算術式をフラット化するためのSchemeプロシージャを書くには？たとえば

Question

：

(* (* (* 1 2) 3) (* 4 5)) = (* 1 (* 2 (* 3 (* 4 5)))) 

私は今、時間のカップルのためにこの手順を記述する方法を把握しようとして座ってきたが、私はそれが仕事を得るように見えることはできません。

たプログラムが（ただし、それは、期待どおりに動作しません）です：

(define interpret-arithmetic-expression_Magritte_bizarre 
    (lambda (e) 
    (cond 
     [(is-literal? e) 
     (make-literal (literal-1 e))] 
     [(is-plus? e) 
     (if (is-plus? (plus-1 e)) 
      (make-plus (interpret-arithmetic-expression_Magritte_bizarre (plus-1 (plus-1 e))) 
         (make-plus (interpret-arithmetic-expression_Magritte_bizarre (plus-2 (plus-1 e))) 
           (interpret-arithmetic-expression_Magritte_bizarre (plus-2 e)))) 
      (make-plus (interpret-arithmetic-expression_Magritte_bizarre (plus-1 e)) 
         (interpret-arithmetic-expression_Magritte_bizarre (plus-2 e))))] 
     [(is-times? e) 
     (if (is-times? (times-1 e)) 
      (make-times (interpret-arithmetic-expression_Magritte_bizarre (times-1 (times-1 e))) 
         (make-times (interpret-arithmetic-expression_Magritte_bizarre (times-2 (times-1 e))) 
            (interpret-arithmetic-expression_Magritte_bizarre (times-2 e)))) 
      (make-times (interpret-arithmetic-expression_Magritte_bizarre (times-1 e)) 
         (interpret-arithmetic-expression_Magritte_bizarre (times-2 e))))] 
     [else 
     (errorf 'interpret-arithmetic-expression_Magritte 
       "unrecognized expression: ~s" 
       e)]))) 

Answer 1

これは完全な答えではありません：それはあなたが実際に答えを望むもの、完全に明確ではありません

• 〜。
• 私は歴史的にはCLプログラマーです - 私は移植可能なSchemeが何であるかも分かりません！）これは移植されていないというスキルはありませんRacketです。

ただし、以下のコードは、様々な種類の表情を平らにします：もあり

> (flatten-expression '(- 1 (+ 2 4) 5)) 
'(- 1 (+ 2 4) 5) 
> (flatten-expression (presimplify-expression '(- 1 (+ 2 4) 5))) 
'(- 1 (+ 2 4 5)) 

：

> (flatten-expression '(+ (+ (* 2 a (* 1 b)) 1 3 (+ 3)))) 
'(+ (* 2 a 1 b) 1 3 3) 

あなたがpresimplifierを使用している場合、それはまたそれをはるかに良い仕事を行います初心者の評価者。

#lang racket 

;;;; Flattening expressions 
;;; 
;;; Expressions are either (op ...), numbers or symbols. Operators are 
;;; symbols. 
;;; 
;;; These tests only look at the top-level of a compound expression 
;;; 
;;; There is a lot more that could be done than this of course: 
;;; partially-evaluating things, for instance. 
;;; 

(define (compound-expression? e) 
    (and (list? e) 
     (symbol? (first e)))) 

(define (atomic-expression? e) 
    (or (number? e) 
     (symbol? e))) 

(define (valid-expression? e) 
    (or (atomic-expression? e) 
     (compound-expression? e))) 

;;; Pulling apart and assembling compound expressions 
;;; 

(define (ce-op e) 
    (first e)) 

(define (ce-args e) 
    (rest e)) 

(define (make-ce op args) 
    (cons op args)) 

;;; A full checker 
;;; 

(define (valid-expression*? e) 
    (cond 
    [(atomic-expression? e) 
    #t] 
    [(compound-expression? e) 
    (andmap valid-expression*? (ce-args e))] 
    [else #f])) 


;;; Flattening. 
;;; This is overcomplicated: really it could just know what operators can 
;;; be flattened. 
;;; 

(define flattenable-operators '(* +)) 

(define (flatten-expression e (fops flattenable-operators)) 
    (define (flatten-fop op argtail accum agenda) 
    (if (null? argtail) 
     (if (null? agenda) 
      (make-ce op (reverse accum)) 
      (flatten-fop op (first agenda) accum (rest agenda))) 
     (let ([arg (first argtail)] 
       [tail (rest argtail)]) 
      (cond 
      [(atomic-expression? arg) 
      (flatten-fop op tail (cons arg accum) agenda)] 
      [(compound-expression? arg) 
      (if (eqv? (ce-op arg) op) 
       (flatten-fop op (ce-args arg) accum (cons tail agenda)) 
       (flatten-fop op tail 
           (cons (flatten-expression arg fops) 
            accum) 
           agenda))] 
      [else (error "not an expression:" arg)])))) 
    (cond 
    [(atomic-expression? e) 
    e] 
    [(compound-expression? e) 
    (let ([op (ce-op e)] 
      [args (ce-args e)]) 
     (if (memv op fops) 
      (flatten-fop op args '() '()) 
      (make-ce op (map (λ (a) (flatten-expression a fops)) args))))] 
    [else (error "not an expression:" e)])) 

;;; A simplifier to make the flattener's life more productive 
;;; 

(define (presimplify-expression e) 
    ;; This has built-in knowledge of some arithmetic operators, 
    ;; and uses the usual Lisp/Scheme semantics for/and -: (/ a b c) is 
    ;; (/ a (* b c)) & so on. 
    (cond 
    [(atomic-expression? e) 
    e] 
    [(compound-expression? e) 
    (let ([op (ce-op e)] 
      [args (ce-args e)]) 
     (case (length args) 
     [(0) 
      (case op 
      [(+ *) 0] 
      [(/ -) (error "no args for" op)] 
      [else e])] 
     [(1) 
      (case op 
      [(+ * /) (presimplify-expression (first args))] 
      [else (make-ce op (map presimplify-expression args))])] 
     [else 
      (case op 
      [(-) (make-ce op 
          (list (presimplify-expression (first args)) 
           (make-ce '+ (map presimplify-expression 
               (rest args)))))] 
      [(/) (make-ce op 
          (list (presimplify-expression (first args)) 
           (make-ce '* (map presimplify-expression 
               (rest args)))))] 
      [else (make-ce op (map presimplify-expression args))])]))] 
    [else 
    (error "not an expression:" e)])) 

(define (simplify-expression e (fops flattenable-operators)) 
    (flatten-expression (presimplify-expression e) fops)) 

;;; An evaluator 
;;; 

(define builtin-bindings 
    `((+ . ,+) 
    (- . ,-) 
    (* . ,*) 
    (/ . ,/))) 

(define (evaluate-expression e (bindings '())) 
    (for ([b bindings]) 
    (unless (and (cons? b) (symbol? (car b))) 
     (error "bad binding form" b)) 
    (when (assv (car b) builtin-bindings) 
     (error "trying to rebind a builtin " (car b)))) 
    (define (symbol-binding s) 
    (let ([binding (or (assv s builtin-bindings) 
         (assv s bindings))]) 
     (unless binding 
     (error "unbound variable" s)) 
     (cdr binding))) 
    (define (eval-exp e) 
    (cond 
     [(atomic-expression? e) 
     (cond 
     [(number? e) e] 
     [(symbol? e) (symbol-binding e)] 
     [else (error "mutant horror" e)])] 
     [(compound-expression? e) 
     (let ([op (ce-op e)] 
      [args (ce-args e)]) 
     (apply (symbol-binding op) 
       (map eval-exp args)))])) 
    (eval-exp e))