集合的实现

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]]
-}

©著作权归作者所有,转载或内容合作请联系作者
  • 序言:七十年代末,一起剥皮案震惊了整个滨河市,随后出现的几起案子,更是在滨河造成了极大的恐慌,老刑警刘岩,带你破解...
    沈念sama阅读 212,884评论 6 492
  • 序言:滨河连续发生了三起死亡事件,死亡现场离奇诡异,居然都是意外死亡,警方通过查阅死者的电脑和手机,发现死者居然都...
    沈念sama阅读 90,755评论 3 385
  • 文/潘晓璐 我一进店门,熙熙楼的掌柜王于贵愁眉苦脸地迎上来,“玉大人,你说我怎么就摊上这事。” “怎么了?”我有些...
    开封第一讲书人阅读 158,369评论 0 348
  • 文/不坏的土叔 我叫张陵,是天一观的道长。 经常有香客问我,道长,这世上最难降的妖魔是什么? 我笑而不...
    开封第一讲书人阅读 56,799评论 1 285
  • 正文 为了忘掉前任,我火速办了婚礼,结果婚礼上,老公的妹妹穿的比我还像新娘。我一直安慰自己,他们只是感情好,可当我...
    茶点故事阅读 65,910评论 6 386
  • 文/花漫 我一把揭开白布。 她就那样静静地躺着,像睡着了一般。 火红的嫁衣衬着肌肤如雪。 梳的纹丝不乱的头发上,一...
    开封第一讲书人阅读 50,096评论 1 291
  • 那天,我揣着相机与录音,去河边找鬼。 笑死,一个胖子当着我的面吹牛,可吹牛的内容都是我干的。 我是一名探鬼主播,决...
    沈念sama阅读 39,159评论 3 411
  • 文/苍兰香墨 我猛地睁开眼,长吁一口气:“原来是场噩梦啊……” “哼!你这毒妇竟也来了?” 一声冷哼从身侧响起,我...
    开封第一讲书人阅读 37,917评论 0 268
  • 序言:老挝万荣一对情侣失踪,失踪者是张志新(化名)和其女友刘颖,没想到半个月后,有当地人在树林里发现了一具尸体,经...
    沈念sama阅读 44,360评论 1 303
  • 正文 独居荒郊野岭守林人离奇死亡,尸身上长有42处带血的脓包…… 初始之章·张勋 以下内容为张勋视角 年9月15日...
    茶点故事阅读 36,673评论 2 327
  • 正文 我和宋清朗相恋三年,在试婚纱的时候发现自己被绿了。 大学时的朋友给我发了我未婚夫和他白月光在一起吃饭的照片。...
    茶点故事阅读 38,814评论 1 341
  • 序言:一个原本活蹦乱跳的男人离奇死亡,死状恐怖,灵堂内的尸体忽然破棺而出,到底是诈尸还是另有隐情,我是刑警宁泽,带...
    沈念sama阅读 34,509评论 4 334
  • 正文 年R本政府宣布,位于F岛的核电站,受9级特大地震影响,放射性物质发生泄漏。R本人自食恶果不足惜,却给世界环境...
    茶点故事阅读 40,156评论 3 317
  • 文/蒙蒙 一、第九天 我趴在偏房一处隐蔽的房顶上张望。 院中可真热闹,春花似锦、人声如沸。这庄子的主人今日做“春日...
    开封第一讲书人阅读 30,882评论 0 21
  • 文/苍兰香墨 我抬头看了看天上的太阳。三九已至,却和暖如春,着一层夹袄步出监牢的瞬间,已是汗流浃背。 一阵脚步声响...
    开封第一讲书人阅读 32,123评论 1 267
  • 我被黑心中介骗来泰国打工, 没想到刚下飞机就差点儿被人妖公主榨干…… 1. 我叫王不留,地道东北人。 一个月前我还...
    沈念sama阅读 46,641评论 2 362
  • 正文 我出身青楼,却偏偏与公主长得像,于是被迫代替她去往敌国和亲。 传闻我的和亲对象是个残疾皇子,可洞房花烛夜当晚...
    茶点故事阅读 43,728评论 2 351

推荐阅读更多精彩内容