Wie kann ich diese Falte allgemeinere

Question

ich diese Funktion geschrieben haben:

{-# 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 

Ich fühle mich wie ich einige grundlegende Abstraktion bin fehlt, die diese allgemeinere und prägnanter machen könnte.

Kann mir jemand Hinweise geben, wie ich hier irgendeinen modernen Haskellismus einsetzen könnte, um das besser zu machen?

bearbeiten Der Code ist hier https://github.com/boothead/hierarchy/blob/master/src/Hierarchy.hs

und ich habe die Importe

bearbeiten Vielleicht kann ich ifoldr enthalten verwenden, näher zu kommen, um @ cdk Idee?

bearbeiten

Hier ist die nächste, die ich habe.

--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 

Hier funktioniert die erste (kommentierte) Signatur. Jetzt liegt das Problem in der existentiellen x in der Typ-Signatur von Fold :: (x -> a -> x) -> x -> (x -> b) -> Fold a b Ich kann nicht herausfinden, was in die begin Position meiner neuen Falte zu setzen. Es muss vom Typ f i x sein, aber ich weiß nicht, wie man Haskell sagt, wie man x als den gleichen Typ wie begin nimmt.

Answer 1

Vor allem für mein eigenes Verständnis (und die meiner geliebten rubber duck):

Angenommen, ich habe eine Falte sumLengths, dass die Längen von Zeichenketten (so fold sumLengths ["a","bbb"] Ausbeuten 4)

ein Ich möchte overMaps sumLengths sein fügt falten Sie das braucht ein Französisch und ein niederländisches Wörterbuch sagen, und macht ein neues Wörterbuch D so dass lookup D "bread" ist 9 (length("pain") + length("brood"))

Das Problem ist natürlich, dass so Ich darf nicht in allen Wörterbüchern Wörter eingeben: lookup D "sex" ist length("sexe") da wir Niederländer sehr prüde sind :-) Also brauchen wir den begin Wert unserer Falte nicht nur am Anfang unserer Falte, sondern eventuell jederzeit.

Das bedeutet, es geht nicht nur die step Funktion Map k heben (in diesem Fall wir jede Instanz von Applicative statt unserer Map siehe unten verwenden können), müssen wir unsere begin Wert entlang der gesamten nehmen Weg.

Dieser "lift plus Standardwert" ist das Mitglied fuseWith einer neuen Klasse Fusable unten. Es ist die step' in Ihrem ursprünglichen Code, aber (leicht) verallgemeinert, so dass wir auch eine overF sumLengths für Listen von Listen zum Beispiel haben.

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] 

Wenn wir keine Sorge entlang der begin Wert zu nehmen, können wir jede Applicative (Map k ist nicht Applicative verwenden!)

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

Es sieht sicherlich viel wie overF aus. Aber es gibt unterschiedliche Ergebnisse: wenn sie über eine Liste von Listen falten, sobald eine Liste zusammen kommt, dass zu kurz ist, wird das Ergebnis abgeschnitten

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