Mercurial > hg > Members > atton > delta_monad
changeset 18:c77397d0677f
Try define Similar as Monad
author | Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp> |
---|---|
date | Mon, 22 Sep 2014 21:04:32 +0900 |
parents | 279ebcf670c4 |
children | 003b6e58d815 |
files | similar.hs |
diffstat | 1 files changed, 53 insertions(+), 10 deletions(-) [+] |
line wrap: on
line diff
--- a/similar.hs Tue Sep 09 16:21:22 2014 +0900 +++ b/similar.hs Mon Sep 22 21:04:32 2014 +0900 @@ -1,17 +1,63 @@ import Control.Applicative +import Data.Numbers.Primes -- $ cabal install primes + +data Similar a = Single [String] a | Similar [String] a [String] a deriving (Show) -data Similar a = Single a | Similar a (Similar a) deriving (Show) +original :: (Similar a) -> Similar a +original (Similar xs x _ _) = Single xs x +original s = s + +similar :: (Similar a) -> Similar a +similar (Similar _ _ ys y) = Single ys y +similar s = s + +mergeSimilar :: Similar a -> Similar a -> Similar a +mergeSimilar (Single xs x) (Single ys y) = Similar xs x ys y instance (Eq a) => Eq (Similar a) where - s == ss = (same s) == (same ss) + s == ss = (original s) == (original ss) + +instance Functor Similar where + fmap f (Single xs x) = Single xs (f x) + fmap f (Similar xs x ys y) = Similar xs (f x) ys (f y) + +similarLogAppend :: [String] -> Similar a -> Similar a +similarLogAppend ls (Single xs x) = Single (ls ++ xs) x +similarLogAppend ls (Similar xs x ys y) = Similar (ls ++ xs) x (ls ++ ys) y + + +instance Monad Similar where + return = Single [] + (Single xs x) >>= f = similarLogAppend xs (original (f x)) + (Similar xs x ys y) >>= f = mergeSimilar (similarLogAppend xs (original (f x))) (similarLogAppend ys (similar (f y))) + + +{- + + +-- samples +{- + +generator :: Int -> Similar [Int] +generator x = return [1..x] + +primeFilter :: [Int] -> Similar [Int] +primeFilter xs = return $ filter isPrime xs + +count :: [Int] -> Similar Int +count xs = return $ length xs + +primeCount :: Int -> Int +primeCount x = value $ generator x >>= primeFilter >>= count +-} + + +{- same :: (Eq a) => Similar a -> a same (Single x) = x same (Similar x s) = if x == (same s) then x else (error "same") -value :: Similar a -> a -value (Single x) = x -value (Similar x s) = value s similar :: Similar a -> Similar a -> Similar a similar (Single x) ss = Similar x ss @@ -30,10 +76,6 @@ mu (Single s) = s mu (Similar s ss) = similar s (mu ss) -instance Monad Similar where - return = Single - (Single x) >>= f = f x - (Similar x s) >>= f = mu $ Similar (f x) (fmap f s) -- samples @@ -91,4 +133,5 @@ 800 -} - +-} +-}