高阶函数

简介

高阶函数(Higher Order Function)是一种以函数为参数的函数。它们都被用于映射(mapping)过滤(filtering)归档(folding)排序(sorting)表。高阶函数提高了程序的模块性。编写对各种情况都适用的高阶函数与为单一情况编写递归函数相比,可以使程序更具可读性。比如说,使用一个高阶函数来实现排序可以使得我们使用不同的条件来排序,这就将排序条件和排序过程清楚地划分开来。函数sort具有两个参数,其一是一个待排序的表,其二是定序(Ordering)函数。下面展示了按照大小将一个整数表正序排序。<函数就是(本例中的)两数的定序函数。

  1. (sort '(7883 9099 6729 2828 7754 4179 5340 2644 2958 2239) <)
  2. ;⇒ (2239 2644 2828 2958 4179 5340 6729 7754 7883 9099)

另一方面,按照每个数末两位的大小排序可以按下面的方式实现:

  1. (sort '(7883 9099 6729 2828 7754 4179 5340 2644 2958 2239)
  2. (lambda (x y) (< (modulo x 100) (modulo y 100))))
  3. ;⇒ (2828 6729 2239 5340 2644 7754 2958 4179 7883 9099)

正如这里所演示的,像快速排序(Quick Sort)归并排序(Merge Sort)等排序过程,将定序函数完全分离开来提高了代码的复用性。

在本节中,我将讲解预定义的高阶函数,然后介绍如何定义高阶函数。由于Scheme并不区别过程和其它的数据结构,因此你可以通过将函数当作参数传递轻松的定义自己的高阶函数。

实际上,Scheme中预定义函数的本质就是高阶函数,因为Scheme并没有定义块结构的语法,因此使用lambda表达式作为一个块。

映射

映射是将同样的行为应用于表所有元素的过程。R5RS定义了两个映射过程:其一为返回转化后的表的map过程,另一为注重副作用的for-each过程。

map

map过程的格式如下:

  1. (map procedure list1 list2 ...)

procedure是个与某个过程或lambda表达式相绑定的符号。作为参数的表的个数视procedure需要的参数而定。

例:

  1. ; Adding each item of '(1 2 3) and '(4 5 6).
  2. (map + '(1 2 3) '(4 5 6))
  3. ;⇒ (5 7 9)
  4. ; Squaring each item of '(1 2 3)
  5. (map (lambda (x) (* x x)) '(1 2 3))
  6. ;⇒ (1 4 9)

for-each

for-each的格式与map一致。但for-each并不返回一个具体的值,只是用于副作用。

例:

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

练习1

map编写下面的函数:

  1. 一个将表中所有元素翻倍的函数;
  2. 一个将两个表中对应位置元素相减的函数;

过滤

尽管过滤函数并没有在R5RS中定义,但MIT-Scheme实现提供了keep-matching-itemsdelete-matching-item两个函数。其它实现中应该有类似的函数。

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

练习2

编写下列函数:

  1. 滤取(Filtering Out)出一个表中的偶数;
  2. 滤取出不满足10 ≤ x ≤ 100的数;

归档

尽管在R5RS中没有定义归档函数,但MIT-Scheme提供了reduce等函数。

  1. (reduce + 0 '(1 2 3 4)) ;⇒ 10
  2. (reduce + 0 '(1 2)) ;⇒ 3
  3. (reduce + 0 '(1)) ;⇒ 1
  4. (reduce + 0 '()) ;⇒ 0
  5. (reduce + 0 '(foo)) ;⇒ foo
  6. (reduce list '() '(1 2 3 4)) ;⇒ (((1 2) 3) 4)

练习3

  1. 编写一个将表中所有元素平方的函数,然后求取它们的和,最后求和的平方根。

排序

尽管R5RS中没有定义排序函数,但MIT-Scheme提供了sort(实为merge-sort实现)和quick-sort函数。

  1. (sort '(3 5 1 4 -1) <)
  2. ;⇒ (-1 1 3 4 5)

练习4

编写下列函数

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

apply函数

apply函数是将一个过程应用于一个表(译注:将表展开,作为过程的参数)。此函数具有任意多个参数,但首参数和末参数分别应该是一个过程和一个表。虽然乍看之下不然,但这个函数的确非常方便。

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

练习5

apply编写练习3中的函数。

编写高阶函数

自己编写高阶函数非常容易。这里用member-ifmemberfractal演示。

member-if和member

member-if函数使用一个谓词和一个表作为参数,返回一个子表,该子表的car部分即是原列表中首个满足该谓词的元素。member-if函数可以像下面这样定义:

  1. (define (member-if proc ls)
  2. (cond
  3. ((null? ls) #f)
  4. ((proc (car ls)) ls)
  5. (else (member-if proc (cdr ls)))))
  6. (member-if positive? '(0 -1 -2 3 5 -7))
  7. ;⇒ (3 5 -7)

接下来,member函数检查特定元素是否在表中,该函数编写如下。函数需要三个参数,其一为用于比较的函数,其二为特定项,其三为待查找表。

  1. (define (member proc obj ls)
  2. (cond
  3. ((null? ls) #f)
  4. ((proc obj (car ls)) ls)
  5. (else (member proc obj (cdr ls)))))
  6. (member string=? "hello" '("hi" "guys" "bye" "hello" "see you"))
  7. ;⇒ ("hello" "see you")

不规则曲线

生成像C曲线、龙曲线等不规则曲线可以通过在两个点中插入一个点来实现 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. 。代码实现如下:

  1. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  2. ;;;
  3. ;;; frac.scm
  4. ;;;
  5. ;;; draw fractal curves
  6. ;;; by T.Shido
  7. ;;; on August 20, 2005
  8. ;;;
  9. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  10. ;;; 平面直角坐标系上的点通过序对来表示,其中car部分和cdr部分分别代表
  11. ;;; x坐标和y坐标。
  12. ;;; 函数_x_y用来取得坐标,point用来建立一个点。
  13. (define _x car)
  14. (define _y cdr)
  15. (define point cons)
  16. ;;; (rappend ls0 ls1)
  17. ;;; (rappend '(1 2 3) '(4 5 6)) -> (3 2 1 4 5 6)
  18. ;;;
  19. ;;; 接受两个表作为参数,将第一个表反转后与第二个表连接起来。
  20. (define (rappend ls0 ls1)
  21. (let loop((ls0 ls0) (ls1 ls1))
  22. (if (null? ls0)
  23. ls1
  24. (loop (cdr ls0) (cons (car ls0) ls1)))))
  25. ;;; (devide p1 p2 r)
  26. ;;; dividing p1 and p2 internally by the ratio r.
  27. (define (divide p1 p2 r)
  28. (point (+ (* r (_x p1)) (* (- 1.0 r) (_x p2)))
  29. (+ (* r (_y p1)) (* (- 1.0 r) (_y p2)))))
  30. ;;; (print-curve points fout)
  31. ;;; 将点输出至文件。将一系列点points按一行一个点得格式输出至fout
  32. ;;; 表的文件
  33. (define (print-curve points fout)
  34. (with-output-to-file fout
  35. (lambda ()
  36. (for-each
  37. (lambda (p)
  38. (display (_x p))
  39. (display " ")
  40. (display (_y p))
  41. (newline))
  42. points))))
  43. ;;; (fractal proc n points fout)
  44. ;;; 创建分型图形的高阶函数。其中,proc是定位函数,n是重复次数,
  45. ;;; points是初始点构成的表,fout是输出文件的文件名。
  46. ;;; 函数由两个叫做loopiter的循环构成。loop对数据表做n次插入。
  47. ;;; The iter adds new points to the data list using the positioning function. In short, fractal generates curves by repeating iter for n times.
  48. The positioning function proc takes two points as arguments and returns a list of the first point and the interpolated point.
  49. (define (fractal proc n points fout)
  50. (let loop ((i 0) (points points))
  51. (if (= n i)
  52. (print-curve points fout)
  53. (loop
  54. (1+ i)
  55. (let iter ((points points) (acc '()))
  56. (if (null? (cdr points))
  57. (reverse! (cons (car points) acc))
  58. (iter
  59. (cdr points)
  60. (rappend (proc (first points) (second points)) acc)))))))
  61. 'done)
  62. ;;; (c-curve p1 p2)
  63. ;;; C-曲线的定位函数
  64. (define (c-curve p1 p2)
  65. (let ((p3 (divide p1 p2 0.5)))
  66. (list
  67. p1
  68. (point (+ (_x p3) (- (_y p3) (_y p2)))
  69. (+ (_y p3) (- (_x p2) (_x p3)))))))
  70. ;;; (dragon-curve p1 p2)
  71. ;;; 龙曲线的定位函数
  72. (define dragon-curve
  73. (let ((n 0))
  74. (lambda (p1 p2)
  75. (let ((op (if (even? n) + -))
  76. (p3 (divide p1 p2 0.5)))
  77. (set! n (1+ n))
  78. (list
  79. p1
  80. (point (op (_x p3) (- (_y p3) (_y p2)))
  81. (op (_y p3) (- (_x p2) (_x p3)))))))))
  82. ;;; (koch p1 p2)
  83. ;;; Koch曲线的定位函数
  84. (define (koch p1 p2)
  85. (let ((p3 (divide p1 p2 2/3))
  86. (p4 (divide p1 p2 1/3))
  87. (p5 (divide p1 p2 0.5))
  88. (c (/ (sqrt 3) 2)))
  89. (list
  90. p1
  91. p3
  92. (point (- (_x p5) (* c (- (_y p4) (_y p3))))
  93. (+ (_y p5) (* c (- (_x p4) (_x p3)))))
  94. p4)))

下面的代码演示了如何生成分型曲线。源代码在这里。使用之前请先编译,以节省计算时间。

  1. (compile-file "frac.scm")
  2. (load "frac")
  3. ;; C-Curve
  4. (fractal c-curve 14 '((0 . 0) (2 . 3)) "c14.dat")
  5. ;Value: done
  6. ;; Dragon-Curve
  7. (fractal dragon-curve 14 '((0 . 0) (1 . 0)) "d14.dat")
  8. ;Value: done
  9. ;; Koch-Curve
  10. (fractal koch 5 '((0 . 0) (1 . 0)) "k5.dat")
  11. ;Value: done

X坐标和Y坐标都存储在名字形如*.dat的文件中。你可以使用你喜欢的制图程序来绘制。图表1-3都是用gnuplot绘制的。

练习 6

  1. 自己实现keep-matching-items
  2. 自己实现map。接受不止一个表作为参数可能有点困难。剩余的参数是通过带点得序对(.)来定义的。其cdr部分以表的形式传递给函数。例: my-list
    1. (define (my-list . x) x)
    多说一句,你需要apply函数。

小结

本章中,我讲解了高阶函数。正如在生成分形图形体现的那样,高阶函数增强了模块化程度。你可以很容易地定义高阶函数。当你编写函数时,更要在乎将其实现为更抽象的高阶函数,这样可以让你的代码能够复用(reusable)

在下一章节中,我会介绍IO。

习题解答

答案1

  1. ; 1
  2. (define (double ls)
  3. (map (lambda (x) (* x 2)) ls))
  4. ; 2
  5. (define (sub ls1 ls2)
  6. (map - ls1 ls2))

答案2

  1. ; 1
  2. (define (filter-even ls)
  3. (keep-matching-items ls even?))
  4. ; 2
  5. (define (filter-10-100 ls)
  6. (delete-matching-items ls (lambda (x) (<= 10 x 100))))

答案3

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

答案4

  1. ; 1
  2. (define (sort-sin ls)
  3. (sort ls (lambda (x y) (< (sin x) (sin y)))))
  4. ; 2
  5. (define (sort-length ls)
  6. (sort ls (lambda (x y) (> (length x) (length y)))))

答案5

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

答案6

  1. ; 1
  2. (define (my-keep-matching-items ls fn)
  3. (cond
  4. ((null? ls) '())
  5. ((fn (car ls))
  6. (cons (car ls) (my-keep-matching-items (cdr ls) fn)))
  7. (else
  8. (my-keep-matching-items (cdr ls) fn))))
  9. ; 2
  10. (define (my-map fun . lss)
  11. (letrec ((iter (lambda (fun lss)
  12. (if (null? lss)
  13. '()
  14. (cons (fun (car lss))
  15. (iter fun (cdr lss))))))
  16. (map-rec (lambda (fun lss)
  17. (if (memq '() lss)
  18. '()
  19. (cons (apply fun (iter car lss))
  20. (map-rec fun (iter cdr lss)))))))
  21. (map-rec fun lss)))
  22. (my-map + '(1 2 3) '(10 20 30) '(100 200 300))
  23. ;⇒ (111 222 333)