普通Lisp 631 576
(let((X"a pangolin"))#1=(labels((U(M &AUX(S *QUERY-IO*))(IF(STRINGP M)(IF(Y-OR-N-P"Is it ~A?"M)(PROG1 M(FORMAT S"Good. That was soooo easy.~%"))(LET*((N(PROGN(FORMAT S"Oh. Well you win then -- What were you thinking of?~%")#2=(READ-LINE S)))(Q(PROGN(FORMAT S"Please give me a question about ~A, so I can tell the difference between ~A and ~A~%"N N M)#2#)))(PROG1(IF(Y-OR-N-P"What is the answer for ~A?"N)`(,Q ,N ,M)`(,Q ,M ,N))(FORMAT S"Thanks~%"))))(DESTRUCTURING-BIND(Q Y N)M(IF(Y-OR-N-P Q)`(,Q ,(U Y),N)`(,Q ,Y,(U N)))))))(write(list'let(list`(X',(U x)))'#1#):circle t)()))
会话示例
命名脚本pango1.lisp并执行以下操作（使用SBCL）：
~$ sbcl --noinform --quit --load pango1.lisp > pango2.lisp
Is it a pangolin? (y or n) n
Oh. Well you win then -- What were you thinking of?
a cat
Please give me a question about a cat, so I can tell the difference between a cat and a pangolin
Does it sleep a lot?
What is the answer for a cat? (y or n) y
Thanks
再加一轮熊：
~$ sbcl --noinform --quit --load pango2.lisp > pango3.lisp
Does it sleep a lot? (y or n) y
Is it a cat? (y or n) n
Oh. Well you win then -- What were you thinking of?
a bear
Please give me a question about a bear, so I can tell the difference between a bear and a cat
Does it hibernate?
What is the answer for a bear? (y or n) y
Thanks
添加一个懒惰（我们测试答案是否为“否”的情况）：
~$ sbcl --noinform --quit --load pango3.lisp > pango4.lisp
Does it sleep a lot? (y or n) y
Does it hibernate? (y or n) n
Is it a cat? (y or n) n
Oh. Well you win then -- What were you thinking of?
a sloth
Please give me a question about a sloth, so I can tell the difference between a sloth and a cat
Does it move fast?
What is the answer for a sloth? (y or n) n
Thanks
测试最后一个文件：
~$ sbcl --noinform --quit --load pango4.lisp > pango5.lisp
Does it sleep a lot? (y or n) y
Does it hibernate? (y or n) n
Does it move fast? (y or n) y
Is it a cat? (y or n) y
Good. That was soooo easy.
备注
- 我首先忘记打印了
"Thanks"，就在这里。
- 如您所见，问题后跟
(y or n)，这是因为我正在使用现有y-or-n-p功能。如果需要，我可以更新答案以删除此输出。
- Common Lisp有一个
*QUERY-IO*专用于用户交互的双向流，这就是我在这里使用的。标准输出和用户交互不会混乱，这遵循恕我直言的精神。
SAVE-LISP-AND-DIE在实践中使用将是更好的方法。
产生的输出
这是最后生成的脚本：
(LET ((X
'("Does it sleep a lot?"
("Does it hibernate?" "a bear"
("Does it move fast?" "a cat" "a sloth"))
"a pangolin")))
#1=(LABELS ((U (M &AUX (S *QUERY-IO*))
(IF (STRINGP M)
(IF (Y-OR-N-P "Is it ~A?" M)
(PROG1 M (FORMAT S "Good. That was soooo easy.~%"))
(LET* ((N
(PROGN
(FORMAT S
"Oh. Well you win then -- What were you thinking of?~%")
#2=(READ-LINE S)))
(Q
(PROGN
(FORMAT S
"Please give me a question about ~A, so I can tell the difference between ~A and ~A~%"
N N M)
#2#)))
(PROG1
(IF (Y-OR-N-P "What is the answer for ~A?" N)
`(,Q ,N ,M)
`(,Q ,M ,N))
(FORMAT S "Thanks~%"))))
(DESTRUCTURING-BIND
(Q Y N)
M
(IF (Y-OR-N-P Q)
`(,Q ,(U Y) ,N)
`(,Q ,Y ,(U N)))))))
(WRITE (LIST 'LET (LIST `(X ',(U X))) '#1#) :CIRCLE T)
NIL))
说明
决策树可以是：
- 一个字符串，如
"a pangolin"，表示叶子。
- 包含三个元素的列表：
(question if-true if-false)其中question是一个闭合的是/否问题（以字符串形式），if-true并且if-false是与该问题相关联的两个可能的子树。
该U功能走，并返回一个可能被修改树。在与用户交互的同时，依次询问每个问题，从根开始直到到达叶子。
这部分非常简单。为了打印源代码，我们使用阅读器变量来构建自引用代码。通过设置*PRINT-CIRCLE*为true，我们可以避免在漂亮打印期间进行无限递归。使用WRITEwith 的技巧:print-circle T是，函数也可能会将值返回给REPL，具体取决于写操作是否为最后一种形式，因此，如果REPL不处理圆形结构，例如由标准默认值定义*PRINT-CIRCLE*，则将无限递归。我们只需要确保没有将循环结构返回给REPL，这就是为什么在LET的最后位置有一个NIL的原因。这种方法大大减少了问题。