changeset 82:1339772b2e36

Define DeltaM. Delta with Monad
author Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
date Sun, 04 Jan 2015 16:31:17 +0900
parents 47317adefa16
children 6635a513f81a
files delta.hs
diffstat 1 files changed, 48 insertions(+), 2 deletions(-) [+]
line wrap: on
line diff
--- a/delta.hs	Sun Jan 04 16:30:17 2015 +0900
+++ b/delta.hs	Sun Jan 04 16:31:17 2015 +0900
@@ -48,8 +48,6 @@
     return x = Mono x
     d >>= f  = mu $ fmap f d
 
-
-
 -- utils
 
 returnS :: (Show s) => s -> Delta s
@@ -89,3 +87,51 @@
         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
+
+headDeltaM :: DeltaM m a -> m a
+headDeltaM (DeltaM (Mono x))     = x
+headDeltaM (DeltaM (Delta x _ )) = x
+
+tailDeltaM :: DeltaM m a -> DeltaM m a
+tailDeltaM d@(DeltaM (Mono _))    = d
+tailDeltaM   (DeltaM (Delta _ d)) = DeltaM d
+
+appendDeltaM :: DeltaM m a -> DeltaM m a -> DeltaM m a
+appendDeltaM (DeltaM d) (DeltaM dd) = DeltaM (deltaAppend d dd)
+
+
+-- 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))
+
+instance (Monad m) => Monad (DeltaM m) where
+    return x                   = DeltaM $ Mono $ return x
+    (DeltaM (Mono x))    >>= f = DeltaM $ Mono $ (x >>= headDeltaM . f)
+    (DeltaM (Delta x d)) >>= f = appendDeltaM ((DeltaM $ Mono x) >>= f)
+                                              ((DeltaM d) >>= tailDeltaM . f)
+
+
+-- DeltaM examples
+
+val :: DeltaM [] Int
+val = DeltaM $ deltaFromList [[10, 20], [1, 2, 3], [100,200,300], [0]]
+
+func :: Int -> DeltaM [] Int
+func x = DeltaM $ deltaFromList [[x+1, x+2, x+3],
+                                 [x*x],
+                                 [x, x, x, x]]