# HG changeset patch # User Yasutaka Higa # Date 1411711343 -32400 # Node ID f0400c4c953fd8cfc7e80a904e4cb4fa8ae339c3 # Parent af8754322ed44c6d2b8de4c5ddaf1d1eca4a8518 Imporve Similar definition. delete "Single" constructor diff -r af8754322ed4 -r f0400c4c953f similar.hs --- a/similar.hs Tue Sep 23 17:27:11 2014 +0900 +++ b/similar.hs Fri Sep 26 15:02:23 2014 +0900 @@ -1,49 +1,40 @@ 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 = Similar [String] a [String] a deriving (Show) value :: (Similar a) -> a -value (Single _ x) = x value (Similar _ x _ _) = x similar :: (Similar a) -> a -similar (Single _ x) = x similar (Similar _ _ _ y) = y instance (Eq a) => Eq (Similar a) where s == ss = (value s) == (value 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) instance Applicative Similar where - pure = Single [] - (Single lf f) <*> (Single lx x) = Single (lf ++ lx) (f x) - (Single lf f) <*> (Similar lx x ly y) = Similar (lf ++ lx) (f x) (lf ++ ly) (f y) - (Similar lf f lg g) <*> (Single lx x) = Similar (lf ++ lx) (f x) (lg ++ lx) (g x) + pure f = Similar [] f [] f (Similar lf f lg g) <*> (Similar lx x ly y) = Similar (lf ++ lx) (f x) (lg ++ ly) (g y) mu :: Similar (Similar a) -> Similar a -mu (Single ls (Single lx x)) = Single (ls ++ lx) x -mu (Single ls (Similar lx x ly y)) = Similar (ls ++ lx) x (ls ++ ly) y -mu (Similar lx (Single llx x) ly (Single lly y)) = Similar (lx ++ llx) x (ly ++ lly) y -mu (Similar lx (Similar llx x _ _) ly (Similar _ _ lly y)) = Similar (lx ++ llx) x (lx ++ lly) y -mu _ = error "Invalid Similar" +mu (Similar lx (Similar llx x _ _) ly (Similar _ _ lly y)) = Similar (lx ++ llx) x (ly ++ lly) y instance Monad Similar where - return = Single [] - s >>= f = mu $ fmap f s + return x = Similar [] x [] x + s >>= f = mu $ fmap f s - +returnS :: (Show s) => s -> Similar s +returnS x = Similar [(show x)] x [(show x)] x -- samples generator :: Int -> Similar [Int] generator x = let intList = [1..x] in - Single [(show intList)] intList + returnS intList primeFilter :: [Int] -> Similar [Int] primeFilter xs = let primeList = filter isPrime xs @@ -52,7 +43,7 @@ count :: [Int] -> Similar Int count xs = let primeCount = length xs in - Single [(show primeCount)] primeCount + returnS primeCount primeCount :: Int -> Similar Int primeCount x = generator x >>= primeFilter >>= count