问题 运行基于SICP模式匹配规则的替代码


我在网上找到了本课的代码(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))

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

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

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

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

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

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

它返回的具体错误是:mcdr:expect类型为mutable-pair的参数;给定#f

当使用neil / sicp时,我在该行的评估过程中打破了:

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

它返回的具体错误是:模块中的未绑定标识符:user-initial-environment

所以,尽管如此,我还是会感谢一些帮助,或者是正确方向的推动。谢谢!


7498
2017-08-07 00:54


起源



答案:


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

例:

  (if '() 1 2)

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

因此,诸如assq之类的过程可以返回'()而不是false。 这就是您需要将extend-directory的定义更改为:

(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即可。

您在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年的麻省理工学院计划?)的另一个变化。

附录:

这段代码 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)

并且在extend-directory中将(null?v)更改为(不是v)。 这至少适用于简单的表达式。


14
2017-08-07 22:44



谢谢你的回复!我正在使用neil / sicp,但觉得从两者中提供不同的错误是有益的。我按照建议进行了调整,这导致我出现了一些“错误”的错误,我尝试将其更改为#f's,这导致了另一个可变付费的错误。 - 在一天结束时,我想我只是想学习代码,但我找不到有效的代码。您知道可以找到此视频课程中的任何工作代码吗?根据您的建议,我一定会继续尝试一次完成一个功能,但这对于我目前的lisp专业知识来说是非常令人兴奋的代码。 - Benjamin Powers
我添加了一个链接到Brandeis使用的更新版本。 - soegaard
是!我真的很欣赏这一点。非常感谢你。 - Benjamin Powers


答案:


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

例:

  (if '() 1 2)

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

因此,诸如assq之类的过程可以返回'()而不是false。 这就是您需要将extend-directory的定义更改为:

(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即可。

您在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年的麻省理工学院计划?)的另一个变化。

附录:

这段代码 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)

并且在extend-directory中将(null?v)更改为(不是v)。 这至少适用于简单的表达式。


14
2017-08-07 22:44



谢谢你的回复!我正在使用neil / sicp,但觉得从两者中提供不同的错误是有益的。我按照建议进行了调整,这导致我出现了一些“错误”的错误,我尝试将其更改为#f's,这导致了另一个可变付费的错误。 - 在一天结束时,我想我只是想学习代码,但我找不到有效的代码。您知道可以找到此视频课程中的任何工作代码吗?根据您的建议,我一定会继续尝试一次完成一个功能,但这对于我目前的lisp专业知识来说是非常令人兴奋的代码。 - Benjamin Powers
我添加了一个链接到Brandeis使用的更新版本。 - soegaard
是!我真的很欣赏这一点。非常感谢你。 - Benjamin Powers


这里 是使用mit-scheme(版本9.1.1)的代码。


1
2017-07-01 19:01





你也可以使用 这段代码。它在Racket上运行。

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

(define ns (make-base-namespace))
(apply (eval '+ ns) '(1 2 3))

1
2017-07-11 19:43