Mercurial > hg > Members > atton > delta_monad

annotate similar.hs @ 15:c599d2236d19

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Similar as Monad
author Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
date Sat, 06 Sep 2014 16:01:27 +0900
parents 116131b196bb
children 4b315cf0edb9
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
14
116131b196bb Define fmap and mu
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 13
diff changeset
1 data Similar a = Single a | Similar a (Similar a) deriving (Show)
116131b196bb Define fmap and mu
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 13
diff changeset
2
116131b196bb Define fmap and mu
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 13
diff changeset
3 instance (Eq a) => Eq (Similar a) where
116131b196bb Define fmap and mu
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 13
diff changeset
4 s == ss = (same s) == (same ss)
10
7c7efee7891f Define Monad style Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 9
diff changeset
5
13
88d6897c391a Redefine Similar. reject function in data
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 12
diff changeset
6 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
7 same (Single x) = x
14
116131b196bb Define fmap and mu
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 13
diff changeset
8 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
9
15
c599d2236d19 Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 14
diff changeset
10 value :: Similar a -> a
c599d2236d19 Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 14
diff changeset
11 value (Single x) = x
c599d2236d19 Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 14
diff changeset
12 value (Similar x s) = value s
c599d2236d19 Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 14
diff changeset
13
c599d2236d19 Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 14
diff changeset
14 toList :: Similar a -> [a]
c599d2236d19 Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 14
diff changeset
15 toList (Single x) = [x]
c599d2236d19 Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 14
diff changeset
16 toList (Similar x s) = x : (toList s)
c599d2236d19 Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 14
diff changeset
17
c599d2236d19 Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 14
diff changeset
18 toSimilar :: [a] -> Similar a
c599d2236d19 Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 14
diff changeset
19 toSimilar [] = undefined
c599d2236d19 Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 14
diff changeset
20 toSimilar (x:[]) = Single x
c599d2236d19 Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 14
diff changeset
21 toSimilar (x:xs) = Similar x (toSimilar xs)
10
7c7efee7891f Define Monad style Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 9
diff changeset
22
13
88d6897c391a Redefine Similar. reject function in data
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 12
diff changeset
23 instance Functor Similar where
88d6897c391a Redefine Similar. reject function in data
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 12
diff changeset
24 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
25 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
26
15
c599d2236d19 Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 14
diff changeset
27 mu :: (Similar (Similar a)) -> Similar a
c599d2236d19 Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 14
diff changeset
28 mu s = toSimilar $ concat $ toList $ fmap (toList) s
10
7c7efee7891f Define Monad style Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 9
diff changeset
29
14
116131b196bb Define fmap and mu
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 13
diff changeset
30 instance Monad Similar where
116131b196bb Define fmap and mu
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 13
diff changeset
31 return = Single
116131b196bb Define fmap and mu
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 13
diff changeset
32 (Single x) >>= f = f x
116131b196bb Define fmap and mu
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 13
diff changeset
33 (Similar x s) >>= f = mu $ Similar (f x) (fmap f s)
11
e8a5df54480e Define sample for Monad style
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 10
diff changeset
34
0
7a82a5e50499 Initial commit. define to Functor for Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff changeset
35
3
3c5fbce357af Define >>= for Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 2
diff changeset
36
14
116131b196bb Define fmap and mu
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 13
diff changeset
37 double :: Int -> Similar Int
116131b196bb Define fmap and mu
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 13
diff changeset
38 double x = Single (2 * x)
4
66609010d477 Define Similer example as Functor
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 3
diff changeset
39
14
116131b196bb Define fmap and mu
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 13
diff changeset
40 twicePlus :: Int -> Similar Int
116131b196bb Define fmap and mu
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 13
diff changeset
41 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
42
14
116131b196bb Define fmap and mu
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 13
diff changeset
43 plusTwo :: Int -> Similar Int
116131b196bb Define fmap and mu
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 13
diff changeset
44 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
45
11
e8a5df54480e Define sample for Monad style
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 10
diff changeset
46 -- samples
6
5e367a167382 Define samples
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
47
11
e8a5df54480e Define sample for Monad style
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 10
diff changeset
48 {-
15
c599d2236d19 Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 14
diff changeset
49 - Similar as Functor
c599d2236d19 Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 14
diff changeset
50 *Main> fmap (double ) (Single 1)
c599d2236d19 Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 14
diff changeset
51 Single (Single 2)
c599d2236d19 Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 14
diff changeset
52 *Main> fmap (twicePlus) (Single 1)
c599d2236d19 Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 14
diff changeset
53 Single (Similar 2 (Single 2))
c599d2236d19 Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 14
diff changeset
54 *Main> fmap (plusTwo) (Single 1)
c599d2236d19 Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 14
diff changeset
55 Single (Similar 3 (Single 2))
c599d2236d19 Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 14
diff changeset
56 *Main> fmap (fmap double) (fmap (plusTwo ) (Single 1))
c599d2236d19 Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 14
diff changeset
57 Single (Similar (Single 6) (Single (Single 4)))
c599d2236d19 Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 14
diff changeset
58 *Main> same $ fmap same $ fmap (fmap double) (fmap (plusTwo ) (Single 1))
c599d2236d19 Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 14
diff changeset
59 *** Exception: same
c599d2236d19 Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 14
diff changeset
60 *Main> same $ fmap same $ fmap (fmap double) (fmap (plusTwo ) (Single 2))
c599d2236d19 Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 14
diff changeset
61 Single 8
6
5e367a167382 Define samples
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 5
diff changeset
62
15
c599d2236d19 Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 14
diff changeset
63 - Similar as Monad
c599d2236d19 Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 14
diff changeset
64 *Main> return 100 >>= double >>= twicePlus
c599d2236d19 Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 14
diff changeset
65 Similar 400 (Single 400)
c599d2236d19 Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 14
diff changeset
66 *Main> return 100 >>= double >>= twicePlus >>= plusTwo
c599d2236d19 Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 14
diff changeset
67 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
68
15
c599d2236d19 Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 14
diff changeset
69 *Main> same $ return 100 >>= double >>= twicePlus >>= plusTwo
c599d2236d19 Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 14
diff changeset
70 *** Exception: same
c599d2236d19 Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 14
diff changeset
71 *Main> same $ return 100 >>= double >>= twicePlus
c599d2236d19 Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 14
diff changeset
72 400
c599d2236d19 Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 14
diff changeset
73
c599d2236d19 Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 14
diff changeset
74 *Main> same $ return 100 >>= double >>= twicePlus
c599d2236d19 Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 14
diff changeset
75 400
c599d2236d19 Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 14
diff changeset
76 *Main> same $ return 100 >>= double >>= twicePlus >>= plusTwo
c599d2236d19 Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 14
diff changeset
77 *** Exception: same
c599d2236d19 Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 14
diff changeset
78 *Main> value $ return 100 >>= double >>= twicePlus >>= plusTwo
c599d2236d19 Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 14
diff changeset
79 800
c599d2236d19 Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 14
diff changeset
80
10
7c7efee7891f Define Monad style Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 9
diff changeset
81 -}
12
158ae705cd16 Rename Similer -> Similar
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents: 11
diff changeset
82