集合的实现

data Listr a = Nilr | Cons a  (Listr a) deriving Show
data Listl a = Nill | Snoc (Listl a) a  deriving Show

-- 从Snoc转换到Cons格式

convert Nill = Nilr
convert (Snoc xs x) = snocr (convert xs, x)
snocr (Nilr, x) = Cons x Nilr
snocr (Cons x xs, y) = Cons x $ snocr (xs, y)
{-
ghci> let a = Snoc (Snoc (Snoc Nill  2)  1)  3
ghci> convert a
Cons 2 (Cons 1 (Cons 3 Nilr))
ghci> 
-}

--针对Listr的filter

listmap f Nilr = Nilr
listmap f (Cons a xs) = Cons (f a) (listmap f xs)

--针对Cons结构

listfoldr (c,h) Nilr = c
listfoldr (c,h) (Cons x xs) = h x (listfoldr (c, h) xs)

listcat :: Listr a -> Listr a -> Listr a
listcat Nilr ys = ys
listcat (Cons a xs) ys = Cons a (listcat xs ys)

listConcat = listfoldr (Nilr,listcat)

listfilter p = listConcat.listmap (\x -> if p x then (Cons x Nilr) else Nilr)

{-
ghci> let m = Cons 2 (Cons 1 (Cons 8 Nilr))
ghci> listfilter (>9) m
Nilr
ghci> listfilter (>2) m
Cons 8 Nilr
ghci> listfilter (>1) m
Cons 2 (Cons 8 Nilr)
ghci> 
-}

过滤函数

listfilter' p = listfoldr (Nilr, \a x  -> if p a then Cons a x else x)

---

lenCons = listfoldr (0, h) where h a n = n+1
{-
ghci> let m = Cons 2 (Cons 1 (Cons 8 Nilr))
ghci> lenCons m
3
-}
--更加简洁的写法
listmap' f xs = listfoldr (Nilr, h) xs where h a x = Cons (f a) x

{-
对于整数列表，sum和product可以如下实现
sumCons = listfoldr (0, (+))
productCons = listfoldr (1, (*))
-}
-------------------------------------------------------------------------做一个例子
listfoldl c h Nill = c
listfoldl c h (Snoc xs x) = h (listfoldl c h xs) x

eval before after = listfoldl 0 f before + listfoldr(0, g) after
f n d = n*10 + d
g e r = (e+r)/ (fromInteger 10)
{-
ghci> eval (Snoc (Snoc Nill 4) 2) (Cons 3 (Cons 1 Nilr))
42.31
-}
--------------------------------------------------------------继续
reverser = listfoldr (Nilr ,appendr)
appendr a x = snocr (x, a)
{-
ghci> let m = Cons 2 (Cons 1 (Cons 8 Nilr))
ghci> reverser m
Cons 8 (Cons 1 (Cons 2 Nilr))
-}

---

data Tree a = Tip a | Bin (Tree a) (Tree a) deriving (Show)

foldt f g (Tip a) = f a
foldt f g (Bin a b) = g (foldt f g a) (foldt f g b)

mapt f = foldt (Tip . f) Bin
{-
ghci> let a = Bin (Tip 0) (Bin (Tip 1) (Tip 2))
ghci> mapt (+1) a
Bin (Tip 1) (Bin (Tip 2) (Tip 3))
ghci>
-}

size = foldt (\x -> 1) (+)
{-
ghci> let a = Bin (Tip 0) (Bin (Tip 1) (Tip 2))
ghci> size a
3
ghci>
-}
maxdepth (Tip _) = 1
maxdepth (Bin left right) = 1 + max (maxdepth left) (maxdepth right)
{-
ghci> let a = Bin (Tip 0) (Bin (Tip 1) (Tip 2))
ghci> maxdepth a
3
ghci>
-}
---------------------------------------------------------------带森林结构
data Tree2 a = Fork a (Forest2 a)
data Forest2 a = NullForest | Grow (Tree2 a) (Forest2 a)

foldTree2T g c h (Fork a xs) = g a (foldTree2F g c h xs)
foldTree2F g c h NullForest = c
foldTree2F g c h (Grow x xs) = h (foldTree2T g c h x) (foldTree2F g c h xs)

sizeTree2 = foldTree2T (_ y -> y+1) 0 (+)

{-

ghci> let a = Fork 3 (Grow (Fork 4 NullForest) (Grow (Fork 5 NullForest) NullForest) )
ghci> sizeTree2 a
3
ghci>

-}
---------------------------------------------------------------zip
ziplistr Nilr _ = Nilr
ziplistr _ Nilr = Nilr
ziplistr (Cons x xs) (Cons y ys) = Cons (x,y) (ziplistr xs ys)
{-
ghci> let m = Cons 2 (Cons 1 (Cons 8 Nilr))
ghci> let n = Cons 2 (Cons 1 (Cons 8 Nilr))
ghci> ziplistr m n
Cons (2,2) (Cons (1,1) (Cons (8,8) Nilr))
-}
unziplistr1 = pair (listmap fst, listmap snd) where pair (f, g) xs = (f xs, g xs)
{-
ghci> unziplistr1 Cons (2,2) (Cons (1,1) (Cons (8,8) Nilr)) (Cons 2 (Cons 1 (Cons 8 Nilr)),Cons 2 (Cons 1 (Cons 8 Nilr))) -} unziplistr2 = listfoldr ((Nilr, Nilr), conss) where conss (a, b) (x,y) = (Cons a x , Cons b y) {- ghci> unziplistr2 Cons (2,2) (Cons (1,1) (Cons (8,8) Nilr))
(Cons 2 (Cons 1 (Cons 8 Nilr)),Cons 2 (Cons 1 (Cons 8 Nilr)))
-}

-------------------------------------------------------------------------多态恒等性
{-
ghci> let a = map (+2) (concat [[2],[3],[4]])
ghci> let b = concat.map (map (+2)) $ [[2],[3],[4]]
ghci> a
[4,5,6]
ghci> b
[4,5,6]
ghci>
-}

{-
ghci> Data.List.inits [1,2,3]
[[],[1],[1,2],[1,2,3]]
ghci>
-}

my_inits = listfoldl (Snoc Nill Nill) ff where ff (Snoc xs x) a = Snoc (Snoc xs x) (Snoc x a)
{-
ghci> my_inits $ Snoc (Snoc Nill 3) 2 --[3,2]
Snoc (Snoc (Snoc Nill Nill) (Snoc Nill 3)) (Snoc (Snoc Nill 3) 2) -- [[],[3],[3,2]]
-}