6.5 其他資料結構
既然串列與自然數都有摺，其他的資料結構也可以有。
二元樹 回顧我們提及的兩種常見二元樹：
data ITree a = Null | Node a (ITree a) (ITree a)
data ETree a = Tip a | Bin (ETree a) (ETree a)
其中 ITree 的摺可定義如下：
foldIT :: (a -> b -> b -> b) -> b -> ITree a -> b
foldIT f e Null = e
foldIT f e (Node x t u) = f x (foldIT f e t) (foldIT f e u)
內標記二元樹 ITree 的兩個建構元之型別分別為 Null :: ITree a 與 Node :: a -> ITree a -> ITree a -> ITree a. 和串列的摺一樣，內標記二元樹的摺將一個 ITree a 轉成一個型別為 b 的值 --- 藉由將 Null 代換為基底值 e :: b, 以及將 Node 代換為步驟函數 f :: a -> b -> b -> b.
外標記二元樹的摺則可定義如下：
foldET :: (b -> b -> b) -> (a -> b) -> ETree a -> b
foldET f k (Tip x) = k x
foldET f k (Bin t u) = f (foldET f k t) (foldET f k u)
型別 ETree 的建構元分別為 Tip :: a -> ETree a 和 Bin :: ETree a -> ETree a -> ETree a.
由於 Tip 是一個由 a 到 ETree a 的函數，取代它的得是一個型別為 a -> b 的基底函數.
取代 Bin 的步驟函數之型別則為 b -> b -> b. 有了這兩者，我們便可將 ETree a 轉換為 b.
例如，第2.8 節中曾提到幾個定義在樹之上的函數：tags 傳回一個 ITree 的所有標記；size 傳回其大小；minE 傳回一個 ETree 的最小元素，mapE f 對樹中的每個標記做 f. 它們都可用摺定義：
tags = foldIT (\x xs ys -> xs ++ [x] ++ ys) []
size = foldIT (\x m n -> 1 + m + n) 0
minE = foldET min id
mapE f = foldET Bin f
兩個二元樹的摺也有它們的融合定理：
定理 6.20 摺融合定理(|ITree|版)
給定 f :: a -> b -> b -> b, e :: b, h :: b -> c, 與 g :: a -> c -> c -> c.
如果融合條件 h (f x y z) = g x (h y) (h z) 對任何 x :: a 與在 foldIT f e 值域中的 y, z :: b 成立，
我們有 h . foldIT f e = foldIT g (h e).
定理 6.21 摺融合定理(|ETree|版)
給定 f :: b -> b -> b, k :: a -> b, h :: b -> c, 與 g :: c -> c -> c.
如果融合條件 h (f x y) = g (h x) (h y) 對任何在 foldET f k 值域中的 x, y :: b 成立，我們有
h . foldET f k = foldET g (h . k).
兩個定理的融合條件都依循著與串列版相同的原則：當 h 與步驟函數碰在一起，融合條件讓我們將 h 往裡推。
兩個定理都可用單純的歸納法證明。
練習 6.13
以摺融合定理證明 length (tags t) = size t.
答案
即證明 length . tags = size.
回顧 tags = foldIT (\x xs ys -> xs ++ [x] ++ ys) []
使用摺融合，由於 length [] = 0 以及
length (xs ++ [x] ++ ys) = 1 + length xs + length ys,
我們得到 length . tags = foldIT (\x m n -> 1 + m + n) 0 = size.
練習 6.14
串列有 foldr-map 融合定理(6.4 )，ETree 也有類似的 foldET-mapE 融合定理。請寫出該定理並證明之。
答案
ETree 上的 foldET-mapE 融合定理為：
foldET f k . mapE g = foldET f (k . g)
由於 mapE g = foldET Bin f, 欲證明上式可用摺融合定理。
其融合條件 foldET f k (Bin t u) = f (foldET f k t) (foldET f k u) 恰巧是 foldET 之定義。
練習 6.15
函數 mapI :: (a -> b) -> ITree a -> ITree b 將一個 a -> b 的函數作用在 ITree 的每一個標記上。
請用 foldIT 定義 mapI, 並寫下 foldIT 與 mapI 的融合定理並證明之。
答案
函數 mapI 可定義如下：
mapI f = foldIT (\x t u -> Node (f x) t u) Null
考慮 foldIT f e . mapI g 之融合。其基底值為 foldIT f e Null = e.
步驟函數的推導如下：
foldIT f e (Node (g x) t u)
=== {- foldIT 之定義 -}
f (g x) (foldIT f e t) (foldIT f e u)
因此 foldIT f e . mapI g = foldIT (\x y z -> f (g x) y z) e.
練習 6.16
以摺融合定理證明 minE (mapE (x +) t) = x + minE t.
答案
即證明 minE . mapE (x+) = (x+) . minE.
推論如下：
minE . mapE (x+)
=== {- foldET-mapE 融合，見習題 6.14 -}
foldET min (id . (x+))
=== {- foldET 融合，如下述 -}
(x+) . minE
融合的基底函數為 id . (x+) = (x+) . id,
融合條件則為 x + (y ↓ z) = (x + y) ↓ (x + z)。
練習 6.17
將 (++) . tags 融合，以便推導出一個在線性時間內收集 ITree 內所有標籤的演算法。
答案
回想 tags = foldIT (\x xs ys -> xs ++ [x] ++ ys) [].
融合後之基底值為 (++) [] = id.
融合後之步驟函數 step 須滿足
(++) (xs ++ [x] ++ ys) = step x (xs++) (ys++).
但由於左手邊的 (++) 還需一個參數才能化簡，我們在左右兩邊各補上一個參數 zs.
演算如下：
(++) (xs ++ [x] ++ ys) zs
=== (xs ++ [x] ++ ys) ++ zs
=== {- (++) 之遞移律 -}
xs ++ (x : (ys ++ zs))
=== {- (.) 之定義 -}
((xs++) . (x:) . (ys++)) zs
因此我們得到 (++) . tags = foldIT (\x f g -> f . (x:) . g) id.
非空串列
第2.10 節中曾提及我們可把至少有一個元素的串列想像成一個資料結構：data ListP a = [a] | a : ListP a. 此種串列的摺可定義為：
foldrn :: (a -> b -> b) -> (a -> b) -> ListP a -> b
foldrn f k [x] = k x
foldrn f k (x:xs) = f x (foldrn f k xs)
例 6.22
例2.13 中的 partsP 可以寫成
partsP :: ListP a -> List (ListP (ListP a))
partsP = foldrn (\x -> concat . map (extend x)) wrap3
where extend x (ys:yss) = [[x]:ys:yss, (x:ys):yss]
wrap3 x = [[[x]]]
我們考慮一個定義在非空串列上的簡單演算法推導練習。
其次，這也將是一個使用 foldrn 與「引入脈絡」的例子，
下述函數 ascending :: ListP Int -> Bool 判斷一個串列是否為遞增：
ascending [x] = True
ascending (x:y:xs) = x <= y ⋀ ascending (y:xs)
給定一個整數串列，如何將它切成一個個區段，使得每個區段都是遞增的？
如果我們讓每個元素都自己成一段，似乎是滿足需求，但這沒什麼意思。
我們希望讓遞增區段盡量連續，也就是說，我們要區段數目最少的分割法。
下述函數 upHills 將輸入串列以最精簡的方式切成段：
upHills :: List Int -> List (List Int)
upHills = shortest . filter (all ascending) . partsP
其中 partsP 把串列任意切段，filter (all ascending) 挑出每個區段都是遞增的分割法，而 shortest 挑選元素數目最少的串列。
我們能由此導出一個比較快的演算法嗎？
我們先將 filter (all ascending) 融入 partsP 之中。
經過一些稍繁瑣但原則上並不困難的計算，我們可得：
filter (all ascending) . partsP ===
foldrn (\x -> concat . map (extendAsc x)) wrap3
這和 partsP 的差別只在 extend 變成了 extendAsc. 後者的定義為：
extendAsc x (ys:yss) = if x >= head ys then [[x]:ys:yss, (x:ys):yss]
else [[x]:ys:yss]
函數 extendAsc 比 extend 多做了一個檢查，只在 x >= head ys 時將 (x:ys):yss 列為一個可能選項。
注意：由於 ys 的型別是 ListP Int, head 一定可成功。
如果我們使用 List Int, 在這裡就得多做些條件判斷。
雖然每個非空串列 ListP 都可用 List 表達, 有些問題使用 ListP 描述時會比較便於證明與推論。
接著我們試圖融合 shortest 與 filter (all ascending) . partsP.
基底函數為 (shortest . wrap3) x = shortest [[[x]]] = [[x]].
至於步驟函數，我們希望找到滿足下述融合條件的 step:
shortest (concat (map (extendAsc x) ysss)) === step x (shortest ysss)
由左手邊開始，由於 shortest 可分配進 concat （意即 shortest . concat = shortest . map shortest），我們可推論：
shortest (concat (map (extendAsc x) ysss))
=== {- shortest 分配進 concat; map 融合 -}
shortest (map (shortest . extendAsc x) ysss)
為了有些進展，我們看看 shortest . extendAsc x 能如何化簡。
將輸入（非空串列）寫成 ys : yss:
shortest (extendAsc x (ys:yss)) =
=== {- extend' 之定義; 提出 if -}
if x >= head ys then shortest [[x]:ys:yss, (x:ys):yss]
else shortest [[x]:ys:yss]
=== {- shortest 挑選較短之串列 -}
if x >= head ys then (x:ys):yss else [x]:ys:yss
因此，融合條件的左手邊可歸約如下：
shortest (map (shortest . extendAsc x) ysss)
=== {- 前述推導 -}
shortest (map (\(ys:yss) -> if x >= head ys then (x:ys):yss
else [x]:ys:yss) ysss)
我們希望繼續將 shortest 往裡推，但此時似乎卡住了。
shortest (map (\(ys:yss) -> if x >= head (head (head ysss)) then (x:ys):yss
else [x]:ys:yss) ysss)
=== shortest ( if x >= head (head (head ysss))
then map (\(ys:yss) -> (x:ys):yss) ysss
else map (\(ys:yss) -> [x]:ys:yss) ysss)
=== if x >= head (head (head ysss))
then shortest (map (\(ys:yss) -> (x:ys):yss) ysss)
else shortest (map (\(ys:yss) -> [x]:ys:yss) ysss)
=== if x >= head (head (head ysss))
then (\(ys:yss) -> (x:ys):yss) (shortest ysss)
else (\(ys:yss) -> [x]:ys:yss) (shortest ysss)
=== let (ys:yss) = shortest ysss
in if x >= head ys
then (x:ys):yss else [x]:ys:yss
upHills = foldrn step (\x -> [[x]])
where step x (ys:yss) = if x >= head ys then (x:ys):yss
else [x]:ys:yss
練習 6.18
將 filter (all ascending) . partsP 融合為 foldrn (\x -> concat . map (extendAsc x)) wrap3, 並在過程中推導 extendAsc 的定義。
您可能用得上習題6.6 提及的性質：
如果 filter p (f x) = if p x then g x else [], 則 concat . map (filter p . f) = concat . map g . filter p.
答案
基底函數為 filter (all ascending) . wrap3 = wrap3.
為求出步驟函數，我們推論：
filter (all ascending) (concat (map (extend x) ysss))
=== {- filter p . concat = concat . map (filter p), map 融合 -}
concat (map (filter (all ascending) . extend x) ysss)
=== {- 推導 extendAsc, 如下述 -}
concat (map (extendAsc x) (filter (all ascending) ysss))
欲使得最後一步成立，我們使用習題6.6 中的性質，
試圖找到滿足下述條件的 extendAsc：
filter (all ascending) (extend x yss) =
if all ascending yss then extendAsc x yss else []
我們演算如下：
filter (all ascending) (extend x (ys:yss))
=== filter (all ascending) [[x]:ys:yss, (x:ys):yss]
=== {- filter 之定義; 因 ascending [x] = True -}
if all ascending (ys:yss) then
([x]:ys:yss) : filter (all ascending) [(x:ys):yss]
else filter (all ascending) [(x:ys):yss]
=== {- filter 與 ascending 之定義；重安排 if 的幾個分支 -}
if all ascending (ys:yss) then
if x >= head ys then [[x]:ys:yss, (x:ys):yss]
else [[x]:ys:yss]
else []
=== {- 抽取出 extendAsc 如下 -}
if all ascending (ys:yss) then extend' x (ys:yss) else []
其中 extendAsc 的定義如下：
extendAsc x (ys:yss) = if x >= head ys then [[x]:ys:yss, (x:ys):yss]
else [[x]:ys:yss]