第八章 高階函數(shù)

8.1?簡介

高階函數(shù)（Higher Order Function）是一種以函數(shù)為參數(shù)的函數(shù)。它們都被用于映射（mapping）、過濾（filtering）、歸檔（folding）和排序（sorting）表。高階函數(shù)提高了程序的模塊性。編寫對各種情況都適用的高階函數(shù)與為單一情況編寫遞歸函數(shù)相比，可以使程序更具可讀性。比如說，使用一個高階函數(shù)來實現(xiàn)排序可以使得我們使用不同的條件來排序，這就將排序條件和排序過程清楚地劃分開來。函數(shù)sort具有兩個參數(shù)，其一是一個待排序的表，其二是定序（Ordering）函數(shù)。下面展示了按照大小將一個整數(shù)表正序排序。<函數(shù)就是（本例中的）兩數(shù)的定序函數(shù)。

(sort '(7883 9099 6729 2828 7754 4179 5340 2644 2958 2239) <)
;?  (2239 2644 2828 2958 4179 5340 6729 7754 7883 9099)

另一方面，按照每個數(shù)末兩位的大小排序可以按下面的方式實現(xiàn)：

(sort '(7883 9099 6729 2828 7754 4179 5340 2644 2958 2239) 
      (lambda (x y) (< (modulo x 100) (modulo y 100))))
;?  (2828 6729 2239 5340 2644 7754 2958 4179 7883 9099)

正如這里所演示的，像快速排序（Quick Sort）、歸并排序（Merge Sort）等排序過程，將定序函數(shù)完全分離開來提高了代碼的復(fù)用性。

在本節(jié)中，我將講解預(yù)定義的高階函數(shù)，然后介紹如何定義高階函數(shù)。由于Scheme并不區(qū)別過程和其它的數(shù)據(jù)結(jié)構(gòu)，因此你可以通過將函數(shù)當作參數(shù)傳遞輕松的定義自己的高階函數(shù)。

實際上，Scheme中預(yù)定義函數(shù)的本質(zhì)就是高階函數(shù)，因為Scheme并沒有定義塊結(jié)構(gòu)的語法，因此使用lambda表達式作為一個塊。

8.2?映射

映射是將同樣的行為應(yīng)用于表所有元素的過程。R5RS定義了兩個映射過程：其一為返回轉(zhuǎn)化后的表的map過程，另一為注重副作用的for-each過程。

8.2.1?map

map過程的格式如下：

(map procedure list1 list2 ...)

procedure是個與某個過程或lambda表達式相綁定的符號。作為參數(shù)的表的個數(shù)視procedure需要的參數(shù)而定。

例：

; Adding each item of '(1 2 3) and '(4 5 6).
(map + '(1 2 3) '(4 5 6))
;?  (5 7 9)

; Squaring each item of '(1 2 3)
(map (lambda (x) (* x x)) '(1 2 3))
;?  (1 4 9)

8.2.2?for-each

for-each的格式與map一致。但for-each并不返回一個具體的值，只是用于副作用。

例：

(define sum 0)
(for-each (lambda (x) (set! sum (+ sum x))) '(1 2 3 4))
sum
;?  10

練習(xí)1

用map編寫下面的函數(shù)：

1. 一個將表中所有元素翻倍的函數(shù)；
2. 一個將兩個表中對應(yīng)位置元素相減的函數(shù)；

8.3?過濾

盡管過濾函數(shù)并沒有在R5RS中定義，但MIT-Scheme實現(xiàn)提供了keep-matching-items和delete-matching-item兩個函數(shù)。其它實現(xiàn)中應(yīng)該有類似的函數(shù)。

(keep-matching-items '(1 2 -3 -4 5) positive?)
;?  (1 2 5)

練習(xí)2

編寫下列函數(shù)：

1. 濾?。‵iltering Out）出一個表中的偶數(shù)；
2. 濾取出不滿足10 ≤ x ≤ 100的數(shù)；

8.4?歸檔

盡管在R5RS中沒有定義歸檔函數(shù)，但MIT-Scheme提供了reduce等函數(shù)。

(reduce + 0 '(1 2 3 4))                 ;?  10
(reduce + 0 '(1 2))                     ;?  3
(reduce + 0 '(1))                       ;?  1
(reduce + 0 '())                        ;?  0
(reduce + 0 '(foo))                     ;?  foo
(reduce list '() '(1 2 3 4))            ;?  (((1 2) 3) 4)

練習(xí)3

1. 編寫一個將表中所有元素平方的函數(shù)，然后求取它們的和，最后求和的平方根。

8.5?排序

盡管R5RS中沒有定義排序函數(shù)，但MIT-Scheme提供了sort（實為merge-sort實現(xiàn)）和quick-sort函數(shù)。

(sort '(3 5 1 4 -1) <)
;?  (-1 1 3 4 5)

練習(xí)4

編寫下列函數(shù)

1. 以sin(x)的大小升序排序；
2. 以表長度降序排序；

8.6?apply函數(shù)

apply函數(shù)是將一個過程應(yīng)用于一個表（譯注：將表展開，作為過程的參數(shù)）。此函數(shù)具有任意多個參數(shù)，但首參數(shù)和末參數(shù)分別應(yīng)該是一個過程和一個表。雖然乍看之下不然，但這個函數(shù)的確非常方便。

(apply max '(1 3 2))      ;?   3
(apply + 1 2 '(3 4 5))    ;?  15
(apply - 100 '(5 12 17))  ;?  66

練習(xí)5

用apply編寫練習(xí)3中的函數(shù)。

8.7?編寫高階函數(shù)

自己編寫高階函數(shù)非常容易。這里用member-if、member和fractal演示。

8.7.1?member-if和member

member-if函數(shù)使用一個謂詞和一個表作為參數(shù)，返回一個子表，該子表的car部分即是原列表中首個滿足該謂詞的元素。member-if函數(shù)可以像下面這樣定義：

(define (member-if proc ls)
  (cond
   ((null? ls) #f)
   ((proc (car ls)) ls)
   (else (member-if proc (cdr ls)))))

(member-if positive? '(0 -1 -2 3 5 -7))
;?  (3 5 -7)

接下來，member函數(shù)檢查特定元素是否在表中，該函數(shù)編寫如下。函數(shù)需要三個參數(shù)，其一為用于比較的函數(shù)，其二為特定項，其三為待查找表。

(define (member proc obj ls)
  (cond
   ((null? ls) #f)
   ((proc obj (car ls)) ls)
   (else (member proc obj (cdr ls)))))

(member string=? "hello" '("hi" "guys" "bye" "hello" "see you"))
;?  ("hello" "see you")

8.7.2?不規(guī)則曲線

生成像C曲線、龍曲線等不規(guī)則曲線可以通過在兩個點中插入一個點來實現(xiàn) which are generated by inserting a point(s) between two points according to a positioning function can be separated into two parts: a common routine to generate fractal curves and a positioning function. 。代碼實現(xiàn)如下：

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;;                frac.scm
;;;
;;;        draw fractal curves
;;;         by T.Shido
;;;       on August 20, 2005
;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; 平面直角坐標系上的點通過序?qū)肀硎?，其中car部分和cdr部分分別代表
;;; x坐標和y坐標。
;;; 函數(shù)_x和_y用來取得坐標，point用來建立一個點。
(define _x car)
(define _y cdr)
(define point cons)

;;; (rappend ls0 ls1)
;;; (rappend '(1 2 3) '(4 5 6)) -> (3 2 1 4 5 6)
;;;
;;; 接受兩個表作為參數(shù)，將第一個表反轉(zhuǎn)后與第二個表連接起來。
(define (rappend ls0 ls1)
  (let loop((ls0 ls0) (ls1 ls1))
    (if (null? ls0)
        ls1
      (loop (cdr ls0) (cons (car ls0) ls1)))))

;;; (devide p1 p2 r)
;;; dividing?p1?and?p2?internally by the ratio?r.
(define (divide p1 p2 r)
  (point (+ (* r (_x p1)) (* (- 1.0 r) (_x p2)))
     (+ (* r (_y p1)) (* (- 1.0 r) (_y p2)))))

;;; (print-curve points fout)
;;; 將點輸出至文件。將一系列點points按一行一個點得格式輸出至fout代
;;; 表的文件
(define (print-curve points fout)
  (with-output-to-file fout
    (lambda ()
      (for-each
       (lambda (p)
         (display (_x p))
         (display " ")
         (display (_y p))
         (newline))
       points))))

;;; (fractal?proc?n?points?fout)
;;; 創(chuàng)建分型圖形的高階函數(shù)。其中，proc是定位函數(shù)，n是重復(fù)次數(shù)，
;;; points是初始點構(gòu)成的表，fout是輸出文件的文件名。
;;; 函數(shù)由兩個叫做loop和iter的循環(huán)構(gòu)成。loop對數(shù)據(jù)表做n次插入。
;;; The?iter?adds new points to the data list using the positioning function. In short,?fractal?generates curves by repeating?iter?for?n?times.
The positioning function?proc?takes two points as arguments and returns a list of the first point and the interpolated point.
(define (fractal proc n points fout)
  (let loop ((i 0) (points points))
    (if (= n i)
      (print-curve points fout)
      (loop
       (1+ i)
       (let iter ((points points) (acc '()))
         (if (null? (cdr points)) 
           (reverse! (cons (car points) acc))
           (iter
             (cdr points)
             (rappend (proc (first points) (second points)) acc)))))))
  'done)

;;; (c-curve p1 p2) 
;;; C-曲線的定位函數(shù)
(define (c-curve p1 p2) 
  (let ((p3 (divide p1 p2 0.5)))
    (list
     p1
     (point (+ (_x p3) (- (_y p3) (_y p2)))
        (+ (_y p3) (- (_x p2) (_x p3)))))))

;;; (dragon-curve p1 p2)
;;; 龍曲線的定位函數(shù)
(define dragon-curve 
  (let ((n 0))
    (lambda (p1 p2)
      (let ((op (if (even? n) + -))
        (p3 (divide  p1 p2 0.5)))
    (set! n (1+ n))
    (list
     p1
     (point (op (_x p3) (- (_y p3) (_y p2)))
        (op (_y p3) (- (_x p2) (_x p3)))))))))

;;; (koch p1 p2)
;;; Koch曲線的定位函數(shù)
(define (koch p1 p2)
  (let ((p3 (divide p1 p2 2/3))
    (p4 (divide p1 p2 1/3))
    (p5 (divide p1 p2 0.5))
    (c  (/ (sqrt 3) 2)))
    (list
     p1
     p3
     (point (- (_x p5) (* c (- (_y p4) (_y p3))))
        (+ (_y p5) (* c (- (_x p4) (_x p3)))))
     p4)))

下面的代碼演示了如何生成分型曲線。源代碼在這里。使用之前請先編譯，以節(jié)省計算時間。

(compile-file "frac.scm")
(load "frac")

;; C-Curve
(fractal c-curve 14 '((0 . 0) (2 . 3)) "c14.dat")
;Value: done

;; Dragon-Curve
(fractal dragon-curve 14 '((0 . 0) (1 . 0)) "d14.dat")
;Value: done

;; Koch-Curve
(fractal koch 5 '((0 . 0) (1 . 0)) "k5.dat")
;Value: done

X坐標和Y坐標都存儲在名字形如*.dat的文件中。你可以使用你喜歡的制圖程序來繪制。圖表1-3都是用gnuplot繪制的。

練習(xí) 6

1. 自己實現(xiàn)keep-matching-items。
2. 自己實現(xiàn)map。接受不止一個表作為參數(shù)可能有點困難。剩余的參數(shù)是通過帶點得序?qū)?code>(.)來定義的。其cdr部分以表的形式傳遞給函數(shù)。 例: my-list?scheme (define (my-list . x) x)?多說一句，你需要apply函數(shù)。

8.8?小結(jié)

本章中，我講解了高階函數(shù)。正如在生成分形圖形體現(xiàn)的那樣，高階函數(shù)增強了模塊化成都。你可以很容易地定義高階函數(shù)。當你編寫函數(shù)時，更要在乎將其實現(xiàn)為更抽象的高階函數(shù)，這樣可以讓你的代碼能夠復(fù)用（reusable）。

在下一章節(jié)中，我會介紹IO。

8.9?習(xí)題解答

8.9.1?答案1

; 1
(define (double ls)
  (map (lambda (x) (* x 2)) ls))

; 2
(define (sub ls1 ls2)
  (map - ls1 ls2))

8.9.2?答案2

; 1
(define (filter-even ls)
  (keep-matching-items ls even?))
; 2
(define (filter-10-100 ls)
  (keep-matching-items ls (lambda (x) (<= 10 x 100))))

8.9.3?答案3

(define (sqrt-sum-sq ls)
  (sqrt (reduce + 0 (map (lambda (x) (* x x)) ls))))

8.9.4?答案4

; 1
(define (sort-sin ls)
  (sort ls (lambda (x y) (< (sin x) (sin y)))))

; 2
(define (sort-length ls)
  (sort ls (lambda (x y) (> (length x) (length y)))))

8.9.5?答案5

(define (sqrt-sum-sq-a ls)
  (sqrt (apply + (map (lambda (x) (* x x)) ls))))

8.9.6?答案6

; 1
(define (my-keep-matching-items ls fn)
  (cond
   ((null? ls) '())
   ((fn (car ls))
    (cons (car ls) (my-keep-matching-items (cdr ls) fn)))
   (else
    (my-keep-matching-items  (cdr ls) fn))))

; 2
(define (my-map fun . lss)
  (letrec ((iter (lambda (fun lss)
               (if (null? lss)
               '()
               (cons (fun (car lss))
                 (iter fun (cdr lss))))))
       (map-rec (lambda (fun lss)
              (if (memq '() lss)
              '()
              (cons (apply fun (iter car lss))
                (map-rec fun (iter cdr lss)))))))
    (map-rec fun lss)))
(my-map + '(1 2 3) '(10 20 30) '(100 200 300))
;? (111 222 333)