5.3 用展開-收回轉換增進效率

在前面的例子中，我們手動推導出的 sumsq 只比原來的版本快了一點點，並沒有複雜度上的改進。 本節我們來看一些使用程式推導改進複雜度的例子。

5.3.1 計算多項式 -- Horner 法則

給定整數串列 $\mathit{as} = [a_0, a_1, a_2 \ldots a_n]$ 以及 x :: Int, 我們想計算如下的多項式：

    a_0 + a_1 x + a_2 x^2 + ... + a_n x^n 

這問題的規格能清楚寫成：

poly x as = sum (zipWith (*) as (iterate (* x) 1)) 

其中 iterate (* x) 1 產生無限串列 $[1, x, x^2, x^3 ...]$, zipWith 計算 $[a_0, a_1 x, \ldots a_n x^n]$, sum 計算總和。

讀者應已對 sum 和 zipWith 很熟悉了。函數 iterate 在第 1.8.2 節中使用過，iterate f x 會展開為無限長的串列 [x, f x, f (f x)...]，每個元素分別是把 f 使用0次、1次、2次... 的結果。 函數 iterate 可定義為

iterate :: (a -> a) -> a -> List a
iterate f x = x : map f (iterate f x) 

我們可將之理解成：iterate f x 的第一個元素是 x；剩下的元素呢？是把 iterate f x 本身拿來，對每個元素多做一次 f!

讀到此的讀者可能有些疑問：這是一個合法的歸納定義嗎？以及，我們原已說定不談無限的資料結構，何以在此卻出現了呢？

上述 iterate 的定義方式確實不是歸納，而是「餘歸納」(coinduction)的一個例子。 第2.9 節中曾提及，餘歸納與歸納互為對偶，以餘歸納定義出的資料結構稱作「餘資料」，可以是能無限地展開的。 「餘串列」和歸納定義的串列應該視為不同的型別，但它們可共存於同一個程式中，只要我們確定不在餘資料上做歸納定義或證明。

為培養一些對 iterate 的直覺，我們試著展開它：

  iterate f x
=   {- iterate 之定義 -}
  x : map f (iterate f x)
=   {- map 之定義 -}
  x : map f (x : map f (iterate f x))
=   {- map 融合 -}
  x : f x : map (f . f) (iterate f x)
=   {- iterate 與 map 之定義 -}
  x : f x : f (f x) : map (f . f) (map f (iterate f x))
=   {- map 融合 -}
  x : f x : f (f x) : map (f . f . f) (iterate f x)

可發現越展開，式子中便累積越多個 map f.

在 poly 之中，iterate 雖產生無限長的餘資料，但立刻被 zipWith 截短了。 (註2) 此處我們假設 as 為有限長的串列，並把 zipWith 視為在其第一個參數之上的歸納定義。 若我們試著展開 poly x [a,b,c,d], 會得到：

   poly x [a,b,c,d]
=  sum (zipWith (*) [a,b,c,d] (iterate (* x) 1))
=    {- 展開 iterate, 將「f自我組合四次」記為 quad f -}
   sum (zipWith (*) [a,b,c,d]
     (1 : (1*x) : (1*x*x) : (1*x*x*x) : map (quad (*x)) (iterate (*x) 1)))
=  a  +  b *x  +  c * x * x  +  d * x * x * x 

可看到式子越長，便累積越多個 (*x)。當 as 長度為 n, 需要的乘法數目為 $O(n^2)$. 我們有可能降低做乘法的次數嗎？

