Common Lisp : coerce 变换 sequence，例如 list, string, vector

见：Common_Lisp：A_Gentle_Introduction_to_Symbolic_Computation 13.11

> (coerce "Cockatoo" 'list)
(#\C #\o #\c #\k #\a #\t #\o #\o)

> (coerce '(#\b #\i #\r #\d) 'string)
"bird"

> (coerce '(foo bar baz) 'vector)
#(FOO BAR BAZ)


参考：

http://jtra.cz/stuff/lisp/sclr/coerce.html

http://zhushaolin2005.blog.sohu.com/147214217.html

Common Lisp : 递归函数包含 &rest 参数 的问题

见：Common_Lisp：A_Gentle_Introduction_to_Symbolic_Computation 11.14

假设递归函数名为 square-all (&rest args)，
如果函数体中递归调用 (square-all (cdr args))，会变成只传入一个参数 ((cdr args))，错误
要换成(apply #'square-all  (cdr args))，会当成列表传入多个参数，正确

Common Lisp : cdr 共享数据结构

见：Common_Lisp：A_Gentle_Introduction_to_Symbolic_Computation 6.12


> (setf x '(a b c))
(A B C)
> (setf y (cons 'd (cdr x)))
(D B C)

这里y会与x共享数据结构，因为y在构造时用到了(cdr x)

Common Lisp : cons、list、append 区别

见：Common_Lisp：A_Gentle_Introduction_to_Symbolic_Computation

6.4 一节专门比较了cons、list、append

cons 新建一个cons cell，一般用于往list头部加一个新元素

list 新建一个cons cell chain，且尾部带个NIL

append 把前一cell的cdr指向下一cell，append的首个参数必须为list

笔记：common lisp 的正则库 cl-ppcre

common lisp 的正则库 cl-ppcre : http://weitz.de/cl-ppcre/ 

提取括号匹配内容到列表

* (scan-to-strings "(([^b])*)b" "aaabd")
"aaab"
#("aaa" "a")

提取括号匹配内容到指定变量

* (register-groups-bind (fname lname (#'parse-integer date month year))
      ("(\\w+)\\s+(\\w+)\\s+(\\d{1,2})\\.(\\d{1,2})\\.(\\d{4})" "Frank Zappa 21.12.1940")
    (list fname lname (encode-universal-time 0 0 0 date month year 0)))
("Frank" "Zappa" 1292889600) 

提取匹配内容到指定变量

* (all-matches-as-strings "\\w*" "foo bar baz")
("foo" "" "bar" "" "baz" "")

分割字符串

* (split "(\\s+)" "foo bar   baz")
("foo" "bar" "baz")
 

替换

* (regex-replace "(?i)fo+" "FOO bar" "frob")
"frob bar"
T

全部替换

* (regex-replace-all "(?i)f(o+)" "foo Fooo FOOOO bar" "fr\\1b" :preserve-case t)
"froob Frooob FROOOOB bar" 

字符串反引用，相当于perl里的quotemeta

* (quote-meta-chars "[a-z]*")
"\\[a\\-z\\]\\*"

笔记：Common Lisp the Language, 2nd Edition

chapter 1  - chapter 2
 
用 | 包围含特殊符号的字符串，省的搞出一堆 \ 转义符

|A(B)|, A|(|B|)|, A\(B\) 三者都表示同一个字符串 A(B)

8进制 #o105
16进制 #x105
2进制 #b1011

函数fn  #'fn 

反引号 ` 与单引号 ' 功能类似，都是后面的内容进入数据模式；但是可以用逗号，将里面部分list内容切换到代码模式

一些键值 #\Backspace #\Tab

'(a b . (c d)) 相当于 '(a b c d)

vector, array, list

一维array称为vector

vector 存取 是O(1)量级，而 list 存取是 O(n)量级

往list头部加个元素是O(1)量级，往array头部加个元素是O(n)量级

一个vector例子 #(a b c)

bit-vector  #*10110

结构体

#S(structure-name 
        slot-name-1 slot-value-1 
        slot-name-2 slot-value-2 
                      ...)

mapcar 例子

> (mapcar #'(lambda (x y) (sqrt (* x y))) '(1 3) '(4 3))
(2 3)
 

chapter 3 - chapter 7


类型转换

(coerce '(a b c) 'vector) => #(a b c)

(coerce "a" 'character) => #\a

(coerce '(a b c) 'vector) => #(a b c) 

defvar 与 defparameter 的差别的是，

在运行期间，如果多次load file，defparameter定义的值会重新初始化，defvar则不会

批量赋值

(setf place1 newvalue1 
      place2 newvalue2) 
      ... 
      placen newvaluen) 

let 与 let* 的差别，非常清晰：http://www.lispworks.com/documentation/HyperSpec/Body/s_let_l.htm

注意，let是并行执行，而let*是串行执行 

从某个块返回

(block loser 
   (catch 'stuff 
      (mapcar #'(lambda (x) (if (numberp x) 
                                (hairyfun x) 
                                (return-from loser nil))) 
              items))) 

dolist, dotimes, do 的用法：successful lisp - Chapter 5 - Introducing Iteration

mapc、mapl 类似于 mapcar、maplist，但是返回的是后面的首个参数

mapcan、mapcon 类似于 mapcar、maplist，但是会把结果flatten

具体可以看 successful lisp - Chapter 12 - Mapping Instead of Iteration

多个返回值

(defun polar (x y) 
  (values (sqrt (+ (* x x) (* y y))) (atan y x))) 

(multiple-value-bind (r theta) (polar 3.0 4.0) 
  (vector r theta)) 
   => #(5.0 0.9272952) 

(nth-value 1 (floor number divisor))

 

lisp : 安装 quicklisp

安装quicklisp，假设放在 d:\quicklisp

> (load "http://beta.quicklisp.org/quicklisp.lisp")
> (quicklisp-quickstart:install :path "d:\\quicklisp")


把quicklisp加入启动项

> (ql:add-to-init-file)

安装或载入lisp库
> (ql:quickload "alexandria")

调用 alexandria 库函数
> (alexandria:alist-hash-table '((1 . 2) (3 . 4)))

笔记：Practial Common Lisp

命名列表

CL-USER> (getf (list :a 1 :b 2 :c 3) :a)
1



format循环打印

(defun dump-db ()
  (format t "~{~{~a:~10t~a~%~}~%~}" *db*))

其中 ~{ ~} 进入一层循环，~% 换行，~a 打印字符， ~10t 格式化字符串间距


根据指定的selector-fn条件，选取出对应的行，进行更新

(defun update (selector-fn &key title artist rating (ripped nil ripped-p))
  (setf *db*
        (mapcar
         #'(lambda (row)
             (when (funcall selector-fn row)
               (if title    (setf (getf row :title) title))
               (if artist   (setf (getf row :artist) artist))
               (if rating   (setf (getf row :rating) rating))
               (if ripped-p (setf (getf row :ripped) ripped)))
             row) *db*)))


前面加'()，括号里的内容当数据处理，不执行
> (list 1 2 '(+ 1 2))
(1 2 (+ 1 2))

前面加反引号的话，只有,()里面的内容才被解释执行（注意前面有个逗号），其余都当成列表数据
`(1 2 (+ 1 2))       → (1 2 (+ 1 2))
`(1 2 ,(+ 1 2))      → (1 2 3)

加,@() 往里拆一层出来
`(and ,(list 1 2 3))  → (AND (1 2 3))
`(and ,@(list 1 2 3)) → (AND 1 2 3)

闭包

(let ((count 0))
  (list
   #'(lambda () (incf count))
   #'(lambda () (decf count))
   #'(lambda () count)))


赋值
Simple variable:    (setf x 10)
Array:              (setf (aref a 0) 10)
Hash table:         (setf (gethash 'key hash) 10)
Slot named 'field': (setf (field o) 10)


宏参数

•  &optional 可选
•  &key  参数以关键字表示（类似perl里的hash)
•  &rest 剩余参数，也可写作 &body

在宏里面新建变量的时候，记得用上GENSYM，不然命名重复的话，宏展开后执行可能出错

笔记：Land of Lisp

chap 2 - chap 4

(defparameter *foo* 6)  全局变量，可修改
(defvar *foo* 5) 全局变量，只在定义时赋值一次
(let (a 5)) 词法变量

defun 定义全局函数
flet 定义局部函数，函数间不可相互引用
labels 定义局部函数，函数间可相互引用

'(expt 2 3) 数据模式
(expt 2 3) 代码模式

列表连接
> (cons 'pork (cons 'beef (cons 'chicken ())))
(PORK BEEF CHICKEN)

首个元素
> (car '(pork beef chicken))
PORK

除掉首个元素之后的列表
> (cdr '(pork beef chicken))
(BEEF CHICKEN)

除掉首个元素之后的列表，之后再取首个元素 =》 第二个元素嘛。。。
> (cadr '(pork beef chicken))
BEEF

还有 cddr, caddr, cddar, cadadr 等等

按顺序执行语句，最后一条语句的运行结果作为返回值
> (progn (setf *number-was-odd* t)
'odd-number)

when / unless 与progn类似，不过多一个判断条件

cond 条件可以写的比较复杂，case一般用于字符串比对

if 的结构相对简单，一个判定条件，2个分支
> (if (member 1 '(3 4 1 5))
'one-is-in-the-list
'one-is-not-in-the-list)

检查1个元素是否在列表里，如果存在，则返回以该元素为起始的剩余元素列表
> (member 1 '(3 4 1 5))
(1 5)

指定函数，对列表做grep
> (find-if #'oddp '(2 4 5 6))

eq 做符号比较
equal 做多种类型数据比较
eql 做数值和符号比较
equalp 比较复杂的比较

chap 5 - chap 6

mapcar相当于列表做函数映射(perl中的map)

apply的第一个参数指定调用函数，后面是调用该函数时传入的参数列表

>(defun describe-paths (location edges)
(apply #'append (mapcar #'describe-path (cdr (assoc location edges)))))

根据指定的key找出符合条件的记录

> (find 'y '((5 x) (3 y) (7 z)) :key #'cadr)
(3 Y)

print 每个元素单独打一行
prin1 不加换行符打印
princ 打印字符
read 输入
#\newline #\tab #\space 换行符、tab符、空格符


转换字符串列表

>(defun tweak-text (lst caps lit)
  (when lst
    (let ((item (car lst))
          (rest (cdr lst)))
      (cond ((eql item #\space) (cons item (tweak-text rest caps lit)))
            ((member item '(#\! #\? #\.)) (cons item (tweak-text rest t lit)))
            ((eql item #\") (cons item (tweak-text rest caps (not lit))))
            (lit (cons item (tweak-text rest nil lit)))
            (caps (cons (char-upcase item) (tweak-text rest nil lit)))
            (t (cons (char-downcase item) (tweak-text rest nil nil)))))))

> (tweak-text  '(#\a #\Space #\b) 't 'nil)
(tweak-text  '(#\a #\Space #\b) 't 'nil)

总共6个可能：

1. 如果是空格，原样输出
2. 如果是!/?/. 等结束符，下个字符就转成大写(tweak-text rest t lit)
3. 如果是"子字符串，则转换之前的lit模式
4. 如果正处于lit模式，则不强制转换成大写 (tweak-text rest nil lit)
5. 如果caps为真，则强制转换为大写，后面默认不转换(cons (char-upcase item) (tweak-text rest nil lit))
6. 否则，转换为小写，后面默认不转换 (cons (char-downcase item) (tweak-text rest nil nil))

> (defun game-print (lst)
 (princ (coerce (tweak-text (coerce (string-trim "() "
 (prin1-to-string lst))
'list)
t
 nil)
'string))
(fresh-line))

> (game-print  '(i am a. test "c aNnd d" b))
I am a. Test "c aNnd d" b

注意game-print的处理过程：

lambda函数

> (mapcar (lambda (n) (/ n 2)) '(2 4 6))
(1 2 3)

chap 7

循环列表，将foo尾部指针指向foo首部

> (defparameter foo '(1 2 3))
FOO
> (setf (cdddr foo) foo)
#1=(1 2 3 . #1#)

把exp中非字母数字类的字符都转换成_

(defun dot-name (exp)
(substitute-if #\_ (complement #'alphanumericp) (prin1-to-string exp)))

截取字符串s的前 *max-label-length* -3 个字符，后面加3个点

(concatenate 'string (subseq s 0 (- *max-label-length* 3)) "...")

一张edges图中有多个node，每个node有多个edge，按结构嵌套处理

(defun edges->dot (edges)
  (mapc (lambda (node)
    (mapc (lambda (edge)
      (fresh-line)
      (princ (dot-name (car node)))
      (princ "->")
      (princ (dot-name (car edge)))
      (princ "[label=\"")
      (princ (dot-label (cdr edge)))
      (princ "\"];"))
  (cdr node)))
edges))

调用thunk函数，输出的结果写入fname文件，再执行指定shell命令画图

(defun dot->png (fname thunk)
 (with-open-file (*standard-output*
fname
:direction :output :if-exists :supersede)
 (funcall thunk))
(ext:shell (concatenate 'string "dot -Tpng -O " fname)))

maplist对列表的cdr依次调用指定的函数

(defparameter *wizard-edges* '((living-room (garden west door)
(attic upstairs ladder))
(garden (living-room east door))
(attic (living-room downstairs ladder))))

(defun uedges->dot (edges)
 (maplist (lambda (lst)
    (mapc (lambda (edge)
     (unless (assoc (car edge) (cdr lst))
       (fresh-line)
       (princ (dot-name (caar lst)))
       (princ "--")
       (princ (dot-name (car edge)))
       (princ "[label=\"")
       (princ (dot-label (cdr edge)))
       (princ "\"];")))
      (cdar lst)))
edges))

  用maplist遍历edges子集合，注意每次遍历都是取cdr

  每次遍历，先用(cdar lst)取出此次首个对象对应的边的集合

  以首次遍历的节点living-room为例，就有两条边(garden west door)、(attic upstairs ladder)
 
  对于每一条边，检查这条边的节点(car edge) = garden、attic，是否会在后面(cdr lst) =(garden, attic)遇到

  如果后面还会遇到，就先不打印，死撑到最后。。。

  通过maplist、assoc的判断，实现去重，很漂亮！

chap 8

循环

(loop repeat 10
collect 1)

(loop for n from 1 to 10
collect n)

取出所有从node能够到达的节点集合visited

取出node起始的边：(direct-edges node edge-list)

从node指向的节点开始递归遍历：(traverse (cdr edge))

(defun get-connected (node edge-list)
 (let ((visited nil))
(labels ((traverse (node)
(unless (member node visited)
 (push node visited)
 (mapc (lambda (edge)
(traverse (cdr edge)))
(direct-edges node edge-list)))))
(traverse node))
visited))

分割出不相邻的节点集：
从nodes取出一个节点node，然后调用get-connected遍历，得到该节点node能够到达的节点集合connected
对剩余unconnected的节点集合重复上述处理过程 

(defun find-islands (nodes edge-list)
(let ((islands nil))
 (labels ((find-island (nodes)
(let* ((connected (get-connected (car nodes) edge-list))
(unconnected (set-difference nodes connected)))
(push connected islands)
 (when unconnected
(find-island unconnected)))))
(find-island nodes))
islands))

按顶点置换边集合：
把(1 2) (1 3) 换成(1 (2) (3))
(remove-duplicates (mapcar #'car edge-list)) 取出不重复的顶点集
对每个顶点node1，取出对应的边集合(remove-duplicates (direct-edges node1 edge-list)
把每个边集合的顶点换成list形式 (list (cdr edge))

(defun edges-to-alist (edge-list)
   (mapcar (lambda (node1)
            (cons node1
                   (mapcar (lambda (edge)
                            (list (cdr edge)))
                            (remove-duplicates (direct-edges node1 edge-list)
                                              :test #'equal))))
          (remove-duplicates (mapcar #'car edge-list))))

添加cops标记
对于每个顶点的alist集合做处理：(1 (2) (3))
例如node1 = 1 , node1-edges = (2) (3)
如果nod1-edges里的顶点node2，与node1连接的边正好在edges-with-cops边集合里
则把(node2) 转换成(node2 'cops)，否则，原样输出edge

(defun add-cops (edge-alist edges-with-cops)
   (mapcar (lambda (x)
            (let ((node1 (car x))
                  (node1-edges (cdr x)))
              (cons node1
`                     (mapcar (lambda (edge)
                              (let ((node2 (car edge)))
                              (if (intersection (edge-pair node1 node2)
                                                  edges-with-cops
                                                  :test #'equal)
                                    (list node2 'cops)
                                  edge)))
                            node1-edges))))
          edge-alist))

检查是否至少有一个cops

(some #'cdr (cdr (assoc n edge-alist)))

mapcan 将map之后的结果都合并成一个列表

> (defun ingredients (order)
     (mapcan (lambda (burger)
                (case burger
                   (single '(patty))
                   (double '(patty patty))
                   (double-cheese '(patty patty cheese))))
             order))
INGREDIENTS
> (ingredients '(single double-cheese double))
'(PATTY PATTY PATTY CHEESE PATTY PATTY)

chap 9

这章草草看过，回头有空重读一下。。。说实话，这个作者真话痨。。。

数组赋值

> (defparameter x (make-array 3))
#(NIL NIL NIL)
> (setf (aref x 1) 'foo)
FOO
> x
#(NIL FOO NIL)
> (aref x 1)
FOO

列表赋值

> (setf foo '(a b c))
(A B C)
> (second foo)
B
> (setf (second foo) 'z)
Z
> foo
(A Z C)

HASH赋值

> foo
#(NIL NIL (X Y Z) NIL)
> (setf (car (aref foo 2)) (make-hash-table))
#S(HASH-TABLE)
> (setf (gethash 'zoink (car (aref foo 2))) 5)
5
> foo
#(NIL NIL (#S(HASH-TABLE (ZOINK . 5)) Y Z) NIL)

aref在数据量较大的时候比nth快得多，nth仅适用于小数据量

> (nth 1 '(foo bar baz))
BAR

用values关键字让函数返回多个值

> (defun foo ()
    (values 3 7))
FOO
> (foo)
3 ;
7

默认只取第1个返回值，也可用multiple-value-bind绑定多个返回值

> (+ (foo) 5)
8
> (multiple-value-bind (a b) (foo)
                       (* a b))
21

hash版本的edges

 (defun hash-edges (edge-list)
   (let ((tab (make-hash-table)))
     (mapc (lambda (x)
            (let ((node (car x)))
               (push (cdr x) (gethash node tab))))
          edge-list)
     tab))

定义结构体

> (defstruct person
             name
             age
             waist-size
             favorite-color)
PERSON

新增一个对象

> (defparameter *bob* (make-person :name "Bob"
                                   :age 35
                                   :waist-size 32
                                   :favorite-color "blue"))
*BOB*

对象属性取值、赋值

> (person-age *bob*)
35
> (setf (person-age *bob*) 36)
36

直接批量赋值

 > (defparameter *that-guy* #S(person :name "Bob" :age 35 :waist-size 32 :favorite-color "blue"))

一些序列处理函数，find-if 过滤、count 计数、position 首次出现的位置、some 至少存在一个元素满足断言、every 每个元素都满足断言

> (find-if #'numberp '(a b 5 d))
5
> (count #\s "mississippi")
4
> (position #\4 "2kewl4skewl")
5
> (some #'numberp '(a b 5 d))
T
> (every #'numberp '(a b 5 d))
NIL

求和

> (reduce #'+ '(3 4 6 5 2))
20

取出最大的偶数

 > (reduce (lambda (best item)
             (if (and (evenp item) (> item best))
                 item
               best))
          '(7 4 6 5 2)
           :initial-value 0)
6

初始化数组

(make-array 5 :initial-contents '(1 2 3 4 5))

以list形式返回map结果

> (map 'list
       (lambda (x)
            (if (eq x #\s)
               #\S
               x))
       "this is a string")
 (#\t #\h #\i #\S #\  #\i #\S #\  #\a #\  #\S #\t #\r #\i #\n #\g)

子字符串

> (subseq "america" 2 6)
"eric" 

排序

> (sort '(5 8 2 4 9 3 6) #'<)
(2 3 4 5 6 8 9)

接口固定，根据参数类型处理（适用于简单判断）

> (defun add (a b)
     (cond ((and (numberp a) (numberp b)) (+ a b))
           ((and (listp a) (listp b)) (append a b))))
ADD
> (add 3 4)
7
> (add '(a b) '(c d))
(A B C D)

接口固定，支持多种参数类型处理（扩展性好）

> (defmethod add ((a number) (b number))
     (+ a b))
ADD
> (defmethod add ((a list) (b list))
     (append a b))
ADD

chap 10

循环例子

chap 11

输出内容到 t 终端 / nil字符串 / stream

> (format t "Add onion rings for only ~$ dollars more!" 1.5)
Add onion rings for only 1.50 dollars more!
NIL

~s会保留"，而~a会去掉分隔符

> (format t "I am printing ~s in the middle of this sentence." "foo")
I am printing "foo" in the middle of this sentence.
> (format t "I am printing ~a in the middle of this sentence." "foo")
I am printing foo in the middle of this sentence.

> (format t "I am printing ~10a within ten spaces of room." "foo")
I am printing foo        within ten spaces of room.
> (format t "I am printing ~10@a within ten spaces of room." "foo")
I am printing        foo within ten spaces of room.

打印数组

> (format t "~{I see a ~a... or was it a ~a?~%~}" *animals*)

两种换行

> (progn (format t "this is on one line ~%")
(format t "~%this is on another line"))
this is on one line

this is on another line
> (progn (format t "this is on one line ~&")
(format t "~&this is on another line"))
this is on one line
this is on another line

此外还有数值处理，居中、两端对齐等等，用的时候再翻书

chap 12

写文件

> (with-open-file (my-stream "data.txt" :direction :output)
 (print "my data" my-stream))

读文件

> (with-open-file (my-stream "data.txt" :direction :input)
(read my-stream))
"my data"

写字符串

> (defparameter foo (make-string-output-stream))
> (princ "This will go into foo. " foo)
> (princ "This will also go into foo. " foo)
> (get-output-stream-string foo)
"This will go into foo. This will also go into foo. "

 socket的简单例子

> (defparameter my-socket (socket-server 4321)) ;ON THE SERVER
MY-SOCKET
> (defparameter my-stream (socket-accept my-socket)) ;ON THE SERVER

> (defparameter my-stream (socket-connect 4321 "127.0.0.1")) ;ON THE CLIENT
MY-STREAM
> (print "Yo Server!" my-stream) ;ON THE CLIENT
"Yo Server!"

> (read my-stream) ;ON THE SERVER
"Yo Server!"

> (close my-stream)
T

chap 13

写了一个简单的web server

包括解析url，解析参数，解析http header，根据请求参数进行应答等等


chap 14

介绍函数式编程


chap 15

又是一个游戏


chap 16  宏

;This function is finally safe to use
(defmacro split (val yes no)
 (let1 g (gensym)
 `(let1 ,g ,val
(if ,g
(let ((head (car ,g))
(tail (cdr ,g)))
,yes)
,no))))

其中，gensym是为了避免调用的时候也有变量名为g，导致冲突出错


chap 17

DSL介绍，举了svg的例子，大概就是新建一些函数or宏，生成特定格式的文件or转换为特定格式的内容

比较灵活，容易自行扩展，但只适用于特定领域

chap 18

延迟求值

chap 19

游戏例子，没看

chap 20

还是游戏例子，没看