Mercurial > hg > Members > atton > delta_monad
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]]