RamdaJS reduBy() в Haskell с использованием рекурсивных схем

У меня есть следующий код, используя recursion-schemes библиотека:

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeFamilies #-}
import Data.Functor.Foldable
import Data.Maybe

import qualified Data.Map as M

reduceBy valueAlgebra keyFn = cata $ fooAlgebra valueAlgebra keyFn

fooAlgebra
  :: Ord k =>
     (ListF t a -> a) -> (t -> k) -> ListF t (M.Map k a) -> M.Map k a   
fooAlgebra valueAlgebra keyFn = \case
    Nil -> M.empty
    Cons elt acc -> M.alter 
         (Just . (valueAlgebra . Cons elt) . fromMaybe (valueAlgebra Nil)) 
         (keyFn elt)
         acc

Использовать как let countBy = reduceBy (\case Nil -> 0 ; Cons a b -> succ b) id in countBy [42,5,5,8,8,8], Код имитирует http://ramdajs.com/docs/

Есть ли лучший способ реализовать reduceBy с помощью recursion-schemes? alter аргументы кажутся хрупкими, и это cata действительно уместно там? Я слышал, что некоторые вещи могут быть реализованы как ana а также cata,

2 ответа

Решение

Я не вижу ничего плохого в вашем подходе. Аргументы alter не очень приятно смотреть, но это в основном beacues alter немного неуклюжий в использовании. Поскольку вам не нужно удалять элементы с карты, можно переписать fooAlgebra с помощью insertWith скорее, чем alter...

fooAlgebra
  :: Ord k =>
     (ListF t a -> a) -> (t -> k) -> ListF t (M.Map k a) -> M.Map k a
fooAlgebra valueAlgebra keyFn = \case
    Nil -> M.empty
    Cons elt acc -> M.insertWith
         (\_ grpAcc -> valueAlgebra (Cons elt grpAcc))
         (keyFn elt)
         (valueAlgebra (Cons elt (valueAlgebra Nil)))
         acc

... что вы можете или не можете найти улучшение.

Что касается использования катаморфизма, то это кажется естественным, так как вы разрушаете первоначальную структуру, чтобы получить групповую сводку элементов. (Стоит также отметить, что если keyFn постоянная функция, то reduceBy становится, по сути, простой старой складкой всех элементов с valueAlgebra.) Рефакторинг, который предлагает Данидиаз (то есть отделение valueAlgebra катаморфизм от группировки один), возможно, делает это более очевидным:

reduceBy valueAlgebra keyFn =
    fmap (cata valueAlgebra) . cata (groupAlgebra keyFn)

groupAlgebra
  :: Ord k => (t -> k) -> ListF t (M.Map k [t]) -> M.Map k [t]
groupAlgebra keyFn = \case
    Nil -> M.empty
    Cons elt acc -> M.alter
         (Just . (elt :) . fromMaybe [])
         (keyFn elt)
         acc

Моя собственная попытка на основе всех советов до сих пор:

type ListAlgebra a b = ListF a b -> b

reduceBy :: Ord k => ListAlgebra t b -> (t -> k) -> [t] -> M.Map k b
reduceBy valueAlgebra keyFn x = cata valueAlgebra <$> cata groupAlgebra x where
    groupAlgebra = \case
        Nil -> M.empty
        Cons elt acc -> M.alter (Just . maybe [elt] (elt:)) (keyFn elt) acc

Другое направление атаки - это заметить, что keyFn может быть учтено из groupAlgebraтак становится groupAlgebra' :: ListAlgebra (k, v) (M.Map k [v]), В этой форме это точно embedХотя и несколько экзотично

newtype XMap k v = XMap { unXMap :: M.Map k [v] }
type instance Base (XMap k v) = ListF (k, v)
instance Ord k => Corecursive (XMap k v) where
    embed = \case
        Nil -> XMap M.empty
        Cons (key,elt) acc -> XMap $ M.alter (Just . maybe [elt] (elt:)) key $ unXMap acc

При создании этого экземпляра не было повреждено ни одной фиксированной точки. наш reduceBy Теперь можно построить с refix "бросок" (hylomorphism, который получает свою алгебру и коалгебру от (Co)recursive экземпляры):

reduceBy :: Ord k => ListAlgebra t b -> (t -> k) -> [t] -> M.Map k b
reduceBy valueAlgebra keyFn =
    fmap (cata valueAlgebra) . unXMap . refix . map (keyFn &&& id)

Обратите внимание, что этот подход является полностью модульным: вы можете легко разбить функцию на независимые комбинаторы, а также гибко строить карты, используя анаморфизмы и другие разворачивания, вместо того, чтобы просто использовать списки.

Другие вопросы по тегам