勿在浮沙筑高台--由LISP公理推导函数的几个练习

Highflybird · 发表于 2013-5-19 11:20:07

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

本帖最后由 Highflybird 于 2013-6-1 17:23 编辑

此次练习由下面的帖子所引发：
http://bbs.xdcad.net/thread-668169-1-1.html

这些练习题的要求，形成的函数中只用到 quote atom cond eq car cdr cons 这七个基本函数和它们组合的函数构成：

附加说明： setq,defun,lambda,function,and,not,null,or 这几个也可以作为基本函数。当然，and,not,null,or 这几个函数也可以由七个公理推出。你不妨也去练习一下这四个逻辑判断函数。
但 apply ,eval，mapcar不能直接使用，除非你用基本函数去定义它们。
练习题1：
=============================================
Subst#
(为区别lisp原有的函数名，我在函数的名后面加了个#)
这个函数跟subst 类似，但又不同。
函数功能是替换，就是把表中的指定的项全部替换：(可能嵌套）
例如：
(subst# 'm 'b '(a b (a b c) d))
==> (a m (a m c) d)
当然，对数据也行：
(subst# 2 3  (list 1 (list 2 (list 3 2 5) 6 3 7) 2 3))
==> (1 (2 (2 2 5) 6 2 7) 2 2)

练习题2：
=============================================
Append#
这个函数跟append相同。取两个表并返回它们的连结.
(append# '(a b) '(c d))
==>(a b c d)
(append# '() '(c d))
==>(c d)
练习题3：
=============================================
Pair
(pair. x y)取两个相同长度的表,返回一个由双元素表构成的表,双元素表是相应位置的x,y的元素对.
例如:
(pair. '(x y z) '(a b c))
==>((x a) (y b) (z c))

练习题4：
=============================================
Assoc#
(assoc# x y)取原子x和形如pair.函数所返回的表y,返回y中第一个符合如下条件的表的第二个元素:它的第一个元素是x.
例如： (assoc# 'x '((x a) (y b)))
==>a
(assoc#  'x '((x new) (x a) (y b)))
==>new

以后慢慢添加。。

Highflybird · 发表于 2013-5-19 11:36:37

Free-Lancer 发表于 2013-5-19 11:33
一个 Common lisp 中关于 Subst
http://clhs.lisp.se/Body/f_substc.htm

嗯，如果不能自己思考出来的，想要知道怎么弄的，完全可以参考如下链接：
http://daiyuwen.freeshell.org/gb/rol/roots_of_lisp.html

Free-Lancer · 发表于 2013-5-19 11:33:27

一个 Common lisp 中关于 Subst
http://clhs.lisp.se/Body/f_substc.htm

牢固 · 发表于 2013-5-20 14:06:40

;;给大家写个Append#函数,理解了这个函数，大家就知道在涉及大量表运算时，
;; append函数的效率要比cons函数的效率低的原因了！
;; (append# '(1 2 3 4) '(5)) 经过4次cons运算得到 '(1 2 3 4 5)
(defun append# (a b)
(cond (a (cons (car a) (append# (cdr a) b)))
(t b)
)
)
;;测试用 append函数组表
(defun c:tt ()
(setq i 0 l nil)
(setq StartTime (car (_VL-TIMES)))
(repeat 10000
(setq l (append l (list (setq i (1+ i)))))
)
(princ (strcat "\n 用时 " (rtos (* 0.001 (- (car (_VL-TIMES)) StartTime)) 2 4) " 秒 "))
(princ)
)
;|命令: tt
用时 6.438 秒
|;
;;用cons函数组表
(defun c:tt1 ()
(setq i 0 l nil)
(setq StartTime (car (_VL-TIMES)))
(repeat 10000
(setq l (cons (setq i (1+ i)) l))
)
(reverse l)
(princ (strcat "\n 用时 " (rtos (* 0.001 (- (car (_VL-TIMES)) StartTime)) 2 4) " 秒 "))
(princ)
)
;|命令: tt1
用时 0.031 秒
|;
;;用cons函数用时几乎可以忽略，而用Append却用了6秒多,所以在涉及大量Append运算时，我们要尽量想方设法避免！

;;给大家写个Append#函数,理解了这个函数，大家就知道在涉及大量表运算时， 
;; append函数的效率要比cons函数的效率低的原因了！ 
;; (append# '(1 2 3 4) '(5)) 经过4次cons运算得到 '(1 2 3 4 5) 
(defun append# (a b) 
  (cond (a (cons (car a) (append# (cdr a) b))) 
        (t b) 
        ) 
  ) 
;;测试 用 append函数组表 
(defun c:tt () 
  (setq i 0 l nil) 
  (setq StartTime (car (_VL-TIMES))) 
  (repeat 10000 
    (setq l (append l (list (setq i (1+ i))))) 
    ) 
  (princ (strcat "\n  用时  " (rtos (* 0.001 (- (car (_VL-TIMES)) StartTime)) 2 4) "  秒 ")) 
  (princ) 
  ) 
;|命令: tt 
  用时  6.438  秒 
  |; 
;;用cons函数组表 
(defun c:tt1 () 
  (setq i 0 l nil) 
  (setq StartTime (car (_VL-TIMES))) 
  (repeat 10000 
    (setq l (cons (setq i (1+ i)) l)) 
    ) 
  (reverse l) 
  (princ (strcat "\n  用时  " (rtos (* 0.001 (- (car (_VL-TIMES)) StartTime)) 2 4) "  秒 ")) 
  (princ) 
  ) 
;|命令: tt1 
  用时  0.031  秒 
  |; 
;;用cons函数用时几乎可以忽略，而用Append却用了6秒多,所以在涉及大量Append运算时，我们要尽量想方设法避免！

黑洞—杜明智 · 发表于 2013-5-20 16:19:03

又够想一阵子了！

Free-Lancer · 发表于 2013-5-20 20:58:25

Assoc# 来了

(defun assoc# (x y)
(cond
((= y nil) nil)
((= (caar y) x) (car y))
(t
(assoc# x (cdr y))
)
)
)

xshrimp · 发表于 2013-5-20 22:04:04

本帖最后由 xshrimp 于 2013-5-20 22:24 编辑

(defun Pair(x y)
(cond (x (cons (list (car x)(car y)) (Pair (cdr x) (cdr y))))
(t nil)
)
)

(pair '(x y z) '(a b c))
==>((x a) (y b) (z c))

表长度不一致时,按照最短的表返回

(defun Pair(x y)
(if(and x y) (cons (cons(car x)(car y)) (Pair (cdr x) (cdr y))))
)

eachy · 发表于 2013-5-20 22:10:41

xshrimp 发表于 2013-5-20 22:04
(pair '(x y z) '(a b c))
==>((x a) (y b) (z c))

如果表一长一短呢？

xshrimp · 发表于 2013-5-20 22:16:38

本帖最后由 xshrimp 于 2013-5-20 22:20 编辑

eachy 发表于 2013-5-20 22:10
如果表一长一短呢？

按照最短表的长度决定.mapcar就是

(defun Pair(x y)
(mapcar '(lambda(a b) (list a b)) x y)
)

(pair '(1 2 3) '(a b c))
=>((1 A) (2 B) (3 C))

(pair '(1 2 ) '(a b c))
=>((1 A) (2 B))

(pair '(1 2 3) '(a b))
=>((1 A) (2 B))

eachy · 发表于 2013-5-20 23:02:21

Free-Lancer 发表于 2013-5-20 20:58
Assoc# 来了

和LZ的要求还有差距

xshrimp · 发表于 2013-5-20 23:13:19

我来个subst#

(defun subst#(n o lst / x)
(if lst
(cons
(cond
((atom (setq x (car lst)))
(if (= x o) n x)
)
(T (subst# n o x))
)
(subst# n o (cdr lst))
)
)
)

例如：
(subst# 'm 'b '(a b (a b c) d))
==> (a m (a m c) d)

(subst# 2 3 '( 1 (2 ( 3 2 5) 6 3 7) 2 3))
==> (1 (2 (2 2 5) 6 2 7) 2 2)

eachy · 发表于 2013-5-20 23:27:22

xshrimp 发表于 2013-5-20 23:13
我来个subst#例如：
(subst# 'm 'b '(a b (a b c) d))
==> (a m (a m c) d)

是这样写的
http://www.xdcad.net/forum/forum ... 196&pid=3454915

xshrimp · 发表于 2013-5-20 23:46:39

把上面链接的
ll_j发布这个subst#贴上来

(defun subst# (x y z)
(cond
((atom z)
(cond ((eq z y) x)
(t z)
)
)
(t
(cons (subst# x y (car z))
(subst# x y (cdr z))
)
)
)
)

/db_自贡黄明儒_ · 发表于 2013-5-21 17:57:34

本帖最后由 /db_自贡黄明儒_ 于 2013-5-21 18:00 编辑

高飞的这个看起来简单，其实难呀，
(defun append# (x y)
(cond ((car x) (cons (car x) (append# (cdr x) y)))
((car y) (cons (car y) (append# (cdr y) x)))
)
)
我的这个满足高飞的要求，看看行不？

牢固 · 发表于 2013-5-21 18:31:45

/db_自贡黄明儒_ 发表于 2013-5-21 17:57
高飞的这个看起来简单，其实难呀，
(defun append# (x y)
(cond ((car x) (cons (car x) (append# (cdr ...

第二个条件的写法多余，直接 y就ok了！看楼上我的回复！

账号		自动登录	找回密码
密码			立即注册

[研讨] 勿在浮沙筑高台--由LISP公理推导函数的几个练习

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

评分

相关帖子

评分

点评

评分

点评

评分

评分