Mercurial > hg > Members > atton > delta_monad

changeset 141:3bbb68f0a1e3

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
case-sensitive collision resolve : Rename delta.hs -> Delta.hs
author Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
date Sun, 15 Feb 2015 17:34:52 +0900
parents 7984c9f4b5eb
children f241d521bf65
files haskell/Delta.hs haskell/delta.hs
diffstat 2 files changed, 177 insertions(+), 177 deletions(-) [+]
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/haskell/Delta.hs	Sun Feb 15 17:34:52 2015 +0900
@@ -0,0 +1,177 @@
+import Control.Applicative
+import Control.Monad.Writer
+import Data.Numbers.Primes -- $ cabal install primes
+
+-- Delta definition
+
+data Delta a = Mono a | Delta a (Delta a) deriving Show
+
+instance (Eq a) => Eq (Delta a) where
+    (Mono x) == (Mono y)         = x == y
+    (Mono _) == (Delta _ _)      = False
+    (Delta x xs) == (Delta y ys) = (x == y) && (xs == ys)
+
+-- basic functions
+
+deltaAppend :: Delta a -> Delta a -> Delta a
+deltaAppend (Mono x) d     = Delta x d
+deltaAppend (Delta x d) ds = Delta x (deltaAppend d ds)
+
+headDelta :: Delta a -> a
+headDelta (Mono  x)   = x
+headDelta (Delta x _) = x
+
+tailDelta :: Delta a -> Delta a
+tailDelta d@(Mono _)   = d
+tailDelta (Delta _ ds) = ds
+
+-- instance definitions
+
+instance Functor Delta where
+    fmap f (Mono x)    = Mono  (f x)
+    fmap f (Delta x d) = Delta (f x) (fmap f d)
+
+instance Applicative Delta where
+    pure f                       = Mono  f
+    (Mono f)     <*> (Mono x)    = Mono  (f x)
+    df@(Mono f)  <*> (Delta x d) = Delta (f x) (df <*> d)
+    (Delta f df) <*> d@(Mono x)  = Delta (f x) (df <*> d)
+    (Delta f df) <*> (Delta x d) = Delta (f x) (df <*> d)
+
+bind :: (Delta a) -> (a -> Delta b) -> (Delta b)
+bind (Mono x)    f = f x
+bind (Delta x d) f = Delta (headDelta (f x)) (bind d (tailDelta . f))
+
+mu :: (Delta (Delta a)) -> (Delta a)
+mu d = bind d id
+
+instance Monad Delta where
+    return x = Mono x
+    d >>= f  = mu $ fmap f d
+
+-- utils
+
+returnDD :: (Show s) => s -> s -> Delta s
+returnDD x y = (return x) `deltaAppend` (return y)
+
+deltaFromList :: [a] -> Delta a
+deltaFromList = (foldl1 deltaAppend) . (fmap return)
+
+
+-- samples
+
+generator :: Int -> Delta [Int]
+generator x = let intList = [1..x] in
+                  return intList
+
+primeFilter :: [Int] -> Delta [Int]
+primeFilter xs = let primeList    = filter isPrime xs
+                     refactorList = filter even xs    in
+                 returnDD primeList refactorList
+
+count :: [Int] -> Delta Int
+count xs = let primeCount = length xs in
+           return primeCount
+
+primeCount :: Int -> Delta Int
+primeCount x = generator x >>= primeFilter >>= count
+
+bubbleSort :: [Int] -> Delta [Int]
+bubbleSort [] = return []
+bubbleSort xs = bubbleSort remainValue >>= (\xs -> returnDD (sortedValueL : xs)
+                                                            (sortedValueR ++ xs))
+    where
+        maximumValue = maximum xs
+        sortedValueL = maximumValue
+        sortedValueR = replicate (length $ filter (== maximumValue) xs) maximumValue
+        remainValue  = filter (/= maximumValue) xs
+
+
+
+-- DeltaM definition (Delta with Monad)
+
+data DeltaM m a = DeltaM (Delta (m a)) deriving (Show)
+
+
+-- DeltaM utils
+
+unDeltaM :: DeltaM m a -> Delta (m a)
+unDeltaM (DeltaM d) = d
+
+headDeltaM :: DeltaM m a -> m a
+headDeltaM (DeltaM d) = headDelta d
+
+tailDeltaM :: DeltaM m a -> DeltaM m a
+tailDeltaM (DeltaM d) = DeltaM $ tailDelta d
+
+appendDeltaM :: DeltaM m a -> DeltaM m a -> DeltaM m a
+appendDeltaM (DeltaM d) (DeltaM dd) = DeltaM (deltaAppend d dd)
+
+checkOut :: Int -> DeltaM m a -> m a
+checkOut 0 (DeltaM (Mono x))    = x
+checkOut 0 (DeltaM (Delta x _)) = x
+checkOut n (DeltaM (Mono x))    = x
+checkOut n (DeltaM (Delta _ d)) = checkOut (n-1) (DeltaM d)
+
+
+-- DeltaM instance definitions
+
+instance (Functor m) => Functor (DeltaM m) where
+    fmap f (DeltaM d) = DeltaM $ fmap (fmap f) d
+
+instance (Applicative m) => Applicative (DeltaM m) where
+    pure f                                          = DeltaM $ Mono $ pure f
+    (DeltaM (Mono f))     <*> (DeltaM (Mono x))     = DeltaM $ Mono $ f <*> x
+    df@(DeltaM (Mono f))  <*> (DeltaM (Delta x d))  = appendDeltaM (DeltaM $ Mono $ f <*> x) (df <*> (DeltaM d))
+    (DeltaM (Delta f df)) <*> dx@(DeltaM (Mono x))  = appendDeltaM (DeltaM $ Mono $ f <*> x) ((DeltaM df) <*> dx)
+    (DeltaM (Delta f df)) <*> (DeltaM (Delta x dx)) = appendDeltaM (DeltaM $ Mono $ f <*> x) ((DeltaM df) <*> (DeltaM dx))
+
+
+mu' :: (Functor m, Monad m) => DeltaM m (DeltaM m a) -> DeltaM m a
+mu' d@(DeltaM (Mono _))    = DeltaM $ Mono $ (>>= id) $ fmap headDeltaM $ headDeltaM d
+mu' d@(DeltaM (Delta _ _)) = DeltaM $ Delta ((>>= id) $ fmap headDeltaM $ headDeltaM d)
+                                            (unDeltaM (mu' (fmap tailDeltaM (tailDeltaM d))))
+
+instance (Functor m, Monad m) => Monad (DeltaM m) where
+    return x = DeltaM $ Mono $ return x
+    d >>= f  = mu' $ fmap f d
+
+
+
+-- DeltaM examples
+
+-- DeltaM example utils
+type DeltaLog     = Writer [String]
+type DeltaWithLog = DeltaM DeltaLog
+
+returnW :: (Show a) => a -> DeltaLog a
+returnW x = do tell $ [show x]
+               return x
+
+dmap :: (m a -> b) -> DeltaM m a -> Delta b
+dmap f (DeltaM d) = fmap f d
+
+deltaWithLogFromList :: (Show a) => [a] -> DeltaWithLog a
+deltaWithLogFromList xs = DeltaM $ deltaFromList $ fmap returnW xs
+
+
+-- example : prime filter
+-- usage   : runWriter $ checkOut 0 $ primeCountM 30  -- run specific version
+--         : dmap runWriter $ primeCountM 30          -- run all version
+
+generatorM :: Int -> DeltaWithLog [Int]
+generatorM x = let intList = [1..x] in
+                             DeltaM $ deltaFromList $ fmap returnW $ replicate 2 intList
+
+primeFilterM :: [Int] -> DeltaWithLog [Int]
+primeFilterM xs = let primeList    = filter isPrime xs
+                      refactorList = filter even xs    in
+                      DeltaM $ deltaFromList $ fmap returnW [primeList, refactorList]
+
+
+countM :: [Int] -> DeltaWithLog Int
+countM xs = let primeCount = length xs in
+                DeltaM $ deltaFromList $ fmap returnW $ replicate 2 primeCount
+
+primeCountM :: Int -> DeltaWithLog Int
+primeCountM x = generatorM x >>= primeFilterM >>= countM
--- a/haskell/delta.hs	Fri Feb 06 16:00:09 2015 +0900
+++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
@@ -1,177 +0,0 @@
-import Control.Applicative
-import Control.Monad.Writer
-import Data.Numbers.Primes -- $ cabal install primes
-
--- Delta definition
-
-data Delta a = Mono a | Delta a (Delta a) deriving Show
-
-instance (Eq a) => Eq (Delta a) where
-    (Mono x) == (Mono y)         = x == y
-    (Mono _) == (Delta _ _)      = False
-    (Delta x xs) == (Delta y ys) = (x == y) && (xs == ys)
-
--- basic functions
-
-deltaAppend :: Delta a -> Delta a -> Delta a
-deltaAppend (Mono x) d     = Delta x d
-deltaAppend (Delta x d) ds = Delta x (deltaAppend d ds)
-
-headDelta :: Delta a -> a
-headDelta (Mono  x)   = x
-headDelta (Delta x _) = x
-
-tailDelta :: Delta a -> Delta a
-tailDelta d@(Mono _)   = d
-tailDelta (Delta _ ds) = ds
-
--- instance definitions
-
-instance Functor Delta where
-    fmap f (Mono x)    = Mono  (f x)
-    fmap f (Delta x d) = Delta (f x) (fmap f d)
-
-instance Applicative Delta where
-    pure f                       = Mono  f
-    (Mono f)     <*> (Mono x)    = Mono  (f x)
-    df@(Mono f)  <*> (Delta x d) = Delta (f x) (df <*> d)
-    (Delta f df) <*> d@(Mono x)  = Delta (f x) (df <*> d)
-    (Delta f df) <*> (Delta x d) = Delta (f x) (df <*> d)
-
-bind :: (Delta a) -> (a -> Delta b) -> (Delta b)
-bind (Mono x)    f = f x
-bind (Delta x d) f = Delta (headDelta (f x)) (bind d (tailDelta . f))
-
-mu :: (Delta (Delta a)) -> (Delta a)
-mu d = bind d id
-
-instance Monad Delta where
-    return x = Mono x
-    d >>= f  = mu $ fmap f d
-
--- utils
-
-returnDD :: (Show s) => s -> s -> Delta s
-returnDD x y = (return x) `deltaAppend` (return y)
-
-deltaFromList :: [a] -> Delta a
-deltaFromList = (foldl1 deltaAppend) . (fmap return)
-
-
--- samples
-
-generator :: Int -> Delta [Int]
-generator x = let intList = [1..x] in
-                  return intList
-
-primeFilter :: [Int] -> Delta [Int]
-primeFilter xs = let primeList    = filter isPrime xs
-                     refactorList = filter even xs    in
-                 returnDD primeList refactorList
-
-count :: [Int] -> Delta Int
-count xs = let primeCount = length xs in
-           return primeCount
-
-primeCount :: Int -> Delta Int
-primeCount x = generator x >>= primeFilter >>= count
-
-bubbleSort :: [Int] -> Delta [Int]
-bubbleSort [] = return []
-bubbleSort xs = bubbleSort remainValue >>= (\xs -> returnDD (sortedValueL : xs)
-                                                            (sortedValueR ++ xs))
-    where
-        maximumValue = maximum xs
-        sortedValueL = maximumValue
-        sortedValueR = replicate (length $ filter (== maximumValue) xs) maximumValue
-        remainValue  = filter (/= maximumValue) xs
-
-
-
--- DeltaM definition (Delta with Monad)
-
-data DeltaM m a = DeltaM (Delta (m a)) deriving (Show)
-
-
--- DeltaM utils
-
-unDeltaM :: DeltaM m a -> Delta (m a)
-unDeltaM (DeltaM d) = d
-
-headDeltaM :: DeltaM m a -> m a
-headDeltaM (DeltaM d) = headDelta d
-
-tailDeltaM :: DeltaM m a -> DeltaM m a
-tailDeltaM (DeltaM d) = DeltaM $ tailDelta d
-
-appendDeltaM :: DeltaM m a -> DeltaM m a -> DeltaM m a
-appendDeltaM (DeltaM d) (DeltaM dd) = DeltaM (deltaAppend d dd)
-
-checkOut :: Int -> DeltaM m a -> m a
-checkOut 0 (DeltaM (Mono x))    = x
-checkOut 0 (DeltaM (Delta x _)) = x
-checkOut n (DeltaM (Mono x))    = x
-checkOut n (DeltaM (Delta _ d)) = checkOut (n-1) (DeltaM d)
-
-
--- DeltaM instance definitions
-
-instance (Functor m) => Functor (DeltaM m) where
-    fmap f (DeltaM d) = DeltaM $ fmap (fmap f) d
-
-instance (Applicative m) => Applicative (DeltaM m) where
-    pure f                                          = DeltaM $ Mono $ pure f
-    (DeltaM (Mono f))     <*> (DeltaM (Mono x))     = DeltaM $ Mono $ f <*> x
-    df@(DeltaM (Mono f))  <*> (DeltaM (Delta x d))  = appendDeltaM (DeltaM $ Mono $ f <*> x) (df <*> (DeltaM d))
-    (DeltaM (Delta f df)) <*> dx@(DeltaM (Mono x))  = appendDeltaM (DeltaM $ Mono $ f <*> x) ((DeltaM df) <*> dx)
-    (DeltaM (Delta f df)) <*> (DeltaM (Delta x dx)) = appendDeltaM (DeltaM $ Mono $ f <*> x) ((DeltaM df) <*> (DeltaM dx))
-
-
-mu' :: (Functor m, Monad m) => DeltaM m (DeltaM m a) -> DeltaM m a
-mu' d@(DeltaM (Mono _))    = DeltaM $ Mono $ (>>= id) $ fmap headDeltaM $ headDeltaM d
-mu' d@(DeltaM (Delta _ _)) = DeltaM $ Delta ((>>= id) $ fmap headDeltaM $ headDeltaM d)
-                                            (unDeltaM (mu' (fmap tailDeltaM (tailDeltaM d))))
-
-instance (Functor m, Monad m) => Monad (DeltaM m) where
-    return x = DeltaM $ Mono $ return x
-    d >>= f  = mu' $ fmap f d
-
-
-
--- DeltaM examples
-
--- DeltaM example utils
-type DeltaLog     = Writer [String]
-type DeltaWithLog = DeltaM DeltaLog
-
-returnW :: (Show a) => a -> DeltaLog a
-returnW x = do tell $ [show x]
-               return x
-
-dmap :: (m a -> b) -> DeltaM m a -> Delta b
-dmap f (DeltaM d) = fmap f d
-
-deltaWithLogFromList :: (Show a) => [a] -> DeltaWithLog a
-deltaWithLogFromList xs = DeltaM $ deltaFromList $ fmap returnW xs
-
-
--- example : prime filter
--- usage   : runWriter $ checkOut 0 $ primeCountM 30  -- run specific version
---         : dmap runWriter $ primeCountM 30          -- run all version
-
-generatorM :: Int -> DeltaWithLog [Int]
-generatorM x = let intList = [1..x] in
-                             DeltaM $ deltaFromList $ fmap returnW $ replicate 2 intList
-
-primeFilterM :: [Int] -> DeltaWithLog [Int]
-primeFilterM xs = let primeList    = filter isPrime xs
-                      refactorList = filter even xs    in
-                      DeltaM $ deltaFromList $ fmap returnW [primeList, refactorList]
-
-
-countM :: [Int] -> DeltaWithLog Int
-countM xs = let primeCount = length xs in
-                DeltaM $ deltaFromList $ fmap returnW $ replicate 2 primeCount
-
-primeCountM :: Int -> DeltaWithLog Int
-primeCountM x = generatorM x >>= primeFilterM >>= countM