Mercurial > hg > Members > atton > delta_monad

comparison similar.hs @ 22:f0400c4c953f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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
comparison
equal deleted inserted replaced
21:af8754322ed4 22:f0400c4c953f
1 import Control.Applicative 1 import Control.Applicative
2 import Data.Numbers.Primes -- $ cabal install primes 2 import Data.Numbers.Primes -- $ cabal install primes
3 3
4 data Similar a = Single [String] a | Similar [String] a [String] a deriving (Show) 4 data Similar a = Similar [String] a [String] a deriving (Show)
5 5
6 value :: (Similar a) -> a 6 value :: (Similar a) -> a
7 value (Single _ x) = x
8 value (Similar _ x _ _) = x 7 value (Similar _ x _ _) = x
9 8
10 similar :: (Similar a) -> a 9 similar :: (Similar a) -> a
11 similar (Single _ x) = x
12 similar (Similar _ _ _ y) = y 10 similar (Similar _ _ _ y) = y
13 11
14 instance (Eq a) => Eq (Similar a) where 12 instance (Eq a) => Eq (Similar a) where
15 s == ss = (value s) == (value ss) 13 s == ss = (value s) == (value ss)
16 14
17 instance Functor Similar where 15 instance Functor Similar where
18 fmap f (Single xs x) = Single xs (f x)
19 fmap f (Similar xs x ys y) = Similar xs (f x) ys (f y) 16 fmap f (Similar xs x ys y) = Similar xs (f x) ys (f y)
20 17
21 instance Applicative Similar where 18 instance Applicative Similar where
22 pure = Single [] 19 pure f = Similar [] f [] f
23 (Single lf f) <*> (Single lx x) = Single (lf ++ lx) (f x)
24 (Single lf f) <*> (Similar lx x ly y) = Similar (lf ++ lx) (f x) (lf ++ ly) (f y)
25 (Similar lf f lg g) <*> (Single lx x) = Similar (lf ++ lx) (f x) (lg ++ lx) (g x)
26 (Similar lf f lg g) <*> (Similar lx x ly y) = Similar (lf ++ lx) (f x) (lg ++ ly) (g y) 20 (Similar lf f lg g) <*> (Similar lx x ly y) = Similar (lf ++ lx) (f x) (lg ++ ly) (g y)
27 21
28 mu :: Similar (Similar a) -> Similar a 22 mu :: Similar (Similar a) -> Similar a
29 mu (Single ls (Single lx x)) = Single (ls ++ lx) x 23 mu (Similar lx (Similar llx x _ _) ly (Similar _ _ lly y)) = Similar (lx ++ llx) x (ly ++ lly) y
30 mu (Single ls (Similar lx x ly y)) = Similar (ls ++ lx) x (ls ++ ly) y
31 mu (Similar lx (Single llx x) ly (Single lly y)) = Similar (lx ++ llx) x (ly ++ lly) y
32 mu (Similar lx (Similar llx x _ _) ly (Similar _ _ lly y)) = Similar (lx ++ llx) x (lx ++ lly) y
33 mu _ = error "Invalid Similar"
34 24
35 instance Monad Similar where 25 instance Monad Similar where
36 return = Single [] 26 return x = Similar [] x [] x
37 s >>= f = mu $ fmap f s 27 s >>= f = mu $ fmap f s
38 28
39 29
40 30 returnS :: (Show s) => s -> Similar s
31 returnS x = Similar [(show x)] x [(show x)] x
41 32
42 -- samples 33 -- samples
43 34
44 generator :: Int -> Similar [Int] 35 generator :: Int -> Similar [Int]
45 generator x = let intList = [1..x] in 36 generator x = let intList = [1..x] in
46 Single [(show intList)] intList 37 returnS intList
47 38
48 primeFilter :: [Int] -> Similar [Int] 39 primeFilter :: [Int] -> Similar [Int]
49 primeFilter xs = let primeList = filter isPrime xs 40 primeFilter xs = let primeList = filter isPrime xs
50 refactorList = filter even xs in 41 refactorList = filter even xs in
51 Similar [(show primeList)] primeList [(show refactorList)] refactorList 42 Similar [(show primeList)] primeList [(show refactorList)] refactorList
52 43
53 count :: [Int] -> Similar Int 44 count :: [Int] -> Similar Int
54 count xs = let primeCount = length xs in 45 count xs = let primeCount = length xs in
55 Single [(show primeCount)] primeCount 46 returnS primeCount
56 47
57 primeCount :: Int -> Similar Int 48 primeCount :: Int -> Similar Int
58 primeCount x = generator x >>= primeFilter >>= count 49 primeCount x = generator x >>= primeFilter >>= count