如期而至的周更，这次是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 处获得。