Mercurial > hg > Members > atton > delta_monad

comparison similer.hs @ 8:6e0285628ead

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Define similer function
author Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
date Tue, 02 Sep 2014 11:27:49 +0900
parents 5e367a167382
children 41c71f67c103
comparison
equal deleted inserted replaced
7:d30e40d5b5cf 8:6e0285628ead
11 eta a = Similer a id a 11 eta a = Similer a id a
12 12
13 mu :: (Eq b) => Similer a (Similer b c) -> Similer b c 13 mu :: (Eq b) => Similer a (Similer b c) -> Similer b c
14 mu (Similer a f b) = if (eq (f a) b) then b else undefined 14 mu (Similer a f b) = if (eq (f a) b) then b else undefined
15 15
16 double :: Int -> Similer Int Int 16 double :: Int -> Int
17 double x = Similer (2 * x) id (2 * x) 17 double x = (2 * x)
18 18
19 twicePlus :: Int -> Similer Int (Similer Int Int) 19 twicePlus :: Int -> Int
20 twicePlus x = Similer x double (Similer (x + x) id $ x + x) 20 twicePlus x = x + x
21 21
22 plusTwo :: Int -> Similer Int (Similer Int Int) 22 plusTwo :: Int -> Int
23 plusTwo x = Similer x double (Similer (x + 2) id (x + 2)) 23 plusTwo x = x + 2
24 24
25 same :: Eq b => Similer a b -> b 25 same :: Eq b => Similer a b -> b
26 same (Similer x f y) = if (f x) == y then y else undefined 26 same (Similer x f y) = if (f x) == y then y else undefined
27 27
28 similer :: Eq b => (a -> b) -> (a -> b) -> a -> b
29 similer f g x = same $ Similer x g (f x)
30
28 31
29 -- samples 32 -- samples
30 33 sameExample = map (similer twicePlus double) [1..10]
31 sameExample :: [Int] 34 nonSameExample = map (similer twicePlus plusTwo) [1..10]
32 sameExample = map same $ map (fmap same) $ fmap twicePlus [1..10] 35 nonSameExampleSpecific = map (similer twicePlus plusTwo) [2]
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]