Common Lisp学习笔记（十）

• 10 Assignment
  • 10.3 stereotypical updating methods
    • INCF and DECF macros
    • PUSH and POP macros
  • 10.4 WHEN and UNLESS
  • 10.5 generalized vars
  • 10.6 tic-tac-toe
  • 10.7 list srugery
  • 10.8 destructive operations on lists
    • nconc
    • nsubst
    • 其它一些destructive func
  • 10.10 setq and set

10 Assignment

lisp全局变量的命名通常在首尾加上**,eg,*total-glasses*

 

10.3 stereotypical updating methods

更新一个变量的值经常会利用该变量原来的值做一些计算得到新的值再用来更新，这里有2种情况，增加或者减少一个计数器，在list的头部增加或者删除一个元素

INCF and DECF macros

> (setf a 2)
2
> (incf a 3)
5
> (decf a)
4

PUSH and POP macros

(setf x (cons 'foo x))可以写成(push 'foo x),类似的在头部删除一个元素可以用(pop x)，不仅删除第一个元素还会将其返回

为了保证代码的可读性和优雅性，尽量不要修改局部变量的值，可以let新的变量去代替修改

 

10.4 WHEN and UNLESS

(when test
    body)

(unless test
    body)

when首先判断test是否为真，如果为nil则直接返回nil,否则进入body执行所有语句最后返回最后一个语句的值。unless的用法类似，但是test为nil才进入body

比如现在有一个函数有2个参数x，y，要保证x为odd且y为even，如果不是则将它们加或减1输出信息，然后将它们相乘

(defun picky-multiply (x y)
  (unless (oddp x)
    (incf x)
    (format t "~&changing x to ~S to make it odd." x))
  (when (oddp y)
    (decf y)
    (format t ...))
  (* x y))

 

10.5 generalized vars

generalized variable是一个指针可以存储的任意空间。平常所说的变量都有一个指针指向它的值，比如说n的值为3,意思是名为n的变量有一个指针指向数字3.修改变量的值只是将指针换为指向另一个对象的指针

思考例子：

(setf x '(jack benny was 39 for many years))
(setf (sixth x) 'several)

> x
(jack benny was 39 for several years)

> (decf (fourth x) 2)
37

> x 
(jack benny was 37 for ...)

例子中的修改变量的值只是把一个cons的car指针改为指向别的对象的指针

 

10.6 tic-tac-toe

九个格子当前的状态需要数据结构来存储，这里用list实现。对于每一个格子，0表示该格子为空，1表示上面是O,10表示上面是X. make-board()创建一个空的九宫格

(defun make-board ()
  (list 'board 0 0 0 0 0 0 0 0 0))

list的第一个元素是'board，(nth 2 B)可以访问第二个格子

print-board函数以九宫格的形式输出当前的棋盘状态，需要辅助函数将数据结构中的0,1,10转化为' ','O', 'X'

(defun convert-to-letter (v)
  (cond ((equal v 1) "O")
        ((equal v 10) "X")
        (t " ")))

(defun print-row (x y z)
  (format t "~&  ~A | ~A | ~A"
    (convert-to-letter x)
    (convert-to-letter y)
    (convert-to-letter z)))

(defun print-board (board)
  (format t "~%")
  (print-row (nth 1 board) (nth 2 board) (nth 3 board))
  (format t "~& ------------")
  (print-row (nth 4 board) (nth 5 board) (nth 6 board))
  (format t "~& ------------")
  (print-row (nth 7 board) (nth 8 board) (nth 9 board))
  (format t "~%~%"))

make-move()表示在某个格子下一步棋，参数player为1或者10表示下子'O'或者'X'

(defun  make-move (player pos board)
  (setf (nth pos board) player)
  board)

显然这里并没有判断pos位置是否已经有下过

假设我们是人机对战，10代表计算机，1代表玩家，定义全局变量

(setf *computer* 10)
(setf *opponent* 1)

前面几个函数已经可以实现由机器或者玩家在某个位置下一步棋，下面要判断游戏什么时候结束。我们先将3个子连成直线的位置情况列举在全局变量*triplets*中

(setf *triplets*
  '((1 2 3) (4 5 6) (7 8 9)
    (1 4 7) (2 5 8) (3 6 9)
    (1 5 9) (3 5 7)))

连成直线的只有8种情况，我们需要一一对三个位置的数进行求和来判断是否有连成直线，sum-triplet给定一个triplet计算三个位置的和，compute-sums返回8种情况求和的一个list

(defun sum-triplet (board triplet)
  (+ (nth (first triplet) board)
     (nth (second triplet) board)
     (nth (third triplet) board)))

(defun compute-sums (board)
  (mapcar #'(lambda (triplet) (sum-triplet board triplet)) *triplets*))

因为双方由1和10表示，所以只有直线三个位置和为3或者30才能赢，winner-p判断是否有一方获胜

(defun winner-p (board)
  (let ((sums (compute-sums board)))
    (or (member (* 3 *computer*) sums)
        (member (* 3 *opponent*) sums))))

程序的主函数

(defun play-one-game ()
  (if (y-or-n-p "would you like to go first?")
      (opponent-move (make-board))
      (computer-move (make-board))))

程序询问用户是否要先手，然后根据选择来决定是opponent-move还是computer-move

剩下的问题就是用户和电脑的一步该怎么走了，用户的话自然就是询问用户的输入，判断输入合法性，等用户走完一步再判断是否分出胜负还是和局。

(defun opponent-move (board)
  (let* ((pos (read-a-legal-move board))
         (new-board (make-move *opponent* pos board)))
    (print-board new-board)
    (cond ((winner-p new-board) (format t "~&you win!"))
          ((board-full-p new-board) (format t "~&tie game."))
          (t (computer-move new-board)))))

read-a-legal-move判断用户输入是否在1到9，还有该格子是否为空，函数递归调用直到用户接受到合法输入

(defun read-a-legal-move (board)
  (format t "~&your move: ")
  (let ((pos (read)))
    (cond ((not (and (integerp pos) (<= 1 pos 9)))
           (format t "~&invalid input.") (read-a-legal-move board))
          ((not (zerop (nth pos board))) 
           (format t "~&that space is already occupied.") (read-a-legal-move board))
          (t pos))))

判断是否还有空位只要查看是否有0的空格即可

(defun board-full-p (board)
  (not (member 0 board)))

computer-move的情况就稍微复杂,choose-best-move返回两个元素的list，第一个是选择的位置，第二个是做这样的选择所用的策略，即一个用来提示的string

(defun computer-move (board)
  (let* ((best-move (choose-best-move board))
         (pos (first best-move))
         (strategy (second best-move))
         (new-board (make-move *computer* pos board)))
    (format t "~&my move: ~S." pos)
    (format t "~&my strategy: ~S." strategy)
    (print-board new-board)
    (cond ((winner-p new-board) (format t "~&I win!"))
          ((board-full-p new-board) (format t "~&tie game"))
          (t (opponent-move new-board)))))

choose-best-move函数要判断到底在哪一个位置来走下一步，而不是要求用户输入。一个方法是随机选择一个空位，这种方法可行，但是会智能程度比较低，有可能用户已经有两个相连了电脑还不会去阻止他而是随便放一个位置。现在使用另一种策略，如果电脑已经有两个相连，就会尝试是否能获胜。否则，会查看用户是否已经有两个相连，如果有会尝试阻止用户获胜

win-or-block判断triplets的八种情况中有没有和等于target-sum的情况，如果有则let中的triplet不为nil，最后就会进入(find-empty-position board triplet)中来寻找空位填在那个triplet中，注意这里不管是电脑查找自己获胜还是阻止用户获胜都适用. find-empty-position则很简单，返回triplet中空的那个pos

(defun win-or-block (board target-sum)
  (let ((triplet (find-if 
                  #'(lambda (trip) (equal (sum-triplet board trip) target-sum))
                  *triplets*)))
    (when triplet (find-empty-position board triplet))))

(defun find-empty-position (board squares)
  (find-if #'(lambda (pos) (zerop (nth pos board))) squares))

下面两个函数分别调用win-or-block尝试查找需要填在triplet唯一那个空位的情况，如果有就将pos与策略组成list返回，如果没有则pos就是nil，and语句中第一个就会返回nil

(defun make-three-in-a-row (board)
  (let ((pos (win-or-block board (* 2 *computer*))))
    (and pos (list pos "make three in a row"))))

(defun block-opponent-win (board)
  (let ((pos (win-or-block board (* 2 *opponent*))))
    (and pos (list pos "block opponent"))))

最后的choose-best-move，如果前两种情况都返回nil则使用随机选择一个空位的策略

(defun choose-best-move (board)
  (or (make-three-in-a-row board)
      (block-opponent-win board)
      (random-move-strategy board)))

(defun random-move-strategy (board)
  (list (pick-random-empty-position board) "random move"))

(defun pick-random-empty-position (board)
  (let ((pos (+ 1 (random 9))))
    (if (zerop (nth pos board)) 
        pos
        (pick-random-empty-position board))))

总结一下,lisp中除了修改全局变量的值以外，一般不要修改局部变量的值，而是用let绑定一个新变量，这样的assignment-free的程序才是优雅的

ex 10.6

> (setf x nil)
nil
> (push x x)
(nil)
> (push x x)
((nil) nil)
> (push x x)
(((nil) nil) (nil) nil)

 

10.7 list srugery

我们可以直接修改cons的cdr指针来改变list的结构，例如可以将一个cons的cdr指向自己，产生一个环的结构：

> (setf circ (list 'foo))
(foo)

> (setf (cdr circ) circ)
(foo foo foo ...)

 

10.8 destructive operations on lists

destructive list operation是改变cons cell内容的操作，虽然可能带来一些危险如一些共享结构的修改可能造成无法预测的后果，这种操作有时候也是非常有用的，这些函数一般以F开头

nconc

和append的作用类似，区别是append实际上是创建一个新的list，而nconc是直接修改第一个list的最后一个cons的cdr来指向第二个list

特殊情况：如果(nconc x y)中x是nil，则直接返回y，而不去改变x的值

nsubst

subst的destructive版本

> (setf tree '(i say (e i (e i) o)))
(i say (e i (e i) o))

> (nsubst 'a 'e) tree)
(i say (a i (a i) o))

> tree
(i say (a i (a i) o))

> (nsubst 'cheery '(a i) tree :test #'equal)
(i say (a i cherry o))

最后两行的替换要使用#'equal对值进行比较而不是默认的eql比较地址

其它一些destructive func

• nreverse
• nunion
• nintersection
• nset-difference
• delete: remove

ex 10.9

(defun shop (x)
  (if (consp x) (setf (cdr x) nil))
  x)

ex 10.10

(defun ntack (x y)
  (nconc x (list y)))

 

10.10 setq and set

setq是比较古老的用法，作用和setf相同

set将一个值存储到一个symbol的value cell中，相当与修改这个全局变量的值

symbol-value返回一个symbol的value cell中的值

(setf duck 'donald)

(defun test1 (duck)
  (list duck (symbol-value 'duck)))

(test1 'huey) -> (huey donald)

(defun test2 (duck)
  (set 'duck 'daffy) ; 修改全局变量的值
  (list duck (symbol-value 'duck)))

(test2  'huey) -> (huey daffy)