changeset 22:f0400c4c953f

Imporve Similar definition. delete "Single" constructor
author Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
date Fri, 26 Sep 2014 15:02:23 +0900
parents af8754322ed4
children b4d3960af901
files similar.hs
diffstat 1 files changed, 9 insertions(+), 18 deletions(-) [+]
line wrap: on
line diff
--- 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