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

我觉得我错过了一些基本的抽象，可以使它更通用，更简洁。

任何人都可以给我一些指示，告诉我如何在这里使用任何现代的Haskellisms来改善它吗？

修改代码在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类型签名中的存在性Fold :: (x -> a -> x) -> x -> (x -> b) -> Fold a b我无法弄清楚在我的新折叠的begin位置放置什么。它必须是f i x类型，但我不知道如何告诉Haskell如何将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值，而且可能在任何时刻。

这意味着它不会将step函数提升为Map k（在这种情况下，我们可以使用Applicative的任何实例代替我们 Map，见下文），我们必须一直采用begin值。

这＆＃34; lift加上默认值＆＃34;是下面新类fuseWith的成员Fusable。它是原始代码中的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 k不是Applicative！）

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

如何使这个折叠更通用

1 个答案: