Mercurial > hg > Members > atton > delta_monad

comparison delta.hs @ 47:1aefea69f71b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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
comparison
equal deleted inserted replaced
46:cb5c190aa45d 47:1aefea69f71b
12 separator x y = if (max (length x) (length y)) > 50 then "|\n " else "|" 12 separator x y = if (max (length x) (length y)) > 50 then "|\n " else "|"
13 13
14 value :: (Delta a) -> a 14 value :: (Delta a) -> a
15 value (Delta _ x _ _) = x 15 value (Delta _ x _ _) = x
16 16
17 similar :: (Delta a) -> a 17 deltaLeft :: (Delta a) -> a
18 similar (Delta _ _ _ y) = y 18 deltaLeft (Delta _ x _ _) = x
19
20 deltaRight :: (Delta a) -> a
21 deltaRight (Delta _ _ _ y) = y
19 22
20 instance (Eq a) => Eq (Delta a) where 23 instance (Eq a) => Eq (Delta a) where
21 s == ss = (value s) == (value ss) 24 s == ss = (value s) == (value ss)
22 25
23 instance Functor Delta where 26 instance Functor Delta where
24 fmap f (Delta xs x ys y) = Delta xs (f x) ys (f y) 27 fmap f (Delta xs x ys y) = Delta xs (f x) ys (f y)
25 28
26 -- not proof 29 -- not proof
27 fmapS :: (Show a) => (a -> b) -> Delta a -> Delta b 30 fmapS :: (Show a) => (a -> b) -> Delta a -> Delta b
28 fmapS f (Delta lx x ly y) = Delta (lx ++ [(show x)]) (f x) (ly ++ [(show y)]) (f y) 31 fmapS f (Delta lx x ly y) = Delta (lx ++ [(show x)]) (f x) (ly ++ [(show y)]) (f y)
32
33 -- not proof
34 fmapSS :: (Show a) => (a -> b) -> (a -> b) -> Delta a -> Delta b
35 fmapSS f g (Delta lx x ly y) = Delta (lx ++ [(show x)]) (f x) (ly ++ [(show y)]) (g y)
29 36
30 instance Applicative Delta where 37 instance Applicative Delta where
31 pure f = Delta [] f [] f 38 pure f = Delta [] f [] f
32 (Delta lf f lg g) <*> (Delta lx x ly y) = Delta (lf ++ lx) (f x) (lg ++ ly) (g y) 39 (Delta lf f lg g) <*> (Delta lx x ly y) = Delta (lf ++ lx) (f x) (lg ++ ly) (g y)
33 40
62 69
63 primeCount :: Int -> Delta Int 70 primeCount :: Int -> Delta Int
64 primeCount x = generator x >>= primeFilter >>= count 71 primeCount x = generator x >>= primeFilter >>= count
65 72
66 bubbleSort :: [Int] -> Delta [Int] 73 bubbleSort :: [Int] -> Delta [Int]
67 bubbleSort [] = returnS [] 74 bubbleSort = rightReverse . bubbleSortDelta . returnS
68 bubbleSort xs = fmapS (\x -> (replicate maxNumCount maxNum) ++ x) (bubbleSort remainList) 75
76 bubbleSortDelta :: Delta [Int] -> Delta [Int]
77 bubbleSortDelta (Delta lx [] ly []) = (Delta lx [] ly [])
78 bubbleSortDelta xs = fmapSS (\x -> (replicate maxNumCount maxNum) ++ x)
79 (\y -> (replicate minNumCount minNum) ++ y)
80 (bubbleSortDelta $ fmapSS remainListMax remainListMin xs)
69 where 81 where
70 maxNum = maximum xs 82 leftValue = deltaLeft xs
71 remainList = filter (/= maxNum) xs 83 rightValue = deltaRight xs
72 maxNumCount = (length xs) - (length remainList) 84 maxNum = maximum leftValue
85 minNum = minimum rightValue
86 remainListMax = filter (/= maxNum)
87 remainListMin = filter (/= minNum)
88 maxNumCount = (length leftValue) - (length $ remainListMax leftValue)
89 minNumCount = (length rightValue) - (length $ remainListMin rightValue)
73 90
91
92 rightReverse :: Delta [Int] -> Delta [Int]
93 rightReverse d = fmapSS id reverse d