Mercurial > hg > Members > atton > delta_monad
annotate similar.hs @ 18:c77397d0677f
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 |
rev | line source |
---|---|
17
279ebcf670c4
Define Similar as Applicative
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
16
diff
changeset
|
1 import Control.Applicative |
18
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
2 import Data.Numbers.Primes -- $ cabal install primes |
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
3 |
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
4 data Similar a = Single [String] a | Similar [String] a [String] a deriving (Show) |
17
279ebcf670c4
Define Similar as Applicative
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
16
diff
changeset
|
5 |
18
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
6 original :: (Similar a) -> Similar a |
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
7 original (Similar xs x _ _) = Single xs x |
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
8 original s = s |
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
9 |
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
10 similar :: (Similar a) -> Similar a |
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
11 similar (Similar _ _ ys y) = Single ys y |
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
12 similar s = s |
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
13 |
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
14 mergeSimilar :: Similar a -> Similar a -> Similar a |
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
15 mergeSimilar (Single xs x) (Single ys y) = Similar xs x ys y |
14
116131b196bb
Define fmap and mu
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
13
diff
changeset
|
16 |
116131b196bb
Define fmap and mu
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
13
diff
changeset
|
17 instance (Eq a) => Eq (Similar a) where |
18
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
18 s == ss = (original s) == (original ss) |
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
19 |
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
20 instance Functor Similar where |
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
21 fmap f (Single xs x) = Single xs (f x) |
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
22 fmap f (Similar xs x ys y) = Similar xs (f x) ys (f y) |
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
23 |
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
24 similarLogAppend :: [String] -> Similar a -> Similar a |
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
25 similarLogAppend ls (Single xs x) = Single (ls ++ xs) x |
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
26 similarLogAppend ls (Similar xs x ys y) = Similar (ls ++ xs) x (ls ++ ys) y |
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
27 |
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
28 |
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
29 instance Monad Similar where |
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
30 return = Single [] |
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
31 (Single xs x) >>= f = similarLogAppend xs (original (f x)) |
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
32 (Similar xs x ys y) >>= f = mergeSimilar (similarLogAppend xs (original (f x))) (similarLogAppend ys (similar (f y))) |
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
33 |
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
34 |
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
35 {- |
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
36 |
10
7c7efee7891f
Define Monad style Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
9
diff
changeset
|
37 |
18
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
38 |
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
39 -- samples |
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
40 {- |
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
41 |
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
42 generator :: Int -> Similar [Int] |
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
43 generator x = return [1..x] |
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
44 |
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
45 primeFilter :: [Int] -> Similar [Int] |
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
46 primeFilter xs = return $ filter isPrime xs |
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
47 |
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
48 count :: [Int] -> Similar Int |
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
49 count xs = return $ length xs |
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
50 |
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
51 primeCount :: Int -> Int |
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
52 primeCount x = value $ generator x >>= primeFilter >>= count |
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
53 -} |
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
54 |
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
55 |
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
56 {- |
13
88d6897c391a
Redefine Similar. reject function in data
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
12
diff
changeset
|
57 same :: (Eq a) => Similar a -> a |
88d6897c391a
Redefine Similar. reject function in data
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
12
diff
changeset
|
58 same (Single x) = x |
14
116131b196bb
Define fmap and mu
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
13
diff
changeset
|
59 same (Similar x s) = if x == (same s) then x else (error "same") |
10
7c7efee7891f
Define Monad style Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
9
diff
changeset
|
60 |
15 | 61 |
16
4b315cf0edb9
Improve mu definition
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
15
diff
changeset
|
62 similar :: Similar a -> Similar a -> Similar a |
4b315cf0edb9
Improve mu definition
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
15
diff
changeset
|
63 similar (Single x) ss = Similar x ss |
4b315cf0edb9
Improve mu definition
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
15
diff
changeset
|
64 similar (Similar x s) ss = Similar x (similar s ss) |
10
7c7efee7891f
Define Monad style Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
9
diff
changeset
|
65 |
13
88d6897c391a
Redefine Similar. reject function in data
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
12
diff
changeset
|
66 instance Functor Similar where |
88d6897c391a
Redefine Similar. reject function in data
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
12
diff
changeset
|
67 fmap f (Single a) = Single (f a) |
88d6897c391a
Redefine Similar. reject function in data
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
12
diff
changeset
|
68 fmap f (Similar a s) = Similar (f a) (fmap f s) |
88d6897c391a
Redefine Similar. reject function in data
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
12
diff
changeset
|
69 |
17
279ebcf670c4
Define Similar as Applicative
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
16
diff
changeset
|
70 instance Applicative Similar where |
279ebcf670c4
Define Similar as Applicative
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
16
diff
changeset
|
71 pure = Single |
279ebcf670c4
Define Similar as Applicative
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
16
diff
changeset
|
72 (Single f) <*> s = fmap f s |
279ebcf670c4
Define Similar as Applicative
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
16
diff
changeset
|
73 (Similar f s) <*> ss = similar (fmap f ss) (s <*> ss) |
279ebcf670c4
Define Similar as Applicative
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
16
diff
changeset
|
74 |
15 | 75 mu :: (Similar (Similar a)) -> Similar a |
16
4b315cf0edb9
Improve mu definition
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
15
diff
changeset
|
76 mu (Single s) = s |
4b315cf0edb9
Improve mu definition
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
15
diff
changeset
|
77 mu (Similar s ss) = similar s (mu ss) |
10
7c7efee7891f
Define Monad style Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
9
diff
changeset
|
78 |
11
e8a5df54480e
Define sample for Monad style
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
10
diff
changeset
|
79 |
0
7a82a5e50499
Initial commit. define to Functor for Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
80 |
16
4b315cf0edb9
Improve mu definition
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
15
diff
changeset
|
81 -- samples |
3
3c5fbce357af
Define >>= for Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
2
diff
changeset
|
82 |
14
116131b196bb
Define fmap and mu
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
13
diff
changeset
|
83 double :: Int -> Similar Int |
116131b196bb
Define fmap and mu
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
13
diff
changeset
|
84 double x = Single (2 * x) |
4
66609010d477
Define Similer example as Functor
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
3
diff
changeset
|
85 |
14
116131b196bb
Define fmap and mu
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
13
diff
changeset
|
86 twicePlus :: Int -> Similar Int |
116131b196bb
Define fmap and mu
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
13
diff
changeset
|
87 twicePlus x = Similar (x + x) (double x) |
4
66609010d477
Define Similer example as Functor
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
3
diff
changeset
|
88 |
14
116131b196bb
Define fmap and mu
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
13
diff
changeset
|
89 plusTwo :: Int -> Similar Int |
116131b196bb
Define fmap and mu
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
13
diff
changeset
|
90 plusTwo x = Similar (x + 2) (double x) |
4
66609010d477
Define Similer example as Functor
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
3
diff
changeset
|
91 |
11
e8a5df54480e
Define sample for Monad style
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
10
diff
changeset
|
92 -- samples |
6 | 93 |
11
e8a5df54480e
Define sample for Monad style
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
10
diff
changeset
|
94 {- |
15 | 95 - Similar as Functor |
96 *Main> fmap (double ) (Single 1) | |
97 Single (Single 2) | |
98 *Main> fmap (twicePlus) (Single 1) | |
99 Single (Similar 2 (Single 2)) | |
100 *Main> fmap (plusTwo) (Single 1) | |
101 Single (Similar 3 (Single 2)) | |
102 *Main> fmap (fmap double) (fmap (plusTwo ) (Single 1)) | |
103 Single (Similar (Single 6) (Single (Single 4))) | |
104 *Main> same $ fmap same $ fmap (fmap double) (fmap (plusTwo ) (Single 1)) | |
105 *** Exception: same | |
106 *Main> same $ fmap same $ fmap (fmap double) (fmap (plusTwo ) (Single 2)) | |
107 Single 8 | |
6 | 108 |
17
279ebcf670c4
Define Similar as Applicative
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
16
diff
changeset
|
109 - Similar as Applicative Functor |
279ebcf670c4
Define Similar as Applicative
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
16
diff
changeset
|
110 *Main> Single (\x -> x * x) <*> Single 100 |
279ebcf670c4
Define Similar as Applicative
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
16
diff
changeset
|
111 Single 10000 |
279ebcf670c4
Define Similar as Applicative
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
16
diff
changeset
|
112 *Main> Similar (\x -> x * x) (Single (\x -> x * 3)) <*> Single 100 |
279ebcf670c4
Define Similar as Applicative
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
16
diff
changeset
|
113 Similar 10000 (Single 300) |
279ebcf670c4
Define Similar as Applicative
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
16
diff
changeset
|
114 *Main> Similar (\x -> x * x) (Single (\x -> x * 3)) <*> (Similar 100 (Single 200)) |
279ebcf670c4
Define Similar as Applicative
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
16
diff
changeset
|
115 Similar 10000 (Similar 40000 (Similar 300 (Single 600))) |
279ebcf670c4
Define Similar as Applicative
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
16
diff
changeset
|
116 |
15 | 117 - Similar as Monad |
118 *Main> return 100 >>= double >>= twicePlus | |
119 Similar 400 (Single 400) | |
120 *Main> return 100 >>= double >>= twicePlus >>= plusTwo | |
121 Similar 402 (Similar 800 (Similar 402 (Single 800))) | |
11
e8a5df54480e
Define sample for Monad style
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
10
diff
changeset
|
122 |
15 | 123 *Main> same $ return 100 >>= double >>= twicePlus >>= plusTwo |
124 *** Exception: same | |
125 *Main> same $ return 100 >>= double >>= twicePlus | |
126 400 | |
127 | |
128 *Main> same $ return 100 >>= double >>= twicePlus | |
129 400 | |
16
4b315cf0edb9
Improve mu definition
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
15
diff
changeset
|
130 *Main> same $ return 100 >>= double >>= twicePlus >>= plusTwo |
15 | 131 *** Exception: same |
16
4b315cf0edb9
Improve mu definition
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
15
diff
changeset
|
132 *Main> value $ return 100 >>= double >>= twicePlus >>= plusTwo |
15 | 133 800 |
134 | |
10
7c7efee7891f
Define Monad style Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
9
diff
changeset
|
135 -} |
18
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
136 -} |
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
137 -} |