如期而至的周更，这次是 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)
提示：对于第二个函数你可能希望使用 iterate 和 takeWhile 函数。请查阅 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) xs 和 map (*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 函数功能一致。
提示：如下 foldr 和 foldl 的工作机制应当有所帮助：
- 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 操作。需要注意的是 foldr 将 f 应用的第一个参数是列表中的元素，第二个是上一次折叠的结果或初始值，而 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 着实是想不出来怎么做。按照链接中的算法，应该有给定 i 和 j，对应所有的 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。
【代码札记】The Day I Learned Haskell 5 由 天空 Blond 采用 知识共享 署名 - 非商业性使用 - 相同方式共享 4.0 国际 许可协议进行许可。
本许可协议授权之外的使用权限可以从 https://skyblond.info/about.html 处获得。