मैं इस गुना अधिक सामान्य

Question

मैं इस समारोह में लिखा है बना सकते हैं:

{-# LANGUAGE RankNTypes #-} 
{-# LANGUAGE MultiParamTypeClasses #-} 
{-# LANGUAGE TemplateHaskell  #-} 
{-# LANGUAGE TypeFamilies   #-} 
module Hierarchy where 

import   Control.Applicative 
import qualified Control.Foldl  as CF 
import   Control.Foldl (Fold(..)) 
import   Control.Lens hiding (Fold) 
import qualified Data.Foldable  as F 
import qualified Data.Map.Lazy  as M 
import   Data.Monoid   (Monoid (..), Sum (Sum)) 
import   Data.Profunctor 
import   Data.Set (Set) 
import   Data.Maybe 
import   Data.Text   (Text) 

overMaps :: (Ord k) => Fold a b -> Fold (M.Map k a) (M.Map k b) 
overMaps (Fold step begin done) = Fold step' M.empty (fmap done) 
    where 
    step' acc m = M.foldrWithKey insert acc m 
    insert k el acc = M.insert k (step (fromMaybe begin $ M.lookup k acc) el) acc 

मुझे लगता है कि मैं कुछ बुनियादी अमूर्त है कि इस अधिक सामान्य बना सकता है याद कर रहा हूँ, और अधिक संक्षिप्त।

क्या कोई मुझे कुछ पॉइंटर्स दे सकता है कि मैं इसे बेहतर बनाने के लिए यहां किसी भी आधुनिक हास्केलिज़्म का उपयोग कैसे कर सकता हूं?

संपादित कोड यहाँ है https://github.com/boothead/hierarchy/blob/master/src/Hierarchy.hs

और मैं आयात

संपादित शायद मैं ifoldr उपयोग कर सकते हैं @ CDK के विचार के साथ नज़दीकी बढ़ाने को शामिल किया है?

संपादित

यहाँ निकटतम मुझे मिल गया है है।

--overFoldable :: (Ord k) => Fold a b -> Fold (M.Map k a) (M.Map k b) 
overFoldable :: (Ord i, At (f i a), FoldableWithIndex i (f i), Monoid (f i x)) 
      => Fold a b -> Fold (f i a) (f i b) 
overFoldable (Fold step begin done) = Fold step' mempty (fmap done) 
    where 
    step' acc m = Lens.ifoldr insert acc m 
    insert k el acc = Lens.at k %~ return . flip step el . fromMaybe begin $ acc 

यहां पहला (टिप्पणी) प्रकार हस्ताक्षर कार्य करता है। अब समस्या के प्रकार हस्ताक्षर में अस्तित्व x में निहित है, मैं यह नहीं समझ सकता कि begin में मेरे नए गुना की स्थिति क्या है। इसे f i x टाइप करने की आवश्यकता है, लेकिन मुझे नहीं पता कि हास्केल को x को begin के समान प्रकार के रूप में कैसे लेना है।

Answer 1

मुख्य रूप से मेरे अपने को समझने के लिए

(और की है कि मेरे प्रिय rubber duck):

मान लीजिए मैं एक फोल्ड sumLengths कि तार (इसलिए fold sumLengths ["a","bbb"] पैदावार 4)

मैं overMaps sumLengths एक होना चाहता हूँ की लंबाई कहते हैं गुना का कहना है कि एक फ्रांसीसी और एक डच शब्दकोश लेता है, और एक नया शब्दकोश D ऐसी है कि lookup D "bread" 9 (length("pain") + length("brood"))

निश्चित रूप से समस्या यह है कि इतना है बनाता है मुझे शब्दकोष सभी शब्दकोशों में नहीं हो सकता है: lookup D "sex"length("sexe") है क्योंकि हम डच बहुत ही समझदार हैं :-) तो हमें न केवल हमारे गुना की शुरुआत में, बल्कि संभवतः किसी भी समय हमारे गुना के begin मूल्य की आवश्यकता है।

इसका मतलब यह है यह, हम साथ सभी हमारे begin मूल्य ले जाना है सिर्फ Map k को step समारोह लिफ्ट करने के लिए (उस मामले में हम अपने Map के बजाय Applicative के किसी भी मामले इस्तेमाल कर सकते हैं, नीचे देखें) से काम नहीं चलेगा मार्ग।

यह "lift प्लस डिफ़ॉल्ट मान" एक नया वर्ग नीचे Fusable के सदस्य fuseWith है। यह आपके मूल कोड में step' है, लेकिन (थोड़ा) सामान्यीकृत है ताकि हमारे पास सूचियों की सूचियों के लिए overF sumLengths भी हो।

import Data.Map as M hiding (map) 
import qualified Control.Foldl  as CF 
import Control.Foldl (Fold(..)) 
import Control.Applicative 
import Data.Foldable as F 
import Data.Maybe 

--- the Fusable class: 
class Functor f => Fusable f where 
    fuseWith :: x -> (x -> a -> x) -> f x -> f a -> f x 
    emptyf :: f a 

--- Map k is a Fusable (whenever k has an ordering) 
instance (Ord k) => Fusable (Map k) where 
    fuseWith x f xmap amap = M.foldrWithKey insert xmap amap where  
     insert k el xmap = M.insert k (f (fromMaybe x $ M.lookup k xmap) el) xmap 
    emptyf = M.empty 

--- Lists are Fusable 
instance Fusable [] where 
    fuseWith = zipWithDefault where 
    zipWithDefault dx f [] ys = zipWith f (repeat dx) ys 
    zipWithDefault dx f xs [] = xs 
    zipWithDefault dx f (x:xs) (y:ys) = (f x y) : zipWithDefault dx f xs ys 
    emptyf = [] 

--- The generalised overMaps: 
overF :: (Fusable f) => Fold a b -> Fold (f a) (f b) 
overF (Fold step begin done) = Fold (fuseWith begin step) emptyf (fmap done) 

--- some tests 
testlist = [(1,4),(3,99),(7,999)] 
testlist2 = [(1,15),(2,88)] 

test = CF.fold (overF CF.sum) $ map fromList [testlist, testlist2] 
-- fromList [(1,19),(2,88),(3,99),(7,999)] 
test2 = CF.fold (overF $ CF.premap snd CF.sum) [testlist, testlist2] 
-- [19,187,999] 

हम begin मूल्य के साथ लेने के बारे में चिंता मत करो, तो हम उपयोग कर सकते हैं किसी भी Applicative (Map kApplicative नहीं है!)

overA :: (Applicative f) => Fold a b -> Fold (f a) (f b) 
overA (Fold step begin done) = Fold (liftA2 step) (pure begin) (fmap done) 

यह निश्चित रूप से overF जैसा दिखता है। के रूप में एक सूची आता है के साथ कि बहुत छोटा है, परिणाम छोटा कर दिया

test3 = CF.fold (overA $ CF.premap snd CF.sum) $ map ZipList [testlist, testlist2] 
-- ZipList [19,187] -- *where* is my third element :-(