Ok, Go ahead.

1

(a)

(b)

(c)

(d)

2

注:union 在 Common Lisp 中的作用就是求两个集合的并集。但是这有一个前提,即给的两个列表已经满足集合的属性了。具体的操作过程似乎是对第一个 list 中的每一个元素在第二个 list 中查找,如无则标记一下;待第一个 list 的所有元素在第二个 list 中查完以后将所有标记过的元素放入一个 list 中与第二个 list 进行合并。这意味着,如果刚开始给的两个 list 不完全满足集合的属性,则会有重复出现。本题依照这种思路来完成。

(defun new-union (lst1 lst2)
    (let ((tmplst '()))
        (dolist (obj lst2)
            (if (not (member obj lst1))
                (setf tmplst (append tmplst (cons obj '())))
                nil))
        (append lst1 tmplst)))

3

(defun occurrences (lst)
    (let ((tmplst '()))
        (dolist (obj lst)
            (if (assoc obj tmplst)
                (setf tmplst (addcount obj tmplst))
                (setf tmplst (append tmplst (cons (cons obj 1) nil)))))
        (sort tmplst #'(lambda (lst1 lst2) (> (cdr lst1) (cdr lst2))))))

(defun addcount (obj tmplst)
    (let (reslst '())
        (dolist (xobj tmplst)
                (if (equal (car xobj) obj)
                    (setf reslst (append reslst (cons (cons obj (+ (cdr xobj) 1)) nil)))
                    (setf reslst (append reslst (cons xobj '())))))
        reslst))

4

'(a) 不是 atom,'a 才是 atom。而 member 是采用 eql 判断相等,不是用 equal。个人感觉 (remove '(a . 2) '((a . 2) (b . 3))) 达不到效果也是这个原因。

P.S. 后来在读到第四章时发现,这个问题可以添加 关键字参数 :test #'equal 来解决。(英文版 67 页)

5

; iteration
(defun pos+1 (lst)
    (let ((tmplst nil) (n 0))
        (dolist (obj lst)
            (setf tmplst (append tmplst (cons (+ obj n) nil)))
            (setf n (+ n 1)))
        tmplst))

; recursion
(defun pos+2 (lst)
    (wtf lst 0))

(defun wtf (lst n)
    (if (null lst)
        nil
        (cons (+ (car lst) n) (wtf (cdr lst) (+ n 1)))))

; mapcar (In fact, I also use iteration to create a list from 0 to n-1...)
(defun pos+3 (lst)
    (mapcar #'+ lst
        (let ((tmplst nil) (n 0))
            (dolist (obj lst)
                (setf tmplst (append tmplst (cons n nil)))
                (setf n (+ n 1)))
            tmplst)))

6

注:第一个 cons 的改写不太明白怎么做。cons 已经是基本的操作符之一了。另外第三个 list 的改写需要用到后面的函数接受不定参数。根据知识屏蔽原则,先标记上,将来学到那里了再反过头来补上。再,刚开始定义的 cdr-x 和 car-x 均为题中“政府”制定的 cdr 和 car。

(defun cdr-x (lst)
    (car lst))

(defun car-x (lst)
    (cdr lst))

(defun cons-new (obj lst)
    ())

(defun length-new (lst)
    (if (null lst)
        0
        (+ 1 (length-new (car-x lst)))))

(defun member-new (obj lst)
    (if (null lst)
        nil
        (if (eql obj (cdr-x lst))
            lst
            (member-new obj (car-x lst)))))

7

仅仅修改了 n-elts 函数,使之返回一个 dotted list 而不是一个 proper list

; modified version
(defun compress-m (x)
    (if (consp x)
        (compr-m (car x) 1 (cdr x))
        x))

(defun compr-m (elt n lst)
    (if (null lst)
        (list (n-elts-m elt n))
        (let ((next (car lst)))
            (if (eql next elt)
                (compr-m elt (+ n 1) (cdr lst))
                (cons (n-elts-m elt n)
                        (compr-m next 1 (cdr lst)))))))

(defun n-elts-m (elt n)
    (if (> n 1)
        (cons n elt) ; modify here
        elt))

8

(defun showdots (lst)
    (let ((n (length lst)))
        (dolist (obj lst)
            (format t "(~A . " obj))
        (format t "NIL")
        (do ((i 1 (+ i 1)))
            ((> i n) 'nil)
            (format t ")"))))

9

前注:一开始感觉在 3.15 节那个 bfs 算法上改动一下,使当前 node 等于 end 并且 (cdr queue) 为 nil 时再返回,这样可以找到 longest path。然而为了避免在环路中无终止,需要再加上两个限制,都是针对 new-paths 函数的:1. 如果当前带入的 node 是 end 的话,就废弃这条路,不再返回;2. 如果非 1 中情况,先把 mapcar 映射得到的列表搞出来,把其中存在重复元素的子列表删去(即环路),再返回给 bfs 函数。

(defun shortest-path (start end net)
    (bfs end (list (list start)) net))

(defun bfs (end queue net)
    (if (null queue)
        nil
        (let ((path (car queue)))
            (let ((node (car path)))
                (if (and (eql node end) (null (cdr queue)))
                    (reverse path)
                    (bfs end
                        (append (cdr queue)
                                (new-paths path node end net))
                                net))))))

(defun new-paths (path node end net)
    (if (equal node end) ; if node = end, abandon it
        nil
        (let ((tmplst (mapcar #'(lambda (n) (cons n path)) (cdr (assoc node net))))
              (reslst nil))
            (dolist (obj tmplst)
                (if (> (no-repeat obj) (length obj)) ; only return the path which has no repeat dots
                    (setf reslst (cons obj reslst))
                    nil))
            reslst)))

(defun no-repeat (lst) ; judge whether there are repeat dots in a path list. if yes, return number less than or equal to length(lst); or return length(lst)+1
    (let ((tmplst nil))
        (do ((i 1 (+ i 1)))
            ((or (member (nth (- i 1) lst) tmplst) (> i (length lst))) i)
            (setf tmplst (cons (nth (- i 1) lst) tmplst)))))

用于测试的网络:1. '((a b c) (b c) (c d) (d b)) 2. '((a b) (b e) (e f c) (c b d f) (f c))
后注:体会到了 lisp 调试的好。直接在 clisp 里边 load 一下,然后直接顶层调用相关函数,就可以调试了,速度很快。

ANSI Common Lisp Practice - My Answers - Chatper - 3的更多相关文章

  1. ANSI Common Lisp Practice - My Answers - Chatper - 2

    I work out the questions by myself Chapter 2 question 4. (defun greater (x y) (if (> x y) x y ) ) ...

  2. 简体中文 — ANSI Common Lisp 中文版

    简体中文 - ANSI Common Lisp 中文版 简体中文¶

  3. ANSI Common Lisp 中文翻譯版 — ANSI Common Lisp 中文版

    ANSI Common Lisp 中文翻譯版 — ANSI Common Lisp 中文版 ANSI Common Lisp 中文翻譯版¶

  4. ANSI Common Lisp Learn

    It has been a long time that I haven't dealt with my blog. On one hand I was preparing the exams.On ...

  5. MAC 下用 Common Lisp 调试 OpenGL 程序

    MAC 下用 Common Lisp 调试 OpenGL 程序 环境搭建 运行环境: OSX 10.11.3 EI Capitan Common Lisp: SBCL 使用 SBCL, 首先要安装这几 ...

  6. 在windows上安装common lisp开发环境

    (2014.1写于CSDN的文章) 最近对lisp非常感兴趣,因此在google中搜索了“common lisp install windows”, 想装一个开发环境玩玩. 第一条结果就是 “Gett ...

  7. Common Lisp学习资源整理

    Lisp Hackers: Interviews with 100x More Productive Programmers Posted on June 26th, 2013 Lisp Hacker ...

  8. 一道Common Lisp 宏的练习题

    这是<ANSI Common Lisp>第10章“宏”的习题第6题: 定义一个宏,接受一变量列表以及一个代码主体,并确保变量在代码主体被求值后恢复 (revert)到原本的数值

  9. 搭建fedora开发环境 common lisp, c++, go

    第三方软件库: http://download1.rpmfusion.org/free/fedora/releases/25/Everything/x86_64/os/repoview/index.h ...

随机推荐

  1. LBaaS 实现机制 - 每天5分钟玩转 OpenStack(125)

    上一节我们已经配置并测试 LBaaS,今天重点分析 Neutron 是如何用 Haproxy 来实现负责均衡的. 在控制节点上运行 ip netns,我们发现 Neutron 创建了新的 namesp ...

  2. 理解 Neutron FWaaS - 每天5分钟玩转 OpenStack(117)

    前面我们学习了安全组,今天学习另一个与安全相关的服务 -- FWaaS.理解概念 Firewall as a Service(FWaaS)是 Neutron 的一个高级服务.用户可以用它来创建和管理防 ...

  3. JavaScript:让浏览器全屏显示

    并不是所有人都会按F11让浏览器全屏显示~~~ 一.直接上代码 <!DOCTYPE html> <html xmlns="http://www.w3.org/1999/xh ...

  4. vscode常用设置

    1.代码提示快捷键设置:(keybindings.json) { "key": "ctrl+j","command": "edit ...

  5. HTML5 学习总结(四)——canvas绘图、WebGL、SVG

    一.Canvas canvas是HTML5中新增一个HTML5标签与操作canvas的javascript API,它可以实现在网页中完成动态的2D与3D图像技术.<canvas> 标记和 ...

  6. jvm系列(五):tomcat性能调优和性能监控(visualvm)

    tomcat服务器优化 1.JDK内存优化 根据服务器物理内容情况配置相关参数优化tomcat性能.当应用程序需要的内存超出堆的最大值时虚拟机就会提示内存溢出,并且导致应用服务崩溃.因此一般建议堆的最 ...

  7. Oracle从文件系统迁移到ASM存储

    环境:RHEL 6.4 + Oracle 11.2.0.4 需求:数据库存储由文件系统迁移到ASM 数据库存储迁移到ASM磁盘组 1.1 编辑参数文件指定新的控制文件路径 1.2 启动数据库到nomo ...

  8. iOS: 在iPhone和Apple Watch之间共享数据: App Groups

    我们可以在iPhone和Apple Watch间通过app groups来共享数据.方法如下: 首先要在dev center添加一个新的 app group: 接下来创建一个新的single view ...

  9. session的使用方法详解

    session的使用方法详解 Session是什么呢?简单来说就是服务器给客户端的一个编号.当一台WWW服务器运行时,可能有若干个用户浏览正在运正在这台服务器上的网站.当每个用户首次与这台WWW服务器 ...

  10. 【原创】C#模拟Post请求,正文为json数据的代码参考

    由于之前一直在做键值对post数据的提交,没遇到过json正文的提交,遇到的问题截图: 对于此种情况的post,我用 谷歌插件 PostMan 模拟试了下成功了,截图如下: Postman插件在你选择 ...