Mercurial > hg > Members > atton > delta_monad

comparison similar.hs @ 18:c77397d0677f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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
comparison
equal deleted inserted replaced
17:279ebcf670c4 18:c77397d0677f
1 import Control.Applicative 1 import Control.Applicative
2 import Data.Numbers.Primes -- $ cabal install primes
2 3
3 data Similar a = Single a | Similar a (Similar a) deriving (Show) 4 data Similar a = Single [String] a | Similar [String] a [String] a deriving (Show)
5
6 original :: (Similar a) -> Similar a
7 original (Similar xs x _ _) = Single xs x
8 original s = s
9
10 similar :: (Similar a) -> Similar a
11 similar (Similar _ _ ys y) = Single ys y
12 similar s = s
13
14 mergeSimilar :: Similar a -> Similar a -> Similar a
15 mergeSimilar (Single xs x) (Single ys y) = Similar xs x ys y
4 16
5 instance (Eq a) => Eq (Similar a) where 17 instance (Eq a) => Eq (Similar a) where
6 s == ss = (same s) == (same ss) 18 s == ss = (original s) == (original ss)
7 19
20 instance Functor Similar where
21 fmap f (Single xs x) = Single xs (f x)
22 fmap f (Similar xs x ys y) = Similar xs (f x) ys (f y)
23
24 similarLogAppend :: [String] -> Similar a -> Similar a
25 similarLogAppend ls (Single xs x) = Single (ls ++ xs) x
26 similarLogAppend ls (Similar xs x ys y) = Similar (ls ++ xs) x (ls ++ ys) y
27
28
29 instance Monad Similar where
30 return = Single []
31 (Single xs x) >>= f = similarLogAppend xs (original (f x))
32 (Similar xs x ys y) >>= f = mergeSimilar (similarLogAppend xs (original (f x))) (similarLogAppend ys (similar (f y)))
33
34
35 {-
36
37
38
39 -- samples
40 {-
41
42 generator :: Int -> Similar [Int]
43 generator x = return [1..x]
44
45 primeFilter :: [Int] -> Similar [Int]
46 primeFilter xs = return $ filter isPrime xs
47
48 count :: [Int] -> Similar Int
49 count xs = return $ length xs
50
51 primeCount :: Int -> Int
52 primeCount x = value $ generator x >>= primeFilter >>= count
53 -}
54
55
56 {-
8 same :: (Eq a) => Similar a -> a 57 same :: (Eq a) => Similar a -> a
9 same (Single x) = x 58 same (Single x) = x
10 same (Similar x s) = if x == (same s) then x else (error "same") 59 same (Similar x s) = if x == (same s) then x else (error "same")
11 60
12 value :: Similar a -> a
13 value (Single x) = x
14 value (Similar x s) = value s
15 61
16 similar :: Similar a -> Similar a -> Similar a 62 similar :: Similar a -> Similar a -> Similar a
17 similar (Single x) ss = Similar x ss 63 similar (Single x) ss = Similar x ss
18 similar (Similar x s) ss = Similar x (similar s ss) 64 similar (Similar x s) ss = Similar x (similar s ss)
19 65
28 74
29 mu :: (Similar (Similar a)) -> Similar a 75 mu :: (Similar (Similar a)) -> Similar a
30 mu (Single s) = s 76 mu (Single s) = s
31 mu (Similar s ss) = similar s (mu ss) 77 mu (Similar s ss) = similar s (mu ss)
32 78
33 instance Monad Similar where
34 return = Single
35 (Single x) >>= f = f x
36 (Similar x s) >>= f = mu $ Similar (f x) (fmap f s)
37 79
38 80
39 -- samples 81 -- samples
40 82
41 double :: Int -> Similar Int 83 double :: Int -> Similar Int
89 *** Exception: same 131 *** Exception: same
90 *Main> value $ return 100 >>= double >>= twicePlus >>= plusTwo 132 *Main> value $ return 100 >>= double >>= twicePlus >>= plusTwo
91 800 133 800
92 134
93 -} 135 -}
94 136 -}
137 -}