### changeset 18:c77397d0677f

author Yasutaka Higa Mon, 22 Sep 2014 21:04:32 +0900 279ebcf670c4 003b6e58d815 similar.hs 1 files changed, 53 insertions(+), 10 deletions(-) [+]
line wrap: on
line diff
```--- a/similar.hs	Tue Sep 09 16:21:22 2014 +0900
+++ b/similar.hs	Mon Sep 22 21:04:32 2014 +0900
@@ -1,17 +1,63 @@
import Control.Applicative
+import Data.Numbers.Primes -- \$ cabal install primes
+
+data Similar a = Single [String] a | Similar [String] a [String] a deriving (Show)

-data Similar a = Single a | Similar a (Similar a) deriving (Show)
+original :: (Similar a) -> Similar a
+original (Similar xs x _ _) = Single xs x
+original s                  = s
+
+similar :: (Similar a) -> Similar a
+similar (Similar _ _ ys y) = Single ys y
+similar s                  = s
+
+mergeSimilar :: Similar a -> Similar a -> Similar a
+mergeSimilar (Single xs x) (Single ys y) = Similar xs x ys y

instance (Eq a) => Eq (Similar a) where
-    s == ss = (same s) == (same ss)
+    s == ss = (original s) == (original ss)
+
+instance Functor Similar where
+    fmap f (Single xs x)       = Single  xs (f x)
+    fmap f (Similar xs x ys y) = Similar xs (f x) ys (f y)
+
+similarLogAppend :: [String] -> Similar a -> Similar a
+similarLogAppend ls (Single xs x)       = Single  (ls ++ xs) x
+similarLogAppend ls (Similar xs x ys y) = Similar (ls ++ xs) x (ls ++ ys) y
+
+
+    return                    = Single []
+    (Single  xs x)      >>= f = similarLogAppend xs (original (f x))
+    (Similar xs x ys y) >>= f = mergeSimilar (similarLogAppend xs (original (f x))) (similarLogAppend ys (similar (f y)))
+
+
+{-
+

+
+-- samples
+{-
+
+generator :: Int -> Similar [Int]
+generator x = return [1..x]
+
+primeFilter :: [Int] -> Similar [Int]
+primeFilter xs = return \$ filter isPrime xs
+
+count :: [Int] -> Similar Int
+count xs = return \$ length xs
+
+primeCount :: Int -> Int
+primeCount x = value \$ generator x >>= primeFilter >>= count
+-}
+
+
+{-
same :: (Eq a) => Similar a -> a
same (Single x)    = x
same (Similar x s) = if x == (same s) then x else (error "same")

-value :: Similar a -> a
-value (Single x)    = x
-value (Similar x s) = value s

similar :: Similar a -> Similar a -> Similar a
similar (Single x) ss    = Similar x ss
@@ -30,10 +76,6 @@
mu (Single s)     = s
mu (Similar s ss) = similar s (mu ss)