# HG changeset patch # User Yasutaka Higa # Date 1411387472 -32400 # Node ID c77397d0677f8a5f3a071d5541df7e92f8549c4a # Parent 279ebcf670c4d68006c34a1e77fb252fab2ad023 Try define Similar as Monad diff -r 279ebcf670c4 -r c77397d0677f similar.hs --- 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 -} - +-} +-}