Mercurial > hg > Members > atton > delta_monad
annotate delta.hs @ 47:1aefea69f71b
Implement bubble sort by delta
author | Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp> |
---|---|
date | Tue, 11 Nov 2014 14:01:31 +0900 |
parents | cb5c190aa45d |
children | 820af7cc8485 |
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 |
44
6e270dfe2bb9
Define pretty-print for Delta
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
43
diff
changeset
|
4 data Delta a = Delta [String] a [String] a |
6e270dfe2bb9
Define pretty-print for Delta
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
43
diff
changeset
|
5 |
6e270dfe2bb9
Define pretty-print for Delta
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
43
diff
changeset
|
6 instance (Show a) => Show (Delta a) where |
6e270dfe2bb9
Define pretty-print for Delta
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
43
diff
changeset
|
7 show (Delta lx x ly y) = values ++ logs |
6e270dfe2bb9
Define pretty-print for Delta
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
43
diff
changeset
|
8 where |
6e270dfe2bb9
Define pretty-print for Delta
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
43
diff
changeset
|
9 values = "Delta {" ++ (show x) ++ "|" ++ (show y) ++ "}\n" |
45 | 10 logs = concat . reverse $ zipWith formatter lx ly |
11 formatter x y = " {" ++ x ++ (separator x y) ++ y ++ "}\n" | |
44
6e270dfe2bb9
Define pretty-print for Delta
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
43
diff
changeset
|
12 separator x y = if (max (length x) (length y)) > 50 then "|\n " else "|" |
17
279ebcf670c4
Define Similar as Applicative
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
16
diff
changeset
|
13 |
43
90b171e3a73e
Rename to Delta from Similar
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
23
diff
changeset
|
14 value :: (Delta a) -> a |
90b171e3a73e
Rename to Delta from Similar
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
23
diff
changeset
|
15 value (Delta _ x _ _) = x |
21
af8754322ed4
Define Similar sample
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
20
diff
changeset
|
16 |
47
1aefea69f71b
Implement bubble sort by delta
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
46
diff
changeset
|
17 deltaLeft :: (Delta a) -> a |
1aefea69f71b
Implement bubble sort by delta
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
46
diff
changeset
|
18 deltaLeft (Delta _ x _ _) = x |
1aefea69f71b
Implement bubble sort by delta
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
46
diff
changeset
|
19 |
1aefea69f71b
Implement bubble sort by delta
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
46
diff
changeset
|
20 deltaRight :: (Delta a) -> a |
1aefea69f71b
Implement bubble sort by delta
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
46
diff
changeset
|
21 deltaRight (Delta _ _ _ y) = y |
14
116131b196bb
Define fmap and mu
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
13
diff
changeset
|
22 |
43
90b171e3a73e
Rename to Delta from Similar
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
23
diff
changeset
|
23 instance (Eq a) => Eq (Delta a) where |
19
003b6e58d815
Define Similar as Monad by mu
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
18
diff
changeset
|
24 s == ss = (value s) == (value ss) |
18
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
25 |
43
90b171e3a73e
Rename to Delta from Similar
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
23
diff
changeset
|
26 instance Functor Delta where |
90b171e3a73e
Rename to Delta from Similar
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
23
diff
changeset
|
27 fmap f (Delta xs x ys y) = Delta xs (f x) ys (f y) |
18
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
28 |
46
cb5c190aa45d
Define bubble sort
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
45
diff
changeset
|
29 -- not proof |
cb5c190aa45d
Define bubble sort
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
45
diff
changeset
|
30 fmapS :: (Show a) => (a -> b) -> Delta a -> Delta b |
cb5c190aa45d
Define bubble sort
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
45
diff
changeset
|
31 fmapS f (Delta lx x ly y) = Delta (lx ++ [(show x)]) (f x) (ly ++ [(show y)]) (f y) |
cb5c190aa45d
Define bubble sort
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
45
diff
changeset
|
32 |
47
1aefea69f71b
Implement bubble sort by delta
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
46
diff
changeset
|
33 -- not proof |
1aefea69f71b
Implement bubble sort by delta
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
46
diff
changeset
|
34 fmapSS :: (Show a) => (a -> b) -> (a -> b) -> Delta a -> Delta b |
1aefea69f71b
Implement bubble sort by delta
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
46
diff
changeset
|
35 fmapSS f g (Delta lx x ly y) = Delta (lx ++ [(show x)]) (f x) (ly ++ [(show y)]) (g y) |
1aefea69f71b
Implement bubble sort by delta
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
46
diff
changeset
|
36 |
43
90b171e3a73e
Rename to Delta from Similar
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
23
diff
changeset
|
37 instance Applicative Delta where |
90b171e3a73e
Rename to Delta from Similar
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
23
diff
changeset
|
38 pure f = Delta [] f [] f |
90b171e3a73e
Rename to Delta from Similar
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
23
diff
changeset
|
39 (Delta lf f lg g) <*> (Delta lx x ly y) = Delta (lf ++ lx) (f x) (lg ++ ly) (g y) |
20
d4aa70d94352
Define Similar as Applicative
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
19
diff
changeset
|
40 |
43
90b171e3a73e
Rename to Delta from Similar
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
23
diff
changeset
|
41 mu :: Delta (Delta a) -> Delta a |
90b171e3a73e
Rename to Delta from Similar
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
23
diff
changeset
|
42 mu (Delta lx (Delta llx x _ _) ly (Delta _ _ lly y)) = Delta (lx ++ llx) x (ly ++ lly) y |
18
c77397d0677f
Try define Similar as Monad
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
17
diff
changeset
|
43 |
43
90b171e3a73e
Rename to Delta from Similar
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
23
diff
changeset
|
44 instance Monad Delta where |
90b171e3a73e
Rename to Delta from Similar
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
23
diff
changeset
|
45 return x = Delta [] x [] x |
22
f0400c4c953f
Imporve Similar definition. delete "Single" constructor
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
21
diff
changeset
|
46 s >>= f = mu $ fmap f s |
18
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 |
43
90b171e3a73e
Rename to Delta from Similar
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
23
diff
changeset
|
49 returnS :: (Show s) => s -> Delta s |
90b171e3a73e
Rename to Delta from Similar
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
23
diff
changeset
|
50 returnS x = Delta [(show x)] x [(show x)] x |
0
7a82a5e50499
Initial commit. define to Functor for Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
diff
changeset
|
51 |
43
90b171e3a73e
Rename to Delta from Similar
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
23
diff
changeset
|
52 returnSS :: (Show s) => s -> s -> Delta s |
90b171e3a73e
Rename to Delta from Similar
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
23
diff
changeset
|
53 returnSS x y = Delta [(show x)] x [(show y)] y |
23
b4d3960af901
Define similar constructor for different element
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
22
diff
changeset
|
54 |
16
4b315cf0edb9
Improve mu definition
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
15
diff
changeset
|
55 -- samples |
3
3c5fbce357af
Define >>= for Similer
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
2
diff
changeset
|
56 |
43
90b171e3a73e
Rename to Delta from Similar
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
23
diff
changeset
|
57 generator :: Int -> Delta [Int] |
21
af8754322ed4
Define Similar sample
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
20
diff
changeset
|
58 generator x = let intList = [1..x] in |
22
f0400c4c953f
Imporve Similar definition. delete "Single" constructor
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
21
diff
changeset
|
59 returnS intList |
6 | 60 |
43
90b171e3a73e
Rename to Delta from Similar
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
23
diff
changeset
|
61 primeFilter :: [Int] -> Delta [Int] |
21
af8754322ed4
Define Similar sample
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
20
diff
changeset
|
62 primeFilter xs = let primeList = filter isPrime xs |
23
b4d3960af901
Define similar constructor for different element
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
22
diff
changeset
|
63 refactorList = filter even xs in |
b4d3960af901
Define similar constructor for different element
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
22
diff
changeset
|
64 returnSS primeList refactorList |
11
e8a5df54480e
Define sample for Monad style
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
10
diff
changeset
|
65 |
43
90b171e3a73e
Rename to Delta from Similar
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
23
diff
changeset
|
66 count :: [Int] -> Delta Int |
21
af8754322ed4
Define Similar sample
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
20
diff
changeset
|
67 count xs = let primeCount = length xs in |
22
f0400c4c953f
Imporve Similar definition. delete "Single" constructor
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
21
diff
changeset
|
68 returnS primeCount |
15 | 69 |
43
90b171e3a73e
Rename to Delta from Similar
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
23
diff
changeset
|
70 primeCount :: Int -> Delta Int |
21
af8754322ed4
Define Similar sample
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
20
diff
changeset
|
71 primeCount x = generator x >>= primeFilter >>= count |
46
cb5c190aa45d
Define bubble sort
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
45
diff
changeset
|
72 |
cb5c190aa45d
Define bubble sort
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
45
diff
changeset
|
73 bubbleSort :: [Int] -> Delta [Int] |
47
1aefea69f71b
Implement bubble sort by delta
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
46
diff
changeset
|
74 bubbleSort = rightReverse . bubbleSortDelta . returnS |
1aefea69f71b
Implement bubble sort by delta
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
46
diff
changeset
|
75 |
1aefea69f71b
Implement bubble sort by delta
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
46
diff
changeset
|
76 bubbleSortDelta :: Delta [Int] -> Delta [Int] |
1aefea69f71b
Implement bubble sort by delta
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
46
diff
changeset
|
77 bubbleSortDelta (Delta lx [] ly []) = (Delta lx [] ly []) |
1aefea69f71b
Implement bubble sort by delta
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
46
diff
changeset
|
78 bubbleSortDelta xs = fmapSS (\x -> (replicate maxNumCount maxNum) ++ x) |
1aefea69f71b
Implement bubble sort by delta
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
46
diff
changeset
|
79 (\y -> (replicate minNumCount minNum) ++ y) |
1aefea69f71b
Implement bubble sort by delta
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
46
diff
changeset
|
80 (bubbleSortDelta $ fmapSS remainListMax remainListMin xs) |
46
cb5c190aa45d
Define bubble sort
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
45
diff
changeset
|
81 where |
47
1aefea69f71b
Implement bubble sort by delta
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
46
diff
changeset
|
82 leftValue = deltaLeft xs |
1aefea69f71b
Implement bubble sort by delta
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
46
diff
changeset
|
83 rightValue = deltaRight xs |
1aefea69f71b
Implement bubble sort by delta
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
46
diff
changeset
|
84 maxNum = maximum leftValue |
1aefea69f71b
Implement bubble sort by delta
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
46
diff
changeset
|
85 minNum = minimum rightValue |
1aefea69f71b
Implement bubble sort by delta
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
46
diff
changeset
|
86 remainListMax = filter (/= maxNum) |
1aefea69f71b
Implement bubble sort by delta
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
46
diff
changeset
|
87 remainListMin = filter (/= minNum) |
1aefea69f71b
Implement bubble sort by delta
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
46
diff
changeset
|
88 maxNumCount = (length leftValue) - (length $ remainListMax leftValue) |
1aefea69f71b
Implement bubble sort by delta
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
46
diff
changeset
|
89 minNumCount = (length rightValue) - (length $ remainListMin rightValue) |
46
cb5c190aa45d
Define bubble sort
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
45
diff
changeset
|
90 |
47
1aefea69f71b
Implement bubble sort by delta
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
46
diff
changeset
|
91 |
1aefea69f71b
Implement bubble sort by delta
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
46
diff
changeset
|
92 rightReverse :: Delta [Int] -> Delta [Int] |
1aefea69f71b
Implement bubble sort by delta
Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
parents:
46
diff
changeset
|
93 rightReverse d = fmapSS id reverse d |