Mercurial > hg > Members > atton > delta_monad

comparison delta.hs @ 49:d654fdecdcd0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Wrote bubble sort with modified calculate
author Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
date Mon, 17 Nov 2014 10:23:38 +0900
parents 820af7cc8485
children 8d9c55bac8b2
comparison
equal deleted inserted replaced
48:820af7cc8485 49:d654fdecdcd0
24 s == ss = (value s) == (value ss) 24 s == ss = (value s) == (value ss)
25 25
26 instance Functor Delta where 26 instance Functor Delta where
27 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)
28 28
29 -- not proof
30 fmapS :: (Show a) => (a -> b) -> Delta a -> Delta b
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)
36
37 instance Applicative Delta where 29 instance Applicative Delta where
38 pure f = Delta [] f [] f 30 pure f = Delta [] f [] f
39 (Delta lf f lg g) <*> (Delta lx x ly y) = Delta (lf ++ lx) (f x) (lg ++ ly) (g y) 31 (Delta lf f lg g) <*> (Delta lx x ly y) = Delta (lf ++ lx) (f x) (lg ++ ly) (g y)
40 32
41 mu :: Delta (Delta a) -> Delta a 33 mu :: Delta (Delta a) -> Delta a
42 mu (Delta lx (Delta llx x _ _) ly (Delta _ _ lly y)) = Delta (lx ++ llx) x (ly ++ lly) y 34 mu (Delta lx (Delta llx x _ _) ly (Delta _ _ lly y)) = Delta (lx ++ llx) x (ly ++ lly) y
43 35
70 primeCount :: Int -> Delta Int 62 primeCount :: Int -> Delta Int
71 primeCount x = generator x >>= primeFilter >>= count 63 primeCount x = generator x >>= primeFilter >>= count
72 64
73 bubbleSort :: [Int] -> Delta [Int] 65 bubbleSort :: [Int] -> Delta [Int]
74 bubbleSort [] = returnS [] 66 bubbleSort [] = returnS []
75 bubbleSort xs = bubbleSort remainValue >>= (\xs -> returnS $ sortedValue : xs) 67 bubbleSort xs = bubbleSort remainValue >>= (\xs -> returnSS (sortedValueL : xs)
68 (sortedValueR ++ xs))
76 where 69 where
77 sortedValue = maximum xs 70 maxmumValue = maximum xs
78 remainValue = filter (/= sortedValue) xs 71 sortedValueL = maxmumValue
72 sortedValueR = replicate (length $ filter (== maxmumValue) xs) maxmumValue
73 remainValue = filter (/= maxmumValue) xs