工具函数

lisp 里有三种类型:
函数, 宏, 特殊格式. 其中, 自己能写的只有函数和宏.

写函数的灵感从哪里来比函数怎么写要重要的得多.
写可扩展语言本身的函数与写任何函数的方法差不多.

写扩展语言本身函数的难点不是怎么写, 而是写什么.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
工具的诞生

工具函数: 重组lisp语言已有的函数和宏，让写程序变得更简单

很多内置的lisp函数, 最开始只是一个工具函数, 后来用的人多了, 便成了标准函数

学习写工具函数, 本质是养成写工具函数的习惯.

自下而上写程序, 意味着, 写程序的同时, 也写了一个编程语言.
为了达到这个目的, 你必须有非常好的意识, 发现缺少哪些操作.
你必须有一眼能看出来本质的能力: "啊, 原来你说的是这个."

比如, 如果 "昵称" 是为一个名字生成一堆昵称的函数,
那么, 怎么样给一系列名字生成昵称, 并且放到一个列表里呢?
(defun 昵称 (名字) '(小名小字名字))

(defun 所有的昵称 (名单)
(if (null 名单)
nil
(nconc (昵称 (car 名单))
(所有的昵称 (cdr 名单)))))

一个有经验的lisp程序员会立即认出来: "哦, 你说的原来是mapcan."
然后, 他将用一句话来实现这个功能, 而不是重定义一个函数
(mapcan #'昵称名单)

这里的"所有的昵称"只是在重复发明轮子.
而且, 它将一个通用的操作, 放在了一个专用的函数里.

这个例子里, mapcan, 是已经存在的函数.
所有认识 mapcan 的程序员, 看到 "所有的昵称" 函数之后, 会有一点不舒服.
更优秀的编程人员, 即使不认识 mapcan, 也会感觉到不舒服
你必须能讲出 "你真正需要的是x", 同时, 你还要知道x究竟是什么.

lisp 编程, 很自然地将需要的工具造出来
下面将展示工具是如何诞生的.

"城市" 是所有周边的城市, 由近及远
"书店" 是一个函数, 列出城市里所有的书店
如果你想找到最近的有书店的城市及它那里有哪些书店, 你可以这样写:
(let ((城 (find-if #'书店城市)))
(values 城 (书店城)))
但是这种实现方法不好, 因为, 将"书店"函数返回第一个非空值的时候, 这个值被丢弃了.
然后会被再重新调用一次, 来得到返回值.
如果"书店"函数是一个很消耗资源的调用, 那么这种实现就很傻逼了.
因此, 我们来做以下改写

(defun 找书店 (城市名单)
(if (null 城市名单)
nil
(let ((找到的店 (书店 (car 城市名单))))
   (if 找到的店
   (values (car 城市名单) 找到的店)
   (找书店 (cdr 城市名单))))))

这里的(找书店城市)让我们不需要多算一次.
但是这样的搜索方式我们未来可能还会再用到
所以我们真正需要的功能是find-if 与 some的组合
返回值是测试函数为真的值. 理理成章地定义一个新函数
(defun 查询 (fn lst)
(if (null lst)
nil
(let ((val (funcall fn (car lst))))
   (if val
   (values (car lst) val)
   (查询 fn (cdr lst))))))

注意, 这个函数与上一个函数是很相似的.
"查询"函数是"找书店"函数的框架.
lisp 的牛逼在于, 你可以搭一个骨架, 然后将血肉作为函数传进去.

现在, 我们想查找城市名单里中, 最近的城市里哪个是有书店, 并且列出书店
只需要一句程序
(查询 #'书店城市名单)

编程技术中, 很重要的一点, 就是将函数作为参数来传递
这是自下而上编程的基本方式
将骨架写成一个函数, 再将血肉写成一个函数, 血肉作为参数传到骨架上.

最简单的讲述式编程, 是将动词重用.
说一个主语参与的一件事, 写一个陈述
说另一个主语参与的同一件事, 写另一个陈述
这中间肯定有重复的地方,
那么不如将这件事写一个陈述, 将两件事的主语作为两个参数传进来

函数化编程, 就走得更远一些. 创造更多的动词, 串在一起, 组成更复杂的动作.

所以, 核心思想是, 将事情的细节拿出去, 将骨架写成新的函数, 再将细节作为参数传进来

这种方式, 可以写出来更优秀的程序.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
在抽象度上下功夫

智慧在于说话简短, 写程序也是一样.
程序的维护成本取决于它的长度, 越短的程序维护越简单.
所以, 将"找书店"写成"查询"的时间消耗, 是一项投资. 让后面写程序变得容易.
写工具, 更大的作用是实现文件的隔离, 不会打扰我们的视线

工具也需要额外的关心, 把它们写得好一些, 会事半功倍, 如果它们写的不好, 就会放大问题.
新工具必须是为了通用情况而写的, 而不是为了眼前的问题.
如果你解决得是个眼前问题, 还不确定将来是否可以遇到类似情况, 先把它放在眼下这个程序里
如果你未来写新程序又用到它了, 就把它给集成到工具里.

如果一种语言的扩展性不强, 又追求简练, 就会产生问题
因为简练的语言, 往往程序的运行效率不高

比如, 我们这样比较两个列表长度
(> (length x ) (length y))
或者, 我们这样将一个函数映射到多个列表上:
(mapcar fn (append x y z))
你会看出这样的处理极端低效, 必须自己来写工具.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
列表操作

lisp 名字的由来即是: list processing, 列表处理.
今天, 在编译的时候, list 即列表, 仍是主要的数据结构

(proclaim '(inline 尾元素单体连接链接列出))

(last '(1 2 3))
(defun 尾元素 (列表)
(car (last 列表)))
返回列表的最后一个元素.
内置的last返回的是最后的cons, 而不是最后的元素.
所以用内置函数的时候, 大家都会写(car (last ..), 专门搞一个工具是很有必要的.
注意, "尾元素"函数不会做任何的容错检测, 短工具不做错误检测是很正常的.

(尾元素 '(1 2 3 ))
(尾元素 "hi")
工具形成的抽象层是很薄的.
薄到几乎是透明的, 下层产生的错误可以被直接看到.

(defun 单元 (列表)
(and (consp 列表) (not (cdr 列表))))
"单元" 功能是检测参数列表是不是只有一个元素.
lisp程序里, 这个操作是非常常用的.
大家通常的写法是
(=(legnth lst) 1)
但是这样写实在是太低效了.
其实我们看完第一个元素, 就已经得到我们想知道的信息了.
(单元 '(1))

(defun 连接 (列表元素)
(append 列表 (list 元素)))
将元素接到列表的末尾.

(defun 链接 (列表元素)
(nconc 列表 (list 元素)))
破坏性地将元素接到列表的末尾.

(defun 造表 (元素)
(if (listp 元素) 元素 (list 元素)))
保证数据是lisp格式的.
使用的场景如下:
(mapcan #'(lambda (d) (mklist (lookup d)))
data)

(defun 更长 (x y)
(labels ((比较 (x y)
   (and (consp x) ; x 没到尽头
       (or (null y) ; y不为空
       (compare (cdr x ) (cdr y)))))) ; x的尾与 y的尾接着比
(if (and (listp x) (listp y))
   (比较 x y) ; 是list的时候, 就用自己写的比较
   (> lenght x) (length y)))) ; 不然调自带的length

(defun 过滤 (函数列表)
(let ((积累 nil)) ; 积累已经处理的部分
(dolist (x 列表) ; 用x遍历列表元素
(let ((值 (funcall 函数 x))) ; 存函数值
(if 值 (push 值积累)))) ; 值为真, 则保存这个值
(nreverse 积累)))

(defun 组 (源 n) ; 将源里的元素, n份n份地放在一起, 最后不足的也放一份
(if (zerop n ) (error "zero length")) ; 参数不能为0
(labels ((分组 (源积累)
   (let ((尾 (nthcdr n 源))) ; 前n个拿掉的部分先存在尾里
   (if (consp 尾)
       (分组尾 (cons (subseq 源 0 n) 积累)) ; 将前n个搞成一组, 放进积累里, 继续搞尾
       (nreverse (cons 源积累)))))) ; 积累即是我们所得, 转向
(if 源 (分组源 nil) nil)))
(组 '(1 2 3 4 5) 2)
"组"函数是为了写成尾递归, 所以才显得这么复杂

(defun 压扁 (x)
(labels ((压 (x 积累)
   (cond ((null x) 积累)
       ((atom x) (cons x 积累))
       (t (压 (car x) (压 (cdr x) 积累))))))
(压 x nil)))
(压扁 '( 1 (2 3 ( 4 5) ) 4))

(defun 修剪 (检测树) ; 把满足检测条件的元素给删掉
(labels ((测 (树余)
   (cond ((null 树) (nreverse 余))
       ((consp (car 树)) (测 (cdr 树) (cons (测 (car 树) nil) 余)))
       (t (测 (cdr 树) (if (funcall 检测 (car 树))
               余
               (cons (car 树) 余)))))))
(测树 nil)))

(修剪 #'zerop '( (1 2 3 ) 0 1 2 3 (0 4 5 6)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
查找

(defun 寻找 (察看列表)
(if (null 列表)
nil
(let ((结果 (funcall 察看 (car 列表))))
   (if 结果
   (values (car 列表) 结果) ; 若找到, 则返回所需要的元素, 和察看元素的结果
   (寻找察看 (cdr 列表)))))) ; 若没找到, 则接着寻找察看剩下的元素

(defun 在前 (x y 列表 &key (test #'eql))
(and 列表
(let ((首 (car 列表)))
   (cond ((funcall test y 首) nil)
   ((funcall test x 首) 列表)
   (t (在前 x y (cdr 列表) :test test))))))

(在前 'a 'b '(1 2 3 a b))
(在前 'a 'b '(a))

(defun 在后 (x y 列表 &key (test #'eql ))
(let ((剩余 (在前 y x 列表 :test test))) ; 找到 y 在 x 前面的结果,
(and 剩余 (member x 剩余 :test test)))) ; 列表不为空, 且 x 要在列表里

(在后 'a 'b '(a)) ; 为什么要检测x是否在这个列表里, 就是这种情况

(defun 重复 ( 元素列表 &key (test #'eql))
(mebmer 元素 (cdr (member 元素列表 :test test)) :test test)) ; 看是不是成员, 找到之后, 再找一次, 则重复.

(defun 斩 (检测列表)
(let ((积累 nil))
(do (( 源列表 (cdr 源))) ; 设源, 初始为列表, 每个循环中, 源=(cdr 源)
(( or (null 源) (funcall 检测 (car 源))) ; 测试条件; 源为空, 或满足测试条件
(values (nreverse 积累) 源)) ; 将积累和源返回
(push (car 源) 积累)))) ; 否则, 将这个元素存入积累
(斩 #'(lambda (x) (= x 5)) '( 1 2 3 5 3 2 1))

下面这些函数是列表内的元素互相比较.

(defun 冠军 (比较列表) ; 比较之后, 返回冠军元素及分数
(if (null 列表)
(values nil nil)
(let* ((牛人 (car 列表))
   (最高分 (funcall 比较牛人)))
   (dolist ((选手 (cdr 列表)))
   (let ((分数 (funcall 比较选手)))
   (when (> 分数最高分)
   (setq 牛人选手
       最高分分数))))
   (values 牛人最高人))))

函数更为通用. 比较函数默认是取两个参数
(defun 最优 (比较列表)
(if (null 列表)
nil
(let ((牛人 (car 列表)))
   (dolist (成员 (cdr 列表))
   (if (funcall 比较成员牛人)
   (setq 牛人成员)))
   牛人)))

(最优 #'> '(1 2 3 4 5))
(car (sort '(1 2 3 4 5) #'>)) ; 同等效果, 但是效率比"最优"低多了

(defun 冠军们 (比较列表) ; 可并列
(if (null 列表)
(values nil nil)
(let ((结果 (list (car 列表)))
   (最大值 (funcall 比较 (car 列表))))
   (dolist (元素 (cdr 列表))
   (let ((分数 (funcall 比较元素)))
   (cond ((> 分数最大值) (setq 最大值分数
                   结果 (list 元素)))
       ((= 分数最大值)
       (push 元素结果)))))
(values (nreverse 结果) 最大值))))

(冠军们 #'length '(1 (1) (1 2 ) ( 3 4 )))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
映射
由于读者反应中文编程反而看不懂, 所以下面还是改为英文代码

另一类广泛应用的函数是映射函数. 即将一个函数施加于一个参数序列上.

看以下例子.

如何将一个函数应用于一系列数字上, 但不需要用cons来组合起这些数字?
(defun map0-n (fn n )
(mapa-b fn 0 n))

(defun map1-n (fn n)
(mapa-b fn 1 n))
以上两个都是映射到指定泛围的正整数.

这里是通用定义, 作用于数字

(defun mapa-b (fn a b &optional (step 1))
(do ((i a (+ i step))
(result nil))
((> i b ) (nreverse result))
(push (funcall fn i) result)))

(mapa-b #'1+ 1 10 3 )

更为通用的映射方法
(defun map-> (fn start test-fn succ-fn)
(do ((i start (funcall succ-fn i )) ; succ-fn 是更新i的方法
(result nil))
((funcall test-fn i) (nreverse result)) ; test-fn 是检测i的方法
(push (funcall fn i) result))) ; 在 i 上执行方法fn 并记入 result

用map->来写一个新的mapa-b
(defun mapa-b (fn a b &optional (step 1))
(map-> fn a
#'(lambda (x) (> x b))
#'(lambda (x) (+ step x))))

为了效率, 内置的 mapcan 是破坏性的. 下面我们来定义一个自己的
(defun our-mapcan (fn &rest lsts)
(apply #'nconc (apply #'mapcar fn lsts)))

(mapcan #'reverse '( (1) (1 2) (1 2 3)))
(our-mapcan #'reverse '( (1) (1 2) (1 2 3)))
mappend 是非破坏性的mapcan
(mappend #'reverse '( (1) (1 2) (1 2 3)))

(defun mappend (fn &rest lsts)
(apply #'append (apply #'mapcar fn lsts))) ; fn should return list
(mappend #'reverse '((1 2) (1 2 3))) ; 看看结果

(defun mapcars (fn &rest lsts) ; 遍历列表的列表
(let ((result nil))
(dolist (lst lsts)
(dolist (obj lst)
(push (funcall fn obj) result)))
(nreverse result)))

(mapcars #'reverse '((1 2 3) (2 3 4))) ; 看看效果
(mapcar #'sqrt (append '(1 2 3) '(4 5 6)))
(mapcars #'sqrt '(1 2 3) '(4 5 6))

(some #'(lambda (x) (> x 4)) '( 1 2 3 4 5 6)) ; 看一下some的用法,
; 遇到第一个满足的元素, 返T
(some #'atom '( (1) 1 (2)))
(defun test (&rest args) ; 看看 &rest 的用法, 将后面的参数放到列表里传进来
args)
(test)
(test 1 2 3)

revursive mapcar 即是针对树的 mapcar
(defun rmapcar (fn &rest args)
"resusive mapcar list of lists"
(if (some #'atom args)
(apply fn args)
(apply #'mapcar
   #'(lambda (&rest args)
       (apply #'rmapcar fn args))
   args)))

(rmapcar #'(lambda (x) (+ 1 x)) '( 1 2 (3 4) 1))
(rmapcar #'princ '(1 2 (3 4 (5) 6) 7 (8 9)))
它也可以作用在两个树上
(rmapcar #'+ '( 1 (2 (3) 4)) '(10 (20 (30) 40))) ;两个树的结构需要一致, 来配+号

CLTL2里有新宏, 可以重新定义 (mapa-b #'fn a b c)
; (collect (#M fn (scan-range :from a :upto b :by c)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
I/O
(defun readlist (&rest args) ;;
(values (read-from-string ; 将字符串读入lisp reader
   (concatenate 'string "(" ; 将读进来的东西, 用括号括起来
           (apply #'read-line args)
           ")"))))

(readlist) ;; 读入一行输入, 并且将它放在list里.

(defun prompt (&rest args)
(apply #'format *query-io* args) ; 将参数Format之后传入read里.
(read *query-io*)) ; 打印出来Args, 然后等着接收答案

(defun break-loop (fn quit &rest args)
(format *query-io* "Entering break-loop.~%")
(loop
(let ((in (apply #'prompt args)))
(if (funcall quit in)
(return)
(format *query-io* "~A~%" (funcall fn in))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
符号和字符串

符号和字符串紧密相关. 通过打印和读取函数, 我们可以在这两者之间切换

(defun mkstr (&rest args) ; 将所有的参数放在一个字符串里.
(with-output-to-string (s) ; create a character output stream
(dolist (a args) (princ a s)))) ;write objec into stream

将字符串给intern, intern 是专门用来生成symbol的
任何一个字符串都可以作为symbo的打印名
(defun symb (&rest args)
(values (intern (apply #'mkstr args))))

symb的通用型式
将一系列对象打印为字符, 并且用read来读它们
(defun reread (&rest args)
(values (read-from-string (apply #'mkstr args))))
注意, a:b将被read认为是包a中的symbol b. .
如果reread读的内容不合lisp的语法, 它会报错.

读一个symbol, 将组成它名字的字母打出来.
(defun explode (sym)
(map 'list #'(lambda (c)
(intern (make-string 1
:initial-element c)))
(symbol-name sym)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
结论.

如果你的代码里, 写了许多自己的工具, 那么别的读代码的人, 就会抱怨你的代码难懂.
对lisp不熟的程序员只习惯于读原生的lisp, 没想过要扩展语言本身.
当这些程序员看到这种很多工具的程序时, 会觉得作者很怪, 在定义自己的语言
其实, 学新的语言比看复杂的冗余程序要简单得多.

读自下而上写出来的程序, 需要看所有作者定义的新操作.
但其实这个时候, 程序已经变得更短更简单了.