Lisp-Stat翻译 —— 第十章 一些动态绘图实例

2019独角兽企业重金招聘Python工程师标准>>>

第十章 一些动态绘图实例

关于统计学领域动态绘图方法的有效使用的研究才刚刚开始（注：本文写于1991年），通过支持对标准方法变化的研究和对新方法开发的研究，Lisp-Stat绘图系统被设计成支持统计学的动态绘图研究。本章展示若干实例，都是用来说明Lisp-Stat绘图系统的用途的，所选的例子即会介绍现有文献里提出的新的统计学思想，也会展示使用Lisp-Stat来实现这些思想的一写有用的编程技术。有的例子很短也很直接，而有的很宽泛。

10.1 一些动画效果

19世纪60年代晚期，Fowlkes开发了一个系统，用来测试概率绘图方面幂转换方面的研究，这是统计学里使用动态绘图方法的最早的例子之一。这幅图绘制在一个CRT显示器上，进行转换操作的参数由显示器上的标度盘来控制。这种依靠一个或多个连续的参数（这些参数可以使用机械或图形的方式进行控制）的动画形式，在很多情况下都很有用。这在Lisp-Stat里很容易实现。第一个例子，即Flowlkes的幂转换图型，将在第2.7.3节里给出，该节会重新检测这个幂转换的实例，并且会再展示2个例子。

10.1.1 再看幂转换

第2.7.3节给出了一个幂转换的可动态变化的图形实例，该图形是针对第2.2.1节给出的降雨量数据。首先对降雨量数据进行排序，然后绘制排序后的数据与对应的正常分数的数据图形，该图形生成完成。在幂指数改变之后，通过向图形发送一个:add-points消息来添加新数据，接着再发送:clear消息来实现图形重画。

    该方法有两个缺陷，首先，通过对数据进行排序，降水量数据原来的索引和图形里的数据的一致性不存在了，这意味着幂转换图形与降水量数据的另一个图形之间的连接不再会产生正确的结果；另一个问题是点数据的特征，比如说颜色、符号和状态，在幂变化的时候不会保存。

    通过使用上一章介绍的一些消息，我们可以克服这些问题。为了避免对数据进行排序，我们可以使用等级来构造这个正常的分数：

> (let ((ranks (rank precipitation)))
    (setf nq (normal-quant (/ (+ ranks 1) 31))))

向每一个等级值上加1是需要的，因为rank函数返回的是基于0的等级分级。就像2.7.3节里一样，我们可以这样定义一个bc函数：

> (defun bc (x p)
    (let* ((bcx (if (< (abs p) .0001) (log x) (/ (^ x p) p)))
           (min (min bcx))
           (max (max bcx)))
      (/ (- bcx min) (- max min))))
BC

那么，对于1的幂的初始化图形可以这样设置：

> (setf w (plot-points nq (bc precipitation 1)))

因为使用的幂是1，函数bc只不过重新缩放一下数据。

    为了改变图形中正在使用的幂，我们可以定义一个函数change-power，我们可以使用:point-coordinate消息来改变图形里点的y坐标。点数据的所有其它特性均不变。因为:point-coordinate消息需要所有点的下标的列表，设置一个包含这些下标的变量是有用的：

> (setf indices (iseq 30))

这避免了每次这个幂值改变时都不得不构建该列表，使用这个变量，change-power函数这样定义：

> (defun change-power (p)
    (send w :point-coordinate 1 indices (bc precipitation p))
    (send w :redraw-content))
CHANGE-POWER

我们只需要调用一次:point-coordinate消息，因为该消息对应的方法是矢量化的。需要:redraw-content消息的原因是:point-coordinate方法不能重画图形。

    我们可以从解释器里调用change-function函数，或者把它当做一个滑块的动作函数：

> (setf slider
        (interval-slider-dialog '(-1 2) :action #'change-power))
#<Object: 133b544, prototype = INTERVAL-SLIDER-DIALOG-PROTO>

在滑块空间里，其默认的初始化值是区间的小端点侧，下边的表达式将滑块的值设置为构造的图形使用的幂值。因为slider变量是为控制图形对象w专门设计的，当图形关闭时，该滑块要从屏幕中移除，通过将滑块定义为一个使用:add-subordinate消息的图形的附属品，我们可以确保滑块移除成功：

> (send w :add-subordinate slider)

    对于较大的数据集，或者速度慢的电脑，类似这样的动画效果可能移动的非常慢。如果动画只依赖一个参数，通常可能会计算它可能需要的所有预计算的值。例如，我们可以使用下边的表达式建立一个幂列表，然后将转换后的数据计算为列表的列表：

