MENU

【代码札记】The Day I Learned Haskell 5

December 15, 2018 • Read: 85 • 瞎折腾

如期而至的周更,这次是Homework 4. 感觉这作业是越来越费脑子了,不过逐渐适应一种新思维模式的感觉很好,而且解出来的一瞬间也十分的有意思。

要求:你最终要提交一个单个的.hs(或.lhs)文件,并且文件必须经过类型检查。1

练习 1 全麦编程2

用一种在Haskell中更加完美的方式重新实现下面两个函数。实践全麦编程的思想,将每个程序分解为对整个数据结构的增量转换管道3。将你的函数分别命名为fun1'fun2'

fun1 :: [Integer] -> Integer
fun1 [] = 1
fun1 (x:xs)
    | even x    = (x - 2) * fun1 xs
    | otherwise = fun1 xs

fun2 :: Integer -> Integer
fun2 1 = 0
fun2 n | even n = n + fun2 (n `div` 2)
       | otherwise = fun2 (3 * n + 1)

提示:对于第二个函数你可能希望使用iteratetakeWhile函数。请查阅Prelude的文档来查看他们是干什么的。(此处就当各位查阅过文档,我就不做额外解释了。

我的解答

import Data.List

fun1' :: [Integer] -> Integer
fun1' = foldl' (*) 1 . map (\x -> x - 2) . filter even

fun2' :: Integer -> Integer
fun2' = sum . filter even . takeWhile (>0) . iterate helper
        where
            helper 1 = 0
            helper x = if even x then div x 2 else 3 * x + 1

一点解说:关于第一个函数,他做的事情是将给定列表中的所有偶数减去2再相乘。因此按照这个思路,先利用filter函数筛选出所有偶数,再使用map函数对列表中的所有偶数减去2,最后用foldl'(或者foldr也行)将所有的数乘起来。

这里需要特别说明map函数用的匿名函数。诸位可能和我一样一开始认为,例如map (+2) xsmap (*2) xs这样的语句中,括号里的的函数应该是Integer -> Integer类型的,而天真的我以为这里的减去2,也应当是类似(-2)这种表达,但是实际上这种表达意味着负2,而非减2,因此编译器会报出类型不匹配的错误。我的解决方案是使用匿名函数,而Haskell中也自带了一个函数来专门应对这种情况,即(subtract 2),或者为了求省事,直接写成(-2+)也是可以的。

关于第二个函数,需要诸位动手写一写画一画了。通过一些简单的代入,我们能够发现一些规律。例如代入一个奇数,那么下一次递归调用的参数一定是偶数(3乘以奇数还是奇数,再加1就是偶数了),因此如果偶数再调用过程中除成了奇数,那么最终还是会变成偶数,直到除成1为止。其中还应该注意到一点,只有偶数被加上去了。因此我这里利用iterate函数生成了符合上述规则的数列。第一个数就是传入的数字n,随后根据其奇偶性做出不同的操作,之后再对上一步的结果同样按照其奇偶性做出不同操作,如此反复,直到除成1。由于iterate函数生成一个无限长度的列表,因此需要使用takeWhile (>0)取出有用的部分。在这里数列最终收敛到0,因此我们遇到0就停止,毕竟后面的求和过程中有没有0都不影响结果的。

刚刚我们说了,只有偶数才被求和,因此对取出来的数列过遍筛子,留下偶数,随后一个sum求和,万事大吉。

练习 2 折叠树

回忆一下二叉树的定义。一个二叉树的高度是从根节点到最深的节点的路径的长度(换句话说就是从根节点到最底下,最多经过了多少层)。例如,一个单独的节点(左右都是叶子)高度是0;一个有两个子树的根节点的高度是1.我们说如果一个二叉树的左右子树的高度相差不超过1,则称这个二叉树平衡,由此他的左子树和右子树也平衡。

你应该使用下面的定义来表示二叉树。注意每个节点有一个额外的Integer来表示当前节点的高度。

data Tree a = Leaf
            | Node Integer (Tree a) a (Tree a)
        deriving (Show, Eq)

对于这个练习,写一个函数

foldTree :: [a] -> Tree a
foldTree = ...

它将使用foldr从一个列表产生一个平衡的二叉树。

举个例子:

foldTree "ABCDEFGHIJ" ==
    Node 3
        (Node 2
        (Node 0 Leaf 'F' Leaf) 
        'I'
        (Node 1 (Node 0 Leaf 'B' Leaf) 'C' Leaf)) 
    'J'
    (Node 2
        (Node 1 (Node 0 Leaf 'A' Leaf) 'G' Leaf) 
        'H'
        (Node 1 (Node 0 Leaf 'D' Leaf) 'E' Leaf))

结构图如下:

【图片】

你的答案不一定要将数据摆成一模一样的顺序,只要是个平衡的二叉树,且每个节点都正确的计算了高度就行。

我的解答

height :: Tree a -> Integer
height Leaf = 0
height (Node _ Leaf y Leaf) = 0
height (Node _ subL y subR) = 1 + max (height subL) (height subR)

insertTree :: a -> Tree a -> Tree a
insertTree x Leaf = Node 0 Leaf x Leaf
insertTree x (Node _ Leaf y subR) = Node (height (Node 0 (insertTree x Leaf) y subR)) (insertTree x Leaf) y subR
insertTree x (Node _ subL y Leaf) = Node (height (Node 0 subL y (insertTree x Leaf))) subL y (insertTree x Leaf)
insertTree x (Node _ subL y subR) 
    | height subL <= height subR = Node (height (Node 0 (insertTree x subL) y subR)) (insertTree x subL) y subR
    | otherwise      = Node (height (Node 0 subL y (insertTree x subR))) subL y (insertTree x subR)

foldTree :: [a] -> Tree a
foldTree = foldr insertTree Leaf

我的这个做法可能有点长,也不算最简洁,但是这确实是我能想到的最好的办法了。如果诸位有更好的主意,请务必在评论区中回复我,洗耳恭听。

首先height函数将按照题目中说的规则计算给定节点的高度。insertTree这个函数一会再说,先说foldTree,他说一定要使用foldr,一开始我没看到,后来才看到。使用这个函数就是相当于将列表中的每一项折叠出来,即foldr f z [x1, x2, ..., xn] == f x1 (f x2 ... (f xn z)...),换作树的话,相当于每次折叠,函数f将列表中的一个元素插入到已有的树中,而一开始的z,就是一个Leaf。而上面的insertTree,就是f。这个函数我写的有些复杂,但是我想不到化简的方法。

首先考虑的情况就是把元素插入到一个空的树里面,这也是递归调用的终止条件,即直接返回一个包含当前元素、高度为0的单个节点。随后在考虑左子树或右子树为Leaf的情况,这里不用额外说明两个都是Leaf的情况,此时优先匹配到左子树是Leaf的情况,按那种情况处理。因为不知道处理好的树有多高,因此将要生成的树丢进height函数计算一下高度,这个值作为返回的节点的高度,其中不一定是Node 0,这个的高度随便写,反正height函数不匹配这个参数。

之后就是两边都有树的情况了。如果左边的树比较矮,或者和右边的树一样高,那么默认是插到左边的树,否则查到右边的树里,这样不断递归,总会遇到有子节点是Leaf的树,再按照上面的情况处理就行了。

我觉得这个函数应该能够用fold来实现,本质上这是一种递归,而fold这一系列的函数就是为了处理递归而设计的,所以应该是可以用fold这些个函数实现的。不过我大概是没想到,同样还是想听听评论区是怎么说的,愿闻其详。

另解

因为一开始我没看到他说要用foldr那个要求,所以一开始我没用这个,写出的来倒是运行的挺好,后来用这个作为基准与fold版本的答案对比进行调试。代码如下:

foldTree :: [a] -> Tree a
foldTree [] = Leaf
foldTree [m] = Node 0 Leaf m Leaf
foldTree (x:xs) = Node deepth (sub1) x (sub2) 
    where 
        deepth = fromIntegral . length . takeWhile ( <  1 + length xs) . map helper $ [0..]
        helper 0 = 1
        helper n = 2^n + helper (n-1)
        sub1 = foldTree . map fst . filter (odd.snd) $ zip xs [1..]
        sub2 = foldTree . map fst . filter (even.snd) $ zip xs [1..]

从上往下看,首先如果是空列表,那么生成的自然就是Leaf节点,如果只有一个元素,那么就是个高度为0的单节点。遇到长度大于1的链表,那么就利用递归处理。

首先解释如何产生当前节点的高度:helper函数接收一个非负整数(负整数的情况没有处理,因为后面保证调用的参数是非负的),对应树的高度,返回值是该高度下最多能够有多少节点。例如高度为0的话就是单独的1个子节点;高度为2则是$ 2^2 $个高度为0的子节点,$ 2^1 $个高度为1的子节点和$2^0$个(1个)高度为2的根节点。利用map[0..](从0开始的无限长度的递增数列)的每一个参数传递进去,产生一个第$i$个元素是对应高度为$i$的树能够存储的节点数量。这时候再用takeWhile取所有小于当前传入函数的列表长度的项,例如当前传入的列表长度为5,那么提取到的就是[1,3];若传入的长度是8,则提取到的是[1,3,7]。对提取的列表求长度,就是对应这一个节点的高度。fromIntegral是将length函数返回的Int转换为Integer类型。

余下的操作就是将剩下的列表对半分开,分别调用两个递归产生左子树和右子树。这里我将余下的列表和[1..](从1开始的无限长度的递增数列)打包成了双元组列表。即假设余下的列表是[a,b,c,d],那么产生的就是[(a,1),(b,2),(c,3),(d,4)],随后用filter判断双元组的第二个元素的奇偶性,分别留下序号是奇数的和偶数的,这样就形成了两个平均的列表,交给递归就可以了。

练习 3 更多的折叠

1. 折叠实现xor

实现函数

xor :: [Bool] -> Bool

它只在输入的列表中有奇数个True时才返回True,与False的个数无关。例如:

xor [False, True, False] == True
xor [False, True, False, False, True] == False

你的答案应该使用fold

我的解答

xor :: [Bool] -> Bool
xor = foldr (\x y -> if x then not y else y) False

对于给定列表,初始值是False,对应匿名函数里面的y,如果列表里的元素(对应匿名函数中的x)是True,那么就将y取反,即奇数个True折叠后的效果相当于一次取反,即返回True,偶数个True折叠后相当于什么也没做,还是False。折叠过程中上一次的结果作为y传入匿名函数,这就算是实现了累加True

2. 用fold实现map

如题,完成如下定义:

map' :: (a -> b) -> [a] -> [b]
map' f = foldr ...

使得map'函数和标准的map函数功能相同。

我的解答

map' :: (a -> b) -> [a] -> [b]
map' f = foldr (\x xs -> [f x] ++ xs) [] 

foldr将初始的空列表或上一次折叠的结果绑定到匿名函数中的xs中,同时将列表中的元素绑定到x,将f应用到x上,将结果构成一个列表在和xs连接到一起,最终还是列表。由于foldr从右边开始求值,因此xs中是从后到前的结果,放在后面。这里其实可以用(f x) : xs代替,因为可以保证xs一定是列表。如果使用foldl,那么应该是xs ++ [f x],因为它是从左边求值,xs中保存的是从前往后的结果,应该放在前面。

3. (选做)用foldr实现foldl

如题,完成如下定义

myFoldl :: (a -> b -> a) -> a -> [b] -> a
myFoldl f base xs = foldr ...

myFoldl函数应该和标准的foldl函数功能一致。

提示:如下foldrfoldl的工作机制应当有所帮助:

foldr f z [x1, x2, ..., xn] == x1 'f' (x2 'f' ... (xn 'f' z)...)
foldl f z [x1, x2, ..., xn] == (...((z 'f' x1) 'f' x2) 'f'...) 'f' xn

我的解答

myFoldl :: (a -> b -> a) -> a -> [b] -> a
myFoldl f base xs = foldr (\x y -> f y x) base $ reverse xs

由于foldr是从后往前求值,即先折叠最后的元素,再折叠前面的,而foldl则正好相反,因此先对列表逆序,然后再使用foldr操作。需要注意的是foldrf应用的第一个参数是列表中的元素,第二个是上一次折叠的结果或初始值,而foldl正相反,第一个参数是初始值或折叠结果,第二个才是列表中的元素。因此使用了一个匿名函数调换了参数列表的顺序以适应f函数。

练习 4 寻找素数

阅读有关Sundaram筛的内容。使用函数组合的方法完成算法。给定整数$n$,你的函数返回值应该包含所有的小于等于$2n+2$的奇素数(不包括2的素数)。

sieveSundaram :: Integer -> [Integer]
sieveSundaram = ...

为了帮助你解题,下面的函数能够生成两个列表的笛卡儿积。这与zip类似,但是结果是两个列表中元素所有可能的组合。例如:

cartProd [1,2] ['a','b'] == [(1,'a'),(1,'b'),(2,'a'),(2,'b')]

这个函数使用了列表推导4,我们还没在课上讲过,但你不妨搜索一下他们。

cartProd :: [a] -> [b] -> [(a, b)]
cartProd xs ys = [(x,y) | x <- xs, y <- ys]

我的解答

sieveSundaram :: Integer -> [Integer]
sieveSundaram n = filter (\x -> x /= 0) $ map (\x -> if x `elem` rm then 0 else 2 * x + 1) [1..n]
                where
                    rm = map (\(x,y) -> x + y + 2 * x * y) $ cartProd [1..n] [1..n]

我这里没有按照题目给的形式实现,想了半天,不明确绑定参数n着实是想不出来怎么做。按照链接中的算法,应该有给定ij,对应所有的i + j + 2*i*j <= n, 1 <= i <= j都应该从[1..n]中剔除出去。而题目中提供的函数可以计算笛卡儿积,刚好就是我们要的所有的(i,j)组合。其中虽然不严格满足i <= j,但不满足的结果也就是导致计算i + j + 2*i*j会有重复项,并不影响最终结果。因此将得到的要剔除的数的列表记成rm。对[1..n]的每一个元素作如下操作 :判断该元素是不是需要剔除的(elem x rm),如果是就把这一项写成0,不是就将这个元素乘2加1得到对应的素数。最后将所有为0的项过滤掉,得到的就是所有的小于等于$ 2n+2 $的奇素数。

小结

上一次作业体验到了Haskell的简洁,这次则是感受到了Haskell的递归。之前也写过递归的作业,例如上一次作业Homework3,我也用上过递归,但是并没有使用fold封装,基本上都是一些简单的递归。这次作业尝试了使用fold,应该算是Haskell中对应递归的通用封装。感觉与方便的递归又是一个不一样的思考方式,要考虑如何将递归封装成一个函数交给fold处理,这又是一种挑战,也是一种乐趣。我觉得OK。


  1. 这句话的原文是:What to turn in: you should turn a single .hs (or .lhs) file, which must type check. 此处我没有搞懂后半句的意思。
  2. 原文: Wholemeal programming.
  3. 原文:... breaking each function into a pipeline of incremental transformations to an entire data structure.
  4. 原文:list comprehension.

知识共享许可协议
【代码札记】The Day I Learned Haskell 5天空 Blond 采用 知识共享 署名 - 非商业性使用 - 相同方式共享 4.0 国际 许可协议进行许可。
本许可协议授权之外的使用权限可以从 https://www.skyblond.info/about.html 处获得。

Tags: Haskell
最后编辑于: December 15, 2018 15:33
Archives QR Code Tip
QR Code for this page
Tipping QR Code
0:00