快乐方法学-Racket-编程-全-

快乐方法学 Racket 编程（全）

原文：zh.annas-archive.org/md5/3db6916bc40bf373a42385ccea8b2ca1

译者：飞龙

协议：CC BY-NC-SA 4.0

前言

在本书中，我们将探讨如何使用 Racket（一种源自 Scheme 家族的编程语言——而 Scheme 又源自 Lisp）以及 DrRacket，这是一种图形化环境，能够让我们充分利用 Racket 的所有功能。该生态系统的一个吸引人的特点是，它配备了大量涵盖各种学科的库。开发者将 Racket 描述为一个“内置电池”的系统，这使它成为互动探索计算机科学和数学中各种主题的理想平台。

鉴于 Racket 的 Lisp 血统，我们如果忽略函数式编程就有失公允，因此本书肯定会探讨这一领域。然而，Racket 绝非单一技巧的语言，因此我们也会在此过程中探讨命令式编程、面向对象编程以及逻辑编程。此外，在计算机科学方面，我们还将研究各种抽象计算机、数据结构，以及与解决一些休闲数学问题相关的搜索算法。最后，我们将通过构建自己的计算器来结束本书，其中包括使用正则表达式进行词法分析，使用扩展巴科斯–诺尔范式（EBNF）定义语法，以及构建递归下降解析器。

Racket

Racket 拥有广泛且编写良好的文档，其中包括 Quick: Racket 入门图解、入门书籍 Racket Guide 和详尽的 Racket Reference。其他各种工具包和环境也有单独的文档。在 DrRacket 中，这些文档可以通过帮助菜单访问。

Racket 支持多种平台：Windows、Linux、macOS 和 Unix。可以通过链接https://download.racket-lang.org/从 Racket 网站下载。下载后，安装过程很简单，只需在 Windows 上运行下载的可执行文件，在 macOS 上运行 .dmg 文件，或在 Linux 上运行 shell 脚本。写作时，当前版本为 7.8。书中的示例可以在任何版本 7.0 或更高版本上运行，也可能在早期版本上运行，但由于当前版本可以免费下载，因此其实没必要使用旧版。当第一次启动 DrRacket 环境时，用户将被提示选择一个 Racket 语言变体。本书中的示例使用弹出对话框中的第一个选项（即标有“Racket 语言”的选项）。

DrRacket 窗口提供了一个定义窗格（图 1 中的顶部窗格），用于定义变量和函数，以及一个交互窗格（图 1 中的底部窗格），可以在其中交互式地执行 Racket 代码。在这些窗格内，帮助只需按下一个按键即可。只需点击任何内置函数名称并按下 F1 键。

定义窗口包含了一个强大互动开发环境（IDE）所期望的所有功能，如语法高亮、变量重命名和集成调试器。

Racket 爱好者亲切地被称为 Racketeers（听起来很有意思吧？）。一旦你有机会探索这个奇妙的环境，别惊讶自己会成为一个 Racketeer。

图 1：DrRacket IDE

本书使用的约定

DrRacket 支持多种编程和学习语言。在本书中，我们仅关注默认的 Racket 语言。因此，除非另有说明，所有定义文件应以以下行开始：

#lang racket

在定义部分输入的代码将以框架框起来，如上所示。

在交互面板中输入的表达式将以右尖括号 > 为前缀显示，如下所示。尖括号是 DrRacket 的输入提示符。输出将不带尖括号。为了方便区分输入和输出，书中将以粗体显示输入内容（但在 IDE 中输入不会以粗体显示）。

> (+ 1 2 3) ; this is an input, the following is an output
6

我们偶尔会使用 DrRacket 支持的一些特殊符号，如希腊字母（例如，我们可能会使用 θ 作为角度的标识符）。这些符号列在附录 B 中。输入这些符号的方法也在那里给出。如果你手动输入示例而不想使用这些特殊符号，只需替换为你自己选择的名称：例如使用 alpha 代替 α。

在定义窗口中输入的程序列表示例如下所示。

#lang racket

(define (piscis x y r b)
  (let* ([y (- y r)]
         [2r (* 2 r)]
         [yi (sqrt (- (sqr r) (sqr x)))] ; y-intersection
         [π pi]
      ➊ [ϕ (asin (/ yi r))]
      ➋ [θ (- π ϕ)]
      ➌ [path (new dc-path%)])
   (send dc set-brush b)
➍ (send path move-to 0 (- yi))
➎ (send path arc (- x r)     y 2r 2r  θ    (+ π  ϕ))
➏ (send path arc (- (- x) r) y 2r 2r (- ϕ) ϕ)
➐ (send dc draw-path path)))

我们将使用 Wingdings 符号，如 ➊，来突出显示代码中的有趣部分。

本书适合谁阅读

虽然不需要具备 Racket、Lisp 或 Scheme 的先前知识，但拥有一些基本的编程知识会更好，不过这并非必须。数学先决条件会有所不同。某些主题可能会有点挑战性，但假设的数学背景仅限于高中代数和三角学。可能会涉及一两个定理，但处理方式是非正式的。

关于本书

如果你已经熟悉 Racket 语言，可以跳过（或者只是略读）前几章，因为这些章节仅提供了语言的介绍。这些早期的章节绝不是 Racket 功能的全面百科全书。雄心勃勃的读者应查阅优秀的 Racket 文档以获取更详细的信息。以下是每一章内容的简要描述。

第一章：Racket 基础 给初学者提供了学习 Racket 的基本概念，这些概念将帮助你顺利阅读本书的其他章节。

第二章：算术与其他数值工具 描述了 Racket 广泛的数值数据类型：整数、真有理数和复数（仅举几例）。这一章将使读者熟练掌握在 Racket 中使用这些实体。

第三章：函数基础 介绍了 Racket 的多范式编程能力。本章将向读者介绍函数式编程和命令式编程。最后一部分将介绍一些有趣的编程应用。

第四章：绘图、绘制和一点集合论 介绍了交互式图形。大多数 IDE 仅支持文本；DrRacket 在交互式环境中生成图形输出的能力非常强。本章将向你展示如何实现这一点。

第五章：GUI：让用户感兴趣 展示了如何构建运行在独立窗口中的迷你图形应用程序。

第六章：数据 探讨了在 Racket 中处理数据的各种方法。本章将讨论如何从计算机中的文件读取和写入数据，还将讨论如何使用统计和数据可视化来分析数据。

第七章：寻找答案 探讨了多种强大的搜索算法。这些算法将用于解决娱乐数学中的各种问题和谜题。

第八章：逻辑编程 探讨了另一种强大的编程范式。在这里，我们将使用 Racket 的类 Prolog 风格的逻辑编程库：Racklog。

第九章：计算机机器 简要回顾了各种抽象计算机机器。这些简单的机制是进入计算机科学一些深刻概念的门户。

第十章：TRAC：Racket 代数计算器 利用前几章中开发的技能，构建一个独立的交互式命令行计算器。

第一章：RACKET 基础

让我们从介绍一些 Racket 的基本概念开始。在本章中，我们将介绍一些将在整本书中使用的基本数据类型。你需要特别关注列表的讨论，因为它支撑了 Racket 的大部分功能。我们还将介绍如何给变量赋值以及各种字符串操作方法，在过程中，你将初次接触向量和结构体。最后，本章将讨论如何生成格式化输出。

原子数据

原子数据 是任何编程语言的基本构建块，Racket 也不例外。原子数据指的是通常被认为是不可分割的基本数据类型；即，像 123 这样的数字，像 "hello there" 这样的字符串，以及像 pi 这样的标识符。数字和字符串求值为其本身；如果被绑定，标识符则会求值为其关联的值：

> 123 
123

> "hello there"
"hello there"

> pi
3.141592653589793

求值一个未绑定的标识符会导致错误。为了防止未绑定的标识符被求值，你可以在它前面加上撇号：

> alpha
. . alpha: undefined;
  cannot reference an identifier before its definition

> 'alpha
'alpha

我们可以使用列表将原子数据组织在一起，接下来会介绍列表。

列表

在 Racket 中，列表是主要的非原子数据结构（即，除了数字、字符串等之外的其他东西）。Racket 依赖列表的原因之一是它是 Lisp（LISt Processing，列表处理）的后代。在深入细节之前，让我们看一些简单的示例。

初探列表

这是创建一个包含一些数字的列表的方法：

> (list 1 2 3)

注意语法。列表通常以一个开括号 ( 开始，接着是由空格分隔的元素列表，最后以闭括号 ) 结束。列表中的第一个元素通常是一个标识符，用来指示该列表如何被求值。

列表也可以包含其他列表。

> (list 1 (list "two" "three") 4 5)

它打印为

'(1 ("two" "three") 4 5)

注意最后一个示例中开头的撇号（或反引号）。这是 quote 关键字的别名。如果你想输入一个字面量列表（即一个按原样接受的列表），你可以将其引用：

> (quote (1 ("two" "three") 4 5))

或者

> '(1 ("two" "three") 4 5)

其中任何一个都打印为

'(1 ("two" "three") 4 5)

虽然 list 和 quote 看起来是构建列表的两种等效方式，但它们之间有一个重要的区别。以下示例演示了这个区别。

> (quote (3 1 4 pi))
'(3 1 4 pi)

> (list 3 1 4 pi)
'(3 1 4 3.141592653589793)

注意，quote 会返回输入的列表内容，而当使用 list 时，标识符 pi 被求值并用其值替代。通常，在一个非引用的列表中，所有标识符都会被求值并替换为其对应的值。关键字 quote 在宏和符号表达式求值中扮演重要角色，这些是高级主题，我们在本书中不予讨论。

Lisp 系列语言的一个批评点是括号的过多。为了解决这个问题，Racket 允许使用方括号或花括号代替圆括号。例如，最后一个表达式完全可以写成：

> '(1 ["two" "three"] 4 5)

或者

> '(1 {"two" "three"} 4 5)

S 表达式

列表是称为 s-表达式 的事物的一种特殊情况。s-表达式（或符号表达式）被定义为两种情况之一：

案例 1 s-表达式是一个原子。

案例 2 s-表达式是形如 (x . y) 的表达式，其中 x 和 y 是其他 s-表达式。

形式 (x . y) 通常称为对。这是一种特殊的语法形式，用来指定一个 cons 单元，我们将很快详细讨论这个内容。

让我们看看能否构造一些 s-表达式的例子。嗯，1 怎么样？是的，它是一个原子，因此符合案例 1。"spud" 呢？没错，字符串是原子，因此 "spud" 也是一个 s-表达式。我们可以将这些组合起来形成另一个 s-表达式：(1 . "spud")，它符合案例 2。由于 (1 . "spud") 是一个 s-表达式，案例 2 允许我们再形成另一个 s-表达式：((1 . "spud") . (1 . "spud"))。从中我们可以看出，s-表达式实际上是类似树状的结构，如图 1-1 所示。（严格来说，s-表达式形成了一个 二叉树，其中非叶节点有恰好两个子节点。）

图 1-1：((a . (2 . pi) . x))

在图 1-1 中，方框是表示原子的叶节点，圆形节点表示对。接下来我们将看到 s-表达式如何用于构建列表。

列表结构

如上所述，列表是 s-表达式的一种特殊情况。不同之处在于，在一个列表中，如果我们跟踪每个对中的最右边元素，最终的节点是一个特殊的原子节点，称为 nil。图 1-2 展示了列表 '(1 2 3)——作为一个 s-表达式是 (1 . (2 . (3 . nil)))——在内部的样子。

图 1-2：列表结构

我们已经将树状结构展平，以便更像一个列表。我们还展开了每个对节点（也就是 cons 单元），以显示它包含两个单元，每个单元包含指向另一个节点的指针。这些指针单元，出于历史原因，分别被称为 car 和 cdr（它们是 Lisp 早期版本中使用的计算机寄存器的名称）。我们可以看到，列表中的最后一个 cdr 单元指向 nil。Nil 在 Racket 中由空列表表示：() 或 null。

可以通过使用 cons 函数直接创建 cons 单元。注意，cons 函数不一定创建一个列表。例如：

> (cons 1 2)
'(1 . 2)

它生成一个对，但不是一个列表。然而，如果我们使用一个空列表作为第二个 s-表达式：

> (cons 1 '())
'(1)

我们生成一个只有一个元素的列表。

Racket 提供了几个函数来测试某个元素是否是列表或对。在 Racket 中，#t 表示真，#f 表示假：

> (pair? (cons 1 2))
#t

> (list? (cons 1 2))
#f

> (pair? (cons 1 '()))
#t

> (list? (cons 1 '()))
#t

从中我们可以看出，列表始终是一个对，但反过来并不总是成立：一对并不总是一个列表。

通常，cons 用于将一个原子值添加到列表的开头，如下所示：

> (cons 1 '(2 3))
'(1 2 3)

Racket 提供了专门的函数来访问 cons 单元的组成部分。car 函数返回由 car 指针指向的元素，cdr 函数则返回由 cdr 指针指向的元素。在 Racket 中，first 和 rest 函数与 car 和 cdr 类似，但它们不是这两个函数的别名，因为它们仅适用于列表。下面给出了一些示例。

> (car '(1 ("two" "three") 4 5))
1

> (first '(1 ("two" "three") 4 5))
1

> (cdr '(1 ("two" "three") 4 5))
'(("two" "three") 4 5)

> (rest '(1 ("two" "three") 4 5))
'(("two" "three") 4 5)

列表元素也可以通过 second、third 等函数进行访问。

> (first '(1 2 3 4))
1

> (second '(1 2 3 4))
2

> (third '(1 2 3 4))
3

最后，可以使用 list-ref 提取任意位置的值。

> (list-ref '(a b c) 0)
'a

> (list-ref '(a b c) 1)
'b

list-ref 函数接受一个列表和你想要的值的索引，列表作为第一个参数。请注意，Racket 使用 从零开始的索引，这意味着在任何值序列中，第一个值的索引为 0，第二个值的索引为 1，以此类推。

一些有用的列表函数

让我们快速回顾一些有用的列表函数。

长度

要获取列表的长度，你可以使用 length 函数，像这样：

> (length '(1 2 3 4 5))
5

反转

如果你需要将列表中的元素反转，可以使用 reverse 函数。

> (reverse '(1 2 3 4 5)) ; reverse elements of a list
'(5 4 3 2 1)

排序

sort 函数将对列表进行排序。你可以传入 < 来将列表按升序排序：

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

或者，如果你传入 >，它将按降序排序列表：

> (sort '(1 3 6 5 7 9 2 4 8) >)
'(9 8 7 6 5 4 3 2 1)

追加

要将两个列表合并在一起，可以使用 append 函数：

> (append '(1 2 3) '(4 5 6)) 
'(1 2 3 4 5 6)

append 函数可以接受多个列表：

> (append '(1 2) '(3 4) '(5 6)) 
'(1 2 3 4 5 6)

范围

range 函数将根据一些参数创建一个数字列表。你可以传入一个起始值和一个结束值，以及一个步进值：

> (range 0 10 2)
'(0 2 4 6 8)

或者，如果你只传入一个结束值，它将从 0 开始，步进为 1：

> (range 10)
'(0 1 2 3 4 5 6 7 8 9)

创建列表

创建列表的另一种方式是使用 make-list 函数：

> (make-list 10 'me)
'(me me me me me me me me me me)

如你所见，make-list 接受一个数字和一个值，并创建一个包含该值，且该值重复指定次数的列表。

空?

要测试一个列表是否为空，可以使用 null? 函数：

> (null? '()) ; test for empty list
#t
> (null? '(1 2 3))
#f

索引值

如果你需要在列表中查找一个值，可以使用 index-of。如果该值存在，它将返回该值的索引：

> (index-of '(8 7 1 9 5 2) 9)
3

如果没有，它将返回 #f：

> (index-of '(8 7 1 9 5 2) 10)
#f

成员

另一种搜索列表的方法是使用 member，它测试一个列表是否包含某个特定元素的实例。如果没有，返回符号 #f；如果有，则返回从第一个匹配元素开始的列表尾部。

> (member 7 '(9 3 5 (6 2) 5 1 4))
#f

> (member 5 '(9 3 5 (6 2) 5 1 4))
'(5 (6 2) 5 1 4)

> (member 6 '(9 3 5 (6 2) 5 1 4))
#f

请注意，在最后一个例子中，尽管 6 是被搜索列表的一个子列表中的成员，member 函数仍然返回了 false。然而，以下的做法是有效的。

> (member '(6 2) '(9 3 5 (6 2) 5 1 4))
'((6 2) 5 1 4)

稍后你会看到，在函数式编程中，你常常需要判断一个元素是否包含在列表中。member 函数不仅能找到该元素（如果它存在），还会返回实际的值，以便在后续计算中使用。

在接下来的内容中，我们将对列表进行更多的讲解。

定义、赋值和变量

到目前为止，我们已经见过一些函数的例子，函数是接受一个或多个输入值并提供一个输出值（某种形式的数据）。函数调用表达式中的第一个元素是标识符（函数名）。函数形式中的其余元素是函数的参数。这些元素会被逐一评估，然后传递给函数，函数对其参数执行某些操作并返回一个值。

更具体来说，一个形式或表达式可以定义一个函数，执行一个函数调用，或仅仅返回一个结构（通常是一个列表），并且可能会或可能不会评估它的所有参数。请注意，quote 是一种不同类型的形式（与评估其参数的函数形式不同），因为它不会首先评估其参数。在下一节中，你将见到 define，它是另一种形式，因为它不会评估其第一个参数，但会评估其第二个参数。随着文本的推进，我们将会见到许多其他类型的形式。

变量是一个值的占位符。在 Racket 中，变量通过标识符（特定的字符序列）来指定，每个标识符只与一个事物关联。（稍后我们将详细讨论什么构成有效的标识符。）要定义一个变量，你使用 define 形式。例如：

> (define a 123)
> a
123

在这里，define 被用来绑定值 123 到标识符 a。几乎任何东西都可以绑定到一个变量。这里我们将绑定一个列表到标识符 b。

> (define b '(1 2 3))
> b
'(1 2 3)

可以并行绑定多个变量：

> (define-values (x y z) (values 1 2 3))

> x
1

> y
2

> z
3

Racket 区分定义变量和赋值变量。赋值通过 set! 表达式进行。通常，任何改变或变更一个值的形式都会以感叹号结尾。试图赋值给一个未曾定义的标识符会导致一个难看的错误信息：

> (set! ice 9)
. . set!: assignment disallowed;
  cannot set variable before its definition
  variable: ice

但这是可以的：

> (define ice 9)
> ice
9
> (set! ice 32)
32

一种理解方式是，define 设置了一个存储值的位置，而 set! 只是将一个新值放入先前定义的位置。

当我们谈到在 Racket 代码中定义的变量 x 时，它将被排版为 x。如果我们仅仅在数学意义上讨论该变量，它将以斜体形式排版为 x。

符号、标识符和关键字

与大多数语言不同，Racket 允许几乎任何字符串用作标识符。例如，我们可以使用 2x3 作为标识符：

> (define 2x3 7)
> 2x3
7

你可以设想定义一个名为rags->riches的函数，它将破衣服变成财富（告诉我你完成后是如何实现的）。这一切看起来很奇怪，但它赋予 Racket 一种许多其他编程语言所没有的表达能力。当然，这其中有一些限制，但除了少数特殊字符，如圆括号、方括号和算术运算符（即使这些通常也没问题，只要它们不是第一个字符），几乎任何东西都可以使用。事实上，看到包含连字符的标识符（如solve-for-x）是很常见的。

一个符号本质上就是一个带引号的标识符：

> 'this-is-a-symbol
'this-is-a-symbol

它们有点像二等字符串（下面会详细介绍字符串）。它们通常像其他编程语言中的enum一样使用，用来表示特定的值。

一个关键字是一个以#:为前缀的标识符。关键字主要用于在函数调用中标识可选参数。这里是一个函数（˜r）的例子，它使用关键字将π以两位小数的字符串形式输出。

> (~r pi #:precision 2)
"3.14"

这里我们定义了可选的precision参数，用来指定pi的值应该四舍五入到两位小数。

相等性

Racket 定义了两种不同的相等性：看起来完全相同的东西和实际上是同一个东西。下面是它们的区别。假设我们做以下两个定义。

> (define a '(1 2 3))
> (define b '(1 2 3))

标识符a和b看起来完全一样，如果我们询问 Racket 它们是否相同，使用equal?谓词，它会回答它们是相同的。注意，谓词是一个返回布尔值（真或假）的函数。

> (equal? a b)
#t

但如果我们使用eq?谓词来询问它们是否是同一个东西，我们会得到不同的答案。

> (eq? a b)
#f

那么，什么时候eq?返回true呢？这里有一个例子。

> (define x '(1 2 3))
> (define y x)
> (eq? x y)
#t

在这种情况下，我们将x绑定到列表(1 2 3)。然后，我们将y绑定到与x绑定的相同位置，有效地使x和y绑定到相同的内容。这个差异微妙但重要。在大多数情况下，equal?是你需要的，但也有一些场景使用eq?来确保变量绑定到相同的对象，而不仅仅是绑定到看起来相同的东西。

另一个必须讨论的相等性细微差别是数字相等性。在上面的讨论中，我们关注的是结构相等性。数字是另一种情况。我们将在下一章详细讨论数字，但我们需要澄清一些与数字相等性相关的事项。请检查以下序列：

> (define a  123)
> (define b  123)
> (eq? a b)
#t

上面我们将 a 和 b 绑定到相同的列表 '(1 2 3)，在这种情况下 eq? 返回了 false。在这个例子中，我们将 a 和 b 绑定到相同的数字 123，eq? 返回了 true。数字（严格来说是fixnums，即适合存储在固定存储空间中的小整数——通常是 32 位或 64 位，具体取决于计算平台）在这方面是独一无二的。每个数字只有一个实例，不管它绑定了多少不同的标识符。换句话说，每个数字都存储在唯一的一个位置。此外，还有一个特殊的谓词 (=)，只能用于数字：

> (= 123 123)
#t

> (= 123 456)
#f

(= '(1 2 3) '(1 2 3))
. . =: contract violation
  expected: number?
  given: '(1 2 3)
  argument position: 1st
  other arguments...:

在本节中，我们仅覆盖一般的相等性。我们将在下一章详细讨论数值比较的更多细节。

字符串与其他元素

在本节中，我们将探讨 Racket 中处理文本值的不同方式。我们将从最简单的文本值类型开始。

字符

单个文本值，例如单个字母，使用字符表示，字符是一个特殊实体，对应于Unicode值。例如，字母 A 对应的 Unicode 值是 65\。Unicode 值通常以十六进制指定，因此 A 的 Unicode 值为 65[10] = 0041[16]。字符值要么以 #\ 开头，后跟一个字面键盘字符，要么以 #`u` 开头，后跟一个 Unicode 值。

下面是使用字符函数编写字符的多种方式。注意使用了注释字符（;），它允许将注释（非编译文本）添加到 Racket 代码中。

> #\A
#\A

> #\u0041
#\A

> #\   ; this is a space character
#\space

> #\u0020  ; so is this
#\space

> (char->integer #\u0041)
65

> (integer->char 65)
#\A

> (char-alphabetic? #\a)
#t

> (char-alphabetic? #\1)
#f

> (char-numeric? #\1)
#t

> (char-numeric? #\a)
#f

Unicode 支持广泛的字符集。这里有一些示例：

> '(#\u2660 #\u2663 #\u2665 #\u2666)
'(#♠ #♣ #♡ #♢)

> '(#\u263A #\u2639 #\u263B)
'(\#☺ \#☹ \#☻)

> '(#\u25A1 #\u25CB #\u25C7)
'(\#□ \#◯ \#◇)

大多数 Unicode 字符应该能够正常打印，但这在一定程度上取决于你计算机上可用的字体。

字符串

一个字符串通常由一系列键盘字符组成，并被双引号字符包围。

> "This is a string."
"This is a string."

Unicode 字符可以嵌入到字符串中，但在这种情况下，前导的 # 会被省略。

> "Happy: \u263A."
"Happy: ☺."

你也可以使用 string-append 将两个字符串连接起来，创建一个新的字符串。

> (string-append "Luke, " "I am " "your father!")
"Luke, I am your father!"

要访问字符串中的字符，使用 string-ref：

> (string-ref "abcdef" 2)
#\c

字符串中每个字符的位置从 0 开始编号，因此在这个例子中，使用索引 2 实际上返回的是第三个字符。

到目前为止，我们看到的字符串是不可变的。要创建一个可变字符串，请使用 string 函数。这允许在字符串中修改字符。

> (define wishy-washy (string #\I #\  #\a #\m #\  #\m #\u #\t #\a #\b #\l #\e)
    )
> wishy-washy
"I am mutable"

> (string-set! wishy-washy 5 #\a)
> (string-set! wishy-washy 6 #\ ) 

> wishy-washy
"I am a table"

注意，对于可变字符串，我们必须使用单个字符来定义字符串。

创建可变字符串的另一种方式是使用 string-copy：

> (define mstr (string-copy "I am also mutable"))
> (string-set! mstr 5 #\space)
> (string-set! mstr 6 #\space)
> mstr
"I am   so mutable"

你也可以使用 make-string 来做同样的事情：

> (define exes (make-string 10 #\X))
> (string-set! exes 5 #\O)
> exes
"XXXXXOXXXX"

根据需要，以上任何一个都可能是优选项。如果你需要让现有的字符串变为可变的，string-copy 是显而易见的选择。如果你只想要一个空格字符串，make-string 是明确的赢家。

有用的字符串函数

当然，还有许多其他有用的字符串函数，接下来我们将展示其中的一些。

字符串长度

string-length函数输出字符串中的字符数（请参见之前在第 14 页“字符串”中的wishy-washy）。

> (string-length wishy-washy)
12

substring

substring函数从给定的字符串中提取子字符串。

> (substring wishy-washy 7 12) ; characters 7-11
"table"

string-titlecase

使用string-titlecase将字符串中每个单词的首字母大写。

> (string-titlecase wishy-washy)
"I Am A Table"

string-upcase

要将字符串输出为大写形式，请使用string-upcase：

> (string-upcase "big")
"BIG"

string-downcase

相反，对于小写字符串，使用string-downcase：

> (string-downcase "SMALL")
"small"

string<=?

要进行字母比较，请使用string<=?函数：

> (string<=? "big" "small")  ; alphabetical comparison
#t

string=?

string=?函数用于测试两个字符串是否相等：

> (string=? "big" "small")
#f

string-replace

string-replace函数用于将字符串的部分内容替换为另一个字符串：

> (define darth-quote "Luke, I am your father!")
> (string-replace darth-quote "am" "am not")
"Luke, I am not your father!"

string-contains?

要测试一个字符串是否包含在另一个字符串中，请使用string-contains?：

> (string-contains? darth-quote "Luke")
#t

> (string-contains? darth-quote "Darth")
#f

string-split

string-split函数可用于将字符串拆分为多个标记：

> (string-split darth-quote)
'("Luke," "I" "am" "your" "father!")

> (string-split darth-quote ",")
'("Luke" " I am your father!")

请注意，上面的第一个示例使用了默认版本，它会根据空格拆分，而第二个版本明确使用了逗号（,）。

string-trim

string-trim函数用于去除字符串的前导和/或尾随空格：

> (string-trim "  hello   ")
"hello"

> (string-trim "  hello   " #:right? #f)
"hello   "

> (string-trim "  hello   " #:left? #f)
"  hello"

请注意，在最后两个版本中，#:left?或#:right?用于禁止修剪对应一侧的内容。最后的#f参数（默认值）用于指定每一侧只去掉一个匹配项；否则，所有的前导或尾随匹配项都会被去掉。

更多高级字符串功能，请参见第 279 页的“正则表达式”。

字符串转换和格式化函数

有许多函数可以将值转换为字符串或从字符串转换。它们的名称都很直观，下面有相关示例。

> (symbol->string 'FBI)
"FBI"

> (string->symbol "FBI")
'FBI

> (list->string '(#\x #\y #\z))
"xyz"

> (string->list "xyz")
'(#\x #\y #\z)

> (string->keyword "string->keyword")
'#:string->keyword

> (keyword->string '#:keyword)
"keyword"

要查看完整的列表，请访问https://docs.racket-lang.org/reference/strings.html。

一个方便的函数用于在字符串中嵌入其他值的是format。

> (format "let ~a = ~a" "x" 2)
"let x = 2"

在格式化语句中，˜a充当占位符。每个额外的参数应该有一个占位符。请注意，数字 2 在嵌入到输出字符串中之前会自动转换为字符串。

如果你想简单地将数字转换为字符串，请使用number->string函数：

> (number->string pi)
"3.141592653589793"

相反：

> (string->number "3.141592653589793")
3.141592653589793

尝试让 Racket 将单词的值转换为数字是行不通的：

> (string->number "five")
#f

对于更多的控制，可以使用在racket/format库中定义的˜r函数，它提供了多种选项，可以将数字转换为字符串并控制数字的精度及其他输出特性。例如，要显示π到四位小数，可以使用以下方式：

> (~r pi #:precision 4)
"3.1416"

要将其右对齐，在 20 个字符宽的字段中并用句点填充左侧，可以执行以下操作：

> (~r pi #:min-width 20 #:precision 4 #:pad-string ".")
"..............3.1416"

关于 ˜r 的更多信息，请参见附录 A，该附录讨论了数字基数。还有许多其他有用的波浪符前缀字符串转换函数，如 ˜a、˜v 和 ˜s。我们这里不做详细讨论，但你可以查阅 Racket 文档了解更多信息： https://docs.racket-lang.org/reference/strings.html。

向量

向量看起来与列表有些相似，但实际上它们大不相同。与列表的内部树结构不同，向量是一个顺序数组（类似于命令式语言中的数组），直接包含值，如图 1-3 所示。

图 1-3：向量结构

向量可以通过 vector 函数来输入。

> (vector 1 3 "d" 'a 2)
'#(1 3 "d" a 2)

另外，向量可以通过使用 # 来输入，如下所示（请注意，未加引号的 # 表示一个引用）：

> #(1 3 "d" a 2)
'#(1 3 "d" a 2)

需要注意的是，这些方法是不等价的。以下是一个原因：

> (vector 1 2 pi)
'#(1 2 3.141592653589793)

> #(1 2 pi)
'#(1 2 pi)

在第一个示例中，就像 list 一样，vector 会先评估它的参数，然后再形成向量。在最后一个示例中，像 quote 一样，# 不会评估它的参数。更重要的是，# 是 vector-immutable 的别名，这也引出了我们下一个话题。

访问向量元素

函数 vector-ref 是一个索引操作符，用于返回向量的元素。该函数将一个向量作为第一个参数，一个索引作为第二个参数：

> (define v (vector 'alpha 'beta 'gamma))
> (vector-ref v 1)
'beta

> (vector-ref v 0)
'alpha

要给向量单元赋值，使用 vector-set!。vector-set! 表达式接受三个参数：一个向量、一个索引和一个要赋给该索引位置的值。

> (vector-set! v 2 'foo)
> v
'#(alpha beta foo)

我们来尝试一种不同的方式：

> (define u #(alpha beta gamma))
> (vector-set! u 2 'foo)
. . vector-set!: contract violation
  expected: (and/c vector? (not/c immutable?))
  given: '#('alpha 'beta 'gamma)
  argument position: 1st
  other arguments...:

记住，# 是 vector-immutable 的别名。这意味着通过 #（或 vector-immutable）创建的向量是（敲锣打鼓。。。）不可变的：它们不能被更改或赋予新值。另一方面，通过 vector 创建的向量是 可变的，意味着它们的单元可以被修改。

向量相对于列表的一个优势是，向量的元素可以比列表的元素访问得更快。这是因为要访问列表的第 100 个元素，必须按顺序访问列表中的每个单元，直到达到第 100 个元素。相反，对于向量，可以直接访问第 100 个元素，而无需遍历之前的单元。另一方面，列表非常灵活，可以轻松扩展，还可以用来表示其他数据结构，如树。它们是 Racket（以及所有基于 Lisp 的语言）的核心，因此语言的大部分功能依赖于列表结构。可预见地，提供了将两者相互转换的函数。

常用的向量函数

向量长度

vector-length 函数返回向量中元素的数量：

> (vector-length #(one ringy dingy))
3

向量排序

vector-sort 函数对向量的元素进行排序：

> (vector-sort #(9 1 3 8 2 5 4 0 7 6 ) <)
'#(0 1 2 3 4 5 6 7 8 9)

> (vector-sort #(9 1 3 8 2 5 4 0 7 6 ) >)
'#(9 8 7 6 5 4 3 2 1 0)

为了激发你对后面内容的兴趣，vector-sort 是函数式编程的典型例子。最后一个参数实际上会评估一个函数，用来确定排序的方向。

vector->list

vector->list 函数将一个向量转换为一个列表：

>  (vector->list #(one little piggy))
'(one little piggy)

list->vector

相反，list->vector 将一个列表转换为向量：

> (list->vector '(two little piggies))
'#(two little piggies)

make-vector

要创建一个可变向量，使用 make-vector 形式：

> (make-vector 10 'piggies) ; create a mutable vector
'#(piggies piggies piggies piggies piggies piggies piggies piggies piggies
     piggies)

vector-append

要将两个向量连接在一起，使用 vector-append：

> (vector-append #(ten little) #(soldier boys))
'#(ten little soldier boys)

vector-member

vector-member 函数返回项目在向量中的索引位置：

> (vector-member 'waldo (vector 'where 'is 'waldo '?) )
2

当然，还有许多其他有用的向量函数，我们将在接下来的章节中探索其中的一些。

使用结构体

为了介绍下一个 Racket 特性，让我们构建一个示例程序。你可以用 Racket 创建一个电子版的支票簿，而不是在纸质银行本上记录交易。通常，这样的交易包含以下组件：

交易日期
收款人
支票号码
金额

跟踪这些不同信息的一个方法是使用 Racket 结构体，称为 struct。Racket 中的 struct 概念上类似于 C 或 C++ 等语言中的 struct。它是一种复合数据结构，包含一组预定义的字段。在使用 struct 之前，必须告诉 Racket 它的样子。对于我们的银行交易示例，这样的定义可能是这样的：

> (struct transaction (date payee check-number amount))

结构的每个组件（date、payee 等）都称为字段。一旦我们定义了 transaction struct，我们可以像这样创建一个：

> (define trans (transaction 20170907 "John Doe" 1012 100.10))

Racket 会自动为结构中的每个字段创建一个访问器方法。访问器方法返回字段的值。它们总是以结构体的名称（在本例中为 transaction）、连字符和字段名开头。

> (transaction-date trans)
20170907

> (transaction-payee trans)
"John Doe"

> (transaction-check-number trans)
1012

> (transaction-amount trans)
100.1

假设你犯了个错误，发现支付给 John Doe 的支票应该是 $100.12 而不是 $100.10，并尝试通过 set-transaction-amount! 来修正它。注意感叹号：这是一个信号，表示 set-transaction-amount! 是一个变异器，即修改字段值的方法。这些变异器在定义结构时生成，通常以 set 开头并以 ! 结尾。

> (set-transaction-amount! trans 100.12)
. . set-transaction-amount!: undefined;
  cannot reference an identifier before its definition

哎呀。。。结构体中的字段默认是不可变的，因此不会导出变异器。解决方法是在结构定义中为需要修改的字段包含 #:mutable 关键字。

> (struct transaction 
    (date payee check-number [amount #:mutable]))
> (define trans (transaction 20170907 "John Doe" 1012 100.10))
> (set-transaction-amount! trans 100.12)
> (transaction-amount trans)
100.12
{

如果所有字段都应是可变的，可以在字段列表后添加 #:mutable 关键字。

> (struct transaction 
    (date payee check-number amount) #:mutable)
> (define trans (transaction 20170907 "John Doe" 1012 100.10))
> (set-transaction-check-number! trans 1013)
> (transaction-check-number trans)
1013

虽然访问器方法足以获取单个字段的值，但它们在查看所有值时有些繁琐。仅输入结构名称并不会提供太多信息。

> trans
#<transaction>

为了使你的结构更加透明，在 struct 定义中包含 #:transparent 选项。

> (struct transaction 
    (date payee check-number amount) #:mutable #:transparent)
> (define trans (transaction 20170907 "John Doe" 1012 100.10))
> trans
(transaction 20170907 "John Doe" 1012 100.1)

在定义结构时，有一些额外的有用选项，其中一个特别值得关注的是 #:guard。#:guard 提供了一种机制，用于在构造结构时验证字段。例如，为了确保不使用负的支票号，我们可以采取以下措施。

> (struct transaction 
    (date payee check-number amount)
    #:mutable #:transparent
    #:guard (λ (date payee num amt name)
        (unless (> num 0) 
        (error "Not a valid check number"))
        (values date payee num amt)))

> (transaction 20170907 "John Doe" -1012 100.10)
Not a valid check number

> (transaction 20170907 "John Doe" 1012 100.10)
(transaction 20170907 "John Doe" 1012 100.1)

别慌张。我们还没有介绍那个看起来有点奇怪的符号（λ，或 lambda），但你应该能理解发生了什么。#:guard 表达式是一个函数，它为每个字段接受一个参数，并且还有一个额外的参数，包含结构的名称。在这个例子中，我们只是测试支票号是否大于零。#:guard 表达式必须返回与 struct 中字段数量相同的值。

在前面的例子中，我们只是返回了输入的相同值，但假设我们有一个变量保存了最后的支票号，叫做 last-check。在这种情况下，我们可以输入 0 作为支票号，并使用 #:guard 表达式插入下一个可用的号码，如下所示。

> (define last-check 1000)

> (struct transaction 
    (date payee check-number amount)
    #:mutable #:transparent
    #:guard (λ (date payee num amt name)
              (cond
                [(< num 0)
                   (error "Not a valid check number")]
                [(= num 0)
                   (let ([next-num (add1 last-check)])
                     (set! last-check next-num)
                     (values date payee next-num amt))]
                [else 
                   (set! last-check num)
                   (values date payee num amt)])))

> (transaction 20170907 "John Doe" 0 100.10)
(transaction 20170907 "John Doe" 1001 100.1)

> (transaction 20170907 "Jane Smith" 1013 65.25)
(transaction 20170907 "Jane Smith" 1013 65.25)

> (transaction 20170907 "Acme Hardware" 0 39.99)
(transaction 20170907 "Acme Hardware" 1014 39.99)

如你所见，非零的支票号被存储为最后的支票号，但如果输入了零作为支票号，struct 值将使用下一个可用的号码生成，这个号码成为 last-check 的当前值。cond 语句将在本书稍后详细解释，但它在这里的使用应该相当清晰：它是用来检查多个情况的一种方式。

控制输出

在交互面板中，DrRacket 会立即显示评估任何表达式后的输出。通常我们希望对输出的呈现方式进行一定控制。当输出是由某个函数或方法生成时，这一点尤其重要。Racket 提供了多种生成格式化输出的机制。主要的形式有 write、print 和 display。每种方式的工作方式略有不同。最好的说明方法是通过示例。

write

write 表达式的输出方式使得输出值形成一个有效的值，这个值可以在输入中使用：

> (write "show me the money")
"show me the money"

> (write '(show me the money))
(show me the money)

> (write #\A)
#\A

> (write 1.23)
1.23

> (write 1/2)
1/2

> (write #(a b c))
#(a b c)

display

display 表达式与 write 类似，但字符串和字符数据类型会原样输出，不会添加任何修饰符，如引号或反引号：

> (display "show me the money")
show me the money

> (display '(show me the money))
(show me the money)

> (display #\A)
A

> (display 1.23)
1.23

> (display 1/2)
1/2

> (display #(a b c))
#(a b c)

print

print 表达式也类似于 write，但它为输出添加了一些额外的格式化。print 的目的是展示一个表达式，该表达式在计算后会得到与打印的值相同的结果：

> (print "show me the money")
"show me the money"

> (print '(show me the money))
'(show me the money)

> (print #\A)
#\A

> (print 1.23)
1.23

> (print 1/2)
1
-
2

> (print #(a b c))
'#(a b c)

注意理性数值 1/2 是如何被打印的（关于有理数的内容将在下一章讲解）。

每种表达式都有一个以 ln 结尾的形式。唯一的区别是，带有 ln 结尾的会自动在输出末尾打印一个新行。以下是几个例子来突出这个区别。

> (print "show me ") (print "the money")
"show me ""the money"

> (display "show me ") (display "the money")
show me the money

> (println "show me ") (println "the money")
"show me "
"the money"

> (displayln "show me ") (displayln "the money")
show me 
the money

一个非常有用的形式是printf。printf表达式的工作方式类似于format函数：它将一个格式字符串作为第一个参数，其他值作为随后的参数。格式字符串使用˜a作为占位符。格式字符串之后的每个参数必须对应一个占位符。格式字符串会按输入的方式打印，唯一的例外是每个占位符会被相应的参数替换。下面是printf的示例。

> (printf "~a + ~a = ~a" 1 2 (+ 1 2))
1 + 2 = 3

> (printf "~a, can you hear ~a?" "Watson" "me")
Watson, can you hear me?

> (printf "~a, can you hear ~a?" "Jeeves" "the bell")
Jeeves, can you hear the bell?

有一些额外的格式说明符（详细信息请参阅 Racket 文档），但我们主要使用print，因为它能更好地视觉化输出值的数据类型。

摘要

在本章中，我们为接下来的内容奠定了基础。大多数核心数据类型已被介绍，并附有一些希望能帮助理解的示例。到目前为止，你应该已经对基础的 Racket 语法感到熟悉，并且对列表的结构以及如何操作它们有了相当好的理解。下一章将详细讲解 Racket 提供的各种数字数据类型。

第二章：算术及其他数值附属物

在本章中，我们将探讨 Racket 提供的丰富数值数据类型。我们将发现常见的整数和浮点值，但我们也会了解到 Racket 支持有理数（或分数）以及复数（即使你不清楚复数是什么，也没关系；它在本文中并不会大量使用，但我们简要介绍一下，以供感兴趣的人参考）。

布尔值

布尔值是表示真和假的值，尽管它们严格来说不是数字，但它们的行为有点像数字，因为可以通过各种运算符将它们组合成其他布尔值。统领这些运算的学科被称为布尔代数。在 Racket 中，布尔值由#t和#f表示，分别代表真和假。也可以使用#true（或true）和#false（或false）作为#t和#f的别名。

在介绍具体的布尔运算符之前，一个关于 Racket 布尔运算符的一般性重要观察是：它们通常将任何非#f的值视为 true。你将在下面看到一些这种行为的示例。

我们将要讨论的第一个运算符是not，它简单地将#t转换为#f，反之亦然。

> (not #t)
#f

> (not #f)
#t

> (not 5)
#f

注意到5被转换成了#f，意味着它原本被视为#t。

我们将要讨论的下一个布尔运算符是and，它在所有参数都为 true 时返回 true。让我们看一些示例：

> (and #t #t)
#t

> (and #t #f)
#f

> (and 'apples #t)
#t

> (and (equal? 5 5) #f)
#f

> (and (equal? 5 5) #t)
#t

> (and (equal? 5 5) #t 23)
23

你可能会对最后一个示例感到有些困惑（这也完全合理）。记住，Racket 认为所有非#f的值都是真值，因此 23 实际上是一个有效的返回值。更重要的是，and如何评估其参数。实际上发生的情况是，and依次评估其参数，直到遇到#f值。如果没有遇到#f值，它就返回最后一个参数的值，在上面的例子中是 23。虽然这种行为看起来有些奇怪，但它与or运算符的工作方式一致，正如我们稍后将看到的那样，它在某些情况下非常有用。

我们将要讨论的最后一个布尔运算符是or运算符，如果其任一参数为 true，则返回 true，否则返回#f。以下是一些示例：

> (or #f #f)
#f

> (or #f #t)
#t

> (or #f 45 (= 1 3))
45

与and类似，or会依次评估其参数。但在or的情况下，返回的是第一个true值。在上面的例子中，45 被视为 true，因此返回的值就是它。这种行为在你希望返回第一个非#f值时非常有用。

其他一些不常用的布尔运算符包括nand、nor和xor。有关这些运算符的详细信息，请参考 Racket 文档。

数值塔

在数学中，有一套数字类型的层级结构。整数是有理数（或分数）的子集。有理数是实数（或浮动点数，在计算机中进行近似）的子集。而实数又是复数的子集。这个层级结构在 Racket 中被称为数值塔。

整数

在数学中，整数集由符号 ℤ 表示。Racket 中的整数由 0 到 9 的数字序列组成，前面可以选择性地加上加号或减号。Racket 中的整数被称为精确的。这意味着对精确数字进行算术运算将始终产生精确的数值结果（在这种情况下，仍然是整数）。在许多编程语言中，一旦某个操作生成了某个大小的数字，结果要么不正确，要么会被转换为近似值，由浮动点数表示。使用 Racket，数字可以越来越大，直到计算机的内存耗尽并崩溃。以下是一些示例。

> (+ 1 1)
2

> (define int 1234567890987654321)
> (* int int int int)
2323057235416375647706123102514602108949250692331618011140356079618623681

> (- int)
-1234567890987654321

> (- 5 -7)
12

> (/ 4 8)
1/2

> (/ 5)
1/5

请注意，在最后的示例中，除法操作没有产生浮动点数，而是返回了精确值：一个有理数（将在下一节讨论）。

可以输入除了 10 以外的其他进制的整数。Racket 理解二进制数字（以#b为前缀的整数）、八进制数字（以#o为前缀的整数）和十六进制数字（以#x为前缀的整数）：

> #b1011
11

> #b-10101
-21

> #o666
438

> #xadded
712173

非十进制进制有一些特定的使用场景，一个例子是 HTML 网页通常将颜色值表示为十六进制数字。此外，二进制数字是计算机内部存储所有值的方式，因此它们对于学习基础计算机科学的人来说非常有用。八进制和十六进制值还有一个额外的优势：二进制数字可以很容易地转换为八进制，因为三个二进制位等于一个八进制值，四个二进制位等于一个十六进制位。

有理数

数学食物链中的下一级是有理数（或分数），用数学符号 ℚ 表示。Racket 中的分数由两个正整数值组成，它们之间用斜杠分隔（不允许有空格），前面可以选择性地加上加号或减号。有理数也是一种精确的数字类型，所有整数的运算都适用于有理数。

> -2/4
-1/2

> 4/6
2/3

> (+ 1/2 4/8)
1

> (- 1/2 2/4 4/8 8/16)
-1

> (* 1/2 2/3)
1/3

> (/ 2 2/3)
3

可以通过numerator和denominator函数获取有理数的分子和分母。

> (numerator 2/3)
2

> (denominator 2/3)
3

实数

实数是一个数学概念（由符号 ℝ 表示），在现实中并不存在于计算机世界中。像π这样的实数具有无限小数扩展，在计算机中只能被近似。因此，我们得到了第一类不精确数字：浮动小数。Racket 中的浮动小数与大多数编程语言和计算器中的输入方式相同。以下是一些（不幸的是无聊的）例子：

> -3.14159
-3.14159

> 3.14e159
3.14e+159

> pi
3.141592653589793

> 2.718281828459045
2.718281828459045

> -20e-2
-0.2

需要牢记的是，某些数字类型的数学概念在计算环境中的含义存在一些细微的区别。例如，输入为 1/10 的数字，如上所述，被视为精确的有理数，因为它可以在计算机中表示为这种形式（内部以两个二进制整数值存储），但值 0.1 被视为不精确的浮动小数值，作为实数值的近似值，因为它不能在内部表示为单一的二进制值（至少不能在不使用无限二进制位的情况下表示）。

复数

当我们使用复数这个术语时，并不意味着我们在说一个复杂的数字，而是指一种特殊类型的数字。如果你还不熟悉这个概念，可以跳过这一节，因为在本书的剩余部分不会使用复数（不过我鼓励你阅读这个迷人的主题）。这一节作为参考，供那些可能在自己项目中使用这些信息的勇敢人士参考。

复数的输入几乎与任何数学文本中的表示方式完全相同，但有一些需要注意的点。首先，如果省略了实部，虚部必须以加号或减号开头。其次，用于定义数字的字符串中不能有空格。最后，复数必须以i结尾。示例如下：

> +1i ; our friend, the imaginary number
0+1i

> 1i ; this will give an error
. . 1i: undefined;
  cannot reference an identifier before its definition

> +i ; it is even possible to leave off the 1
0+1i

> -1-234i
-1-234i

> -1.23+4.56i
-1.23+4.56i

> 1e10-2e10i
10000000000.0-20000000000.0i

请注意，复数可以是精确的或不精确的。我们可以使用exact?运算符来测试精确度：

> (exact? 1/2+8/3i)
#t

> (exact? 0.5+8/3i)
#f

要获取复数的组成部分，使用real-part和imag-part：

> (real-part 1+2i)
1

> (imag-part 1+2i)
2

这就是我们对数字塔和各种数字类型的基本算术操作的讨论。在接下来的几节中，我们将讨论比较运算符，数字类型相加时会发生什么（例如将整数与浮动小数相加），以及一些有用的数学函数。

数字比较

Racket 支持常见的数字比较运算符。我们可以测试数字是否相等：

> (= 1 1.0)
#t

> (= 1 2)
#f

> (= 0.5 1/2)
#t

并比较它们的大小：

> (< 1 2)
#t

> (<= 1 2)
#t

> (>= 2 1.9)
#t

你还可以将这些运算符应用于多个参数，Racket 会确保元素按对满足比较运算符。如下例所示，意味着 1 < 2，2 < 3，3 < 4。

> (< 1 2 3 4)
#t

> (< 1 2 4 3)
#f

但没有不等于运算符，所以要测试两个数字是否不相等，你需要做类似如下的操作：

> (not (= 1 2))
#t

合并数据类型

如上所示，你可以比较不同类型的数字。但请注意，我们只对精确数字与精确数字进行算术运算，反之亦然。这里我们将讨论混合精确和不精确数字的影响。混合精确和不精确数字不会导致大规模混乱（想象一下捉鬼敢死队中的能量流交叉），但你应该注意一些细节。

首先，当涉及到算术运算符（加法、减法等）时，规则相当简单：

将精确与精确混合将得到精确的结果。

将不精确与不精确混合将得到不精确的结果。

将精确与不精确（或反之）混合将得到不精确的结果。

这里没有什么意外，但这些规则也有一些微妙的例外，比如将任何数与零相乘会得到精确的零。

三角函数通常会返回一个不精确的结果（但同样也有一些合理的例外；例如 exp 0 会返回精确的 1）。你将在本章后面看到这些函数。平方函数(sqr)如果输入一个精确数字，将返回一个精确结果。如果它的平方根对应函数(sqrt)接收的是精确数字并且结果是精确数字，则也会返回精确结果；否则，它将返回不精确的数字：

> (sqrt 25)
5

> (sqrt 24)
4.898979485566356

> (sqr 1/4)
1/16

> (sqr 0.25)
0.0625

> (sqrt 1/4)
1/2

> (sqrt -1)
0+1i

有几个函数可以用来测试精确性。之前你见过exact?函数，如果它的参数是精确数字，则返回#t；否则返回#f。它的对等函数是inexact?。还可以通过两个内置函数强制将一个精确数字变为不精确，反之亦然：

> (exact->inexact 1/3)
0.3333333333333333

> (inexact->exact pi)
3 39854788871587/281474976710656
>

有一个谓词可以测试本节中提到的每种数字数据类型，但它们的工作方式可能不完全如你所预期。

> (integer? 70)
#t

> (real? 70.0)
#t

> (complex? 70)
#t

> (integer? 70.0)
#t

> (integer? 1.5)
#f

> (rational? 1.5)
#t

> (rational? 1+5i)
#f

> (real? 2)
#t

> (complex? 1+2i)
#t

这些谓词返回的结果符合该谓词的数学含义。你可能期望(complex? 70)返回#f，但是整数也是复数，只不过它的实部为零。同样，你可能期望(integer? 70.0)返回#f，因为它是一个浮点数，但由于小数部分为 0，该数（虽然也是实数）实际上是一个整数（但不是精确的数字）。数字 1.5 等于 3/2，因此 Racket 认为它是一个有理数（但同样是近似的）。数字类型谓词（integer?、rational?、real? 和 complex?）与数学层级（或数值塔）对齐，如本节开头所提到的。

内置函数

除了上述的普通算术运算符，Racket 还提供了通常的数学函数，这些函数是任何编程语言中的标准内容。以下是一些详细的示例。

> (abs -5)
5

> (ceiling 1.5)
2.0

> (ceiling 3/2)
2

> (floor 1.5)
1.0

> (tan (/ pi 4))
0.9999999999999999

> (atan 1/2)
0.4636476090008061

> (cos (* 2 pi))
1.0

> (sqrt 81)
9

> (sqr 4)
16

> (log 100) ; natural logarithm
4.605170185988092

> (log 100 10) ; base 10 logarithm
2.0

> (exp 1) ; e¹
2.718281828459045

> (expt 2 8) ; 2⁸
256

请注意，当可能时，带有精确参数的函数将返回精确的结果。

当然，还有许多其他可用的函数。详情请查阅 Racket 文档。

中缀表示法

正如我们所看到的，在 Racket 中，数学运算符位于操作数之前：(+ 1 2)。典型的数学符号是将运算符放在操作数之间：1 + 2。这种写法叫做 中缀表示法。Racket 原生支持一种通过点运算符的中缀表示法。下面是一些示例。

> (1 . >= . 2)
#f

> (1 . < . 2)
#t

> (1 . + . 2)
3

> (2 . / . 4)
1/2

> (2 . * . 3)
6

当我们希望明确某些运算符之间的关系时，这非常有用，但对于复杂的表达式来说，它显得有些笨重。

对于复杂的数学表达式，Racket 提供了 infix 包。这个包可以通过以下代码导入：

#lang at-exp racket
(require infix)

#lang 关键字允许我们定义语言扩展（在本例中，at-exp 允许我们使用 @-表达式，我们很快就会看到）。require infix 表达式表示我们希望使用 infix 库。不幸的是，infix 包默认没有安装，必须从 Racket 包管理器安装（可以通过 DrRacket 的文件菜单访问包管理器）或使用 raco 命令行工具（如果 raco 的可执行文件不在你的执行路径中，可以直接从 Racket 安装文件夹启动）。要使用 raco 安装，请在命令行执行以下命令：

> raco pkg install infix

还需要注意，我们使用了语言扩展 at-exp，虽然它不是完全必要的，但提供了一种更优雅的语法来输入中缀表达式。例如，如果没有 at-exp，要计算 1 + 2 * 3，我们需要输入以下内容：

> ($ "1+2*3")
7

使用 at-exp 扩展，我们可以输入如下内容：

> @${1+2*3}
7

尽管这仅节省了几个按键，但它去除了令人讨厌的字符串分隔符，看起来更自然一些。

函数调用通过使用方括号以熟悉的方式处理。例如

> @${1 + 2*sin[pi/2]}
3.0

甚至有一种特殊的列表表示形式：

> @${{1, 2, 1+2}}
'(1 2 3)

还有一个用于变量赋值的形式（使用 :=，等同于 set!，因此变量必须先绑定）：

> (define a 5)
> @${a²}
25
> @${a := 6}
> @${2*a + 7}
19

为了进一步说明 infix 包的功能，下面是一个包含名为 quad 的函数的完整程序，该函数返回一个包含二次方程根的列表

ax² + bx + c = 0

正如你在代数课上学到的（你还记得吧），这些根可以表示为

#lang at-exp racket
(require infix)

(define (quad a b c)
  (let ([d 0])
    @${d := sqrt[b² - 4 * a * c];
         {(-b + d)/(2*a), (-b - d)/(2*a)}}))

编译后，我们可以通过输入以下内容求解 2x² -* 8x + 6 = 0 的 x：

> @${quad[2, -8, 6]}
'(3 1)

或者等效地。。。

> (quad 2 -8 6)
'(3 1)

总结

通过前两章的学习，你应该已经对 Racket 的基本数据类型非常熟悉。你也应该能熟练地在 Racket 丰富的数值环境中执行数学运算。这应该为接下来更有趣的主题做好准备，我们将在其中探讨数论、数据分析、逻辑编程等内容。但接下来要学习的是函数式编程，我们将深入探讨如何实际编写程序。

第三章：函数基础

在上一章中，我们介绍了 Racket 的基本数值运算。在本章中，我们将探讨构成函数式编程主题的核心思想。

什么是函数？

一个函数可以被看作是一个盒子，具有以下特点：如果你把一个对象放入一侧，另一个对象（可能相同，也可能不同）会从另一侧出来；对于任何给定的输入项，都会输出相同的结果。这最后一个特点意味着，如果你把一个三角形放进一侧，另一侧出来的是一个星星，那么下次你再放入一个三角形时，出来的也会是一个星星（参见图 3-1）。不幸的是，Racket 没有任何内置函数可以接受几何形状作为输入，所以我们只能使用更普通的对象，比如数字或字符串。

图 3-1：函数如何工作

Lambda 函数

在 Racket 中，函数最基本的形式是由 lambda 表达式 产生的，通常用希腊字母 λ 表示。这来源于一种名为 λ 演算的数学学科，这个领域比较晦涩，我们在这里不作探讨。相反，我们将重点关注 lambda 表达式的实际应用。Lambda 函数用于简短的简单函数，它们会立即被应用，因此不需要一个名字（它们是匿名的）。例如，Racket 有一个内置函数 add1，它简单地将 1 加到它的参数上。一个等价的 Racket lambda 表达式如下所示：

(lambda (x) (+ 1 x))

Racket 允许你用希腊字母λ来简写 lambda，我们将频繁使用这种方式表示它。你可以通过在 DrRacket 中从插入菜单中选择它，或使用快捷键 CTRL-\ 来输入 λ。我们可以将上面的代码重写为如下：

(λ (x) (+ 1 x))

为了查看 lambda 表达式的实际效果，在交互面板中输入以下内容：

> ((λ (x y) (+ (* 2 x) y)) 4 5)
13

请注意，在列表的第一个元素位置，我们并没有使用函数名，而是使用了实际的函数。在这里，4 和 5 会被传递给 lambda 函数进行求值。

执行上述计算的另一种等效方式是使用 let 形式。

> (let ([x 4]
        [y 5])
    (+ (* 2 x) y))
13

这种形式使得对变量 x 和 y 的赋值更加直观。

我们可以通过将 lambda 表达式赋值给标识符（一个命名函数）来以更常规的方式使用它们。

> (define foo (λ (x y) (+ (* 2 x) y)))
> (foo 4 5)
13

Racket 还允许你使用这个快捷方式来定义函数：

> (define (foo x y) (+ (* 2 x) y))
> (foo 4 5)
13

这两种函数定义形式是完全等价的。

高阶函数

Racket 是一种函数式编程语言。函数式编程是一种编程范式，强调一种声明式的编程风格，没有副作用。副作用是指改变编程环境状态的事情，比如给全局变量赋值。

Lambda 值特别强大，因为它们可以作为值传递给其他函数。接受其他函数作为值（或返回一个函数作为值）的函数被称为 高阶函数。在本节中，我们将探讨一些最常用的高阶函数。

map 函数

map 函数是最直接的高阶函数之一，它将一个函数作为第一个参数，一个列表作为第二个参数，然后将该函数应用于列表中的每个元素。下面是一个 map 函数的示例：

> (map (λ (x) (+ 1 x)) '(1 2 3))
'(2 3 4)

你也可以将一个命名函数传递给 map：

> (define my-add1 (λ (x) (+ 1 x)))
> (map my-add1 '(1 2 3)) ; this works too
'(2 3 4)

在上面的第一个示例中，我们将增量函数传递给 map 作为一个值。然后 map 函数将它应用于列表中的每个元素(1 2 3)。

事实证明，map 非常灵活。它可以接受函数能够接受的任意多个列表作为参数。效果有点像拉链，其中列表参数并行传递给函数，得到的结果是一个单一的列表，该列表通过将每个列表中的元素应用到函数上形成。下面的示例展示了如何使用 map 将两个等大小列表的相应元素相加：

> (map + '(1 2 3) '(2 3 4))
'(3 5 7)

如你所见，两个列表通过将相应元素加在一起进行了合并。

apply 函数

map 函数让你可以将一个函数应用于列表中的每一项。但有时候，我们希望将列表的所有元素作为参数应用到单个函数调用中。例如，Racket 的算术运算符可以接受多个数值参数：

> (+ 1 2 3 4)
10

但是如果我们尝试将一个列表作为参数传递进去，我们会得到一个错误：

> (+ '(1 2 3 4))
. . +: contract violation
  expected: number?
  given: '(1 2 3 4)

+ 运算符只接受数值类型的参数。但别担心，有一个简单的解决方案：apply 函数：

> (apply + '(1 2 3 4))
10

apply 函数接受一个函数和一个列表作为参数。然后它应用该函数到列表中的值，就像这些值是函数的参数一样。

foldr 和 foldl 函数

另一种将列表元素加在一起的方式是使用 foldr 函数。foldr 函数接受一个函数、一个初始参数和一个列表：

> (foldr + 0 '(1 2 3 4))
10

尽管 foldr 在这里产生了与 apply 相同的结果，但它在幕后是以非常不同的方式工作的。这就是 foldr 如何将列表加在一起的方式：1 + (2 + (3 + (4 + 0)))。该函数通过以右关联的方式执行操作（因此 foldr 中的 r）将列表“折叠”在一起。

与 foldr 紧密相关的是 foldl。foldl 的作用与你的预期略有不同。请观察以下内容：

> (foldl cons '() '(1 2 3 4))
'(4 3 2 1)

> (foldr cons '() '(1 2 3 4))
'(1 2 3 4)

你可能会预期 foldl 会生成(1 2 3 4)，但实际上 foldl 执行的计算是(cons 4 (cons 3 (cons 2 (cons 1 ())))))。列表参数是从左到右处理的，但传递给 cons 的两个参数是反转的——例如，我们有 (cons 1 ()) 而不是 (cons () 1)。

compose 函数

函数可以通过将一个函数的输出作为另一个函数的输入来组合在一起，或称为组合。在数学中，如果我们有 f (x) 和 g(x)，它们可以组合成 h(x) = f (g(x))（在数学文本中，有时使用一个特殊的组合运算符表示为 h(x) = (f ∘ g)(x)）。我们可以在 Racket 中使用 compose 函数来实现这一点，它接受两个或更多的函数并返回一个新的组合函数。这个新函数有点像管道。例如，如果我们想将一个数字加 1 并平方结果（即，对于任何 n 计算 (n + 1)²），我们可以使用以下函数：

(define (n+1_squared n) (sqr (add1 n)))

但是 compose 使得这个表达式更加简洁：

> (define n+1_squared (compose sqr add1))
> (n+1_squared 4)
25

更简单一些. . .

> ((compose sqr add1) 4)
25

请注意，add1 会首先执行，然后是 sqr。函数是从右到左组合的——即最右边的函数先执行。

filter 函数

我们的最后一个例子是 filter。这个函数接受一个谓词（返回布尔值的函数）和一个列表。返回值是一个列表，其中仅包含原始列表中满足谓词的元素。下面是我们如何使用 filter 来返回列表中的偶数元素：

> (filter even? '(1 2 3 4 5 6))
'(2 4 6)

filter 函数允许你过滤掉原始列表中不需要的项目。

正如你在本节中所看到的，我们将函数描述为盒子的方式是恰当的，因为它实际上是一个值，可以像数字、字符串或列表一样传递给其他函数。

词法作用域

Racket 是一种词法作用域语言。Racket 文档为 词法作用域 提供了以下定义：

Racket 是一种词法作用域语言，这意味着每当一个标识符被用作表达式时，表达式的文本环境中的某些内容决定了该标识符的绑定。

这个定义中重要的概念是 文本环境。文本环境有两种类型：全局环境 或者标识符绑定的地方。如我们所见，标识符通常在全局环境（有时称为顶层）中用 define 绑定。例如：

> (define ten 10)
> ten
10

在全局环境中绑定的标识符的值是可以在任何地方使用的。因此，它们应该谨慎使用。全局定义通常应保留给函数定义和常量值。然而，这并不是一个命令，因为全局变量还有其他合法的用途。

在一个形式中绑定的标识符通常不会在形式外部被定义（但请参阅第 58 页的 “一些闭包的时刻”，这条规则有个有趣的例外）。

让我们来看几个例子。

之前我们探讨了 lambda 表达式 ((λ (x y) (+ (* 2 x) y)) 4 5)。在这个表达式中，标识符 x 和 y 被绑定为 4 和 5。一旦 lambda 表达式返回了一个值，标识符将不再被定义。

这里再次是等价的 let 表达式。

(let ([x 4]
      [y 5])
  (+ (* 2 x) y))

你可能会想象，以下代码也会有效：

(let ([x 4]
      [y 5]
      [z (* 2 x)])
  (+ z y))

但是这无法正常工作。从语法角度来看，无法将其转换回等效的 lambda 表达式。尽管标识符 x 已在绑定表达式列表中绑定，但 x 的值仅在 let 表达式的主体内可用。

然而，let 还有一种替代定义，叫做 let*。在这种情况下，以下代码将有效。

> (let* ([x 4]
         [y 5]
         [z (* 2 x)])
    (+ z y))
13

区别在于，使用 let* 时，标识符的值在它被绑定后立即可用，而使用 let 时，标识符的值只有在所有标识符被绑定后才能使用。

这是另一个稍微不同的变体，其中 let 确实有效。

> (let ([x 4]
        [y 5])
    (let ([z (* 2 x)])
      (+ z y)))
13

在这种情况下，第二个 let 位于第一个 let 的词法环境中（但正如我们所见，let* 更高效地编码了这种类型的嵌套结构）。因此，x 可以在表达式 (* 2 x) 中使用。

条件表达式：一切都与选择有关

计算机根据输入改变执行路径的能力是其架构中的一个重要组成部分。没有这一点，计算机无法进行计算。在大多数编程语言中，这种能力表现为一种叫做 条件表达式 的东西，而在 Racket 中，它被表达为（以最通用的形式）cond 表达式。

假设你被要求编写一个函数，该函数返回一个值，指示一个数字是否只能被 3 整除、只能被 5 整除，或者同时被两者整除。一种实现方式是使用以下代码。

(define (div-3-5 n)
  (let ([div3 (= 0 (remainder n 3))]
        [div5 (= 0 (remainder n 5))])
    (cond [(and div3 div5) 'div-by-both]
          [div3 'div-by-3]
          [div5 'div-by-5]
          [else 'div-by-neither])))

cond 表达式包含一系列表达式。对于这些表达式中的每一个，第一个元素包含某种类型的测试，如果该测试为真，则计算第二个元素并返回其值。请注意，在这个例子中，判断是否能被 3 和 5 整除的测试必须放在最前面。以下是试运行：

> (div-3-5 10)
'div-by-5

> (div-3-5 6)
'div-by-3

> (div-3-5 15)
'div-by-both

> (div-3-5 11)
'div-by-neither

cond 的简化版是 if 表达式。该表达式由一个单一的测试（第一个子表达式）组成，如果测试为真，则返回其第二个参数（在其被计算之后）；否则返回并计算第三个参数。这个例子简单地测试一个数字是偶数还是奇数。

(define (parity n)
  (if (= 0 (remainder n 2)) 'even 'odd))

如果我们运行一些测试：

> (parity 5)
'odd
> (parity 4)
'even

cond 和 if 都是返回值的表达式。在某些情况下，人们只是希望在条件为真或为假时有条件地执行一些步骤。这通常涉及到某些副作用，比如打印一个值，而不需要返回结果。为了这个目的，Racket 提供了 when 和 unless。如果条件表达式为真，when 会计算其主体中的所有表达式；否则它什么也不做。

> (when (> 5 4)
    (displayln 'a)
    (displayln 'b))
a
b

> (when (< 5 4) ; doesn't generate output
    (displayln 'a)
    (displayln 'b))

unless 表达式的行为与 when 完全相同；区别在于，如果条件表达式不为真，unless 将会计算其主体。

> (unless (> 5 4) ; doesn't generate output
    (displayln 'a)
    (displayln 'b))

> (unless (< 5 4)
    (displayln 'a)
    (displayln 'b))
a
b

我感觉有点循环！

循环（或迭代）是任何编程语言的基础。在讨论循环时，不可避免地会涉及到可变性的话题。可变性当然意味着变化。可变性的例子包括给变量赋值（或者更糟的情况，改变嵌入在数据结构中的值，例如向量）。如果一个函数在函数体内没有发生变异（或副作用，如打印出一个值或写入文件——这些也属于变异形式），则该函数被称为纯粹函数。如果可能的话，通常应避免变异。一些语言，如 Haskell，会特别避免这种不良做法。一个 Haskell 程序员宁愿赤脚走过一床炙热的煤炭，也不愿写一个不纯粹的函数。

偏好纯粹函数有很多充分的理由，比如所谓的引用透明性（这个术语的意思是能够推理程序的行为）。我们不会那么挑剔，并将在必要时谨慎使用变异和不纯粹的函数。

假设你被要求定义一个函数来加上前 n 个正整数。如果你熟悉像 Python 这样的语言（它本身是一个优秀的语言），你可能会这样实现它。

def sum(n):
    s = 0
    while n > 0:
     ➊ s = s + n
     ➋ n = n - 1
    return s

这是一个完全有效的函数（并且是使用可变变量的一个相当温和的例子）来生成所需的和，但请注意，变量 s 和 n 都被修改了 ➊ ➋。虽然这本身没有什么问题，但这些赋值操作使得 sum 函数的实现变得不纯粹。

纯粹性

在我们开始深入讨论之前，让我们先看看如何仅使用纯函数来实现循环。递归是 Racket（以及所有函数式编程语言）中循环或迭代的常见做法。递归函数就是通过自身来定义的函数。以下是一个纯粹的（且简单的）递归程序，用于返回前 n 个正整数的和。

 (define (sum n)
➊ (if (= 0 n) 0
    ➋ (+ n (sum (- n 1)))))

正如你所看到的，我们首先测试 n 是否已达到 0 ➊，如果是，则直接返回 0。否则，我们取当前的 n 值，并递归地将其加上所有小于 n 的数字的 sum ➋。对于数学爱好者来说，这有点像数学归纳法的证明方式，其中我们有一个基例 ➊ 和归纳部分 ➋。

让我们来测试一下。

> (sum 100)
5050

我们刚才看到的例子存在一个潜在的问题。问题在于每次进行递归调用时，Racket 必须跟踪当前代码的位置，以便它可以返回到正确的位置。让我们更深入地看一下这个函数。

(define (sum n)
  (if (= 0 n) 0
   ➊ (+ n (sum (- n 1)))))

当递归调用 sum 被执行 ➊ 时，递归调用返回后仍然需要做加法操作。此时，系统必须记住递归调用发生时的位置，以便在递归调用返回后能够从中断的地方继续执行。这对于不需要深度嵌套的函数来说不成问题，但对于深度递归较大的情况，计算机可能会耗尽空间并以戏剧性的方式失败。

Racket（以及几乎所有的 Scheme 变种）实现了一种叫做 尾调用优化 的技术（Racket 社区称这只是处理尾调用的正确方式，而不是一种优化，但在其他地方一般称为 尾调用优化）。这意味着，如果递归调用是函数中最后一个执行的调用，那么就不需要记住返回的地方，因为在该函数中没有更多需要计算的内容。此类函数实际上表现为一个简单的迭代循环。这是 Lisp 系列语言中进行循环计算的基本范式。然而，你必须以特定的方式构造函数，才能利用这一特性。我们可以按如下方式重写求和函数。

(define (sum n)
  (define (s n acc)
 ➊ (if (= 0 n) acc
     ➋ (s (- n 1) (+ acc n))))
  (s n 0))

请注意，sum 现在有一个名为 s 的局部函数，它接受一个额外的参数 acc。还要注意，s 会递归调用自己 ➋，但它是局部函数中的最后一个调用，因此会进行尾调用优化。之所以能够这样工作，是因为 acc 累积了和并在递归过程中不断传递。当它达到最终的嵌套调用 ➊ 时，累积的值会被返回。

另一种实现方法是使用命名 let 形式，如下所示。

(define (sum n)
  (let loop ([n n] [acc 0])
    (if (= 0 n) acc
        (loop (- n 1) (+ acc n)))))

命名的 let 形式与普通的 let 类似，它有一个初始化局部变量的部分。表达式 [n n] 起初可能让人感到困惑，但它的意思是，let 中的第一个 n 被初始化为 sum 函数调用时传入的 n。与 define 不同，define 只是将标识符与函数体绑定，而命名的 let 则绑定标识符（在这个例子中是 loop），计算函数体并返回通过初始化参数列表调用函数所得到的值。在这个例子中，函数是递归调用的（这是命名 let 的正常使用情况），如代码中的最后一行所示。这是一个无副作用的循环构造的简单示例，受 Lisp 社区推崇。

黑暗面的力量

纯粹性是好的，就它所达到的程度而言。问题在于，保持纯粹需要很多工作（特别是在现实生活中）。是时候仔细看看让人头痛的 set! 形式了。请注意，任何内建的 Racket 标识符末尾加上感叹号，可能是在警告它会做一些不纯的事情，比如以某种方式修改程序状态。使用语句改变程序状态的编程风格被称为命令式编程。无论如何，set! 会重新为先前绑定的标识符分配一个值。让我们重新审视一下之前提到的 Python 的 sum 函数。下面给出了等效的 Racket 版本。

(define (sum n)
  (let ([s 0])   ; initialize s to zero
    (do ()       ; an optional initializer statement can go here
      ((< n 1))  ; do until this becomes true
      (set! s (+ s n))
      (set! n (- n 1)))
    s))

Racket 实际上没有 while 语句（这是因为 Lisp 社区的预期是递归应该成为主要的递归方式）。Racket 的 do 形式起到了 do-until 的作用。

如果你熟悉 C 系列编程语言，那么你会看到 do 语句的完整形式实际上类似于 C 语言中的 for 语句。用 C 语言求前 n 个整数之和的一种方式如下：

int sum(int n)
{
  int s = 0;
  for (i=1; i<= n; i++) // initialize i=1, set i = i+1 at each iteration
                        // do while i<= n
  {
      s = s + i;
  }
  return s;             // return s
}

这里是 Racket 的等效形式：

 (define (sum n)
➊ (let ([s 0])
  ➋ (do ([i 1 (add1 i)])   ; initialize i=1, set i = i+1 at each iteration
    ➌ ((> i n) s)          ; do until i>n, then return s
    ➍ (set! s (+ s i)))))

在上面的代码中，我们首先将局部变量 s（它存储我们的总和）初始化为 0 ➊。do 的第一个参数 ➋ 初始化 i（i 对于 do 形式是局部的）为 1，并指定每次迭代时 i 增加 1。第二个参数 ➌ 测试 i 是否达到了目标值，如果是，则返回当前 s 的值。最后一行 ➍ 实际计算总和的地方，通过 set! 语句将当前 i 的值加到 s 上。

诸如带有 set! 语句的 do 形式的值，其优点在于许多算法自然地以逐步的方式陈述，而变量则通过类似于 set! 语句的操作被改变。这有助于避免将这些结构转换为纯递归函数时需要的复杂思维。

在下一部分，我们将研究 for 家族的循环变体。在这里，我们将看到 Racket 的 for 形式在管理循环方面提供了很大的灵活性。

for 家族

Racket 提供了 for 形式，并且有一个庞大的 for 变体家族，足以满足大部分的迭代需求。

一系列的值

在我们深入研究 for 之前，让我们先看一下几个常常与 for 一起使用的 Racket 形式：in-range 和 in-naturals。这些函数返回一些我们之前没有见过的东西，叫做流。流是类似于列表的对象，但与列表一次性返回所有值不同，流只有在请求时才返回一个值。这基本上是一种惰性求值的形式，值在请求之前不会提供。例如，(in-range 10) 会返回一个包含 10 个值的流，起始值为 0，结束值为 9。下面是 in-range 实际应用的一些例子。

> (define digits (in-range 10))
> (stream-first digits)
0

> (stream-first (stream-rest digits))
1

> (stream-ref digits 5)
5

上面的代码中，(in-range 10)定义了一个值的序列 0，1，...，9，但digits实际上并不包含这些数字。它基本上只是包含了一个规范，允许它在稍后的某个时间返回这些数字。当执行(stream-first digits)时，digits返回第一个可用值，这个值是数字 0。然后，(stream-rest digits)返回包含第一个数字之后所有数字的流，因此(stream-first (stream-rest digits))返回数字 1。最后，stream-ref返回流中的第i个值，在这个例子中是 5。

函数in-naturals的工作方式与in-range类似，但它返回的是无限数量的值，而不是特定数量的值。

> (define naturals (in-naturals))
> (stream-first naturals)
0

> (stream-first (stream-rest naturals))
1

> (stream-ref naturals 1000)
1000

随着我们在一些for例子中的使用，流的概念如何有用将变得更加清晰。我们还将介绍一些有用的额外参数，用于in-range。

for 的具体实现

下面是for最基本形式的一个例子。目标是将字符串“Hello”的每个字符单独打印在一行上。

> (let* ([h "Hello"]
      ➊ [l (string-length h)])
   ➋ (for ([i (in-range l)])
     ➌ (display (string-ref h i))
      (newline)))
H
e
l
l
o

我们捕获了string-length ➊，并使用该长度与in-range函数 ➋。然后，for使用生成的值流来填充标识符i，该标识符在for表达式体中用于提取和显示字符 ➌。在前一部分中提到，in-range会生成一个值的序列，但事实证明，在for语句的上下文中，一个正整数也可以生成一个流，下面的例子将说明这一点。

> (for ([i 5]) (display i))
01234

for表达式对于接受的参数类型非常宽容。事实证明，有一种更简单的方法可以实现我们的目标。

> (for ([c "Hello"])
    (display c)
    (newline))
H
e
l
l
o

我们没有使用索引流，而是直接提供了字符串本身。正如我们将看到的，for可以接受许多内建数据类型，这些数据类型包含多个值，如列表、向量和集合。这些数据类型也可以转换为流（例如，通过in-list，in-vector等），在某些情况下与for一起使用时可以提供更好的性能。所有提供值给for用来迭代的标识符的表达式被称为序列表达式。

是时候看看我们如何利用上面介绍的神秘in-naturals表达式了。

> (define (list-chars str)
    (for ([c str]
          [i (in-naturals)])
      (printf "~a: ~a\n" i c)))

> (list-chars "Hello")
0: H
1: e
2: l
3: l
4: o

list-chars函数中的for表达式现在有两个序列表达式。这些序列表达式并行评估，直到其中一个表达式没有值为止。这就是为什么即使in-naturals提供了无限数量的值，for表达式最终仍然会终止的原因。

事实上，确实有一种版本的for，它不并行评估其序列表达式：它被称为for*。这个版本的for会像下面的例子所示，以嵌套的方式评估其序列表达式。

> (for* ([i (in-range 2 7 4)]
         [j (in-range 1 4)])
    (display (list i j (* i j)))
    (newline))
(2 1 2)
(2 2 4)
(2 3 6)
(6 1 6)
(6 2 12)
(6 3 18)

在这个例子中，我们还展示了in-range可以接受的额外可选参数。序列表达式(in-range 2 7 4)将产生一个从数字 2 开始的流，每次迭代时将该值增加 4。当流中的值达到小于 7 的数值时，迭代会停止。所以在这个表达式中，i绑定为 2 和 6。表达式(in-range 1 4)没有指定步长值，因此使用默认的步长 1。这会导致j绑定为 1、2 和 3。

最终，for*会将每一个可能的i值和j值的组合形成输出。

你能理解这个吗？

数学中有一种符号叫做集合表示法。集合表示法的一个例子是表达式 {x² ∣ x ∈ ℕ, x ≤ 10}。这只是 0 到 10 之间所有自然数的平方集合。Racket 提供了一个自然的（字面意思上的）扩展形式，称为列表推导式。这个数学表达式在 Racket 中的直接翻译如下：

> (for/list ([x (in-naturals)] #:break (> x 10)) (sqr x))
'(0 1 4 9 16 25 36 49 64 81 100)

#:break关键字用于在in-naturals生成的流中，一旦所有期望的值都已生成，就终止该流。另一种方法是在不使用#:break的情况下使用in-range来实现这一点。

> (for/list ([x (in-range 11)]) (sqr x))
'(0 1 4 9 16 25 36 49 64 81 100)

如果你只想要偶数的平方，可以这样做：

> (for/list ([x (in-range 11)] #:when (even? x)) (sqr x))
'(0 4 16 36 64 100)

这次引入了#:when关键字，以提供一个条件，用于过滤生成列表时所用的值。

for/list与for的一个重要区别是，for/list不会产生任何副作用，因此它是一种纯粹的形式，而for明确用于产生副作用。

该是时候使用闭包了

假设你在银行有 $100，并且想要探讨不同利率下复利的影响。如果你不熟悉复利是如何运作的（而你应该了解它），它的工作原理如下：如果你在一个支付 i 周期性利息的银行账户中存有 n[0]，那么在期末你将得到：

n[1] = n[0] + n[0]i = n0

以你的 $100 存款为例，如果银行每期支付 4 百分之 (i = 0.04) 的利息（现在想在银行得到这个利率真的很难），那么在期末你将得到以下金额：

100 + 100 · 4% = 100(1 + 0.04) = 104

一种方法是创建一个函数，在应用利率后自动更新余额。一个聪明的方式是使用 Racket 中的闭包，我们将在以下函数中使用它：

(define (make-comp bal int)
  (let ([rate (add1 (/ int 100.0))])
 ➊ (λ () (set! bal (* bal rate))  (round bal))))

请注意，这个函数实际上返回了另一个函数——lambda 表达式（λ . . . ）➊——并且这个 lambda 表达式包含了来自定义作用域的变量。我们稍后将解释这如何工作。

在上面的代码中，我们定义了一个名为 make-comp 的函数，它接受两个参数：初始余额和利率百分比。rate 变量初始化为 (1 + i)。这个函数并不直接返回一个数字，而是返回另一个函数。返回的函数设计成每次调用时（不带参数）通过应用利率更新余额并返回新余额。你可能会认为，一旦 make-comp 返回了 lambda 表达式，bal 和 rate 变量就会被定义为未定义，但在闭包中并非如此。该 lambda 表达式被称为捕获了 bal 和 rate 变量，这些变量在 lambda 表达式定义的词法环境中是可用的。返回的函数包含了 bal 和 rate 变量（它们是在函数外部定义的），这就是它成为闭包的原因。

让我们尝试一下，看看会发生什么。

> (define bal (make-comp 100 4))

> (bal)
104.0

> (bal)
108.0

> (bal)
112.0

> (bal)
117.0

如你所见，平衡值已被适当更新。

闭包的另一个用途是在一种叫做 记忆化 的技术中。其含义是我们存储先前计算的值，如果某个值已经计算过了，就返回已记住的值；否则，继续计算该值并保存，以便下次需要时使用。这在函数可能会多次调用且参数已经计算过的场景中非常有用。

为了实现这个功能，通常会使用一种叫做 哈希表 或字典的结构。哈希表是一个可变的键值对集合。哈希表可以通过 make-hash 函数构造。项可以通过 hash-set! 存储到哈希表中，通过 hash-ref 从哈希表中检索。我们可以通过 hash-has-key? 来测试表中是否已包含某个键。

阶乘函数的标准定义是 n! = n(*n - 1)!。在 Racket 中实现这一点的显而易见方法如下。

(define (fact n)
  (if ( = 0 n) 1
      (* n (fact (- n 1)))))

这可以正常工作，但每次你调用 (fact 100) 时，Racket 都必须执行 100 次计算。使用记忆化时，第一次执行 (fact 100) 仍然需要 100 次计算。但下次你调用 (fact 100)（或者调用 fact 处理任何小于 100 的值）时，Racket 只需在哈希表中查找该值，这只需要一步操作。以下是实现代码。

(define fact
  (let ([h (make-hash)]) ; hash table to contain memoized values
 ➊ (define (fact n)
      (cond [(= n 0) 1]
         ➋ [(hash-has-key? h n) (hash-ref h n)]
             [else
             ➌ (let ([f (* n (fact (- n 1)))]) 
               ➍ (hash-set! h n f)
                f)]))
 ➎ fact))

需要注意的是，外部的 fact 函数实际上返回了内部的 fact 函数 ➊。这最终就是我们调用 fact 100 时执行的部分。正是这个捕获了哈希表的内部 fact 函数，构成了闭包。首先，它检查传递给 fact 的参数是否是已计算的值 ➋，如果是，返回保存的值。如果值尚未计算，则必须进行计算 ➌，但计算后会将其保存，以便以后需要时使用 ➍。局部的 fact 函数作为全局 fact 函数的返回值被返回（抱歉用了相同的名称两次）。

应用

在介绍了 Racket 的基本编程构造后，让我们看一下跨越计算机科学、数学和娱乐谜题的一些应用。

我没有队列

在这一节中，我们将涉及 Racket 的面向对象编程功能。对象就像我们在第一章中遇到的结构的豪华版。

想象一下清晨，一个小镇银行只有一个出纳员。银行刚刚开门，出纳员还在试图准备好工作，但客户 Tom 已经到达并在窗口等候。不久，另外两个客户出现了：Dick 和 Harry。出纳员最终依次服务 Tom，然后是 Dick 和 Harry。这种情况是一个典型的队列示例。严格来说，队列是一种先进先出（FIFO）数据结构。Racket 自带有内置队列（事实上有好几个），但让我们尝试从头开始构建一个队列。

我们可以用一个列表来模拟队列。例如，排队等待看出纳员的人群可以通过一个单一列表表示：(define q (list 'tom 'dick 'harry))。但这里有一个问题。显然，通过使用car（或first）和cdr（或rest），很容易将 Tom 从列表头部移除并获得列表的其余部分：

> (car q)
'tom

> (set! q (cdr q))
> q
'(dick harry)

但是当 Sue 出现时会发生什么？我们可以做如下操作：

> (set! q (append q (list 'sue)))
> q
'(dick harry sue)

但是想一想，如果列表非常长，比如有 10,000 个元素，会发生什么。append函数将会创建一个包含 q 中所有元素以及一个附加值'sue的新列表。实现这一点的高效方法之一是保持一个指向列表最后一个元素的指针，并且在不创建新列表的情况下，将列表最后一个节点的cdr指向列表(list 'sue)（参见图 3-2）。此时，警报铃声应该在你脑中响起。你应该会觉得修改列表结构某种程度上是错误的。你是对的。使用正常的 Racket 列表结构实际上无法做到这一点，因为列表对中的car和cdr单元是不可变的，不能被更改。

图 3-2：可变列表

Scheme 的传统版本允许通过set-car!和set-cdr!方法修改一个 cons 节点的元素。由于这些方法在 Racket 中没有定义，Racket 保证任何绑定到 Racket 列表的标识符，在程序的生命周期内都会保持相同的值。

仍然有合理的理由需要这种功能。正如我们所见，这种功能对于队列的高效操作是必需的。为了满足这一需求，Racket 提供了一个可变的 cons 单元，可以通过mcons函数创建。可变 cons 单元的每个组件都可以通过set-mcar!和set-mcdr!修改。mcar和mcdr是相应的访问器函数。

修改列表结构之所以不好，是因为如果某个其他标识符绑定到该列表，它现在会将修改后的列表作为值，可能这并不是预期的行为。请观察以下示例。

> (define a (mcons 'apple 'orange))
> (define b a)
> a
(mcons 'apple 'orange)
> b
(mcons 'apple 'orange)

> (set-mcdr! a 'banana)
> a
(mcons 'apple 'banana)
> b
(mcons 'apple 'banana)

尽管我们看似只改变了 a 的值，但我们实际上也改变了 b 的值。

为了避免这种潜在的灾难性情况，我们将封装列表，使得列表本身不可访问，但我们仍然能够从列表的前端移除元素并向列表的末端添加元素，以实现队列的功能。封装是面向对象编程的基本组成部分。我们将通过创建一个包含实现队列所需所有功能的类来直接深入：

➊ (define queue%

  ➋ (class object%

    ➌ (init [queue-list '()])

    ➍ (define head '{})
       (define tail '{}) 

    ➎ (super-new) 

    ➏ (define/public (enqueue val)
         (let ([t (mcons val '())])
           (if (null? head)
               (begin
                 (set! head t)
                 (set! tail t))
               (begin
                 (set-mcdr! tail t)
                 (set! tail t)))))

    ➐ (define/public (dequeue)
         (if (null? head) (error "Queue is empty.")
             (let ([val (mcar head)])
            ➑ (set! head (mcdr head))
               (when (null? head) (set! tail '()))
               val)))

      (define/public (print-queue)
        (define (prt rest)
          (if (null? rest)
              (newline)
              (let ([h (mcar rest)]
                    [t (mcdr rest)])
                (printf "~a " h)
                (prt t))))
         (prt head))

    ➒ (for ([v queue-list]) (enqueue v))))

我们的类名是 queue%（注意，按照约定，Racket 类名以 % 结尾）。我们从类定义 ➊ 开始。所有类都必须继承自某个父类。在这个例子中，我们使用内置类 object% ➋。一旦我们指定了类名和父类，我们就指定了类的初始化参数 ➌。这个类接受一个单一的可选列表参数。如果提供了该列表，则使用它来初始化队列 ➒。我们的类使用 head 和 tail 指针标识符，我们必须定义它们 ➍。在类的主体内部，define 语句对类外部不可访问。这意味着 head 或 tail 的值不能绑定到类外部的标识符上。

在必须调用父类（在此情况下是 object%） ➎ 之后，我们进入了这个类的核心部分：它的方法。首先我们定义了一个 public 类方法，叫做 enqueue ➏。公共方法可以从类外部访问。此方法接受一个单一值，并将其以类似我们苹果和香蕉示例的方式添加到队列的末尾。如果队列为空，则初始化 head 和 tail 标识符为可变的 cons 单元 t。

dequeue 方法 ➐ 返回队列头部的值，但如果队列为空则会生成错误。head 指针会更新为指向队列中的下一个值 ➑。

为了查看队列中的所有值，我们还定义了方法 print-queue。

让我们看看它的实际操作。

> (define queue (new queue% [queue-list '(tom dick harry)]))

> (send queue dequeue)
'tom

> (send queue enqueue 'sue)
> (send queue print-queue)
dick harry sue 

> (send queue dequeue)
'dick

> (send queue dequeue)
'harry

> (send queue dequeue)
'sue

> (send queue dequeue)
. . Queue is empty.

类对象是通过 new 形式创建的。此形式包括类名和类定义中的 init 形式所定义的任何参数（参见类定义代码 ➌）。

与普通的 Racket 函数和方法不同，对象方法必须通过 send 形式调用。send 标识符后跟对象名称（queue）、方法名称以及方法的任何参数。

本例旨在展示 Racket 面向对象功能的基础，但在接下来的内容中，我们将看到 Racket 在面向对象方面的更多强大功能。

汉诺塔

汉诺塔是一个包含三根钉子的难题，钉子插在一块板上，板上还有八个圆形的圆盘，每个圆盘中央有一个孔。没有两个圆盘的大小相同，它们排列在其中一根钉子上，最大的圆盘在底部，其他圆盘按照从大到小的顺序排列，确保较小的圆盘总是位于较大的圆盘之上（见图 3-3）。

图 3-3：汉诺塔

W. W. Rouse Ball 讲述了一个有趣的故事，说明了这个难题是如何产生的（见[3]和[8]）。

在贝拿勒斯的大庙中，在标志着世界中心的圆顶下，安放着一块铜板，上面固定着三根钻石针，每根针高一肘，粗如蜜蜂的身体。在其中一根针上，神在创造之初放置了 64 个纯金圆盘，最大的圆盘放在铜板上，其他圆盘逐渐变小，直到顶部的圆盘。这就是梵天之塔。日夜不停，值班的祭司根据梵天的不变法则，将圆盘从一根钻石针移动到另一根上，按照要求，祭司每次只能移动一个圆盘，并且必须把这些圆盘放置在针上，确保没有较小的圆盘在较大的圆盘下面。当这 64 个圆盘都从神在创造时所放置的那根针上转移到其他任一根针上时，塔、庙和祭司们都会化为尘土，世界将伴随着一声雷鸣消失。

这将需要 2⁶⁴ - 1 步。让我们看看在世界末日来临之前我们还有多少时间。我们假设每秒可以完成一次移动。

> (define moves (- (expt 2 64) 1))
> moves
18446744073709551615

> (define seconds-in-a-year (* 60 60 24 365.25))
> seconds-in-a-year
31557600.0

> (/ moves seconds-in-a-year)
584542046090.6263

这个最后的数字大约是 5.84 × 10¹¹ 年。当前宇宙的年龄估计略低于 14 × 10⁹ 年。如果祭司们从宇宙起始时就开始移动圆盘，那么还剩大约 570 亿年，因此你应该至少有足够的时间读完这本书。

尽管这个过程很有趣，我们的主要目标是使用 Racket 来展示如何实际执行这些移动。当然，我们会先从较少的圆盘开始，所以让我们从一个圆盘开始。我们将钉子编号为 0、1 和 2。假设我们的目标是将圆盘从钉子 0 移动到钉子 2。只有一个圆盘时，我们只需将圆盘从钉子 0 移动到钉子 2。如果我们有 n > 1 个圆盘，我们将我们要移动所有圆盘的钉子指定为 f，将我们要移动到的钉子指定为 t，剩下的钉子我们指定为 u。解决这个难题的步骤可以这样表述：

将 n - 1 个圆盘从 f 移动到 u。
将一个圆盘从 f 移动到 t。
将 n - 1 个圆盘从 u 移动到 t。

虽然这个过程简单，但足以解决这个难题。步骤 1 和 3 暗示了递归的使用。以下是实现这些步骤的 Racket 代码。

➊ (define (hanoi n f t)
  ➋ (if (= 1 n) (list (list f t))        ; only a single disk to move
      ➌ (let* ([u (- 3 (+ f t))]         ; determine unused peg
             ➍ [m1 (hanoi (sub1 n) f u)] ; move n-1 disks from f to u
             ➎ [m2 (list f t)]           ; move single disk from f to t
             ➏ [m3 (hanoi (sub1 n) u t)]); move disks from u to t
        ➐ (append m1 (cons m2 m3)))))

我们传递给hanoi函数磁盘的数量、起始的柱子和目标柱子。然后，我们计算实现步骤一 ➌、二 ➍ 和三 ➎ 所需的移动。你能理解为什么let表达式 ➌ 决定了未使用的柱子吗？（提示：考虑所有可能的组合。例如，如果 f = 1 且 t = 2，let表达式 ➌ 将得到 u = 3 - (1 + 2) = 0，即未使用的柱子编号。）hanoi函数返回一个移动列表 ➏。列表中的每个元素是由两个元素组成的列表，指定了从哪个柱子移动到哪个柱子。以下是三个磁盘的输出示例：

> (hanoi 3 0 2)
'((0 2) (0 1) (2 1) (0 2) (1 0) (1 2) (0 2))

注意，我们有 2³ - 1 = 7 次移动。

如代码中的注释所示，hanoi函数本质上是前面给出的三步解决过程的直接翻译。此外，它提供了递归的实际应用，其中函数通过传递问题的简化版本来调用自身。

斐波那契与朋友们

斐波那契序列的定义如下：

0, 1, 1, 2, 3, 5, 8, 13, 21, 34, . . .

在这个序列中，下一个项总是前两个项的和。在某些情况下，初始的零不被认为是序列的一部分。这个序列有许多有趣的属性。我们这里只会简要介绍其中的一些。

一些有趣的属性

斐波那契序列的一个有趣属性是，总是可以创建一个由斐波那契序列中生成的边长的正方形拼接而成的矩形，如图 3-4 所示。我们将在第四章中看到如何生成这种平铺。

图 3-4：斐波那契平铺

约翰内斯·开普勒指出，连续斐波那契数的比值接近一个特定的数字，称为 ϕ，也被称为黄金比例：

如果你不熟悉 lim n →∞ 这种写法，它只是意味着当 n 越来越大时，结果就是这个。

数字 ϕ 也有许多有趣的属性。一个例子是黄金螺旋。黄金螺旋是一个对数螺旋，其增长因子为 ϕ，这意味着每转一个四分之一圈，螺旋就会以 ϕ 的倍数变宽（或远离原点）。初始半径为 1 的黄金螺旋具有以下极坐标方程：

黄金螺旋的图示见图 3-5。我们将在第四章中展示如何生成这个图。

图 3-5：黄金螺旋

图 3-6 展示了通过绘制连接斐波那契平铺中正方形对角线的圆弧来近似黄金螺旋（在第四章中，我们将看到如何将这个螺旋叠加到斐波那契平铺上）。

图 3-6：黄金螺旋近似

虽然这两个黄金螺旋的版本看起来非常相似，但从数学上讲，它们是非常不同的。这与一个叫做曲率的概念有关。这个概念有一个精确的数学定义，但现在你只需将其理解为路径的弯曲程度。曲线越紧，曲率越大。方程（3.1）描述的路径具有连续的曲率，而斐波那契螺旋则具有不连续的曲率。图 3-7 展示了这两条路径在曲率上的明显差异。

我们将在接下来的章节中以及第四章中使用这些性质。

图 3-7：曲率：黄金与斐波那契

计算数列

数学上，斐波那契数列F[n]由以下递推关系定义：

F[n] = F[n-1] + F[n-2]

在本节中，我们将探讨三种不同的计算该数列的方法。

1. 傻瓜式方法。 根据斐波那契数列的递推关系定义，我们的第一个版本几乎是现成的。它实际上是从定义到 Racket 函数的精确翻译。

(define (F n)
  (if (<= n 1) n
    (+ (F (- n 1)) (F (- n 2)))))

这段代码的优点是非常清晰简洁。唯一的问题是，它效率极低。两个嵌套调用导致相同的值被反复计算。最终结果是计算量随着n的增加而呈指数增长。

2. 效率至上。 在这里，我们探讨了计算机科学经典著作《计算机程序的构造与解释》中提出的一种巧妙方法[2]。这个方法的思路是使用一对整数初始化，使得a = F[1] = 1 和 b = F[0] = 0，并反复应用以下变换：

a ← a + b

b ← a

可以证明，在应用这些变换n次之后，我们将得到a = F[n+1] 和 b = F[n]。这个证明并不难，我已将其留作习题给你。下面是实现这一解决方案的代码：

(define (F n)
  (define (f a b c)
    (if (= c 0) b
        (f (+ a b) a (- c 1))))
  (f 1 0 n))

由于尾递归优化，f递归调用自身时无需保持继续点。它作为一个迭代过程工作，并且随着n的增大，增长是线性的。

3. 内存的作用。 在这个版本中，我们使用了在《一些闭包的时机》第 58 页中介绍的记忆化技术。为此，下面的代码使用了哈希表。回忆一下，哈希表是一个可变的键值对集合，它是通过函数make-hash构建的。可以通过hash-set!将项目存储到哈希表中，使用hash-ref从表中检索项。我们通过hash-has-key?测试表中是否已包含某个键。

(define F
  (let ([f (make-hash)]) ; hash table to contain memoized F values
    (define (fib n)
      (cond [(<= n 1) n]
            [(hash-has-key? f n) (hash-ref f n)]
            [else
              (let ([fn (+ (fib (- n 1)) (fib (- n 2)))])
                (hash-set! f n fn)
                fn)]))
    fib))

这段代码应该相当容易理解。它是前面提到的fact示例中记忆化（memoization）方法的直接应用。

获胜者是谁？ 这取决于情况。你绝对不应该使用第一个方法。比较第二个和第三个方法时，考虑以下内容：第二个方法总是在每次调用F时需要进行n次计算。第三个方法在第一次调用F时也需要进行n次计算。若第二次（或之后）调用F时，针对n（或任何小于n的数值），它几乎瞬间返回结果，因为它只需查找哈希表中的值。第三种方法会有轻微的空间开销，但在大多数情况下，这个开销是微不足道的。

比内公式。 在我们离开斐波那契数列及其计算方式的迷人世界之前，让我们来看看比内公式：

在这个公式中，以下是正确的：

这个公式为我们提供了另一种计算F[n]的方法。以下对所有n都适用：

所以数字F[n]是最接近的整数。因此，如果我们四舍五入到最接近的整数，F[n]可以通过以下方式计算：

方括号用于指定四舍五入函数。在 Racket 中，这变成：

(define (F n)
  (let* ([phi (/ (add1 (sqrt 5)) 2)]
         [phi^n (expt phi n)])
    (round (/ phi^n (sqrt 5)))))

虽然比内公式非常快速（因为它不需要循环或递归），但缺点是它只给出一个近似值，而其他版本则提供精确值。

连分数。 下面的表达式是一个连分数的例子。在这种情况下，分数部分是无限重复的。正如我们将看到的，连分数与斐波那契数列有着惊人的联系。

由于这个分数是无限重复的，我们可以进行如下替换。

这个替换简化为二次方程：

f² - f - 1 = 0

这个方程有几个解。下面是正确的：

或者，这些是正确的：

问题依然存在：哪个值才是f的正确值？由于ψ是负的，答案必须是ϕ。因此……

我敢打赌你没想到这个。

保险销售员问题

这个问题改编自 Flannery 的《编码》 [7]。这是一个可以手工解决的问题，但我们可以利用 Racket 来完成一些繁琐的计算。问题描述如下。

一名上门的保险推销员停在一位女士家门口，接下来发生了以下对话：

销售员：你有几个孩子？

女人：三。

销售员：那么他们的年龄是多少？

女人：猜猜看。

销售员：那给个提示怎么样？

女人：好的，他们年龄的乘积是 36，且所有年龄都是整数。

销售员：这也太少了，能再给我一个提示吗？

女人：他们年龄的总和等于隔壁房子的门牌号。

推销员立即跑开，跳过栅栏，看了看隔壁房子的号码，挠了挠头，然后回到女人身边。

推销员：你能再给我一个提示吗？

女人：最年长的那个弹钢琴。

推销员想了一会儿，做了一些计算，弄清楚了孩子们的年龄。他们分别是多大？

一开始，提示看起来有些不一致。让我们逐个分析。首先，我们知道三个年龄的乘积是 36。以下是一个程序，它生成所有乘积为 36 的唯一三正整数组合。

   #lang racket
   (require math/number-theory)

➊ (define triples '())
   (define (gen-triples d1)
  ➋ (let* ([q (/ 36 d1)]
            [divs (divisors q)])
     ➌ (define (try-div divs)
          (when (not (null? divs))
        ➍ (let* ([d2 (car divs)] [d3 (/ q d2)])
          ➎ (when (<= d3 d2 d1)
            ➏ (set! triples (cons (list d3 d2 d1) triples)))
            (try-div (cdr divs)))))
      (try-div divs)))

➐ (for ([d (divisors 36)]) (gen-triples d))

   triples

尽管这段代码在效率上不会赢得任何奖项，但它相对简单，且能够完成任务。我们首先定义了变量triples，它将包含生成的三元组列表➊。处理实际上在我们为 36 的每个除数调用gen-triples ➐时开始（除数由math/number-theory库中的divisors函数提供）。这个函数接着定义了除数d1与 36 的商q ➋。之后，我们生成q的除数列表（divs，这些除数当然也能整除 36）。接下来是try-div ➌函数，它完成了大部分工作。然后我们得到q的第一个除数（d2） ➍，并通过将q除以d2来生成第三个除数（d3）。这些除数（d1、d2和d3）被测试以确定是否形成一个合适的三元组（为了确保唯一性，我们确保它们形成一个有序的序列 ➎）。如果满足条件，它将被添加到三元组列表中➏。测试其他除数将继续进行。运行此程序将生成以下三元组集合：{1, 1, 36}、{1, 2, 18}、{1, 3, 12}、{1, 4, 9}、{2, 2, 9}、{1, 6, 6}、{2, 3, 6}、{3, 3, 4}。

仅凭这一点，当然无法让推销员确定孩子们的年龄。第二个提示是，年龄之和等于隔壁房子的号码。我们再次使用 Racket 生成所需的和。

(for ([triple triples]) (printf "~a: ~a\n" triple (apply + triple)))

从这里，我们得出以下结论。

在看过隔壁房子的号码之后，推销员仍然不知道孩子们的年龄。这意味着年龄一定是那两个和为 13 的数字集合之一（否则他会知道该选择哪个集合）。由于女人说“最年长的那个弹钢琴”，唯一的可能性是年龄集合{2, 2, 9}，因为集合{1, 6, 6}会意味着有两个最年长的。

总结

本章中，我们介绍了 Racket 的基本编程构造，并将其应用于各种问题领域。到目前为止，我们的探索仅限于以文本形式获取输出。接下来，我们将展示如何通过生成图形输出为我们的应用程序添加一些亮点。

第四章：绘图、绘制与一些集合论

在本章中，我们将探讨如何利用 DrRacket 显示图形信息的功能。具体来说，我们将查看生成二维函数图表的各种方法，以及使用一些内建的图形原语（圆形、矩形等）来创建更复杂的绘图。在介绍基本知识后，我们还将探讨一些扩展应用，包括集合论、黄金螺旋和尼姆游戏。

绘图

所有绘图函数都需要plot库，因此在尝试本节中的任何示例之前，请确保先执行以下操作。

> (require plot)

既然这些都解决了，我们就从一些简单而熟悉的内容开始吧。

X-Y 图表

所有二维图表都使用plot函数。此函数接受单个函数或函数列表，并为每个函数生成一个图表。生成图表后，如果需要，可以通过右键点击图表并选择弹出菜单中的“保存图像…”将其保存为位图。

plot函数接受多个关键字参数（所有参数都是可选的），但至少建议指定图表的范围，因为 DrRacket 并不总是能确定适当的图表边界。以下是生成简单正弦函数图表的示例：

(plot (function sin #:color "Blue")
      #:x-min (* -2 pi) #:x-max (* 2 pi)
      #:title "The Sine Function")

结果如图 4-1 所示。请注意，图像显示为灰度，但当你在电脑上输入代码时，图形将显示为彩色。

图 4-1：使用正弦函数的示例图表

请注意，sin函数被包含在function形式中。function是一个被称为渲染器的东西；它控制传递给它的函数参数的渲染方式。function形式允许你添加可选的关键字参数来控制单个函数的显示方式。在这种情况下，我们指定正弦函数以蓝色渲染。

以下代码通过将正弦函数和余弦函数合并到一个列表中来创建一个显示这两个函数的图表。

(plot (list
       (axes) ; can also use (axis x y) to specify location
       (function sin #:color "Blue" #:label "sin" #:style 'dot)
       (function cos 0 (* 2 pi) #:color "red"  #:label "cos"))
      #:x-min (* -2 pi) #:x-max (* 2 pi)
      #:y-min -2 #:y-max 2
      #:title "Sine and Cosine" 
      #:x-label "X" 
      #:y-label #f) ; suppress y-axis label

生成的图表如图 4-2 所示。请注意，我们为余弦函数指定了更窄的图表范围，并为两个函数添加了文本标签，以便它们可以在图表上轻松区分。我们还使用特定的值覆盖了默认标签。

图 4-2：正弦和余弦函数

以下代码演示了一些额外的绘图功能（请参见图 4-3 查看输出）。

(plot (list (axes)
            (function sin #:color "Blue" #:label "sin" #:style 'dot)
            (inverse sqr -2 2 #:color "red" #:label "x²" #:width 2))
      #:x-min (* -2 pi) #:x-max (* 2 pi)
      #:y-min -2 #:y-max 2
      #:title "Sine and Square" 
      #:x-label "X" 
      #:y-label #f
      #:legend-anchor 'bottom-left)

请注意，我们在绘图函数的列表中使用了一种新的inverse形式。该形式通过将 y 轴作为自变量的轴来工作。这样，我们可以有效地绘制反函数，而无需代数推导出来。我们还指定了一些附加样式来帮助区分不同的曲线。正弦曲线使用虚线显示，而反平方函数则用更粗的线条表示。通过为plot函数指定#:legend-anchor 'bottom-left，我们将图例移到了左下角。

如果你运行代码，应该会得到类似图 4-3 的结果。

图 4-3：正弦与反平方

接下来我们看看参数化绘图。

参数化绘图

如果一个平面中的曲线是参数化的，那么曲线的坐标（x，y）是由一个变量（或参数）的函数表示的，假设该参数为t。我们来看一个例子。

圆的参数化

标准的圆定义是以原点为圆心的所有点的集合，且这些点与原点的距离相等。我们可以通过隐式方程的代数形式或通过一对三角函数表达式来表示这一定义，如图 4-4 所示。

图 4-4：圆的定义

在图 4-4（a）中，圆是通过这个代数表达式来定义的：

r² = x² + y²

为了将其绘制为 x-y 图，我们必须明确地将y表示为x的函数，其中表达式的正值给出圆的上半部分，负值则给出下半部分：

图 4-4（b）说明了如何通过参数θ来定义圆。在这种情况下，曲线的 x 和 y 坐标分别由三角函数 cos θ和 sin θ给出。

在 Racket 中，参数曲线是通过一个函数来定义的，该函数以参数为其输入并返回一个包含计算出的x和y值的vector。下面的代码绘制了代数和参数版本的圆。我们已经将参数版本偏移，使其出现在代数版本的右侧（关于infix包及@的使用，请参见第二章）。

   #lang at-exp racket
   (require infix plot)

   (define r 30)
   (define off (+ 5 (* 2 r)))

   ; algebraic half-circles
➊ (define (c1 x) @${ sqrt[r² - x²]})
➋ (define (c2 x) @${-sqrt[r² - x²]})

   ; parametric circle
➌ (define (cp t) @${vector[off + r*cos[t], r*sin[t]]})

   (plot (list
          (axes)
          (function c1 (- r) r #:color "blue" #:label "c1")
          (function c2 (- r) r #:style 'dot #:label "c2")
     ➍ (parametric cp 0 (* 2 pi) #:color "red" #:label "cp" #:width 2))
         #:x-min (- r)
         #:x-max (+ off r)
         #:y-min (- r)
         #:y-max (+ off r)
         #:legend-anchor 'top-right)

我们使用了infix包和at-exp语言扩展，以便以更自然的形式呈现代数表达式。我们从定义半圆函数c1 ➊和c2 ➋开始。参数化版本表示为cp ➌。请注意，cp被置于一个从parametric ➍开始的形式中，并且指定了 0 到 2π的绘图范围。此代码的输出显示在图 4-5 中。

图 4-5：显式与参数化绘图

圆的运动

坦白说，静态圆形真的很无聊。在这一节中，我们将探讨圆形的运动。具体来说，我们将研究一个固定点在圆上滚动时沿直线无滑移运动所形成的路径。描述这一路径的曲线叫做摆线。我们在图 4-6 中设定了场景，其中一个半径为r的圆已经从原点滚动了距离x。感兴趣的点是标记为P的点。

图 4-6：摆线场景

让我们来看看生成参数图所需的数学知识，目标是绘制一个点P的轨迹，这个点位于一个半径为r的圆上，圆在直线上无滑移地滚动。

由于小圆在大圆内无滑移地滚动，从x到P的弧长等于d。我们可以将其表示为d = θr。因此，当小圆转动角度θ时，P的 x 坐标为d - rsinθ。但由于d = rθ，所以x = rθ - rsinθ = r(θ - sinθ)。显然，y的值仅由y* = r(1 - cosθ)给出。以下是绘图代码：

#lang at-exp racket
(require infix plot)

(define r 30)

(define (cycloid t) @${vector[r*(t - sin[t]),  r*(1-cos[t])]})

(plot (list
       (axes)
       (parametric cycloid 0 (* 2 pi)
                   #:color "red"
                   #:samples 1000))
      #:x-min 0
      #:x-max (* r 2 pi)
      #:y-min 0
      #:y-max (* r 2 pi))

在这种情况下，我们使用了#:samples关键字来增加生成图像时使用的采样点数量，从而使得图形看起来更平滑。以下是生成的图像。

图像中的曲线已经被叠加到图 4-7 中的原始场景设置上。

图 4-7：摆线

稍后我们将展示如何对其进行动画处理，这样我们就能看到它的运动效果。

内摆线

我们不仅可以让圆形沿直线滚动，还可以让它在另一个圆上滚动。事实上，如果一个圆的半径大于另一个，我们可以让小圆在大圆内滚动。以这种方式生成的曲线叫做内摆线。在这里，我们为内摆线创建了一个基于半径为r的小圆和半径为R的大圆的参数图，其中小圆在大圆内部无滑移地滚动。我们假设大圆的圆心在原点(图 4-8)。

图 4-8：内摆线设置

由于小圆在大圆内无滑移地滚动，弧长s由公式s = rθ = Rϕ给出，因此。小圆的圆心（图中的q）与原点的距离为R - r。为了帮助分析，我们放大了小圆并在图 4-9 中提供了一些额外的参考线。

图 4-9：放大后的设置

请注意以下几点：

从中可以清楚地看到，P的 x 坐标由以下公式给出：

同样，P的 y 坐标由以下公式给出：

我们将所有这些结合起来，写成了以下 Racket 代码：

#lang at-exp racket
(require infix plot)

(define r 20)
(define R (* r 3))

(define (hypocycloid phi)
  @${vector[
    (R-r)*cos[phi] + r*cos[(R-r)/r * phi],
    (R-r)*sin[phi] - r*sin[(R-r)/r * phi]]})

(plot (list
       (parametric (λ (t) @${vector[R*cos[t], R*sin[t]]})
                   0 (* r 2 pi)
                   #:color "black"
                   #:width 2)
       (parametric hypocycloid
                   0 (* r 2 pi)
                   #:color "red"
                   #:width 2))
      #:x-min (- -10 R ) #:x-max (+ 10 R )
      #:y-min (- -10 R ) #:y-max (+ 10 R )
      #:x-label #f #:y-label #f
      )

你可以在图 4-10 中看到我们工作的成果。

图 4-10：内滚线图

为了激发你进一步探索这些迷人曲线的兴趣，给你另一个问题：对于什么半径比率，内滚线是直线？

直击要点

到目前为止，我们集中在生成连续曲线，但如果你想绘制单个点怎么办？是的，Grasshopper，这也是可以的。从绘图角度来看，一个点只是一个包含两个数字的向量。例如，#(1 2)是一个点。要绘制一组点，你只需向plot例程提供一个由向量点组成的列表。以下是一个示例：

#lang racket
(require plot)

(parameterize ([plot-width    250]
               [plot-height   250]
               [plot-x-label  #f]
               [plot-y-label  #f])

  (define lim 30)
  (plot (list
         (points '(#(0 0))
                 #:size 300
                 #:sym 'fullcircle1
                 #:color "black"
                 #:fill-color "yellow")
         (points '(#(-5 5) #(5 5))
                 #:size 10
                 #:fill-color "black")
         (points '(#(0 -5))
                 #:size 30
                 #:sym 'fullcircle1
                 #:color "black"
                 #:fill-color "black"))
        #:x-min (- lim) #:x-max (+ lim)
        #:y-min (- lim) #:y-max (+ lim)))

这里是图 4-11 中的输出结果。

图 4-11：用点绘制的面部

在这种情况下，我们使用的是parameterize形式，它允许我们指定图表的物理大小（以像素为单位，plot-width和plot-height），并抑制图表标签。请注意，#:size关键字参数也以像素表示。第一个点列表是我们用于绘制面部的单个点。#:sym关键字参数指定用于打印该点的符号类型。我们使用的是一个填充圆圈，用符号fullcircle表示面部。预定义符号种类繁多（可以在文档中搜索“known-point-symbols”），但你也可以使用 Unicode 字符或字符串。

现在我们可以绘制点了，我们可以使用line形式将它们连接成线条。像点一样，线条由两个元素的向量列表组成。plot例程将该列表视为一系列线段的端点，并适当地绘制它们。以下是一个示例。

#lang racket
(require plot)

(define pts (for/list ([i (in-range 0 6)]) (vector i (sqr i))))

(plot (list
       (lines pts
               #:width 2
               #:color "green")
       (points pts
               #:sym 'fulldiamond
               #:color "red"
               #:fill-color "red"))
      #:x-min -0.5 #:x-max 5.5
      #:y-min -0.5 #:y-max 26)

生成的图表显示在图 4-12 中：

图 4-12：绘制线条和点

极坐标图

极坐标图是通过...（你猜对了！）polar形式创建的。polar形式接受一个函数，该函数在给定旋转角度时返回原点的距离。最简单的极坐标图函数是单位圆，其作为 lambda 表达式的形式为(λ (θ) 1)。一个稍微更复杂的示例是逆时针螺旋线，定义为(λ (θ) θ)。以下是两个图表的代码：

(parameterize
    ([plot-width 150]
     [plot-height 150]
     [plot-tick-size 0]
     [plot-font-size 0]
     [plot-x-label  #f]
     [plot-y-label  #f])

  (list (plot (polar (λ (θ) 1) 0 (* 2 pi))
              #:x-min -1 #:x-max 1
              #:y-min -1 #:y-max 1)
        (plot (polar (λ (θ) θ) 0 (* 2.5 pi))
              #:x-min -8 #:x-max 8
              #:y-min -8 #:y-max 8)
        ))

我们利用一些图表参数抑制了坐标轴刻度和标签。此代码在图 4-13 中生成以下输出。

图 4-13：基本极坐标图

注意，图表是以列表的形式呈现的。在 Racket 中，图表只是另一种数据值。

让我们生成图 4-14 中所示的图表。

图 4-14：极玫瑰

我们需要一个从 0 到 1 再回到 0 的函数。这听起来像是正弦函数。我们需要它在从 0 到π/2（并重复直到 2π）的过程中产生这些值，因此我们需要的函数是r[θ] = sin(2θ)。绘制此图的代码如下：

#lang at-exp racket
(require infix plot)

(parameterize
    ([plot-width 200]
     [plot-height 200]
     [plot-tick-size 0]
     [plot-font-size 0]
     [plot-x-label  #f]
     [plot-y-label  #f])

  (plot (list
         (polar-axes #:number 8)
         (polar (λ (t) @${sin[2*t]})  0 (* 2 pi)
         #:x-min -1 #:x-max 1
         #:y-min -1 #:y-max 1))))

通过对函数r[θ] = sin(kθ)添加一个小的参数k，就能产生各种有趣的曲线（见图 4-15）。

(parameterize
     ([plot-width 200]
     [plot-height 200]
     [plot-tick-size 0]
     [plot-font-size 0]
     [plot-x-label  #f]
     [plot-y-label  #f])

  (define (rose k)
    (plot (polar (λ (t) @${sin[k*t]})  0 (* 4 pi)
                 #:x-min -1 #:x-max 1
                 #:y-min -1 #:y-max 1)))
  (for/list ([k '(1 1.5 2 2.5 3 4 5)]) (rose k)))

图 4-15：极坐标玫瑰

作为另一个极坐标绘图的示例，以下是我们用来绘制黄金螺旋的代码，黄金螺旋最早在第三章的第 68 页介绍，并在此处的图 4-16 中重新绘制。

(define ϕ (/ (add1 (sqrt 5)) 2))
(define π pi)
(plot (polar (λ (θ) (expt ϕ (* θ (/ 2 π))))
             0 (* 4 pi)
             #:x-min -20 #:x-max 50
             #:y-min -40 #:y-max 30
             #:color "red")
      #:title "Golden Spiral"
      #:x-label #f ; suppress axis labels
      #:y-label #f)

现在，我们有了用于生成黄金螺旋的实际代码，这是我们在第三章首次遇到的。

图 4-16：黄金螺旋

尽管我们尽力提供了 DrRacket 绘图功能的概述，但其实还有更多：等高线图、区间图、误差条、向量场，等等。我鼓励你查阅文档，了解更多可能对你有兴趣的主题。不过，接下来我们将继续讨论使用图形原语创建图形。

绘图

在 Racket 中绘图需要一种称为绘图上下文（DC）的东西。你可以把它当作绘图发生的画布。绘图上下文可以为各种对象设置，例如位图、PostScript 文件或 Racket GUI 应用程序。

与用于绘制函数的坐标不同，绘图上下文使用的坐标系中的 y 轴是反转的，如图 4-17 所示。请注意，原点位于画布的左上角。

图 4-17：绘制坐标

所有使用 Racket 绘图库创建的图形都需要导入draw库，如下所示：

> (require racket/draw)

在本节中，我们将重点介绍使用位图绘图上下文创建简单的图形。要创建这样的上下文，我们需要一个位图（通过make-bitmap，如下所示）：

> (define drawing (make-bitmap 50 50)) ; a 50x50 bitmap

我们还需要一个位图绘图上下文：

> (define dc (new bitmap-dc% [bitmap drawing]))

接下来，我们需要一些绘图工具。在现实生活中，我们用钢笔画线条，用画笔填充画布上的区域；在 Racket 中也是如此。我们可以通过几种方式告诉 Racket 我们想使用什么样的笔：

> (send dc set-pen "black" 2 'solid)
> (send dc set-pen (new pen% [color "black"] [width 2] [style 'solid]))

第一个方法是通过设置宽度为 2 的实心黑色笔进行快速且简便的绘制。第二个方法是创建一个笔对象并将其发送到绘图上下文。颜色可以通过字符串名称指定，如上所示，也可以通过颜色对象指定，其中红色、绿色、蓝色以及可选的 alpha（透明度）值可以被指定。每个这些值必须在 0 到 255 之间（包括 0 和 255）。例如，以下输入将创建一个青色颜色对象，并设置绘图上下文使用它。

> (define cyan (make-object color% 0 255 255))
> (send dc set-pen cyan 2 'solid)

一种等效的，但略微高效的方法是执行以下操作：

> (define cyan (make-color 0 255 255))
> (send dc set-pen cyan 2 'solid)

画刷控制二维图形（如矩形和圆形）内部的填充类型。像钢笔一样，画刷可以通过几种不同的方式定义：

> (send dc set-brush "blue" 'cross-hatch)
> (send dc set-brush (new brush% [color "red"] [style 'solid]))

第一个例子将创建一个画刷，产生蓝色的交叉填充效果。第二个例子使用一个画刷对象，它有一个实心的红色填充。第二个例子中达到相同效果的另一种方法如下：

(send dc set-brush (make-brush #:color "red" #:style 'solid))

完成这些前期准备后，我们可以实际开始绘图，通过使用 send 向绘图上下文发送绘图命令来实现。要绘制一条单独的线段，我们输入以下代码：

> (send dc draw-line 10 10 30 25)

这将绘制一条从 (10, 10) 到 (30, 25) 的线段。我们已经将这条线添加到绘图上下文中，但它并不会立即显示。为了实际看到这条线，我们需要做以下操作：

> (print drawing)

这将产生以下效果：

记得之前定义的 drawing 变量，它是我们正在绘制的实际位图。

矩形也同样容易绘制：

> (send dc draw-rectangle 0 0 50 25)

前两个参数 (0, 0) 是矩形左上角的 x 和 y 坐标。接下来的两个参数是矩形的宽度和高度。

圆形和椭圆的处理方式类似。

> (send dc draw-ellipse 10 10 30 25)

在这种情况下，参数指定了一个包围盒，它包含了椭圆，再次强调，第一个两个参数是包围矩形左上角的 x 和 y 坐标，接下来的两个参数是矩形的宽度和高度（参见图 4-18 中的灰色区域——我们稍后将讨论楔形）。

图 4-18：椭圆包围盒

要显示绘图，我们只需打印包含我们正在绘制的位图的变量（通过绘图上下文 dc）：

> (print drawing)

它会产生这样的效果：

文本可以通过 draw-text 方法添加到绘图中。

> (send dc draw-text "Hello, World!" 10 10)

在这种情况下，最后两个参数指定了文本左上角的 x 和 y 坐标。

为了将这些思想结合起来，这里有一些简单的代码来绘制一个粗略的汽车。

#lang racket

(require racket/draw)

(define drawing (make-bitmap 200 100)) ; a 200x100 bitmap
(define dc (new bitmap-dc% [bitmap drawing]))

; background
(send dc set-brush (new brush% [color "yellow"]))
(send dc draw-rectangle 0 0 200 100)

; antenna
(send dc draw-line 160 5 160 50)
(send dc set-brush (new brush% [color "gray"]))
(send dc draw-rectangle 155 45 10 5)

; body
(send dc set-pen "black" 2 'solid)
(send dc set-brush (new brush% [color "gray"]))
(send dc draw-rectangle 60 20 80 30)

(send dc set-brush (new brush% [color "red"]))
(define c (make-object color% 0 255 255))
(send dc set-pen c 2 'solid)
(send dc draw-rectangle 20 50 160 30)

; wheels
(send dc set-pen "black" 2 'solid)
(send dc set-brush (new brush% [color "blue"]))
(send dc draw-ellipse  40 60 40 40)
(send dc draw-ellipse 120 60 40 40)

(send dc draw-text "This is a car?" 5 1)

(print drawing)

运行此代码将产生图 4-19 中显示的惊艳艺术作品。根据你的计算机，输出可能会有所不同（主要是由于字体的处理方式不同）。

图 4-19：一件惊艳的艺术作品

绘图库包含了比我们在这里展示的更多功能，但我们已经学到了足够的知识来开始使用。在接下来的章节中，我们将实际应用我们的新技能（并学习一些新技能）。

集合论

你可能会觉得将集合论的讨论放在图形章节中是一个奇怪的选择，你说得对。但是，当你能看到图形时，集合论会更容易理解，我们可以利用 DrRacket 出色的图形功能来说明集合论的一些基本概念。我们还将看到图形库的一些额外功能。

基础知识

集合就是一些任意的元素集合，例如 {5, 1/2, 7, 12} 或 {汽车, 公交车, 火车}。数学集合的一个显著特点是，数学集合不允许包含两个相同的元素。例如 {8, 2, 9, 2} 不是一个集合，因为数字 2 出现了两次（这种情况通常称为袋或 多重集合）。我们可以通过成员（或属于）符号 ∈ 来表示某个元素属于某个集合。例如 5 ∈ {8, 2, 5, 9, 3}。同样，我们也可以通过 非成员 符号 ∉ 来表示某个元素不属于某个集合，例如 7 ∉ {8, 2, 9, 3}。

在 Racket 中，集合可以通过一个名为 hash set 的对象来表示。一个哈希集合可以是可变的或不可变的，取决于它是如何构建的。可变哈希集合是通过 mutable-set 形式创建的，而不可变集合是通过 set 形式构建的。我们可以使用 set-member? 来测试一个元素是否是哈希集合的成员。元素可以通过 set-add! 形式添加到可变集合中，并且可以通过 set-add 形式从一个旧的（不可变的）集合中创建一个新的集合。

在接下来的示例中，mset 将指定一个可变集合，iset 将指定一个不可变集合。

   > (define mset {mutable-set 5 1/2 7 12 1/2})
   > mset
   (mutable-set 5 1/2 7 12)

   > (set-member? mset 7)
   #t

   > (set-member? mset 9)
   #f

➊ > (set-add mset 9)
   . . set-add:
     expected: (not/c set-mutable?)
     given mutable set: (mutable-set 5 1/2 7 12)
     argument position: 1st

   > (set-add! mset 9)
   > mset
   (mutable-set 5 1/2 7 9 12)

➋ > (set-add! mset 7)
   > mset
   (mutable-set 5 1/2 7 9 12)

   > (define iset (set 3 8 9 7 4))

   > iset
   (set 9 3 7 4 8)

   > (set-add iset 2)
   (set 9 3 7 2 4 8)

   > (set-add iset 3) ; note, no change in output
   (set 9 3 7 2 4 8)

➌ > (set-add! iset 2)
   . . set-add!:
     expected: set-mutable?
     given immutable set: (set 9 3 7 4 8)
     argument position: 1st

注意，我们无法在可变集合 ➊ 上使用 set-add，也无法在不可变集合 ➌ 上使用 set-add!。此外，尽管没有产生错误，但将数字 7 添加到 mset ➋ 上没有任何效果，因为 7 已经是成员。

在许多数学文献中，集合通过包含一个矩形和一个或多个圆的图示来表示。这些图示被称为 韦恩图。矩形用于表示所有感兴趣的项目（称为 讨论宇宙 —— 我们将使用符号 U 来表示它），而圆形用于表示特定的集合。为了帮助我们进行探索，我们将定义一些辅助方法来绘制这些图示中的各种对象。

#lang racket
#lang racket
(require racket/draw)

(define WIDTH 150)
(define HEIGHT 100)

(define venn (make-bitmap WIDTH HEIGHT))
(define dc (new bitmap-dc% [bitmap venn]))

(send dc scale 1.0 -1.0)
(send dc translate (/ WIDTH 2) (/ HEIGHT -2))
(send dc set-smoothing 'smoothed) 
(send dc set-pen "black" 2 'solid)

(define IN-BRUSH (new brush% [color "green"]))
(define OUT-BRUSH (new brush% [color (make-object color% 220 220 220)]))

(define dc (new bitmap-dc% [bitmap venn])) 这段代码应该对我们之前的讨论很熟悉。

将绘图原点放在左上角，并且 y 轴方向翻转，这有些不方便，因此我们使用一种叫做变换的新特性。我们使用 scale 变换来按 x 轴方向放大 1 倍，按 y 轴方向放大 -1 倍。这保持了所有东西的大小不变，但将 y 轴翻转，使得向上变为正方向。为了将原点放置在图示的中央，我们使用 translate 来居中它。（还有一种旋转变换，但我们当前的目的不需要使用它。）

set-smoothing 参数用于 send dc，可以启用或禁用绘图的抗锯齿平滑。默认值为 unsmoothed，会产生略显锯齿的绘图效果。

IN-BRUSH 将用作表示集合中元素的颜色，而 OUT-BRUSH 用于表示集合外元素的颜色。

接下来，我们将创建一些方法来实际进行绘图。

(define (rect x y w h b)
  (let ([x (- x (/ w 2))]
        [y (- y (/ h 2))])
    (send dc set-brush b)
    (send dc draw-rectangle x y w h)))

(define (circle x y r b)
  (let ([x (- x r)]
        [y (- y r)])
    (send dc set-brush b)
    (send dc draw-ellipse x y (* 2 r) (* 2 r))))

rect 方法将绘制一个矩形，其中心位于坐标 (x,y)，宽度和高度分别为 w 和 h。b 是我们想要用来绘制矩形的画笔。类似地，circle 将绘制一个圆，其中心位于坐标 (x, y)，半径为 r，画笔为 b。

由于我们只需要绘制一个矩形（表示讨论宇宙 U），我们创建一个特殊函数，使其能够适当地绘制；我们只需要为它提供颜色的画笔。

(define (universe b) (rect 0 0 (- WIDTH 10) (- HEIGHT 10) b))

让我们试试这些（参见图 4-20）。

> (universe OUT-BRUSH)
> (circle 0 0 30 IN-BRUSH)
> venn

图 4-20：表示单一集合的图示

假设我们的讨论宇宙是整数（即 U = ℤ）。我们可以用绿色圆圈表示偶数集。现在假设我们对任何不是偶数的元素感兴趣。这就是偶数集的补集。A 的集合补集可以表示为 A^(c)，Ā，或 A’。我们在维恩图中表示如下（并参见图 4-21）：

> (send dc erase)
> (universe IN-BRUSH)
> (circle 0 0 30 OUT-BRUSH) 
> venn

图 4-21：集合外的元素

请注意，在生成下一个图示之前，我们使用了 erase 来清除绘图上下文。

集合可以以多种方式组合。假设我们有两个集合：A 和 B。一种组合这些集合的方式是形成一个新的集合，这个集合是集合 A 和 B 中所有元素的唯一组合。这个操作叫做集合并，用符号 ∪ 表示。如果 C 是 A 和 B 的并集，那么数学表达式表示为 C = A ∪ B。使用集合构造符号，集合补集可以表示为 A^(c) = {x ∈ U ∣ x ∉ A}。用语言表达就是“U 中所有 x 的集合，使得 x 不在 A 中。”

另一种理解集合 A 和 B 并集的方法是将其看作由以下几个部分组成：

所有在 A 中而不在 B 中的元素（左侧部分圆形）。
所有在 B 中而不在 A 中的元素（右侧部分圆形）。
所有同时在 A 和 B 中的元素（图示的中央形状——这个形状称为鱼膀胱，拉丁语为“鱼的膀胱”）。

请参见图 4-22 以查看示例。

图 4-22：集合并

简短的数学绕行

为了能够绘制图 4-22 中的维恩图组件，我们首先需要做一些简单的计算。我们的计算将基于图 4-23 中说明的命名法。

图 4-23：如何绘制维恩图

让我们看看如何找到图 4-23 中显示的 x[i]、y[i]、θ 和 ϕ 的值。假设 x[c]、y[c] 和 r 已知。注意，圆形显然关于 y 轴对称，这在某种程度上简化了我们的任务。可以立即得出 x[i] = 0。一个以 x 轴为中心的圆的方程如下所示：

(x - x[c])² + y² = r²

交点出现在 x = 0。通过这个代入并解出 y，我们得到以下结果：

给定 y，角度很容易求出：

现在让我们来练习一种新的 DrRacket 图形功能，称为路径。路径功能允许绘制任意的图形。路径是通过选择起始位置并构建一系列段来定义整个路径。路径段可以由直线、弧线和一种称为贝塞尔曲线的图形组成（请参见手册）。我们通过以下方法构建一个填充路径来表示韦恩图的中心部分（vesica piscis）。

(define (piscis x y r b)
  (let* ([y (- y r)]
         [2r (* 2 r)]
         [yi (sqrt (- (sqr r) (sqr x)))] ; y-intersection
         [π pi]
      ➊ [ϕ (asin (/ yi r))]
      ➋ [θ (- π ϕ)]
      ➌ [path (new dc-path%)])
    (send dc set-brush b)
 ➍ (send path move-to 0 (- yi))
 ➎ (send path arc (- x r)     y 2r 2r  θ    (+ π  ϕ))
 ➏ (send path arc (- (- x) r) y 2r 2r (- ϕ) ϕ)
 ➐ (send dc draw-path path)))

在 let* 表达式中，我们可以找到方程 (4.1) ➊ 和 (4.2) ➋ 的直接翻译。标识符 path 然后被绑定到一个新的 dc-path% 对象 ➌。路径的工作方式有点像绘图上下文，路径命令会发送到路径对象来构建路径。代码随后将我们定位到初始位置，以绘制第一个弧线 ➍。然后绘制第一个弧线 ➎，并通过镜像第一个弧线来完成它 ➏。路径 arc 命令类似于绘图上下文中的 draw-ellipse 命令。唯一的区别是，arc 需要额外的参数来指定起始角度和结束角度。完成的路径会被发送到绘图上下文中渲染 ➐。

得出结论

在掌握了 piscis 后，我们已经具备了绘制任何二元集合运算所需的大部分工具。为了帮助我们的任务，让我们定义一个简单的函数来生成最终的图表。

(define SET-BRUSH (new brush% [color (make-object color% 220 255 220)]))

(define (venn-bin b1 b2 b3)
  (universe OUT-BRUSH)
  (circle (- CIRCLE-OFF) 0 30 b1)
  (circle CIRCLE-OFF 0 30 b3)
  (piscis CIRCLE-OFF 0 30 b2)
  (print venn))

我们在 SET-BRUSH 中定义了一种新的浅绿色，用于标识参与运算的集合。venn-bin 方法（bin 部分只是指它在绘制二元操作）接受三种刷子，每种刷子标识图表中的一个组件。其余的代码应该是不言自明的。

为了生成我们在图 4-22 中看到的并集图，我们使用：

> (venn-bin IN-BRUSH IN-BRUSH IN-BRUSH)

为了说明 Racket 的集合操作，我们将使用两个集合：

> (define A (set 2 4 6 8 10 12 14 16 18))
> (define B (set 3 6 9 12 15 18))

这是形成两个集合的并集 (A ∪ B) 后的结果：

> (set-union A B)
(set 9 18 14 3 16 2 6 10 15 4 8 12)

请注意，集合不一定按任何特定顺序排列。

我们接下来的操作是 集合交集。集合交集由符号 ∩ 表示。A 和 B 的交集包含所有同时属于 A 和 B 的元素。即 A ∩ B = {x ∣ x ∈ A 且 x ∈ B}。交集的韦恩图如下所示：

(venn-bin SET-BRUSH IN-BRUSH SET-BRUSH)

它也显示在图 4-24 中。

图 4-24：集合交集

下面是一个 Racket 代码的交集示例：

> (set-intersect A B)
(set 18 6 12)

接下来是 集合差异。集合差异由符号 * 表示。A* 和 B 的集合差异包含所有属于 A 但不属于 B 的元素。即 A \ B = {x ∣ x ∈ A 且 x ∉ B}。集合差异的维恩图如下所示：

(venn-bin IN-BRUSH SET-BRUSH SET-BRUSH)

它也显示在图 4-25 中。

图 4-25：集合差异

集合差异通过 Racket 中的 set-subtract 函数执行。

> (set-subtract A B)
(set 14 16 2 10 4 8)

我们的最终操作是 对称差异。对称差异由符号 △ 表示。A 和 B 的对称差异包含所有属于 A 或 B 但不同时属于 A 和 B 的元素。即 A △ B = {x ∣ x ∈ A 或 x ∈ B，但 x 不属于 A 且不属于 B}。对称差异的维恩图如下所示：

(venn-bin SET-BRUSH IN-BRUSH SET-BRUSH)

参见图 4-26 中的示例。

图 4-26：对称差异

对称集合差异通过 Racket 中的 set-symmetric-difference 函数执行。

> (set-symmetric-difference A B)
(set 9 14 3 16 2 10 15 4 8)

我们有关联吗？

在集合理论中，有几个重要的关系是你应该了解的。第一个是子集的概念。如果集合 A 的所有元素也都是集合 B 的元素，那么集合 A 是集合 B 的子集。这个关系由符号 ⊆ 表示。在 Racket 中，可以使用谓词 subset? 来测试一个集合是否是另一个集合的子集。

> (subset? (set 2 4 6 8) (set 1 2 3 4 5 6 7 8 9 10))
#t

> (subset? (set 2 4 6 8) (set 3 4 5 6 7 8 9 10))
#f

第一个示例中的子集关系可以通过图 4-27 中的维恩图表示。在这种情况下，内圈完全被外圈包围。

图 4-27：子集关系

如果集合 A 是集合 B 的子集，但 A ≠ B，则称 A 为 B 的 真子集。这个关系由符号 ⊂ 表示。Racket 提供了 proper-subset? 谓词来执行此功能。

> (subset? (set 2 4 6 8) (set 2 4 6 8))
#t

> (proper-subset? (set 2 4 6 8) (set 2 4 6 8))
#f

给定集合 A 和 B，笛卡尔积 定义如下：

A × B = {(a, b) | a ∈ A 且 b ∈ B}

虽然 Racket 没有内建的函数返回两个集合的笛卡尔积，但我们可以轻松地自己实现一个版本。

> (define (cart-prod A B)
    (list->set
     (for*/list ([a A]
                 [b B])
       (list a b))))

但是一个更简洁的版本如下：

> (define (cart-prod A B)
    (for*/set ([a A]
               [b B])
      (list a b)))

我们可以通过以下方式进行测试：

> (define A (set 'a 'b 'c))
> (define B (set 1 2 3))

> (cart-prod A B)
(set '(a 1) '(c 3) '(c 1) '(c 2) '(a 2) '(a 3) '(b 2) '(b 3) '(b 1))

从中可以看出，笛卡尔积是从两个给定集合中生成的所有可能值对的集合。笛卡尔积的子集常常用于定义关系。例如，如果 A = {1, 2, 3, 4}，我们可以如下表示“小于”关系：

{(1, 2), (1, 3), (1, 4), (2, 3), (2, 4), (3, 4)}

注意，每对中的第一个值总是小于第二个元素。

这段简短的探索结束了我们利用 DrRacket 的图形功能，探讨集合理论这一激动人心的主题。接下来，我们将看看几个扩展应用，利用这些功能来探索数学中的其他主题。

应用

让我们从一个老朋友开始，斐波那契数列。

斐波那契复习

正如我们在上一个章节的斐波那契与朋友部分所学，使用斐波那契数列给出的边长的正方形始终可以平铺一个矩形。在这一部分，我们将创建一个可以绘制任何斐波那契数（直到屏幕限制）的平铺的函数。平铺从绘图画布的中心开始，并通过从该点螺旋状扩展出去。我们在编写这段代码之前，进行一些小的分析将帮助我们找到方向。

平铺

请参见图 4-28。我们将使用每个正方形的左上角作为参考点（如黑色象限所示）。每个箭头表示我们必须移动的方向，以创建下一个斐波那契正方形。

图 4-28：瓷砖分析

如果 n 是第 n 个斐波那契数（F[n]），我们将 f[n] 定义为具有边长 s[n] 的第 n 个斐波那契正方形（这只是 F[n] 的某个常数倍）。f[n] 的左上角坐标为（x[n]，y[n]）。我们假设绘图已经初始化，f[1] 和 f[2] 如图中心的两个小正方形所示。从 f[2] 向上移动到 f[3]，我们看到（x[3]，y[3]）=（x[1]，y[2] - 2）。我们可以将这一点推广为（x[n]，y[n]）=（x[n-2]，y[n-1] - s[n]），每当我们从一个正方形移动到另一个正方形时，方向向上。表 4-1 给出了四个方向的坐标变化。由于模式在四次移动后会重复，因此适用的移动由余数（n mod 4）列给出。

表 4-1：方向坐标

方向	坐标	n mod 4
↑	(x[n-2], y[n-1] – s[n])	3
←	(x[n-1] – s[n], y[n-1])	0
↓	(x[n-1], y[n-1] + s[n-1])	1
→	(x[n-1] + s[n-1], y[n-2])	2

这张表告诉我们，在绘制过程中任何阶段，我们不仅需要访问 F[n] 和 F[n-1]，还需要（x[n-1], y[n-1]）和（x[n-2]，y[n-2]）。我们将使用斐波那契与朋友部分介绍的第二种方法来生成绘图代码中的 F[n]。因此，我们将描述一个 draw-tiles 函数，该函数接收一个斐波那契 n 并返回四个值：x[n-1]，y[n-1]，x[n-2]，和 y[n-2]。这些值与 F[n] 和 F[n-1] 一起用于绘制第 n 个瓷砖。

图 4-29 显示了调用 (draw-tiles 10) 后的结果。

图 4-29：斐波那契平铺

我们的代码从一些常量定义开始，以设定在程序其余部分中使用的参数。

#lang racket
(require racket/draw)

(define WIDTH 600)  ; width of drawing area
(define HEIGHT 400) ; height of drawing area
(define UNIT 6) ; pixels in unit-width square
(define OFFSET-X 140) ; starting x offset
(define OFFSET-Y 75) ; starting y offset
(define START-X (- (/ WIDTH 2)  UNIT OFFSET-X))
(define START-Y (- (/ HEIGHT 2) UNIT OFFSET-Y))

这里应该有足够的注释来说明每个部分的作用。我们通过添加一些偏移值来弥补瓷砖不对称的特性。

接下来，我们设置绘图表面、画笔和画刷。

(define tiling (make-bitmap WIDTH HEIGHT)) 
(define dc (new bitmap-dc% [bitmap tiling]))

(define TILE-PEN   (new pen% [color "black"] [width 1] [style 'solid]))
(send dc set-pen TILE-PEN)

(define TILE-BRUSH (new brush% [color "yellow"] [style 'solid]))
(send dc set-brush TILE-BRUSH)

现在我们定义两个函数：一个用于计算F[n]，另一个是draw-n，用于实际生成清单 4-1 中的瓷砖：

  ; function to compute F(n)
  (define (F n)
    (define (f a b cnt)
      (if (= cnt 0) b
          (f (+ a b) a (- cnt 1))))
    (f 1 0 n))

  ; function to draw the tiling
  (define (draw-n n)
 ➊ (let* ([fn (F n)]
       ➋ [sn (* UNIT fn)]
       ➌ [fn1 (F (sub1 n))]
       ➍ [sn1 (* UNIT fn1)]
          [n-mod-4 (remainder n 4)])
     (cond [(< n 2) #f] ; do nothing tiles already drawn
           [(= n 2) (values (+ UNIT START-X) START-Y START-X START-Y)]
           [else
         ➎ (let-values ([(x1 y1 x2 y2) (draw-n (sub1 n))])
              (let-values ([(x y)
                            (case n-mod-4
                           ➏ [(0) (values (- x1 sn) y1)]
                              [(1) (values x1 (+ y1 sn1))]
                              [(2) (values (+ x1 sn1) y2)]
                           ➐ [(3) (values x2 (- y1 sn))])])
              ➑ (draw-tile x y sn)
              ➒ (values x y x1 y1)))])))

清单 4-1: 使用瓷砖的斐波那契数列

draw-n函数是这个过程的核心。这个过程会递归调用➎，直到绘制出所需数量的瓷砖。首先，我们计算F[n] ➊和F[n-1] ➌。然后，我们将这些数字乘以常量UNIT ➋ ➍来确定方块的大小。接下来，我们根据表 4-1 中讨论的内容确定方块左上角的坐标 ➏ ➐。然后，实际绘制瓷砖 ➑。最后，我们返回在上述分析部分中提到的值x[n-1]、y[n-1]、x[n-2]和y[n-2] ➒，因为这些值是前一个递归调用➎所需要的。

为了实际绘制图形，我们有以下代码：

(define (draw-tiles n)
  (draw-tile START-X START-Y UNIT)
  (draw-tile (+ UNIT START-X) START-Y UNIT)
  (draw-n n)
  (print tiling))

它用两个单位方块初始化绘图，调用draw-n，并将构建的位图输出到屏幕上。

最后，调用(draw-tiles 10)将生成之前在图 4-29 中展示的输出。

黄金螺旋（近似）

为了绘制在第三章中讨论的黄金螺旋（并在图 4-30 中再现），我们只需在我们的瓷砖代码中添加几行内容。

图 4-30: 黄金螺旋

我们首先定义一个新的绘图画笔和画刷，用于绘制螺旋。

(define SPIRAL-PEN (new pen% [color "red"] [width 2] [style 'solid]))
(define TRANS-BRUSH (new brush% [style 'transparent]))

为了绘制螺旋，我们将使用draw-arc函数。这个函数的工作方式与draw-ellipse相似，不同之处在于它多了两个参数，用来指定弧线的起始角度和终止角度。这些值在图 4-18 中由θ[0]和θ[1]表示。默认情况下，弧线使用填充画刷，因此为了避免覆盖瓷砖，我们将TRANS-BRUSH定义为透明画刷。螺旋是通过每绘制一个瓷砖就绘制一个弧线来产生的。我们预先定义了绘制弧线时需要用到的各种角度（以弧度为单位）：

; define angle constants
(define 0d 0)
(define 90d (/ pi 2))
(define 180d pi)
(define 270d (* 3 (/ pi 2)))
(define 360d (* 2 pi))

接下来，我们定义了用于绘制螺旋段的实际函数。

(define (arc x y r a)
  (let-values ([(d) (values (* 2 r))]
               [(start stop x y)
                (case a
               ➊ [(0) (values  90d 180d x       y  )]
                  [(1) (values 180d 270d x       (- y r)  )]
                  [(2) (values 270d 360d (- x r) (- y r) )]
                  [(3) (values   0d  90d (- x r) y)])])
    (send dc set-pen SPIRAL-PEN)
    (send dc set-brush TRANS-BRUSH)
    (send dc draw-arc x y d d start stop)
    (send dc set-pen TILE-PEN)
    (send dc set-brush TILE-BRUSH)))

首先，我们确定弧线的起始角度和终止角度 ➊，以及绘制弧线的位置的 x 坐标和 y 坐标。接下来，我们切换到适当的画笔和画刷来绘制弧线。最后，绘图上下文被重置为绘制瓷砖所需的状态。

对draw-n代码所需的唯一修改是在清单 4-1 中的(draw-tile x y sn)语句 ➑后立即添加这一行：

(arc x y sn n-mod-4)

通过这个修改，调用 (draw-tiles 10) 现在会生成一个覆盖黄金螺旋的瓷砖，如图 4-30 所示。

Nim

Nim 是一款策略游戏，两个玩家轮流从不同的堆中移除物体。每一轮，玩家必须至少移除一个物体，并且可以移除任意数量的物体，只要它们都来自同一个堆。游戏的胜者是最后移除物体的玩家。这个游戏也可以修改为移除最后一个物体的玩家输，但在我们这个版本中，移除最后一个物体的玩家获胜。

在这个版本的 Nim 中，我们将有三个堆，每个堆最多有 15 个球，如图 4-31 所示。这次不再是两个玩家对战，而是人类对机器，mano a mano。

图 4-31：Nim 开始的堆

设置图形

我们将从一些基本定义开始，以建立一些有用的常量。这些常量大多数应该是相当明显的。BOARD引用的是球体所放置的棕色板。

#lang racket
(require racket/draw)

; overall dimensions of drawing area
(define WIDTH 300)
(define HEIGHT 110)
(define BOTTOM-MARGIN 20)

(define RADIUS 8) ; ball radius
(define DIAMETER (* 2 RADIUS))
(define DELTA-Y (- (* DIAMETER (sin (/ pi 3)))))

(define BOARD-THICKNESS 10)
(define BOARD-Y (- HEIGHT BOARD-THICKNESS BOTTOM-MARGIN))

; location to start drawing pile numbers
(define TEXT-X (+ 5 (* RADIUS 5)))
(define TEXT-Y (- HEIGHT BOTTOM-MARGIN))

; x, y location to start drawing balls
(define START-X 20)
(define START-Y (- BOARD-Y RADIUS))

(define BALL-BRUSH (new brush% [color "red"]))
(define BACKGROUND-BRUSH (new brush% [color "yellow"]))
(define BOARD-BRUSH (new brush% [color "brown"]))

Nim 图形的关键是 draw-pile 函数，如下所示，它绘制了一个单独的球堆。此代码使用球的中心位置的 x 和 y 坐标调用 draw-ball。它从下到上绘制每一行（见 draw-row），直到没有更多球或该行已经包含所有球。

(define (draw-ball x y) ; draw ball with center at (x,y)
  (send dc draw-ellipse (- x RADIUS) (- y RADIUS) DIAMETER DIAMETER))

(define (draw-pile n start-x)
  {let ([rem n]
        [x start-x]
        [y START-Y])
    (define (draw-row x y n max)
       (when (and (> rem 0) (<= n max))
         (set! rem (sub1 rem))
         (draw-ball x y)
         (draw-row (+ x DIAMETER) y (add1 n) max)))
    (for ([r (in-range 5 0 -1)])
      (draw-row x y 1 r)
      (set! x (+ x RADIUS))
      (set! y (+ y DELTA-Y)))})

最后，我们来看一下实际上绘制整个 Nim 环境的代码 draw-game：

(define pile (make-vector 3 15))

(define (draw-game)
  (send dc set-pen "black" 2 'solid)
  (send dc set-brush BACKGROUND-BRUSH)
  (send dc draw-rectangle 0 0 WIDTH HEIGHT)
  (send dc set-brush BOARD-BRUSH)
  (send dc draw-rectangle 0 BOARD-Y WIDTH BOARD-THICKNESS)
  (send dc set-brush BALL-BRUSH)

  (draw-pile (vector-ref pile 0) START-X)
  (send dc draw-text "0" TEXT-X TEXT-Y)

  (draw-pile (vector-ref pile 1) (+ START-X (* 6 DIAMETER)))
  (send dc draw-text "1" (+ TEXT-X (* 6 DIAMETER)) TEXT-Y)

  (draw-pile (vector-ref pile 2) (+ START-X (* 12 DIAMETER)))
  (send dc draw-text "2" (+ TEXT-X (* 12 DIAMETER)) TEXT-Y)

  (print drawing) ; display the board
)
(draw-game)

这个例程只是绘制了背景和堆下的矩形板。然后它会为每个堆调用一次 draw-pile。每个堆中包含的球的数量存储在向量变量 pile 中。作为参考，堆的编号显示在每个堆下方。

游戏玩法

Nim 游戏在所有游戏中有点不同，因为已知存在一种完美的游戏策略。它相对容易实现，但并不显而易见。所以，一旦你编写了这个程序，你就可以将它用在一个毫无戒备的朋友身上，让电脑把他打得一败涂地。

这一策略的关键是所谓的 nim-sum。nim-sum 就是每个堆中物体数量的按位异或。异或运算符用数学符号 ⊕ 表示，通常称为 xor。它可以通过 Racket 的 bitwise-xor 函数来计算。

按位异或的计算方法如下：如果你在结合两个单一的比特且两个比特相同，则结果为 0；否则，结果为 1。例如，1 ⊕ 1 = 0 和 1 ⊕ 0 = 1。

在 Racket 中，我们可以通过在 printf 语句的格式字符串中使用 "˜b" 来显示数字的二进制表示。例如，我们有如下代码：

> (printf "~b" 13)
1101

> (printf "~b" 9)
1001

> (printf "~b" (bitwise-xor 13 9))
0100

请注意，如果你在对应的比特位置上对 13[10] = 1101[2] 和 9[10] = 1001[2] 进行按位异或运算，你会得到 0100[2]。

事实证明，获胜的策略就是每次操作结束时使 nim-sum（即异或）为 0。如果在操作之前 nim-sum 不为零，那么这种方法总是可行的。实现这一点的方法如下：

指定 b[0]、b[1] 和 b[2]* 为堆 0、堆 1 和堆 2 中的球数。
设 s = b[0] ⊕ b[1] ⊕ b[2] 为所有堆大小的 nim-sum。
计算 n[0] = s ⊕ b[0]、n[1] = s ⊕ b[1] 和 n[2] = s ⊕ b[2]。
在这三堆中，至少有一个值 n[0]、n[1] 或 n[2] 的数值将小于对应堆中的物品数量。我们从其中一堆中选择，并用字母 i 来表示它。
获胜的操作是将堆 i 的大小减少到 n[i]。也就是说，这一步是从堆 i 中移除 b[i] - n[i] 个球。

如果在玩家回合开始时 nim-sum 为零，那么如果对手完美发挥，该玩家将会输。在这种情况下，最佳策略是通过从其中一堆中取出一个球来拖延时间，并希望对手在某个时刻犯错。之所以这种策略有效，原因有点技术性，不过可以在维基百科的文章中找到分析，链接为 en.wikipedia.org/wiki/Nim。

这引出了实际的 Racket 代码，用于找到获胜的操作。

➊ (define nim-sum bitwise-xor)

➋ (define (random-pile) ; select a random pile that has balls
     (let ([i (random 3)])
       (if (> (vector-ref pile i) 0) i (random-pile))))

   (define (find-move)
     (let* ([balls (vector->list pile)]
         ➌ [s (apply nim-sum balls)])
    ➍ (if (= 0 s)
           (let ([i (random-pile)]) (values i 1)) ; stall
        ➎ (let ([n (list->vector (map (λ (b) (nim-sum s b)) balls))])
          ➏ (define (test? i) (< (vector-ref n i) (vector-ref pile i)))
             (define (move i) (values i  (- (vector-ref pile i) (vector-ref n i))))  
          ➐ (cond [(test? 0) (move 0)]
             [(test? 1) (move 1)]
             [(test? 2) (move 2)])))))

首先，我们将 nim-sum 定义为 bitwise-xor ➊。接下来，我们有辅助函数 random-pile ➋，它只是找到一个有球的随机堆。我们用它来实现上述提到的拖延策略。find-move 实现了我们在上面列出的整体游戏策略。该函数返回两个值：堆的编号和从堆中移除的球数。现在我们计算整体的 nim-sum ➌（上面步骤 2）。然后测试这个和 ➍，如果它为零，它就返回一个随机堆，移除一个球。上面步骤 3 中提到的计算执行 ➎。局部函数 test? ➏ 确定 n[i] 是否小于 b[i]。局部函数 move 返回堆的编号和要移除的球数，如步骤 5 所示。最后，我们进行测试以确定使用哪个堆 ➐。

在我们为玩家输入他们的操作创建代码之前，我们定义了一些辅助函数。

(define (apply-move p n) ; remove n balls from pile p
  (vector-set! pile p (- (vector-ref pile p) n)))

(define (game-over?)
  (for/and ([i (in-range 3)]) (= 0 (vector-ref pile i))))

(define (valid-move? p n)
  (cond [(not (<= 0 p 2)) #f]
        [(< n 0) #f]
        [else (>= (vector-ref pile p) n)]))

apply-move 函数通过移除指定数量的球来更新指定的堆。game-over? 函数测试是否还有球可以继续操作。valid-move? 函数测试给定的操作是否有效。

将所有内容结合起来的是实现以下游戏循环的函数：

(define (move p n)
  (if (not (valid-move? p n))
    (printf"\n Invalid move.\n\n")
    (begin (apply-move p n)
           (if (game-over?)
             (printf "\nYou win!")
             (let-values ([(p n) (find-move)])
             (draw-game)
             (printf "\n\nComputer removes ~a balls from pile ~a.\n" n p)
             (apply-move p n)
             (draw-game)
             (when (game-over?)
               (printf "\nComputer wins!")))))))

玩家通过指定堆的编号和要移除的球数来输入他们的操作。例如，要从堆 1 中移除 5 个球，可以输入以下内容：

> (move 1 5)

为了让事情更有趣，我们定义了一个 init 函数，它会随机初始化每个堆，球的数量在 10 到 15 个之间。

(define (init)
  (for ([i (in-range 3)]) (vector-set! pile i (random 10 16)))
  (newline)
  (draw-game)
  (newline))

图 4-32 展示了正在进行中的游戏。

图 4-32: Nim: 游戏进行中

摘要

在本章中，我们玩转了绘图，探索了图形，并在过程中发现了 Racket 在视觉表现方面的强大功能。在下一章，我们将基于这个功能，突破命令行的局限，制作动画，并迈出创建互动应用程序的第一步。

第五章：GUI：吸引用户兴趣

GUI（发音为 gooey）代表图形用户界面。这个术语是指任何具有图形元素的程序，与仅基于文本的程序不同。图形元素可以是静态图像或绘图，就像我们在上一章中探索的那样，或者是像按钮和菜单这样的互动元素。除了图形元素外，GUI 还引入了事件范式——事件触发动作。事件可以是按键、鼠标点击，甚至是定时器触发等。Racket 不仅支持构建迷你应用程序，还支持独立的可执行文件。

在本章中，我们将通过动画将我们的老朋友圆弧线重新带入生活，学习一些新的（卡片）技巧，并让汉诺塔不仅仅是一个智力游戏。

GUI 简介

Racket GUI 编程使用 racket/gui/base 库，可以通过 (require racket/gui/base) 语句导入。或者，你可以使用语言切换 #lang racket/gui，它包含了 Racket 的基础库和 GUI 库。下面是一个简单的代码片段，它仅仅是创建并显示一个 300 x 200 像素的窗口框架。

#lang racket/gui

(define frame
  (new frame%
       [label "I'm a GUI!"]
       [width 300]
       [height 200]))

(send frame show #t)

你应该注意到，框架的大小是外部窗口的大小，包括标题栏和任何窗口边框。框架内部会稍微小一些。

以下代码展示了一个稍微更刺激的示例，演示了如何响应事件的基本思想。

   #lang racket/gui

   (define main-frame
     (new frame%
          [label "I'm a GUI Too!"]
          [width 300]
          [height 100]))

   (define msg
  ➊ (new message%
       ➋ [parent main-frame]
          [auto-resize #t]
          [label "Hi, there!"]))

➌ (new button%
        [parent main-frame]
        [label "Click Me"]
     ➍ [callback (λ (button event)
                   (send msg set-label "You didn't say may I!"))])

   (send main-frame show #t)

message% 对象 ➊ 创建一个文本为“Hi, there!”的标签（message% 对象比你想象的更强大；它们还可以包含一个位图作为标签）。GUI 对象通常需要指定它们所在的父框架 ➋。我们还定义了 auto-resize 参数，以便如果文本比初始化时的更大，消息控件会自动扩展。

接下来我们创建一个 button% 对象 ➌，并将其设置为 main-frame 窗口的子对象。按钮可以响应鼠标点击。这个响应通过 callback 选项 ➍ 来处理。它接受一个函数（在这种情况下是一个 lambda 表达式），该函数接受两个参数。当按钮被点击时，窗口事件处理器会将一个指向按钮对象的指针和一个包含事件信息的事件对象传递给回调函数（我们在这里没有使用它们；我们只需要知道按钮被点击了）。在我们的例子中，我们向 msg 对象发送一个命令，让它将标签设置为一个新值。

图 5-1 显示了该应用的外观（根据操作系统的不同，可能会略有不同）。

图 5-1：简单的 GUI 应用程序

让我们尝试一下动画。我们将从简单的开始，让一个小红圆圈在屏幕上移动：

   #lang racket/gui

   (define RADIUS 8) 
   (define DIAMETER (* 2 RADIUS))

   (define loc-x RADIUS)
   (define loc-y 35)

   (define main-frame
     (new frame%
          [label "I'm a GUI Too!"]
          [width 300]
          [height 100]))

   (define canvas
     (new canvas% [parent main-frame]
       ➊ [paint-callback
           (λ (canvas dc)
             (send dc set-smoothing 'smoothed)
             (send dc set-text-foreground "blue")
             (send dc draw-text "Having a ball!" 0 0)
             (send dc set-brush "red" 'solid)
             (send dc draw-ellipse (- loc-x RADIUS) (- loc-y RADIUS) DIAMETER DIAMETER))]))

   (define timer
   ➋ (new timer%
       ➌ [notify-callback
           (λ ()
          ➍ (set! loc-x (add1 loc-x))
          ➎ (send canvas refresh-now))]))

   (send main-frame show #t)

➏ (send timer start 50)

在这段代码中，我们在frame%对象中创建了一个canvas%对象。这是我们在上一章中探讨过的相同画布对象，因此之前看到的所有绘图命令都可用。canvas对象支持一个paint-callback事件➊。每当画布需要重新绘制时，都会触发此事件（注意，回调函数会提供一个绘图上下文dc）。默认情况下，当画布首次显示时会触发该事件，但我们通过使用timer%对象➋强制其刷新。画布对象会在(loc-x, loc-y)处绘制小球，因此我们的定时器会在每次调用时更新loc-x值。定时器会响应一个名为notify-callback的事件➌。当该事件触发时，它会通过发送refresh-now消息➎强制画布刷新。定时器回调还会递增loc-x变量➍。整个过程由最后一行代码启动。我们向定时器对象发送消息，使其每 50 毫秒触发一次➏。

我们在这里没有使用它，但定时器也可以通过向其发送stop消息来停止。timer%对象还支持just-once?选项，如果定时器只需要触发一次。也可以通过start消息来指定。例如，调用以下代码会使定时器停止，并在等待一秒钟后触发一次。

> (send timer stop)
> (send timer start 1000 #t)

如果我们希望小球来回弹跳，可以按如下方式修改timer：

(define timer
  (let ([delta 2])
    (new timer%
         [notify-callback
          (λ ()
            (cond [(<= loc-x RADIUS) (set! delta 2)]
                  [(>= loc-x (- (send canvas get-width) RADIUS)) (set! delta -2)])
            (set! loc-x (+ loc-x delta))
            (send canvas refresh-now))])))

这次我们定义了变量delta，它的值根据小球的运动方向可以是正值或负值。我们还添加了一个cond语句，用于检测小球是否到达画布的某个边缘，并改变其运动方向。

动画化摆线

在上一章中，我们展示了如何绘制摆线曲线，这条曲线是由一个在圆周上移动的点生成的，该点在没有滑动的情况下沿着直线滚动。在这一节中，我们将制作一个动画，以便我们可以看到这一运动的实际效果。最终结果将是一个滚动的圆形动画，圆周上的点在其运动过程中描绘出摆线。动画的快照见图 5-2。

图 5-2：动画摆线

我们再次使用infix包来简化代数表达式的输入。我们还将使用之前用过的plot库：

#lang at-exp racket/gui 
(require infix plot)

接下来我们看到cycloid函数与之前使用的版本相同。

(define r 30)
(define angle 0)

(define (cycloid t) @${vector[r*(t - sin[t]),  r*(1-cos[t])]})
(define (circle t) @${vector[r*angle + r*sin[t], r + r*cos[t]]})

再次提醒，r是用来定义摆线的圆的半径。angle变量用于定义动画中任意时刻的旋转角度。circle函数将用来创建我们正在旋转的实际圆的参数图（图中以绿色显示）。

为了创建从圆心到圆边的蓝色线段以及线的红色端点，我们将使用以下两个函数。参数t是旋转角度。

(define (line t)
  (let ([x @${r*(t - sin[t])}]
        [y @${r*(1 - cos[t])}]
        [x0 (* r angle)]
        [y0 r])
    (lines (list (vector x0 y0) (vector x y))
           #:width 2
           #:color "blue")))

(define (end-points t)
  (let ([x @${r*(t - sin[t])}]
        [y @${r*(1 - cos[t])}]
        [x0 (* r angle)]
        [y0 r])
    (points (list (vector x0 y0) (vector x y))
            #:size 10
            #:sym 'fullcircle1
            #:color "red"
            #:fill-color "red")))

这里应该没有什么意外：x 和 y 端点值是通过基本的三角学计算得出的（请参见上一章关于旋轮线问题的解决方案）。我们在上一章中也研究了使用lines和points的情况。

最后，我们来看看实际的绘图程序：

(plot-decorations? #f)

(define (cycloid-plot dc)
  (plot/dc (list
            (axes)
            (parametric circle 0 (* 2 pi) #:color "green")
         ➊ (parametric cycloid 0 angle #:color "red")
         ➋ (line angle)
         ➌ (end-points angle))
        ➍ dc 10 25 300 150
           #:x-min 0
           #:x-max (* r 2 pi)
           #:y-min 0
           #:y-max (* r pi)))

为了在 GUI 中绘图，我们必须使用一个特殊版本的plot，叫做plot/dc，因为这次我们希望输出进入绘图上下文。注意plot和plot/dc之间的区别 ➍。在这里，我们指定了绘图上下文、绘图的* x * 和 * y * 位置，以及绘图的宽度和高度。其他参数与plot相同。这段代码的主要内容是指定我们要绘制的具体对象。特别要注意的是：旋轮线本身 ➊、连接圆心到边缘的线 ➋，以及线的端点 ➌。列表开头的代码(plot-decorations? #f)关闭了一些坐标轴信息，以便我们获得一个更简洁的图形。

为了实际生成动画，我们对之前看到的窗口代码做了一些小改动：

(define main-frame
  (new frame%
       [label "The Plot Thickens"]
       [width 350]
       [height 250]))

(define canvas
  (new canvas% [parent main-frame]
       [paint-callback
        (λ (canvas dc)
          (send dc set-smoothing 'smoothed)
       ➊ (cycloid-plot dc)
          (send dc set-text-foreground "blue")
          (send dc draw-text "Animated Cycloid" 10 180))]))

(define timer
  (new timer%
       [notify-callback
        (λ ()
        ➋ (set! angle (+ 0.1 angle))
        ➌ (when (> angle (* 2 pi)) (set! angle 0))
           (send canvas refresh-now))]))

(send main-frame show #t)

(send timer start 10)

具体来说，我们在每次计时器滴答声响时更新旋转角度 ➋，当圆圈旋转达到 2π度时，将角度重置为零 ➌。绘图实际上是通过cycloid-plot dc ➊来生成的。

在完成了几个热身练习，以熟悉一些基本的 GUI 功能之后，我们来看看更有挑战性的内容——一些我们可以用来让朋友们惊叹的东西。

抽卡

让我们在计算机上施展一点魔法。在这个魔术中，我们随机发出一个 5x5 的卡牌矩阵，卡面朝上。参与者心里挑选其中一张卡片，并指出卡片所在的行。然后，卡片被重新洗牌，并再次发出一个 5x5 的矩阵。接着，参与者再次被要求指出卡片所在的行。选中的卡片随后会在热烈的气氛中被揭示出来。我们游戏的 Racket 版本如图 5-3 所示。这里使用的卡片图像根据 GPL 许可协议提供，感谢 Chris Aguilar 的贡献⁽¹⁾和⁽²⁾。

图 5-3：抽卡魔术

很明显，如果卡片被正确洗牌并重新发出，就不可能不出错地选择正确的卡片。像所有的魔术一样，这个也涉及一点欺骗。这背后的机制其实相当简单。在以下图示中，我们用字母表示每张卡片。

假设在第二行第三列选择了N。我们可以随机交换列，而不影响已选中的行。做完这一步后，我们可能会得到如下所示的结果。

现在，我们得到的东西看起来相当不同，但我们仍然可以看到第 2 行中的 N（但现在位于第 1 列）。在一个重要的步骤中，我们进一步增强了这种错觉，我们对行和列进行了转置（所谓转置，是指行变成列，列变成行——也就是说，第 1 行变成第 1 列，第 2 行变成第 2 列，依此类推）。这样做会得到以下排列。

结果矩阵现在与原始矩阵完全不同，但请注意，N 现在位于第 2 列，而不是第 2 行。一旦玩家确定第 1 行为正确行（原本是第 1 列），我们立即得到了位置（第 1 行，第 2 列——原本是第 2 行）。由于我们对行和列进行了转置，玩家无意中揭示了卡片所在的行和列。

交换行和列，以及行列转置，是线性代数数学学科中的常见操作。我们将利用 Racket 的矩阵库，它提供了我们所需的功能。基于此，我们的代码从以下内容开始：

#lang racket/gui
(require math/matrix)

(define selected-row -1)
(define selected-col -1)
(define show-card #t)

define 表达式用于跟踪程序状态。

卡片位图将保存在一个名为 card-deck 的向量中。正在使用的卡片图像的根名称将存储在另一个向量中，名为 card-names。以下代码从一个名为 Card PNGs 的子文件夹中读取卡片图像：

(define card-names
  #("01H" "02H" "03H" "04H" "05H" "06H" "07H" "08H" "09H" "10H" "11H" "12H" "13H"
    "01C" "02C" "03C" "04C" "05C" "06C" "07C" "08C" "09C" "10C" "11C" "12C" "13C"
    "01D" "02D" "03D" "04D" "05D" "06D" "07D" "08D" "09D" "10D" "11D" "12D" "13D"
    "01S" "02S" "03S" "04S" "05S" "06S" "07S" "08S" "09S" "10S" "11S" "12S" "13S"))

(define card-deck 
  (for/vector ([card-name (in-vector card-names)]) 
    (read-bitmap (build-path "Card PNGs" (string-append card-name ".png")))))

(define card-width (send (vector-ref card-deck 0) get-width))
(define card-height (send (vector-ref card-deck 0) get-height))

请注意，我们使用了 build-path 来构造一个操作系统无关的路径名。

由于我们希望能够洗牌，以下代码将把 card-deck 按随机顺序排列：

(define (shuffle-deck)
  (for ([i (in-range 52)])
    (let ([j (random 52)]
          [t (vector-ref card-deck i)])
      (vector-set! card-deck i (vector-ref card-deck j))
      (vector-set! card-deck j t))))

card-deck 向量只是一个卡片位图的线性列表。为了能够以显示时的排列方式展示它们，我们定义了一个 Racket 的 display-matrix，它存储了指向 card-deck 向量的索引。我们还创建了 get-card，使我们能够根据卡片所在的行和列访问任何位图。

(define display-matrix
  (build-matrix SIZE SIZE (λ (r c) (+ (* r SIZE) c))))

(define (get-card r c)
  (vector-ref card-deck (matrix-ref display-matrix r c)))

在本节中，我们已经解释了这个技巧背后的基本机制，并定义了一些数据结构来存储谜题对象（卡片及其图像）。在下一节中，我们将利用 Racket 的布局机制生成一个吸引人的表格。

GUI 布局

我们之前使用过按钮、消息控件和画布控件，但我们以默认顺序显示它们，即一个堆叠在另一个上面。在这种情况下，我们需要一些更复杂的东西。Racket 提供了两个足够满足我们需求的布局控件：horizontal-panel% 和 vertical-panel%。vertical-panel% 控件允许我们将控件垂直堆叠，如图 5-3 左侧所示。下面的代码中，我们使用 horizontal-panel% 来容纳 vertical-panel% 和用于绘制卡片面朝上的画布。

(define main-frame
  (new frame%
       [label "Pick a Card"]
       [width 550]
       [height 650]))

(define main-panel (new horizontal-panel%
                        [parent main-frame]))

(define control-panel (new vertical-panel%
                           [parent main-panel]
                           [min-width 100]
                           [stretchable-width 100]))

(define MARGIN 10)     ; in pixels
(define SIZE 5)        ; card rows and columns
(define MSG-HEIGHT 20) ; height of msg label

(define canvas
  (new canvas%
       [parent main-panel]
       [min-width 400]
       [paint-callback
        (λ (canvas dc)
          (send dc set-smoothing 'smoothed)
          (for* ([r (in-range SIZE)] ; draw the cards
                 [c (in-range SIZE)])
            (send dc draw-bitmap (get-card r c)
                  (+ MARGIN (* c (+ MARGIN card-width)))
                  (+ MSG-HEIGHT MARGIN (* r (+ MARGIN card-height)))))
       ➊ (when show-card ; draw red border on selected card
            (let* ([off-x (/ MARGIN 2)]
                   [off-y (+ off-x MSG-HEIGHT)])
              (send dc set-pen "red" 3 'solid)
              (send dc set-brush (new brush% [style 'transparent]))
              (send dc draw-rectangle
                    (+ off-x (* selected-col (+ MARGIN card-width)))
                    (+ off-y (* selected-row (+ MARGIN card-height)))
                    (+ card-width MARGIN) (+ card-height MARGIN))
              (send dc set-pen "black" 2 'solid)))
         )]))

大部分canvas的代码应该是熟悉的，但从when ➊开始的部分使用了一个名为show-card的状态变量，当它为真时，表示该显示选定的卡片（通过在卡片周围绘制红色边框）。

构建控件

我们希望在应用程序的左上角显示一个消息控件，以作为用户的提示。让我们现在添加代码来实现这一点。首先使用以下代码。

(define msg
  (new message%
       [parent control-panel]
       [min-height MSG-HEIGHT]
       [label "Select again."]))

为了美化我们的按钮，我们需要一张箭头的图像。与其去外面寻找箭头的位图，不如通过一系列path语句来即时构建它，正如我们在这里通过生成箭头形状的多边形来做到的：

(define arrow ; bitmap
  (let* ([image (make-bitmap 50 40)]
         [dc (new bitmap-dc% [bitmap image])]
         [path (new dc-path%)])
    (send dc set-brush (new brush% [color "blue"]))
    (send path move-to  0 10)
    (send path line-to 30 10)
    (send path line-to 30  0)
    (send path line-to 50 20)
    (send path line-to 30 40)
    (send path line-to 30 30)
    (send path line-to  0 30)
    (send path line-to  0 10)
    (send dc draw-path path)
    image))

这里有一种稍微简洁的写法：

(define arrow ; bitmap
  (let* ([image (make-bitmap 50 40)]
         [dc (new bitmap-dc% [bitmap image])]
         [path (new dc-path%)])
    (send dc set-brush (new brush% [color "blue"]))
    (send path move-to  0 10)
    (send path
          lines '(
                 (30 . 10)
                 (30 . 0)
                 (50 . 20)
                 (30 . 40)
                 (30 . 30)
                 ( 0 . 30)
                 ( 0 . 10)))
    (send dc draw-path path)
    image))

现在我们已经有了箭头，我们还需要按钮来选择卡片行。我们将使用以下代码：

(define (gen-row-button r)
  (new button%
       [parent control-panel]
       [label arrow]
       [min-width 80]
       [min-height 50]
       [vert-margin (/ (+ MARGIN (- card-height 50)) 2)]
       [callback (λ (button event)
                   (select-row r))]))

(for ([i (in-range SIZE)])
  (gen-row-button i))

请注意，我们使用卡片的高度来调整按钮的边距，使它们与卡片图像行对齐。

控制逻辑

现在我们已经指定了基本的 GUI 组件，接下来进入控制逻辑部分，使得拼图变得互动。交换display-matrix列的逻辑在下面给出的swap-cols函数中。它接受两个列号，并按要求交换display-matrix的列。我们将简要介绍它是如何工作的，但如果你不熟悉线性代数，可能需要将这个函数视为一个按预期工作的黑盒，并跳过下一部分。

(define (swap-cols c1 c2)
  (let ([swap-matrix (make-swap c1 c2)])
    (matrix* display-matrix swap-matrix)))

线性代数区域

正如你从线性代数中回忆起的那样，有三种基本的矩阵操作。

交换两行（或两列）。
将一行（或一列）中的每个元素乘以一个数字。
将一行（或一列）乘以一个数字，并将结果加到另一行（或一列）中。

所有这些操作都可以通过矩阵乘法来实现。为了我们的目的，我们只需要实现交换列的功能，但如果M和R是矩阵，使得RM = M[r]，其中M的某些行已交换，那么MR = M[c]将产生一个交换了相应列的矩阵。举个例子，我们定义M和R如下：

然后我们可以按如下方式交换矩阵 M的前两行或前两列：

Racket 提供了一个矩阵乘法运算符matrix*，但遗憾的是没有提供内置的行或列交换操作，因此我们必须自己创建。以下的make-swap函数接受两个行号，并返回一个矩阵，其对应的矩阵行已被交换。我们将其与 Racket 提供的矩阵乘法运算符结合使用，在上面的swap-cols函数中给出。由于swap-matrix是乘法中的第二个参数，它执行列交换，而不是行交换。

(define (make-swap r1 r2)
  (define (swap-func r c)
    (cond [(= r r1) (if (= c r2) 1 0)]
          [(= r r2) (if (= c r1) 1 0)]
          [(= r c) 1]
          [else 0]))
  (build-matrix SIZE SIZE swap-func))

函数build-matrix在 Racket 的matrix库中定义。它通过使用swap-func计算的元素来构造一个新的矩阵。

总结 GUI 部分

当用户进行第一次行选择时，以下代码会运行：

 (define (first-row-selection r)
   (set! selected-col r)
   (send msg set-label "Select again.")
➊ (for ([i (in-range SIZE)])
    (let ([j (random SIZE)]
          [t (vector-ref card-deck i)])
   ➋ (set! display-matrix (swap-cols i j))))
➌ (set! display-matrix (matrix-transpose display-matrix))
   (send canvas refresh-now))

你可能会好奇它首先做的事情是为什么要将selected-col设置为选定的行r。原因是，在执行内置的matrix-transpose操作后，选定的行将变成选定的列➌。我们通过一系列列交换来打乱显示的方程式，而不影响行顺序➊ ➋)。

用户第二次进行行选择时，将运行show-selection函数。

(define (show-selection r)
  (send msg set-label "Tada!")
  {set! selected-row r}
  (set! show-card #t)
  (send canvas refresh-now))

该函数设置了show-card变量，并触发画布刷新，显示选定的卡片。

为了初始化整个过程，我们有restart函数：

(define (restart)
  (shuffle-deck)
  (send msg set-label "Select a row.")
  (set! show-card #f)
  (set! selected-row -1)
  (set! selected-col -1)
  (send canvas refresh-now))

(restart)

(send main-frame show #t)

让我们看看当用户点击按钮时会发生什么。早在我们创建箭头按钮时，我们为它们分配了一个名为select-row的回调函数，并指定了相应的行号。根据状态变量selected-row和selected-col，该函数会执行不同的操作。

(define (select-row r)
  (cond [(< selected-col 0) (first-row-selection r)]
        [(< selected-row 0) (show-selection r)]
        [else (send msg set-label "Restart.")]))

如果selected-col小于零（表示这是第一次选择），则运行first-row-selection。如果selected-row小于零（表示这是第二次选择），则运行show-selection以显示选定的卡片。如果两者都不为真（表示已经进行了两次选择），则提示用户通过按“重新开始”按钮重置程序。

我们的卡片魔术应用程序已经充分利用了 Racket 的 GUI 功能，但没有什么比看到物体在屏幕上飞来飞去更具吸引力了。在下一部分，我们将把我们的命令行版汉诺塔转化为一个互动动画谜题。

控制塔

在第三章中，我们看到了解决汉诺塔谜题的一个简单函数。该函数返回一个包含解决谜题所需移动的列表。当然，这并不是一个非常令人满意的方式来可视化解决方案的进展。在本节中，我们将通过动画展示解决方案来弥补这一遗漏，并在此过程中进一步了解 Racket 小部件。小部件是用于向应用程序提供输入（如按钮、文本框和选择列表）或显示信息（如进度条和标签）的图形对象。

解决谜题的代码（hanoi）如下所示。它仍然完全符合我们的需求。回想一下，它返回一个移动列表，每个列表包含从哪个柱子到哪个柱子的移动。它可以放在#lang racket/gui命令之后的任何位置。

(define (hanoi n f t)
  (if (= 1 n) (list (list f t))
      (let* ([u (- 3 (+ f t))] ; determine unused peg
             [m1 (hanoi (sub1 n) f u)] ; move n-1 disks from f to u
             [m2 (list f t)] ; move single disk from f to t
             [m3 (hanoi (sub1 n) u t)]); move disks from u to t
        (append m1 (cons m2 m3)))))

我们将在接下来的部分构建的程序将支持 1 到 10 个盘子的情况。图 5-4 展示了我们在本节其余部分将使用的一些基本参数。如图所示，每根柱子将分配一个从 0 到 2 的数字。柱子上的每个位置也有一个指定的值。这些值将作为参数传递给各种函数，以控制盘子的源位置和目标位置。

图 5-4: 汉诺塔参数

设置

我们将从一些有用的常量开始。

#lang racket/gui

(define MAX-DISKS 9)
(define UNIT 15)
(define PEG-X (+ (* 3 UNIT) (* MAX-DISKS (/ UNIT 2))))
(define PEG-Y (* 2 UNIT))
(define START-Y (+ PEG-Y (* UNIT MAX-DISKS)))
(define PEG-DIST (* UNIT (add1 MAX-DISKS)))
(define RADIUS (/ UNIT 2))
(define ANIMATION-INTERVAL 1) ; ms
(define MOVE-DIST 2)

为了实现可扩展性，我们将常量UNIT定义为基本的度量单位（以像素为单位）。通过将所有其他测量值基于这个值，我们可以通过更改这个数字来缩放整个界面。常量PEG-X和PEG-Y是第一个柱子的位置。常量PEG-DIST是柱子之间的距离，START-Y是盘子在最底部位置（位置 1）时的y坐标。常量RADIUS用于弯曲盘子和柱子的两端。常量ANIMATION-INTERVAL定义了动画更新之间的毫秒时间间隔，MOVE-DIST定义了每次动画更新时盘子移动的距离。这两个最后的参数可能需要根据运行代码的计算机的性能特点进行调整。

这里是主窗口元素，应该没有什么令人惊讶的地方。

(define main-frame
  (new frame%
       [label "Tower of Hanoi"]
       [width (+ (* 7 UNIT) (* 3 PEG-DIST))]))

(define main-panel (new vertical-panel%
                        [parent main-frame]))

(define canvas
  (new canvas%
       [parent main-panel]
       [min-height (+ START-Y UNIT)]
       [paint-callback (λ (canvas dc) (update-canvas dc))]))

(define control-panel1
  (new horizontal-panel%
       [parent main-panel]))

(define control-panel2
  (new horizontal-panel%
       [parent main-panel]))

我们将在稍后更详细地查看update-canvas。

以下定义的是一些变量，这些变量将在动画过程中进行更新。

(define num-disks 8)
(define delta-x 0) 
(define delta-y 0)
(define target-x 0) 
(define target-y 0)
(define source-peg 0)
(define dest-peg 0)
(define current-disk 0)
(define current-x 0)
(define current-y 0)
(define peg-disks (make-vector 3 0))
(define move-list '())
(define total-moves 0)
(define move-num 0)
(define in-motion #f)
(define mode 'stoppd)

peg-disks变量是一个三元素向量，用于表示三个柱子。向量的每个元素将包含一个数字列表，表示分别位于各个柱子上的盘子。其他大多数变量的名称能较好地描述它们的用途，但我们将在本节中进一步详细说明。

为了让你了解我们正在构建的内容，图 5-5 是最终应用程序的快照，展示了一个盘子正在移动的过程。

图 5-5: 汉诺塔 GUI

在接下来的部分中，我们将描述将在 GUI 中使用的界面小部件。

第 1 行小部件

第一行控件（显示在图 5-5 画布下方）被放置在水平面板control-panel1中。我们将按添加到面板的顺序描述它们。

首先，有一个基本的按钮控件，它具有一个回调函数，该函数在动画尚未开始的情况下调用reset，将一切恢复到初始状态。

(define btn-reset
  (new button%
       [parent control-panel1]
       [label "Reset"]
       [callback (λ (button event)
                   (when (not in-motion) (reset)))]))

接下来是一个text-field%小部件。这是一个基本的文本输入框，用来让用户指定动画中使用的盘子数量（通过init-value，它还用于初始化其他一些控件）。

(define text-disks
  (new text-field%
       [parent control-panel1]
       [label "Disks: "]
       [stretchable-width #f]
       [init-value "8"]))

在文本框之后，我们有一个方便的滑块控件。滑块提供了选择盘子数量的另一种方法。回调函数将根据滑块的位置更新文本框中的盘子数量。通过获取滑块的值并将其发送到文本框小部件来完成此操作。其余参数的用途应该是显而易见的。

(define slider-disks
  (new slider%
       [parent control-panel1]
       [label #f]
       [stretchable-width #f]
       [min-width 100]
       [style (list' horizontal 'plain)]
       [min-value 1]
       [max-value MAX-DISKS]
       [init-value 8]
       [callback (λ (slider event)
                   (send text-disks
                         set-value
                         (number->string (send slider-disks get-value))))]))

第一行的最后一个元素是一个进度条。这里我们使用的是 Racket 的 gauge% 小部件。要更新此控件，只需发送一个数字，表示要显示的值（该数字必须在指定的范围内）。

(define gauge
  (new gauge%
       [parent control-panel1]
       [label "Progress: "]
       [stretchable-width #f]
       [min-width 100]
       (range 100)))

第二行控件

控件的第二行位于水平面板 control-panel2 中。首先是一个按钮，允许用户一步一步地解决难题。

(new button%
     [parent control-panel2]
     [label "Step"]
     [callback (λ (button event)
                 (when (not in-motion)
                   (when (equal? move-list '()) (reset))
                   (set! in-motion #t)
                   (set! mode 'step)
                   (send msg set-label "Running...")
                   (init-next-step)
                   (send timer start ANIMATION-INTERVAL)))])

状态变量 in-motion 用于标记动画是否正在进行中。如果是，它会检查该变量，以确保在步骤完成之前不会重新触发动作。move-list 变量包含求解器 hanoi 提供的移动列表。如果列表为空，表示解决方案已经生成，此时程序会自动重置。mode 变量可以有三种值：

’stopped。等待用户输入。

’step。执行一个单独的步骤。

’solve。解决方案动画正在进行中。

接着，init-next-step 会设置所有状态变量，以执行下一个解决步骤。

接下来是触发完整解决方案的按钮。

(new button%
     [parent control-panel2]
     [label "Solve"]
     [callback (λ (button event)
                 (when (not in-motion)
                   (let ([old num-disks]
                         [new (validate-disks)])
                  ➊ (when (or (equal? move-list '()) (not (= old new)))
                       (set! num-disks new)
                       (reset))
                     (set! in-motion #t)
                     (set! mode 'solve)
                     (send msg set-label "Running...")
                     (init-next-step)
                     (send timer start ANIMATION-INTERVAL))))])

该按钮的回调与步骤按钮的回调类似，但这次我们还会检查用户是否更改了盘子数量 ➊ ，如果更改了，程序会重置以反映新的盘子数量，然后再运行动画。同时，它会将 mode 变量设置为’solve。（如果你不喜欢在执行时 (object:button . . . ) 在 DrRacket 窗口中打印出来，可以将其包裹在一个 void 语句中。）

下一个按钮非常简单：它将 mode 设置为’step。模式会在每一步结束时被检查，所以这会自动停止动画。可以通过按下“解决”或“步骤”按钮来恢复动画。

(new button%
     [parent control-panel2]
     [label "Pause"]
     [callback (λ (button event)
                 (set! mode 'step))])

面板中的最后一个控件是一个标准的 message% 小部件。它用于显示程序的当前状态。

(define msg
  (new message%
       [parent control-panel2]
       [auto-resize #t]
       [label "Ready"]))

定位

现在让我们看几个函数，它们决定如何在画布上定位盘子。每个盘子都有一个从 1 到 MAX-DISKS 的编号，决定盘子的大小。disk-x 函数接收盘子编号和盘子所在的柱子的编号，它返回盘子的 x 坐标。disk-y 函数接收盘子在柱子上的位置（参见图 5-4）并返回盘子的 y 坐标。

(define (disk-x n peg)
  (let ([w (* (add1 n) UNIT)])
    (- (+ PEG-X (* peg PEG-DIST)) (/ w 2) (/ UNIT -2))))

(define (disk-y pos)
  (- START-Y (* pos UNIT)))

盘子实际上只是一个圆角矩形。我们打算通过添加渐变效果为盘子增添一些亮点，这样盘子看起来会更像盘子。如果你仔细看图 5-5，你会注意到盘子不是单一的颜色，而是呈现出圆柱形的效果。为此，我们定义了一个 make-gradient 函数。

(define (make-gradient start stop c1 c2)
  (new linear-gradient%
       [x0 start] [y0 0]
       [x1 stop] [y1 0]
       [stops
        (list (list 0   (make-object color% c1))
              (list 0.5 (make-object color% c2))
              (list 1   (make-object color% c1)))]))

这个函数返回一个 Racket 的linear-gradient%对象，可以应用于画笔。start和stop参数是渐变开始和结束的屏幕* x 位置。变量c1是渐变两端的颜色，而c2是渐变中心的颜色。线性渐变通过定义一个线段来工作，该线段的端点由(x[0], y[0])和(x[1], y[1])给出。颜色是沿着线段垂直应用的。这就是为什么在我们的应用中，我们可以将 y 值设为 0。颜色沿着线段变化，通过定义一组 stop *位置来实现。每个位置定义了沿着线段应用颜色的位置。该位置是一个介于 0 和 1 之间的数字，其中 0 是线段起点的颜色，1 是线段终点的颜色；0 到 1 之间的任何数字都表示在该点处应用颜色。

要实际绘制一个圆盘，我们使用以下draw-disk函数。我们传递给该函数一个绘图上下文、一个圆盘编号、一个柱子编号以及柱子上的位置。

(define (draw-disk dc n peg pos)
  (let* ([w (* (add1 n) UNIT)]
         [x (disk-x n peg)]
         [y (disk-y pos)])
    (send dc set-brush
          (new brush%
               [gradient (make-gradient x (+ x w) "Green" "GreenYellow")]))
    (send dc draw-rounded-rectangle x y w UNIT RADIUS)))

在其中，我们计算圆盘的宽度和 x、y 坐标。然后，我们使用make-gradient函数创建一个画笔，该函数生成一个线性渐变，使用它绘制一个圆角矩形来表示圆盘。

以下函数用于绘制圆盘。draw-peg-disks函数会在一个柱子上绘制所有圆盘。它接受一个绘图上下文、一个柱子编号以及一个包含需要绘制的圆盘的列表。draw-disks函数会为每个柱子调用一次draw-peg-disks。

(define (draw-peg-disks dc peg disks)
  (define (loop disks pos)
    (when (> pos 0)
      (let ([n (first disks)]
            [r (rest disks)])
        (draw-disk dc n peg pos)
        (loop r (sub1 pos)))))
  (loop disks (length disks)))

(define (draw-disks dc)
  (for ([peg (in-range 3)])
    (draw-peg-disks dc peg (vector-ref peg-disks peg))))

这里是draw-base，它绘制了带有柱子的基础（注意柱子也使用了线性渐变）。

(define (draw-base dc)
  (for ([i (in-range 3)])
    (let ([x (+ PEG-X (* i PEG-DIST))])
      (send dc set-brush
            (new brush%
                 [gradient (make-gradient x (+ x UNIT) "Chocolate" "DarkOrange")]))
      (send dc draw-rounded-rectangle x PEG-Y UNIT (+ UNIT (- START-Y PEG-Y)) RADIUS)))
  (send dc set-brush (new brush% [color "Chocolate"]))
  (send dc draw-rectangle UNIT START-Y (+ (* 4 UNIT) (* 3 PEG-DIST)) UNIT))

实际的绘制过程由这里给出的update-canvas开始。除了调用上述的draw-base和draw-disks之外，它还会检查是否有圆盘正在移动（通过current-disk大于零来判断）。如果是这种情况，它还会渲染正在动画化的圆盘。

(define (update-canvas dc)
  (draw-base dc)
  (draw-disks dc)
  (when (current-disk . > . 0)
    (let* ([w (* (add1 current-disk) UNIT)]
           [x current-x]
           [y current-y])
      (send dc set-brush
            (new brush%
                 [gradient (make-gradient x (+ x w) "Green" "GreenYellow")]))
      (send dc draw-rounded-rectangle x y w UNIT RADIUS))))

控制动画

现在我们将查看两个用于在过程中的两个关键点初始化状态变量的函数：在解决方案开始时和每一步之前。第一个叫做reset。

  (define (reset)
 ➊ (set! num-disks (validate-disks))
    (set! delta-x 0)
    (set! delta-y 0)
    (set! current-disk 0)
 ➋ (set! move-list (hanoi num-disks 0 2))
    (set! total-moves (length move-list))
    (set! move-num 0)
 ➌ (vector-set! peg-disks 0 (range 1 (+ 1 num-disks)))
    (vector-set! peg-disks 1 '())
 ➍ (vector-set! peg-disks 2 '())
    (send canvas refresh-now))

➎ (define (init-next-step)
    (let ([move (first move-list)])
      (set! source-peg (first move))
      (set! dest-peg (second move))
      (set! delta-x 0)
      (set! delta-y (- MOVE-DIST))
      (set! target-y (/ UNIT 2))
      (set! move-list (rest move-list))
      (let* ([source-disks (vector-ref peg-disks source-peg)]
             [pos (length source-disks)])
        (set! current-disk (first source-disks))
        (set! current-x (disk-x current-disk source-peg))
        (set! current-y (disk-y pos))
        (vector-set! peg-disks source-peg
                     (rest source-disks)))))

 ➏ (define (validate-disks)
     (let* ([disks-str (send text-disks get-value)]
            [n (string->number disks-str)])
       (if (and (integer? n) (< 0 n (add1 MAX-DISKS)))
           (begin
             (send slider-disks set-value n)
             (send msg set-label "  Ready")
             n)
           (begin
             (send text-disks set-value (number->string num-disks))
             (send msg set-label "  Disks out of range.")
             num-disks))))

上面的代码首先通过调用validate-disks ➊将请求的圆盘数量赋值给变量num-disks（validate-disks ➏确保用户输入了正确的圆盘数量；如果没有，它会回退到上一个有效的输入）。接下来，根据请求的圆盘数量生成一个移动列表 ➋。然后，我们初始化peg-disks向量，将圆盘放置在每个柱子上 ➌ ➍。init-next-step函数 ➎通过从移动列表中提取下一个移动来确定源柱子和目标柱子、目标位置以及需要移动的圆盘的参数。

我们最终到达了负责主要动画更新过程的move-disk代码。它分为三个阶段处理单个移动步骤：目标盘子从源柱子向上移动并脱离，盘子向左或向右移动至目标柱子，然后盘子向下移动到最终的停放位置。下面的代码中，update-progress用于更新进度条。它在每一步的末尾由move-disk调用 ➎。

(define (update-progress)
  (send gauge set-value (inexact->exact (floor (* 100 (/ move-num total-moves))))))

(define (move-disk)
  (cond [((abs delta-y) . > . 0)
         (begin
        ➊ (set! current-y (+ current-y delta-y))
           (when ((abs (- target-y current-y)) . < . MOVE-DIST)
             (set! current-y target-y)
             (if (delta-y . < . 0) 
                 (begin ; was moving up
                   (set! target-x (disk-x current-disk dest-peg))
                   (set! delta-x (sgn (- dest-peg source-peg)))
                   (set! delta-y 0))
                 (begin ; was moving down
                   (set! move-num (add1 move-num))
                ➋ (vector-set! peg-disks dest-peg
                        (cons current-disk (vector-ref peg-disks dest-peg)))
                   (if (equal? mode 'step)
                       (begin
                         (send timer stop)
                         (set! current-disk 0)
                         (set! in-motion #f)
                         (set! mode 'stopped)
                         (send msg set-label "Ready")
                         (set! delta-y 0))
                       (if (> (length move-list) 0)
                           (init-next-step)
                           (begin
                             (send timer stop)
                             (send msg set-label "Done!")
                             (set mode 'stopped)
                             (set! in-motion #f)
                             (set! delta-y 0))))))))]

     ➌ [((abs delta-x) . > . 0)
         (begin
        ➍ (set! current-x (+ current-x delta-x))
           (when ((abs (- target-x current-x)) . < . MOVE-DIST)
             (set! current-x target-x)
             (set! target-y (* PEG-DIST (- dest-peg source-peg)))
             (set! delta-y MOVE-DIST)
             (let ([tdisks (length (vector-ref peg-disks dest-peg))])
               (set! target-y (disk-y (add1 tdisks))))
             (set! delta-x 0)))]

        [else (send timer stop)])

➎ (update-progress)
➏ (send canvas refresh-now))

在调用move-disk之前，目标盘子、源柱子和目标柱子的参数都将通过调用init-next-step来设定。

垂直移动的代码从 ➊ 开始，并更新盘子的当前 y 坐标。接着进行检查，看看盘子是否已经到达目标位置。如果盘子到达了目标位置且正在向上移动，则为盘子设置新的 x 坐标目标和移动增量。如果盘子正在向下移动，则通过将动画盘子添加到列表中来更新目标柱子 ➋。如果动画处于step模式，动画计时器将被关闭，并且状态变量会设置为指示该步骤已完成。否则，动画处于solve模式，因此会检查是否还有剩余的移动。如果有剩余的移动，则调用init-next-step；否则，停止计时器。

水平移动的检查在➌处进行。盘子的 x 坐标会被更新，随后检查盘子是否位于目标位置 ➍。如果是，它会设置状态变量，以便下次触发move-disk时，盘子开始向下移动。在每个步骤的末尾，进度计和画布都会更新 ➎ ➏。

总结

启动所需的剩余项目如下所示。首先，我们定义timer并指定回调函数为move-disk。接着，调用reset初始化所有状态变量。最后，显示主窗口。

(define timer
    (new timer% [notify-callback move-disk]))

(reset)

(send main-frame show #t)

除了一个小巧的应用程序来探索汉诺塔谜题的各个方面外，在构建这个应用程序的过程中，我们还使用了 DrRacket 环境提供的大量（但不是全部）控件。

总结

在本章中，我们从几个简单的 GUI 应用程序开始，逐步构建成一个功能相对完备的应用程序，在此过程中我们接触到构建稳健应用所需的一些元素。在本书的后续部分，我们将看到如何将此功能打包成一个独立的应用程序，可以在不依赖 DrRacket 环境的情况下运行。但接下来，我们将探索如何访问和分析数据的各种形式。

第六章：数据

本章讲述的是数据：如何读取它、写入它、可视化它以及分析它。我们将从使用 Racket 端口进行输入和输出的讨论开始（这是我们在本章中将使用的一个重要工具）。

I/O，I/O，我们开始工作了

在 Racket 中，数据通过端口进行传输：数据流入输入端口并流出输出端口。将数据从外部源（如文本文件或数据库服务器）传输到 Racket，或从 Racket 传输到外部源的过程被称为 I/O。让我们来看一些端口的例子。

文件 I/O 端口

端口可以用于写入和读取文件中的数据，如下对话所示。

> ; Output some stuff
(define out-port (open-output-file "data/SomeStuff.txt"))
(display "some stuff" out-port)
(close-output-port out-port)

> ; Read it back in
(define in-port (open-input-file "data/SomeStuff.txt"))
(read-line in-port)
(close-input-port in-port)
"some stuff"

如果我们尝试打开一个已存在的文件端口，就会出现错误。

> (define more-out (open-output-file "data/SomeStuff.txt"))
open-output-file: file exists
  path: ...\data\SomeStuff.txt

open-output-file 的默认操作模式是创建一个新文件。由于我们不能两次创建新文件，因此需要声明如何处理现有文件。这是通过 #:exists 关键字来管理的：通过指定 append 作为值，我们可以将数据附加到现有文件中，使用 replace 会删除文件并创建一个新文件，或者使用 truncate 保留文件但删除其内容（#:exists 的默认值是 error，即如果文件已存在则生成错误）。我们在下面演示了一些选项。

> (define out-port (open-output-file "data/SomeStuff.txt" #:exists 'append))
  (display "some more stuff\n" out-port)
  (close-output-port out-port)

> (define in-port (open-input-file "data/SomeStuff.txt"))
> (read-line in-port)
"some stuff"

> (read-line in-port)
"some more stuff"
> (close-input-port in-port)

> (define out-port (open-output-file "data/SomeStuff.txt" #:exists 'truncate))
  (display "some new stuff\n" out-port)
  (close-output-port out-port)

> (define in-port (open-input-file "data/SomeStuff.txt"))
> (read-line in-port)
"some new stuff"
> (read-line in-port)
#<eof>
> (close-input-port in-port)

一旦到达文件的末尾，read-line 会返回一个文件结束对象；它显示为#<eof>，但在 Racket 中定义为 eof。可以通过 eof-object? 谓词来测试这个值。

> eof
#<eof>

> (eof-object? eof)
#t

每次打开端口时，必须记得在数据传输完成后关闭端口。可以通过使用 call-with-output-file 或 call-with-input-file 自动执行关闭操作（具体取决于数据流的方向）。这些过程通过提供一个执行实际数据传输的函数来工作。下面是一些使用这种方法的示例。

> (call-with-output-file "data/SomeData.txt"
    #:exists 'truncate
    (λ (out-port)
      (display "Data line1\n" out-port)
      (display "Data line2\n" out-port)
      (display "Data line3\n" out-port)
      (display "Data line4\n" out-port)))

> (call-with-input-file "data/SomeData.txt"
    (λ (in-port)
      (let loop()
        (let ([data (read-line in-port)])
          (unless (eof-object? data)
            (displayln data)
            (loop))))))
Data line1
Data line2
Data line3
Data line4

我们将在本章稍后部分更详细地探讨文件端口。

字符串端口

端口可以与字符串一起打开。当你尝试构建一个字符串时，这会非常方便，因为字符串的不同部分将在过程中的不同时间被附加。我们将在第十章中通过构建代数表达式的字符串表示来充分利用字符串端口。这里提供了一些简单的例子：

> (define str-port (open-output-string))
> (display "Hello "   str-port)
  (display "there, " str-port)
  (display "amigo!"   str-port)
> (get-output-string str-port)
"Hello there, amigo!"

与文件端口不同，字符串端口不需要显式关闭。

计算机对计算机端口

端口可以设置以允许两台计算机相互通信。这种类型的通信使用 TCP/IP 协议。为了建立连接，第一台计算机（称为服务器）通过tcp-listen命令将自己设置为监听者。此命令接受一个无符号整数作为端口号（这是一个 TCP/IP 端口号）。请注意，Racket 端口与端口号指定的 TCP 端口是不同的实体。然后，服务器调用tcp-accept，该命令返回两个值——一个输入端口和一个输出端口——以便两台计算机之间进行双向通信。以下会话演示了设置服务器并等待来自客户端计算机的查询。

计算机 1 – 服务器

> (define comp1 (tcp-listen 999))
  (define-values (comp1-in comp1-out) (tcp-accept comp1))
  (read-line comp1-in)
  (displayln "Got it, bro!\n" comp1-out)
  (close-input-port comp1-in) 
  (close-output-port comp1-out)
 "Hello there!"

字符串"Hello there!"从客户端发送。这是执行(read-line comp1-in)这一行后的结果，之后服务器响应"Got it, bro!"。

客户端通过使用tcp-connect建立通信连接。tcp-connect命令接受服务器计算机名称和服务器建立的端口号作为参数。然后，它通过输出端口发送(displayln "Hello there!\n" comp2-out)启动对话，并使用(read-line comp2-in)等待来自服务器的响应。

计算机 2 – 客户端

> (define-values (comp2-in comp2-out) (tcp-connect "Comp1Name" 999))
  (displayln "Hello there!\n" comp2-out)
  (flush-output comp2-out)
  (read-line comp2-in)
  (close-input-port comp2-in) 
  (close-output-port comp2-out)
"Got it, bro!"

这只是一个简单的示例；当然，在建立成功的计算机间通信通道时有许多细节。有关更多详细信息，请查阅 Racket 文档。

安全性简介

既然我们已经了解了端口的知识，接下来看看如何利用它们来增强我们的安全性。不，这不是计算机安全。在本节中，我们将探讨一种几乎每个人都感兴趣的安全性：金钱。特别地，我们将研究证券，如股票和债券。我们将要查看的具体数据是价格随时间的变化。有许多方式可以查看价格：单个公司的股票价格、行业或机构集团的平均价格，或是指数基金的价格。

表 6-1 列出了我们将要研究的各种实体。在本章的其余部分，我们将这些实体称为资产。符号列显示了用于查找价格信息的股票市场符号。类型列中条目的定义如下：

公司一个独立的公司。大多数这些应该是相对熟悉的。

指数一个市场指数——只是一个指标，而不是你实际投资的东西。道琼斯工业平均指数是由 30 家大型上市公司组成的加权平均数。标准普尔 500 指数（S&P 500）类似，但由 500 家大型上市公司组成。

指数基金 与指数不同，可以进行投资。指数基金通常由一些股票或债券的混合组成。Vanguard Total Bond Market 基金由长期和短期以及公司债券和政府债券的混合组成。指数基金的理念是，通过投资于多个机构来最小化风险，因为一个投资表现不佳时，其影响会在其他投资中得到缓解。

表 6-1：证券选集

名称	符号	类型
Amazon	AMZN	公司
Apple	AAPL	公司
Bank of America	BAC	公司
Dow Jones	^DJI	指数
ExxonMobil	XOM	公司
Ford	F	公司
Microsoft	MSFT	公司
S&P 500	^GSPC	指数
Vanguard Total Bond Market	VBMFX	指数基金

我们要检查的数据是从 Yahoo! Finance 网站下载的。数据格式为逗号分隔值（CSV）文件。这意味着文件中的每个值都由逗号分隔，每条记录占用一行。下面是一个包含 2007 年初几天道琼斯工业平均指数的文件示例（我们已将价格的小数位去掉，以防止列表超出页面）。

Date,Open,High,Low,Close,Adj Close,Volume
2007-01-03,12459.540,12580.349,12404.820,12474.519,12474.519,327200000
2007-01-04,12473.160,12510.410,12403.860,12480.690,12480.690,259060000
2007-01-05,12480.049,12480.129,12365.410,12398.009,12398.009,235220000

第一行简要描述了后续各行中的数据值。表 6-2 提供了更详细的描述。

表 6-2：CSV 文件格式

值	描述
Date	交易日期（年-月-日）
Open	市场开盘时的价格
High	当日最高交易价格
Low	当日最低交易价格
Close	市场关闭时的价格
Adj Close	调整后的收盘价
Volume	当日交易量

调整后的收盘价反映了基于股息或股票拆分的任何调整（“拆分”一词意味着，如果你拥有一股售价为 100 美元的股票，那么拆分后你将拥有两股，每股 50 美元）。

将数据导入 Racket

第一个任务是将 CSV 数据转化为在 Racket 中有用的形式。我们将使用一个hist结构来存储 CSV 文件中的单条记录数据。该结构具有以下形式。

(struct hist (date open high low close adj-close vol)
  #:transparent)

字段名称无需额外解释。

以下函数将接受一个文件端口并返回一个hist结构，结构内填充了当前导入记录中的数据值（文件中的下一行未读取行），每个价格条目都会被转换为数字值。

(define (import-record port)
  (let ([rec (read-line port)])
    (if (eof-object? rec)
        eof
     ➊ (match (string-split rec ",")
      ➋ [(list date open high low close adj-close vol)
       ➌ (hist date
                (string->number open)
                (string->number high)
                (string->number low)
                (string->number close)
                (string->number adj-close)
                (string->number vol))]
       ➍ [_ (error "Failed to load record.")]))))

在这里，我们有机会使用 Racket 的另一个隐藏宝藏——模式匹配。模式匹配使用match形式 ➊（包含在racket/match库中，别担心；这个库会自动包含在racket库中）。

match表达式看起来有点像cond表达式，但我们不需要使用复杂的布尔表达式，而是简单地提供我们要匹配的数据结构。可以使用多种不同的结构作为匹配模式，包括字面值，但在本练习中，我们将仅使用一个列表➋。拆分后的rec值被绑定到标识符date、open等。如果找到匹配项，则返回一个hist结构➌。单个下划线（_）充当通配符，匹配任何内容➍（例如，如果拆分列表中的值数量与绑定列表中的项数不匹配，则会引发error异常）。在此基础上，以下代码读取一些值（在接下来的代码片段中，读者应将以StockHistory/开头的路径替换为自己的数据路径）：

> (define in-port 
    (open-input-file "StockHistory/Daily/XOM.csv"))
> (import-record in-port)
(hist "Date" #f #f #f #f #f #f)

> (import-record in-port)
(hist "1980-01-02" 3.445313 3.453125 3.351563 3.367188 0.692578 6622400)

> (import-record in-port)
(hist "1980-01-03" 3.320313 3.320313 3.25 3.28125 0.674902 7222400)

> (close-input-port in-port)

生成的第一个hist结构包含错误值，因为 CSV 文件第一行的头部字符串无法通过import-record转换为数字。

为了显示的目的，我们通常希望统一格式化历史记录，将每个值以字符串形式右对齐并具有一定的精度。以下函数执行此操作：

(define (format-rec rec width prec)
  (match rec
    [(hist date open high low close adj-close vol)
     (hist date
           (~r open #:min-width width  #:precision (list '= prec))
           (~r high #:min-width width  #:precision (list '= prec))
           (~r low #:min-width width  #:precision (list '= prec))
           (~r close #:min-width width  #:precision (list '= prec))
           (~r adj-close #:min-width width  #:precision (list '= prec))
           (~r vol #:min-width 9 ))]))

width参数指定每个值的整体宽度，prec参数指定精度。将此函数应用于 ExxonMobil 数据的前几行，结果如下：

> (define in-port 
    (open-input-file "StockHistory/Daily/XOM.csv"))
> (import-record in-port)
(hist "Date" #f #f #f #f #f #f)

> (format-rec (import-record in-port) 6 2)
(hist "1980-01-02" "  3.45" "  3.45" "  3.35" "  3.37" "  0.69" "  6622400")

> (format-rec (import-record in-port) 6 2)
(hist "1980-01-03" "  3.32" "  3.32" "  3.25" "  3.28" "  0.67" "  7222400")

> (close-input-port in-port)

请注意，由于数字格式化为两位小数时宽度小于六个字符，因此一些输出值使用了空格进行填充。

由于我们有时需要以表格形式显示数据，因此我们将利用text-table包。不幸的是，这个包并未包含在默认的 Racket 安装中，因此需要通过 Racket 的包管理器或raco命令行工具进行安装（有关如何安装包的示例，请参见第二章的infix部分）。一旦安装了text-table包，以下命令必须包含在定义文件中或在交互窗口中执行：

(require text-table)

text-table包定义了table->string函数，该函数接受一个列表的列表，每个子列表表示表中的一行。以下是它的一个简单使用示例。

> (define data '((a b c) (1 2 3) (4 5 6)))
> (display (table->string data))
+-+-+-+
|a|b|c|
+-+-+-+
|1|2|3|
+-+-+-+
|4|5|6|
+-+-+-+

我们将查询的数据具有类似于图 6-1 所示的文件结构。这些文件包含 1980 年至 2016 年底（如果有的话）之间的记录（每个记录代表一天、一个月或一周）。

图 6-1：股票历史文件结构

以下代码将在给定股票符号和时间周期（“每日”，“每月”或“每周”——每个周期的文件存储在相应的文件夹中）时显示股票历史记录的行。此外，必须指定一个过滤器。过滤器是一个接受hist结构并根据搜索内容返回#t或#f的函数。

(define (show sym period filter)
  (let ([in-port (open-input-file
      (build-path "StockHistory" period (string-append sym ".csv")))])
    (read-line in-port) ; skip past header row
 ➊ (let* ([recs
         (reverse
         ➋ (let loop([rec-list '()])
           ➌ (let ([rec (import-record in-port)])
                (if (eof-object? rec)
                    rec-list
                 ➍ (if (filter rec)
                     ➎ (let* ([rec (format-rec rec 8 2)]
                               [rec (list (hist-date rec)
                                          (hist-high rec)
                                          (hist-low rec)
                                          (hist-close rec))])                          
                       ➏ (loop (cons rec rec-list)))
                     ➐ (loop rec-list))))))]
       ➑ [tbl-list (cons (list "   Date" "  High" "  Low" "  Close") recs)])
      (close-input-port in-port)
   ➒ (display (table->string tbl-list)))))

一旦输入文件被打开并且我们跳过了标题行，代码行(let* ([recs ➊绑定了两个变量：recs和tbl-list ➑。请注意，recs用于初始化tbl-list ➑，它仅仅为recs中包含的数据添加了一个标题。然后生成最终输出 ➒。

在代码的主体部分，我们设置了一个名为loop ➋的函数，用于递归提取输入文件中的数据（在此之前的reverse是必需的，因为递归调用会反向构建数据）。请注意，rec-list初始化为空列表。标识符rec ➌被填充为输入文件中的一行记录。一旦文件末尾被达到，我们将输出编译后的rec-list，但在此之前，我们使用过滤器搜索符合条件的记录 ➍。当找到这样的记录时，我们使用之前定义的format-rec代码 ➎将rec的本地版本绑定。由于我们在let*形式中，因此我们将在下一行绑定一个新的本地版本的rec，并从导入的记录中提取数据。完成此操作后，我们将其添加到之前导入的数据中 ➏，并递归调用loop。如果过滤器的条件不符合，我们只需触发读取导入文件中的下一行数据，并保留现有数据 ➐。

让我们来看一下 2008 年，当时金融部门开始出现严重问题。（substring函数用于从日期字段中提取年份，并仅显示年份等于 2008 的记录。）

> (show "^DJI" "Monthly"
        (λ (rec) (equal? (substring (hist-date rec) 0 4) "2008")))

+----------+--------+--------+--------+
|   Date   |  High  |  Low   |  Close |
+----------+--------+--------+--------+
|2008-01-01|13279.54|11634.82|12650.36|
+----------+--------+--------+--------+
|2008-02-01|12767.74|12069.47|12266.39|
+----------+--------+--------+--------+
|2008-03-01|12622.07|11731.60|12262.89|
+----------+--------+--------+--------+
|2008-04-01|13010.00|12266.47|12820.13|
+----------+--------+--------+--------+
|2008-05-01|13136.69|12442.59|12638.32|
+----------+--------+--------+--------+
|2008-06-01|12638.08|11287.56|11350.01|
+----------+--------+--------+--------+
|2008-07-01|11698.17|10827.71|11378.02|
+----------+--------+--------+--------+
|2008-08-01|11867.11|11221.53|11543.96|
+----------+--------+--------+--------+
|2008-09-01|11790.17|10365.45|10850.66|
+----------+--------+--------+--------+
|2008-10-01|10882.52| 7882.51| 9325.01|
+----------+--------+--------+--------+
|2008-11-01| 9653.95| 7449.38| 8829.04|
+----------+--------+--------+--------+
|2008-12-01| 9026.41| 8118.50| 8776.39|
+----------+--------+--------+--------+

在那一年，道琼斯指数从 1 月的 13,279.54 点跌至 11 月的 7,449.38 点。下跌幅度达到 5,380 点，或 44%的跌幅！

一年前，微软的股票平均价格约为每股$30，但在 2008 年几次跌破$19。我们来看一下那时发生了什么。

> (show "MSFT" "Daily"
     (λ (rec) (and
                     (< (hist-close rec) 19)
                     (equal? (substring (hist-date rec) 0 4) "2008"))))

+----------+--------+--------+--------+
|   Date   |  High  |  Low   |  Close |
+----------+--------+--------+--------+
|2008-11-19|   19.95|   18.25|   18.29|
+----------+--------+--------+--------+
|2008-11-20|   18.84|   17.50|   17.53|
+----------+--------+--------+--------+
|2008-12-01|   19.95|   18.60|   18.61|
+----------+--------+--------+--------+
|2008-12-29|   19.21|   18.64|   18.96|
+----------+--------+--------+--------+

数据库绕行

本节是完全可选的，因为本章的其余部分不依赖于这里介绍的思想。但我们确实想要介绍一些随机文件访问的信息，这在各种场景中可能会很有用。随机文件访问是高效数据查询的关键组件。特别是，随机文件访问是任何数据库中的一个关键组件。数据库主要是一个预定义的表格集合，每个表可能包含多个记录。到目前为止，为了在一个表中找到特定的记录，我们需要逐条扫描文件，直到找到所需的条目。平均而言，必须检查一半的记录，在最坏的情况下，所有记录都要检查。这显然不是很高效。

通常，我们是在查找特定日期，而记录是按日期顺序排列的，这表明可能适用二分查找（如果你不知道什么是二分查找，稍后我们会详细介绍）；但是有一个问题。在 CSV 文件中，记录是以可变长度的字符数打包在一起的，因此无法通过不从文件开头逐行读取的方式准确定位到特定记录。关键是为每条记录分配固定大小的槽，每个槽的大小足以容纳最大的记录。为方便起见，我们将定义以下函数：

(define (file-info sym period)
  (let ([port (open-input-file
          (build-path "StockHistory" period (string-append sym ".csv")))]
        [recs 0]
        [max-size 0])
    (let loop ()
      (let ([rec (read-line port)])
        (unless (eof-object? rec)
          (let ([len (string-length rec)])
            (set! recs (add1 recs))
            (unless (<= len max-size)
              (set! max-size len)))
          (loop))))
    (close-input-port port)
    (values recs max-size)))

这个函数扫描输入文件，以确定文件中的记录数量和最大记录大小。

利用 file-info 返回的信息，我们可以构建一个适当格式的数据文件。这个文件保留第一个槽来存放 file-info 返回的信息，因为这在我们实际搜索文件时会非常有用。其余槽将通过使用 file-position 函数设置位置来填充源文件中的值（通过调用 display）。记录末尾的未使用空间将填充零（0）字节。为了实际创建文件，我们定义了一个名为 csv->db 的函数：

(define (csv->db sym period)
  (let*-values ([(recs max-size) (file-info sym period)]
      [(in-port) (open-input-file
        (build-path "StockHistory" period (string-append sym ".csv")))]
   ➊ [(out-port) (open-output-file
       (build-path "StockHistory" period (string-append sym ".db"))
         #:exists 'truncate)]
      [(slot-size) (+ 10 max-size)])
 ➋ (file-position out-port (* recs slot-size))
 ➌ (display (make-string slot-size #\space) out-port)
    (file-position out-port 0)
 ➍ (display recs out-port)
    (display "," out-port)
 ➎ (displayln slot-size out-port)
    (read-line in-port) ; read past header
    (for ([ i (in-range 1 recs)])
      (let ([rec (read-line in-port)]
            [pos (* i slot-size)])
     ➏ (file-position out-port pos)
     ➐ (displayln rec out-port)))
    (close-input-port in-port)
    (close-output-port out-port)
    ))

这个函数会在与源文件相同的文件夹中创建一个数据文件，文件名相同，只是输出文件 ➊ 的扩展名为 .db，而不是 .csv。接下来，我们将文件位置设置到文件末尾 ➋ 并写入一个虚拟记录 ➌。这个步骤是为了提高效率，防止操作系统每次写入记录时都不断扩展文件大小。我们将记录数量和槽大小写入文件的第一条记录 ➍ ➎。然后，对于输入文件中的每条记录，我们设置输出文件指针 ➏ 并写出记录 ➐。

通过这样创建了一个可搜索的数据文件后，我们现在可以创建一个例程，执行二分查找以高效地找到特定日期的记录。（有关二分查找的更详细信息，请参阅维基百科文章： http://en.wikipedia.org/wiki/Binary_search_algorithm 。）

 (define (bin-search sym period date)
➊ (let* ([port (open-input-file
          (build-path "StockHistory" period (string-append sym ".db")))]
      [info (string-split (read-line port) ",")]
      [recs (string->number (first info))]
      [slot-size (string->number (second info))]
      [min 1]
   ➋ [max recs])

 ➌ (define (get-date rec)
      (substring rec 0 10))

 ➍ (define (get-rec i)
      (file-position port (* slot-size i))
      (read-line port))

    (let loop ()
   ➎ (if (> min max)
          (begin
            (close-input-port port)
            #f)
       ➎ (let* ([i (floor (/ (+ min max) 2))]
                 [rec (get-rec i)]
                 [d (get-date rec)])
            (cond [(string<? d date)
                ➏ (set! min (add1 i))
                   (loop)]
                  [(string>? d date)
                ➐ (set! max (sub1 i))
                   (loop)]
                  [else
                   (close-input-port port)
                ➑ rec]))))))

首先，我们执行一些基本的初始化 ➊ ➋。打开输入文件后，我们读取第一条记录（其中包含记录数和槽大小），并将 recs 和 slot-size 绑定到相应的值。接下来，我们定义几个辅助函数，以简化检索当前记录数据的过程 ➌ ➍。其余代码是二分查找常规的直观实现，主要部分由一个循环组成（通过递归函数 loop）。搜索首先通过测试是否还有记录待检查 ➎。如果 (> min max) 为真，则表示所有记录都已检查过且未找到匹配项，因此函数返回 #f。接下来，我们将文件中间元素的日期与目标日期进行比较 ➏。如果目标日期与中间元素匹配，则返回当前记录 ➑。如果目标日期小于或大于当前元素的日期，则通过根据需要重置 min ➏ 和 max ➐ 来缩小文件范围，继续进行搜索。

我们通过首先使用以下内容创建一个可搜索的微软股票价格数据文件来测试我们的创建：

> (csv->db "MSFT" "Daily")

如果我们接下来想要检索 1992 年 3 月 13 日的股票价格记录，我们可以这样做：

> (bin-search "MSFT" "Daily" "1992-03-13")
"1992-03-13,2.552083,2.562500,2.510417,2.520833,1.674268,36761600"

Microsoft 文件有 7,768 条记录。平均而言，线性搜索需要检查 3,884 条记录。二分查找的最坏情况性能由以下公式给出，其中 t 是需要执行的检查次数，n 是记录的数量：

t = ⌊log2⌋

这意味着搜索微软数据只需要进行以下检查。检查 12 条记录远比检查 3,884 条要好得多。

数据可视化

一张图片胜过千言万语，呃…千字。到目前为止，我们一直在查看数据。现在我们想要查看信息。两者的区别在于：数据只是数字、日期和字符串的原始集合；而信息则说明这些事物如何相互关联。仅仅浏览数字列表并不会提供太多对其含义的洞察，但往往一个视觉化的表现能够带来顿悟。考虑到这一点，我们转向数据可视化的主题。在本节中，我们将从两个不同的角度来看待财务数据：随时间变化的价值和通过直方图的频率分析。

为确保我们拥有所需的一切，我们从以下定义开始。

#lang racket
(require plot)
(require text-table)

(define (data-path symbol period)
  (build-path "StockHistory" period (string-append symbol ".csv")))

(struct hist (date open high low close adj-close vol)
  #:transparent)

(define symbols '("^DJI" "^GSPC" "AAPL" "AMZN"
                         "BAC" "F" "MSFT" "VBMFX" "XOM"))

(define symbol-color
  (make-hash
   (list
    (cons "^DJI" "black")
    (cons "^GSPC" "gray")
    (cons "AAPL" "black")
    (cons "AMZN" "gray")
    (cons "BAC" "purple")
    (cons "F" "orange")
    (cons "MSFT" "blue")
    (cons "VBMFX" "black")
    (cons "XOM" "gray")
    )))

(define symbol-style
  (make-hash
   (list
    (cons "^DJI" 'solid)
    (cons "^GSPC" 'solid)
    (cons "AAPL" 'dot)
    (cons "AMZN" 'dot)
    (cons "BAC" 'dot-dash)
    (cons "F" 'solid)
    (cons "MSFT" 'long-dash)
    (cons "VBMFX" 'short-dash)
    (cons "XOM" 'short-dash)
    )))

其中大部分应该不言自明。提醒一下，text-table 包并不是默认的 Racket 设置的一部分（更多信息请参见第 150 页的“将数据导入 Racket”）。我们使用 data-path 来避免在各种函数体内硬编码文件路径。为了区分图表上的多个资产，它们在 symbol-color 中被分配了独特的颜色，在 symbol-style 中分配了线条样式。

我们将再次使用 import-record，如下所示。

(define (import-record port)
  (let ([rec (read-line port)])
    (if (eof-object? rec)
        eof
        (match (string-split rec ",")
          [(list date open high low close adj-close vol)
           (hist date
                 (string->number open)
                 (string->number high)
                 (string->number low)
                 (string->number close)
                 (string->number adj-close)
                 (string->number vol))]
          [_ (error "Failed to load record.")]))))

虽然这个函数提取了记录中的所有内容，但在本章剩余部分，我们将主要关注日期和收盘价。

由于我们将绘制随时间变化的值，我们需要将每个记录中的日期字符串转换为数值。我们可以通过以下向量和函数来完成：

(define month-days
  #(0 0 31 59.25 90.25 120.25 151.25 181.25
      212.25 243.25 273.25 304.25 334.25))

(define (date->number d)
  (match (string-split d "-")
    [(list year month day)
     (let ([year (string->number year)]
           [month (string->number month)]
           [day (string->number day)])
       (exact->inexact (+ year
                          (/ (vector-ref month-days month) 365.25)
                          (/ (sub1 day) 365.25))))]))

month-days 向量提供了年份中每个月第一天经过的天数（月份编号是索引；例如，二月的索引是 2）。例如，索引为 2 的条目是 31，表示 2 月 1 日已经过去了 31 天。2 月之后的月份有额外的四分之一天来考虑闰年。日期转换发生在 date->number 函数中，年份构成日期的整数部分，而月份和日期则提供小数部分。2 月可能有 28 天或 29 天的问题通过近似值来处理，这对于我们的目的应该足够。

成功绘图

正如你在第四章中看到的，Racket 通过使用 lines 形式来绘制一系列线段，该形式以一个向量列表作为参数。每个向量指定了一个线段的 x（日期）和 y（收盘价）坐标。为了构建这个列表，我们使用 get-coords 函数：

(define (get-coords symbol period filter normalize)
  (let ([in-port (open-input-file (data-path symbol period))]
        [start-price #f])
    (read-line in-port)
    (let* ([recs
      (reverse
        (let loop([rec-list '()])
          (let ([rec (import-record in-port)])
            (if (eof-object? rec)
               rec-list
               (if (filter rec)
                 (let ([date-val (date->number (hist-date rec))]
                     [close (hist-close rec)])
                   (unless start-price (set! start-price close))
                   (let ([val 
                  ➊ (if normalize (/ close start-price) close)])
                     (loop 
                       (cons (vector date-val val) rec-list))))
                 (loop rec-list))))))])
      (close-input-port in-port)
      recs)))

与其他示例一样，这个函数接受股票符号、时间段类型和一个过滤函数作为参数。由于我们正在检查的资产可能有很大的价值差异，为了能在同一图表上显示它们，我们提供了通过额外参数规范化值的功能。这意味着我们不会绘制实际的值，而是绘制时间段内第一个值与实际值的比率 ➊。这样，所有资产的起始值都是 1，但我们仍然可以看到它们随时间变化的相对值。稍后通过几个示例会更加清晰。

执行绘图的例程非常简单。

(define (plot-symbols symbols period filter
                      [normalize #f]
                      [anchor 'top-left]
                      [y-min #f]
                      [y-max #f])
  (let* ([plot-data
          (for/list ([symbol symbols])
            (let ([color (hash-ref symbol-color symbol)]
                  [style (hash-ref symbol-style symbol)])
              (lines (get-coords symbol period filter normalize)
                     #:label symbol
                     #:width 1.5
                     #:color color
                     #:style style)))]
         [ymin (if (and normalize (not y-min)) 0.0 y-min)]
         [ymax (if (and normalize (not y-max)) 2.0 y-max)])
    (parameterize
        ([plot-width 400]
         [plot-height 250]
         [plot-x-label "Year"]
         [plot-y-label #f]
         [plot-legend-anchor anchor])
      (plot plot-data
            #:y-min ymin
            #:y-max ymax))))

这次，我们为它提供了一组股票符号（以允许同时绘制多个资产），一个时间段类型，以及一个过滤函数作为参数。我们还可以选择是否使用可选的 normalize 参数来规范化数据，默认为 #f。由于绘制的值几乎可以出现在图表的任何部分，我们允许用户通过可选的 anchor 参数指定图例的位置。此外，我们还允许用户覆盖 y 值的默认范围。

由于我们主要会绘制某个年份或日期范围的数据，我们将定义几个函数工厂，通过指定我们感兴趣的日期范围来创建查询函数。

(define (year-range y1 y2)
  (λ (rec) 
    (string<=? y1 (substring (hist-date rec) 0 4)
               y2)))

(define (date-range d1 d2)
  (λ (rec) 
    (string<=? d1 (substring (hist-date rec) 0 10)
               d2)))

在确定了先决条件后，我们准备生成一些图表。让我们从绘制 2007 年和 2008 年的道琼斯数据开始（见图 6-2）。

> (plot-symbols '("^DJI") "Daily"
                (year-range "2007" "2008")
                #f 'bottom-left)

图 6-2：道琼斯 2007–2008 年每日收盘价

现在我们可以实际看到 2008 年 10 月发生的急剧下跌了。接下来，让我们看看其他一些机构的表现如何（见图 6-3）。

> (plot-symbols '("^DJI" "^GSPC" "AAPL" "VBMFX") "Daily"
                (year-range "2007" "2008")
                #f 'bottom-left)

图 6-3：多个日度收盘价格

不幸的是，道琼斯指数的数字太大，它已经淹没了其他所有指标。现在让我们来看一下当我们对数字进行标准化时会发生什么（见图 6-4）。

> (plot-symbols '("^DJI" "^GSPC" "AAPL" "VBMFX") "Daily"
                (year-range "2007" "2008")
                #t 'bottom-left)

图 6-4：标准化的日度收盘价格

很明显，道琼斯指数和标准普尔 500 指数整体市场走势非常接近。苹果的走势则波动较大。债券基金在这场混乱中保持稳定。

我们学到了什么？嗯，基于几个图表做出太多假设是愚蠢的。不过，至少在这个时间段内，债券几乎没有波动，整个市场（由标准普尔 500 指数和道琼斯指数代表）有些波动，但不如苹果股价波动那么大。

让我们从更长远的角度来看一下，看看图 6-5 展现了什么。

> (plot-symbols '("^GSPC" "AAPL" "XOM") "Monthly"
                (year-range "1981" "2016")
                #t 'top-left 0 20)

图 6-5：1981-2016 年月度收盘价格

所以大约在 2005 年左右，苹果股价突破了图表（稍后会详细讲解）。让我们更详细地研究一下埃克森美孚。由于这是一个标准化的图表，我们看到的是价格的相对差异；这意味着在 2016 年底，埃克森美孚的股票大约是 1981 年初价格的 18 倍。听起来很多，但真的是这样吗？我们可以通过使用复利公式来大致了解这代表的年平均回报率：

在这个公式中，V 是当前价值，P 是初始本金，i 是年利率，n 是每年的复利周期数（我们假设为按月复利，因此这里是 12），t 是周期数（所以 nt 是 12 乘以年份数）。我们想要知道年利率 i，所以经过一点代数运算（我们不在此赘述细节），得到这个公式：

以下函数将为我们计算这个值：

(define (int-rate v p t)
  (let ([n 12.0])
    (* n (- (expt (/ v p) (/ 1 (* n t))) 1))))

因此，在 35 年的时间里，投资 1 美元在埃克森美孚股票上将获得的利率是……

> (int-rate 18 1 35)
0.08286686131778254

或者约 8%，考虑到埃克森美孚也每季度支付股息，这无疑让投资回报更具吸引力。

那么那匹狂野的独角兽——苹果呢？让我们稍微调整一下范围，看看会发生什么。

> (plot-symbols '("^GSPC" "AAPL" "XOM") "Monthly"
                (year-range "1981" "2016")
                #t 'top-left 0 300)

图 6-6：月度收盘价格最高达 300 美元

哇，1981 年投资的一美元（经过长时间的低迷期）到 2016 年底将值约 225 美元。谁能想到？让我们看看实际的利率是多少。

> (int-rate 225 1 35)
0.15574778848870174

几乎 16%——不错吧。苹果是一个好的投资吗？嗯，任何（诚实的）财务顾问都会反复告诉你这一点：过去的表现并不能保证未来的结果。

将事物合并在一起

除了苹果的投资回报率（ROI）令人瞠目结舌外，还有一点特别突出：它的股价波动非常大。让我们来看一下 2008 年事情变得疯狂之前，埃克森美孚和苹果的股价（参见图 6-7）。

> (plot-symbols '("AAPL" "XOM") "Daily"
                (date-range "2007-01-01" "2008-09-30")
                #t 'top-left 0.5 2.5)

图 6-7：苹果与埃克森美孚在崩盘前的情况

很明显，即使是在这段短暂的时间内，苹果从一天到另一天的股价也很难预测。如果某人对股票的具体数值不感兴趣，而是对其波动性更感兴趣，一种可视化波动性的方法是使用直方图。直方图通过显示数据值如何分布在某些区间中来表示数据。我们将这些区间称为箱子。为了帮助我们的分析，我们将每个直方图与一个表格一起展示，表格中显示每个箱子的数值范围和各箱子中的数值数量。

首先，我们定义一个函数，它根据股票符号、时间段、过滤函数和相应的hist结构字段提取投资的特定数据字段。

(define (get-data symbol period filter field)
  (let ([in-port (open-input-file (data-path symbol period))])
    (read-line in-port)
    (let* ([recs
            (reverse
             (let loop([rec-list '()])
               (let ([rec (import-record in-port)])
                 (if (eof-object? rec)
                     rec-list
                     (if (filter rec)
                         (loop (cons (field rec) rec-list))
                         (loop rec-list))))))])
      (close-input-port in-port)
      recs)))

例如，如果我们想要查看 1999 年微软（对微软来说是一个相当不错的年份）在每月数据中的最大股价，我们可以通过以下方式获取：

> (get-data "MSFT" "Monthly"
                (year-range "1999" "1999")
                hist-close)
'(43.75 37.53125 44.8125 40.65625 40.34375 45.09375 42.90625 46.28125 45.28125
      46.28125 45.523399 58.375)

以下函数会汇总数据（数值列表）并将正确数量的值填入箱子中。

(define (categorize data avg num-bins)
  (let* ([bin (make-vector num-bins 0)]
         [bin-min (* 0.4 avg)]
         [bin-max (* 1.6 avg)]
         [bin-delta (/ (- bin-max bin-min) num-bins)])
    (define (update-bin val)
      (when (<= bin-min val bin-max)
        (let ([i (inexact->exact (floor (/ (- val bin-min) bin-delta)))])
          (vector-set! bin i (add1 (vector-ref bin i))))))
    (let loop ([val-list data])
      (unless (null? val-list)
        (update-bin (car val-list))
        (loop (cdr val-list))))
    (values bin-min bin-max
            (for/list ([i (in-range num-bins)])
              (vector i (vector-ref bin i))))))

该函数首先设置一个整体值范围，这个范围低于平均值 60%并且高于平均值 60%。在这个范围内，数据值将被汇总到bin向量中。在处理的最后，函数返回这些箱子的最小值和最大值范围，以及bin中包含的分类值。bin中的每个向量包含箱子索引和箱子中的数据值数量（它必须以这种方式格式化才能与 Racket 的discrete-histogram函数一起使用）。

为了以表格形式显示数据，我们定义了bin-table，它将显示箱子索引、箱子的数值范围以及每个箱子中的数据数量。

(define (bin-table bins bin-min bin-max)
  (let* ([num-bins (length bins)]
         [bin-delta (/ (- bin-max bin-min) num-bins)]
         [rows
          (for/list ([i (in-range num-bins)]
                     [bin bins])
            (let ([bmin (+ bin-min (* bin-delta i))]
                  [bmax (+ bin-min (* bin-delta (add1 i)))]
                  [count (vector-ref bin 1)])
              (list
               (~r i #:min-width 3)
               (~r bmin #:min-width 8  #:precision (list '= 2))
               (~r bmax #:min-width 8  #:precision (list '= 2))
               (~r count #:min-width 4))))])
    (table->string (cons '("Bin" "   Min" "   Max" "Vals") rows))))

在我们打好基础后，创建一个函数来生成输出是相当简单的。

(define (histogram-symbol symbol period filter [bins 11])
  (let*-values ([(data) (get-data symbol period filter hist-close)]
                [(avg) (/ (apply + data) (length data))]
                [(bin-min bin-max hist-data) (categorize data avg bins)])
    (displayln (bin-table hist-data bin-min bin-max))
    (parameterize
        ([plot-width 400]
         [plot-height 250]
         [plot-x-label #f]
         [plot-y-label "Frequency"])
      (plot (discrete-histogram hist-data)))))

让我们看看这对苹果和埃克森美孚告诉了我们什么（参见图 6-8 和图 6-9）。

> (histogram-symbol "AAPL" "Daily" (date-range "2007-01-01" "2008-09-30"))
+---+--------+--------+----+
|Bin|   Min  |   Max  |Vals|
+---+--------+--------+----+
|  0|    8.06|   10.25|   0|
+---+--------+--------+----+
|  1|   10.25|   12.45|  30|
+---+--------+--------+----+
|  2|   12.45|   14.65|  55|
+---+--------+--------+----+
|  3|   14.65|   16.85|  20|
+---+--------+--------+----+
|  4|   16.85|   19.04|  87|
+---+--------+--------+----+
|  5|   19.04|   21.24|  54|
+---+--------+--------+----+
|  6|   21.24|   23.44|  46|
+---+--------+--------+----+
|  7|   23.44|   25.64|  81|
+---+--------+--------+----+
|  8|   25.64|   27.83|  61|
+---+--------+--------+----+
|  9|   27.83|   30.03|   6|
+---+--------+--------+----+
| 10|   30.03|   32.23|   0|
+---+--------+--------+----+

图 6-8：苹果直方图

> (histogram-symbol "XOM" "Daily" (date-range "2007-01-01" "2008-09-30"))

+---+--------+--------+----+
|Bin|   Min  |   Max  |Vals|
+---+--------+--------+----+
|  0|   33.65|   42.83|   0|
+---+--------+--------+----+
|  1|   42.83|   52.00|   0|
+---+--------+--------+----+
|  2|   52.00|   61.18|   0|
+---+--------+--------+----+
|  3|   61.18|   70.36|   4|
+---+--------+--------+----+
|  4|   70.36|   79.54| 106|
+---+--------+--------+----+
|  5|   79.54|   88.71| 210|
+---+--------+--------+----+
|  6|   88.71|   97.89| 120|
+---+--------+--------+----+
|  7|   97.89|  107.07|   0|
+---+--------+--------+----+
|  8|  107.07|  116.25|   0|
+---+--------+--------+----+
|  9|  116.25|  125.42|   0|
+---+--------+--------+----+
| 10|  125.42|  134.60|   0|
+---+--------+--------+----+

图 6-9：埃克森美孚直方图

从直方图可以清楚地看出，苹果的数据值在同一时间段内比埃克森美孚的数据值分布范围更广。这种更高的波动性是苹果投资者为可能获得更大回报而付出的代价。

一点统计学

我们在上一节中展示了这样一个老生常谈的道理：一张图片胜过千言万语，这至少在分析投资数据时是有一定道理的。但同样正确的是，一个数字也至少值得上一张图片。到目前为止，我们的分析主要是定性的，我们使用了多种技巧来可视化我们的数据。现在我们转向一些广泛用于定量分析的标准统计工具。

标准差

在上一节中，我们使用直方图来了解某一时间段内股价的分布情况。这类信息可以用一个数字来总结，这个数字就是标准差。对于一组给定的数字，标准差表示个别数字偏离该组数据总体平均值的程度。你可以将它视为偏差的平均值。标准差的定义如下公式：

在这个公式中，n是数据值的数量，希腊字母 mu（μ）表示所有数据值的均值或平均值，x[i]表示单个数据值。

与标准差密切相关的统计概念是方差，它实际上是标准差的平方：

我们稍后会看到，方差在回归分析中非常有用，回归分析旨在确定数据的趋势。

我们将标准差公式封装到一个 Racket 函数中，如下所示：

(define (std-deviation nums)
  (let* ([n (length nums)]
         [mu (/ (apply + nums) n)]
         [sqr-diff (map (λ (x) (sqr (- x mu))) nums)])
    (sqrt (/ (apply + sqr-diff) n))))

现在我们可以计算数值，从而分析不同资产的偏差。让我们来看一下我们生成的直方图数据。

> (define apple (get-data "AAPL" "Daily" (date-range "2007-01-01" "2008-09-30"
    ) hist-close))
> (define xom (get-data "XOM" "Daily" (date-range "2007-01-01" "2008-09-30")
    hist-close))

> (std-deviation apple)
4.811932439819516

> (std-deviation xom)
6.399636764602135

这似乎表明苹果的偏差实际上小于埃克森美孚。这时，数据的正确解释至关重要。直方图数据向我们展示了数据在±60%的平均值范围内的分布情况。为了更好地理解偏差数据，我们来计算一下这些股票的平均值。

> (define apple-avg (/ (apply + apple) (length apple)))
> apple-avg
20.143350647727257

> (define xom-avg (/ (apply + xom) (length xom)))
> xom-avg
84.12513634318191

> (/ (std-deviation apple) apple-avg)
0.23888441024395504

> (/ (std-deviation xom) xom-avg)
0.07607282487478317

从中我们可以看出，在那段时间内，苹果的价格偏离其平均价格大约 24%，而埃克森美孚仅偏离约 7.5%。

虽然我们在这里严格地看的是收盘价的标准差，但这不是通常在金融领域评估偏差的方式。更为关注的是收益的偏差。一个年回报率稳定为 10%的股票显然会有一些价格偏差，但根据收益来看的话，它几乎没有偏差。另一个需要考虑的因素是，单纯的股价变化并不一定能反映出收益，因为股息（对于那些支付股息的股票）也会影响结果。

回归分析

在我们对各种金融资产的分析中，我们提到过“过去的表现不能保证未来的结果”这句格言，这是正确的，但过去的表现可能暗示未来的结果。给定一组不同的数据点，常常需要确定它们是否暗示着某种趋势。名为 回归分析 的统计工具旨在做出这种判断。回归分析将一条直线拟合到一组数据点（由于我们只是将数据拟合到直线，这技术上称为 线性回归），其中 x 称为 独立预测变量 或 预测变量，y 称为 依赖响应。期望的结果是这个回归或预测直线：

y = a + bx

其思想是，给定这条直线和某个 x 值，我们可以计算出 y 的估计值。a 和 b 参数的定义方式是最小化 y 数据值与回归线之间的总距离。具体而言，如果 (x[i], y[i]) 是实际的数据点，我们让 ŷ[i] = a + bx[i]（这是 x[i] 处的 y 估计值），在这种情况下，回归分析的目标是最小化以下公式所给出的 平方和误差：

如果是所有 x 值的均值，或平均值，而是所有 y 值的均值，那么可以证明，回归线的 a 和 b 参数由以下公式给出：

看似复杂的方程（6.1）实际上是两个更简单公式的比率：x 和 y 的 协方差 以及 x 的方差。我们已经看到，x 的方差由以下公式给出：

x 和 y 的协方差由以下公式给出：

协方差是衡量两个随机变量联合变化的度量（在我们的案例中是 x[i] 和 y[i]）。我们利用这两个方程的略微调整形式，以及其他一些方程，来开发一种方法，确定我们的回归线在多大程度上真实地拟合数据。

我们可以看到，SS[xx] 只是的略微调整版本，而 SS[xy] 同样是 Cov(x, y) 的调整版本。最后一个方程，平方和回归，表示的是估计的 ŷ 从 y 值的均值到回归线的距离的平方和（最小化这个距离的回归线将给出最佳的拟合数据）。我们在方程（6.1）中看到，回归线的斜率由以下公式给出：

但是也可以证明：

最后一方程称为平方相关或决定系数。这个数值在 0 和 1 之间变化。值为 1 表示数据点完全拟合回归线，值为 0 表示没有任何相关性。

回归线的参数可以通过以下 Racket 函数计算：

(define (regression-params data)
  (define (x v) (vector-ref v 0))
  (define (y v) (vector-ref v 1))
  (let* ([num (length data)] 
         [totx (apply + (map x data))]
         [toty (apply + (map y data))]
         [avgx (/ totx num)]
         [avgy (/ toty num)]
         [ss-xy (apply + (map (λ (v) (* (- (x v) avgx) (- (y v) avgy))) data))]
         [ss-xx (apply + (map (λ (v) (sqr (- (x v) avgx))) data))]
         [b (/ ss-xy ss-xx)]
         [a (- avgy (* b avgx))])
    (values a b)))

这是对方程（6.1）和（6.2）的直接改编。让我们看看这对在 2008 年金融危机期间陷入下行漩涡的美国银行有什么启示。

> (define bac (get-coords "BAC" "Monthly"
                          (date-range "2007-07-01" "2009-02-01")
                          #f))

> (regression-params bac)
54422.310899480566
-27.082265190974677

第二个值是回归线的斜率，它表示在那个时期，平均每年损失 27 美元（相当于 2007 年 7 月其价值的一半）。哎呀。

我们现在定义一个绘图例程，接受单一资产符号，但绘制数据点而不是线条，并包括相应的回归线。

(define (plot-regression symbol period filter
                         [anchor 'top-left])
  (let* ([coords (get-coords symbol period filter #f)]
         [plot-data 
          (let ([color (hash-ref symbol-color symbol)])
            (points coords #:label symbol #:color color))])
    (let-values ([(a b) (regression-params coords)])
      (parameterize 
          ([plot-width 400]
           [plot-height 250]
           [plot-x-label "Year"]
           [plot-y-label #f]
           [plot-legend-anchor anchor])
        (plot (list
               plot-data
               (function (λ (x) (+ (* b x) a))
                         #:color "black" #:label "Regr")))))))

我们可以在图 6-10 中详细查看美国银行的困境。

> (plot-regression "BAC" "Monthly"
                (date-range "2007-07-01" "2009-02-01")
                'bottom-left)

图 6-10：美国银行数据上的回归线

为了确定回归线与数据的拟合程度，我们定义一个correlation函数：

(define (correlation data)
  (define (x v) (vector-ref v 0))
  (define (y v) (vector-ref v 1))
  (let* ([num (length data)] 
         [totx (apply + (map x data))]
         [toty (apply + (map y data))]
         [avgx (/ totx num)]
         [avgy (/ toty num)]
         [ss-xx (apply + (map (λ (v) (sqr (- (x v) avgx))) data))]         
         [ss-yy (apply + (map (λ (v) (sqr (- (y v) avgy))) data))]
         [ss-xy (apply + (map (λ (v) (* (- (x v) avgx) (- (y v) avgy))) data))]
         [b (/ ss-xy ss-xx)]
         [a (- avgy (* b avgx))]
         [ssr (apply + (map (λ (v) (sqr (- (+ (* b (x v)) a) avgy))) data))])
    (/ ssr ss-yy)))

这也是对上述R²定义的直接实现。通过这个，我们可以测试美国银行最小二乘回归线与数据的拟合情况。

> (define bac (get-coords "BAC" "Monthly"
                          (date-range "2007-07-01" "2009-02-01")
                          #f))
> (correlation bac)
0.8799353920116734

这表示拟合得相当不错。但在许多情况下，数据并不能很好地与直线拟合。例如，如果我们包括恢复阶段的开始，最终得到的图像就像图 6-11 中所示。

> (plot-regression "BAC" "Monthly"
                   (year-range "2008" "2009")
                   'bottom-left)

图 6-11：拟合不好的回归线

这表示一定程度的相关性，但不如之前的拟合效果好：

> (define bac (get-coords "BAC" "Monthly"
                          (year-range "2008" "2009")
                          #f))

> (correlation bac)
0.6064135484684874

总结

在本章中，我们探讨了使用 Racket 和 DrRacket 访问和分析数据的各种方法。我们首先介绍了如何将数据导入和导出到 Racket 端口的机制。一旦掌握了这一技术，我们就利用它来查看证券数据，即原始历史股市数据。接着，我们稍微绕了一下，探索了使用随机文件访问的二分查找。在定义了访问和解析股市数据的机制之后，我们又通过各种可视化技术来分析数据的定性方法。最后，我们鼓起勇气引入了一些数学内容，使我们能够进行一些统计量化分析。

接下来，我们将看到如何使用一些复杂的搜索算法来解决一些经典的 recreational mathematics（娱乐数学）问题。

第七章：寻找答案

对于我们到目前为止遇到的所有问题，都有一种直接的方法来计算解决方案。但情况并不总是如此。对于许多问题，我们必须使用某种算法来搜索解决方案，例如在解决数独谜题或n皇后问题时。在这些情况下，过程涉及尝试一系列步骤，直到我们找到解决方案，或者必须回退到上一步尝试另一条路径。本章中，我们将探索一些算法，帮助我们高效选择一条通向解决方案的路径。这种方法被称为启发式。通常，启发式算法不能保证找到解决方案，但我们在这里探索的算法（幸运的是）是可以的。

图论

我们试图解决的问题往往可以用图来建模。直观地说，图只是一些点（或节点）和连接这些点的线条，如图 7-1 所示。每个节点表示问题解决过程中的某个状态，从一个节点延伸到其他节点的线条表示可能的替代步骤。在深入实际问题解决算法之前，我们首先介绍一些基本的图的定义作为背景。

基础知识

从正式定义来看，图是一个有限集合 V 的顶点（或节点），以及一个集合 E 的边，连接不同的顶点对（见图 7-1）。

图 7-1: 图

在上面的图 7-1 中，V = {a, b, c, d, e} 是顶点，E = {(a, b), (a, c), (b, c), (c, d), (b, e), (e, d)} 是边。

一系列图的顶点（v[1], v[2], …, v[n]），使得存在一条边连接 v[i] 和 v[i+1]，称为路径。如果所有顶点都不相同，则路径称为简单路径。如果路径中所有顶点都不相同，除了 v[1] = v[n] 外，则称为循环或回路。在图 7-1 中，序列（a, b, c, b）是一个路径，序列（a, b, c, d）是一个简单路径，序列（a, b, c, a）是一个循环。

一个图，如果从每个顶点到其他所有顶点都有路径，则称为连通图。一个没有循环的连通图称为树。在树中，任何路径都假定从上层节点流向下层节点。这样的结构（没有循环，并且从一个节点到另一个节点只有一条路径）称为有向无环图（DAG）。通过移除一些边，可以将上面的图转换为树，如图 7-2 所示。

图 7-2: 树

如果节点x和y以某种方式连接，使得从x到y是可能的，那么y被称为x的子节点。没有子节点的节点（如a、c和d）被称为终端（或叶子）节点。通过树结构建模并能得到解的问题通常采用更简单的搜索策略，因为树没有回路。搜索有回路的图需要跟踪已经访问过的节点，以避免重新探索相同的节点。

可以为图的每一条边标记一个叫做权重的数值，如图 7-3 所示。这种类型的图叫做加权图。

图 7-3：加权图

如果e是一个边，那么该边的权重由w(e)表示。权重可以用来表示许多测量值，如时间、成本或距离，这些因素可能在搜索图时影响边的选择。

在探索图的属性时，会提出许多有趣的问题。一个这样的问题是：“给定任意两个节点，如何找到它们之间的最短路径？”另一个问题是著名的旅行商问题：“给定一系列城市及其之间的距离，如何找到一条最短路径，能够访问每个城市一次，并返回到原始城市？”最后一个问题，其中每个节点被访问一次并返回到原始节点，涉及到所谓的哈密顿回路。

图搜索

搜索图的策略大致分为两类：广度优先搜索（BFS）和深度优先搜索（DFS）。为了说明这些概念，我们将使用图 7-2 中的树。

广度优先搜索

广度优先搜索涉及通过完全探索每个层级（或深度）后再进入下一个层级的方式来搜索图。在树状图中（如图 7-2 所示），e（根）节点位于第一层，节点b和d位于下一层，节点a和c位于第三层。这通常涉及使用队列来暂存待检查的节点。过程从将根节点推送到队列开始，如图 7-4 所示：

图 7-4：包含根节点的队列

然后我们弹出队列中的第一个节点（e），并检查它是否是目标节点；如果不是，我们将其子节点推送到队列中，如图 7-5 所示：

图 7-5：节点 e 被探索后的队列

我们再次从队列中弹出第一个节点（这次是b），并检查它是否是目标节点；如果不是，我们将其子节点推送到队列中，如图 7-6 所示：

图 7-6：节点 b 被探索后的队列

我们继续以这种方式进行，直到找到目标节点，或者队列为空，在这种情况下说明没有解。

深度优先搜索

深度优先搜索通过不断沿树的一个分支走下去，直到找到目标节点或到达终端节点。例如，从树的根节点开始，依次检查节点e、b和a。如果这些节点都不是目标节点，我们回溯到节点b，并检查它的下一个子节点c。如果c也不是目标节点，我们回溯到节点e，并检查它的下一个子节点d。下一节的n-皇后问题提供了一个使用深度优先搜索的简单例子。

N皇后问题

n-皇后问题是一个经典问题，经常用来说明深度优先搜索。问题是这样的：在一个n乘n的棋盘上放置n个皇后，使得没有一个皇后会被其他皇后攻击。如果你不熟悉国际象棋，皇后可以攻击位于同一行、同一列或对角线上的任意格子，如图 7-7 所示。

图 7-7：皇后的可能移动

存在解的最小n值是 4。两个可能的解法如图 7-8 所示。

图 7-8：4 皇后问题的解法

这个问题受欢迎的一个原因是它的搜索图是树形的，这意味着通过深度优先搜索，不会再次到达之前已经见过的状态（也就是说，一旦皇后被放置，就无法在后续步骤中回到一个皇后更少的状态）。这避免了需要跟踪之前的状态，确保它们不会被重复探索的麻烦。

解决这个问题的一个简单方法是逐列检查，每次测试一列中的每个格子，直到找到解决方案（需要时进行回溯）。例如，如果我们从图 7-9 开始，无法将皇后放置在 b1 或 b2，因为它们会被 a1 位置的皇后攻击。

图 7-9：第一个皇后放置在 a1

下一个未被攻击的格子是 b3，结果如图 7-10 所示：

图 7-10：第二个皇后放置在 b3

但现在当我们到达 c 列时，卡住了，因为该列的每个格子都被其他皇后攻击了。所以我们回溯并将 b 列的皇后移到 b4，见图 7-11：

图 7-11：第二个皇后放置在 b4

所以现在我们可以在图 7-12 中将皇后放置在 c2：

图 7-12：第三个皇后放置在 c2

唉，现在 d 列没有位置可以放置皇后了。所以我们回溯到 a 列，重新开始，如图 7-13 所示。

图 7-13：回溯到第一个皇后位置 a2

这个过程继续进行，直到找到解决方案。

一个 Racket 解决方案

我们将棋盘定义为一个n乘n的数组，由一个包含n个元素的可变向量构成，每个元素也是一个包含n个元素的向量，其中每个元素是 1 或 0（0 表示该位置未被占据；1 表示该位置有一个皇后）：

(define (make-chessboard n)
  (let loop ([v n] [l '()])
    (if (zero? v)
        (list->vector l)
        (loop (sub1 v) (cons (make-vector n 0) l)))))

为了通过行（r）和列（c）编号访问棋盘cb的元素，我们定义了以下访问器形式，其中v是要设置或检索的值。

(define (cb-set! cb r c v)
  (vector-set! (vector-ref cb c) r v))

(define (cb-ref cb r c)
  (vector-ref (vector-ref cb c) r))

由于我们使用的是一个可变的数据结构来表示棋盘，因此每当找到一个解时，我们需要一种机制来复制棋盘，以保持棋盘的状态。

(define (cb-copy cb)
  (for/vector ([v cb]) (vector-copy v)))

当然，我们需要能够查看解，因此我们提供了一个打印过程：

(define (cb-print cb)
  (let ([n (vector-length cb)])
    (for* ([r n]
           [c n])
      (when (zero? c) (newline))
      (let ([v (cb-ref cb r c)])
        (if (zero? v)
            (display " .")
            (display " Q")
            ))))
  (newline))

解决问题的实际代码dfs是一个简单的深度优先搜索。当解被找到时，它们会被编译成一个名为sols的列表，这是函数的返回值。在下面的代码中，回想一下，在let loop形式中，我们使用了一个命名的let（我们在第三章中描述过），我们在其中定义了一个函数（loop），我们将递归调用它。

(define (dfs n)
  (let ([sols '()]
        [cb (make-chessboard n)])
    (let loop([r 0][c 0])
      (when (< c n)
     ➊ (let ([valid (not (attacked cb r c))])
          (when valid
         ➋ (cb-set! cb r c 1)
         ➌ (if (= c (sub1 n))
              (let ([copy (cb-copy cb)])
             ➍ (set! sols (cons copy sols)))
           ➎ (loop 0 (add1 c)))
         ➏ (cb-set! cb r c 0))
       ➐ (when (< (add1 r) n) (loop (add1 r) c)))))
 ➑ sols))

代码首先测试每个位置，看看当前单元格是否被已经放置的任何皇后攻击➊（attacked的代码稍后会描述）；如果没有，那么该单元格标记为valid，并在该位置放置一个皇后（数字 1）➋。接下来，我们测试当前单元格是否位于棋盘的最后一列➌；如果是，那么我们找到了解，复制棋盘并将其放入sols ➍。如果我们不在最后一列，我们就继续进入下一层（即下一列）➎。最后，清除有效的单元格➏，以便可以测试列中的其他行➐。一旦所有解都被找到，它们会被返回➑。

在这个过程中，DFS 回溯发生的位置有些微妙。假设我们处于一个被之前放置的皇后攻击的位置，因此valid ➊为假，执行会跳到➐。现在假设我们还在最后一行。在这种情况下，测试失败➐，因此不会再进行循环，递归调用返回。要么没有后续语句，在这种情况下整个循环退出，要么在从递归调用返回后有额外的语句需要执行。这只能在当前位置被清除且我们回到先前的位置➏时发生。这就是回溯点。然后，执行会在最后的when语句➐处恢复。

以下函数测试一个位置是否受到任何已经放置的皇后的攻击。它仅检查当前列之前的列，因为棋盘的其他列尚未填充。

(define (attacked cb r c)
  (let ([n (vector-length cb)])
    (let loop ([ac (sub1 c)])
      (if (< ac 0) #f
          (let ([r1 (+ r (- c ac))]
                [r2 (+ r (- ac c))])
            (if (or (= 1 (cb-ref cb r ac))
                    (and (< r1 n) (= 1 (cb-ref cb r1 ac)))
                    (and (>= r2 0) (= 1 (cb-ref cb r2 ac))))
                #t
                (loop (sub1 ac))))))))

为了输出解，我们定义了一个简单的例程来迭代并打印dfs返回的每一个解。

(define (solve n)
  (for ([cb (dfs n)]) (cb-print cb)))

下面是几个测试运行。

> (solve 4)

 . Q . .
 . . . Q
 Q . . .
 . . Q .
 . . Q .
 Q . . .
 . . . Q
 . Q . .

> (solve 5)

 . . Q . .   . . . Q .  . . . . Q   . Q . . .   . . . . Q
 . . . . Q   . Q . . .  . Q . . .   . . . . Q   . . Q . .
 . Q . . .   . . . . Q  . . . Q .   . . Q . .   Q . . . .
 . . . Q .   . . Q . .  Q . . . .   Q . . . .   . . . Q .
 Q . . . .   Q . . . .  . . Q . .   . . . Q .   . Q . . .

 . Q . . .   . . . Q .   . . Q . .   Q . . . .  Q . . . .
 . . . Q .   Q . . . .   Q . . . .   . . Q . .  . . . Q .
 Q . . . .   . . Q . .   . . . Q .   . . . . Q  . Q . . .
 . . Q . .   . . . . Q   . Q . . .   . Q . . .  . . . . Q
 . . . . Q   . Q . . .   . . . . Q   . . . Q .  . . Q . .

> (solve 8)

 . . Q . . . . .
 . . . . . Q . .
 . . . Q . . . .
 . Q . . . . . .
 . . . . . . . Q
 . . . . Q . . .
 . . . . . . Q .
 Q . . . . . . .

<intermediate solutions omitted>

 Q . . . . . . .
 . . . . . . Q .
 . . . . Q . . .
 . . . . . . . Q
 . Q . . . . . .
 . . . Q . . . .
 . . . . . Q . .
 . . Q . . . . .

Dijkstra 的最短路径算法

给定一个图，其中一个节点被指定为起始节点，Edsger Dijkstra 的算法用于找到到其他任何节点的最短路径。该算法首先将所有节点（除了起始节点，它的距离为零）赋予无穷大的距离值。随着算法的进行，节点的距离会逐步调整，直到能够确定其真实距离。

我们将使用图 7-3 中介绍的加权图来说明 Dijkstra 算法（其中 S 是起始节点）。我们描述的算法将使用一种名为优先队列的数据结构。优先队列类似于常规队列，但在优先队列中，每个项都有一个关联值，称为优先级，这决定了它在队列中的顺序。与普通队列的先进先出顺序不同，优先级较高的项将排在其他项之前。由于我们关心的是找到最短路径，因此较短的距离将被赋予比较长的距离更高的优先级。

图 7-14 中的下图展示了算法的起始条件。

图 7-14：从 S 找到最短路径的起始条件

从起始节点到各节点的距离值显示在节点圆圈外面。尚未访问的节点被赋予无穷大的暂定距离值（起始节点的距离值为零）。队列中显示的是带有距离值的节点，距离值由指数表示。

第一步是从队列中弹出第一个节点（该节点将始终具有已知的距离），并将其以浅色背景标记，如图 7-15 所示。将此节点设置为当前节点，u（在这种情况下，u = S，距离值为零）。

图 7-15：Dijkstra 算法的步骤 1

u 的邻居节点用更深的颜色标记。然后，我们对队列中仍然存在的每个 u 的邻居（标记为 v）执行以下的暂定距离计算 t，其中 d(u) 是从起始节点到 u 的已知距离，l(u, v) 是从 u 到 v 的边的距离值：

如果 t 小于先前的距离值（最初为 ∞），则队列会更新为新的节点距离。

在队列更新后，我们重复这个过程，这次将 c 从队列中弹出，使其成为当前节点（换句话说，u = c），并像之前一样更新队列和邻居节点的距离。此时图的状态如图 7-16 所示：

图 7-16：Dijkstra 算法的步骤 2

我们用一条较粗的灰线显示从 S 到 c 的路径，以表示在图 7-16 中已知的最短路径。图 7-17 中的一系列图示展示了其余的过程。请注意，在图 7-17a 中，节点 a 的原始距离已从 12 更新为 9，原因是当前路径是从 S 通过 b 到 a。在 7-17d 中，最终图中粗线条所形成的树形结构反映了所有从节点 S 出发到其余节点的最短路径。

图 7-17：Dijkstra 算法的其余部分

我们通常关心的是算法的执行效率。这通常通过一个复杂度值来指定。有很多种方式可以做到这一点，但一种常见的表述方式叫做大 O 符号（O 代表“阶”（Order））。这种符号旨在给出算法执行效率的粗略估算（在运行时间或内存使用方面），并且基于输入的规模。Dijkstra 算法的运行时间复杂度是 O(N²)，其中 N 是图中节点的数量。这意味着运行时间随着输入数量的平方增长。换句话说，如果我们将节点数加倍，算法的运行时间大约会变为原来的四倍。这被视为一个上界或最坏情况，并且根据图的性质，运行时间可能会更少。

优先队列

正如我们在上面的分析中所看到的，优先队列在 Dijkstra 算法中起着关键作用。优先队列可以通过多种方式实现，但一种流行的方法是使用称为二叉堆的结构。二叉堆是一种二叉树结构（意味着每个节点最多有两个子节点），其中每个节点的值大于或等于其子节点的值。这种类型的堆叫做最大堆。也可以让每个父节点小于或等于其子节点的值，这种类型的堆叫做最小堆。这种堆的示例如图 7-18 所示。根节点或顶部节点总是第一个被移除，因为它被认为具有最高优先级。在向堆中添加或移除节点后，剩余的节点会重新排列以维持正确的优先顺序。虽然构建二叉堆对象并不是特别困难，但 Racket 中已经有一个可用的二叉堆，它在 data/heap 库中。

图 7-18：最小堆

我们的堆条目不仅仅是数字：我们需要跟踪节点及其当前的距离值（这决定了它的优先级）。因此，每个堆条目将由一对元素组成，其中第一个元素是节点，第二个元素是当前距离。当构建一个 Racket 堆时，必须提供一个函数，用来在给定两个节点条目时执行正确的比较。我们通过以下代码来实现这一点。comp函数只比较每对中的第二个元素，因为那才是决定优先级的关键。

#lang racket
(require data/heap)

(define (comp n1 n2)
  (let ([d1 (cdr n1)]
        [d2 (cdr n2)])
    (<= d1 d2)))

(define queue (make-heap comp))

为了减少一些输入工作，我们创建了几个简单的辅助函数。

(define (enqueue n) (heap-add! queue n))

(define (dequeue)
  (let ([n (heap-min queue)])
    (heap-remove-min! queue)
    n))

(define (update-priority s p)
  (let ([q (for/first ([x (in-heap queue)] #:when (equal? s (car x))) x)])
    (heap-remove! queue q)
    (enqueue (cons s p))))

(define (peek-queue) (heap-min queue))

(define (queue->list) (for/list ([n (in-heap queue)]) n))

(define (in-queue? s)
  (for/or ([x (in-heap queue)]) (equal? (car x) s)))

update-priority过程接受一个符号和一个新的优先级来更新队列。它通过删除（出队）旧值并添加（入队）新值来完成此操作。heap-remove!函数的执行非常高效，但它需要确切的值（符号和优先级的配对）才能工作。不幸的是，在不知道优先级的情况下，我们必须通过in-heap序列进行线性搜索，查找符号。这可以通过将符号和当前优先级存储在另一种数据结构中（如哈希表）来优化。如果读者愿意，可以进行这个附加步骤。

以下是优先队列实际操作的一些示例。

> (enqueue '(a . 12))
> (enqueue '(b . 8))
> (enqueue '(c . 6))
> (queue->list)
'((c . 6) (b . 8) (a . 12))

> (in-queue? 'b)
#t

> (in-queue? 'x)
#f

> (update-priority 'a 9)
> (queue->list)
'((c . 6) (b . 8) (a . 9))

> (dequeue)
'(c . 6)

> (queue->list)
'((b . 8) (a . 9))

> (peek-queue)
'(b . 8)

无论值添加到队列的顺序如何，它们都会按优先级顺序存储和移除。

实现

我们将图定义为一个边的列表。列表中的每条边由端节点和节点之间的距离组成。

(define edge-list
  '((S a 12)
    (S b 8)
    (S c 6)
    (a b 1)
    (b c 9)
    (a e 8)
    (e d 5)
    (b d 10)
    (c d 13)))

随着算法的推进，我们希望跟踪每个节点的当前父节点，以便算法完成后，我们能够重现到达每个节点的最短路径。一个哈希表将用于维护这些信息。键是节点名，值是父节点的名称。

(define parent (make-hash))

我们在编码时需要小心，牢记我们的图是双向的，一个由(a, b)定义的边与由(b, a)定义的边是等价的。我们通过补充原始边列表，加入一个由反向节点构成的列表来考虑这一点。我们还将使用一个哈希表（lengths）来维护每条边的长度，并使用另一个哈希表（dist）来记录到达每个节点的最短距离，一旦发现该节点。为了整合这些内容，我们定义了init-graph，它接受一个边列表并返回一个附加了反向节点列表的原始列表。它还将用于初始化优先队列和各个哈希表。

(define lengths (make-hash))
(define dist (make-hash))

(define (init-graph start-node edges)
  (let* ([INFINITY 9999]
         [swapped (map (λ (e) (list (second e) (first e) (third e))) edges)] 
         [all-edges (append edges swapped)]
         [nodes (list->set (map (λ (e) (first e)) all-edges))])
    (hash-clear! lengths)
    (for ([e all-edges]) (hash-set! lengths (cons (first e) (second e)) (third e)))
    (set! queue (make-heap comp))
    (hash-clear! parent)
    (hash-clear! dist)
    (for ([n nodes])
      (hash-set! parent n null)
      (hash-set! dist n INFINITY)
      (if (equal? n start-node)
          (enqueue (cons start-node 0))
          (enqueue (cons n INFINITY))))
    (hash-set! dist start-node 0)
    all-edges))

这是实际计算每个节点最短路径的代码，dijkstra。

(define (dijkstra start-node edges)
  (let ([graph (init-graph start-node edges)])
 ➊ (define (neighbors n)
      (filter
       (λ (e) (and (equal? n (first e)) (in-queue? (second e))))
       graph))
 ➋ (let loop ()
      (let* ([u (car (dequeue))])
        (for ([n (neighbors u)])
       ➌ (let* ([v (second n)]
              ➍ [t (+ (hash-ref dist u) (hash-ref lengths (cons u v)))])
    ➎ (when (< t (hash-ref dist v))
           ➏ (hash-set! dist v t)
           ➐ (hash-set! parent v u)
           ➑ (update-priority v t)))))
   ➒ (when (> (heap-count queue) 0) (loop)))))

dijkstra 代码将起始节点符号和边列表作为参数。接着，它定义了 graph，这是原始的边列表，并附加了一个节点交换后的边列表。如前所述，init-graph 程序还初始化了算法所需的所有其他数据结构。定义了一个局部的 neighbors 函数 ➊，它接受一个节点并返回与该节点相邻且仍在队列中的节点列表。主循环开始 ➋，第一步是弹出队列中的第一个节点，并将其符号赋值给 u。接着，处理它的每一个邻居（v） ➌。对于每个邻居，我们计算 t = d(u) + l(u, v) ➍（回想一下，d(u) 是从起始符号到 u 的当前最短距离估计，l(u, v) 是从 u 到 v 的边长）。然后我们测试是否 t < d(v) ➎，如果通过测试，我们执行以下操作：

将 d(v) = t ➏。
将 u 作为 v 的父节点 ➐。
更新队列，将 t 作为 v 的新优先级 ➑。

最后，我们测试堆中是否还剩值，如果有，则重复该过程 ➒。当算法完成时，parent 将包含每个节点的父节点。剩下的就是追踪父节点链到起始符号，以确定到该节点的最短路径。这是通过以下的 get-path 函数完成的：

(define (get-path n)
  (define (loop n)
    (if (equal? null n)
        null
        (let ([p (hash-ref parent n)])
          (cons n (loop p)))))
  (reverse (loop n)))

show-paths 程序将打印出所有节点的路径。

(define (show-paths)
  (for ([n (hash-keys parent)])
    (printf "  ~a: ~a\n" n (get-path n))))

为了方便起见，我们定义了 solve，它接收一个起始符号和边列表，调用 dijkstra 计算最短路径，并打印出到每个节点的最短路径。

(define (solve start-node edges)
  (dijkstra start-node edges)
  (displayln "Shortest path listing:")
  (show-paths))

给定我们在 edge-list 中定义的原始图以及起始符号 S，我们生成解决方案如下：

> (solve 'S edge-list)
Shortest path listing:
  S: (S)
  e: (S b a e)
  a: (S b a)
  d: (S b d)
  c: (S c)
  b: (S b)

让我们尝试在图 7-19 中展示的这个稍微更有挑战性的示例（参见 [4]）。

图 7-19: 测试 Dijkstra 算法的另一个图

这个图的边列表是 . . .

> (define edges '((v a 4) (v b 15) (v c 6) (a b 12) (b c 9) (b d 8) (a f 10) (
     c v 6) (c g 13) (g h 6) (h w 3) (a d 3) (d e 5) (b e 2) (e w 16) (b g 4)
     (g e 8) (e h 16) (e f 3) (f w 14)))

所以，求解最短路径时，我们得到了 . . .

> (solve 'v edges)
Shortest path listing:
  d: (v a d)
  w: (v a d e b g h w)
  f: (v a f)
  c: (v c)
  v: (v)
  a: (v a)
  e: (v a d e)
  g: (v a d e b g)
  h: (v a d e b g h)
  b: (v a d e b)

我们已经在结果图中突出显示了最短路径树（参见图 7-20）。

图 7-20: 找到的最短路径

现在我们已经彻底研究了 Dijkstra 最短路径算法，接下来我们将通过 Sam Loyd 的（不）著名的 14–15 拼图来看看 A* 算法。

15 拼图

15 拼图由 15 个按顺序编号的滑动拼图块组成，这些拼图块随机打乱，目标是将它们恢复到正确的数字顺序。在 19 世纪末，Sam Loyd 通过提供 1000 美元奖金，引起了人们对这个拼图的关注，奖金将奖励任何能够展示从一个已按顺序排列的拼图开始，只是 14 和 15 拼图块反转（如图 7-21 所示，Loyd 将这种排列称为“14-15 拼图”），并能将其恢复到正确顺序的人（当然不允许将拼图块从框架中取出）。正如我们将很快看到的那样，这是数学上不可能的，因此 Loyd 知道他的赌注是安全的。

图 7-21：Sam Loyd 的 14-15 拼图插图

为什么只交换两个拼图块是不可能的

为了理解为什么 Loyd 的钱是安全的（即为什么不可能只交换两个且仅仅交换两个拼图块），可以考虑图 7-22 所示的已解状态下的拼图。

图 7-22：已解的 15 拼图

任何能够交换 14 和 15 拼图块的移动序列都会得到 Loyd 拼图中的排列。仅仅重复这个序列就能将拼图块恢复到正确顺序。我们将看到这实际上是不可能的。现在考虑图 7-23 中的排列。

图 7-23：带有逆序的 15 拼图

如果我们将这些拼图块按顺序排列，得到 2, 3, 1, 4, 5, 6，……特别地，拼图块 2 和拼图块 3 的值大于其后面的拼图块 1。每当一个拼图块的值大于紧随其后的拼图块时，这种情况称为逆序（此情况下有两个逆序）。

与逆序的概念相关的是换位的概念。换位只是序列中两个值的交换。通过任意次数的换位，可以得到某一排列。例如，得到序列 2, 3, 1, 4, 5, 6，……的一种方式如下：

初始排列：1, 2, 3, 4, 5, 6，……
换位 1 和 3：3, 2, 1, 4, 5, 6，……
换位 2 和 3：2, 3, 1, 4, 5, 6，……

关键的思想是，包含偶数个逆序的排列总是通过偶数次换位产生的，而包含奇数个逆序的排列总是通过奇数次换位产生的。为了参考，空白位置将视为一个拼图块，并用数字 16 标示。任何拼图块 16 的单次移动都是一次换位。如果拼图块 16 从右下角离开并经过奇数次换位到达某个位置，则需要奇数次换位才能回到起始位置，或者净换位次数为偶数次。这样，拼图就会有偶数个逆序。

萨姆·洛伊德提出的排列是无法解决的，因为它涉及一个单一的奇数逆序。虽然证明起来更为复杂，但也可以证明，任何具有偶数逆序的谜题都是可以解决的。

解决了这个历史性问题——萨姆·洛伊德的难题后，我们现在将注意力转向那些实际上可以解决的谜题。在这方面，我们将探索 A* 搜索算法（我们以后通常简称为“A*算法”）。

A 搜索算法*

我们当然假设计算机提供的是一个可解的谜题（即它有偶数个逆序对）。计算机应提供一个尽可能高效的解决方案——也就是说，提供一个达到目标状态所需最少步数的解决方案。一种通常能提供良好结果的方法被称为 A 搜索算法。与简单的广度优先或深度优先搜索相比，A*算法的一个优势是，它使用一个 启发式^(1) 来减少搜索空间。它通过计算搜索树中任意给定分支的估算成本来实现这一点。它反复改进这一估算，直到确定最佳解决方案或确定无法找到解决方案为止。估算值存储在一个优先队列中，其中最小成本状态位于队列的头部。

我们将通过查看 15 数字拼图的一个较小变体——8 数字拼图来开始我们的分析。8 数字拼图在其已解决状态下如图 7-24 所示。

图 7-24：已解决的 8 数字拼图

8 数字拼图的搜索树可以如图 7-25 所示进行建模，其中树的每个节点代表拼图的一个状态，而子节点则是由有效移动产生的可能状态。

图 7-25：部分 8 数字拼图游戏树

在每次 A* 算法迭代中，它都会计算从当前状态到目标状态的成本估算（即所需步数）。形式上，它试图最小化以下估算成本函数，其中 n 是正在考虑的节点，g(n) 是从起始节点到 n 的路径成本，h(n) 是估算从 n 到目标的最便宜路径的启发式：

f(n) = g(n) + h(n)

设计一个好的启发式函数有些像是一门艺术。为了从 A* 算法中获得最佳性能，启发式的一个重要特性是，它满足图中每条边的以下条件，其中 h^(n*) 是到达目标状态的实际（但未知的）成本：

如果一个启发式满足此条件，则称其为 可接纳的，并且 A* 算法可以保证找到最优解。

一种可能的启发式方法是使用名为曼哈顿距离的计算方法（与常见的直线距离不同）。例如，要将图 7-25 中的瓦片-2 移到它的目标位置（即它在已解决状态中应占据的单元格），该瓦片需要先上移两格，再左移一格，总共需要三次移动——这就是曼哈顿距离。拼图状态的启发式值将是每个瓦片的曼哈顿距离之和。表 7-1 展示了图 7-25 根节点的这一值的计算。

表 7-1：计算曼哈顿距离

瓦片	行	列	总计
1	0	1	1
2	2	1	3
3	1	1	2
4	1	0	1
5	0	1	1
6	1	0	1
7	1	2	3
8	2	1	3
距离：	15

曼哈顿距离始终小于或等于实际的移动次数，因此它满足可接受性条件。

一种稍弱的启发式是汉明距离，即错位瓦片的数量。图 7-25 中显示的拼图的汉明距离是八：所有瓦片都没有放在它们的目标位置。

在图 7-26 中，我们为每个节点标注了三个值。第一个值是游戏树的深度（该值每经过一层递增 1，并构成成本公式中g(n)的值），第二个值是启发式值，h(n)，即节点的启发式值（在此案例中为曼哈顿距离），第三个值是前两个值之和，表示节点的整体成本分数。

图 7-26：带有节点成本的 8 拼图

A算法使用一个名为open的优先队列。这个队列根据估计的到达目标的成本，对已检查但其子节点尚未扩展的拼图状态进行排序。该算法还依赖于一个名为closed*的字典，该字典将拼图状态作为键，并维护该节点的最新成本值。图 7-27 反映了当前分析的状态，其中 open 队列中的第一个节点是图 7-26 的根节点。

图 7-27：已关闭和打开的节点

已关闭节点顶部显示的值是最新的估计成本。打开节点顶部显示的值是上面描述的三个成本值。通过这一介绍，我们将一步步演示 A*算法如何处理游戏树。

第一步是从开放队列中弹出优先级最低的值。然后，该节点被添加到闭合字典中。下一步是计算子节点的成本，这些节点显示在图 7-26 的第二层。如果这些节点中有任何一个不在闭合列表中，它们将直接加入到开放队列中，不需要进一步分析。注意，第一个子节点已经在闭合列表中。由于其当前的估计成本低于闭合列表中的成本，它被从闭合列表中移除，并以新的值重新加入队列。如果子节点已经在闭合列表中，但其估计值大于闭合列表中的值，则不做任何更改，也不将其添加到队列中。完成此阶段后，开放和闭合结构将如图 7-28 所示。

由于图 7-26 中的第一个子节点的成本低于开放队列中其他节点的成本，它被移到队列的头部，并成为下一个被弹出的项目。注意，它的第一个子节点已经在闭合列表中，但其新计算的成本高于闭合列表中的成本，因此被忽略。剩下的子节点将像以前一样进行处理。

图 7-28：闭合与开放，更新版

该过程将持续进行，直到发生以下两种情况之一：要么从开放队列中弹出的节点处于已解状态，在这种情况下算法完成并打印答案（有关如何完成此操作的详细信息将在下一节中描述）；要么开放队列变为空，表示拼图无法解决。

Racket 中的 8-拼图

我们将先实现一个针对较小的 3x3 版本的拼图的解决方案，然后再继续解决完整的 4x4 版本。

与 Dijkstra 算法类似，我们将使用 Racket 的堆对象来处理开放优先队列：

#lang racket
(require data/heap)

(define (comp n1 n2)
  (let ([d1 (cdr n1)]
        [d2 (cdr n2)])
    (<= d1 d2)))

(define queue (make-heap comp))

(define (enqueue n) (heap-add! queue n))

(define (dequeue)
  (let ([n (heap-min queue)])
    (heap-remove-min! queue)
    n))

一个SIZE常量将指定拼图的行列数。此外，我们还将定义一些实用函数来处理拼图结构。为了提高效率，拼图的状态将内部存储为一个大小为SIZE*SIZE+2的 Racket 向量。向量的最后两个元素将包含空白格的行和列。空白格将具有由(define empty (sqr SIZE))指定的数值。为此，我们有以下内容：

(define SIZE 3)
(define empty (sqr SIZE))

(define (ref puzzle r c)
  (let ([i (+ c (* r SIZE))])
    (vector-ref puzzle i)))

(define (empty-loc puzzle)
  (values
   (vector-ref puzzle empty)
   (vector-ref puzzle (add1 empty))))

ref函数将接受拼图以及行和列号作为参数。它返回该位置上的拼图块编号。empty-loc函数将返回两个值，分别表示空白格的行和列。

以下函数用于计算曼哈顿距离。第一个函数创建一个哈希表，用于根据拼图块的编号查找其家居位置。第二个函数计算拼图中每个块的曼哈顿距离之和。这将用于计算拼图节点的成本。

(define tile-homes
  (let ([hash (make-hash)])
    (for ([n (in-range (sqr SIZE))])
      (hash-set! hash (add1 n) (cons (quotient n SIZE) (remainder n SIZE))))
    hash))

(define (manhattan puzzle) 
  (let ([dist 0])
    (for* ([r SIZE] [c SIZE])
      (when (not (= empty (ref puzzle r c)))
        (let* ([t (hash-ref tile-homes (ref puzzle r c))]
               [tr (car t)]
               [tc (cdr t)])
          (set! dist (+ dist
                        (abs (- tr r))
                        (abs (- tc c)))))))
    dist))

以下函数用于根据移动说明生成新的谜题状态。移动说明是一个从零到三的数字，用于确定哪一个方向的方块可以移动到空白位置。

(define (move-offset i)
  (case i
    [(0) (values  0 -1)]
    [(1) (values  0  1)] 
    [(2) (values -1  0)] 
    [(3) (values  1  0)]))

(define (make-move puzzle i)
  (let*-values ([(ro co) (move-offset i)]
                [(re ce) (empty-loc puzzle)]
                [(rt ct) (values (+ re ro) (+ ce co))]
                [(t) (ref puzzle rt ct)])
    (for/vector ([i (in-range (+ 2 (sqr SIZE)))])
      (cond [(< i empty)
             (let-values ([(r c) (quotient/remainder i SIZE)])
               (cond [(and (= r re) (= c ce)) t]
                     [(and (= r rt) (= c ct)) empty]
                     [else (vector-ref puzzle i)]))]
            [(= i empty) rt]
            [else ct]))))

move-offset 函数接受一个移动说明，并返回两个值，指定执行该移动所需的行和列增量。make-move 函数接受一个移动说明，并返回一个新的向量，表示执行该移动后的谜题状态。

以下函数将接受一个谜题并返回一个列表，包含所有可以从特定谜题状态到达的有效谜题状态。局部的 legal 函数通过检查某个方向的移动是否会超出谜题的边界，来判断一个移动说明是否会导致当前谜题状态的有效移动。

(define (next-states puzzle)
  (let-values ([(re ce) (empty-loc puzzle)])
    (define (legal i)
      (let*-values ([(ro co) (move-offset i)]
                    [(rt ct) (values (+ re ro) (+ ce co))])
        (and (>= rt 0) (>= ct 0) (< rt SIZE) (< ct SIZE))))
    (for/list ([i (in-range 4)] #:when (legal i))
      (make-move puzzle i))))

当然，实际看到谜题的可视化表示会非常有用。以下程序提供了这个功能。

(define (print puzzle)
  (for* ([r SIZE] [c SIZE])
    (when (= 0 c) (printf "\n"))
    (let ([t (ref puzzle r c)])
      (if (= t empty)
          (printf "  ")
          (printf " ~a" t))))
  (printf "\n"))

接下来，我们定义一个辅助函数来处理关闭节点。

(define closed (make-hash))

(define (process-closed node-parent node node-depth score)
  (begin
 ➊ (hash-set! closed node (list node-parent score)) 
    (for ([child (next-states node)])
   ➋ (let* ([depth (add1 node-depth)]
          ➌ [next-score (+ depth (manhattan child))]
          ➍ [next (cons (list child depth node) next-score)])
        (if (hash-has-key? closed child)
         ➎ (let* ([prior-score (second (hash-ref closed child))])
           ➏ (when (< next-score prior-score)
                (hash-remove! closed child)
                (enqueue next)))
         ➐ (enqueue next))))))

我们首先将节点、其父节点及其估算成本放入 closed 表 ➊。接下来，我们生成可能的子谜题状态列表，并对其进行循环。对于每个子节点，我们生成新的节点深度 ➋ 和估算得分 ➌。然后我们汇总需要的信息，以便将该节点推入打开队列 ➍，如果该节点不在 closed 表中，推送操作会自动进行 ➐。如果该节点已经在 closed 表中，我们会提取其之前的成本得分 ➎ 并与当前得分 ➏ 进行比较。如果当前得分小于之前的得分，我们会将该节点从 closed 表中移除，并将其放入打开队列中。

最后，我们进入真正的算法部分。

(define (a-star puzzle)
  (let [(solved #f)]
    (hash-clear! closed)
 ➊ (set! queue (make-heap comp))  ; open
 ➋ (enqueue (cons (list puzzle 0 null) (manhattan puzzle)))
 ➌ (let loop ()
   ➍ (unless solved
        (let* ([node-info (dequeue)])
       ➎ (match node-info
            [(cons (list node node-depth node-parent) score)
          ➏ (if (= 0 (manhattan node))
                 (begin
                   (set! solved #t) 
                   (print-solution (solution-list node-parent (list node))))
             ➐ (process-closed node-parent node node-depth score)
                 )])
       ➑ (if (> (heap-count queue) 0)
              (loop)
           ➒ (unless solved(printf "No solution found\n"))))))))

首先，我们定义上述的 closed 哈希表。打开队列被初始化 ➊，并且提供给 a-star 程序的打乱谜题被推送到打开队列中 ➋。队列中的项由一个 Racket 对组成。对的 cdr 部分是估算的得分，而 car 部分由谜题状态、树的深度和父节点的谜题状态组成。初始化完成后，主循环开始 ➌。

循环会一直重复，直到 solved 变量被设为 true。循环的第一步是从打开队列中弹出优先级最高（成本得分最低）的项，并将其分配给 node-info 变量。使用 match 形式解析 node-info 中包含的值 ➎。首先测试谜题状态（在 node 中）是否已达到解决状态 ➏，如果是，函数会输出移动序列并终止过程。否则，处理继续，我们通过将节点、其父节点和估算成本放入 closed 表来处理关闭节点 ➐。

每次迭代完成后，会检查队列 ➑ 是否包含任何需要处理的节点。如果有，则下一次迭代继续进行 ➍；否则，表示没有解决方案，过程终止 ➒。

这是显示解法的打印函数。solution-list过程通过追溯closed中的父节点，生成一个从起始拼图到最终拼图的所有状态列表；print-solution则接受该解法列表并打印其中包含的拼图状态。

(define (solution-list n l)
  (if (equal? n null)
      l
      (let* ([parent (first (hash-ref closed n))])
        (solution-list parent (cons n l)))))

(define (print-solution l)
  (for ([p l]) (print p)))

下面是对图 7-25 中展示的谜题进行的测试运行（为了节省空间，输出谜题横向显示）。

> (a-star #(8 1 6 5 3 7 4 9 2 2 1))

 8 1 6  8 1 6  8 1 6    1 6  1   6  1 3 6  1 3 6
 5 3 7  5 3 7    3 7  8 3 7  8 3 7  8   7    8 7
 4   2    4 2  5 4 2  5 4 2  5 4 2  5 4 2  5 4 2

 1 3 6  1 3 6  1 3 6  1 3 6  1 3 6  1 3 6  1 3 6  
 5 8 7  5 8 7  5 8 7  5 8    5   8  5 2 8  5 2 8  
   4 2  4   2  4 2    4 2 7  4 2 7  4   7  4 7    

 1 3 6  1 3    1   3  1 2 3  1 2 3  1 2 3  1 2 3  
 5 2    5 2 6  5 2 6  5   6    5 6  4 5 6  4 5 6  
 4 7 8  4 7 8  4 7 8  4 7 8  4 7 8    7 8  7   8  

 1 2 3
 4 5 6
 7 8

上升到 15 拼图

在 8 拼图的基础上，15 拼图需要进行这个棘手的修改：将SIZE的值从 3 更改为 4。好吧，也许这并不算太棘手，但在你太兴奋之前，实际上这也并没有那么简单。观察图 7-29。前两个拼图来自[9]，我们的测试计算机轻松解决了这些问题。但第三个拼图是随机生成的，导致测试计算机崩溃，它自己在地板上咯咯笑，认为我们竟然让它解决如此复杂的问题——没有解答能够成功输出。

图 7-29：一些 15 拼图示例

问题在于，某些谜题可能导致 A*算法需要探索过多的路径，从而使计算机资源耗尽（或者用户在等待答案时耐心耗尽）。我们的解决方案是通过将问题分解成三个子问题，采取稍微不那么优雅的方法。我们将以牺牲完全优化的解法为代价，换取一个不需要等太久就能得到的解法。

为了将问题分解成子问题，我们将如图 7-30 所示将谜题划分为三个区域。这些区域的选择是为了利用 A*算法在 8 拼图上的高效性。

图 7-30：15 拼图分区

中灰色区域，我们指定为区域 1，表示一个子问题，白色区域（区域 2）将是第二个子问题，深灰色区域（区域 3）代表另一个子问题（相当于 8 拼图，我们知道它可以快速解决）。这个思路是为a-star算法提供不同的评分函数，具体取决于当前正在处理的区域。这些函数仍然会使用曼哈顿距离，但会应用一定的限制。一旦区域 1 和区域 2 被解决，我们就可以像以前一样调用manhattan，因为区域 1 和区域 2 中的边缘瓷砖已经到位，剩下的瓷砖将相当于一个 8 拼图。

区域 1

在开始解决区域 1 之前，我们将创建一个帮助函数，该函数与我们在manhattan函数中看到的代码非常相似：

(define (cost puzzle guard)
  (let ([dist 0])
    (for* ([r SIZE] [c SIZE])
      (let ([t (ref puzzle r c)])
        (when (guard r c t)
          (let* ([th (hash-ref tile-homes t)]
                 [hr (car th)]
                 [hc (cdr th)]
                 [d (+ (abs (- hr r)) (abs (- hc c)))])
            (set! dist (+ dist d))))))
    dist))

主要区别在于，替代直接在cost函数中嵌入空格测试，我们将传递一个用于guard参数的函数来为我们执行该测试。基于此，我们可以重新定义manhattan如下：

(define (manhattan puzzle)
  (cost puzzle (λ (r c t) 
                 (not (= t empty)))))

我们将分两阶段攻击区域 1：首先，我们将第 1 到第 4 个瓦片推入拼图的前两行；然后，我们将它们按照正确的顺序排列到第一行。

为了将瓦片 1 到 4 移入前两行，我们定义了zone1a。

(define (zone1a puzzle)
  (cost puzzle (λ (r c t)
                 (or (and (<= t 4) (> r 1))))))

在这种情况下，我们只更新第 1 到第 4 个瓦片的距离，并且只有在这些瓦片尚未位于前两行时，我们才更新其距离。

第二阶段稍有不同。这次我们始终更新第 1 到第 4 个瓦片的距离，以确保它们落到正确的位置。

(define (zone1b puzzle)
  (cost puzzle (λ (r c t)
                 (<= t 4))))

可能看起来这一切可以在一个函数中完成，但如果试图一次性将所有瓦片定位，则会导致一个巨大的搜索空间，并需要更多的时间和计算资源（例如内存）。我们的第一阶段，只是将瓦片放置到接近其正确位置的地方，就减少了搜索空间的一半，且不需要大量资源。第二阶段的排序通常只需要处理拼图上半部分的瓦片，因为剩余的瓦片得分为零。

区域 2

此时，我们已将搜索空间缩小了 25%。这种适度的减少足以让我们在一个过程中将瓦片 5、9 和 13 移入区域 2，并按正确顺序排列，我们在这里提供的过程就是zone2：

(define zone2-tiles (set 5 9 13))

(define (zone2 puzzle)
  (cost puzzle (λ (r c t)
                 (and (>= r 1)
                      (set-member? zone2-tiles t)))))

此时，我们不再需要关注第 1 行，正如代码中>= r 1所示。除此之外，代码几乎与其他代码相同，唯一不同的是这次我们使用在zone2-tiles中定义的值来进行评分。

将所有内容整合在一起

一旦一个区域被解决，我们就不希望干扰已经放置好的瓦片。为此，我们对生成可行状态列表的函数（next-states）做了一个轻微调整。之前，我们只是简单地检查是否没有超出第一行或列。现在，我们定义了全局变量min-r和min-c，它们会根据当前正在处理的区域设置为 0 或 1。

(define min-r 0)
(define min-c 0)

(define (next-states puzzle)
  (let-values ([(re ce) (empty-loc puzzle)])
    (define (legal i)
      (let*-values ([(ro co) (move-offset i)]
                    [(rt ct) (values (+ re ro) (+ ce co))])
        (and (>= rt min-r) (>= ct min-c) (< rt SIZE) (< ct SIZE))))
    (for/list ([i (in-range 4)] #:when (legal i))
      (make-move puzzle i))))

最终的求解器将在区域 1 和区域 2 填充完成后更新min-r和min-c的值。

现在，我们需要对a-star和process-closed的代码进行一些关键的修改。

(define (process-closed node-parent node node-depth score fscore)
  (begin
    (hash-set! closed node (list node-parent score)) 
    (for ([child (next-states node)])
      (let* ([depth (add1 node-depth)]
          ➊ [next-score (+ depth (fscore child))]
             [next (cons (list child depth node) next-score)])
        (if (hash-has-key? closed child)
            (let* ([prior-score (second (hash-ref closed child))])
              (when (< next-score prior-score)
                (hash-remove! closed child)
                (enqueue next)))
            (enqueue next))))))

最显著的变化是，之前我们一直使用manhattan来进行评分估计，而现在我们使用函数fscore ➊，它作为额外参数传递给process-closed。这个函数会根据正在解决的拼图区域的不同而有所不同。

(define (a-star puzzle fscore)
  (let ([solution null]
        [goal null])
    (hash-clear! closed)
    (set! queue (make-heap comp))  ; open
    (enqueue (cons (list puzzle 0 null) (fscore puzzle)))
    (let loop ()
      (when (equal? solution null)
        (let* ([node-info (dequeue)])
          (match node-info
            [(cons (list node node-depth node-parent) score)
             (if (= 0 (fscore node))
                 (begin
                ➊ (set! goal node)
                ➋ (set! solution (solution-list node-parent (list node))))
                 (process-closed node-parent node node-depth score fscore))])
          (if (> (heap-count queue) 0)
              (loop)
              (when (equal? solution null) (printf "No solution found\n"))))))
 ➌ (values goal solution)))

在这里，我们还包括了fscore作为一个额外的参数。现在，当目标状态达到时，我们不再立即打印出解决方案，而是返回两个值：第一个set! ➊中的当前目标和第二个set! ➋中的解决方案列表。剩余的代码应与原始版本保持一致。

我们不再像以前那样直接调用a-star，而是提供了一个solve函数，逐步执行并为a-star提供适当的评分函数，该函数可以是区域特定的函数之一，或是manhattan。

(define (solve puzzle)  
  (set! min-r 0)
  (set! min-c 0)
  (let*-values ([(goal sol-z1a) (a-star puzzle zone1a)])
    (let*-values  ([(goal sol2) (a-star goal zone1b)]
                   [(sol-z1b) (cdr sol2)])
      (set! min-r 1)
      (let*-values  ([(goal sol3) (a-star goal zone2)]
                     [(sol-z2) (cdr sol3)])
        (set! min-c 1)
        (let*-values  ([(goal sol4) (a-star goal manhattan)]
                       [(sol-man) (cdr sol4)])
          (print-solution (append sol-z1a sol-z1b sol-z2 sol-man)))))))

在代码执行时，它会在每个步骤存储解决方案列表，并最终在代码的最后一行打印出完整的解决方案。我们在每个步骤（除了第一步）都取解决方案列表的cdr，这是因为前一步骤的最后一项是下一步的目标；如果我们把它保留在列表中，这个状态就会被重复。

最后，我们解决了print例程中由于瓷砖上的双位数字导致的小问题。修改后的代码如下。

(define (print puzzle)
  (for* ([r SIZE] [c SIZE])
    (when (= 0 c) (printf "\n"))
    (let ([t (ref puzzle r c)])
      (if (= t empty)
          (printf "   ")
          (printf " ~a" (~a t #:min-width 2 #:align 'right) ))))
  (printf "\n"))

以下是一些用于测试代码的示例输入。为了节省空间，仅显示第一个示例的输出（压缩格式）。

> (solve #(2 10 8 3 1 6 16 4 5 9 7 11 13 14 15 12 1 2))

  2 10  8  3   2 10     3    2 10  3       2 10  3  4 
  1  6     4   1  6  8  4    1  6  8  4    1  6  8   
  5  9  7 11   5  9  7 11    5  9  7 11    5  9  7 11
 13 14 15 12  13 14 15 12   13 14 15 12   13 14 15 12

  2 10  3  4    2 10  3  4   2     3  4       2  3  4
  1  6     8    1     6  8   1 10  6  8    1 10  6  8
  5  9  7 11    5  9  7 11   5  9  7 11    5  9  7 11
 13 14 15 12   13 14 15 12  13 14 15 12   13 14 15 12

  1  2  3  4    1  2  3  4    1  2  3  4   1  2  3  4  
    10  6  8    5 10  6  8    5 10  6  8   5     6  8  
  5  9  7 11       9  7 11    9     7 11   9 10  7 11  
 13 14 15 12   13 14 15 12   13 14 15 12  13 14 15 12  

  1  2  3  4    1  2  3  4    1  2  3  4    1  2  3  4 
  5  6     8    5  6  7  8    5  6  7  8    5  6  7  8
  9 10  7 11    9 10    11    9 10 11       9 10 11 12
 13 14 15 12   13 14 15 12   13 14 15 12   13 14 15   

> (solve #(5 1 2 4 14 9 3 7 13 10 12 6 15 11 8 16 3 3))
. . .

> (solve #(10 9 5 13 8 14 15 7 1 3 11 6 4 2 12 16 3 3))
. . .

> (solve #(3 1 2 4 13 6 7 8 5 12 10 11 9 14 15 16 3 3))
. . .

> (solve #(9 6 12 3 5 13 16 8 14 1 10 7 2 15 11 4 1 2))
. . .

> (solve #(11 1 3 12 5 2 9 8 10 6 14 15 7 13 4 16 3 3))
. . .

请注意，根据谜题的复杂性和计算机的性能，生成解决方案可能需要从几秒钟到一分钟不等的时间。

数独

数独^(2)是一种流行的谜题，由一个 9x9 的方格组成，初始时有一些方格被填入了从 1 到 9 的数字，如图 7-31a 所示。目标是填充空白方格，使得每一行、每一列和每一个 3x3 的方格块也包含数字 1 到 9，如图 7-31b 所示。一个完整的数独谜题应只有一个可能的解。

图 7-31：数独谜题

本节的目标是编写一个过程，生成任何给定数独谜题的解决方案。

基本策略如下：

检查每个空单元格，确定可用的数字。
选择一个可用数字最少的单元格。
一次填写单元格中的一个可用数字。
对每个可用数字，重复该过程，直到谜题被解决，或没有可用数字填入空单元格。
如果没有可用的数字，请回溯到步骤 3，尝试其他数字。

该过程是深度优先搜索的另一种应用。

图 7-32 给出了在谜题中参考位置的坐标：数字索引列位于顶部，数字索引行位于左边缘，数字索引块位于 3x3 子网格的内部。

图 7-32：谜题坐标

要确定某个单元格的可用数字，我们需要对每行、每列和每个区块中未使用的数字进行集合交集操作。以图 7-31a 中第一行第一列的单元格为例，第一行的可用数字集合为{2, 5, 8}，第一列的所有数字中除了 5 外的其他数字均可用，在区块 0 中，可用的数字集合为{2, 3, 7, 8, 9}。这些集合的交集给出了该单元格的可选值集合：{2, 8}。

我们的实现将使用一个 9x9 的数字数组来表示谜题，其中数字 0 表示一个空白格。该数组将由九个元素的向量构成，每个元素是另一个九个元素的整数向量。为了方便访问数组的元素，我们定义了两个实用函数来设置和获取值：

(define (array-set! array r c v)
  (vector-set! (vector-ref array r) c v))

(define (array-ref array r c)
  (vector-ref (vector-ref array r) c))

这两个函数都需要将数组以及行列号作为初始参数提供。

从行和列号推导相应的块索引也将是有用的，正如 getBlk 函数所示。

(define (getBlk r c) ; block from row and column
  (+ (* 3 (quotient r 3)) (quotient c 3)))

谜题将作为一个单一字符串输入，其中每行九个数字由换行符分隔，如下面的示例所示。

> (define puzzle-str "
150000320
604031097
000200000
000049073
400800000
000000001
503008000
002000004
007000260
")

我们将数独谜题对象定义为 sudoku% Racket 对象，以下是该对象的部分实现。该对象将维护谜题的状态，并包含可以通过设置单元格值来操作状态的函数，同时提供列出潜在候选数字（在某行、某列或某块中未使用的数字）及其他辅助函数。

(define sudoku%
  (class object%

 ➊ (init [puzzle-string ""])

    (define avail-row (make-markers))
    (define avail-col (make-markers))
    (define avail-blk (make-markers))
 ➋ (define count 0)

 ➌ (define grid
      (for/vector ([i 9]) (make-vector 9 0)))

    (super-new)

 ➍ (define/public (item-set! r c n)
      (array-set! grid r c n)
      (array-set! avail-row r n #f)
      (array-set! avail-col c n #f)
      (let ([b (getBlk r c)])
        (array-set! avail-blk b n #f))
      (set! count (+ count 1)))
    (unless (equal? puzzle-string "")
   ➎ (init-puzzle puzzle-string))

    (define/public (get-grid) grid)

    (define/public (item-ref r c)
      (array-ref grid r c))

 ➏ (define/public (init-grid grid)
      (for* ([r 9] [c 9])
        (let ([n (array-ref grid r c)])
          (when (> n 0)
            (item-set! r c n)))))

 ➐ (define/private (init-puzzle p)
      (let ([g 
             (let ([rows (string-split p)])
               (for/vector ([row rows])
                 (for/vector ([c 9])
                   (string->number (substring row c (add1 c))))))])
        (init-grid g)))

; More to come shortly . . .

))

init 表单 ➊ 捕获定义谜题的输入字符串值。我们通过调用 init-puzzle ➐ 来初始化谜题 ➎，该函数通过调用 init-grid ➏ 使用适当的数值更新 grid ➌。

count 变量 ➋ 包含当前已赋值的单元格数量。一旦 count 达到 81，谜题即已解答。

avail-row、avail-col 和 avail-blk 变量用于跟踪每行、每列和每个块中当前未使用的数字。make-markers 函数用于初始化这些变量，它创建一个布尔数组，表示在给定索引（行、列或块）中哪些数字是可用的；make-markers 定义如下：

(define (make-markers)
  (for/vector ([i 10])
    (let ([v (make-vector 10 #t)])
      (vector-set! v 0 #f)  
      v)))

请注意，数字 0（表示空单元格）自动标记为不可用。

随着数字被添加到谜题中，item-set! 会被调用 ➍。该过程负责在给定要分配给谜题的行、列和数字时更新 grid、avail-row、avail-col 和 avail-blk。get-grid 和 item-ref 函数分别返回 grid 或 grid 中的某个单元格。

在以下代码片段中，所有缩进的函数定义应包含在 sudoku% 类定义中，而不是全局定义。

以下 avail 函数将 avail-row、avail-col 和 avail-blk 的值结合起来，生成一个指示哪些数字可用的向量。

    (define (avail r c)
      (let* ([b (getBlk r c)]
             [ar (vector-ref avail-row r)]
             [ac (vector-ref avail-col c)]
             [ab (vector-ref avail-blk b)])
        (for/vector ([i 10])
          (and (vector-ref ar i)
               (vector-ref ac i)
               (vector-ref ab i)))))

给定这个向量，我们按照以下方式创建一个自由数字的列表：

    (define (free-numbers v)
      (for/list ([n (in-range 1 10)] #:when (vector-ref v n)) n))

为了提高效率，以下代码查找所有只有一个可用数字的单元格，并相应地更新谜题。

    (define (set-singles)
      (let ([found #f])
        (for* ([r 9] [c 9])
          (let* ([free (avail r c)]
                 [num-free (vector-count identity free)]
                 [n (item-ref r c)])
            (when (and (zero? n)  (= 1 num-free))
              (let ([first-free
                     (let loop ([i 1])
                       (if (vector-ref free i) i
                           (loop (add1 i))))])
                (item-set! r c first-free)
                (set! found #t))
              )))
        found))

执行此过程一次可能会导致其他单元格只有一个可用的数字。以下代码会持续运行，直到没有单元格只剩下一个可用数字。

    (define/public (set-all-singles)
      (when (set-singles) (set-all-singles)))

对于那些仅凭逻辑即可直接解决的谜题（无需猜测），上述过程就足够了，但情况并不总是如此。为了支持回溯，提供了以下两个函数。

    (define (get-free)
      (let ([free-list '()])
        (for* ([r 9] [c 9])
          (let* ([free (avail r c)]
                 [num-free (vector-count identity free)]
                 [n (item-ref r c)])
            (when (zero? n)
              (set! free-list
                    (cons
                     (list r c num-free (free-numbers free))
                     free-list)))))
        free-list))

    (define/public (get-min-free)
      (let ([min-free 10]
            [min-info null]
            [free-list (get-free)])
        (let loop ([free free-list])
          (unless (equal? free '())
            (let* ([info (car free)]
                   [rem (cdr free)]
                   [num-free (third info)])
              (when (< 0 num-free min-free)
                (set! min-free num-free)
                (set! min-info info))
              (loop rem))))
        min-info))

第一个函数（get-free）逐个单元格地创建每个单元格的所有自由值的列表。列表的每个元素都包含一个列表，保存行、列、自由值的数量以及自由值的列表。第二个函数（get-min-free）接受get-free返回的列表，并返回自由数字最少的单元格的值。

这里有一些实用的工具函数。

    (define/public (print)
      (for* ([r 9] [c 9])
        (when (zero? c) (printf "\n"))
        (let ([n (item-ref r c)])
          (if (zero? n)
              (printf " .")
              (printf " ~a" n)
              )))
      (printf "\n"))

    (define/public (solved?) (= count 81))

    (define/public (clone)
      (let ([p (new sudoku%)])
        (send p init-grid grid)
        p))

print成员函数提供谜题的简单文本打印输出。solved?函数通过测试所有 81 个单元格是否都已填充来判断谜题是否已解。clone函数提供谜题的副本。

这就是sudoku%类定义体内定义的代码，接下来是实际用于解决谜题的代码。

(define (solve-sudoku puzzle)
  (let ([solution null]
     ➊ [puzzle (send puzzle clone)])
 ➋ (define (dfs puzzle)
      (if (send puzzle solved?)
          (set! solution puzzle)
          (let ([info (send puzzle get-min-free)]) 
            (match info
              ['() #f]
           ➌ [(list row col num free-nums) 
               (let loop ([nums free-nums])
                 (if (equal? nums '())
                     #f
                  ➍ (let ([n (car nums)]
                        ➎ [t (cdr nums)])
                       (let ([p (send puzzle clone)])
                      ➏ (send p item-set! row col n)
                         (send p set-all-singles)
                      ➐ (unless (dfs p)(loop t))))))]))))
 ➑ (send puzzle set-all-singles)
    (dfs puzzle)
    (if (equal? solution null)
        (error "No solution found.")
        solution
        )))

我们首先创建一个谜题副本进行操作 ➊。接下来，我们定义一个深度优先搜索过程dfs ➋，稍后我们将解释。调用set-all-singles ➑偶尔足以解决谜题，但谜题会被交给dfs，以确保找到完整的解决方案。剩下的行将返回已解的谜题（如果存在）；否则会发出错误信号。

深度优先搜索代码dfs ➋，立即测试谜题是否已解决，如果已解决，则返回已解的谜题。否则，探索具有最少可用数字的单元格（如果有的话） ➌，其中match表达式提取单元格的行、列、自由数字的数量以及自由数字的列表。然后，从下一行开始，迭代自由数字的列表。在列表不为空时，第一个数字被提取到n ➍，剩余的数字存储在t ➎中。接下来，创建谜题的副本。然后，使用当前可用的数字填充谜题副本 ➏，并紧接着调用set-all-singles。如果这个数字不能生成解决方案（通过递归调用dfs ➐），则循环将用原始谜题和下一个可用数字重新开始。

为了测试各种谜题，我们定义了一个简单的例程，接受一个输入的谜题字符串，解决谜题，并打印解决方案。

(define (solve pstr)
  (let* ([puzzle (new sudoku% [puzzle-string pstr])]
         [solution (solve-sudoku puzzle)])
    (send puzzle print)
    (send solution print)))

现在我们已经打下了基础，接下来用我们的示例谜题进行试运行。

> (define puzzle "
150000320
604031097
000200000
000049073
400800000
000000001
503008000
002000004
007000260
")
> (solve puzzle)

 1 5 . . . . 3 2 .
 6 . 4 . 3 1 . 9 7
 . . . 2 . . . . .
 . . . . 4 9 . 7 3
 4 . . 8 . . . . .
 . . . . . . . . 1
 5 . 3 . . 8 . . .
 . . 2 . . . . . 4
 . . 7 . . . 2 6 .

 1 5 8 9 7 4 3 2 6
 6 2 4 5 3 1 8 9 7
 7 3 9 2 8 6 1 4 5
 2 8 5 1 4 9 6 7 3
 4 7 1 8 6 3 9 5 2
 3 9 6 7 5 2 4 8 1
 5 6 3 4 2 8 7 1 9
 8 1 2 6 9 7 5 3 4
 9 4 7 3 1 5 2 6 8

虽然这无疑是生成输出的足够方法，但只需稍加额外工作，就可以产生更具吸引力的输出。

为了实现我们的目标，我们需要 Racket 的draw库。

(require racket/draw)

此外，我们还将借用在 15 拼图 GUI 中使用的draw-centered-text过程：

(define CELL-SIZE 30)

(define (draw-centered-text dc text x y)
  (let-values ([(w h d s) (send dc get-text-extent text)])
    (let ([x (+ x (/ (- CELL-SIZE w) 2))]
          [y (+ y (/ (- CELL-SIZE h d) 2))])
      (send dc draw-text text x y ))))

有了这些前提条件后，我们现在可以定义我们的draw-puzzle函数：

(define (draw-puzzle p1 p2)
  (let* ([drawing (make-bitmap (* 9 CELL-SIZE) (* 9 CELL-SIZE))]
         [dc (new bitmap-dc% [bitmap drawing])]
         [yellow (new brush% [color (make-object color% 240 210 0)])]
         [gray (new brush% [color "Gainsboro"])])
    (for* ([r 9][c 9])
      (let* ([x (* c CELL-SIZE)]
             [y (* r CELL-SIZE)]
             [n1 (send p1 item-ref r c)]
             [n2 (send p2 item-ref r c)]
             [num (if (zero? n2) "" (number->string n2))]
             [color (if (zero? n1) yellow gray)])
        (send dc set-pen "black" 1 'solid)
        (send dc set-brush color)
        (send dc draw-rectangle x y CELL-SIZE CELL-SIZE)
        (draw-centered-text dc num x y)))
    (for* ([r 3][c 3])
      (let* ([x (* 3 c CELL-SIZE)]
             [y (* 3 r CELL-SIZE)])
        (send dc set-pen "black" 2 'solid)
        (send dc set-brush "black" 'transparent)
        (send dc draw-rectangle x y (* 3 CELL-SIZE) (* 3 CELL-SIZE))))
    drawing))

这里其实没有什么新鲜的内容。我们传递给它两个拼图的原因是，第一个拼图是原始的未解拼图。它仅用于确定绘制方格时使用的颜色。如果方格在原始拼图中是空白的，它将在输出中被涂成黄色；否则，它将被涂成灰色。

有了这个，我们可以重新定义solve如下：

(define (solve pstr)
  (let* ([puzzle (new sudoku% [puzzle-string pstr])]
         [solution (solve-sudoku puzzle)])
    (print (draw-puzzle puzzle puzzle))
    (newline)
    (newline)
    (print (draw-puzzle puzzle solution))))

使用这个新版本得到如下结果：

它展示了图 7-33 中的初始状态：

图 7-33：数独初始状态图示

以及在图 7-34 中的解题状态：

图 7-34：已解数独图示

总结

在本章中，我们探讨了多种在解决问题时常用的算法。具体来说，我们讨论了广度优先搜索（BFS）、深度优先搜索（DFS）、A* 算法以及 Dijkstra 算法（并且在此过程中了解了优先队列），这些算法用于寻找图中节点之间的最短路径。我们在 n-皇后问题和 15 拼图问题中使用了 DFS（后者还使用了 A* 算法）。最后，我们研究了数独，在某些情况下，逻辑就足以解决问题，但如果失败，DFS 又会派上用场。虽然我们探讨的算法远非全面，但它们构成了一套有效的工具集，能在许多领域解决广泛的问题。

到目前为止，我们已经运用了多种编程范式：命令式、函数式和面向对象。在下一章，我们将介绍一种新的技术：逻辑编程或逻辑程序设计。

第八章：逻辑编程

逻辑编程 起源于形式逻辑学科。它是一种声明式编程风格，专注于 需要做什么，而不是 如何做。这一领域中最著名的编程语言是 Prolog（参见 [5]）。Prolog 和逻辑编程的一个巨大优势是，它提供了一个平台，可以自然流畅地表达和解决某些类型的问题（通常涉及某种搜索）。缺点是，对于其他类型的问题，逻辑编程可能非常低效。

好消息是，Racket 允许你同时享受两全其美的方案。Racket 提供了一个类似 Prolog 风格的逻辑编程库，名为 Racklog。Racklog 在语义上与 Prolog 非常相似，但它是 Racket 语法的嵌入式扩展。Racklog 库可以通过 (require racklog) 形式访问。

前言

逻辑编程完全围绕事实及事实之间的关系展开。在普通的 Racket 中，如果我们想定义什么是咖啡饮品，可能会这样写：

> (define coffee '(moka turkish expresso cappuccino latte))

然后我们可以通过使用成员函数来询问某个东西是否是咖啡饮品。

> (member 'latte coffee)
'(latte)

> (member 'milk coffee)
#f

Racklog 定义我们咖啡事实的方式如下。请注意，所有内建的 Racklog 对象名称都以百分号 (%) 开头，以避免与标准 Racket 名称冲突。用户名不必遵循这一惯例。

> (require racklog)

> (define %coffee
    (%rel ()
          [('moka)]
          [('turkish)]
          [('expresso)]
          [('cappuccino)]
          [('latte)]))

这样的事实集合在 Prolog 中通常被称为 数据库。我们可以通过 %which 形式（查询哪些事实为真）来查询我们的咖啡事实（技术上是子句）。请注意，稍后会解释 %rel 和 %which 形式中的空括号的目的。

> (%which () (%coffee 'latte))
'()

> (%which () (%coffee 'milk))
#f

由于 milk 不在我们的 %coffee 事实中，查询 (%which () (%coffee 'milk)) 如预期返回了 false。表达式 (%coffee 'milk) 在 %which 子句中被称为目标。以这种方式使用时，%coffee 被称为谓词。本质上，我们在问，牛奶是咖啡吗？ 在这个例子中，目标被认为是失败的。当我们询问 latte 时，查询返回了空列表 ()。任何类型的返回列表（即使是空的）都是 Racklog 表示成功的方式。你也可以用明确的目标查询 Racklog，且这些目标总是成功或总是失败，如下所示。

> (%which () %true)
'()

> (%which () %fail)
#f

假设我们想知道哪些东西被认为是咖啡饮品。我们可以这样提问。

> (%which (c) (%coffee c))
'((c . moka))

当 %which 找到匹配项时，它会返回一对对的列表。c 标识符是一个本地逻辑变量，%which 形式使用它来指示哪个项被匹配（即绑定或 实例化）到该标识符。请注意，绑定逻辑变量与绑定 Racket 标识符是不同的过程。在这种情况下，标识符 c 并没有被赋值，而是作为一种机制，将逻辑变量与从数据库中检索到的值关联起来。虽然“绑定”这个术语可以在两种情况下使用，但我们通常会使用“实例化”这个术语来区分绑定逻辑变量和绑定 Racket 标识符。%which 的第二个子形式（即 (c)）可以是一个这样的本地逻辑变量列表。这个列表仅仅是用来向 Racklog 声明在接下来的表达式中使用了哪些逻辑变量。

这里正在发生的过程叫做统一。有两个重要的因素在起作用。第一个是模式匹配。第二个是前面提到的实例化。如果查询中没有逻辑变量，那么查询表达式的结构必须与数据库中的对应值完全匹配才能成功。我们在查询尝试 (%which () (%coffee 'milk)) 时看到了这个过程失败，因为数据库中没有完全匹配的项。如果查询表达式中有逻辑变量，它们可以与数据库中的相应元素匹配。到目前为止，我们只看到过一个简单的例子，查询表达式只包含一个逻辑变量，而数据库只包含一些原子值。我们很快会遇到更有趣的例子。

我们可以使用 (%more) 查询我们的咖啡数据库，以获取更多的咖啡饮品。每次调用 %more 时，都会生成更多的匹配项。

> (%more)
'((c . turkish))

> (%more)
'((c . expresso))

> (%more)
'((c . cappuccino))

> (%more)
'((c . latte))

> (%more)
#f

请注意，当我们用完咖啡事实时，(%more) 会失败（返回 #f）。

如果我们只需要知道是否有咖啡，我们可以这样提问，其中表达式 (_) 表示一个匿名变量，它可以匹配任何内容：

> (%which () (%coffee (_)))
'()

基础知识

到目前为止，我所展示的看起来只是在做 Racket 已经能够完成的同样事情，但 Racklog 是为更复杂的事情而设计的。我们将看到可以定义更复杂的关系，比如父子关系。这种关系可以自然地扩展到祖父母–子女关系，依此类推。由于这些关系已在我们的数据库中定义，我们可以提出这样的问题，例如 Tom 的父母是谁？ 或 Dick 的孙子是谁？

了解你的亲戚

了解咖啡饮品可能不会让你彻夜未眠，但知道你的亲戚是谁可能会。尽管如此，我们将创建一个简单的父子数据库，进一步扩展我们对 Racklog 的了解。

> (define %parent
    (%rel ()
          [('Wilma 'Pebbles)]
          [('Fred 'Pebbles)]
          [('Homer 'Bart)]
          [('Dick 'Harry)]
          [('Sam 'Tim)]
          [('William 'Henry)]
          [('Henry 'John)]
          [('Mary 'Sam)]
          [('Dick 'Harriet)]
          [('Tom 'Dick)]
          [('George 'Sam)]
          [('Tim 'Sue)]))

每个关系的第一个项是父母，第二个是孩子（实际上，你可以决定哪个是哪个；这只是一种约定）。假设在定义了%parent后，发现Lisa和Maggie需要作为Homer的孩子被添加进来。这可以通过使用两种%assert!形式之一来解决。

> (%assert! %parent () [('Homer 'Lisa)])
> (%assert-after! %parent () [('Homer 'Maggie)])

第一个表达式将Homer作为Lisa的父母添加到所有其他子句之后。但是要注意，%assert-after!会在所有其他子句之前添加子句（不要问我们为什么）。为了演示这一点，让我们找出Homer的所有孩子。

> (%which (c) (%parent 'Homer c))
'((c . Maggie))

> (%more)
'((c . Bart))

> (%more)
'((c . Lisa))

不需要预先填充关系的值。我们可以创建一个空关系，并像这样向其中添加条目。

> (define %parent %empty-rel)
> (%assert! %parent () [('Adam 'Bill)])
> (%assert! %parent () [('Noah 'Andy)])

我们不必局限于单一的世代。我们也可以询问祖父母。祖父母是指那些子女是他人父母的人。我们可以这样定义这种关系：

> (define %grand
 ➊ (%rel (g p c)
       ➋ [(g c)
            ➌ (%parent g p) (%parent p c)]))

在这种情况下，第二个子形式➊是一个符号列表(g p c)（分别表示祖父母、父母和孩子）。如同%which所提到的，这个列表只是向 Racklog 声明将在其余表达式中使用的局部逻辑变量。与其他关系不同，每个子句只包含单个表达式，而在这个例子中，子句包含了三个表达式。如果你熟悉 Prolog（如果你不熟悉也没关系），这可以表示为如下形式：

grand(G,C) :- parent(G,P), parent(P,C).

这种类型的表达式被称为规则。在 Racklog 版本中，我们将该表达式与➋进行匹配。在 Prolog 术语中，这被称为规则的头部（Racket 代码(g c)在 Prolog 版本中相当于grand(G,C)）。接下来，我们有两个子目标（称为规则的主体），也必须与➌匹配。用通俗的话来说，这意味着如果g是p的父母，并且p是c的父母，那么g就是c的祖父母。

让我们来看看查询(%which (k) (%grand ’Tom k))的执行过程，这个查询是在问谁是Tom的孙子（k）。通过这个查询，我们的%grand定义中的局部变量g ➌ 被实例化为Tom。变量k和c被关联在一起（尽管它们目前还没有具体的值）；如上所述，关联这些变量的过程称为统一。Racklog 随后扫描其父数据库（假设我们有原始的父母数据集），直到找到一条记录，其中Tom是父母之一。在这种情况下，有一条记录显示Tom是Dick的父亲。因此，第一个子目标成功，结果是p被实例化为Dick。现在，第二个子目标被测试（(%parent p c)，通过统一变成了(%parent ’Dick c)）。Racklog 扫描其父数据库，发现Dick是Harry的父亲，此时变量c（通过统一也就是k）被实例化为Harry。在 DrRacket 中执行该查询时，我们确实得到了预期的结果。

> (%which (k) (%grand 'Tom k))
'((k . Harry))

如果我们想看看Tom是否有其他孙子，可以使用(%more)。

> (%more)
'((k . Harriet))

在最初匹配Harry时，父母（p）被实例化为Dick。在(%more)背后发生的事情是，它实际上触发了规则的失败。Racklog 随后回溯到目标(%parent p c)，并且将变量c进行反实例化（它不会反实例化p，因为p是在之前的目标中实例化的）。然后它在数据库中查找Dick的另一个父母匹配，找到了第二条记录，显示Harriet是Dick的孩子（因此是Tom的孙子）。

逻辑编程的一个优点是同一关系可以以不同的方式提问。我们问了谁是Tom的孙子，但我们也可以通过以下方式来问谁有孙子：

> (%which (g) (%grand g (_)))
'((g . William))

> (%more)
'((g . Tom))

> (%more)
#f

或者我们可以问Homer是否是祖父。

> (%which () (%grand 'Homer (_)))
#f

这就是 Racklog 扩展 Racket 功能的一种方式。我们将在下一节中看到更多这种灵活性的例子。

如果我们只是想列出父母，可以使用目标(%parent p (_))，然后输入一些(%more)命令。每次都输入(%more)以查看目标是否能够重新满足，确实有些繁琐。解决这个问题的一种方法是使用%bag-of。%bag-of谓词接受三个参数：我们想要返回的 Racket 表达式（在这种情况下，就是逻辑变量p的值），要测试的目标（在此为(%parent p (_))），以及用来实例化计算出的结果列表的变量（也就是p）。这里有一个例子。

> (%which (p) (%bag-of p (%parent p (_)) p))
'((p Wilma Fred Homer Dick William Henry Mary Sam George Dick Tom Tim))

在这个例子中，我们只是使用了p作为计算结果，但我们可以通过这种方式构造查询来稍微美化一下输出（从中可以看出，逻辑变量p的值与字面量parent一起使用，生成最终结果）。

> (%which (p) (%bag-of (cons 'parent p) (%parent p (_)) p))
'((p
   (parent . Wilma)
   (parent . Fred)
   (parent . Homer)
   (parent . Dick)
   (parent . William)
   (parent . Henry)
   (parent . Mary)
   (parent . Sam)
   (parent . George)
   (parent . Dick)
   (parent . Tom)
   (parent . Tim)))

这里有一种更简单的方式来获得类似的输出。

> (%find-all (p) (%parent p (_)))
'(((p . Wilma))
  ((p . Fred))
  ((p . Homer))
  ((p . Dick))
  ((p . William))
  ((p . Henry))
  ((p . Mary))
  ((p . Sam))
  ((p . George))
  ((p . Dick))
  ((p . Tom))
  ((p . Tim)))

使用%bag-of和%find-all将按与使用(%more)相同的顺序列出值。因此，一些条目可能会重复（例如本例中的Dick）。为了只获得唯一值，我们可以改用%set-of。

> (%which (p) (%set-of p (%parent p (_)) p))
'((p Wilma Fred Homer Dick William Henry Mary Sam George Tom Tim))

在本节中，我们介绍了一些逻辑编程的基本思想。如需更详细地了解回溯、统一等内容，请参阅 Clocksin 和 Mellish 所著的经典且易于理解的作品《Prolog 编程》[5]。

Racklog 谓词

到目前为止，我们已经探索了 Racklog 提供的一些基本功能。逻辑编程是一种独特的范式，要求使用一些专门的工具才能充分发挥其作用。在本节中，我们将介绍其中的一些工具。

等式

我们已经看到，统一在逻辑编程的语义中起着关键作用。Racklog 提供了等式谓词%=, 它直接使用统一来测试结构相等性并实现实例化过程。以下示例应能为这个谓词的应用提供一些见解。

> (%which (a b) (%= '(1 potato sack) (cons a b)))
'((a . 1) (b potato sack))

> (%which (x y) (%= (vector x 5) (vector 4 y)))
'((x . 4) (y . 5))

> (%which (x y) (%= (vector x 5) (list 4 y)))
#f

> (%which () (%= (list 4 5) (list 4 5)))
'()

第一个例子中发生的情况比较微妙。请注意，(1 potato sack)实际上等同于(1 . (potato sack))，而(cons a b)等同于(a . b)。这意味着通过统一，a被实例化为 1，b被实例化为(potato sack)。结果是((a . 1) (b potato sack))。实例化总是以对的形式显示，但我们看到第一个元素(a . 1)显示为一对，第二个元素(b potato sack)显示为列表。回想一下，列表实际上就是一对，只是显示方式略有不同。在(b potato sack)的例子中，b是这一对的car，(potato sack)是这一对的cdr。

%=的相反是%/=，表示无法统一。回想一下，统一本质上是一个匹配过程。利用上一个例子，观察以下内容：

> (%which (a) (%= (list 4 5) (list 5 a)))
#f

> (%which (a) (%/= (list 4 5) (list 5 a)))
'((a . _))

在第一个例子中，虽然可以将逻辑变量a实例化为 5，但尝试将第一个列表中的 4 与第二个列表中的 5 匹配导致了统一失败。在第二个例子中，统一仍然失败，但由于我们使用了不相等谓词，因此返回了一个列表，逻辑变量a保持未绑定状态。

类似于等式谓词的是*identical*谓词%==。与%=不同，%==不进行任何实例化。它检查两个表达式是否完全相同。

> (%which (a b) (%== (list 1 2) (list a b)))
#f

> (%which () (%== (list 1 2) (list 1 2)))
'()

%==的相反是%/==，表示不相等。

Let

有时我们希望在查询中使用局部变量来生成中间结果，而不希望这些变量出现在输出中。%let谓词提供了一种建立这些隐藏变量的方式。

> (define %friends %empty-rel)
> (%assert! %friends () [('jack 'jill)])
> (%assert! %friends () [('fred 'barny)])
> (%which (pals) (%let (a b) (%bag-of (cons a b) (%friends a b) pals)))
'((pals (jack . jill) (fred . barny)))

在这个例子中，%bag-of 谓词从 friends 的结果创建了一个 cons 对，并将其实例化为 pals。这里 a 和 b 是 %let 的词法局部变量，因此只有统一的结果被传递到 pals。

是

%is 谓词的作用与其他 Racklog 谓词略有不同。它有两个参数：第一个表达式通常（但不总是）是标识符，第二个是普通的 Racket 表达式。%is 表达式将第二个表达式求值的结果实例化为第一个表达式。通常，第二个表达式中的所有标识符需要在求值 %is 表达式之前先实例化。%is 表达式可以用来给第一个参数赋值或测试相等性。

> (%which (val) (%is val (+ 1 (* 2 3 4))))
'((val . 25))

> (%which () (%is 25 (+ 1 (* 2 3 4))))
'()

> (%which () (%is 5 (+ 1 (* 2 3 4))))
#f

%is 和 %= 之间的一个区别是，对于 %is，它的第二个参数中的任何逻辑变量通常需要先实例化，正如这些例子所示。

> (%which (x y) (%= (list x 5) (list 4 y)))
'((x . 4) (y . 5))

> (%which (x y) (%is (list x 5) (list 4 y)))
#f

> (%which (x y) (%is (list x y) (list 4 5)))
'((x . 4) (y . 5))

然而，在某些情况下，%is 可能更有优势。详细信息请参见 Racket 手册^(1)。

算术比较

Racklog 使用 %=:= 来测试数值相等，使用 %=/= 来测试数值不等，但其他谓词则是你通常期望的。

> (%which () (%=:= 1 2))
#f

> (%which () (%=:= 1 1))
'()

> (%which () (%< 1 2))
'()

> (%which () (%>= 5 (+ 2 3)))
'()

请注意，这些比较只执行测试，而不会实例化逻辑变量，因此像 (%which (a) (%=:= a 2)) 这样的表达式会失败。

逻辑运算符

Racklog 支持常见的逻辑谓词 %not、%and 和 %or，如下所示。内置的 %fail 目标总是失败，而 %true 目标总是成功。

> (%which () (%not %fail))
'()

> (%which () (%not %true))
#f

> (%which () (%and %true %true %true))
'()

> (%which () (%and %true %fail %true))
#f

> (%which () (%or %true %fail %true))
'()

还有一个 %if-then-else 谓词：当给定三个目标时，如果第一个目标成功，它会求值第二个目标；否则，它会求值第三个目标。这里有一个小的测试框架。

#lang racket
(require racklog)

(define %spud
  (%rel ()
        [('Russet 'plain)]
        [('Yam 'sweet)]
        [('Kennebec 'plain)]
        [('Sweet 'sweet)]
        [('LaRette 'nutty)]))

(define %spud-taste
  (%rel (tater t taste)
     [(tater t) 
         (%if-then-else
             (%spud tater taste)
             (%is t taste)
             (%is t 'unknown))]))

以下交换示例展示了%if-then-else的实际应用。

> (%which (taste) (%spud-taste 'LaRette taste))
'((taste . nutty))

> (%which (taste) (%spud-taste 'Yam taste))
'((taste . sweet))

> (%which (taste) (%spud-taste 'broccoli taste))
'((taste . unknown))

因为’broccoli 不在 %spud 数据库中，最后的目标被求值，’unknown 被实例化为 taste（通过 t）。

附加

我们已经看到过标准的 Racket 版本的 append，它是一个函数，通常接受两个列表并返回一个由这两个列表连接而成的新列表，如下所示。

> (append '(1 2 3) '(4 5 6))
'(1 2 3 4 5 6)

这是一条单行街道。我们只能问一个问题：如果我有两个列表，将这两个列表合并后的结果列表是什么样的？在我们即将探索的 Racklog 版本中，我们还可以问这些问题：

如果我有一个结果列表，还有哪些其他列表可以组合成这个列表？
如果我有一个起始列表和一个结果列表，哪个列表可以加入到起始列表中以得到结果列表？
如果我有一个结束列表和一个结果列表，什么列表可以加入到结束列表的开头来得到结果列表？
如果我有三个列表，第三个列表是将前两个列表拼接的结果吗？

在我们解释 Racklog 的 %append 是如何工作的之前，让我们先看看几个例子。第一个查询回答了原始问题（两个列表连接的结果）。

> (%which (result) (%append '(1 2 3) '(4 5 6) result))
'((result 1 2 3 4 5 6))

这个查询回答了第二个问题。

> (%which (l1) (%append l1 '(4 5 6) '(1 2 3 4 5 6)))
'((l1 1 2 3))

这个查询回答了第三个问题。

> (%which (l2) (%append '(1 2 3) l2 '(1 2 3 4 5 6)))
'((l2 4 5 6))

而这个查询回答了第一个问题。

> (%which (lists)
          (%let (l1 l2)
                (%bag-of (list l1 l2)
                         (%append l1 l2 '(1 2 3 4 5 6)) lists)))
'((lists
   (() (1 2 3 4 5 6))
   ((1) (2 3 4 5 6))
   ((1 2) (3 4 5 6))
   ((1 2 3) (4 5 6))
   ((1 2 3 4) (5 6))
   ((1 2 3 4 5) (6))
   ((1 2 3 4 5 6) ())))

生成满足特定条件的所有可能性是逻辑编程的强项之一。

如果 %append 在 Racklog 中还没有定义，我们可以很容易地从头开始创建它（改编自 [5]）：

(define %append
  (%rel (h l l1 l2 l3)
     ➊ [('() l l)]
     ➋ [((cons h l1) l2 (cons h l3))
      	➌ (%append l1 l2 l3)]))

那么我们的谓词 %append 到底是怎么回事呢？它由两个子句组成。第一个 ➊ 简单地表示，如果第一个列表为空，则将该列表与任何列表 l 连接的结果就是 l。第二个子句 ➋ 比较复杂：((cons h l1) l2 (cons h l3)) 是规则的头部。该规则的头部需要三个参数，每个参数要么是一个列表，要么是一个未实例化的变量：

如果该参数是一个列表，则其第一个元素会被实例化为 h，其余的部分会实例化为 l1。
第二个参数被实例化为 l2。
如果第三个参数是逻辑变量，则使用 (cons h l3) 从第一个参数中提供的 h 和在递归调用 %append ➌ 时生成的 l3 来构建返回值。如果该参数是一个列表，则它的头部必须与第一个参数中的 h 匹配，剩余的列表部分将与最后一行中的 l3 匹配 ➌。

正如我们所看到的，%append 的任何一个或两个参数可能只是一个未实例化的变量。Racklog 使用它的统一过程将具体值与适当的值关联，并使用占位符临时分配空间，以便在适当的实例化后为其他变量分配空间。我们考虑一下第一和第二个参数被实例化为显式列表的情况。一旦统一过程完成 ➋，变量 l1（实例化为第一个提供的列表的尾部）和 l2（实例化为第二个列表）将用于递归调用 %append ➌，期望通过递归调用将现在更短的列表 l1 与 l2 连接，最终填充 l3。由于 (cons h l3) 被用来构造最终值，最终结果就是将两个原始提供的列表连接在一起。

这里是一个演示过程，我们将 ’(1) 和 ’(2 3) 连接起来（为了简洁起见，我们将使用等号（=）来表示逻辑变量绑定）：

第一步是调用 (%which (a) (%append ’(1) ’(2 3) a))。
然后我们来到了第一个判断点 ➊。由于 ’(1) 不匹配 ’(), 我们继续执行下一个情况。
此时在代码中我们有 h=1，l1=’() 和 l2=’(2 3) ➋（稍后我们会看到 l3，它用于构造返回值）。
接下来是递归调用 ➌。通过实例化的值，结果为 (%which (l3) (%append ’() ’(2 3) l3))。
我们再次来到第一个判断点 ➊，但现在空列表确实匹配。通过将 l=’(2 3) 与 l3 实例化，我们返回 l3=’(2 3)。
由于我们已经从递归调用中返回，逻辑变量将恢复到第 3 步中给出的值；特别感兴趣的是h=1。但是现在我们也得到了从l3=’(2 3)的递归调用中返回的值。我们的代码 ➋ 表示从这一阶段返回的值（a）是由(cons h l3)构造的。那就是(1 2 3)，即所需的最终结果。

其他实例化场景可以以类似的方式进行分析。

成员

另一个有 Racklog 等价物的 Racket 函数是%member。如果我们需要自己创建这个函数，一种实现方式如下：

(define %member
  (%rel (x y)
        [(x (cons x (_)))]
        [(x (cons (_) y)) (%member x y)]))

应该很明显，首先检查x是否位于列表的开头（也就是说，(cons x (~_))将x赋值为列表头部的值，因此它必须匹配正在查找的值）；如果不是，它会检查它是否出现在列表的其余部分。

示例：

> (define stooges '(larry curly moe))
> (%which () (%member 'larry stooges))
'()

> (%which () (%member 'fred stooges))
#f

> (%find-all (stooge) (%member stooge stooges))
'(((stooge . larry)) ((stooge . curly)) ((stooge . moe)))

Racklog 工具

在本节中，我们将研究在 Racklog 中实现一些额外的谓词。这些都是常见的列表操作，其实现展示了逻辑编程和 Racklog 的能力。稍后我们将使用%permutation谓词（我们会详细解释）。其余的可以视为黑盒，即我们通过提供的示例来展示它们的功能和用法，而不对代码进行详细解释。

选择

根据select的使用方式，它可以从列表中选择单个项、返回一个删除项的列表，或返回一个插入项的列表。以下是其定义。

(define %select
  (%rel (x r h t)
        [(x (cons x t) t)]
        [(x (cons h t) (cons h r))
         	(%select x t r)]))

下面是一些示例。

> (%which (r) (%select 'x '(u v w x y z) r)) ; remove 'x from list
'((r u v w y z))

> (%which (s) (%select s '(u v w x y z) '(u v x y z))) ; find value in first
     list that is not in the second
'((s . w))

> (%find-all (s) (%select s '(u v w x y z) (_)))
'(((s . u)) ((s . v)) ((s . w)) ((s . x)) ((s . y)) ((s . z)))

> (%find-all (l) (%select 'a l '(u v w x y z)))
'(((l a u v w x y z))
  ((l u a v w x y z))
  ((l u v a w x y z))
  ((l u v w a x y z))
  ((l u v w x a y z))
  ((l u v w x y a z))
  ((l u v w x y z a)))

减法

%subtract谓词旨在从一个列表中的元素集合中删除另一个列表中的元素集合。它利用%select谓词的功能来实现其结果。实现非常直接，应该容易理解。

(define %subtract
  (%rel (s r h t u)
        [(s '() s)]
        [(s (cons h t) r)
             (%select h s u)
             (%subtract u t r)]))

谓词的第一个参数是源列表，第二个参数是需要删除的项的列表，最后一个参数是返回的列表。

下面是一些说明%subtract用法的示例。

> (%which (r) (%subtract '(1 2 3 4) '(2 1) r))
'((r 3 4))

> (%which (r) (%subtract '(1 2 3 4) '(3) r))
'((r 1 2 4))

> (%which (t) (%subtract '(1 2 3 4) t '(2)))
'((t 1 3 4))

> (%which (s) (%subtract s '(1 2 4) '(3)))
'((s 1 2 4 3))

排列

有时获得给定列表的所有排列是有用的。为了提供以下谓词的工作原理的一些背景，想象一种生成给定列表所有排列的简单方法是很有帮助的。假设我们有一个从 1 到 4 的数字列表。显然，每个数字必须在某一时刻作为列表中的第一个数字出现。因此，一种方法是从四个列表开始，每个列表由 1 到 4 中的一个数字组成。对于这些列表中的每一个，我们创建一个对应的列表，包含所有剩余的数字，如下所示。

(1) (2 3 4)
(2) (1 3 4)
(3) (1 2 4)
(4) (1 2 3)

我们现在把问题缩小了一些。我们不再需要生成四个数字列表的所有排列，而只需要生成一个三位数字列表的排列。当然，我们足够聪明，知道可以递归地继续这个过程，处理更小的列表。剩下的就是将各部分重新组合起来。这实际上就是 %permutation 谓词所做的事情。

在深入代码之前，回顾一下 %append 的作用是很有帮助的，它不仅可以将两个列表连接在一起，还可以找到列表分割成两部分的所有方式。例如，如果我们调用 %which (l1 l2) '(1 2 3 4)，其中一个可能的输出是 '((l1) (l2 1 2 3 4))（l1 的值是空列表）。有了这些背景知识之后，这里是谓词（代码来源于 [5]）。

(define %permutation
  (%rel (l h t u v w)
     ➊ [('() '())]
     ➋ [(l (cons h t))
	      ➌ (%append v (cons h u) l)
	      ➍ (%append v u w)
	      ➎ (%permutation w t)]))

这个谓词接受两个参数：一个要排列的列表和一个标识符，用于实例化返回的排列列表。让我们看看当我们调用 (%which (a) (%permutation '(1 2 3 4) a))时会发生什么。因为列表不为空，我们跳过了第一次匹配尝试 ➊。接下来，我们有l='(1 2 3 4)➋。此时其余的代码用于构造返回值，我们稍后再回到这一部分。下一行开始有些有趣的变化 ➌。正如前面提到的，第一次调用%append时，第三个参数是一个列表，它会生成一个空列表和列表'(1 2 3 4)。通过这个结果，我们有 v = '()，h=1，u='(2 3 4)。接着看下一行，v='() 和 u='(2 3 4) 被实例化了，但 w 并没有，所以 (%append v u w) 只是将 w 绑定到 '(2 3 4)➍。最后，我们生成'(2 3 4) 的排列，并将结果实例化为 t ➎。现在我们处于构造返回值的阶段 ➋。这将生成所有以 1 开头的排列。

那剩下的排列呢？一旦我们通过回溯 ➌ 耗尽了以 1 开头的所有排列，我们最终得到 %append 生成的列表 '(1) 和 '(2 3 4)。此时我们有 v='(1)，h=2，u='(3 4)，所以现在我们有 w='(1 3 4) ➍。过程继续进行，就像之前一样，现在开始构建以 2 开头的列表的排列。

让我们看看如何安排四种扑克牌的花色。

> (%find-all (s) (%permutation '(♠ ♣ ♡ ♢) s))
'(((s ♠ ♣ ♡ ♢))
  ((s ♠ ♣ ♢ ♡))
  ((s ♠ ♡ ♣ ♢))
  ((s ♠ ♡ ♢ ♣))
  ((s ♠ ♢ ♣ ♡))
  ((s ♠ ♢ ♡ ♣))
  ((s ♣ ♠ ♡ ♢))
  ((s ♣ ♠ ♢ ♡))
  ((s ♣ ♡ ♠ ♢))
  ((s ♣ ♡ ♢ ♠))
  ((s ♣ ♢ ♠ ♡))
  ((s ♣ ♢ ♡ ♠))
  ((s ♡ ♠ ♣ ♢))
  ((s ♡ ♠ ♢ ♣))
  ((s ♡ ♣ ♠ ♢))
  ((s ♡ ♣ ♢ ♠))
  ((s ♡ ♢ ♠ ♣))
  ((s ♡ ♢ ♣ ♠))
  ((s ♢ ♠ ♣ ♡))
  ((s ♢ ♠ ♡ ♣))
  ((s ♢ ♣ ♠ ♡))
  ((s ♢ ♣ ♡ ♠))
  ((s ♢ ♡ ♠ ♣))
  ((s ♢ ♡ ♣ ♠)))

通过做一个小调整，我们可以创建一个版本的 %permutation，它通过额外的参数——所需的长度——来生成某一长度的所有排列：

(define %permute-n
  (%rel (l h t u v w n m)
        [((_) '() 0) !]
        [(l (cons h t) n)
            (%append v (cons h u) l)
            (%append v u w)
            (%is m (sub1 n))
            (%permute-n w t m)]))

第三行中的感叹号（!）称为 cut。cut 是一个总是成功的目标，但它用于防止在 cut 之前回溯。这意味着，如果紧跟在 cut 后面的目标失败（无论是通过回溯还是其他原因），cut 会阻止回溯到任何之前的目标。在这个例子中，一旦我们达到了零的计数，就不需要再寻找额外的、更长的排列。这将使过程更加高效（也就是说，谓词在没有它的情况下仍然能正常工作，但不会测试那些不必要的额外排列）。

由于 Racklog 的模式匹配功能，我们不需要使用两个独立的谓词。我们可以将它们合并为一个谓词，具体如下：

(define %permute
  (%rel (l h t u v w n m)

        ;permute all
        [('() '())]
        [(l (cons h t))
            (%append v (cons h u) l)
            (%append v u w)
            (%permute w t)]

        ;permute n
        [((_) '() 0) !]
        [(l (cons h t) n)
            (%append v (cons h u) l)
            (%append v u w)
            (%is m (sub1 n))
            (%permute w t m)]))

这里有几个例子：

> (%find-all (p) (%permute '(1 2 3) p))
'(((p 1 2 3)) ((p 1 3 2)) ((p 2 1 3)) ((p 2 3 1)) ((p 3 1 2)) ((p 3 2 1)))

> (%find-all (p) (%permute '(1 2 3) p 2))
'(((p 1 2)) ((p 1 3)) ((p 2 1)) ((p 2 3)) ((p 3 1)) ((p 3 2)))

现在我们已经打下了基础，让我们来看几个应用实例。

应用实例

到目前为止，我们已经介绍了逻辑编程的基本机制。尽管这些话题很有趣，但接下来我们将看看如何解决一些现实世界中的（但属于娱乐性质的）问题。在这里，我们将看到逻辑编程如何提供一个框架，通过声明式的方式来解决问题，更直接地映射问题的约束条件。

SEND + MORE = MONEY

下面这个著名的娱乐数学问题由 Henry Dudeney 在 1924 年 7 月的《The Strand Magazine》上发表。

每个字母代表解答中的一个不同数字。这类问题通常被称为字母算式、加密算术、加密算式或文字加法。尽管这个问题可以通过纸和笔来解决，我们将利用 Racket（通过 Racklog）来解决它。我们将使用一种通常不被推荐的方法：穷举法。这意味着我们将生成（几乎）所有可能的方式，将数字分配给字母（显然 M 是 1，所以我们不会再去寻找那个值）。

在以下代码中，我们使用了上一节定义的 %permute-n 谓词。

   #lang at-exp racket

   (require infix racklog)

   (define %permute-n
       ; see previous section
       ...)

➊ (define %check
  (%rel (S E N D O R Y s1 s2)
        [((list S E N D O R Y))
        ➋ (%is s1 @${S*1000 + E*100 + N*10 + D +
              1000 + O*100 + R*10 + E})
        ➌ (%is s2 @${10000 + O*1000 + N*100 + E*10 + Y})
           (%=:= s1 s2)]))

➍ (define %solve
  (%rel (S E N D M O R Y p)
        [(S E N D M O R Y)
            (%is M 1)
         ➎ (%permute-n '(0 2 3 4 5 6 7 8 9) p 7) 
            (%check p) 
         ➏ (%= p (list S E N D O R Y))]))

解这个谜题的谓词是 %solve ➍。首先，它将 1 分配给 M，如前所述。这个谜题中使用的唯一字母（除了 M）是 S、E、N、D、O、R 和 Y。下一步是生成所有可能的排列 '(0, 2, 3, 4, 5, 6, 7, 8, 9) ➎（每次取 7 个数字）。调用 %check 谓词来测试特定排列是否能解出这个谜题（稍后会介绍 %check）。如果当前排列生成了一个解，结果的赋值将被返回 ➏。请注意，如果 %check 失败，我们将回溯 ➎ 以生成另一个排列。

%check的代码也相当简单。在第一个%is语句 ➋ 中，我们只需为当前排列计算算术和 s1 = SEND + MORE（记住 M 隐含为 1——这里扩展为 1000）。在第二个%is语句 ➌ 中，我们计算和 s2 = MONEY。最后，我们测试 s1 是否等于 s2。由于算术表达式 ➋ ➌ 相当冗长，我们利用了 infix 库，使得计算过程更为清晰。

我们如下生成了解决方案。

> (%which (S E N D M O R Y) (%solve S E N D M O R Y))
'((S . 9) (E . 5) (N . 6) (D . 7) (M . 1) (O . 0) (R . 8) (Y . 2))

即使我们使用的是一种效率非常低的暴力破解方法，在一台相对健康的计算机上，解答应该在一分钟之内出现。

狐狸、鹅和豆子

狐狸、鹅和豆子谜题是河流过河类谜题的一个例子。这种谜题相当古老，至少可以追溯到 9 世纪。这类谜题非常适合逻辑编程系统。谜题的叙述大致是这样的：

从前，一位农民去市场买了狐狸、一只鹅和一袋豆子。回家的路上，农民来到河边，他把船停在了那里。但他的船很小，农民只能带着自己和他购买的其中一个物品——狐狸、鹅或豆子。如果留下狐狸，它会吃掉鹅；如果留下鹅，它会吃掉豆子。

农民的任务是将自己和他的购买物品（保持完好）带到河的另一岸。他是如何做到的呢？

尽管这个谜题手动解答并不困难，但它为我们提供了一个机会，展示 Racklog 执行 深度优先搜索（DFS） 的固有能力。为了帮助你理解这种搜索是如何工作的，可以想象你在一个小岛上，需要到达灯塔，但你不知道该怎么走，也没有地图。到达目的地的一个方法是开始行驶，每次遇到分岔路口时，仔细记录下你走的路。你继续前进，直到到达目的地，或者走到死胡同或已经走过的地方。如果你到达死胡同或已经走过的地方，你需要回溯到上一个分岔口，选择一条没走过的路。如果你已经尝试过所有分岔口的路径，你会回到更早的分岔口。最终，如果你按照这种方式继续工作，你将尝试所有可能的路径，最终到达目的地，或者你会发现自己其实在错误的岛屿上（哎呀）。

假设农夫在河流两岸之间往返。使用深度优先搜索（DFS）策略，我们在搜索过程中跟踪每一岸上放置了哪些物品。然后我们从所有物品都在东岸的记录开始。任何时候，我们可以选择不带物品返回对岸，或者选择携带一件物品回到对岸（前提是这些动作不违反谜题的约束）。我们还必须确保，所做的移动不会造成之前已经存在的物品排列。例如，假设我们首先将鹅带过河。现在我们有两个已存状态：一个是所有物品（包括农夫）都在东岸，另一个是狐狸和豆子在东岸，农夫和鹅在西岸。此时，农夫可以选择独自返回东岸，因为这会生成一个新的状态，但如果农夫（愚蠢地）将鹅带回东岸，这将导致已经出现过的状态（起始状态），因此不应考虑。游戏以这种方式继续进行，直到找到解决方案。

西岸用数字 0 表示，东岸用数字 1 表示。使用一个四元素向量来跟踪程序状态。向量的每个元素将表示每个角色的位置（即岸），如表 8-1 所示。

表 8-1：狐狸、鹅、豆子状态向量

索引	角色
0	农夫
1	狐狸
2	鹅
3	豆子

我们首先定义哪些状态在谓词%rejects中是不允许的。

#lang racket
(require racklog)

(define %reject
  (%rel ()
        [(#(0 1 1 1))]
        [(#(0 1 1 0))]
        [(#(0 0 1 1))]
        [(#(1 0 0 0))]
        [(#(1 0 0 1))]
        [(#(1 1 0 0))]))

第一个被拒绝的状态表明，如果农夫在 0 号岸，则不允许狐狸、鹅和豆子都在 1 号岸。其余状态可以类似地进行分析。通过观察数字模式，%rejects可以更简洁地编写：

(define %reject
  (%rel (x y)
        [((vector x y y (_))) (%=/= x y)]
        [((vector x x y y)) (%=/= x y)]))

如果农夫将物品从一岸移到另一岸，就必须切换农夫的岸和物品的岸。这是由toggle-item函数处理的，该函数接受一个状态向量和一个元素索引，并返回一个新的状态向量。请注意，这是一个普通的 Racket 函数，而不是 Racklog 谓词。接下来将展示这一点如何适应。

(define (toggle-item s a)
  (for/vector ([i (in-range 4)])
    (let ([loc (vector-ref s i)])
   ➊ (if (or (zero? i) (= i a))
          (- 1 loc)
          loc))))

代码(zero? i)测试农夫的索引（0），而(= i a)检查物品的索引 ➊。回忆一下，for/vector根据let体中计算的每个项的结果形成一个新的向量。

以下的%gen-move谓词生成的移动包括四种可能的船上乘客类型（分别用数字 0 到 3 表示）：农夫单独，或农夫带狐狸、鹅或一袋豆子。

(define %gen-move
  (%rel (n t s0 s1)
     ➊ [('() s0 s1)
             (%is s1 (cons 0 (toggle-item s0 0))) !]
     ➋ [((cons n (_)) s0 s1)
             (%is s1 (cons n (toggle-item s0 n)))]
     ➌ [((cons (_) t) s0 s1)
             (%gen-move t s0 s1)]))

谓词最初使用列表’(0 1 2 3)（表示所有可以移动的项目）和当前状态进行调用。它返回一个对，其中car表示正在移动的项目，cdr给出结果状态。我们遇到了没有剩余项目可以移动的情况 ➊，因此下一行仅切换农民的状态。注意切割（!）：不需要生成额外的移动，因为没有剩余的项目可以移动。接下来，我们有一个非空列表，因此我们取列表的头部并切换该项目的状态 ➋。最后，我们使用递归调用%gen-move处理其余的列表 ➌。

随着搜索的推进，需要确保程序不会通过重新检查已经测试过的状态进入无限循环。为此，我们维护一个包含已访问状态的列表，并将此列表和待检查的状态传递给%check-history谓词。如果该状态在历史列表中，检查将失败。

(define %check-history
  (%rel (state h t)
        [(state '())]
        [(state (cons h t))
          ➊ (%is #t (equal? state h)) ! %fail]
        [(state (cons (_) t))
	         (%check-history state t)]))

在这里，我们遇到了一个先前的状态，因此通过紧随其后的%fail ➊失败而不回溯。

接下来是%gen-valid-move谓词。该谓词接收当前状态和移动历史。它首先生成一个潜在的移动，并检查移动后银行上剩余的项目是否形成一个合法的组合（即状态不在拒绝列表中）。如果是，它接着检查当前状态是否曾经出现过。如果没有，它将返回这个移动作为有效的移动。

(define %gen-valid-move
  (%rel (state hist move s a left-behind)
        [(state hist move)
            (%gen-move '(0 1 2 3)  state (cons a s))
            (%is left-behind (toggle-item state a))         
            (%not (%reject left-behind))
            (%check-history s hist)
            (%is move (cons a s))]))

通过前面的开胃菜，我们现在进入正餐：

(define %solve
  (%rel (a s state hist move moves m1 m2)
        [(state (_) moves moves)
          ➊ (%is #t (equal? state #(1 1 1 1))) !]
        [(state hist m1 m2)
          ➋ (%gen-valid-move state hist (cons a s))
          ➌ (%is move (cons a s))
          ➍ (%solve s (cons s hist) (cons move m1) m2)]))

整体策略非常简单：生成一个有效的移动并检查是否到达解决状态。如果我们遇到死胡同，Racklog 的自动回溯机制将回退并尝试另一个不会导致重复状态的移动。%solve谓词以初始状态、一个空列表（表示状态历史）和一个包含至今生成的移动的列表（也是空的）进行调用。最后一个参数是一个标识符，将被实例化为解决难题的移动列表。首先，我们检查谜题是否处于解决状态 ➊；如果是，我们返回移动列表。如果不是，我们获取下一个移动候选和结果状态 ➋（这些被赋值给move ➌），然后递归调用%solve ➍。如果%solve谓词 ➍ 生成了失败，回溯发生。由于%is不能重新满足，回溯会继续回到 ➋ 处，生成另一个可能的解决方案。%solve谓词返回一个对：第一个元素是船上的乘客指示器（有关数字的含义，请参见%gen-move的讨论），第二个元素是移动后的东岸状态。

为了真正解决这个难题，我们像这样调用%solve：

> (%which (moves) (%solve #(0 0 0 0) '() '() moves))
'((moves
   (2 . #(1 1 1 1))
   (0 . #(0 1 0 1))
   (1 . #(1 1 0 1))
   (2 . #(0 0 0 1))
   (3 . #(1 0 1 1))
   (0 . #(0 0 1 0))
   (2 . #(1 0 1 0))))

除了顺序被反转外，输出列表在可读性上还有些欠缺。为了获得更直观的输出，我们定义了几个新的辅助过程。首先，我们创建了 Racklog 谓词版的 Racket printf形式，称为%print。它的第一个参数是格式化字符串，第二个参数是要打印的值。让它工作需要一些技巧。由于printf函数不是谓词，所以不能作为 Racklog 目标调用，也不会返回值，因此正常的实例化方法无法工作。技巧在于将printf形式封装在begin形式中（该形式按顺序求值表达式，并返回最后一个表达式的值），我们将#t作为最终表达式返回。然后，我们可以使用%is实例化它，得到一个始终成功的谓词。

(define %print
  (%rel (fmt val)
        [(fmt val) (%is #t (begin (printf fmt val) #t))]))

第二个辅助过程是一个常规的 Racket 函数，它接受一个状态向量和一个银行编号。它返回一个列表，指示当前银行上有哪些物品。

(define (get-items s b)
  (for/list ([i (in-range 4)] #:when (= b (vector-ref s i)))
    (vector-ref #(Farmer Fox Goose Beans) i)))

给定一系列解法步骤，%print-moves（见下文）将为每个步骤提供两行输出：第一行将表示移动方向和船上的乘客；第二行输出将是一个列表，其中第一个项目是银行 0 的占用者，第二个项目是银行 1 的占用者。我们将此作为一个小练习留给读者去理解其工作原理。

(define %print-moves
  (%rel (s t i pass dir b0 b1 d)
        [('()) %true]
        [((cons (cons i s) t))
         (%is pass (vector-ref
             #(Farmer Farmer-Fox Farmer-Goose Farmer-Beans) i))
         (%is d (vector-ref s 0))
         (%is dir (vector-ref #( <- -> ) d))
         (%print "~a\n" (list dir pass))
         (%is b0 (get-items s (- 1 d)))
         (%is b1 (get-items s (vector-ref s 0)))
         (%if-then-else
            (%=:= 0 d)
            (%print "~a\n\n" (list b1 b0))
            (%print "~a\n\n" (list b0 b1)))
         (%print-moves t)]))

最后，我们得到了这个：

(define %print-solution
  (%rel (moves rev-moves)
        [()
             (%print "~a\n\n" (list (get-items #(0 0 0 0) 0) '()))
             (%solve #(0 0 0 0) '() '() moves)
             (%is rev-moves (reverse moves))
             (%print-moves rev-moves)]))

过程%print-solution不接受任何参数，但它会生成谜题的解法，反转动作列表，并调用%print-moves打印出解法。这里是一个更易读的最终结果：

> (%which () (%print-solution))
((Farmer Fox Goose Beans) ())

(-> Farmer-Goose)
((Fox Beans) (Farmer Goose))

(<- Farmer)
((Farmer Fox Beans) (Goose))

(-> Farmer-Fox)
((Beans) (Farmer Fox Goose))

(<- Farmer-Goose)
((Farmer Goose Beans) (Fox))

(-> Farmer-Beans)
((Goose) (Farmer Fox Beans))

(<- Farmer)
((Farmer Goose) (Fox Beans))

(-> Farmer-Goose)
(() (Farmer Fox Goose Beans))

'()

请记住，最终的空列表是 Racklog 表示成功的方式。

多少块甜甜圈？

以下问题出现在 2007 年 10 月 27 日的Parade杂志“AskMarilyn”专栏中：

Jack、Janet 和 Chrissy 在他们常去的咖啡馆碰面并买了六个甜甜圈。每个朋友要么总是说真话，要么总是撒谎。Jack 说他拿了一块甜甜圈，但 Janet 说 Jack 拿了两块，Chrissy 则说 Jack 拿了三块以上。另一方面，三个人都一致认为 Janet 拿了两块。假设每个人至少拿了一块，而且没有甜甜圈被切分，问每个人拿了多少块甜甜圈？

逻辑编程系统对于这种类型的问题简直是轻松应对（甜甜圈，早餐——有趣吧？），而 Racklog 也不例外。这个问题的特别之处在于，在 Racklog 中的解决方案主要只是对事实的声明（并附带了一些辅助项）。

这里有一些基本定义；注释应该足以解释它们的功能。

#lang racket
(require racklog)

; Each person can have from one to six donuts
(define %can-have
  (%rel (d)
        [(d) (%member d '(1 2 3 4 5 6))]))

; an alias for equality
(define %has (%rel (n) [(n n)]))

; if a person doesn't have d donuts, they have n donuts
(define %not-have
  (%rel (n d)
        [(n d)
           (%can-have n)
           (%=/= n d)]))

这里的目的是确定一个人可以拥有多少个甜甜圈，前提是我们说他们不能拥有某个数量（作为第二个参数提供）。由于%can-have给出了一个人可以拥有的所有甜甜圈，语句(%=/= n d)])将给出他们可以拥有的所有甜甜圈，排除他们不能拥有的数量。

现在我们以两种版本列出每个人的陈述（一种是他们说真话的情况，另一种是他们撒谎的情况）。这里我们将“Chrissy”缩写为“Chris”。

(define %statement
  (%rel (Jack Janet Chris)

        ; Jack's statements
        [('jack Jack Janet)
            (%has Janet 2) (%has Jack 1)]
        [('jack Jack Janet)
            (%not-have Janet 2) (%not-have Jack 1)]

        ; Janet's statements
        [('janet Jack Janet)
            (%has Janet 2) (%has Jack 2)]
        [('janet Jack Janet)
            (%not-have Janet 2) (%not-have Jack 2)]

        ; Chris's statements
        [('chris Jack Janet)
            (%has Janet 2) (%can-have Jack) (%> Jack 3)]
        [('chris Jack Janet)
            (%not-have Janet 2) (%can-have Jack) (%<= Jack 3)]))

我们的求解器只需要检查每个人的陈述，并查看总甜甜圈是否加起来为六个。

(define %solve
  (%rel (Jack Janet Chris)
        [(Jack Janet Chris)
            (%statement 'jack Jack Janet)
            (%statement 'janet Jack Janet)
            (%statement 'chris Jack Janet)
            (%can-have Chris)
            (%is 6 (+ Jack Janet Chris))]))

然后就像魔法一样：

> (%which (Jack Janet Chris) (%solve Jack Janet Chris))
'((Jack . 3) (Janet . 1) (Chris . 2))

Boles 和 Creots

Boles 和 Creots 是一种传统的纸笔破译游戏，也叫做 Bulls 和 Cows，或 Pigs 和 Bulls。一种商业变体叫做 Mastermind，使用的是由彩色小圆钉组成的代码。游戏玩法是由一个玩家选择一个秘密代码（通常是四个或五个独特的数字或字母组成的序列）。另一个玩家然后提出一个猜测，系统提供提示，告诉他们有多少个 boles（正确的数字在正确的位置）和多少个 creots（正确的数字在错误的位置）。玩家继续交换猜测和提示，直到猜测玩家将所有数字按正确顺序猜中。

在这里，我们让计算机尝试猜测一个由人类玩家提供的数字。

策略相当简单：猜测玩家（在此案例中是 Racklog 程序）记录每次猜测和相应的 boles 和 creots 数量。候选猜测由所有可能的数字 0 到 9 的排列组合的暴力生成生成，每个候选猜测都与之前的猜测进行比对，看看是否能得出一致的 boles 和 creots 数量。如果一个候选猜测与之前的猜测没有不一致的地方，它就会成为下一个展示给用户的猜测。为了说明我们的意思，假设游戏已经按下面的表 8-2 进行。

表 8-2：Boles 和 Creots 进展情况

猜测	Boles	Creots
2359	0	2
1297	2	1

在下一轮中，第一个候选猜测是 1973。与表中的第一个猜测相比，这个猜测有两个正确的数字（但位置错误），因此得到了 0 个 boles 和 2 个 creots。到此为止一切正常；但与第二个猜测相比，得到了 1 个 bole 和 2 个 creots，因此被拒绝。假设下一个候选猜测是 9247。与第一个猜测相比，得到了 0 个 boles 和 2 个 creots；与第二个猜测相比，得到了 2 个 boles 和 1 个 creot，因此它是一个不错的候选猜测。程序猜测 9247，得到用户的提示，并更新表格，记录猜测、boles 和 creots。这个过程会重复，直到有人获胜。

为了模拟一个猜测计算机与提示人类之间的游戏，我们的 Racklog 程序使用一个读-评估-打印循环（REPL），该循环打印出一个猜测，等待用户输入（提示），读取输入，并评估该输入以形成下一个猜测。

在我们开始深入代码之前，先来看看一个示例会话。我已经决定了要猜的数字是 12345。对于每次猜测，我的回应是一个两位数，分别表示 boles 和 creots 的数量。

> (%which () (%repl))

Guess: (3 8 2 1 7)
03

Guess: (8 3 1 0 5)
12

Guess: (8 2 3 5 6)
21

Guess: (8 2 0 3 4)
12

Guess: (8 1 4 5 2)
04

Guess: (1 2 3 4 5)
50
'()

整个过程的代码如下所示。它依赖于一些支持过程，稍后将更详细地解释。

(require racklog)

(define DIGITS 5)

(define %repl
  (%rel (digits guess val boles creots)
        [()
         ➊ (%is digits (randomize-digits))
         ➋ (%is #t (begin (set! history '()) #t))
            (%repl digits)]
        [(digits)
         ➌ (%permute-n digits guess DIGITS)
         ➍ (%consistent? guess)
         ➎ (%print "\nGuess: ~a\n" guess)
         ➏ (%= (cons boles creots) (get-input))
         ➐ (%update-history guess boles creots)
         ➑ (%if-then-else (%=:= boles DIGITS) ! %fail)]))

常量DIGITS指定用于猜测的数字个数。%repl谓词实现了读-评估-打印循环。%repl代码生成一个随机化的数字列表，用于生成猜测➊，同时清空history列表➋。实际的循环从➌开始，此时生成排列。每个排列都会进行测试➍，直到生成一个可接受的候选猜测为止，回溯过程会继续进行。生成候选猜测后，用户将看到该猜测➎。接着，系统提示用户提供 boles 和 creots 的数量，结果输入将被解析➏。然后，history列表会被更新➐。最后，输入将被测试，看是否所有数字都正确➑，如果是，使用一个切割符号（!）来终止过程。否则，生成失败，触发回溯并进行额外的猜测。

为了跟踪之前的猜测，定义了一个history列表。列表的每个元素是一个包含以下三个元素的三元组：猜测、boles 的数量和 creots 的数量。history列表由%update-history谓词填充。

(define history '())

(define %update-history
  (%rel (guess boles creots)
        [(guess boles creots)
         (%is #t
              (begin
                (set! history (cons (list guess boles creots) history))
                #t))]))

如上所示，一个猜测由一组数字表示。我们定义了一个score函数，给定两个数字列表，比较它们并返回对应的 boles 和 creots 的数量。

(define (score c h)
  (let loop ([l1 c] [l2 h] [boles 0] [creots 0])
    (if (equal? l1 null)
        (cons boles creots)
        (let ([d1 (car l1)]
              [d2 (car l2)]
              [t1 (cdr l1)]
              [t2 (cdr l2)])
          (if (= d1 d2) 
              (loop t1 t2 (add1 boles) creots)
              (loop t1 t2 boles (+ creots (if (member d1 h) 1 0))))))))

为了防止程序每次都从相同的初始猜测开始，我们定义了一个数字生成器函数，用于创建一个混乱的数字集合以供选择：

(define (randomize-digits)
  (let loop([count 10] [l '()])
    (if (= count 0) l
    (let ([d (random 10)])
      (if (member d l)
          (loop count l)
          (loop (sub1 count) (cons d l)))))))

为了创建猜测候选项，我们需要生成随机数字的排列列表。为此，我们重用了在早期章节中介绍的%permute-n谓词。

(define %permute-n
  (%rel (l h t u v w n m)
        [((_) '() 0) !]
        [(l (cons h t) n)
            (%append v (cons h u) l)
            (%append v u w)
            (%is m (sub1 n))
            (%permute-n w t m)]))

一个名为%consistent?的谓词接受一个猜测并测试它是否与history中的元素一致（如上所定义）。它通过候选猜测调用。

(define %consistent?
  (%rel (g h hb hc gb gc t)
        [((_) '()) %true]
        [(g (cons (list h hb hc) t))
            (%is (cons gb gc) (score g h))
            (%and (%=:= hb gb) (%=:= hc gc))
            (%consistent? g t)]
        [(g) (%consistent? g history)]))

控制输入和输出的工作由get-input和%print负责，具体如下所示。

(define %print
  (%rel (fmt val)
        [(fmt val)
         (%is #t (begin (printf fmt val) #t))]))
(define (get-input)
  (let ([val (read (current-input-port))])
    (let-values ([(boles creots) (quotient/remainder val 10)])
      (cons boles creots))))

在本章的开头部分，我们介绍了逻辑编程范式以及扩展其能力的各种工具和实用程序。在本节中，我们讨论了一些可以通过逻辑编程以自然和声明的方式解决的数学谜题和问题。这些问题展示了逻辑编程内在的强大搜索机制。

总结

在这一章，我们概述了逻辑编程范式，并考察了一些有趣的应用。我们已经看到，除了 Racket 的函数式和命令式编程能力之外，它在逻辑编程方面也相当擅长，得益于其 Racklog 库。逻辑编程（特别是 Prolog）被认为是图灵完备的。简单来说，这意味着任何可以用典型的命令式编程语言计算的内容，也可以用逻辑程序计算。技术上来说，它可以用来模拟图灵机（稍后会详细讲解）。话虽如此，逻辑编程在某些问题领域并不总是最优的。例如，涉及大量数值计算的案例，或者已经有了公认的命令式算法的情况，都不适合使用逻辑编程。逻辑编程尤其在搜索问题上表现出色，就像我们在应用部分看到的那样，以及在定理证明等符号计算中。好消息是，使用 Racket 时，你可以选择最适合当前问题的编程方法。

在下一章，我们将探讨一些抽象的计算机模型，例如前文提到的图灵机。

第九章：计算机

我们都习惯于使用强大的计算设备，这些设备拥有复杂的架构和指令集，但计算机科学的基本理念是基于更简单的设备。基本的思路是从最简单的设备开始，确定哪些类型的计算是可能的。下面我们将探讨三种此类设备，范围从只能执行简单操作（如识别字符串）的设备到能够执行任何算法的设备。

有限状态自动机

在本节中，我们将介绍一种抽象机器——计算模型，而非物理机器——称为有限状态自动机（FSA）或有限状态机（FSM）。尽管其名字很有威慑力，有限状态自动机实际上非常简单。有限状态自动机的存在意义就是执行条件表达式。

FSA（有限状态自动机）有一条（比喻的）带子，上面有一系列符号作为输入。每个符号只读取一次，机器随后会移动到序列中的下一个符号。FSM 是通过有限的状态和转换来建模的，因此得名有限状态机。机器从给定的初始状态开始，根据输入符号转换到另一个状态。在任何给定时刻，它只能处于一个状态。一些状态是接受状态，如果机器在接受状态结束，输入字符串就是有效的。根据输入和从某个状态出发的可能转换，机器可能无法继续，在这种情况下，字符串就是无效的。关键在于，对于每个输入，每个转换都有一个条件。

有限状态自动机可以用于建模许多不同类型的计算，但在本节中，我们将重点介绍它们在计算机科学中的常见用途——识别器：给定输入字符串的程序，判断该字符串是否有效。作为示例，我们将看看一个识别器，它接受形如“HELLO”、“HELLLO”、“HELLOOO”等的字符串，并拒绝所有其他字符串。从这个问题的性质可以看出，FSA 不仅需要能够按条件执行计算，而且重复性（因此也包括迭代）也起着作用。

表示 FSM 程序有很多不同的方式；我们将使用其中两种：状态转换图和状态表。状态转换图是一个有向图，描述了 FSM 如何从一个状态转换到另一个状态。每个状态由一个圆圈表示。初始状态由指向某一状态的箭头表示，接受状态（可以有多个）通常由双圆圈表示。状态通过线条或弧连接，每条线或弧上标有输入符号。FSM 根据当前输入符号是否与其出弧的标签匹配来从一个状态转换到下一个状态。一个字符串如果最终到达某个接受状态，则认为它被接受；否则，它被拒绝。

用于识别我们的“HELLO”字符串的 FSM 如图 9-1 所示。

图 9-1：用于“HELLO”字符串的 FSM

FSM 从状态 0 开始，当接收到输入“H”时，它会转移到状态 1；否则，它会停留在状态 0（表示字符串被拒绝）。一旦进入状态 1，它会期待一个“E”并像之前一样接受或拒绝输入值。它以这种方式继续，直到到达最终的接受状态（状态 4）。请注意，状态 3 可以接受“L”或“O”。像这样的 FSM，每个状态对于每个输入符号只有一个转换，称为确定性有限状态机（或DFA）。也可以构建有限状态自动机，其中一个或多个状态对于相同的输入符号可能转移到多个状态。这种 FSM 称为非确定性有限状态机（或NFA）。对于任何非确定性 FSM，我们可以构造一个确定性 FSM，使它们都能识别相同的字符串集。非确定性 FSM 的优势在于，在某些情况下，它们比确定性版本更简单。在本书中，我们将只使用确定性有限状态机。

我们还可以将我们的有限状态机（FSM）表示为一个状态表（有时称为事件表）。请参见表 9-1。表的第一列包含状态编号，其余列表示输入符号。表格单元格包含给定输入符号对应的下一个状态。如果没有给出状态，则该输入符号会被拒绝。

表 9-1： “HELLO” 字符串的状态表

S	H	E	L	O
0	1
1		2
2			3
3			3	4
4				4

为了在 Racket 中实现一个 FSM 来识别我们的“HELLO”字符串，我们首先定义一个状态表，如下所示：

#lang racket

(define state-table
  (vector
   ;        H  E  L  O
   (vector  1 #f #f #f) ; state 0
   (vector #f  2 #f #f) ; state 1
   (vector #f #f  3 #f) ; state 2
   (vector #f #f  3  4) ; state 3
   (vector #f #f #f  4) ; state 4
   ))

在这种情况下，我们使用 #f 来表示无效的转换。

由于我们使用向量来表示状态表，我们需要一种方法将字符转换为索引。这是通过哈希表来实现的，如下面的定义所示。

(define chr->ndx
  (make-hash '[(#\H . 0) (#\E . 1) (#\L . 2) (#\O . 3)] ))

给定一个状态编号和字符，以下的 next-state 函数会根据状态表返回下一个状态（或 #f）。

(define (next-state i chr)
  (if (hash-has-key? chr->ndx chr)
      (vector-ref (vector-ref state-table i)
                  (hash-ref chr->ndx chr) )
      #f))

最后，这是用来识别我们“HELLO”字符串的 DFA。

  (define (hello-dfa str)
➊ (let ([chrs (string->list str)])
    (let loop ([state 0] [chrs chrs])
   ➋ (if (equal? chrs '()) ; end of string
       ➌ (if (= state 4) 
              #t ;if 4, accepting
              #f ;not 4, not accepting
              )
       ➍ (let ([state (next-state state (car chrs))]
                [tail (cdr chrs)])
            (if (equal? state #f) #f ; invalid
             ➎ (loop state tail)))))))

首先，我们将字符串转换为字符列表 ➊。然后我们遍历这个列表，首先检查是否所有字符都已经被读取 ➋。接着我们检查状态 ➌。如果我们处于接受状态（在本例中是状态 4），我们返回#t表示接受的字符串；否则，我们返回#f。如果整个字符串还没有处理完，我们获取下一个状态和剩余的字符串 ➍。然后我们用剩余的字符串重新开始这个过程 ➎。下面是一些示例运行。

> (hello-dfa "HELP")
#f

> (hello-dfa "HELLO")
#t

> (hello-dfa "HELLLLLOOOO")
#t

> (hello-dfa "HELLOS")
#f

事实证明，有限状态自动机（无论是确定性还是非确定性）都有一定的局限性。例如，不可能构建一个识别匹配括号的有限状态机（因为在任何时刻，我们都需要一个机制来记住遇到多少个左括号）。在下一节中，我们将介绍有限状态机的更智能的兄弟——图灵机。

图灵机

图灵机是英国杰出数学家艾伦·图灵的发明。在最简单的形式下，图灵机是一个由以下组件构成的抽象计算机。

一条可以包含零或一的无限带（也允许任意符号，但我们在这里不使用）
一个可以在每个单元格中读取或写入值并向左或向右移动的头（参见图 9-2）
一个状态表
一个包含当前状态的状态寄存器

图 9-2：图灵机带和头部

尽管这看似简单，但对于任何计算机算法，都可以构造一个图灵机来模拟该算法的逻辑。反过来，任何可以模拟图灵机的计算设备或编程语言都被称为图灵完备。因此，图灵机不受我们前面提到的有限状态自动机的局限性。关于图灵机在分析某些函数是否在理论上可计算的文献非常丰富。我们不会深入这些推测，而是集中讨论机器本身的基本操作。

我们构造的机器将执行一个简单的任务——加两个数字。一个数字，n，将表示为由n个一组成的连续字符串。要加的两个数字将由一个零分隔，头部将位于第一个数字的最左边的一个一上。结果将是一个由一组成的字符串，其长度是两个数字的和。在计算结束时，头部将位于结果的最左边的一个一上。

简而言之，程序通过将最左边的最左边数字中的一个一改为零，然后向右扫描，直到遇到第二个数字的末尾，并在最后一个一后写入一个一。然后头部向左移动，直到发生以下两种情况之一：

它遇到一个零，后跟一个一，这意味着还有更多的 1 需要移动，所以它继续向左移动，以便重新开始。
它遇到两个连续的零，在这种情况下，进行加法操作（因为第一个数字没有剩下其他的 1），并向右移动，直到它定位在最终数字最左边的 1 上。

图 9-3 展示了计算过程中不同时间的带子快照（图中的三角形表示计算开始和结束时的头位置）。

图 9-3：带子的故事

你可能已经猜到，实际上有更直接的方法来组合这两串数字，但所描述的方法更适合应用于其他计算，例如乘法。

编程图灵机包括构造一个状态表。表中的每一行表示一个特定的状态。每个状态根据当前头部读取的零或一来指定三种动作。这些动作包括：写入 1 或 0 到当前单元格、接下来是向左或向右移动，以及下一个状态应该是什么。表 9-2 包含了我们的加法器程序。

表 9-2：图灵机状态表

最上面的行表示输入符号。标有 W 的列表示应写入的值，标有 M 的列表示移动方向（向左或向右），标有 N 的列表示下一个状态编号。标有 x 的条目表示永远不会到达的状态（假设输入和起始状态设置正确）——在这种情况下，条目将无关紧要。机器从状态 0 开始。最终状态（或停机状态）是状态 7，在一的输入的移动列中以 H 表示。

表示图灵机状态变化的另一种方法（可能更容易解读）是使用状态转换图，如图 9-4 所示。在状态图中，每个转换标签包含三个组成部分：读取的符号、要写入的符号，以及移动的方向。

图 9-4：图灵机状态转换图

一个 Racket 图灵机

正如本节开头提到的，能够模拟图灵机的编程语言被称为图灵完备。我们将通过构建这样一个模拟来演示 Racket 本身是图灵完备的（以我们的加法机作为示例程序）。当然，我们不得不在无限磁带上做一些妥协，因此我们的机器将拥有更为简单的磁带，只有 10 个单元格。状态表将由一个向量组成，其中每个单元格代表一个状态。每个状态是一个包含两个单元格的向量，第一个单元格包含读取零时的动作，第二个单元格包含读取一时的动作。动作将由一个名为act的结构表示。act结构将包含字段write、move和next（含义显而易见）。状态将存储在一个名为state的变量中，而头部位置则在head中。考虑到这些初步设定，我们有如下内容：

#lang racket

(define tape (vector 1 1 1 0 1 1 0 0 0 0))

(define head 0)

(struct act (write move next))

(define state-table
  (vector
   (vector (act 0 #f 0) (act 0 'R 1)) ; state 0
   (vector (act 0 'R 2) (act 1 'R 1)) ; state 1
   (vector (act 1 'L 3) (act 1 'R 2)) ; state 2
   (vector (act 0 'L 4) (act 1 'L 3)) ; state 3
   (vector (act 0 'R 6) (act 1 'L 5)) ; state 4
   (vector (act 0 'R 0) (act 1 'L 5)) ; state 5
   (vector (act 0 'R 7) (act 1 #f 0)) ; state 6
   (vector (act 0 #f 0) (act 1 'H 0)) ; state 7
   ))

(define state 0)

尽管在定义中并不严格要求，我们在“无关”状态中加入了一个#f值（表示失败），以防在问题初始设置时引入了某些错误（嘿，谁能做到完美呢）。

在编写指定机器执行的代码之前，我们定义了几个辅助函数来获取各个组件。第一个函数返回给定当前状态和输入符号时的下一个状态，其他两个函数用于获取和设置磁带头的值。

(define (state-ref s i) (vector-ref (vector-ref state-table s) i))
(define (head-val) (vector-ref tape head))
(define (tape-set! v) (vector-set! tape head v))

运行该机器的程序很简单。请注意，这段代码对于任何你编程的图灵机都是一样的；只有tape和state-table会有所变化。

(define (run-machine)
  (let* ([sym (head-val)] ; current input
      ➊ [actions (state-ref state sym)]
         [move (act-move actions)])
    (cond [(equal? #f move)
           (printf "Failure in state ~a, head: ~a\n~a" state head tape)]
       ➋ [(equal? 'H move)
           (printf "Done!\n")]
          [else
        ➌ (let* ([write (act-write actions)]
               ➍ [changed (not (equal? sym write))])
             (tape-set! write)
          ➎ (set! head (if (equal? move 'L) (sub1 head) (add1 head)))
          ➏ (when changed (printf "~a\n" tape))
          ➐ (set! state (act-next actions))
             (run-machine))])))

首先，我们捕捉当前状态和输入➊的动作。然后，我们捕捉下一个要写入的符号➌，并更新下一个状态➐。我们还测试头部是否即将改变磁带上的值➍，如果是这种情况，我们会打印出更新后的磁带➏。头部位置会提前更新➎。一旦达到最终状态➋，程序会打印Done!。以下是输出结果。

#(1 1 1 0 1 1 0 0 0 0)
#(0 1 1 0 1 1 0 0 0 0)
#(0 1 1 0 1 1 1 0 0 0)
#(0 0 1 0 1 1 1 0 0 0)
#(0 0 1 0 1 1 1 1 0 0)
#(0 0 0 0 1 1 1 1 0 0)
#(0 0 0 0 1 1 1 1 1 0)
Done!

推入自动机

“推入自动机”这个词并不是让你去推翻毫无防备的机器人。不，术语推入自动机（或PDA）指的是一类抽象计算设备，它们使用推入堆栈（或仅称为堆栈）。从计算能力上讲，推入自动机的能力恰好介于有限状态自动机和图灵机之间。

PDA 相较于有限状态自动机的优势在于堆栈。堆栈形成了一种基本的内存类型。从概念上讲，堆栈就像一堆盘子，你只能从堆栈顶端移走一个盘子（称为弹出操作）或把一个盘子添加到顶部（称为推入操作）。堆栈的其余部分只能通过从顶部进行添加或移除来访问。为了在 Racket 中模拟这一点，我们将堆栈定义为一个符号串，并且提供两个操作：

推入（Push）。此操作将一个符号添加到堆栈的顶部（字符串的前端）。
弹出（Pop）。弹出操作移除堆栈顶部的符号并返回该符号。

PDA 允许读取栈顶符号，但无法访问其他栈值。栈值不一定要与输入符号相匹配。

像 FSA 一样，PDA 按顺序读取输入并通过状态转移来确定下一个状态，但 PDA 有一个要求：除了处于接受状态外，栈也必须为空，才能接受字符串（但为了实际应用，在下面的示例中我们预先在栈中放入一个唯一标记来表示空栈）。需要注意的是，压栈自动机有确定性和非确定性两种类型。此外，非确定性压栈自动机能够执行更广泛的计算。

尽管我们通常尽量保持介绍的非正式性，但我们将提供一个 PDA 的正式描述，因为如果你决定进一步研究抽象计算机，你很可能会遇到这种类型的符号表示。^(1) 如果你不熟悉集合符号，可能需要跳到第四章中的“集合理论”部分来复习。

通常，PDA 被定义为一个机器 M = (Q, Σ, Γ, q[0], Z, F, δ)，其中以下内容成立：

Q 是有限状态集。
Σ 是输入符号的集合。
Γ 是可能的栈值集合。
q[0] ∈ Q 是起始状态。
Z ∈ Γ 是初始栈符号。
F ⊆ Q 是接受状态的集合。
δ 是可能的转移集合。

允许的转移集合由这个略显复杂的表达式定义（其中 Γ^* 用于表示所有可能的栈字符串，符号 ϵ 用来表示空字符串，即没有任何符号的字符串）。

δ ⊆ (Q × (Σ ∪ {ϵ}) × Γ) × (Q × Γ*)

这并不像看起来那么复杂。基本上，它是说可能的转移集合是所有可能的状态、输入符号和栈值组合的子集（也就是说，转移前的所有可能性），以及所有可能的状态和栈字符串（转移后的所有可能性）。括号中的第一组值表示转移函数的输入，包括以下内容：

当前状态：q ∈ Q
当前输入符号：i ∈ (Σ ∪ {ϵ})（记住，我们使用 ϵ 来表示在某个时刻剩余的字符串可以为空）
栈顶的值：s ∈ Γ

给定这些值，转移定义了下一个状态（第二个 Q）和潜在的新栈值（Γ^*）。对于任何转移，栈要么不变，要么推入新值，或者从栈顶弹出一个值。

栈的变化通过符号 a/b 表示，其中 a 是栈顶的符号，b 是栈顶结果的字符串。例如，如果我们匹配某个输入符号，栈顶是 α，并且我们弹出这个值而不替换它，那么我们用 α/ϵ 来表示。如果我们匹配输入时栈顶是 α，并且需要将 β 压入栈顶，则表示为 α/βα。

识别零和一

现在让我们暂时搁置形式化内容，来看一个简单的例子。一种常见的练习是构建一个 PDA，它能够识别由零和一组成的字符串，其中一串一的长度正好与一串零的长度相等。使用有限状态自动机是做不到这一点的，因为它需要记住在开始扫描一之前已经扫描了多少个零。

表达式 0^(*n*)1(n) 表示我们要寻找的字符串格式（零重复 n 次，后跟一重复 n 次），我们的输入字母表是 Σ = {0, 1}。任何其他输入都不会被接受。为了识别这个字符串，我们只需要跟踪已经读取的零的数量，因此每当输入中遇到零时，我们会将零压入栈顶。当遇到一时，我们从栈中弹出一个零；如果零和一的数量匹配，输入结束时栈中将不剩任何零。为了判断何时弹出了栈中的最后一个零，我们会预先在栈中放入一个特殊标记 ω。因此我们的栈符号集是 Γ = {0, ω}。

图 9-5 是我们 PDA 的状态转移图。

图 9-5：用于 0^(*n*)1(n)的下推自动机

转移到状态 0 的循环上标签 0;ω/0ω 表示在输入中读取一个零，并且栈顶的标记是 ω，然后将零压入栈中。（这是第一个转移。）同样，标签 0;0/00 表示在输入中读取一个零，并且栈顶是零，然后将零压入栈中。标签 1;0/ϵ 表示从状态 0 转移到状态 1，表示读取一个一，并从栈中弹出一个零。状态 1 上的循环继续读取输入中的一，并为每个读取的零从栈中弹出一个零。一旦没有更多的输入值，并且栈中没有零，机器将转移到状态 2，这是一个接受状态。显然，栈中必须包含与读取的零和一相同数量的零，才能到达接受状态。

一个 Racket PDA

在本节中，我们将构造一个 PDA 来识别图 9-6 中描述的字符串。输入将是一个包含若干个 1 和 0 的序列的列表。为了处理该输入，我们将定义 make-reader，它返回另一个函数。

(define (make-reader input)
  (define (read)
    (if (null? input) 'ϵ ; return empty string indicator
        (let ([sym (car input)])
          (set! input (cdr input))
          sym)))
  read)

我们使用 make-reader 函数，并传入我们希望用作输入的列表，它将返回一个函数，每次调用时返回列表中的下一个值。以下是如何使用它的示例。

> (define read (make-reader '(1 0 1)))
> (read)
1
> (read)
0
> (read)
1
> (read)
ϵ

栈也将由一个列表表示。以下代码给出了执行各种栈操作所需的定义。

(define stack '(ω)) ; ω is the bottom of stack marker

(define (pop)
  (let ([s (car stack)])
    (set! stack (cdr stack))
    s))

(define (push s)
  (set! stack (cons s stack)))

(define (peek) (car stack))

由于只有一个有意义的状态，我们不必费心构建状态表。我们将借此机会练习 Racket 的另一个隐藏宝藏——模式匹配。这种模式匹配是 Racket 内置的，与在第八章中介绍的 Racklog 库提供的模式匹配功能不同。模式匹配使用 match 表达式，该表达式包含在 racket/match 库中。^(2)

match 表达式看起来有点像 cond 表达式，但我们无需使用复杂的布尔表达式，而是简单地提供我们想要匹配的数据结构。我们可以使用许多不同的结构作为匹配模式，包括字面值，但我们在这个练习中将简单地使用一个列表。

(define (run-pda input)
  (let ([read (make-reader input)]) ; initialize the reader
    (set! stack '(ω)) ; initialize stack
    (define (pda)
      (let ([symbol (read)]
            [top (peek)])
        (match (cons symbol top)
          [(cons 'ϵ 'ω ) #t] ; accept input
          [(cons  0 'ω)   (begin (push 0) (pda))]
          [(cons  0  0)  (begin (push 0) (pda))]
          [(cons  1 'ω)   (begin (push 1) (pda))]
          [(cons  1  1)  (begin (push 1) (pda))]
          [(cons  0  1)  (begin (pop)    (pda))]
          [(cons  1  0)  (begin (pop)    (pda))]
          [_ #f]))) ; reject input
    (pda)))

请注意，match 表达式如何紧密地与图 9-6 中显示的状态转移相似。我们使用 #t 和 #f 来表示输入是否被接受或拒绝。单个下划线（_）作为通配符，匹配任何内容。在这种情况下，匹配通配符表示该字符串被拒绝。

让我们试试看。

> (run-pda '(1))
#f

> (run-pda '(1 0))
#t

> (run-pda '(1 0 0 1 1 0))
#t

> (run-pda '(0 1 0 0 1 1 0))
#f

> (run-pda '(1 0 0 1 1 0 0 0 1 1 1))
#f

> (run-pda '(1 0 0 1 1 0 0 0 1 1 1 0))
#t

关于语言的一些话

有限状态自动机和下推自动机作为不同类型语言的识别器发挥作用。如果有某个有限状态机器能够接受整个符号字符串集合，那么这个符号字符串集合就叫做正则语言。正则语言的例子包括表示整数的数字字符串集合，或者像 1.246e52 这样的浮点数表示字符串。

有效的算术表达式集合（例如，a + x(1 + y)）是上下文无关文法（CFG）的一个例子。由下推自动机接受的字符串所组成的语言被称为上下文无关语言。这意味着我们可以构造一个下推自动机来识别算术表达式。

有限状态自动机和下推自动机在将现代计算机语言字符串转换为令牌中发挥着关键作用，这些令牌可以被传递给 PDA 进行语法分析。解析器将输入语言转换为一种叫做抽象语法树的结构，然后可以将其传递给编译器或解释器进行进一步处理。

总结

在本章中，我们探讨了几种简单的计算机机器：有限状态自动机、下推自动机和图灵机。我们看到，尽管这些机器简单，但它们能够解决实际问题。在下一章中，我们将广泛应用这些概念，它们识别通用字符串和表达式的能力将用于开发一个交互式计算器。

第十章：TRAC: RACKET 代数计算器

Racket 提供了一个面向语言编程的生态系统。它拥有广泛的内建功能，可以构建宏、词法分析器和解析器生成器。在本章的最后，我们遗憾地没有时间探索所有这些引人入胜的主题。然而，我们将探索计算机科学中的一些新话题，并利用前面章节中介绍的许多主题（尤其是前一章中介绍的计算机概念）。

在这个过程中，我们将构建一个名为 TRAC（Racket 代数计算器）的命令行程序，它将接收一个表示代数表达式的字符字符串并计算其值。事实上，TRAC 是一种简化版的编程语言。如果需要，它可以通过多种方式扩展，以实现一个完整的编程语言。

这个程序将能够处理如下对话：

> let x = 0.8
> let y = 7
> (x + 1.2)*(7.7 / y)
2.2

TRAC 流程

为了构建 TRAC，我们将使用以下的处理流程，该流程分阶段处理输入，以便计算输出。

词法分析器（或 词法分析器）负责接收输入字符串，并将其分解为一系列可以传递给解析器进一步处理的标记。例如，考虑以下字符串：

"(x + 1.2)*(7.7 / y)"

给定上述字符串，词法分析器将返回类似于以下的输出列表：

("(" "x" "+" 1.2 ")" "*" "(" 7.7 "/" "Y" ")" )

一旦我们生成了标记列表，我们就可以将其传递给解析器。解析器的任务是通过构建一种称为 抽象语法树（或 AST）的结构，来确定输入的结构。AST 是表达式结构的描述。像刚刚引入的数学表达式具有一种倒置的树状结构。我们示例表达式的 AST 如图 10-1 所示。

图 10-1：(x* + 1.2)(7.7 / y) 的 AST

然后，我们可以将 AST 传递给 解释器，以评估表达式并计算结果。如果我们在构建一个完全的计算机语言，AST 将被传递给编译器和优化器，在那里它将被转换成机器代码，以便高效执行。严格来说，如果仅仅是构建一个解释器，则不需要构建 AST，因为解析器可以直接在运行时进行任何必要的计算，但稍后我们会看到，拥有 AST 使我们能够操作它，从而推导出其他有用的结果。

处理流水线（词法分析器、解析器、解释器）除了提供明确的职责分离外，还允许我们插入针对特定任务优化的不同模块。例如，解释器适合交互式计算，但不适合长期运行的计算。在这种情况下，我们希望将解释器替换为编译器。这将允许我们的代码被转换为机器码，并通过 CPU 直接执行以全速运行。

我们将依次讨论并实现这些组件，直到我们拥有一个功能齐全的代数计算器；然后，我们将研究几种改进 TRAC 的方法。

词法分析器

为了将输入分割成标记，词法分析器一次扫描一个字符，寻找特定的模式。从高层次来看，标记就是一些可以以某种方式分类的字符序列。例如，一串数字如 19876 可以被归类为整数标记。以字母开头，后面跟着零个或多个字母和数字的字符串（如“AVG1”或“SIN”）可以被归类为标识符标记。词法分析器通常会忽略不必要的字符，如空格和制表符（Python 语言是一个显著的例外）。

每个模式都可以通过有限状态机（FSM）来表示（参见第九章）。我们将使用的一个 FSM 是无符号整数的识别器。在接下来的讨论中，某些字符集组合在一起时，称为字符类。我们需要的一个字符类是由 0 到 9 的数字组成的字符，我们将其简单地指定为数字类。无符号整数完全由数字类中的数字串组成，因此我们可以通过下图所示的 FSM 来表示它的识别器，在该 FSM 中，数字类由一个大写斜体字母D表示。

图 10-2：用于识别数字的有限状态机（FSM）

该图表显示无符号整数总是以数字开始，后面可以跟任意数量的尾随数字。表示无符号整数的另一种方法是使用语法图，例如图 10-3 所示。

图 10-3：用于识别数字的语法图

在这种情况下，数字类使用类似打字机字体的样式表示，如digit。语法图有时可以提供一种更直观的模式识别表示方式。语法图显示，在接受一个数字后，分析器可以选择性地循环回去接受另一个数字。

为了真正有用，TRAC 需要能够识别的不仅仅是整数。以下图 10-4 中的语法图展示了一个可以接受由无符号整数、带小数点的浮点数以及带有嵌入 e 的科学计数法表示的数字组成的识别器。

图 10-4：识别数字的语法图

请注意，语法图可以嵌套：图 10-4 中的框包含了图 10-3 中的识别器。我们留给读者作为练习，构建对应的 FSM。

除了识别数字，TRAC 还可以识别标识符（如 let x = 4 中的 x）。TRAC 标识符总是以字母开头，后跟任意数量的字母或数字。我们将字母类指定为斜体大写字母 L。因此，以下 FSM（见图 10-5）将用于识别 TRAC 标识符：

图 10-5：识别标识符的 FSM

这是图 10-6 中对应的语法图。

图 10-6：识别标识符的语法图

正则表达式

到目前为止，讨论一直处于一种相对抽象的层次。现在的问题是，如何实际获得一个能够识别各种字符模式的有限状态机（FSM）？ 答案是正则表达式。正则表达式本质上是一种特殊语言，用于构建有限状态机（在这种情况下，Racket 会为我们构建 FSM，给定正则表达式）。我们的标记（例如，构成整数的数字字符串）实际上是正则语言。回顾上一章，正则语言是指存在一个 FSM 可以接受整个字符串集的语言。正则表达式有些不同。正则表达式（与正则语言不同）实际上是用来构建一个识别正则语言的 FSM 的规范。

这是一个可以用来识别无符号整数的正则表达式：

[0-9][0-9]*

方括号中的表达式是字符类。在这种情况下，它是从 0 到 9 的数字类。这个正则表达式包含了两个字符类，都是用来识别数字的。解释这种方式是，第一个类将识别一个数字，但第二个类，由于后面紧跟着星号，将识别零个或多个额外的数字（星号被称为 克里尼星号，以纪念斯蒂芬·克里尼，他正式化了正则表达式的概念）。一种更简洁的方式是使用以下正则表达式：

[0-9]+

后缀的加号（称为 克里尼加号）表示我们想要识别由一个或多个字符组成的字符串。

克利尼星号和克利尼加号被称为量词。另外一个正则表达式量词是问号 ?。问号匹配零次或一次正则表达式的出现。如果我们想捕捉恰好有一位或两位数字的数字，可以这样指定：

[0-9][0-9]?

还有许多其他方式可以指定正则表达式类。我们已经看到的数字版本指定了一个范围，其中连字符 (-) 用于分隔起始字符和结束字符。还可以在一个类中指定多个范围。例如，要指定一个同时包含大写字母和小写字母的类，可以使用 [A-Za-z]。一个类还可以包含任何任意字符集合——例如 [abCD]。

对于我们的目的，我们将定义一个包含算术运算符的类：[-+/*^]。关于这个特定类，有几点需要注意。首先，由于类以连字符开始，因此连字符不会用于指定范围，它被当作普通字符处理。第二点是，如果连字符 (^) 是类中的第一个项目，它将被特殊处理。例如，正则表达式 [^abc] 会匹配除 a、b 或 c 外的所有字符。

这些只是基础知识。了解了这些概述后，让我们来看看 Racket 如何实现正则表达式，并在此过程中更深入地挖掘正则表达式的能力。

Racket 中的正则表达式

Racket 使用 regexp 函数构建正则表达式，该函数接受一个字符串并将其转换为正则表达式：

> (define unsigned-integer (regexp "[0-9]+"))

还有一个特殊的文字正则表达式值，它以 #rx 开头。例如，一个识别无符号整数的正则表达式值是 #rx"[0-9]+"（或者如果你喜欢打字，可以用 #rx"[0-9][0-9]*"）。这种语法是一种构建正则表达式的简写方法。

正则表达式值与函数 regexp-match 和 regexp-match-positions 一起使用。假设我们想在字符串 "Is the number 1234 an integer?" 中查找嵌入的整数。可以通过以下方式之一来实现：

> (regexp-match #rx"[0-9]+" "Is the number 1234 an integer?")
'("1234")

匹配结果以列表的形式返回。之所以这样做，是因为正则表达式可以包含子表达式，这会导致额外的匹配项被返回。我们稍后会讨论这一点。regexp-match-positions 函数的工作方式与 regexp-match 类似。不同之处在于，regexp-match-positions 不返回匹配的字符串；相反，它返回可以与 substring 一起使用的索引，以提取匹配的内容。下面是一个示例。

> (regexp-match-positions #rx"[0-9]+" "Is the number 1234 an integer?")
'((14 . 18))

> (substring "Is the number 1234 an integer?" 14 18)
"1234"

这些函数有许多有用的可选参数。通过指定起始位置和停止位置，可以限定搜索范围，而不是搜索整个字符串。以下是一些示例。

> (regexp-match #rx"[0-9]+" "Is the number 1234 an integer?" 14 18)
'("1234")

> (regexp-match-positions #rx"[0-9]+" "Is the number 1234 an integer?" 14 18)
'((14 . 18))

> (regexp-match #rx"[0-9]+" "Is the number 1234 an integer?" 16)
'("34")

在第二个例子中，注意 regexp-match-positions 总是返回从字符串开始位置的匹配位置，而不是从指定的起始位置开始。结束位置是可选的，如果没有指定，搜索会一直进行到字符串的末尾，就像第三个例子中所示。

可能最基本的正则表达式就是字面上的字母和数字。例如，要判断一个字符串是否包含字符串 "gizmo"，可以形成这样的查询：

> (regexp-match #rx"gizmo" "Is gizmo here?")
'("gizmo")

> (regexp-match #rx"gizmo" "Is gixmo here?")
#f

当然，这种功能也可以通过 string-contains? 来实现，但正则表达式要强大得多。与 Kleene 星号和加号操作符配合使用时，我们可以形成更加复杂的查询。

> (regexp-match #rx"cats.*dogs" "It's raining cats and dogs!")
'("cats and dogs")

正则表达式中的句点（.）会匹配任何单一字符，因此上面的正则表达式会匹配任何包含字符串 "cats"，并且在其他地方跟随字符串 "dogs" 的子字符串。

如果我们只想知道字符串中是否包含 "cats" 或 "dogs"，该怎么办？这时正则表达式的或操作符，即竖线（|），就派上用场了。

> (regexp-match #rx"cats|dogs" "Do you like cats?")
'("cats")
> (regexp-match #rx"cats|dogs" "Or do you like dogs?")
'("dogs")

上箭头符号（^）和美元符号（$）是特殊的正则表达式标记。上箭头表示匹配必须从字符串的开始处开始，或者如果指定了起始位置，则从起始位置开始。同样，美元符号表示匹配必须延伸到字符串的末尾或结束位置（如果指定了的话）。

> (regexp-match #rx"^[0-9]+" "Is the number 1234 an integer?" 16)
'("34")

> (regexp-match #rx"^[0-9]+" "Is the number 1234 an integer?")
#f

> (regexp-match #rx"^[0-9]+" "987 is an integer!")
'("987")

> (regexp-match #rx"[0-9]+$" "987 is a number?")
#f

> (regexp-match #rx"[0-9]+$" "The number is at the end: 987")
'("987")

Table 10-1 提供了各种正则表达式操作符的摘要描述。表格中的字符串“…”代表一组任意字符。

Table 10-1：正则表达式操作符

Operator	描述
.	匹配任何字符
x*	匹配 x 零次或多次
x+	匹配 x 一次或多次
x?	匹配 x 零次或一次
x∣y	匹配 x 或 y
^	匹配字符串的开始
$	匹配字符串的结束
[…]	定义字符类
[^…]	定义排除字符类

到目前为止讨论中有一个不明显的地方，那就是每个字母和数字实际上都是一个正则表达式。像 "abc" 这样的字符串实际上是字母 a、b 和 c 的连接。就像数学表达式中的乘法（例如 3a）一样，连接在正则表达式中是隐式的。并且像乘法与加法一样，连接的优先级高于或（|）操作符。这意味着像 "abc|def" 这样的表达式会被解释为 "(abc)|(def)"，而不是 "ab(c|d)ef"（注意，最后两个字符串中的括号只是用来说明正则表达式 "abc|def" 是如何被解释的，但请参见下面关于括号在正则表达式中的作用）。

括号在正则表达式中用于将子表达式组合在一起，并指定评估的顺序。让我们看看这如何发挥作用。

> (regexp-match #rx"abc|def" "abcdef")
'("abc")

> (regexp-match #rx"abc|def" "defabc")
'("def")

> (regexp-match #rx"(abc)|(def)" "abcdef")
'("abc" "abc" #f)

> (regexp-match #rx"ab(c|d)ef" "abcdef")
#f

> (regexp-match #rx"ab(c|d)ef" "abcef")
'("abcef" "c")

前两个示例返回匹配 "abc" 或 "def" 的字符串的第一部分。

第三个示例，使用子表达式，返回三个值。第一个是符合整体正则表达式的预期匹配。第二个值表示对这个问题的回答：在第一个返回值中，子表达式 "(abc)" 的匹配是什么？在这个案例中，值就是字符串 "(abc)"。第三个值回答这个问题：在第一个返回值中，子表达式 "(def)" 的匹配是什么？在这个案例中没有匹配，因此返回 #f。

在第四个示例中，匹配失败，因为正则表达式在查找包含 c 或 d 的字符串，但不能同时包含两者。在最后一个示例中，整个字符串被匹配，这在第一个返回值中有所体现，但第二个返回值反映了只有子表达式 "(c|d)" 中的 "c" 被匹配。

在我们的词法分析器中，我们希望使用子表达式，但我们只关心整体正则表达式是否找到匹配，而不关心各个子表达式的匹配（也就是说，我们主要使用它来控制评估）。在这种情况下，我们将使用特殊的括号语法 "(?>...)"，表示我们只想要整体匹配，而不返回匹配的子表达式（请注意，?: 的作用与 ?> 类似，但 ?: 允许指定匹配模式，如是否区分大小写——具体请参见 Racket 文档）。

> (regexp-match #rx"(?>abc)|(?>def)" "abcdef")
'("abc")

regexp-match 的一个有趣变种是 regexp-match*。这个特定的函数（虽然我们在应用中不需要它）只返回子表达式的匹配项。

> (regexp-match* #rx"(abc)|(def)" "abcdef")
'("abc" "def")

请注意，regexp-match 只匹配 "abc"，而 regexp-match* 返回所有匹配的列表，因此会返回 "abc" 和 "def"。更多信息请参见 Racket 文档中的 regexp-match*。

注意

Racket 提供了一种附加的正则表达式形式，符合 Perl 编程语言中使用的正则表达式。用于创建这种正则表达式的函数叫做 pregexp。还有一种文字语法，类似于 #rx 形式，但以 #px 开头。Perl 语法提供了一些有用的扩展，包括预定义的字符类。由于我们的需求相对简单，我们将坚持使用上述基本语法。

TRAC 中的正则表达式

在 TRAC（或者任何计算器中），我们需要识别有效的数字字符串（准确来说是浮动小数点数）。此外，我们还需要定义变量，这意味着我们需要能够定义标识符。我们还需要指定数学运算符，如加法、减法等，并定义一组合理的基本函数名。这些都需要使用正则表达式。

为了我们 TRAC 应用的需要，我们将始终指定正则表达式搜索的起始位置，因此每个正则表达式都会以^开始。标识符的识别器定义如下：

(define regex-ident #rx"^A-Za-z*")

从上面的信息应该能清楚地看出，这将匹配任何以字母开头，后面跟着零个或多个字母或数字的字符串。

数字的识别器（如下所示）稍微复杂一点，但唯一的新元素是带有\\.的部分。由于句点（.）是一个匹配任意字符的正则表达式，它需要被转义，以便将其视为普通字符（如果字符在正则表达式中具有特殊含义，转义就是去除或转义这种特殊含义的一种方式）。为了避免转义句点，我们也可以将\\.指定为[.]，这在某些上下文中可能更容易阅读。正则表达式的转义字符是反斜杠（\），而且由于它嵌入在 Racket 字符串中，因此必须通过在前面加一个斜杠来转义。

(define regex-number #rx"^[0-9]+(?>\\.[0-9]+)?(?>e[+-]?[0-9]+)?")

虽然这有点长，但它与前面图 10-4 中给出的语法图定义非常相似。让我们回顾几个测试用例。

> (regexp-match regex-number "123")
'("123")

> (regexp-match regex-number "a123")
#f
(@\pagebreak@)
> (regexp-match regex-number "123.")
'("123")

注意在最后的表达式中，匹配没有包括小数点，因为我们规定小数点后必须至少跟随一个数字。这与语法图一致，因为匹配是直到但不包括小数点。如果正则表达式以$结尾，这个匹配将会失败。请注意以下内容。

> (regexp-match regex-number "123.0")
'("123.0")

在这种情况下，整个字符串都会被匹配。这里有几个更多的例子。

> (regexp-match regex-number "123.456")
'("123.456")

> (regexp-match regex-number "123.456e")
'("123.456")

同样，匹配没有包括e，因为我们规定e后必须跟随至少一个数字。

> (regexp-match regex-number "123.456e23")
'("123.456e23")

> (regexp-match regex-number "123.456e+23")
'("123.456e+23")

> (regexp-match regex-number "123e+23")
'("123e+23")

> (regexp-match regex-number "123e23")
'("123e23")

> (regexp-match regex-number "e23")
#f

算术运算符的定义很明显。

(define regex-op #rx"^[-+*/^=]")

我们希望跳过任何空格字符，因此我们将其添加到我们的工具箱中：

(define regex-ws #rx"^ *")

为了让 TRAC 真正有用，我们包括了常见的超越函数。

(define regex-fname #rx"^(sin|cos|tan|asin|acos|atan|log|ln|sqrt)")

最后，为了方便变量赋值，我们为关键字创建了一个正则表达式。目前，let是我们唯一的关键字。

(define regex-keyword #rx"^let")

词法分析器

在定义了必要的定义后，我们继续实际定义词法分析器。我们不仅仅返回一个令牌列表，而是将每个令牌值与其类型进行补充。例如，如果匹配到了一个标识符，我们将返回一个对：对的第一个元素是令牌类型，在这种情况下是identifier，第二个元素是匹配的字符串。这些额外的信息将使解析器的工作稍微容易一点。

词法分析器（从概念上讲）相当简单：它只是顺序地尝试匹配每种令牌类型，并跟踪匹配字符串的位置。如果没有找到匹配项，过程会失败。如果找到匹配项，则会记录令牌及其位置，并在下一个位置重复该过程。这个过程会一直持续，直到整个输入字符串被消耗完。

另一个值得注意的点是，我们使用regexp-match-positions作为我们的匹配函数。这将使我们在匹配成功后，轻松获取下一个匹配位置。

TRAC 的词法分析器是一个名为tokenize的函数，如下所示。代码的主体部分只有几行（见cond块➌）；其余部分由一些辅助函数组成，用于处理一些账务管理。

(define (tokenize instr)
  (let loop ([i 0])
    (let* ([str-len (string-length instr)]
           [next-pos 0]
        ➊ [start (cdar (regexp-match-positions regex-ws instr i))])

      (define (match-reg regex)
        (let ([v (regexp-match-positions regex instr start)])
          (if (equal? v #f)
              (set! next-pos #f)
              (set! next-pos (cdar v)))
          next-pos))

   ➋ (define (classify type)
        (let ([val (substring instr start next-pos)])
          (if (equal? type 'number)
              (cons type (string->number val))
              (cons type val))))

      (define (at-end)
        (or (= str-len next-pos)
            (let ([c (string-ref instr next-pos)])
              (not (or (char-numeric? c) (char-alphabetic? c))))))

      (let ([token
          ➌ (cond [(= start str-len)'()]
                ➍ [(and (match-reg regex-keyword) (at-end))
                      (classify 'keyword)]
                   [(and (match-reg regex-fname) (at-end))
                      (classify 'fname)]
                   [(match-reg regex-ident) (classify 'ident)]
                   [(match-reg regex-number) (classify 'number)]
                   [(match-reg regex-op) (classify 'op)]
                ➎ [(equal? #\( (string-ref instr start))
                      (set! next-pos (add1 start))
                      (cons 'lpar "(")]
                ➏ [(equal? #\) (string-ref instr start))
                      (set! next-pos (add1 start))
                      (cons 'rpar ")")]
                   [else #f])])
        (cond [(equal? token '()) '()]
           ➐ [token (cons token (loop next-pos))]
           ➑ [else (error (format "Invalid token at ~a." start))])))))

在从第二行开始的循环的每次迭代中，变量i表示输入字符串instr中的当前位置。初始化str-len和next-pos后，函数会跳过任何空白字符➊。match-reg函数执行传递给它的正则表达式，并将next-pos设置为字符串中的下一个位置（如果匹配成功）；否则设置为#f。如果匹配成功，则返回next-pos；否则返回#f。classify函数➋将标记类型和标记值合并到一个 Racket 的cons单元中。如果标记是数字，它还会将字符串值转换为相应的数字值。at-end函数测试词法分析器是否已经到达关键字或函数的结尾。像sine这样的字符串是有效的变量名，但不能作为函数名sin，因此at-end允许词法分析器区分不同的输入类型。

有了这些函数，实际的字符串标记化逻辑就相当简单。首先会进行检查➌，判断我们是否已经到达字符串的末尾，如果是，则返回空列表。接着进行一系列检查➍，判断当前字符串位置的文本是否与指定的某个正则表达式匹配；如果匹配，则通过classify将匹配的标记打包成一个cons单元并返回。如果没有找到匹配项，cond语句将返回#f，从而生成一个错误➑。如果token的值不是#f，则将其添加到返回的列表中➐。我们没有为括号设置正则表达式，因为它们可以很容易地通过➎➏处理。

正则表达式的评估顺序是非常重要的。如果regex-ident在regex-fname之前被评估，像cos这样的函数名可能会被错误地解释为普通变量名，而不是余弦函数（这可以在解析器中处理，但最好将尽可能多的工作委托给词法分析器）。

下面是输出的一个示例：

> (tokenize "(x1*cos(45) + 25 *(4e-12 / alpha)²")
'((lpar . "(")
  (ident . "x1")
  (op . "*")
  (fname . "cos")
  (lpar . "(")
  (number . 45)
  (rpar . ")")
  (op . "+")
  (number . 25)
  (op . "*")
  (lpar . "(")
  (number . 4e-012)
  (op . "/")
  (ident . "alpha")
  (rpar . ")")
  (op . "^")
  (number . 2))

解析器

我们的下一个主要 TRAC 组件是解析器。解析器接受来自词法分析器的标记列表，并输出一个抽象语法树，该语法树可以进一步由解释器或编译器处理。我们首先提供一个正式的语法定义，作为构建解析器的指导。

TRAC 语法规范

计算机语言通常通过一种称为扩展巴科斯–诺尔形式（EBNF）的元语法（描述另一种语法的语法）来指定。你会发现 EBNF 与正则表达式有许多相似之处，但 EBNF 具有更强的表达能力。EBNF 可用于描述上下文无关文法，或CFG（参见第 272 页的“关于语言的一些话”），这类文法超出了正则表达式的范围。（TRAC 使用的是 CFG）。这种符号将用于给 TRAC 提供形式定义。我们将从简单开始，正式定义digit的含义（实际上我们将使用词法分析器来识别数字和标识符，但为了介绍 EBNF 的简单示例，我们也在这里定义它们）。

digit = "1" | "2" | "3" | "4" | "5" | "6" | "7" | "8" | "9";

这被称为产生式规则。与正则表达式一样，竖线（|）表示或。引号中的项目（" "）称为终结符，而标识符digit称为非终结符。终结符是一系列实际字符（例如你在计算机终端上输入的字符）。非终结符是一个规则的标签，例如上面的digit。letter的定义类似，但我们这里不展示，因为你可以自行推断。

unsigned的产生式直接来自digit：

unsigned = digit , { digit };

在 EBNF 中，大括号{和}几乎完全像克里尼星（Kleene star），不同之处在于它们还允许将项组合在一起。这意味着大括号内的项可以重复零次或多次。逗号（,）是连接操作符。

在这些实体确定后，我们定义identifier如下：

identifier = letter , { letter | digit };

number的产生式如下：

number = unsigned , [ "." unsigned ]

, [ "e", [ "+" | "-" ] , unsigned ];

这个产生式引入了方括号[和]的使用。与正则表达式中的?类似，方括号包含可选项。

函数名定义如下：

| "log" | "ln";

所有这些产生式都有正则表达式的等价形式，因此实现由词法分析器管理。语法分析器将实现更复杂的产生式规则。算术表达式通常包含多个层次的嵌套括号表达式；这样的表达式构成了上下文无关文法。如前一章所述，解析这种表达式超出了有限状态自动机（FSA，进而是正则表达式）的能力。因此，我们现在需要 EBNF 的表达能力来完成我们的定义。

完成这些初步工作后，我们可以给出 TRAC 语法的其余部分定义。由于我们仅使用没有空格的产生式名称，因此省略逗号，因此连接操作是隐式的。

statement = "let" identifier "=" expr

| expr;

expr = term { [ "+" | "-" ] term };

term = neg { [ "*" | "/" ] neg };

neg = "-" neg

| pow;

pow = factor | factor "^" pow;

factor = number

| identifier

| "(" expr ")"

| fname "(" expr ")";

这些规则是这样编写的，使得优先级更高的运算符被嵌套在更深的地方。因为 EBNF 的求值方式（见下例），这确保了乘法和除法在加法和减法之前发生。同样，指数运算发生在乘法和除法之前。还要注意，pow产生式是递归定义的，递归调用位于运算符的右侧。这使得指数运算是右结合的，这是正常的处理方式（即，a^b^c被解释为a^(b^c)，其中最右侧的指数运算首先进行）。

表 10-2 展示了如何为表达式a * (1 + b)扩展产生式。

表 10-2：a * (1 + b)的展开

标准字体用于表示终结符，而斜体用于表示非终结符规则。符号expr-op表示表达式运算符+和-，而term-op表示项运算符*和/。请注意，只有最左侧的产生式会展开，直到识别出一个终结符值。展开从第 1 行的statement规则开始。一个statement可以是一个expr，而expr又可以是一个term；这在第 2 行和第 3 行中得到了体现。

一个term可以是一个neg，后跟一个term-op，再后跟一个neg。这一点在第 4 行展示。展开按这种方式继续，直到我们到达第 7 行。请注意，我们的最左侧规则是identifier。现在我们有一个终结符a，它满足这个规则。这个规则的展开显示在第 8 行。此行的最左侧规则是term-op，它可以展开为终结符*。展开继续进行，直到我们在第 22 行解析完整个字符串。

这个语法是设计成一个LL(1)语法。LL(1)中的 LL 表示它从左到右扫描输入（来自词法分析器的符号列表），使用最左推导（就像我们在上面的讲解中做的那样），并且具有一个向前看（向前看定义了我们需要查看输入符号列表的多远）的范围为一个符号（符号）。这种特定类型的语法允许解析器以一种无需回溯即可解析输入流的方式构建。LL(1)语法由递归下降解析器识别，其中每个非终结符产生式都有一个过程（或函数），负责识别其语法部分，并返回相应的语法树部分（如果输入不正确，则生成错误）。

TRAC 解析器

如前一节所述，TRAC 将使用递归下降解析器。递归下降解析器主要是一组相互递归的函数，每个语法规则都有一个对应的函数。总是有一个起始函数（对应于顶层规则——这就是为什么它被称为自顶向下解析器），该函数根据语法规则调用其他函数。定义中的descent部分之所以存在，是因为规则会继续嵌套，直到遇到终结符（或错误）。

我们需要一些全局变量来跟踪解析过程中的令牌。

(define token-symbol #f)
(define token-value null)
(define token-list '())

接下来是用于测试各种运算符类型的谓词。

(define (assign?) (equal? token-value "="))

(define (pow?) (equal? token-value "^"))

(define (neg?) (equal? token-value "-"))

(define (term?) (or
                  (equal? token-value "*")
                  (equal? token-value "/")))

(define (expr?) (or
                  (equal? token-value "+")
                  (equal? token-value "-")))

以下过程会在每次请求下一个标记值时更新令牌信息。

(define (next-symbol)
  (unless (null? token-list)
    (let ([token (car token-list)])
      (set! token-symbol (car token))
      (set! token-value (cdr token))
      (set! token-list (cdr token-list)))))

accept函数测试输入的令牌是否为预期类型，如果是，则读取下一个令牌并返回#t；否则返回#f。

(define (accept sym)
  (if (equal? token-symbol sym)
      (begin
        (next-symbol)
        #t)
      #f))

expect函数测试输入的令牌是否为预期类型，如果是，则读取下一个令牌并返回#t；否则，它会产生错误。

(define (expect sym)
  (if (accept sym)
      #t
      (if (null? token-list)
          (error "Unexpected end of input.") 
          (error (format "Unexpected symbol '~a' in input." token-value)))))

我们同时使用accept和expect的原因是，在某些情况下，我们需要测试各种令牌类型，而不产生错误。例如，factor规则接受多种不同类型的令牌。如果我们在测试一个数字时，当前令牌是一个标识符，我们不希望产生错误，因为即使数字测试失败，我们仍然希望测试标识符，因此使用accept。另一方面，如果预期的令牌必须是某种特定类型，我们使用expect函数，如果当前令牌不是预期的类型，它将产生错误。

现在我们可以定义与每个语法生成式对应的函数。尽管递归下降解析器是自顶向下的解析器，但我们将从底向上展示代码。这样依赖关系更少，应该更容易理解。基于此，第一个函数是factor：

(define (factor)
  (let ([val token-value])
    (cond [(accept 'number) (cons 'number val)]
          [(accept 'ident) (cons 'ident val)]
       ➊ [(accept 'lpar)
           (let ([v (expr)])
             (expect 'rpar)
             v)]
          [(accept 'fname)
           (let ([fname val])
             (expect 'lpar)
             (let ([v (expr)])
               (expect 'rpar)
               (cons 'func-call (cons fname v))))]
          [else (error (format "Invalid token: ~a." token-value))])))

请注意，我们需要将当前的令牌值保存在val中（它在let的第一行被设置）。一旦调用了accept并找到匹配项，变量token-value会被设置为下一个令牌的值，但这不是我们在代码的cond部分返回值所需要的内容。各种cond测试与factor生成式之间的对应关系应该是显而易见的。关于第三个条件分支➊的简要说明，如果我们回顾一下factor的规则，会发现"(" expr ")"是一个有效的生成式。因此，我们看到这段代码接受一个左括号，调用expr来解析该部分规则，然后期望一个右括号（如果当前标记不是右括号，则会报错）。

对于每个接受的值，会创建一个cons单元，其中第一个元素是一个符号，用于标识节点类型，第二个元素是值。factor规则中的函数调用部分（fname "(" expr ")"）没有给它起名字，但我们在这里指定func-call来标识节点类型。定义规则的函数的这种模式将在所有的产生式中得到复制，最终的结果是构造语法树所需的解析器。

接下来是pow的代码：

(define (pow)
  (let ([e1 (factor)])
    (if (pow?)
        (begin
          (next-symbol)
       ➊ (let ([e2 (pow)])
            (cons '^ (cons e1 e2))))
        e1)))

这是以一种方式编写的，目的是强制执行语法规则，要求它是右结合的。通过递归调用pow ➊来管理这一点。pow返回的值要么是factor返回的值，要么是一个新对（如果识别到符号^）。这个新对的第一个元素是字符^，第二个元素是另一个对，其中第一个元素是基数（来自e1），第二个元素是它的幂（来自对pow的递归调用）。

neg（一元减法）的代码非常简单。如果需要，它会将一个否定操作符附加到pow的返回值上，从而生成一元减法的节点。

(define (neg)
  (if (neg?)
      (begin
        (next-symbol)
        (cons 'neg (neg)))
      (pow)))

乘法和除法由下一个函数term处理。只要它继续识别其他term操作符（*或/），它就会循环，从neg中收集值。注意这与pow的代码不同：这段代码使得term操作符是左结合的，而pow的代码使得指数运算是右结合的。

(define (term)
  (let ([e1 (neg)])
    (let loop ()
      (when (term?)
        (let ([op (if (equal? token-value "*") '* '/)])
          (next-symbol) 
          (let ([e2 (neg)])
            (set! e1 (cons op (cons e1 e2)))))
        (loop)))
    e1))

加法和减法由expr管理。这个函数的工作方式与term类似。

(define (expr)
  (let ([e1 (term)])
    (let loop ()
      (when (expr?)
        (let ([op (if (equal? token-value "+") '+ '-)])
          (next-symbol) 
          (let ([e2 (term)])
            (set! e1 (cons op (cons e1 e2)))))
        (loop)))
    e1))

最后，我们来到顶层，大部分需要做的工作是设置解析赋值语句的过程。

(define (statement)
  (if (equal? token-value "let")
      (begin
        (next-symbol)
        (let ([id token-value])
          (accept 'ident)
          (if (assign?)
              (begin
                (next-symbol)
                (cons 'assign (cons id (expr))))
              (error "Invalid let statement"))))
      (expr)))

实际的解析器只需要调用tokenize（词法分析器）将输入字符串转换成一个符号列表，并通过调用statement启动解析过程。

(define (parse instr)
  (set! token-list (tokenize (string-trim instr)))
  (next-symbol)
  (let ([val (statement)])
    (if (equal? token-list '())
        val
        (error "Syntax error in input."))))

注意，如果token-list中还有剩余的内容，会生成一个错误。如果没有这个机制，输入开始时是一个有效的表达式，但如果有一些悬挂的符号，也不会警告用户输入无效。例如，以下输入将返回一个部分结果（在这个例子中是(ident . "x")），却没有提醒用户输入无效。

> (parse "x y")

下面是一个测试输入表达式：

> (parse "(x1*cos(45) + 25 *(4e-12 / alpha))²")
'(pow (+ (* (ident . "x1") func-call "cos" number . 45) * (number . 25) / (
     number . 4e-012) ident . "alpha") number . 2)

它似乎能工作，但要解读这个输出的实际内容有些困难。我们需要一个程序，它能够接收语法树，并以一种更直观的方式打印出来，从而使结构更明显。所以，这就是它的实现！

(define (print-tree ast)
  (let loop ([level 0][node ast])
    (let ([indent (make-string (* 4 level) #\ )]
           [sym (car node)]
           [val (cdr node)])
      (printf indent)
      (define (print-op)
        (printf "Operator: ~a\n"  sym)
        (loop (add1 level) (car val))
        (loop (add1 level) (cdr val)))
      (match sym
        ['number (printf "Number: ~a\n" val)]
        ['ident  (printf "Identifier: ~a\n" val)]
        ['func-call 
           (printf "Function: ~a\n" (car val))
           (loop (add1 level) (cdr val))]
        ['+ (print-op)]
        ['- (print-op)]
        ['* (print-op)]
        ['/ (print-op)]
        ['^ (print-op)]
        ['neg 
           (printf "Neg:\n")
           (loop (add1 level) val)]
        ['assign
           (printf "Assign: ~a\n" (car val))
           (loop (add1 level) (cdr val))]
        [_ (printf "Node: ~a?\n" node)]))))

它本质上是一个大的match语句，用来与树的节点类型进行匹配。缩进根据节点在树中的深度而变化。这将提供一个视觉化的表示，展示子节点如何排列。通过这种方式，我们可以生成更容易解读的输出。

> (define ast (parse "(x1*cos(45) + 25 *(4e-12 / alpha))²"))
> (print-tree ast)
Operator: ^
    Operator: +
        Operator: *
            Identifier: x1
            Function: cos
                Number: 45
        Operator: *
            Number: 25
            Operator: /
                Number: 4e-012
                Identifier: alpha
    Number: 2

解析器创建了输入字符串的语法树，而print-tree打印出树的可视化表示。事实证明，print-tree提供了一个框架，通过它可以构建一个例程，从语法树中重构输入字符串。这对于调试非常有用，因为它允许我们检查从 AST 构建的输出字符串是否与输入字符串对应。我们通过首先从语法树创建一个标记列表，然后将这些标记拼接在一起生成输出字符串，来逆转这个过程。

创建树到字符串的转换函数的最大难点在于决定何时在表达式周围加上括号。我们当然希望在需要时包含括号，但在不需要时我们不希望加入不必要的括号。为了解决这个问题，我们创建了一个返回每个操作符优先级和结合性的函数。这是为了判断是否需要括号（例如，优先级较低的操作符需要括号，如果优先级相同，则由结合性决定是否需要括号）。

(struct op (prec assoc))

(define get-prop
  (let ([op-prop
         (hash
          'assign (cons 0 'r)
          '+   (op 10 'l) 
          '-   (op 10 'l) 
          '*   (op 20 'l) 
          '/   (op 20 'l)
          'neg (op 30 'n)
          '^   (op 40 'r)
          'expt   (op 40 'r)
          'number (op 90 'n)
          'ident  (op 90 'n)
          'func-call (op 90 'n))])
    (λ (sym)
      (hash-ref op-prop sym (λ () (op 90 'n))))))

如果符号不在表中，第二个λ表达式将返回默认值(info 90 ’n)。

有了这个功能，我们可以生成ast->string：

(define (ast->string ast)
  (let ([expr-port (open-output-string)])
    (define (push str)
      (display str expr-port))
    (let loop ([node ast])
      (let* ([sym (car node)]
             [val (cdr node)]
             [prop (get-prop sym)]
             [prec (op-prec prop)]
             [assoc (op-assoc prop)])

        (define (need-paren arg side)
          (let ([arg-prec (op-prec (get-prop (car arg)))])
            (cond [(< arg-prec prec) #t]
                  [(> arg-prec prec) #f]
                  [else (not (equal? assoc side))])))

        (define (push-op) 
          (let* ([e1 (car val)]
                 [par1 (need-paren e1 'l)]
                 [e2 (cdr val)]
                 [par2 (need-paren e2 'r)])
            (when par1 (push "("))
            (loop e1)
            (when par1 (push ")"))
            (push (format " ~a "  sym))
            (when par2 (push "("))
            (loop e2)
            (when par2 (push ")"))))

        (match sym
          ['number (push (number->string val))]
          ['ident (push val)]
          ['func-call 
           (push (car val))
           (push "(")
           (loop (cdr val))
           (push ")")]
          ['+ (push-op)]
          ['- (push-op)]
          ['* (push-op)]
          ['/ (push-op)]
          ['^ (push-op)]
          ['neg 
           (push "-")
           (let ([paren (need-paren val 'n)])
             (when paren (push "("))
             (loop val)
             (when paren (push ")")))]
          ['assign
           (push (format "let ~a = " (car val)))
           (loop (cdr val))]
          [_ (push (format "Node: ~a" sym))])))
    (get-output-string expr-port)))

定义了一个本地函数push，它将一个标记添加到输出字符串端口（expr-port）。这段代码与print-tree的主要区别在于，所有的print语句都被改成了push语句。此外，处理各种操作符的函数push-op（取代了print-op）被扩展，以决定何时加入括号。除了这些变化之外，从match语句开始，ast->string和print-tree之间的结构相似性应该是显而易见的。那么现在我们可以完整回环：从输入字符串到抽象语法树，再到输入字符串：

> (ast->string (parse "(x1*cos(45) - 4 + -25 *(4e-12 / alpha))²"))
"(x1 * cos(45) - 4 + -25 * (4e-012 / alpha)) ^ 2"

TRAC

一旦语法树创建完成，其余的工作就变得轻松了。剩下的主要部分是一个字典，用于保存变量值，以及实际计算输入表达式并生成数值的代码。在我们结束之前，我们将看一些改进，例如添加复数和设置角度模式。

添加字典

由于 TRAC 有能力为变量分配值，我们将需要一个字典来保存这些值。我们实际上将以函数的形式创建它，其中我们传递一个动作（例如，get用于检索值，set用于分配值）。这将使其更容易扩展其功能，而不会用额外的定义来弄乱命名空间。这也提供了一个在 lambda 表达式中使用单个rest-id的示例。rest-id 是接受单个列表中提供给函数的所有参数的参数。下面代码中的args参数是一个 rest-id，接受一个参数列表。请注意，它没有被括号包围。

(define var
  (let ([vars (make-hash)])
    (λ args
      (match args
        [(list 'set v n) (hash-set! vars v n)]
        [(list 'get v)
         (if (hash-has-key? vars v)
             (hash-ref vars v)
             (error (format "Undefined variable: ~a" v)))]))))

请注意，此代码实际上使用闭包来构造字典（即vars，以哈希表的形式）。此函数返回一个嵌入了字典的函数。

现在有了一个用于保持变量值的字典，我们可以定义表达式评估器。

(define (eval-ast ast)
  (let loop ([node ast])
  ➊ (let ([sym (car node)]
           [val (cdr node)])

   ➋ (define (eval-op)
        (let ([n1 (loop (car val))]
              [n2 (loop (cdr val))])
          (match sym
            ['+ (+ n1 n2)]
            ['- (- n1 n2)]
            ['* (* n1 n2)]
            ['/ (/ n1 n2)]
            ['^ (expt n1 n2)])))

   ➌ (define (eval-func fname val)
        (match fname
          ["sin" (sin val)]
          ["cos" (cos val)]
          ["tan" (tan val)]
          ["asin" (asin val)]
          ["acos" (acos val)]
          ["atan" (atan val)]
          ["ln" (log val)]
          ["log" (log val 10)]
          ["sqrt" (sqrt val)] ))

   ➍ (match sym
        ['number val]
        ['ident (var 'get val)]
        ['+ (eval-op)]
        ['- (eval-op)]
        ['* (eval-op)]
        ['/ (eval-op)]
        ['^ (eval-op)]
        ['neg (- (loop val))]
        ['assign (var 'set (car val)
                      (loop (cdr val)))]
     ➎ ['func-call 
         (eval-func (car val)
                    (loop (cdr val)))]
        [_ (error "Unknown symbol")]))))

注意它遵循类似于ast->string和print-tree的模式；不同之处在于，现在它不是返回或打印字符串，而是遍历语法树并计算节点的数值。

让我们逐步走一遍发生的事情。给定 AST，我们提取解析的符号（sym）和值（val）➊。然后我们匹配符号➍并采取适当的操作。如果给定的是字面数字，我们简单地返回值。如果是标识符，我们使用(var ’get val)从字典中提取值。算术运算将调用eval-op ➋，它首先递归提取参数n1和n2。然后，它匹配输入符号以确定要执行的操作。函数调用➎通过(loop (cdr val))递归提取其参数，并调用eval-func ➌来执行计算。

现在我们可以实际执行一些计算了。

> (eval-ast (parse "let x = 3"))
> (eval-ast (parse "let y = 4"))
> (eval-ast (parse "sqrt(x² + y²)"))
5

> (eval-ast (parse "x + tan(45 * 3.14159 / 180)"))
3.9999986732059836

为了避免每次调用parse和eval-ast，我们需要设置一个交互式读取-评估-打印循环（REPL）。为此，我们创建一个start函数来启动这个过程并设置几个预定义变量。

(define (start)
  (var 'set "pi" pi)
  (var 'set "e" (exp 1))
  (display "Welcome to TRAC!\n\n")
  (let loop ()
    (display "> ")
      (let ([v (eval-ast (parse (read-line)))])
        (when (number? v) (displayln  v)))
    (loop)))

现在我们可以以更自然的方式运行 TRAC 了。

> (start)
Welcome to TRAC!

> let x = 3
> let y = 2+2
> sqrt(x²+y²)
5

> tan(45 * pi / 180)
0.9999999999999999

一些增强

我们现在已经建立了 TRAC 的基本功能，但要使其真正有用，我们将添加一些增强功能。一个重要的增强功能是使其在用户输入错误时优雅地失败。如果能让高级用户能够处理复数也不错。我们将在接下来的部分中探讨这些主题及更多内容。

异常处理

目前，TRAC 非常脆弱。稍有不慎就会导致失败：

> let x=3
> let y=4
> sqrt(x² + y²
. . Unexpected end of input

它应该更容忍输入错误（毕竟我们是人类）。为了缓解这种情况，我们利用了 Racket 的异常处理能力。

当执行 Racket 代码时发生错误，异常将被引发。异常将具有 exn 类型或其子类型之一。由 error 引发的异常具有 exn:fail 类型。为了捕获这种错误，可以将代码包装在 with-handlers 结构中。这里给出了一个使用 with-handlers 的修改版 start 函数。

(define (start)
  (var 'set "pi" pi)
  (var 'set "e" (exp 1))
  (display "Welcome to TRAC!\n\n")
  (let loop ()
    (display "> ")
    (with-handlers ([exn:fail? (λ (e) (displayln "An error occured"))])
      (let ([v (eval-ast (parse (read-line)))])
        (when (number? v) (displayln v))))
    (loop)))

with-handlers 结构可以捕获多种不同类型的错误。在这种情况下，我们使用 exn:fail? 谓词来捕获由 error 结构生成的 exn:fail 错误。每种捕获的错误类型都有一个相应的函数来处理捕获的错误。

这里我们使用一个 lambda 表达式来生成稍微不具信息性的 "An error occurred." 消息。现在，评估缺少右括号的表达式将产生以下结果。

> sqrt(x² + y²
An error occurred!
>

请注意，这一次，尽管发生了错误，> 提示符仍然出现，表示程序仍在运行。用户现在有机会重新输入表达式并继续工作。

假设我们想提供一个更具信息量的错误信息，类似于 Racket 提供的错误信息。传递给异常处理函数的 e 参数是一个 exn 结构体。这个结构体有一个 message 字段，包含了引发的错误的实际文本字符串。所以，为了打印错误信息的文本，我们需要修改 lambda 函数，使其如下所示：

(λ (e) (displayln (exn-message e)))

进行此修改后，一个包含错误输入的会话将按如下方式进行：

> (start)
Welcome to TRAC!

> let x=3
> let y=4
> sqrt(x² + y²
Unexpected end of input.
> sqrt(x² + y²)
5
>

请注意，像 sqrt(-1) 这样的表达式会产生复数 0+1i。这可能会让不熟悉复数的用户感到困惑。在这种情况下，最好是引发一个错误，而不是返回结果。为此，可以将 start 函数修改如下：

(define (start)
  (reset)
  (let loop ()
    (display "> ")
    (with-handlers ([exn:fail? (λ (e) (displayln (exn-message e)))])
      (let ([v (eval-ast (parse (read-line)))])
        (when (number? v)
          (if (not (real? v))
              (error "Result undefined.")
              (displayln v)))))
    (loop)))

进行此修改后，评估一个返回复数的表达式将产生以下结果：

> sqrt(-2)
Result undefined.

复数

在上一节中，我们提到如果计算结果是复数则抛出异常。如果用户熟悉复数，词法分析器可以修改为接受复数类型，在这种情况下，原始的 start 函数可以保持不变。修改 TRAC 的词法分析器，使其能够处理复数，并不是非常困难。人们可能会倾向于创建一个识别复数（例如 1+2i）的正则表达式。那将是一个大错误。如果评估像 2*1+2i 这样的表达式，期望的结果是 2+2i，因为乘法的优先级高于加法。如果词法分析器将整个表达式当作一个数字返回，解析器将把表达式 2*1+2i 当作 2*(1+2i) 来处理，从而得到 2+4i 的结果。

实际的解决方案非常简单。我们不是识别整个复数，而是只识别虚部。也就是说，数字的正则表达式变为如下所示：

(define regex-number #rx"^[0-9]+(?>\\.[0-9]+)?(?>e[+-]?[0-9]+)?i?")

请注意，表达式中唯一的变化是在末尾添加了i?，这意味着我们接受数字输入末尾的可选i。

此外，我们对classify（嵌入在tokenize中）进行了一些小修改，以处理虚数。

(define (tokenize instr)
         ⋮
      (define (classify type)
        (let ([val (substring instr start next-pos)])
          (if (equal? type 'number) 
              (cons type
                    (if (equal? #\i (string-ref val (sub1 (string-length val))))
                        (string->number (string-append "0+" val))
                        (string->number val)))
              (cons type val))))
         ⋮

在这些更改完成后，我们可以在 TRAC 中进行如下计算：

> 1i
0+1i

> 1i²
-1

> 2*1+2i
2+2i

> 2*(1+2i)
2+4i

模式、重置和帮助命令

大多数计算器允许用户使用角度或弧度计算三角函数。如果 TRAC 没有这个功能那就太遗憾了。为此，我们需要一个全局变量来存储三角函数模式：

(define RADIANS 1)
(define DEGREES (/ pi 180))
(define trig-mode RADIANS)

TRAC 目前处理数字输入的方式与 Racket 完全相同。也就是说，如果一个精确值除以另一个精确值，将返回一个分数结果。例如，输入2/4会返回1/2。这通常不是日常计算时所期望的结果。因此，我们将修改 TRAC，让用户可以选择将所有输入当作浮点数处理，或者保留分数输入。为了实现这一点，我们将使用一个全局变量来维护数字模式。

(define FRAC 1)
(define FLOAT 2)
(define num-mode FLOAT)

另外，允许用户将 TRAC 重置为默认启动状态也是很好的，因此 TRAC 引入了一个新的关键字reset，这要求对regex-keyword做出以下更改。

(define regex-keyword #rx"^(let|reset|\\?)")

末尾的问号将允许 TRAC 拥有一个迷你帮助系统，用户可以通过在命令行输入?来访问它（稍后会详细介绍）。

输入reset将清除 TRAC 字典中的先前条目，并用默认值初始化它。这些操作被捆绑成一个reset过程：

(define (reset)
  (var 'set "pi" pi)
  (var 'set "e" (exp 1))

  (var 'set "Rad" RADIANS)
  (var 'set "Deg" DEGREES)
  (set! trig-mode RADIANS)

  (var 'set "Frac" FRAC)
  (var 'set "Float" FLOAT)
  (set! num-mode FLOAT)

  (displayln "** Welcome to TRAC! **\n")
  (displayln "  Modes: Rad, Float")
  (displayln "  Enter ? for help.\n")
  )

然后，start过程变为如下：

(define (start)
  (reset)
  (let loop ()
    (display "> ")
    (with-handlers ([exn:fail? (λ (e) (displayln (exn-message e)))])
      (let ([v (eval-ast (parse (read-line)))])
        (when (number? v) (displayln v))))
    (loop)))

为了适应新的reset和?关键字，解析器的statement部分进行了如下更新：

(define (statement)
  (cond [(equal? token-value "let")
         (next-symbol)
         (let ([id token-value])
           (accept 'ident)
           (if (assign?)
               (begin
                 (next-symbol)
                 (cons 'assign (cons id (expr))))
               (error "Invalid let statement")))]
        [(equal? token-value "reset") (cons 'reset null)]
        [(equal? token-value "?") (cons 'help null)]
        [else (expr)]))

如果输入reset或?，函数会立即返回，而不会深入解析器，以便表达式求值器可以直接处理这些命令。

当然，我们仍然需要修改三角函数，以确保它们在当前模式下正确运行。数字输入的处理也需要调整，以确保它们遵循当前的数字模式。以下是调整过的ast-eval版本。

(define (eval-ast ast)
  (let loop ([node ast])
    (let ([sym (car node)]
          [val (cdr node)])

      (define (eval-op)
        (let ([n1 (loop (car val))]
              [n2 (loop (cdr val))])
          (match sym
            ['+ (+ n1 n2)]
            ['- (- n1 n2)]
            ['* (* n1 n2)]
            ['/ (/ n1 n2)]
            ['^ (expt n1 n2)])))

      (define (eval-func fname val)
        (match fname
       ➊ ["sin" (sin (* val trig-mode))]
          ["cos" (cos (* val trig-mode))]
          ["tan" (tan (* val trig-mode))]
          ["asin" (/ (asin val) trig-mode)]
          ["acos" (/ (acos val) trig-mode)]
          ["atan" (/ (atan val) trig-mode)]
          ["ln" (log val)]
          ["log" (log val 10)]
          ["sqrt" (sqrt val)] ))

      (match sym
        ['number
      ➋ (if (and (= num-mode FLOAT) (exact? val))
             (exact->inexact val)
             val)]
        ['ident (var 'get val)]
        ['+ (eval-op)]
        ['- (eval-op)]
        ['* (eval-op)]
        ['/ (eval-op)]
        ['^ (eval-op)]
        ['neg (- (loop val))]
     ➌ ['reset (reset)]
     ➍ ['help (print-help)]
        ['assign
         (var 'set (car val)                    
              (let ([n (loop (cdr val))])
             ➎ (cond [(equal? (car val) "TrigMode")
                       (if (or (= n RADIANS) (= n DEGREES))
                           (begin
                             (set! trig-mode n)
                             (printf "TrigMode set to ~a.\n\n" (if (= n
     RADIANS) "Rad" "Deg")))
                           (error "Invalid TrigMode."))]
                   ➏ [(equal? (car val) "NumMode")
                       (if (or (= n FRAC) (= n FLOAT))
                           (begin
                             (set! num-mode n)
                             (printf "NumMode set to ~a.\n\n" (if (= n FRAC) "
     Frac" "Float")))
                           (error "Invalid NumMode."))]
                      [else n])))]
        ['func-call 
         (eval-func (car val)
                    (loop  (cdr val)))]
        [_ (error "Unknown symbol")]))))

对三角函数的实际更改是微小的：只需通过mode进行乘法或除法就能完成（观察trig-mode是如何处理的➊）。代码还增加了在模式设置为FLOAT时正确将精确值转换为不精确值的功能➋。其余的大多数更改都涉及修改赋值语句，以捕捉TrigMode➎和NumMode➏的变化，确保它们只能被赋予正确的值。注意reset➌和help➍的新增内容。这里提供了print-help过程：

(define (print-help)
  (let ([help (list
               (format "Current TrigMode: ~a"
                       (if (= trig-mode RADIANS) "Rad" "Deg"))              
               "To change TrigMode: to radians type:"
               "   let TrigMode = Rad"
               "To change TrigMode to degrees type:"
               "   let TrigMode = Deg"
               ""   
               (format "Current NumMode: ~a"
                       (if (= num-mode FLOAT) "Float" "Frac"))
               "To change NumMode to float type:"
               "   let NumMode: = Float"
               "To change NumMode: to fraction type:"
               "   let NumMode: = Frac"
               ""
               "To reset TRAC to defaults type:"
               "   reset")])
    (let loop([h help])
      (unless (equal? h '())
        (printf "~a\n" (car h))
        (loop (cdr h)))))
  (newline))

这里有一个展示新功能的会话。

> (start)
** Welcome to TRAC! **

  Modes: Rad, Float
  Enter ? for help.

> tan(45)
1.6197751905438615
> let TrigMode=Deg
TrigMode set to Deg.

> tan(45)
0.9999999999999999
> atan(1)
45.0
> let TrigMode=45
Invalid TrigMode.
> let TrigMode=Rad
TrigMode set to Rad.

> cos(pi)
-1.0
> 2/4
0.5
> let NumMode=Frac
NumMode set to Frac.

> 2/4
1/2
> reset
** Welcome to TRAC! **

  Modes: Rad, Float
  Enter ? for help.

> ?
Current TrigMode: Rad
To change TrigMode: to radians type:
   let TrigMode = Rad
To change TrigMode to degrees type:
   let TrigMode = Deg

Current NumMode: Float
To change NumMode to float type:
   let NumMode: = Float
To change NumMode: to fraction type:
   let NumMode: = Frac

To reset TRAC to defaults type:
   reset

>

相当酷，是吧？

确保 TRAC 正常工作

鉴于这个应用的性质，能够确认其正确执行计算是很有必要的。如果你用这个计算月球着陆轨迹的话，结果应该是正确的，而不是返回一个将飞船送入空旷太空的计算。

当然，理论上你可以坐下来手动输入大量的测试方程到 TRAC 中，并通过在其他计算器上输入相同的方程来验证结果，看看它们是否一致。显然，这样做既不有趣（也不高效）。不，我们希望有一个自动化的过程，让计算机做所有的工作。我们采取的方法是构建一个程序，生成一个随机的 Racket 表达式。这个表达式可以通过 Racket 的eval函数计算出一个数值。此外，我们还需要一个函数，将 Racket 表达式转换为 TRAC 表达式字符串。我们可以评估 TRAC 表达式，看看它是否返回相同的值。接着，我们可以让计算机重复执行这个过程几千次，以确保没有出现任何不匹配的结果。

下面是随机 Racket 表达式生成器的代码。

(define ops
  (vector
   (cons '+ 2) 
   (cons '- 1) ; unary minus
   (cons '- 2) ; subtraction
   (cons '* 2) 
   (cons '/ 2) 
   (cons 'expt 2) 
   (cons 'sin 1) 
   (cons 'cos 1) 
   (cons 'tan 1) 
   (cons 'asin 1) 
   (cons 'acos 1) 
   (cons 'atan 1) 
   (cons 'sqrt 1) 
   (cons 'log 1) ; natural log
   (cons 'log 2) ; base n log
   ))

(define (gen-racket)
  (let ([num-ops (vector-length ops)])
    (let loop ([d (random 1 5)])
      (if (= d 0)
          (exact->inexact (* (random) 1000000000))
          (let* ([op (vector-ref ops (random num-ops))]
                 [sym (car op)]
                 [args (cdr op)]
                 [next-d (sub1 d)])
            (if (= args 1)
                (list sym (loop next-d))
                (if (equal? sym 'log)
                    (list sym (loop next-d) 10)
                    (list sym (loop next-d) (loop next-d)))))))))

gen-racket函数会从ops向量中随机选择一个操作符。ops中的值包括操作符符号以及它所期望的参数个数（称为它的元数）。请注意，log和减号（-）有两个不同的元数。TRAC 中的log(x)（以 10 为底的对数）与 Racket 中的(log x 10)是相同的。然后，gen-racket会构建一个包含从一个到五个随机操作或函数的表达式，且这些操作或函数的浮点数参数是随机生成的。结果是一个实际的 Racket 表达式，而非抽象语法树（AST），其参数和函数都会被随机值填充。

下面是gen-racket生成的一些表达式的展示。

> (gen-racket)
'(* (cos 25563340.24229431) (cos 112137357.31425005))

> (gen-racket)
'(log 502944961.7985059 10)

> (gen-racket)
'(sqrt (tan (expt (sqrt 721196577.8863264) (+ 739078577.777451 744205482.2563056))))

大部分工作都涉及将 Racket 表达式转换为 TRAC 表达式。

(define (racket->trac expr)
  (let ([out-port (open-output-string)])
    (define (push str)
      (display str out-port))
    (let loop ([node expr])
      (if (number? node)
          (push (number->string node))
          (let* ([sym (car node)]
                 [sym (cond [(equal? sym 'expt) '^]
                            [(equal? sym 'log)
                             (if (= (length node) 2) 'ln 'log)]
                            [(equal? sym '-)
                             (if (= (length node) 2) 'neg '-)]
                            [else sym])]
                 [prop (get-prop sym)]
                 [prec (op-prec prop)]
                 [assoc (op-assoc prop)])

            (define (need-paren arg side)
              (if (not (list? arg))
                  #f
                  (let ([arg-prec (op-prec (get-prop (car arg)))])
                    (cond [(< arg-prec prec) #t]
                          [(> arg-prec prec) #f]
                          [else (not (equal? assoc side))]))))

            (define (push-op)
              (let* ([e1 (second node)]
                     [e2 (third node)]
                     [par1 (need-paren e1 'l)]
                     [par2 (need-paren e2 'r)])
                (when par1 (push "("))
                (loop e1)
                (when par1 (push ")"))
                (push (format " ~a "  sym))
                (when par2 (push "("))
                (loop e2)
                (when par2 (push ")"))))

            (define (push-neg)
              (let* ([e (second node)]
                     [paren (need-paren e 'n)])
                (push "-")
                (when paren (push "("))
                (loop e)
                (when paren (push ")"))))

            (define (push-func)
              (push (format "~a"  sym))
              (push "(")
              (loop (second node))
              (push ")"))

            (match sym
              ['+ (push-op)]
              ['- (push-op)]
              ['* (push-op)]
              ['/ (push-op)]
              ['^ (push-op)]
              ['neg  (push-neg)]
              ['sin  (push-func)]
              ['cos  (push-func)]
              ['tan  (push-func)]
              ['asin (push-func)]
              ['acos (push-func)]
              ['atan (push-func)]
              ['ln   (push-func)]
              ['log  (push-func)]
              ['sqrt (push-func)])))
      (get-output-string out-port))))

这在很大程度上是ast->string函数的改编，但使用gen-racket生成的随机 Racket 表达式作为输入，而不是 TRAC 语法树。我们不得不做出一些调整，以考虑到-和log的多个元数。我们还会匹配字面上的函数符号。除了这些考虑之外，代码应当与ast->string非常相似。以下是其输出的一些示例。

> (racket->trac (gen-racket))

"asin(tan(944670433.0 - 858658023.0 + (918652763.0 + 285573780.0)))"
> (racket->trac (gen-racket))
"sin(atan(364076270.0)) / sqrt(ln(536830818.0))"

> (racket->trac (gen-racket))
"atan(978003385.0)"

基本思路是自动化以下过程：

> (define r (gen-racket))
> r
'(+ (cos (atan 142163217.6660815)) (log (cos 528420918.36769867)))

> (define v1 (eval r))
> v1
-1.021485300993499

> (define v2 (eval-ast (parse (racket->trac r))))
> v2
-1.021485300993499

> (= v1 v2)
#t

下面是我们的测试平台：

(define (test n)
  (for ([in-range n])
    (let* ([expr (gen-racket)]
           [v1 (eval expr)]
           [v2 (eval-ast (parse (racket->trac expr)))]
           [delta (magnitude (- v1 v2))])
      (when (> delta 0)
        (displayln "Mismatch:")
        (printf "Racket: ~a\n" expr)
        (printf "TRAC: ~a\n" (racket->trac expr))
        (printf "v1: ~a, v2: ~a, delta: ~a\n\n" v1 v2 delta)))))

计算结果可能会导致复数（例如，(sqrt -1)），因此我们使用magnitude来获取值之间差异的绝对值大小。

下面是初步测试运行的输出，事实上显示 TRAC 的评估程序并不总是产生正确的结果。

> (test 10)
Mismatch:
Racket: (atan (atan (expt 137194961.20152807 513552901.52574974)))
TRAC: atan(atan(137194961.20152807 ^ 513552901.52574974))
v1: 1.0038848218538872, v2: 0.2553534898896325, delta: 0.7485313319642546

Mismatch:
Racket: (- (log (expt (+ 67463417.07939068 342883686.1438599) (sin
     521439863.24302197))) (sqrt (+ (atan 402359159.5913063) (acos
     213010305.84288383))))
TRAC: ln((67463417.07939068 + 342883686.1438599) ^ sin(521439863.24302197)) -
     sqrt(atan(402359159.5913063) + acos(213010305.84288383))
v1: -23.07001808516913-3.029949988703483i, v2:
     16.55567328478171+0.11164266488631025i, delta: 39.75003171002113

所有不匹配的共同点是指数运算符 ^（来自 Racket 的 expt 函数），它不小心与除法运算符在 eval-ast 中一起定义了（上面给出的 eval-ast 代码是正确的，但如果您想测试这个错误，可以引入相同的错误）。一旦修正后，另一次测试运行产生了以下结果。

> (test 100000)
>

在这种情况下，无新闻即是好消息。

创建可执行文件

其实没有必要让 TRAC 依赖于 DrRacket 环境。只需几个额外的步骤，就可以创建一个可执行文件，该文件可以在不启动 DrRacket 的情况下启动。第一步是简单地在定义文件的最后一行添加 (start) 命令（见下文），使得程序在启动时立即开始执行。

(start)

Racket 支持三种不同类型的可执行文件：

启动器 这种类型的可执行文件将执行当前版本的 .rkt 源文件，因此它会在可执行文件中包含源文件的路径。这将使您的可执行文件能够立即反映程序的任何改进。缺点是您无法将源文件移到其他位置或轻松与他人共享可执行文件。

独立版 这个版本将源文件嵌入到可执行文件中，因此可以将其移动到您计算机上的其他位置。独立版可执行文件仍然依赖于安装的 Racket DLL 文件，因此如果移到另一台计算机上，可能无法正常工作。

分发归档 分发归档将所有需要的文件捆绑到一个安装文件中。只要目标计算机使用的操作系统与创建归档时使用的操作系统相同，安装文件就可以用来在另一台计算机上安装 TRAC。

在创建可执行文件之前，建议关闭调试功能。可以通过进入选择语言 . . .对话框（从主菜单的语言选项中）并点击显示详情按钮来实现。这将打开一个面板，您应该选择不启用调试。完成后，前往 Racket 主菜单，从那里选择创建可执行文件 . . .。在对话框中，您可以选择要创建的三种不同类型的可执行文件中的一种。甚至可以选择一个自定义图标，为 TRAC 增添个人风格。

图 10-7 是 TRAC 在我们机器上运行的截图。

图 10-7：TRAC 的实际操作

概要

在本章中，我们利用了之前章节中介绍的抽象计算机和各种自动机的知识，构建了一个交互式命令行表达式计算器。在这个过程中，我们学习了词法分析器（以及如何使用正则表达式构建它们）、语法分析器（构建抽象语法树）和解释器。我们使用了 EBNF（扩展巴科斯范式）来指定我们的计算器语法。构建好基础计算器后，我们增强了它的功能，例如处理复数和手动选择角度或弧度。为了确保我们的计算器不会给出错误的结果，我们建立了一个简单的测试平台，确保我们的代码具有鲁棒性。

好的，这差不多就是我们目前 Racket 之旅的总结了。但我们仅仅是触及了冰山一角。还有更多的功能我们甚至没有提及。我们鼓励你通过 Racket 网站和其他可用文献进一步探索 Racket。祝你学习愉快！

第十一章：A

数字基数

数字这个词来源于拉丁语digitus，意为手指或脚趾。当然，我们将其视为我们从零到九的计数数字的起源，可以通过手指（或脚趾）来匹配这些数字。这些数字构成了我们的十进制或基数为 10 的数字系统的基础。当前常用的位置数字系统称为印度-阿拉伯数字系统。穆罕默德·伊本·穆萨·阿尔·赫瓦里兹米的著作（例如《用印度数字进行计算》，约公元 825 年）在这一系统的引入中具有影响力。创新之处在于利用每个数字的位置来表示该数字乘以的 10 的幂。与使用其他系统（如罗马数字）相比，这使得计算变得更加简便。

十进制数字系统为每个数字位置分配了一个 10 的幂次，从数字串中的最右侧数字开始。数字串的含义则通过将每个数字与对应的 10 的幂相乘来得出，如图 A-1 所示。

图 A-1：基数为 10 的位置值

这意味着以下内容：

271828 = 2 ⋅ 10⁵ + 7 ⋅ 10⁴ + 1 ⋅ 10³ + 8 ⋅ 10² + 2 ⋅ 10¹ + 8 ⋅ 10⁰

表示此值的一种简洁方式如下：

这里 d[0] = 8, d[1] = 2, …, d[5] = 2——从最低位到最高位的数字。

十进制系统并不是唯一的数字系统。任何大于 1 的整数都可以用作数字系统的基数。如果你生活在一个人们只有八个手指的宇宙中（见图 A-2），你可能会使用八进制（或基数为 8）数字系统。

图 A-2：八进制数字

除 10 进制外的其他基数系统中的数字通常以数字的下标形式表示基数。一个八进制数会写作 1234[8]。我们可以按以下方式将其转换为十进制：

如大家所知，计算机内部严格按照二进制（或基数为 2）数字系统工作。三个二进制数字能够表示从 0 到 7 的数字，这些数字，如我们所见，构成了八进制数字系统的基础。四个二进制数字可以表示从 0 到 15 的数字（基数为 16 的数字）。由于数字 10 到 15 需要多个十进制数字来表示，因此使用字母 A 到 F 代替。也就是说，A=10，B=11，依此类推。这就是所谓的十六进制数字系统。例如，数字 FACE[16] = 64206，如下所示。

两个十六进制数字（或八个二进制数字）构成所谓的一个字节。字节通常不是用作数字的基数，但它们是用来表示计算机内存大小的常见单位。

这里有一些 Racket 代码，它接受一个正十进制整数，并返回一个包含该数字二进制表示的数字列表。

(define (decimal->bin n)
  (let loop ([n n] [l '()])
    (if (zero? n) l
        (let-values ([(n d) (quotient/remainder n 2)])
          (loop n (cons d l))))))

这个方法通过提取最不重要的（二进制中最右边的）数字，并通过除以 2 来减少n的值，从而得到下一个数字。

> (decimal->bin 15)
'(1 1 1 1)
> (decimal->bin 10)
'(1 0 1 0)
> (decimal->bin 64206)
'(1 1 1 1 1 0 1 0 1 1 0 0 1 1 1 0)

Racket 还提供了˜r函数，它接受一个十进制值并输出以另一进制格式化的字符串。

> (~r 64206 #:base 2)
"1111101011001110"

> (~r 64206 #:base 8)
"175316"

> (~r 64206 #:base 16)
"face"

> (~r  170 #:base 2 #:min-width 12  #:pad-string "0" )
"000010101010"

第十二章：B

特殊符号

Racket 语言支持在字符串和标识符中使用 Unicode 字符。这些符号可以直接在 DrRacket 中输入，通过键入表 B-1、B-2、B-3 和 B-4 中显示的代码。输入代码后，按住 A L T 键并立即按下 \ 键（在 Windows 和 Linux 中有效，但 macOS 使用 CTL-\）。

表 B-1: 标准希腊字母

符号	代码	符号	代码
α	\alpha	Ξ	\Xi
β	\beta	ξ	\xi
Γ	\Gamma	Π	\Pi
γ	\gamma	π	\pi
Δ	\Delta	ρ	\rho
δ	\delta	Σ	\Sigma
ϵ	\epsilon	σ	\sigma
ζ	\zeta	τ	\tau
η	\eta	Υ	\Upsilon
Θ	\Theta	υ	\upsilon
θ	\theta	Φ	\Phi
ι	\iota	ϕ	\phi
κ	\kappa	χ	\chi
λ	\lambda	Ψ	\Psi
Λ	\Lambda	ψ	\psi
μ	\mu	Ω	\Omega
ν	\nu	ω	\omega

表 B-2: 希腊变体

符号	代码
ε	\varepsilon
φ	\varphi
ϖ	\varpi
ϱ	\varrho
ς	\varsigma
ϑ	\vartheta

表 B-3: 其他符号，第一个部分

符号	代码	符号	代码
⇑	\Uparrow	†	\dagger
↑	\uparrow	•	\bullet
⇓	\Downarrow	‡	\ddagger
↓	\downarrow	≀	\wr
⇐	\Leftarrow	⊆	\subseteq
←	\leftarrow	⊇	\supseteq
⇒	\Rightarrow	⊂	\subset
→	\rightarrow	⊃	\supset
↖	\nwarrow	∈	\in
↙	\swarrow	∋	\ni
↘	\searrow	∉	\notin
↗	\nearrow	≠	\neq
⇕	\Updownarrow	≐	\doteq
↕	\updownarrow	≤	\leq
⇔	\Leftrightarrow	≥	\geq
↔	\leftrightarrow	≡	\equiv
↦	\mapsto	~	\sim
↝	\leadsto	≅	\cong
ℵ	\aleph	≈	\approx
′	\prime	∝	\propto
∅	\emptyset	⊧	\models
∇	\nabla	≺	\prec
△	\triangle	≻	\succ
¬	\neg	⊥	\bot
∀	\forall	⊤	\top
∃	\exists	⊢	\vdash
∞	\infty	⊣	\dashv
∘	\circ	≃	\simeq
±	\pm	«	\ll
∓	\mp	»	\gg
∪	\cup	≍	\asymp
∩	\cap	∥	\parallel
◇	\diamond	⊥	\perp

表 B-4: 其他符号，第两个部分

符号	代码	符号	代码
△	\bigtriangleup	⋈	\bowtie
▽	\bigtriangledown	⋅	\cdot
×	\times	∑	\sum
÷	\div	∏	\prod
⊕	\oplus	∐	\coprod
⊖	\ominus	∫	\int
⊗	\otimes	∮	\oint
⊘	\oslash	√	\sqrt
⊙	\odot	☺	\smiley
∨	\vee	☻	\blacksmiley
∧	\wedge	☹	\frownie
♢	\diamondsuit	§	\S
♠	\spadesuit	⋮	\vdots
♣	\clubsuit	⋱	\ddots
♡	\heartsuit	⋯	\cdots
♯	\sharp	…	\hdots
♭	\flat	⟨	\langle
♮	\natural	⟩	\rangle
⋆	\star

posted @ 2025-11-30 19:35 绝不原创的飞龙阅读(0) 评论(0) 收藏举报

刷新页面返回顶部

龙哥盟

掠夺·扩张·投机·博弈

快乐方法学-Racket-编程-全-

快乐方法学 Racket 编程（全）

前言

Racket

本书使用的约定

本书适合谁阅读

关于本书

第一章：RACKET 基础

原子数据

列表

初探列表

S 表达式

列表结构

一些有用的列表函数

长度

反转

排序

追加

范围

创建列表

空?

索引值

成员

定义、赋值和变量

符号、标识符和关键字

相等性

字符串与其他元素

字符

字符串

有用的字符串函数

字符串长度

substring

string-titlecase

string-upcase

string-downcase

string<=?

string=?

string-replace

string-contains?

string-split

string-trim

字符串转换和格式化函数

向量

访问向量元素

常用的向量函数

向量长度

向量排序

vector->list

list->vector

make-vector

vector-append

vector-member

使用结构体

控制输出

write

display

print

摘要

第二章：算术及其他数值附属物

布尔值

数值塔

整数

有理数

实数

复数

数字比较

合并数据类型

内置函数

中缀表示法

总结

第三章：函数基础

什么是函数？

Lambda 函数

高阶函数

map 函数

apply 函数

foldr 和 foldl 函数

compose 函数

更多有趣的`for`用法