Mercurial > hg > Members > atton > similar_monad
annotate similer.hs @ 6:5e367a167382
Define samples
author | Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp> |
---|---|
date | Tue, 02 Sep 2014 11:06:49 +0900 |
parents | 051c663a4af2 |
children | 6e0285628ead |
rev | line source |
---|---|
3
3c5fbce357af
Define >>= for Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
2
diff
changeset
|
1 {-# LANGUAGE UndecidableInstances #-} |
2 | 2 data Similer a b = Similer a (a -> b) b |
0
7a82a5e50499
Initial commit. define to Functor for Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
3 |
2 | 4 instance Functor (Similer a) where |
0
7a82a5e50499
Initial commit. define to Functor for Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
5 fmap g (Similer a f b) = Similer a (g . f) $ g b |
7a82a5e50499
Initial commit. define to Functor for Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
6 |
5
051c663a4af2
Rename some functions
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
4
diff
changeset
|
7 eq :: (Eq a) => Similer a b -> Similer a b -> Bool |
051c663a4af2
Rename some functions
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
4
diff
changeset
|
8 eq (Similer a _ _ ) (Similer b _ _) = a == b |
3
3c5fbce357af
Define >>= for Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
2
diff
changeset
|
9 |
2 | 10 eta :: a -> Similer a a |
0
7a82a5e50499
Initial commit. define to Functor for Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
11 eta a = Similer a id a |
7a82a5e50499
Initial commit. define to Functor for Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
12 |
3
3c5fbce357af
Define >>= for Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
2
diff
changeset
|
13 mu :: (Eq b) => Similer a (Similer b c) -> Similer b c |
5
051c663a4af2
Rename some functions
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
4
diff
changeset
|
14 mu (Similer a f b) = if (eq (f a) b) then b else undefined |
3
3c5fbce357af
Define >>= for Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
2
diff
changeset
|
15 |
4
66609010d477
Define Similer example as Functor
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
3
diff
changeset
|
16 double :: Int -> Similer Int Int |
66609010d477
Define Similer example as Functor
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
3
diff
changeset
|
17 double x = Similer (2 * x) id (2 * x) |
66609010d477
Define Similer example as Functor
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
3
diff
changeset
|
18 |
66609010d477
Define Similer example as Functor
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
3
diff
changeset
|
19 twicePlus :: Int -> Similer Int (Similer Int Int) |
66609010d477
Define Similer example as Functor
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
3
diff
changeset
|
20 twicePlus x = Similer x double (Similer (x + x) id $ x + x) |
66609010d477
Define Similer example as Functor
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
3
diff
changeset
|
21 |
66609010d477
Define Similer example as Functor
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
3
diff
changeset
|
22 plusTwo :: Int -> Similer Int (Similer Int Int) |
66609010d477
Define Similer example as Functor
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
3
diff
changeset
|
23 plusTwo x = Similer x double (Similer (x + 2) id (x + 2)) |
66609010d477
Define Similer example as Functor
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
3
diff
changeset
|
24 |
5
051c663a4af2
Rename some functions
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
4
diff
changeset
|
25 same :: Eq b => Similer a b -> b |
051c663a4af2
Rename some functions
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
4
diff
changeset
|
26 same (Similer x f y) = if (f x) == y then y else undefined |
6 | 27 |
28 | |
29 -- samples | |
30 | |
31 sameExample :: [Int] | |
32 sameExample = map same $ map (fmap same) $ fmap twicePlus [1..10] | |
33 | |
34 nonSameExample :: [Int] | |
35 nonSameExample = map same $ map (fmap same) $ fmap plusTwo [1..10] | |
36 | |
37 nonSameExampleSpecific :: [Int] | |
38 nonSameExampleSpecific = map same $ map (fmap same) $ fmap plusTwo [2] |