Использование Maybe и Writer для фильтрации списка и отслеживания попаданий фильтра

Я фильтрую список, используя связанные функции, которые возвращают элемент «Может быть». Эта часть работает нормально.

{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, OverlappingInstances #-}
import Control.Monad
import Control.Monad.Trans.Maybe
import Control.Monad.Writer
import Data.Map (Map, alter, empty, unionWith)

------------------------------------------------

main = do
  let numberList = [1..6]
  let result = filter ((\z -> case z of Just _ -> True; Nothing -> False) . numFilter) numberList
  (putStrLn . show) result

{-
 [2,3,4]
-}

--- Maybe
bigOne :: Int -> Maybe Int
bigOne n | n > 1     = Just n
         | otherwise = Nothing

lessFive :: Int -> Maybe Int
lessFive n | n < 5     = Just n
           | otherwise = Nothing

numFilter :: Int -> Maybe Int
numFilter num = bigOne num
            >>= lessFive

Но затем я также хочу подсчитать количество раз, когда разные функции поймали элемент. Сейчас я использую Writer с картой для сбора хитов. Я попытался обернуть это внутри MaybeT, но это приводит к сбою всего фильтра в случае нежелательного элемента и возврата и пустого списка.

-------------------------------
type FunctionName = String
type Count = Int
type CountMap = Map FunctionName Count

instance Monoid CountMap where
  mempty = empty :: CountMap
  -- default mappend on maps overwrites values with same key,
  -- this increments them
  mappend x y = unionWith (+) x y

{-
  Helper monad to track the filter hits.
-}
type CountWriter = Writer CountMap

incrementCount :: String -> CountMap
incrementCount key = alter addOne key empty

addOne :: Maybe Int -> Maybe Int
addOne Nothing = Just 1
addOne (Just n) = Just (n + 1)

bigOneMW :: Int -> MaybeT CountWriter Int
bigOneMW n | n > 1     = MaybeT $ return (Just n)
           | otherwise = do
                          tell (incrementCount "bigOne")
                          MaybeT $ return Nothing

lessFiveMW :: Int -> MaybeT CountWriter Int
lessFiveMW n | n < 5     = MaybeT $ return (Just n)
             | otherwise = do
                           tell (incrementCount "lessFive")
                           MaybeT $ return Nothing

chainMWBool :: Int -> MaybeT CountWriter Bool
chainMWBool n = do
             a <- bigOneMW n
             b <- lessFiveMW a
             return True

chainerMW :: [Int] -> MaybeT CountWriter [Int]
chainerMW ns = do
               result <- filterM chainMWBool ns
               return result
{-
> runWriter (runMaybeT (chainerMW [1..3]))
(Nothing,fromList [("bigOne",1)])
> runWriter (runMaybeT (chainerMW [2..5]))
(Nothing,fromList [("lessFive",1)])
> runWriter (runMaybeT (chainerMW [2..4]))
(Just [2,3,4],fromList [])
-}

Я просто не могу понять, как заставить его делать то, что я хочу. Я предполагаю, что сигнатура типа, которую я ищу, это [Int] -> CountWriter [Int], но как получить такой результат, когда ввод [1..6]:

([2,3,4], fromList[("bigOne", 1), ("lessFive", 2)])

filter haskell monads maybe writer
person Ari P    schedule 26.05.2013    source источник
comment
Несвязанное замечание по стилю: вы можете использовать isJust вместо большой лямбды с выражением case в main. Или, поскольку numFilter возвращает тот же номер, если это Just, все filter ... можно заменить на mapMaybe numFilter numberList. Обе функции находятся в Data.Maybe.   -  person hammar    schedule 26.05.2013

Ответы (2)


arrow_upward
4
arrow_downward

Вы были ближе, чем вы думали, когда вы сказали:

но как получить такой результат, когда ввод [1..6]:

([2,3,4], fromList[("bigOne", 1), ("lessFive", 2)])

Другими словами, вам нужно что-то, что принимает список в качестве входных данных и возвращает список и карту в качестве выходных данных:

newtype Filter a = Filter { runFilter :: [a] -> (CountMap, [a]) }

Почему бы просто не закодировать все ваши фильтры напрямую, используя представление, которое вы действительно хотели:

import Data.List (partition)
import qualified Data.Map as M
import Data.Monoid

newtype CountMap = CountMap (M.Map String Int)

instance Show CountMap where
    show (CountMap m) = show m

instance Monoid CountMap where
    mempty = CountMap M.empty
    mappend (CountMap x) (CountMap y) = CountMap (M.unionWith (+) x y)

filterOn :: String -> (a -> Bool) -> Filter a
filterOn str pred = Filter $ \as ->
    let (pass, fail) = partition pred as
    in  (CountMap (M.singleton str (length fail)), pass)

bigOne :: Filter Int
bigOne = filterOn "bigOne" (> 1)

lessFive :: Filter Int
lessFive = filterOn "lessFive" (< 5)

Нам не хватает еще одного кусочка головоломки: как комбинировать фильтры. Что ж, получается, что наш тип Filter — это тип Monoid:

instance Monoid (Filter a) where
    mempty = Filter (\as -> (mempty, as))
    mappend (Filter f) (Filter g) = Filter $ \as0 ->
        let (map1, as1) = f as0
            (map2, as2) = g as1
        in  (map1 <> map2, as2)

Опытные читатели поймут, что это всего лишь замаскированная State монада.

Это упрощает составление фильтров с использованием (<>) (то есть mappend), и мы запускаем их, просто разворачивая наш тип Filter:

ghci> runFilter (bigOne <> lessFive) [1..6]
(fromList [("bigOne",1),("lessFive",2)],[2,3,4])

Это показывает, как часто лучший путь оказывается самым прямым!

person Gabriel Gonzalez    schedule 26.05.2013
comment
Это здорово, особенно мне нравится возможность композитинга. Спасибо! - person Ari P; 28.05.2013

arrow_upward
2
arrow_downward

Итак, проблема здесь в том, что использование короткого замыкания уничтожает CountMap, который вы создаете. Быстрый пример

test :: MaybeT (Writer [String]) ()
test = do
       tell ["Blah"] >> mzero
       tell ["Blah"] >> mzero
       tell ["Blah"] >> mzero
       tell ["Blah"] >> mzero


Prelude> runWriter (runMaybeT test)
   (Nothing, ["Blah"])

Видите проблему?

Исправить это довольно просто, просто не полагайтесь на короткое замыкание :)

Пример*:

bigOneMW n | n > 1     = return True
           | otherwise = tell "bigOne" >> return False
lessFiveMW n | n < 5     = return True
             | otherwise = tell "lessFive" >> return False
chainMWBool n = liftM2 (&&) (bigOneMW n) (lessFiveMW n)
chainerMW ns = filterM chainMWBool ns

Теперь, конечно, слой MaybeT немного бесполезен, поэтому мы можем просто его выбросить.

К счастью, это не влияет ни на один из приведенных выше кодов.

* Вы заметите, что tell используют простую строку, для этого я использую расширение языка OverloadedStrings и определяю экземпляр класса типов IsString из Data.String. Код для этой работы выглядит так, если вам интересно:

instance IsString CountMap where
  -- This is the same as your incrementOne code
  -- Just a bit more reliant on higher order function and
  -- pointfree.
  fromString = flip (alter inc) empty
    where inc = maybe (Just 1) $ Just . (+1)

Нравится ли вам этот конкретный трюк, зависит от вас :)

Код после того, как все сказано и сделано: http://hpaste.org/88624

person Daniel Gratzer    schedule 26.05.2013