我們試著找出 poly 在 as 上的歸納定義。 當 as := [] 時，poly x [] 可歸約為 0. 考慮 as := a:as 的情況，和做證明時一樣，我們先將 poly x (a:as) 展開，然後試著整理出 sum (zipWith (*) as (iterate (* x) 1)，以便收回成為 poly x as。 計算中的每一步都以此為目的，試著將 sum 與 zipWith 移動至 iterate 旁邊:

      poly x (a : as)
 ===   {- poly 的定義 -}
      sum (zipWith (*) (a:as) (iterate (* x) 1))
 ===   {- iterate 的定義 -}
      sum (zipWith (*) (a:as) (1 : map (* x) (iterate (* x) 1)))
 ===   {- zipWith 與 sum 的定義 -}
      a + sum (zipWith (*) as (map (* x) (iterate (* x) 1)))
 ===   {- zipWith (*) as . map (* x) = map (* x) . zipWith (*) as，見習題 -}
      a + sum (map (* x) (zipWith (*) as (iterate (* x) 1)))
 ===   {- sum . map (* x) = (* x) . sum -}
      a + (sum (zipWith (*) as (iterate (* x) 1))) * x
 ===   {- poly 的定義 -}
      a + (poly x as) * x 

第 4 步中關於 zipWith 與 map 的性質幫助我們將 map (*x) 往外提、將 zipWith 往裡推。事實上，該性質不限於乘法，而可適用於任何滿足結合律的運算子 otimes。我們可非正式地理解如下：

   zipWith otimes [a,b,c] (map (⊗ x) [d,e,f])
=  [a ⊗ (d ⊗ x), b ⊗ (e ⊗ x), c ⊗ (f ⊗ x)]
=    {- 結合律: m ⊗ (n ⊗ k) = (m ⊗ n) ⊗ k -}
   [(a ⊗ d) ⊗ x, (b ⊗ e) ⊗ x, (c ⊗ f) ⊗ x]
=  map (⊗ x) (zipWith otimes [a,b,c] [d,e,f]) 

第 5 步之中的 sum . map (* x) = (* x) . sum 在習題2.7 中證明過，需要乘法與加法的分配律。 在本推導中，它的功能是將 sum 往右推。 它也是使 poly 可以加速的關鍵性質：共同的 (*x) 可以提出來 --- 左手邊可能做了的許多次 (*x) 其實只需做一次。 追根究底，poly 之所以能算得更快，都歸功於乘法與加法的分配律。 經過上述計算，我們可得：

poly x []        = 0
poly x (a : as)  = a + (poly as) * x 

在這個定義中，函數 poly 遞迴多少次，便做多少個乘法。 因此本演算法所需的乘法數目為 $O(n)$.

快速版本的函數 poly 相當於把 $a_0 + a_1 x + a_2 x^2 + ... + a_n x^n$ 轉換成

    a_0 + x \times (a_1 + x \times (a_2 + ... + (a_{n-1} + x \times a_n)))

這條規則在 William George Horner 1819 年的一篇論文中出現並證明，因此通常被稱作 Horner 法則， 雖然 Horner 本人和許多歷史學家們都相信該規則可被追溯得更早。

      zipWith otimes (a:as) (map (⊗ x) (b:bs))
 ===    {- zipWith 與 map 之定義 -}
      (a ⊗ (b ⊗ x)) : zipWith otimes as (map (⊗ x) bs)
 ===    {- 歸納假設 -}
      (a ⊗ (b ⊗ x)) : map (⊗ x) (zipWith otimes as bs)
 ===    {- otimes 滿足結合律 -}
      ((a ⊗ b) ⊗ x) : map (⊗ x) (zipWith otimes as bs)
 ===    {- zipWith 與 map 之定義 -}
      map (⊗ x) (zipWith otimes (a:as) (b:bs)) 

5.3.2 二進位表示法

回顧第2.2 節中的函數 exp。該函數計算乘冪 --- $|exp b n| = b^n$，其定義如下:

exp :: Nat -> Nat -> Nat
exp b Zero     = 1
exp b (Suc n)  = b *: exp b n 

以這個演算法計算 $b^n$ 時會需要 $O(n)$ 個乘法。是否有更快的做法呢？

我們先定義函數 binary :: Nat -> List Bool，可將一個自然數轉換成反轉的二進位表示法（即最低有效位在左邊，最高有效位在右邊）。以下我們將 False 簡寫為 ff, True 簡寫為 tt：

binary 0  = []
binary n  | even n  = ff : binary (n `div` 2)
          | odd n   = tt : binary (n `div` 2) 

例如，map binary [1,2,3,4] = [[tt], [ff,tt], [tt,tt], [ff,ff,tt]]. 函數 binary 在每次遞迴呼叫時將參數減半，因此 binary n 只需要 $O(\log n)$ 的時間。 我們讓 binary 傳回反轉的二進位數是為了方便定義 decimal :: List Bool -> Nat --- binary 的反函數，將 binary 的結果轉回成原有的數字：

decimal []      = 0
decimal (c:cs)  = if c then 1 + 2 * decimal cs else 2 * decimal cs 

我們可證明 decimal . binary = id.

回到 exp, 試計算如下

   exp b
=    {- id 為 (.) 的單位元 -}
   exp b . id
=    {- decimal . binary = id -}
   exp b . decimal . binary 

由於 binary n 只需 $O(\log n)$ 的時間，如果我們能把 exp b . decimal 的計算時間也縮減到 $O(\log n)$, 我們就有個只需對數時間的演算法了！

令 roll b = exp b . decimal。顯然 roll b [] = 1. 考慮輸入為 c:cs 的情況，在以下的推導中，我們假設 $|exp b n| = b^n$ 擁有乘冪該有的各種算術性質：

    roll b (c:cs)
 ===    {- exp2 與 decimal 之定義  -}
    exp b (if c then 1 + 2 * decimal cs else 2 * decimal cs)
 ===    {- 函數分配進 if -}
    if c then exp b (1 + 2 * decimal cs) else exp b (2 * decimal cs)
 ===    {- 算術：$b^{i + 2 \times x} = b^i \times {(b^x)}^2 $ -}
    if c then b * square (exp b (decimal cs)) else square (exp b (decimal cs))
 ===    {- roll 之定義  -}
    if c then b * square (exp2 b cs) else square (roll b cs)

因此，我們推導出了在 $O(\log n)$ 時間內計算 $b^n$ 的程式如下：

exp b = roll b . binary

roll b []      = 1
roll b (c:cs)  = if c then b * square (exp2 b cs) else square (exp2 b cs)

exp b 0 = 1
exp b n  | even n  = square (exp b (n `div` 2))
         | odd n   = b * square (exp b (n `div` 2)) 

5.3.3 小結與提醒

如果回顧本節發生了什麼，該說：我們為 poly 和 roll . decimal 找出了歸納定義。 它們的效率因此提升了，但這只能說是湊巧：兩個演算中，都有些代數性質可運用，使得推導出的歸納定義在每一步需要做的工作不多，剛好是有效率的。

一般說來，歸納定義和效率提升不見得能畫上等號。導出了某函數的歸納定義後，仍需針對它做分析，才能知道這個推導是否值得。 有些情況下，推導出的程式有較好的時間複雜度，這樣的程式通常能表現得比原來的程式好。 有些情況下，找出歸納定義能消除中間串列，或著減少走訪資料結構的次數。 這時，導出的程式仍有同樣的時間複雜度，但可能有較小的常數。 此時需注意：本章談的僅是時間複雜度，而且只考慮一些特定運算元被使用的次數。 實際上的執行效率受到許多因素的影響，例如：不同運算元花費不同的時間； 空間的使用量也影響效率（例如，使用大量記憶體的程式可能需要較多次垃圾收集）； 某些演算法適合快取，等等。 我們在之後的章節中將看到一些歸納定義程式走訪資料結構的次數雖較少，但反而執行得慢的例子。

sublists :: List a -> List (List a)
sublists []      = [[]]
sublists (x:xs)  = sublists xs ++ map (x:) (sublists xs) 

choose :: Nat -> List a -> List (List a)
choose k = filter ((k ==) . length) . sublists 

     choose (Suc k) (x:xs)
 ===   {- choose 之定義 -}
     filter ((Suc k ==) . length') (sublists (x:xs))
 ===   {- sublists 之定義 -}
     filter ((Suc k ==) . length') (sublists xs ++ map (x:) (sublists xs))
 ===   {- filter 分配入 (++) -}
     filter ((Suc k ==) . length') (sublists xs) ++
     filter ((Suc k ==) . length') (map (x:) (sublists xs))
 ===   {- choose 之定義 -}
     choose (Suc k) xs ++
     filter ((Suc k ==) . length') (map (x:) (sublists xs))
 ===   {- 定理 2.4 -}
     choose (Suc k) xs ++
     map (x:) (filter ((Suc k ==) . length' . (x:)) (sublists xs))
 ===  {- (Suc k ==) . length' . (x:) = (k ==) . length' -}
     choose (Suc k) xs ++
     map (x:) (filter ((k ==) . length') (sublists xs))
 ===  {- choose 之定義 -}
     choose (Suc k) xs ++
     map (x:) (choose k xs) 

choose :: Nat -> List a -> List (List a)
choose Zero     xs      =  [[]]
choose (Suc k)  []      =  []
choose (Suc k)  (x:xs)  =  choose (Suc k) xs ++
                           map (x:) (choose k xs)