> (setf powers (rseq -1 2 31))
(-1.0 -0.9 -0.8 -0.7 -0.6 -0.5 -0.3999999999999999 -0.29999999999999993 -0.19999999999999996 -0.09999999999999998 0.0 0.10000000000000009 0.20000000000000018 0.30000000000000004 0.40000000000000013 0.5 0.6000000000000001 0.7000000000000002 0.8 0.9000000000000001 1.0 1.1 1.2000000000000002 1.3000000000000003 1.4000000000000004 1.5 1.6 1.7000000000000002 1.8000000000000003 1.9000000000000004 2.0)
> (setf data (mapcar #'(lambda (p) (bc precipitation p)) poser))

然后，一个序列滑块可用来在该数据列表上滚动：

> (flet ((change (x)
                 (send w :point-coordinate 1 indices x)
                 (send w :redraw-content)))
    (sequence-slider-dialog data
                            :display powers
                            :action #'change))

在该滑块里，动作函数的参数是针对当前幂值的转化后的坐标值列表，对于滑块来说，幂值列表被用做显示序列。

    在动画效果中，预计算通常会引起极大的速度提升，但是这也需要额外的编程努力。由于为了容纳预计算的结果需要大量的空间，如果动画参数超过一个的话，预计算通常是行不通的。

练习 10.1

10.1.2 绘图插值

      动态制图的一个主要目标就是在数据超过三维时提供可视化的方法。检测四维数据的一个方法就是将变量并变成数据对(x1,y1)和(x2,y2)，然后在数据对的二维散点图之间，使用动画连续地移动。这种技术叫图形插值。

      有的方法可以用于在两个图形中进行插值，很自然的选择就是图插值。

xp = (1-p)x1 + px2
yp = (1-p)y1 + py2

那就是：当p由0向1连续变化时，设置和显示yp相对于xp的图形。不幸的是，这个方法有个问题，当用于不想关数据的时候，插值显示的点云在p从0移动到0.5时是收缩的，而当p从0.5移动到1时是扩张的。

      为了理解问题的本源，假设我们使用插值来观看构成4维球形正态分布的样本，该组件是独立标准正态随机变量，所以插值图形里的最初的和最后的两个图形表示的是两个独立标准正态变量的图形。但是对于p=0.5的状况，变量xp和yp是两个独立标准正态变量的平均值，因此他们的标准方差是1/sqrt(2)。

      为了避免这个问题，Buja et al建议使用三角插值。公式如下：

xp = cos(p*pi/2)x1 + sin(p*pi/2)x2
yp = cos(p*pi/2)y1 + sin(p*pi/2)y2

表示当p从0到1连续变化时，yp对xp的图形，如果所有变量都归一化到想吐的方差下，这种方法可以保持组件的方差。这与9.1.3节里使用的旋转是等价的。

      三角插值可以多种方式实现，一个方法就是使用一个二维图形，然后在图形里使用:point-coordinate消息来改变数据。

      为了开始验证，我们可以定义一个可以标准化数据的函数：

> (defun standardize (x)
     (let ((x-bar (mean x))
           (s (standard-deviation x)))
        (/ (- x x-bar) s)))

使用第5.6.2节的stack loss数据，我们可以构造4个标准化的变量：

(setf std-air (standardize air))
(setf std-temp (standardize temp))
(setf std-conc (standardize conc))
(setf std-loss (standardize loss))

plot-points函数可以用来设置前两个变量的图形：

(setf w (plot-points std-air std-temp))

我们需要设置这两个变量的范围，以确保它们足够大能够显示所有数据的旋转效果。对于标准化的数据，[-3,3]这一区间对这两个变量就足够大了。因为:range消息对应的方法是矢量化的，这两个变量的范围都可以使用下式来设置：

> (send w :range '(0 1) -3 3)

      在我们使用下式将点数据的索引储存到  变量indices之后：

> (setf indices (iseq (length std-air)))

下式定义的interpolate函数带一个点参数，其范围在[0,1]，计算对应的角度，然后将图形里的变量设置到角度值得的差值上去。

> (defun interpolate (p)
    (let* ((alpha (* (/ pi 2) p))
           (s (sin alpha))
           (c (cos alpha))
           (x (+ (* c std-air) (* s std-temp)))
           (y (+ (* c std-conc) (* s std-loss))))
       (send w :point-coordinate 0 indices x)
       (send w :point-coordinate 1 indices y)
       (send w :redraw-content)))

插值后的结构可以使用这样的循环来运行：

> (dolist (p (rseq 0 1 30)) (interpolate p))

或者使用下式构造的滑块来运行：

> (interval-slider-dialog '(0 1) :action #'interpolate)

就像幂转换那个例子一样，该滑块应该以绘图窗体下级的控件的角色进行注册，以确保当窗体关闭的时候会随之关闭。

    构造一个三角图形插值的第二个方法就是使用一个四维散点图，然后利用graph-proto原型提供的变换系统来完成。plot-points函数可再一次用来设置该图形，该函数可以接受一个四个变量的列表，同时也接受由:scale-type关键字指定的尺度类型：

> (setf w (plot-points (list std-air std-conc std-loss std-temp)
                       :scale-type 'fixed))

这里使用fixed这一尺度类型是合适的，因为我们要使用标准化标量。

    插值函数可以这样定义：

> (defun interpolate (p)
    (let* ((alpha (* (/ pi 2) p))
           (s (sin alpha))
           (c (cos alpha))
           (m (make-array '(4 4) :initial-element 0)))
      (setf (aref m 0 0) c)
      (setf (aref m 0 2) s)
      (setf (aref m 1 1) c)
      (setf (aref m 1 3) s)
      (send w :transformation m)))

该定义里的变换矩阵不是正定变换，因为它将第3个和第4个转换后的坐标设置为0，我们可以使用正定矩阵，但是这里并不需要。

    interpolate函数可以像以前一样，从一个循环或一个滑块对话框开始运行。图10.1展示该图形插值的4个视图。

图10.1 stack loss数据的4个插值视图

    幂转换动画和图形插值动画之间有很多相似的地方，但是仍有一个主要的不同之处。在幂转换的例子里，其目标是找到一个合理的幂值，并探讨其附近的值。使用这个动画，我们通常可以在一个较宽范围内开始，然后缩小这个范围。相反地，在图形插值里通常几乎想要从开始的坐标对到终止的坐标对，完整地运行该动画。当数据进行旋转操作时，中间的图形确实有像数据的旋转操作一样的表达能力，但是在插值图形里它们不是最受关注的。中间图形的目的是当观察者从一个散点图向另一个散点图进行移动时，允许他们跟踪单独的点或点群。因此，插值图形的目标与连接两个散点图的目标是相似的。结果，就像在9.1.7节的例子里构造的按钮叠置层一样，对于运行图形插值来说，一个按钮控件与滚动条相比，可能是一个更好的绘图控件。

练习 10.2
略。

10.1.3 选择平滑参数

到目前为止，我们讨论的连个例子使用了动画技术展示点数据的变化。动画也可用于线数据的展示。例如，对于降雨量数据的核密度估计，我们可以使用动画技术提供一个图形化的方法来选择其平滑参数。降雨量数据的范围可以这样给出：

> (min precipitation)
0.32
> (max precipitation)
4.75

kernel-dens函数接收窗体宽度参数，它可由:width关键字提供。对于降雨量数据的范围，初始大小为1的窗体可能是合理的，下式将使用默认的双平方核和宽度为1的窗体来设置一个图形：

> (setf w (plot-lines (kernel-dens precipitation :width 1)))

    因为我们可能既想改变核的宽度，又想改变核的类型，所有我们可以安装几个槽，用来保留图形里的当前核规则。

> (send w :add-slot 'kernel-width 1)

> (send w :add-slot 'kernel-type 'b)

图10.2 使用双平方核和2个不同的平滑参数值的降雨量数据的核密度估计

假设该密度估计的图形可以使用:set-lines消息来重置，这些槽的获取方法可以这样定义：

> (defmteh w :kernel-width (&optional width)
    (when width
          (setf (slot-value 'kernel-width) width)
          (send self :set-lines))
    (slot-value 'kernel-width))

> (defmteh w :kernel-type (&optional type)
    (when width
          (setf (slot-value 'kernel-type) type)
          (send self :set-lines))
    (slot-value 'kernel-type))

:set-lines方法可以使用:clear-lines和:add-lines消息来定义：

> (defmeth w :set-lines ()
    (let ((width (send self :kernel-width))
          (type (send self :kernel-type)))
      (send self :clear-lines :draw nil)
      (send self :add-lines
            (kernel-dens precipitation
                         :width width :type type))))

为了避免linestart里有任何的颜色、宽度或者线型信息的丢失，我们可以使用:linestart-coordinate消息来代替。但是与维护点数据的属性相比，维护linestart属性通常没有那么重要。

    再一次，滑块可以用来改变该核窗体，对于这个数据，我们可以设置一个区间为[0.25 1.5]合理的范围内，用来讨论：

> (interval-slider-dialog '(.25 1.5)
                            :action
                            #'(lambda (s)
                                (send w :kernel-width s)))

该滑块值应该设置为图形的当前核值，同时该滑块应该注册为绘图窗体的子窗体。默认地，滑块的显示区域将显示当前窗体的宽度。一个替代无就是，我们可以让它显示判据的一个值，该判据是用于选择针对文献里可用的平滑参数。图示10.2展示了针对两个不同的窗体宽度的密度估计。

    为了简化核类型的变化，我们可以定义一个:choose-kernel方法，它可以弹出一个对话框来选择核：

> (defmeth w :choose-kernel ()
    (let* ((types '("Bisquare" "Gaussian" "Triangle" "Uniform"))
           (i (choose-item-dialog "Kernel Type" types)))
      (if i (send w :kernel-type (select '(b g t u) i)))))

该消息可以从键盘发送出去，或者你也可以构造一个菜单项：

> (setf kernel-item
    (send menu-item-proto :new "Kernel Type"
          :action #'(lambda () (send w :choose-kernel))))

然后将该菜单项安装到图形菜单里：

> (send (send w :menu) :append-items kernel-item)

练习 10.3 
略

练习 10.4
略

10.2 使用新的鼠标模式

图形响应用户动作是依靠它的鼠标模式。通过向图形里添加鼠标模式，我们可以获取很多效果。本节将战术3个实例，用来说明可能性范围。

10.2.1 简单线性回归里的敏感性

第一个例子是一个可交互的图形，用来展示最小二乘回归线的杠杆影响。一个散点图展示带最小二乘回归线的(x,y)点对集合。有一个新的鼠标模式，在该模式中通过点击附近的点并拖拽的方法，达到在图形里移动点的目的。该回归线在当鼠标按键释放时进行重画。该例子的首要作用是作为一个指导性的工具，但是，基于该思想的变种作为探索性的工具也是很有用的。

    为了构造这个实例，我们可以使用下式给定的模拟数据作为开始：

(setf x (append (iseq 1 18) (list 30 40)))
(setf y (+ x (* 2 (normal-rand 20))))

值y遵循这样的规律：带单位斜率的正态线性回归，点中的两个x值给予他们一个大的杠杆调节。下边的表达式将为这些数据构造一个散点图：

(setf w (plot-points x y))

    一个新的鼠标模式——point-moving这样定义：

(send w :add-mouse-mode 'point-moving
      :title "Point Moving"
      :cursor 'finger
      :click :do-point-moving)

该消息对应的方法:do-point-moving可以使用:drag-point消息来定义：

(defmeth w :do-point-moving (x y a b)
  (let ((p (send self :drag-point x y :draw nil)))
    (if p (send self :set-regression-line))))

    消息:set-regression-line负责调整回归线以适应图形中的点数据。它对应的方法这样定义：

(defmeth w :set-regression-line ()
  (let ((coefs (send self :calculate-coefficients)))
    (send self :clear-lines :draw nil)
    (send self :abline (select coefs 0) (select coefs 1))))

该定义假设:calculate-coefficients消息可以用来确定当前数据的回归系数。对于最小二乘拟合方法，该消息对应的方法可以这样定义：

(defmeth w :calculate-coefficients ()
  (let* ((i (iseq 0 (- (send self :num-points) 1)))
         (x (send self :point-coordinate 0 i))
         (y (send self :point-coordinate 1 i))
         (m (regression-model x y :print nil)))
    (send m :coef-estimates)))

从绘图处理里分离拟合处理的好处是，只需要重定义:calculate-coefficients方法就能引入一个新的拟合方法。

    为了完成这个实例，我们可以加入一条初始回归线，然后将图形置于point-moving模式中：

(send w :set-regression-line)

(send w :mouse-mode 'point-moving)

图10.3展示了移除点数据中的一个前后的图形：

图10.3：移除最右侧的数据点之前与之后的数据与回归线

    该实例可以通过几种方法来改进。例如，我们可以重定义:calculate-coefficients方法，目的是仅使用图形里的可见数据点：

(defmeth w :calculate-coefficients ()
  (let* ((i (send self :points-showing))
         (x (send self :point-coordinate 0 i))
         (y (send self :point-coordinate 1 i))
         (m (regression-model x y :print nil)))
    (send m :coef-estimates)))

因为散点图里用来维护点数据状态的系统 ，通常会设置:need-adjusting标识，时机是 当一个点数据的状态改变为或者改变自非可见的情况，并使用下式覆盖:adjust-screen方法的时候，该覆盖方法图形里的或其任意连接图形里的点变为不可见时确保回归线可以重新计算。

练习 10.5
略。

联系 10.6
略。

10.2.2 手动旋转

一个图形上的旋转控制允许图形绕屏幕的x、y及垂直于屏幕的轴旋转。其它的控制策略也可以使用，其中的一种策略基于：想象数据是包含于一个“球”内的，这个“球”可以通过鼠标进行抓取和移动，当释放鼠标按键的时候，旋转操作可以停止或者继续：如果使用带有扩展标示符（shift，alt等键）的“抓取”操作则继续。该控制策略可以通过定义一个新的鼠标模式来实现。因为这个鼠标模式对图形旋转操作是有用的，我们可以在spin-proto原型里安装它。

    这个新的鼠标模式可以这样定义：

> (send spin-proto :add-mouse-mode 'hand-rotate
        :title "Hand Rotate"
        :cursor 'hand
        :click :do-hand-rotate)
HAND-ROTATE

对于该模式来说，手型图标看起来是一个自然的选择。

    为了开发针对这个新模式的点击方法，我们需要一个这样的方法：它可以将一个旋转图形窗体里的点击事件转换为一个球上的数据点：

> (defmeth spin-proto :canvas-to-sphere (x y rad)
    (let* ((p (send self :canvas-to-scaled x y))
           (x (first p))
           (y (second p))
           (norm-2 (+ (* x x) (* y y)))
           (rad-2 (^ rad 2))
           (z (sqrt (max (- rad-2 norm-2) 0))))
      (if (< norm-2 rad-2)
          (list x y z)
          (let ((r (sqrt (/ norm-2 rad2))))
            (list (/ x r) (/ y r) (/ z r))))))
:CANVAS-TO-SPHERE

传递给该方法的参数是点击处的画布坐标和尺度坐标系里的球体半径。球体将与屏幕表面相交，该屏幕在一个指定半径的圆的内部，在该圆内部的一次点击将转换为上述点击对应的球体上的数据点。在该圆形外部的点击将被投影到圆的外部。

    使用:canvas-to-sphere消息，:do-hand-rotate方法这样定义：

(defmeth spin-proto :do-hand-rotate (x y m1 m2)
  (let* ((m (send self :num-variables))
         (range (send self :scaled-range 0))
         (rad (/ (apply #'- range) 2))
         (oldp (send self :canvas-to-sphere x y rad))
         (p oldp)
         (trans (identity-matrix m)))
    (flet ((spin-sphere (x y)
             (setf lodp p)
             (setf p (send self :canvas-to-sphere x y rad))
             (setf (select trans vars vars)
                   (make-rotation oldp p))
             (when m1
                   (send self :rotation-type trans)
                   (send self :idle-on t))
             (send self :apply-transformation trans)))
    (send self :idle-on nil)
    (send self :while-button-down #'spin-sphere))))

局部函数spin-sphere用来作为:while-button-down消息的动作函数。他使用了三个变量，这三个变量都是在局部函数环境里定义的。变量p和oldp代表当前和前一个点击事件的位置，并将它们转换到球体上；变量trans代表一个变换矩阵，该矩阵标识除了内容变量所在的行与列的剩下的元素组成的矩阵。该定义是需要的，因为旋转图形可以用在超过三个变量的时候。spin-sphere函数更新oldp和p的值，然后使用新值作为make-rotation的参数，它还会返回一个旋转矩阵，该矩阵将在一个平面里旋转图形，这个平面是由这两个点定义的，保证固定的正交补。在使用该旋转操作之前，spin-sphere会检查扩展标识符（即是否按下了alt或shift等键），如果标识符的值为非nil，打开空置功能，旋转类型被设置为当前步进变换。旋转图形对应的:do-idle在每次发送:apply-transformation方法的时候使用这个矩阵。

10.2.3 图形函数输入

有这样一些情况，在这些情况里过程（相当于函数）需要一个正值函数作为输入。一个例子就是关于一个实值量的先验密度函数的启发。在一些情况下，该函数被指定为一个过程或者一个变量是充分需求，但是在其它的情况下允许将函数被图形化地指定将更加方便。一个用来图形化地指定一个函数应该是这样的：

• 允许设置和获取当前的函数
• 强制为过程输入一个真正的函数，也就是防止一个单独的x值对应多个y值

强制函数为连续性函数可能是有用的。

    为了构造一个图形，用来在单位区间来指定正值函数，我们可以通过构造一个图形了开始，这里的图形包含一个50个互相联通的点的序列，x值在单位区间里的是等间隔的，y值等于0:

(setf p (plot-lines (rseq 0 1 50) (repeat 0 50)))

如果我们主要对函数的形状感兴趣，我们可以使用下式移除y坐标轴：

(send p :y-axis nil)

图形里起始的点表示一个值为0的函数。为了允许该函数使用鼠标来改变，我们可以指定一个新的模式：

(send p :add-mouse-mode 'drawing
      :title "Drawing"
      :cursor 'finger
      :click :mouse-drawing)

以下表达式将图形放置到新的模型里。

    点击消息:mouse-drawing对应的方法将鼠标点击处的x坐标作为参数，使用该值来区分与linestart最近的x坐标，然后将linestart的y值改变成点击处的y值。当拖动鼠标的时候，x值被鼠标穿过的linestarts数据需要让他们的y值也得到调整。:mouse-drawing方法的一个简单的实现可以是这样的：

(defmeth p :mouse-drawing (x y m1 m2)
  (flet ((adjust (x y)
          (let* ((n (send self :num-lines))
                 (reals (send self :canvas-to-real x y))
                 (i (x-index (first reals) n))
                 (y (second reals)))
            (send self :linestart-coordinate 1 i y)
            (send self :redraw-content))))
    (adjust x y)
    (send self :while-button-down #'adjust)))

函数x-index这样定义：

(defun x-index (x n)
  (max 0 (min (- n 1) (floor (* n x)))))

    如果鼠标被点击和缓慢地拖拽，这个定义就会生效。但是如果鼠标快速地移动，它可能会忽略一些linestarts数据点，导致一个带峰值的函数。为了避免这个问题，我们可以使用一个略微精心制作的:mouse-drawing方法，该方法将在点数据之间进行线性差值，这些点数据会被传递到鼠标按下时触发的动作函数里。

(defun interpolate (x a b ya yb)
  (let* ((range (if-else (/= a b) (- b a) 1))
         (p (pmax 0 (pmin 1 (abs (/ (- x a) range))))))
    (+ (* p yb) (* (- 1 p) ya))))

这个函数将处于点(a,ya)和(b,yb)之间的x参数对应的y值进行线性差值。这里的a可能比b大，所有的参数可能是复合数据。如果a与b相等，if-else表达式需要避免被0除。使用interpolate函数，我们可以这样定义:mouse-drawing方法：

(defmeth p :mouse-drawing (x y m1 m2)
  (let* ((n (send self :num-lines))
         (reals (send self :canvs-to-real x y))
         (old-i (x-index (first reals) n))
         (old-y (second reals)))
    (flet ((adjust (x y)
              (let* ((reals (send self :canvas-to-real x y))
                     (new-i (x-index (first reals) n))
                     (new-y (second reals))
                     (i (iseq old-i new-i))
                     (yvals (interpolate
                             i old-i new-i old-y new-y)))
                (send self :linestart-coordinate 1 i yvals)
                (send self :redraw-content)
                (setf old-i new-i)
                (setf old-y new-y))))
  (adjust x y)
  (send self :while-button-down #'adjust))))

局部函数adjust在其上下文环境里使用old-i和old-y变量，目的是容纳最近一次的adjust函数调用相对应的值。前一个和当前鼠标位置之间的linestart数据是线性差值的。

    图形p的linestart数据包括它的函数的值，该函数处于x值的网格。:lines消息对应的方法这样来定义：

(defmeth p :lines ()
  (let ((i (iseq (send self :num-lines))))
    (list (send self :linestart-coordinate 0 i)
          (send self :linestart-coordinate 1 i))))

它可以用来获取当前函数的值，这些值以x值列表和y值列表的列表形式获取。

练习 10.7
略。

练习 10.8
略。

练习 10.9
略。

10.3 图形控制叠置

绘图动作可以从菜单、对话框处得到控制，也可以在处于图形自身的叠置层内部进行控制。本节描述两种简单的叠置层控制原型，然后展示如何针对旋转图形为这些原型添加额外的功能。

10.3.1 按钮控制

按钮是由代表按钮自身的小正方形和绘制在其右侧的标签字符串组成的。当鼠标在正方形内部点击的时候，就会按压到该按钮，正方形将高亮，然后将持续调用一个动作函数直到按钮释放。

按钮原型

按钮原型这样定义：

(defproto button-overlay-proto
          '(location title)
          nil
          graph-overlay-proto)

原型中两个槽的读取函数定义如下：

> (defmeth button-overlay-proto :location (&optional new)
    (if new (setf (slot-value 'location) new))
    (slot-value 'location))

> (defmeth button-overlay-proto :title (&optional new)
    (if new (setf (slot-value 'location) new))
    (slot-value 'title))

这两个读取方法都没有任何错误检查，另外如果修改了槽的值也不会视图重画控件。

    我们可以使用这两个读取函数为原型的location槽和title槽赋合理的初始化值：

> (send button-overlay-proto :locatiion '(0 0))

> (send button-overlay-proto :title "Button")

位置也可以通过:resize方法来改变。

    为有助于定位按钮，我们需要能够确定包围按钮的矩形的大小，假设location槽包含该矩形区域的左上角坐标，该矩形的尺寸取决于包含按钮叠置层的图形的文本字体的大小。按钮本身是一个正方形，他的边在数值上与字符顶部到基线的距离相等。按钮和标签字符串之间会放置一个空白，其大小是字符顶部到基线的距离的一半，与这个空白相同尺寸的边距将会被放置到字符串与按钮之间。使用这样的布局，返回该矩形的宽度与高度的列表的:size方法这样定义：

(defmeth button-overlay-proto :size ()
    (let* ((graph (send self :graph))
           (title (send self :title))
           (text-width (send graph :text-width title))
           (side (send graph :text-ascent))
           (gap (floor (/ side 2)))
           (descent (send graph :text-descent))
           (height (+ side descent (* 2 gap))))
      (list (+ side (* 3 gap) text-width) height)))

    基于刚刚描述的布局，一个返回按钮正方形的矩形坐标的列表的方法可以这样给定：

(defmeth button-overlay-proto :button-box ()
    (let* ((graph (send self :graph))
           (loc (send self :location))
           (side (send graph :text-ascent))
           (gap (floor (/ side 2))))
      (list (+ gap (first loc)) (+ gap (second loc)) side side)))

下边这个方法是用来计算标签字符串绘制位置的：

(defmeth button-overlay-proto :title-start ()
    (let* ((graph (send self :graph))
           (loc (send self :location))
           (title (send self :title))
           (side (send graph :text-ascent))
           (gap (floor (/ side 2))))
      (list (+ (* 2 gap) side (first loc))
            (+ gap side (second loc)))))

    绘制该按钮的方法这样给定：

(defmeth button-overlay-proto :draw-button (&optional paint)
    (let ((box (send self :button-box))
          (graph (send self :graph)))
      (apply #'send graph :erase-rect box)
      (if paint
          (apply #'send graph :paint-rect box)
          (apply #'send graph :frame-rect box))))

这个方法带一个可选参数，如果该参数是非nil的，按钮将以高亮状态绘制；否则，按钮只是简单地构造出来。这里的apply函数是需要的，因为box变量包含一个参数列表，矩形绘制函数需要该参数列表。

    绘制标签字符串的方法可以这样定义：

(defmeth button-overlay-proto :draw-title ()
    (let ((graph (send self :graph))
          (title (send self :title))
          (title-xy (send self :title-start)))
      (apply #'send graph :draw-string title title-xy)))

使用这两个方法，:redraw方法这样定义：

(defmeth button-overlay-proto :redraw ()
    (send self :draw-title)
    (send self :draw-button))

    为了确定叠置层是否应该响应点击事件，我们需要确定点击的位子是否位于按钮正方形的范围内。这个工作可以用下边定义的方法来定义：

(defmeth button-overlay-proto :point-in-button (x y)
    (let* ((box (send self :button-box))
           (left (first box))
           (top (second box))
           (side (third box)))
      (and (< left x (+ left side)) (< top y (+ top side)))))

我们假定按钮叠置层有一个:do-action方法，使用该方法可以实现按钮的动作。对于点击操作，该动作可能需要利用修饰符（shift或alt键）。我们可能想要这个动作在鼠标按下的初始状态和随后的调用中表现不同的行为，为了允许这种可能性，我们可以使用下边这一协定，即发送只带一个参数的:do-action消息。在一次点击之后的第一次调用的时候，参数是一个带有两个修饰符的列表；在后续的调用中，这个参数为nil。:do-click方法可以这样定义：

(defmeth button-overlay-proto :do-click (x y m1 m2)
    (let ((graph (send self :graph)))
      (when (send self :point-in-button x y)
            (send self :draw-button t)
            (send self :do-action (list m1 m2))
            (send graph :while-button-down
                  #'(lambda (x y) (send self :do-action nil)) nil)
            (send self :draw-button nil)
            t)))

因为发送了第二个参数为nil的:while-button-down消息，当按钮按下的时候它的动作函数将持续调用。

    为了完成按钮原型的定义，我们可以给出一个不做任何事情的:do-action方法：

(defmeth button-overlay-proto :do-action (x) nil)

一个应用：滚动一个可旋转图形

在计算机上旋转一个图形带来的问题是：当旋转停止的时候，由动作创建的深度暗示将会消失。换句话说，当图形旋转的时候，很难将注意力集中到一个特定的视图上。解决这个问题的一个方法就是允许图形来回翻转，在垂直于屏幕的坐标轴附近的每个方向上通过一个很小的数量旋转图形。翻转动作提出了深度错觉，但是数据视图基本上保持不变。一个用来翻转可旋转图形的方法可以这样来定义：

(defmeth spin-proto :rock-plot (&optional (a . 15))
    (let* ((angle (send self :angle))
           (k (round (/ a angle))))
      (dotimes (i k) (send self :rotate-2 0 2 angle))
      (dotimes (i (* 2 k)) (send self :rotate-2 0 2 (- angle)))
      (dotimes (i k) (send self :rotate-2 0 2 angle))))

该方法通过一个方向上的指定角度进行旋转，在相反方向上以该角度的两倍进行旋转，然后旋转回原始位置。私用的默认角度是0.15弧度。

    按钮提供了一个便捷的方式，将:rock-plot消息发送到一个旋转图形里。使用按钮原型，我们可以为翻转一个旋转图形定义一个新的原型：

(defproto spin-rock-control-proto () () button-overlay-proto)

这个按钮对应的标题可以这样设置：

(send spin-rock-control-proto :title "Rock Plot")

对于翻转按钮的动作方法将向图形发送:rock-plot消息。

(defmeth spin-rock-control-proto :do-action (first)
  (send (send self :graph) :rock-plot))

    按钮的一个很自然的位置就是沿着图形的底端，同时标准的旋转控件。:resize方法将会把按钮的位置设置到图形的右侧较低的角落里：

(defmeth spin-rock-control-proto :resize ()
  (let* ((graph (send self :graph))
         (size (send self :size))
         (width (send graph :canvas-width))
         (height (send graph :canvas-height)))
    (send self :location (- (list width (+ 3 height)) size))))

这里的3像素高度的调整是需要的，目的是与Macintosh操作系统的标准控件的按钮对其。

    举个例子，使用第2.5.1节里的磨损数据，以下表达式将构造一个旋转图形，并在图形里安装一个翻转按钮：

(let ((w (spin-plot
           (list hardness tensile-strength abrasion-loss)))
      (b (send spin-rock-control-proto :new)))
  (send w :add-overlay b)
  (send b :resize)
  (send b :redraw))

10.3.2 双按钮控件

双按钮控件原型

旋转图形上的标准控件是双按钮控件，一个按钮用来产生正角度，另一个用来产生负角度。双按钮控件对应的原型可以从头构造，就像点击按钮一样。但是在点击按钮和双按钮之间有相当大的相似处，所以我们可以通过定义这个继承自点击按钮的新的原型来省些事情

(defproto twobutton-control-proto () () button-overlay-proto)

这里继承的使用与线性模型里的非线性回归模型的定义是相似的。

    双按钮控件的布局与单按钮控件布局相似，只不过增加了一个额外的按钮而已，那么:size方法也可以使用继承来的方法，并且可以为两个按钮之间增加一块空白空间：

(defmeth twobutton-control-proto :size ()
    (let* ((graph (send self :graph))
           (size (call-next-method))
           (side (send graph :text-ascent))
           (gap (floor (/ side 2))))
      (list (+ gap side (first size)) (second size))))

:title-start方法也可以使用继承来的方法，但是从头来定义它也很容易：

(defmeth twobutton-control-proto :title-start ()
    (let* ((graph (send self :graph))
           (loc (send self :location))
           (title (send self :title))
           (side (send graph :text-ascent))
           (gap (floor (/ side 2))))
      (list (+ (* 3 gap) (* 2 side) (first loc))
            (+ gap side (second loc)))))

    由于现在有两个按钮，我们需要一种方式区分它们。符号 - 和 +将分别用于左边和右边的按钮。这里的:button-box方法带一个参数，即button符号：

(defmeth twobutton-control-proto :button-box (which)
    (let* ((graph (send self :graph))
           (loc (send self :locatiion))
           (side (send graph :text-ascent))
           (gap (floor (/ side 2)))
           (left (case which
                   (+ (+ gap (first loc)))
                   (- (+ (* 2 gap) side (first loc))))))
      (list left (+ gap (second loc)) side side)))

:draw-button方法这样定义：

(defmeth twobutton-control-proto :draw-button (which &optional paint)
    (let ((box (send self :button-box which))
          (graph (send self :graph)))
      (cond (paint (apply #'send graph :paint-rect box))
        (t (apply #'send graph :erase-rect box)
           (apply #'send graph :frame-rect box)))))

它也需要一个button符号参数，并且带一个可选的参数来指定该按钮是否高亮。:redraw方法现在可以这样给出：

(defmeth twobutton-control-proto :redraw ()
    (send self :draw-title)
    (send self :draw-button '-)
    (send self :draw-button '+))

    :point-in-button方法是用来做这样的事的：如果点击处的坐标没有落在按钮范围内，返回nil；如果它们落在按钮范围内的话，将返回button符号：

(defmeth twobutton-control-proto :point-in-button (x y)
    (let* ((box1 (send self :button-box '-))
           (box2 (send self :button-box '+))
           (left1 (first box1))
           (top (second box1))
           (side (third box1))
           (left2 (first box2)))
      (cond
        ((and (< left1 x (+ left1 side)) (< top y (+ top side))) '-)
        ((and (< left2 x (+ left1 side)) (< top y (+ top side))) '+))))

点击方法可以这样定义：

(defmeth twobutton-control-proto :do-click (x y m1 m2)
    (let ((graph (send self :graph))
          (which (send self :point-in-button x y)))
      (when which
            (send self :draw-button which t)
            (send self :do-action which (list m1 m2))
            (send graph :while-button-down
                  #'(lambda (x y)
                      (send self :do-action which nil))
                  nil)
            (send self :draw-button which nil)
            t)))

:do-action消息的发送需要两个参数，第一个参数是一个button符号，第二个参数由第一次调用时的修饰符列表组成，在随后的调用过程中将返回nil，默认的:do-action方法这样给定：

(defmeth twobutton-control-proto :do-action (which mods) nil)

应用举例：绕坐标轴旋转

用于旋转图形的标准控件允许图形绕屏幕坐标旋转，有时候绕着一个坐标轴旋转是有用的，这只有在三维坐标系，因为在更高维度的情况下，坐标轴和角度不能唯一指定一次旋转操作。

    下边这个方法将一个图形的rotation-type设置成为一个矩阵，该矩阵由通过索引参数v指定的坐标轴和绕着该坐标轴转的角度组成。

(defmeth spin-proto :set-axis-rotation (v)
    (let* ((m (send self :num-variables))
           (v1 (if (= v 0) 1 0))
           (v2 (if (= v 2) 1 2))
           (trans (send self :transformation))
           (cols (column-list
                  (if trans trans (identity-matrix m))))
           (x1 (select cols v1))
           (x2 (select cols v2))
           (angle (send self :angle)))
      (send self :rotation-type (make-rotation x1 x2 angle))))

绕指定坐标轴旋转的双按钮原型可以这样定义：

(defproto spin-rotate-control-proto
    '(v) () twobutton-control-proto)

槽v代表旋转轴的索引，:isnew方法定义如下：

(defmeth spin-rotate-control-proto :isnew (v &rest args)
    (apply #'call-next-method :v v args))

该方法带一个索引为参数，并使用继承来的:isnew方法将该索引值安置到槽v里。

    坐标轴旋转按钮的标签字符串可以通过使用:variable-label消息来从图形里读取：

(defmeth spin-rotate-control-proto :title ()
    (send (send self :graph) :variable-label (slot-value 'v)))

:do-action方法这样定义：

(defmeth spin-rotate-control-proto :do-action (sign mods)
    (let ((graph (send self :graph)))
      (if mods
          (let ((v (slot-value 'v))
                (angle (abs (send graph :angle))))
            (send graph :idle-on (first mods))
            (send graph :angle
                  (if (eq sign '+) angle (- angle)))
            (send graph :set-axis-rotation v)))
      (send graph :rotate)))

该方法在点击的时候设置为坐标轴旋转，并在后续的调用中发送:rotate消息。角度的正负可以根据按下的按钮来调整，如果提供了带点击的扩展修饰符，那么将开始一段空置时间。

    我们在使用一次上文提到的磨损数据，以下表达式将设置一个旋转图形，并给出3个轴的旋转控制，每个数据轴一个：

(flet ((width (c) (first (send c :size))))
    (let* ((w (spin-plot
               (list hardness tensile-strength abrasion-loss)))
           (c0 (send spin-rotate-control-proto :new 0))
           (c1 (send spin-rotate-control-proto :new 1))
           (c2 (send spin-rotate-control-proto :new 2)))
      (send w :add-overlay c0)
      (sedn w :add-overlay c1)
      (send w :add-overlay c2)
      (let ((width (max (mapcar #'width (list c0 c1 c2))))
            (height (second (send c0 :size)))
            (margin (send w :margin)))
        (send c1 :location (list 0 height))
        (send c2 :location (list 0 (* 2 height)))
        (send w :margin width 0 0 (fourth margin)))))

新的控件将放置在图形的左边，:margin方法将向图形发送:resize和:redraw消息，这些消息对应的方法将向叠置层发送对应的消息，结果图形见10.4。

图10.4 带轴旋转控件的磨损数据旋转图

10.4 grand tours

最近，为了探讨多维数据我们提出的方法是grand tour，它的基本意思就是找出数据的一维、二维或者三维投影的序列的一种，在所有可能的投影中间这些序列会迅速地变得稠密。该序列可以针对那些极其“不同寻常的”数据视图进行检测，就像展示聚类和其它结构的视图那样。这类检测可以通过两种方式完成，一个是通过对投影进行统计计算在数值上进行完成，还有一个方法是通过显示投影的影像来图形化地完成。对于数值化的方法，投影序列不需要任何附加的结构；对于图形化的方法，可能需要提供持续变化的能力，目的是让观察者可以容易地进行单点和点群跟踪。

    在Lisp-Stat里实现m维图形grand tour的一种方法就是选择一个旋转序列，当开始该旋转时观察图形。与短程grand tour方法接近的模式是这样的：选择m维的单位球面的两点，使用这两个点定义一个平面，然后构造一个旋转序列，当保持固定平面的正交互补的同事将第一个点带入到第二个点里。当到达第二个点时，使用另一个点对重复该过程。在该模式上的轻微的改变可以用于构造增量旋转，在切换到一个新的旋转之前，本次旋转将使用由时间产生的随机数。作用到旋转上的时间数值可以均匀地选取[0, pi/2a]里非负整数。

    该模式可以通过使用一些基本原型来实现。旋转图形已经提供了对速度的控制，提供了使用增量旋转的系统。换句话说，在一维投影中，直方图可以给出更好的点密度视图，对于探测偏离度来说会更有用。对于基于旋转图形和直方图的tours，我们无需实现每个tour的所有特征，我们可以利用对象系统的多重继承能力，通过定义一个mixin来维持tour所需的方法和槽规则。那么，基于旋转图形的tour原型，可以通过使用mixin和spin-proto作为其父类的方式来构造。

    为了实现上边着重提到的策略，tour图形使用make-rotation函数来构造矩阵，用来从一个点向另一个点进行旋转转换。旋转操作使用一个由当前旋转速度确定的角度，旋转操作需要使用多次来将球形上的第一个点映射到第二个点上。当到达第二个点的时候，将产生一个新的旋转增量，旋转操作使用的次数也会得到计算。那么这里的tour mixin原型可以这样定义：

(defproto tour-mixin '(tour-count tour-trans))

这两个槽表示增量旋转矩阵和需要应用此操作的次数。mixin没有父类，因为它是用来与其它图形原型联合使用的。

    tour处理过程就是持续地运行，因此它可以通过定义:do-idle方法来实现：

(defmeth tour-mixin :do-idle () (send self :tour-step))

这里的:tour-step是该系统的主要部分：

(defmeth tour-mixin :tour-step ()
    (when (< (slot-value 'tour-count) 0)
          (flet ((sphere-rand (m)
                              (let* ((x (normal-rand m))
                                     (nx2 (sum (^ x 2))))
                                (if (< 0 nx2)
                                    (/ x (sqrt nx2))
                                    (/ (repeat 1 m) (sqrt m))))))
            (let* ((m (send self :num-variables))
                   (angle (send self :angle))
                   (mx (+ 1 (abs (floor (/ pi (* 2 angle)))))))
              (setf (slot-value 'tour-count) (random max))
              (setf (slot-value 'tour-trans)
                    (make-rotation (sphere-rand m)
                                   (spere-rand m)
                                   angle)))))
    (send self :apply-transformation (slot-value 'tour-trans))
    (setf (slot-value 'tour-count)
          (- (slot-value 'tour-count) 1)))

该方法检测tour-count槽，以查明其是否小于0，如果不小于0，其值将逐次递减1，将会使用到tour-trans槽的值；如果tour-count槽的值小于0，该方法首先将计算新的变换矩阵和计数。局部函数sphere-rand用来在m维的单元球上生成正态散点，它是通过正规化m维独立标准正态随机变量得到的。为了安全起见，将检测除数为0的情况。使用sphere-rand生成两个点，通过向图形发送:angle消息可以获取角度，其结果将被传递到make-rotation函数以构造新的增量旋转矩阵，random函数将构造一个新的计数。

    为了使该方法更好地工作，图形必须有一个:angle方法，因为spin-proto图形已经有这个方法了，它就不会包含到tour-mixin里了。基于其它原型的Tour图形加入它们自己的angle方法。

    为了保证可以计算新的变换矩阵和计数，首次要使用:tour-step方法，我们可以将tour-count槽的值设置成一个负数：

(send tour-mixin :slot-value ;tour-count -1)

为了可以打开和关闭tour功能，或者为了确认tour功能是否打开，我们可以定义一个:tour-on方法。在可能的情况下，该方法的最简单的版本就是想:idle-on消息传递参数：

(defmeth tour-mixin :tour-on (&rest args)
    (apply #'send self :idle-on args))

晚些时候我们可能想要一个更加精心设计的定义。

    为了允许向图形菜单上加入一个菜单项，用来打开和光比tour功能，我们可以定义一个tour-item-proto原型：

(defproto tour-item-proto '(graph) () menu-item-proto)

该原型的:isnew方法需要一个图对象作为参数：

(defmeth tour-item-proto :isnew (graph)
    (call-next-method "Touring")
    (setf (slot-value 'graph) graph))

图对象可以使用:graph消息来获取：

(defmeth tour-item-proto :graph () (slot-value graph))

如果tour功能是打开的，该菜单项的:update方法将在它前边放一个标记：

(defmeth tour-item-proto :update ()
    (let ((graph (send self :graph)))
      (send self :mark (send graph :tour-on))))

:do-action方法转换tour的动作：

(defmeth tour-item-proto :do-action ()
    (let* ((graph (send self :graph))
           (is-on (send self :tour-on)))
      (send graph :tour-on (not is-on))))

最后，我们可以为tour mixin重新定义:menu-template方法，用来向菜单模板的尾部添加一个tour项，这里的菜单模板由继承来的方法产生：

(defmeth tour-mixin :menu-template ()
    (append (call-next-method)
            (list (send tour-item-proto :new self))))

    使用tour mixin，一个基于旋转图形的tour图形原型可以这样定义：

(defproto spin-tour-proto () () (list tour-mixin spin-proto))

该原型有两个父类，分别是tour mixin和spin-proto，mixin放在spin-proto前边，所以在优先级列表里，mixin的方法出现在从旋转图形里获取的方法的前边。使用下边的表达式，我们可以赋予新原型更加合适的窗体标题和菜单标题：

(send spin-tour-proto :title "Grand Tour")

(send spin-tour-proto :menu-title "Tour")

针对一个数据集产生tour图形的构造函数可以这样来定义：

> (defun tour-plot (data &rest args &key point-labels)
    (let ((graph (apply #'send spin-tour-proto :new
                        (length data) args)))
      (if point-labels
          (send graph :add-points
                data :point-labels point-labels :draw nil)
          (send graph :add-points data :draw nil))
      (send graph :adjust-to-data :draw nil)
      graph))

图10.5 糖尿病数据grand tour的四个视图

通过向原型发送:new消息，该函数产生了一个新的图形，并将数据添加到图形里，然后，使用:adjust-to-data消息将图形缩放到数据之上。由于tour mixin没有:isnew方法，它将使用从spin-proto继承来的:isnew方法。

    对于在多维空间里进行聚类探测，Grand tours看起来是很有用的。作为一个人工事例，图10.5展示了Reaven和Miller地区的一个数据集的一个grand tour的4个视图，图形里使用的数据包括150个患者数据，每位患者都进行3次连续测量，两次葡萄糖测量和一次胰岛素耐量测量，第4个变量是一个分类变量，它分3个等级，用来指示患者被分类到正常、“化学性”糖尿病或是明显的糖尿病。图10.5里前两个视图显示：这3个连续变量里点云数据呈现为回旋镖的形状；剩下的两个视图表明：当将第4个分类变量引入到tour里的时候，点云分成独立的3个聚类。

    使用这种tour与图形混合的模式，我们还可以构造一个直方图tour原型，该定义增加了一个角度槽：

(defproto hist-tour-proto
    '(angle) () (list tour-mixin histogram-proto))

该槽的读取函数这样给出：

(defmeth hist-tour-proto :angle (&optional new)
    (if new (setf (slot-value 'angle) new))
    (slot-value 'angle))

可以这样设置其初始值：

(send hist-tour-proto :angle .1)

    该原型的默认缩放选项应该是可变缩放：

(send hist-tour-proto :scale-type 'variable)

然后我们为原型赋予新的窗体标题和新的菜单标题：

(send hist-tour-proto :title "Histogram Tour")

(send hist-tour-proto :menu-title "Tour")

我们可以定义一个构造函数：

(defun histogram-tour (data &rest args &key point-labels)
    (let ((graph (apply #'send hist-tour-proto :new
                        (length data) :draw nil args)))
      (if point-labels
          (send graph :add-points
                data :point-labels point-labels :draw nil)
          (send graph :add-points data :draw nil))
      (send graph :adjust-to-data :draw nil)
      graph))

    

图10.6 6维单位立方里的100个点数据的均匀分布的直方grand tour的四个视图

    用一个直方图tour来研究兴趣点，这种方法是理论观测，对于较大的m空间维度，m维空间里的多数正态数据的投影都是“看起来是”正态的。下表的表达式够早了一个100个点的直方图tour，这100个点均匀地分布在六维单位立方体里：

(histogram-tour (uniform-rand (repeat 100 6)))

图10.6展示了该tour的4个视图。第1个视图表示首坐标的直方图，看起来是比较合理的均匀分布；其它视图根据tour里不同的点而定，与其说均匀不如说是正态。

    构造一个基于散点图矩阵的tour图形，可以私用相似的方法，散点图矩阵tour提供了当前旋转操作中所有坐标对儿的同步视图。

练习 10.10
略
练习 10.11
略。
练习 10.12
略
练习 10.13
略
练习 10.14
略

10.5 平行坐标图

在3维或更高纬度里显示数据的另一个方法就是使用平行坐标图。平行坐标图是由图上等距放置的纵坐标轴平行的图形构造而成的，每个坐标轴上每个点的值都是分开的，然后在为每个点建立连接符号。举个例子，图10.7展示了烟道损耗数据的平行坐标图，这4个坐标轴以线的形式扭结在一起，我们没有画出他们。通过对点数据符号进行选择操作或者刷操作，我们可以在图形里选取点数据，初始情况下，这些点符号是位于第一个坐标轴上的，我们可以通过使用菜单里的一个对话框将这些点符号定位到其它任意坐标轴上。该布局是基于Andreas Buja和Paul Tukey两人使用过的一个相似图形的。

图10.7 烟道损耗数据的平行坐标图

    平行坐标图的原型可以通过使用graph-proto原型来开发，新的原型需要一个额外的槽来表示当前坐标轴的索引，该当前坐标轴是包含点符号的：

(defproto parallel-plot-proto '(v) () graph-proto)

可以这样为平行坐标图安置新标题：

(send parallel-plot-proto :title "Parallel Plot")

    与直方图相似，平行坐标图向数据中添加了一个额外的维度，该维度用来沿着水平轴定位点符号。:isnew方法向其维度参数里增加了1，将当前坐标轴槽设置为0，然后将初始内容变量设置为最后一个坐标轴和第一个维度：

(defmeth parallel-plot-proto :isnew (m &rest args)
    (setf (slot-value 'v) 0)
    (apply #'call-next-method (+ 1 m) args)
    (send self :content-variables m 0))

对于最后一个维度，只要放置的值是合适的，该设置就可以确保graph-proto方法在合适的位置绘制点符号，并处理标准鼠标动作。对于平行图形，需要一些其它方法来保证安置合适的数据，并细心地处理数据线的绘制。

    为了获得点数据符号在当前坐标的位置，安置正确的点坐标值是该方法的责任。以不带参数的方式调用，该方法将返回当前坐标轴的索引；以带参数的方式调用，该参数是指定新坐标轴的索引i，它会将最后一个变量的点坐标的值设置为i，然后将内容变量设置为最后一个变量和变量i：

(defmeth parallel-plot-proto :current-axis
    (&optional (i nil set) &key (draw t))
    (when set
          (setf (slot-value 'v) i)
          (let* ((n (send self :num-points))
                 (m (- (send self :num-variables) 1))
                 (i (max 0 (min i (- m 1)))))
            (if (< 0 n)
                (send self :point-coordinate m (iseq n) i))
            (send self :content-variables m i))
          (if draw (send self :redraw)))
    (slot-value 'v))

关键字参数:draw可用来避免方法重画图形。一个用来切换当前坐标轴的对话框可以这样表示：

(defmeth parallel-plot-proto :choose-current-axis ()
    (let* ((choices
            (mapcar #'(lambda (x) (format nil "~d" x))
                    (iseq (- (send self :num-variables) 1))))
           (v (choose-item-dialog
               "Current Axis:"
               choices
               :initial (send self :current-axis))))
      (if v (send self :current-axis v))))

为了显示该对话框，可以通过修改:menu-template方法，向标准菜单里增加一个菜单项：

(defmeth parallel-plot-proto :menu-template ()
    (flet ((action () (send self :choose-current-axis)))
      (let ((item (send menu-item-proto :new
                        "Current Variable"
                        :action #'action)))
        (append (call-next-method) (list item)))))

    :adjust-to-data方法使用了继承来的方法，然后调整最后那个变量的范围，使第一个和最后一个坐标轴的边侧留下0.1个单元的空白。如果缩放类型为nil，数据变量的方位可以扩展10%：

(defmeth parallel-plot-proto :adjust-to-data (&key (draw t))
    (call-next-method :draw nil)
    (let ((m (- (send self :num-variables) 1)))
      (if (null (send self :scale-type))
          (flet ((expand-range (i)
                               (let* ((range (send self :range i))
                                      (mid (mean range))
                                      (half (- (second range) (first range)))
                                      (low (- mid (* .55 half)))
                                      (high (+ mid (* .55 half))))
                                 (send self :range i low high :draw nil))))
            (dotimes (i m) (expand-range i))))
      (send self :scale m 1 :draw nil)
      (send self :center m 0 :draw nil)
      (send self :range m -.1 (- m .9) :draw draw)))

    在调用继承来的方法之前，:add-points方法需要向新的点数据增加一个额外的坐标，只要集成来的方法不会绘制点数据，实际值就不会出现什么问题，并且可以私用:current-axis消息设置成合适的值：

(defmeth parallel-plot-proto :add-points (data &key (draw t))
    (let ((n (length (first data))))
      (call-next-metod (append data (list (repeat 0 n)))
                       :draw nil))
    (send self :current-axis
          (send self :current-axis) :draw draw))

:add-lines消息可以这样覆写：

(defmeth parallel-plot-proto :add-lines (&rest args)
    (error "Lines are not meaningful for this plot"))

因为在平行坐标图里，线数据不能合理地显示。

    :redraw-content方法可以通过几种合理的方式来定义。最有效的方法就是利用画布坐标，它是由graph-proto原型转换系统定义的。向下边这样定义:resize方法可以确保所有数据变量的画布范围都被设置到这一范围内：即从0到内容矩形的高度：

(defmeth parallel-plot-proto :resize ()
    (call-next-method)
    (let ((height (fourth (send self :content-rect)))
          (m (- (send self :num-variables) 1)))
      (send self :canvas-range (iseq m) 0 height)))

这个继承来的、在新方法开始处调用的方法确保了如下事实：当前的x变量使其范围在0到内容矩形的宽度范围之内。

    作为点的平行表示方法的直线可以绘制成一个多边形，这里的x坐标可以计算为对内容原点的偏移量，该原点基于当前坐标轴设置里使用的惯例；y坐标是这样的点：画布坐标到内容原点的偏移量。在彩色显示器上，这些线以点的颜色着色。那么绘制一个或更多这类线的方法可以这样定义：

(defmeth parallel-plot-proto :draw-parallel-point (i)
    (let* ((points (if (numberp i) (list i) i))
           (width (third (send self :content-rect)))
           (origin (send self :content-origin))
           (x-origin (first origin))
           (y-origin (second origin))
           (m (- (send self :num-variables) 1))
           (gap (/ width (+ (- m 1) .2)))
           (xvals (+ x-origin
                     (round (* gap (+ .1 (iseq 0 (- m 1)))))))
           (indices (iseq 0 (- m 1)))
           (oldcolor (send self :draw-color)))
      (dolist (i points)
              (if (sned self :point-showing i)
                  (let* ((color (send self :point-color i))
                         (yvals (- y-origin
                                   (send self
                                         :point-canvas-coordinate
                                         indices
                                         i)))
                         (poly (transpose (list xvals yvals))))
                    (if color (send self :draw-color color))
                    (send self :frame-poly poly)
                    (if color (send self :draw-color oldcolor)))))))

该方法的参数可以是一个单独的索引，也可以是一个索引列表。现在，:redraw-content方法可以定义成这样：

(defmeth parallel-plot-proto :redraw-content ()
    (let ((indices (iseq (send self :num-points))))
      (send self :start-buffering)
      (call-next-method)
      (send self :draw-parallel-point indices)
      (send self :buffer-to-screen)))

    最后，我们定义一个构造函数：

(defun parallel-plot (data &rest args &key point-labels)
    (let ((graph (apply #'send parallel-plot-proto :new
                        (length data) :draw nil args)))
      (if points-labels
          (send graph :add-points
                data :point-labels point-labels :draw nil)
          (send graph :add-points data :draw nil))
      (send graph :adjust-to-data :draw nil)
      graph))

下表的表达式将创建图10.7展示的图形：

(parallel-plot (list air temp conc loss))

    因为平行图形的原型是建立在graph-proto原型之上的，所以它已经获得了全部的变换系统，因此，它使用旋转操作去定义一个grand tour的平行图形版本是可能的。

练习10.15
略。

练习10.16
略。

练习10.17
略。

10.6 一个可代替的连接策略

Lisp-Stat里使用的默认的连接策略是使用一个共同的索引在不同的图形之间建立一个松散的对应关系。点的状态是通过连接图进行匹配的，但是其他特征，比如符号或者颜色则不能。一个可替代的方法将观测值视为对象，这里的对象可以视为使用不同的图形，此方法McDonald和Stuetzle使用过。点状态、颜色或者符号这些属性都是观测值的属性，这些属性里的任何一个改变，或者说某个观测值里的变量的值发生了改变，应该在所有的观测图形里都有反应。在这个方法里，观测值放入图形里的顺序是不重要的，因为观测值作为对象有他们自己的标识，不需要通过索引来识别。这意味着不同的图形可以展示不同的观测集。

    本节将在Lisp-Stat绘图系统里描述一个这种连接策略的简单的实现，该实现基于第6.8.2节描述的数据展示。基本的思想就是将观测值表示为对象，并允许使用图形改变观测对象的特征，然后确保将观测值对象的更改传递到所有包含这个观测值的图形上去。

    基本的观测值原型定义如下：

(defproto observation-proto '(label state symbol color views))

6.8.2节里定义的这些参数，它们的槽用来存放绘制观测值所需要的特征，这些槽的读取方法这样给出：

(defmeth observation-proto :label () (slot-value 'label))

(defmeth observation-proto :state () (slot-value 'state))

(defmeth observation-proto :symbol () (slot-value 'symbol))

(defmeth observation-proto :color () (slot-value 'color))

默认的状态和符号值可以这样安置：

(send observation-proto :slot-value 'state 'normal)

(send observation-proto :slot-value 'symbol 'disk)

对于特殊的数据集的观测量，可以通过增加槽的方式来构造，目的是将变化的值保存到对象上，这里的对象是从该观测量原型继承来的。

    这里的观测量里的views槽是与特定的图形里的观测量的索引一起，用来来记录哪个槽包含观测量的。通过向观测量发送:add-view消息，我们可以向这个列表里添加一个新的入口，要添加的消息有两个参数：图形对象和观测量的索引：

(defmeth observation-proto :add-view (graph key)
    (setf (slot-value 'views)
          (cons (list graph key) (slot-value 'views))))

下边的方法从views列表里为特定的图形删除该入口。为了提高效率，使用了析构函数delete：

(defmeth observation-proto :delete-view (graph)
    (flet ((test (x y) (eq x (first y))))
      (let ((views (slot-value 'views)))
        (if (member graph views :test #'test)
            (setf (slot-value 'views)
                  (delete graph views :test #'test))))))

返回当前views列表的读取方法这样定义：

(defmeth observation-proto :views () (slot-value 'views))

为了支持新的连接系统，观测量对象里的槽应该仅仅通过这样的方法来改变，即通过向观测量发送:change消息来改变，其参数为槽的符号和新的槽值。下边的方法向每个视图（包括该对象）发送:changed消息，其参数为观测量的索引、槽符号和槽的新值。

(defmeth observation-proto :change (slot value)
    (setf (slot-value slot) value)
    (dolist (view (send self :views))
            (send (first view) :changed (second view) slot value)))

    :changed消息是观测量与需要支持新连接策略的图形之间的通信的协议的一部分，该消息对应的方法和其它消息一起可以组合到一个mixin里：

(defproto observation-plot-mixin '(observations variables))

这里的mixin有两个槽，observations槽表示图形里的观测量对象的矢量。就像6.8.2节一样，图形里表示的变量通过消息选择器关键字来展示，variables槽保存了这些关键字的列表。这两个槽的读取函数这样定义：

(defmeth observation-plot-mixin :observations ()
    (slot-value 'observations))

(defmeth observation-plot-mixin :variables ()
    (slot-value 'variables))

:isnew方法需要一个变量列表，而不是一个维度的数值：

(defmeth observation-plot-mixin :isnew (vars &rest args)
    (apply #'call-next-method
           (length vars)
           :variable-labels (mapcar #'string vars)
           args)
    (setf (slot-value 'variables) vars))

因为这个mixin模式将与其它图形原型一同使用，继承来的:isnew方法将需要一个指定图形维度的整型参数。

    通过使用:add-observation消息，观测量可以加入到图形中，这里的:add-observation消息需要观测量列表作为参数，并接收:draw关键字，目的是指定图形是否应该重画：

(defmeth observation-plot-mixin :add-observations
    (new-obs &key (draw t))
    (let* ((obs (send self :observations))
           (n (length obs))
           (m (length new-obs))
           (new-obs (coerce new-obs 'vector)))
      (setf (slot-value 'observations)
            (concatenate 'vector obs new-obs))
      (dotimes (i m)
               (send (aref new-obs i) :add-view self (+ i n)))
      (send self :needs-adjusting t)
      (if draw (send self :adjust-screen))))

    当图形接收到:remove消息时，比如关闭窗体，它会移除自身，就像从观测量里移除一个视图一样：

(defmeth observation-plot-mixin :remove ()
    (call-next-method)
    (let ((obs (send self :observations)))
      (dotimes (i (length obs))
               (send (aref obs i) :delete-view self))))

adjust-screen方法检测图形是否需要调整，如果需要调整，清除当前点数据，新的点数据通过引用图中观测量的方式安置进来：

(defmeth observation-plot-mixin :adjust-screen ()
    (if (send self :needs-adjusting)
        (let ((vars (send self :variables))
              (obs (send self :observations)))
          (send self :clear-points :draw nil)
          (when (< 0 (length obs))
                (flet ((variable (v)
                                 (map-elements #'(lambda (x) (send x v))
                                               obs)))
                  (send self :add-points
                        (mapcar #'variable vars) :draw nil))
                (dotimes (i (length obs))
                         (let ((x (aref obs i)))
                           (send self :point-label i (send x :label))
                           (send self :point-label i (send x :state))
                           (send self :point-label i (send x :color))
                           (send self :point-symbol i (send x :symbol)))))
          (send self :needs-adjusting nil)
          (send self :redraw-content))))

:changed消息对应的方法这样定义：

(defmeth observation-plot-mixin :changed (key what value)
    (case what
      (state (send self :point-state key value))
      (t (send self :needs-adjusting t))))

因为大多数图形都可以使它们的点的状态快速地调整，所以我们使用:point-state消息来响应状态改变。其它的改变通过在图上做标记来调整。

    一些被标准图形菜单使用的方法需要重新定义，以改变观测量对象而不是改变图形，然后确保所有将该对象作为视图的图形都得到调整。下边的函数可以用来调整所有图形：

(defun synchronize-graphs ()
    (dolist (g (active-windows))
            (if (kind-of-p g observation-plot-mixin)
                (send g :adjust-screen))))

菜单使用的三个方法定义如下，:erase-selection方法用来使选中的点数据不可见：

(defmeth observation-plot-mixin :erase-selection ()
    (let ((obs (send self :observations)))
      (dolist (i (send self :selection))
              (send (aref obs i) :change 'state 'invisible)))
    (synchronize-graphs))

:show-all-points方法将任意不可见观测量设置为正常状态：

(defmeth observation-plot-mixin :show-all-points ()
    (let ((obs (send self :observations)))
      (dotimes (i (length obs))
               (send (aref obs i) :change 'state 'normal)))
    (synchronize-graphs))

:focus-on-selection方法用来使所有未选中的点数据不可见：

(defmeth observation-plot-mixin :focus-on-selection ()
    (let* ((obs (send self :observations))
           (showing (send self :points-showing))
           (selection (send self :selection)))
      (dolist (i (set-difference showing selection))
              (send (aref obs i) :change 'state 'invisible)))
    (synchronize-graphs))

    由于原来的连接系统不再使用，在mixin里定义:menu-template方法，处理掉标准菜单里的连接项就是个好想法：

(defmeth observation-plot-mixin :menu-template ()
    (remove 'link (call-next-method)))

    标准鼠标方法使用的消息也需要修改，:unselect-all-points方法变成这样：

(defmeth observation-plot-mixin :unselect-all-points ()
    (let ((obs (send self :observations)))
      (dolist (i (send self :selection))
              (send (aref obs i) :change 'state 'normal))
      (send self :adjust-screen)))

新的:adjust-points-in-rect方法可以通过:points-in-rect消息来定义：

(defmeth observation-plot-mixin :adjust-points-in-rect (left top width height state)
    (let ((points (send self :points-in-rect
                        left top width height))
          (selection (send self :selection))
          (obs (send self :observations)))
      (case state
        (selected
         (dolist (i (set-difference points selection))
                 (send (aref obs i) :change 'state 'selected)))
        (hilited
         (let* ((points (set-difference points selection))
                (hilited (send self :points-hilited))
                (new (set-difference points hilited))
                (old (set-difference hilited points)))
           (dolist (i new)
                   (send (aref obs i) :change 'state 'hilited))
           (dolist (i old)
                   (send (aref obs i) change 'state 'normal))))))
    (synchronize-graphs))

这两个方法都影响了观测量里而不是图形的状态，并且通过通信协议从观测量向它们的视图回传变化。

    使用观测量图形混合模式，我们可以设置一个观测量散点图：

(defproto obs-scatterplot-proto ()
    ()
    (list observation-plot-mixin
          scatterplot-proto))

它的简单的构造函数这样给出：

(defun plot-observations (obs vars)
    (let ((graph (send obs-scatterplot-proto :new vars)))
      (send graph :new-menu)
      (send graph :add-observations obs)
      (send graph :adjust-to-data)
      graph))

图形的其它类型可以以同样的方式构造。

    为了表示新的连接系统，我们可以再次回到烟道损失数据上，就像在6.8.2节说的，针对该数据的观测量原型可以这样给出：

(defproto stack-obs '(air temp conc loss) () observation-proto)

这四个变量槽的读取方法可以这样定义：

(defmeth stack-obs :air (slot-value 'air))
(defmeth stack-obs :temp (slot-value 'temp))
(defmeth stack-obs :conc (slot-value 'conc))
(defmeth stack-obs :loss (slot-value 'loss))

派生变量，比如对数损耗变量，可以定义为：

(defmeth stack-obs :log-loss () (log (send self :loss)))

下边的表达式设置了一个观测量对象的列表：

(flet ((make-obs (air temp conc loss index)
                   (let ((label (format nil "~d" index)))
                     (send stack-obs :new
                           :air air
                           :temp temp
                           :conc conc
                           :loss loss
                           :label label))))
    (setf stack-list (mapcar #'make-obs
                             air temp conc loss (iseq 0 20))))

下边的两个表达式将产生观测量的两个图形，一个图形显示所有的观测量，另一个图形只显示其中的一个子集：

(plot-observations stack-list '(:air :log-loss))

(plot-observations (select stack-list (iseq 10 20))
                     '(:temp :conc))

因为这些数据点由他们的观测量对象标识而不是由它们的索引标识，所有这个不会引起问题。

练习 10.18
略。

《Lisp-Stat：一种统计计算和动态制图的面向对象环境》系列正文部分翻译完毕。

转载于:https://my.oschina.net/u/1011760/blog/390843