Common Lisp学习笔记（七）

• 7 Applicative Programming
  • 7.2 funcall
  • 7.3 mapcar
  • 7.4 manipulating tables with mapcar
  • 7.5 lambda expressions
  • 7.6 find-if
  • 7.7 my-assoc
  • 7.8 remove-if, remove-if-not
  • 7.9 reduce
  • 7.10 every
  • debug tool: trace
  • 7.11 operating on multiple lists
  • 7.12 function函数
  • 7.13 kwargs for applicative operators

7 Applicative Programming

7.2 funcall

(funcall #'cons 'a 'b) -> (a . b)
funcall可以通过函数名字来调用函数

lisp里面引用函数使用符号#'

再看一个例子，

> (setf fn #'cons)
#<compilied-function cons {6041410}>

> (funcall fn 'c 'd)
(c . d)

7.3 mapcar

mapcar可以将一个函数应用到一个list中的每一个元素中，然后将每次返回的结果全部放到一个list中返回

(defun square (n) (* n n))

(square 3) -> 9
(square '(1 2 3)) -> error

(mapcar #'square '(1 2 3) -> (1 4 9)

7.4 manipulating tables with mapcar

(mapcar #'function-name list)

现在有一张英语和法语的转换表

(setf words
  `((one un)
    (two deux)
    (three trois)
    (four quatre)
    (five cinq)))

获取所有list的第一个item:

> (mapcar #'first words)
(one two three four five)

ex 7.1

(defun add1 (x) (+ x 1))

> (mapcar #'add1 '(1 3 5 7 9)

7.5 lambda expressions

(lambda (n) (* n n))

在使用mapcar的时候如果不想另外定义一个函数，可以直接在mapcar函数里面定义匿名函数lambda

> (mapcar #'(lambda (n) (* n n)) '(1 2 3)
(1 4 9)

ex 7.7

(defun flips (x) 
  (mapcar #'(lambda (n) (if (equal n 'up) 'down 'up)) x))

7.6 find-if

(find-if #'predicate list)

对list中的每个item调用predicate，返回第一个返回值是t的item，没有返回t的就返回nil

> (find-if #'oddp '(2 4 6 7 8))
7

7.7 my-assoc

assoc函数有2个参数(key table),返回在table中第一个元素是key的那个list

现在可以用find-if来写一个assoc功能的函数

(defun my-assoc (key table)
  (find-if #'(lambda (entry) (equal key (first entry))) table))

对于table中的每个list,我们定义的lambda函数要判断key是否等于这个list的第一个元素，如果想等就返回t,而find-if函数只要lambda函数返回t就将那个list返回，刚好可以实现assoc函数的功能

要注意的一点，例子中lambda函数可以访问定义在my-assoc函数中的局部变量key，说明lambda函数可以包含这个lambda函数的外层函数的local vars

ex 7.8

(defun foo (x k) 
  (find-if #'(lambda (n) (if (< n (- k 10)) nil (<= n (+ k 10)))) x))

ex 7.9

(defun find-nested (x)
  (find-if #'(lambda (entry) (and (listp entry) (not (equal entry nil)))) x))

7.8 remove-if, remove-if-not

(remove-if #'function-name list)

对于list中的每个元素都调用函数进行判断，如果为t就将其删除，返回剩下的list

> (remove-if #'numberp '(2 for 1 sale)
(for sale)

remove-if-not则相反，如果函数返回为nil就将该元素删除

> (remove-if-not #'(lambda (x) (> x 3)) '(2 3 4 5 6))
(4 5 6)

ex 7.15

(defun rank (x) (first x))
(defun suit (x) (second x))

(setf my-hand `((3 hearts) (5 clubs) (2 diamonds) (4 diamonds) (ace spades)))

(defun count-suit (suit hand) 
  (length (remove-if-not #'(lambda (entry) (equal suit (second entry))) hand)))

(setf colors '((clubs black) (diamonds red) (hearts red) (spades black)))

(defun color-of (x) 
  (second (assoc (second x) colors)))

(defun first-red (hand)
  (find-if #'(lambda (card) (equal 'red (color-of card))) hand))

(defun black-cards (hand)
  (remove-if-not #'(lambda (card) (equal 'black (color-of card))) hand))

(defun what-ranks (suit hand)
  (mapcar #'first (remove-if-not #'(lambda (card) (equal suit (second card))) hand)))

(setf all-ranks '(2 3 4 5 6 7 8 9 10 jack queen king ace))

(defun higher-rank-p (card1 card2)
  (member (first card1) (rest (member (first card2) all-ranks))))

(defun high-card (hand)
  ;;建立一个rank的list(ace king queen jack 10 ... 2),使用find-if对这个list的rank逐个查找是否出现在hand中
  ;;(mapcar #'first hand)可以得到hand中所有的rank的list
  (assoc (find-if #'(lambda (rank) (member rank (mapcar #'first hand))) (reverse all-ranks)) hand))

7.9 reduce

(reduce #'function list)

reduce函数对list不断进行操作直到只剩一个结果，如对一个list使用加法相当与对list中的所有因素求和

比如list是(a b c d)，则先计算a b的结果，再用这个结果与c运算，得到的结果再与d运算，最后剩下一个结果

其中function必须是有两个参数的，eg,

(reduce #'+ '(1 2 3)) -> 6
(reduce #'* '(2 3 4)) -> 24

reduce可以将嵌套的list变为一个list，eg,

> (reduce #'append '((one un) (two deux) (three trois)))
(one un two deux three trois)

ex 7.17

(defun total-length (x)
  (reduce #'+ (mapcar #'length x)))

7.10 every

(every #'predicate list)
如果list中的所有元素都使得predicate返回t则函数返回t，意思就是对于每一个list中的因素都成立,否则返回nil,eg,

> (every #'numberp '(1 2 3))
t

如果第二个参数是nil，则every返回t

every后面也可以给多个list,eg,

> (every #'> '(10 20 30 40) '(1 4 11 23))
t

>函数需要两个参数，every每次从后面的两个list中各取出一个作为参数，如例子中10>1,20>4,30>11,40>24都成立，所以返回t

debug tool: trace

• (trace func1 func2 ...)
• (trace) : 查看正在trace的函数
• (untrace func1 func2 ...)
• (untrace) : untrace所有函数

(defun half (n) (* n 0.5))

(defun average (x y)
  (+ (half x) (half y)))

> (trace half average)
(half average)

> (average 3 7)
1. Trace: (AVERAGE '3 '7)
2. Trace: (HALF '3)
2. Trace: HALF ==> 1.5
2. Trace: (HALF '7)
2. Trace: HALF ==> 3.5
1. Trace: AVERAGE ==> 5.0
5.0

ex 7.29

(setf database 
  '((b1 shape brick)
    (b1 color green)
    (b1 size  small)
    (b1 supported-by b2)
    (b1 supported-by b3)
    (b2 shape brick)
    (b2 color red)
    (b2 size small)
    (b2 supports b1)
    (b2 left-of b3)
    (b3 shape brick)
    (b3 color red)
    (b3 size small)
    (b3 supports b1)
    (b3 right-of b2)
    (b4 shape pyramid)
    (b4 color blue)
    (b4 size large)
    (b4 supported-by b5)
    (b5 shape cube)
    (b5 color green)
    (b5 size large)
    (b5 supports b4)
    (b6 shape brick)
    (b6 color purple)
    (b6 size large)))
    
(defun match-element (x y)
  (or (equal x y) (equal y '?)))

(defun match-triple (assertion pattern)
  (every #'match-element assertion pattern))

(defun fetch (pattern)
  (remove-if-not #'(lambda (entry) (match-triple entry pattern)) database))

> (fetch '(b4 shape ?)) 
> (fetch '(? shape brick))
> (fetch '(b2 ? b3))
> (fetch '(? color ?))
> (fetch '(b4 ? ?))

(defun ask-color (block)
  (list block 'color '?))

(defun supporters (block)
  (mapcar #'first  (fetch (list '? 'supports block))))

(defun supp-cube (block)
  (find-if #'(lambda (entry) (fetch (list entry 'shape 'cube))) (supporters block)))

(defun desc1 (block)
  (remove-if-not #'(lambda (entry) (equal block (first entry))) database))

(defun desc2 (block)
  (mapcar #'rest (desc1 block)))

(defun description (block)
  (reduce #'append (desc2 block)))

(setf (cdr (last database)) '((b1 material wood) (b2 material plastic)))

7.11 operating on multiple lists

之前我们使用mapcar是将一个list的每个item作为参数调用一个函数，这个函数只接受一个参数。其实mapcar也可以对多参数的函数使用，eg,

> (mapcar #'(lambda (x y) (list x 'get y)) '(fred wilma) '(job1 job2))
((fred gets job1) (wilma gets job2))

> (mapcar #'+ '(1 2 3) '(10 20 30 40))
(11 22 33)

这种方式类似于前面的every后面跟多个list，如果两个list的长度不一样，则遍历完较短那个就会停止

ex 7.30

(mapcar #'append words (mapcar #'list '(uno dos tres quatro cinco)))

7.12 function函数

'代表函数quote，#'则代表函数function,#'cons等价与(function cons)

> 'cons
cons

> #'cons
#<compiled-function cons ...>

> #'(lambda (x) (...))
#<lexical-closure ...>

#'返回的是一个函数对象，可以用funcall来进行调用

> (setf g #'(lambda (x) (* x 10)))
#<lexical...>

> (funcall g 12)
120

7.13 kwargs for applicative operators

:from-end等关键字参数也可以应用在find-if,remove-if,reduce这些函数

> (reduce #'cons '(a b c d e))
((((a . b) . c) . d) . e)

> (reduce #'cons '(a b c d e) :from-end t)
(a b c d . e)