PasteRack.org
Paste # 4691
2017-08-13 16:12:19

Fork as a new paste.

Paste viewed 119 times.


Embed:

#lang racket

#lang racket

(define (variable? x) (symbol? x))

(define (same-variable? v1 v2)
  (and (variable? v1) (variable? v2) (eq? v1 v2)))

(define (=number? exp num)
  (and (number? exp) (= exp num)))

;(define (make-product m1 m2) (list '* m1 m2))

(define (make-product m1 m2)
  (cond ((or (=number? m1 0) (=number? m2 0)) 0)
        ((=number? m1 1) m2)
        ((=number? m2 1) m1)
        ((and (number? m1) (number? m2)) (* m1 m2))
        (else (list '* m1 m2))))

(define (sum? x)
  (and (pair? x) (eq? (car x) '+)))

(define (addend s) (cadr s))

(define (augend s) (caddr s))

(define (product? x)
  (and (pair? x) (eq? (car x) '*)))

 (define (multiplier p) (cadr p))

(define (multiplicand p) (caddr p))
  
;(define (make-sum a1 a2) (list '+ a1 a2))

(define (make-sum a1 a2)
  (cond ((=number? a1 0) a2)
        ((=number? a2 0) a1)
        ((and (number? a1) (number? a2)) (+ a1 a2))
        (else (list '+ a1 a2))))

(define (simplify exp)
  (cond
    [(product? exp) (make-simp-prod exp)]
    [(sum? exp) (make-simp-add exp)]
    [else exp]))

(define (make-simp-add exp)
  (define l (simplify (addend exp)))
  (define r (simplify (augend exp)))
  (cond
    ((equal? l 0) r)
    ((equal? 0 r) l)
    ((and (number? l) (number? r)) (+ l r))
    (else (make-sum l r))))

(define (make-simp-prod exp)
  (define l (simplify (multiplier exp)))
  (define r (simplify (multiplicand exp)))
  (cond
    ((or (equal? 0 l) (equal? 0 r)) 0)
    ((equal? l 1) r)
    ((equal? 1 r) l)
    ((and (number? l) (number? r)) (* l r))
    (else (make-prod l r))))


=>

prog:3:0: read: #lang not enabled in the current context
  context...:
   /home/pasterack/racket68/collects/syntax/module-reader.rkt:186:17: body
   /home/pasterack/racket68/collects/syntax/module-reader.rkt:183:2: wrap-internal
   /home/pasterack/racket68/collects/racket/../syntax/module-reader.rkt:65:9: lang:read-syntax
   /home/pasterack/racket68/share/pkgs/scribble-lib/scribble/private/manual-code.rkt:112:0: get-tokens
   /home/pasterack/racket68/share/pkgs/scribble-lib/scribble/private/manual-code.rkt:56:0: typeset-code15
   /home/pasterack/pasterack/tmp/4691/4691code.scrbl: [running body]
   loop
   ...cket/cmdline.rkt:179:51
   /home/pasterack/racket68/share/pkgs/scribble-lib/scribble/run.rkt: [running body]