13

我在网上找到了本课的代码(http://groups.csail.mit.edu/mac/ftpdir/6.001-fall91/ps4/matcher-from-lecture.scm),我玩得很开心试图调试它。该代码看起来与 Sussman 所写的非常相似:

;;; Scheme code from the Pattern Matcher lecture

;; Pattern Matching and Simplification

(define (match pattern expression dictionary)
  (cond ((eq? dictionary 'failed) 'failed)
        ((atom? pattern)
         (if (atom? expression)
             (if (eq? pattern expression)
                 dictionary
                 'failed)
             'failed))
        ((arbitrary-constant? pattern)
         (if (constant? expression)
             (extend-dictionary pattern expression dictionary)
             'failed))
        ((arbitrary-variable? pattern)
         (if (variable? expression)
             (extend-dictionary pattern expression dictionary)
             'failed))
        ((arbitrary-expression? pattern)
         (extend-dictionary pattern expression dictionary))
        ((atom? expression) 'failed)
        (else
         (match (cdr pattern)
                (cdr expression)
                (match (car pattern)
                       (car expression)
                       dictionary)))))

(define (instantiate skeleton dictionary)
  (cond ((atom? skeleton) skeleton)
        ((skeleton-evaluation? skeleton)
         (evaluate (evaluation-expression skeleton)
                   dictionary))
        (else (cons (instantiate (car skeleton) dictionary)
                    (instantiate (cdr skeleton) dictionary)))))

(define (simplifier the-rules)
  (define (simplify-exp exp)
    (try-rules (if (compound? exp)
                   (simplify-parts exp)
                   exp)))
  (define (simplify-parts exp)
    (if (null? exp)
        '()
        (cons (simplify-exp   (car exp))
              (simplify-parts (cdr exp)))))
  (define (try-rules exp)
    (define (scan rules)
      (if (null? rules)
          exp
          (let ((dictionary (match (pattern (car rules))
                                   exp
                                   (make-empty-dictionary))))
            (if (eq? dictionary 'failed)
                (scan (cdr rules))
                (simplify-exp (instantiate (skeleton (car rules))
                                           dictionary))))))
    (scan the-rules))
  simplify-exp)

;; Dictionaries 

(define (make-empty-dictionary) '())

(define (extend-dictionary pat dat dictionary)
  (let ((vname (variable-name pat)))
    (let ((v (assq vname dictionary)))
      (cond ((null? v)
             (cons (list vname dat) dictionary))
            ((eq? (cadr v) dat) dictionary)
            (else 'failed)))))

(define (lookup var dictionary)
  (let ((v (assq var dictionary)))
    (if (null? v)
        var
        (cadr v))))

;; Expressions

(define (compound? exp) (pair?   exp))
(define (constant? exp) (number? exp))
(define (variable? exp) (atom?   exp))

;; Rules

(define (pattern  rule) (car  rule))
(define (skeleton rule) (cadr rule))

;; Patterns

(define (arbitrary-constant?    pattern)
  (if (pair? pattern) (eq? (car pattern) '?c) false))

(define (arbitrary-expression?  pattern)
  (if (pair? pattern) (eq? (car pattern) '? ) false))

(define (arbitrary-variable?    pattern)
  (if (pair? pattern) (eq? (car pattern) '?v) false))

(define (variable-name pattern) (cadr pattern))

;; Skeletons & Evaluations

(define (skeleton-evaluation?    skeleton)
  (if (pair? skeleton) (eq? (car skeleton) ':) false))

(define (evaluation-expression evaluation) (cadr evaluation))


;; Evaluate (dangerous magic)

(define (evaluate form dictionary)
  (if (atom? form)
      (lookup form dictionary)
      (apply (eval (lookup (car form) dictionary)
                   user-initial-environment)
             (mapcar (lambda (v) (lookup v dictionary))
                     (cdr form)))))

;;
;; A couple sample rule databases...
;;

;; Algebraic simplification

(define algebra-rules
  '(
    ( ((? op) (?c c1) (?c c2))                (: (op c1 c2))                )
    ( ((? op) (?  e ) (?c c ))                ((: op) (: c) (: e))          )
    ( (+ 0 (? e))                             (: e)                         )
    ( (* 1 (? e))                             (: e)                         )
    ( (* 0 (? e))                             0                             )
    ( (* (?c c1) (* (?c c2) (? e )))          (* (: (* c1 c2)) (: e))       )
    ( (* (?  e1) (* (?c c ) (? e2)))          (* (: c ) (* (: e1) (: e2)))  )
    ( (* (* (? e1) (? e2)) (? e3))            (* (: e1) (* (: e2) (: e3)))  )
    ( (+ (?c c1) (+ (?c c2) (? e )))          (+ (: (+ c1 c2)) (: e))       )
    ( (+ (?  e1) (+ (?c c ) (? e2)))          (+ (: c ) (+ (: e1) (: e2)))  )
    ( (+ (+ (? e1) (? e2)) (? e3))            (+ (: e1) (+ (: e2) (: e3)))  )
    ( (+ (* (?c c1) (? e)) (* (?c c2) (? e))) (* (: (+ c1 c2)) (: e))       )
    ( (* (? e1) (+ (? e2) (? e3)))            (+ (* (: e1) (: e2))
                                                 (* (: e1) (: e3)))         )
    ))

(define algsimp (simplifier algebra-rules))

;; Symbolic Differentiation

(define deriv-rules
  '(
    ( (dd (?c c) (? v))              0                                 )
    ( (dd (?v v) (? v))              1                                 )
    ( (dd (?v u) (? v))              0                                 )
    ( (dd (+ (? x1) (? x2)) (? v))   (+ (dd (: x1) (: v))
                                        (dd (: x2) (: v)))             )
    ( (dd (* (? x1) (? x2)) (? v))   (+ (* (: x1) (dd (: x2) (: v)))
                                        (* (dd (: x1) (: v)) (: x2)))  )
    ( (dd (** (? x) (?c n)) (? v))   (* (* (: n) (+ (: x) (: (- n 1))))
                                        (dd (: x) (: v)))              )
    ))

(define dsimp (simplifier deriv-rules))

(define scheme-rules
  '(( (square (?c n)) (: (* n n)) )
    ( (fact 0) 1 )
    ( (fact (?c n)) (* (: n) (fact (: (- n 1)))) )
    ( (fib 0) 0 )
    ( (fib 1) 1 )
    ( (fib (?c n)) (+ (fib (: (- n 1)))
                      (fib (: (- n 2)))) )
    ( ((? op) (?c e1) (?c e2)) (: (op e1 e2)) ) ))

(define scheme-evaluator (simplifier scheme-rules))

我正在使用 R5RS 在 DrRacket 中运行它,我遇到的第一个问题是那个原子?是一个未定义的标识符。所以,我发现我可以添加以下内容:

    (define (atom? x) ; atom? is not in a pair or null (empty)
    (and (not (pair? x))
    (not (null? x))))

然后我试图弄清楚如何实际运行这个野兽,所以我再次观看了视频并看到他使用以下内容:

(dsimp '(dd (+ x y) x))

正如苏斯曼所说,我应该回来(+ 1 0)。相反,使用 R5RS 我似乎打破了扩展字典的过程:

((eq? (cadr v) dat) dictionary) 

它返回的具体错误是: mcdr: expects argument of type mutable-pair; 给定#f

使用 neil/sicp 时,我在以下行中断了评估程序:

(apply (eval (lookup (car form) dictionary)
                   user-initial-environment)

它返回的具体错误是:模块中的未绑定标识符:用户初始环境

所以,说了这么多,我会很感激一些帮助,或者是朝着正确方向的一个很好的推动。谢谢!

4

3 回答 3

15

您的代码来自 1991 年。由于 R5RS 于 1998 年问世,因此必须为 R4RS(或更早版本)编写代码。R4RS 和后来的方案之间的区别之一是空列表在 R4RS 中被解释为假,而在 R5RS 中被解释为真。

例子:

  (if '() 1 2)

在 R5RS 中给出 1,但在 R4RS 中给出 2。

因此,诸如 assq 之类的过程可能会返回 '() 而不是 false。这就是为什么您需要将扩展​​目录的定义更改为:

(define (extend-dictionary pat dat dictionary)
  (let ((vname (variable-name pat)))
    (let ((v (assq vname dictionary)))
      (cond ((not v)
             (cons (list vname dat) dictionary))
            ((eq? (cadr v) dat) dictionary)
            (else 'failed)))))

那时地图也被称为mapcar。只需将 mapcar 替换为 map。

您在 DrRacket 中看到的错误是:

mcdr: expects argument of type <mutable-pair>; given '()

这意味着 cdr 得到了一个空列表。由于空列表没有 cdr,因此会显示错误消息。现在 DrRacket 写入 mcdr 而不是 cdr,但暂时忽略它。

最佳建议:一次通过一个函数,并在 REPL 中使用一些表达式对其进行测试。这比一次性弄清楚所有事情要容易。

最后开始你的程序:

(define user-initial-environment (scheme-report-environment 5))

R4RS(或 1991 年的 MIT 计划?)的另一个变化。

附录:

这段代码http://pages.cs.brandeis.edu/~mairson/Courses/cs21b/sym-diff.scm几乎可以运行。在 DrRacket 中添加前缀:

#lang r5rs
(define false #f)
(define user-initial-environment (scheme-report-environment 5))
(define mapcar map)

并在扩展目录中将 (null?v) 更改为 (not v)。这至少适用于简单的表达式。

于 2011-08-07T22:44:56.497 回答
1

是适用于 mit-scheme(版本 9.1.1)的代码。

于 2012-07-01T19:01:57.197 回答
1

您也可以使用此代码。它在球拍上运行。

为了不出错地运行“eval”,需要添加以下内容

(define ns (make-base-namespace))
(apply (eval '+ ns) '(1 2 3))
于 2012-07-11T19:43:03.453 回答