运行基于SICP模式匹配规则的替代代码 [英] Running SICP Pattern Matching Rule Based Substitution Code

查看:124
本文介绍了运行基于SICP模式匹配规则的替代代码的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!

问题描述

我已经在线上从本课中找到了代码(http://groups.csail.mit.edu/mac/ftpdir/6.001-fall91/ps4/matcher-from-lecture.scm),我感到很头疼尝试调试它的时间.该代码看起来与Sussman编写的代码相当:

I have found the code from this lesson online (http://groups.csail.mit.edu/mac/ftpdir/6.001-fall91/ps4/matcher-from-lecture.scm), and I am having a heck of a time trying to debug it. The code looks pretty comparable to what Sussman has written:

;;; 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中运行它,而我遇到的第一个问题是那个原子?是未定义的标识符.因此,我发现可以添加以下内容:

I'm running it in DrRacket with the R5RS, and the first problem I ran into was that atom? was an undefined identifier. So, I found that I could add the following:

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

然后我试图弄清楚该野兽的实际运行方式,所以我再次观看了视频,看到他使用了以下内容:

I then tried to figure out how to actually run this beast, so I watched the video again and saw him use the following:

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

正如Sussman所说,我应该回来(+1 0).相反,使用R5RS似乎在以下方面打破了扩展词典的程序:

As stated by Sussman, I should get back (+ 1 0). Instead, using R5RS I seem to be breaking in the extend-dictionary procedure at the line:

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

它返回的特定错误是:mcdr:期望参数类型为mutable-pair;给定#f

The specific error it's returning is: mcdr: expects argument of type mutable-pair; given #f

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

When using neil/sicp I'm breaking in the evaluate procedure at the line:

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

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

The specific error it's returning is: unbound identifier in module in: user-initial-environment

因此,尽管如此,我还是会有所帮助,或者在正确的方向上有所帮助.谢谢!

So, with all of that being said, I'd appreciate some help, or the a good nudge in the right direction. Thanks!

推荐答案

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

Your code is from 1991. Since R5RS came out in 1998, the code must be written for R4RS (or older). One of the differences between R4RS and later Schemes is that the empty list was interpreted as false in the R4RS and as true in R5RS.

示例:

  (if '() 1 2)

在R5RS中给出1,而在R4RS中给出2.

gives 1 in R5RS but 2 in R4RS.

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

Procedures such as assq could therefore return '() instead of false. This is why you need to change the definition of extend-directory to:

(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替换为地图.

Also back in those days map was called mapcar. Simply replace mapcar with map.

您在DrRacket中看到的错误是:

The error you saw in DrRacket was:

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

这表示cdr有一个空列表.由于有一个空列表 没有cdr,这会给出错误消息.现在DrRacket写mcdr 而不是cdr,但暂时不要理会.

This means that cdr got an empty list. Since an empty list has no cdr this gives an error message. Now DrRacket writes mcdr instead of cdr, but ignore that for now.

最佳建议:一次浏览一个功能并使用 REPL中的一些表达式.这比计算容易 一切都立刻消失.

Best advice: Go through one function at a time and test it with a few expressions in the REPL. This is easier than figuring everything out at once.

最后,您的程序开始于:

Finally begin your program with:

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

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

Another change from R4RS (or MIT Scheme in 1991?).

附录:

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

This code http://pages.cs.brandeis.edu/~mairson/Courses/cs21b/sym-diff.scm almost runs. Prefix it in DrRacket with:

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

然后在扩展目录中将(null?v)更改为(not v). 至少对于简单的表达式有效.

And in extend-directory change the (null? v) to (not v). That at least works for simple expressions.

这篇关于运行基于SICP模式匹配规则的替代代码的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!

查看全文
登录 关闭
扫码关注1秒登录
发送“验证码”获取 | 15天全站免登陆