variable not acceptable

Discussion of Scheme and Racket

variable not acceptable

Postby nakias » Mon Jan 05, 2009 5:58 pm

Hello,

I'm trying to run this code but unfortunately i receive an error.
When i enter (make-product 'x 2)
instead of returning back 2 * x returns that x is not acceptable :S

What can i do for that?

Thanks in advance for any help !

Code: Select all

(define order 'infix)

(define (deriv exp var)
  (cond ((constant? exp) 0)
        ((variable? exp)
         (if (same-variable? exp var) 1 0))
        ((sum? exp)
         (make-sum (deriv (firstop exp) var)
                   (deriv (secondop exp) var)))
        ((difference? exp)
         (make-difference (deriv (firstop exp) var)
                          (deriv (secondop exp) var)))
        ((product? exp)
         (make-sum
          (make-product (firstop exp)
                        (deriv (secondop exp) var))
          (make-product (deriv (firstop exp) var)
                        (secondop exp))))
        ((quotient? exp)
         (make-quotient (make-difference
                         (make-product (secondop exp)
                                       (deriv (firstop exp) var))
                         (make-product (firstop exp)
                                       (deriv (secondop exp) var)))
                        (make-exponentiation (secondop exp) 2)))
        ((exponentiation? exp)
         (if (equal? 0 (deriv (secondop exp) var))
             (make-product
              (deriv (firstop exp) var)
              (make-product (secondop exp)
                            (make-exponentiation
                             (firstop exp)
                             (make-difference (secondop exp) 1))))
             (make-product exp
                           (make-sum
                            (make-product (deriv (secondop exp) var)
                                          (make-logarithm 'e (firstop exp)))
                            (make-product (deriv (firstop exp) var)
                                          (make-quotient (secondop exp)
                                                         (firstop exp)))))))
        ((function? exp)
         (case (ffunc exp)
           ('sin (make-product (deriv (fop exp) var)
                               (make-function 'cos (fop exp))))
           ('cos (make-product (make-product -1 (deriv (fop exp) var))
                               (make-function 'sin (fop exp))))
           ('sqrt (make-quotient (make-product 0.5 (deriv (fop exp) var))
                                 (make-function 'sqrt (fop exp))))
           ('arctan (make-quotient
                     (deriv (fop exp) var)
                     (make-sum 1 (make-exponentiation (fop exp) 2))))))
        ((logarithm? exp)
         (make-product
          (deriv (secondop exp) var)
          (make-quotient (make-logarithm (firstop exp) 'e) 'x)))
        (else #f)))

(define (constant? x) (number? x))

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

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

(define (make-sum a1 a2)
  (let ((worstcase (make-worstcase a1 '+ a2)))
    (cond ((and (number? a1) (number? a2)) (+ a1 a2))
          ((equal? a1 a2) (make-product 2 a1))
          ((number? a1) (cond ((= a1 0) a2)
                              ((sum? a2)
                               (cond ((number? (firstop a2))
                                      (make-sum
                                       (+ a1 (firstop a2)) (secondop a2)))
                                     ((number? (secondop a2))
                                      (make-sum
                                       (+ a1 (secondop a2)) (firstop a2)))
                                     (else worstcase)))
                              ((difference? a2)
                               (cond ((number? (firstop a2))
                                      (make-difference
                                       (+ a1 (firstop a2)) (secondop a2)))
                                     ((number? (secondop a2))
                                      (make-sum
                                       (- a1 (secondop a2)) (firstop a2)))
                                     (else worstcase)))
                              (else worstcase)))
          ((number? a2) (cond ((= a2 0) a1)
                              ((sum? a1)
                               (cond ((number? (firstop a1))
                                      (make-sum
                                       (+ a2 (firstop a1)) (secondop a1)))
                                     ((number? (secondop a1))
                                      (make-sum
                                       (+ a2 (secondop a1)) (firstop a1)))
                                     (else worstcase)))
                              ((difference? a1)
                               (cond ((number? (firstop a1))
                                      (make-difference
                                       (+ a2 (firstop a1)) (secondop a1)))
                                     ((number? (secondop a1))
                                      (make-difference
                                       (firstop a1) (- (secondop a1) a2)))
                                     (else worstcase)))
                              (else worstcase)))
          (else worstcase))))

(define (make-difference a1 a2)
  (let ((worstcase (make-worstcase a1 '- a2)))
    (cond ((and (number? a1) (number? a2)) (- a1 a2))
          ((equal? a1 a2) 0)
          ((number? a1) (cond ((= a1 0) (make-product -1 a2))
                              ((sum? a2)
                               (cond ((number? (firstop a2))
                                      (make-difference
                                       (- a1 (firstop a2)) (secondop a2)))
                                     ((number? (secondop a2))
                                      (make-difference
                                       (- a1 (secondop a2)) (firstop a2)))
                                     (else worstcase)))
                              ((difference? a2)
                               (cond ((number? (firstop a2))
                                      (make-sum
                                       (- a1 (firstop a2)) (secondop a2)))
                                     ((number? (secondop a2))
                                      (make-difference
                                       (+ a1 (secondop a2)) (firstop a2)))
                                     (else worstcase)))
                              (else worstcase)))
          ((number? a2) (cond ((= a2 0) a1)
                              ((sum? a1)
                               (cond ((number? (firstop a1))
                                      (make-sum
                                       (- (firstop a1) a2) (secondop a1)))
                                     ((number? (secondop a1))
                                      (make-sum
                                       (- (secondop a1) a2) (firstop a1)))
                                     (else worstcase)))
                              ((difference? a1)
                               (cond ((number? (firstop a1))
                                      (make-difference
                                       (- (firstop a1) a2) (secondop a1)))
                                     ((number? (secondop a1))
                                      (make-difference
                                       (firstop a1) (+ (secondop a1) a2)))
                                     (else worstcase)))
                              (else worstcase)))
          (else worstcase))))

(define (make-product m1 m2)
  (let ((worstcase (make-worstcase m1 '* m2)))
    (cond ((and (number? m1) (number? m2)) (* m1 m2))
          ((number? m1) (cond ((= m1 0) 0)
                              ((= m1 1) m2)
                              ((product? m2)
                               (cond ((number? (firstop m2))
                                      (make-product
                                       (* m1 (firstop m2)) (secondop m2)))
                                     ((number? (secondop m2))
                                      (make-product
                                       (* m1 (secondop m2)) (firstop m2)))
                                     (else worstcase)))
                              ((quotient? m2)
                               (cond ((number? (firstop m2))
                                      (make-quotient
                                       (* m1 (firstop m2)) (secondop m2)))
                                     ((number? (secondop m2))
                                      (make-product
                                       (/ m1 (secondop m2)) (firstop m2)))
                                     (else worstcase)))
                              (else worstcase)))
          ((number? m2) (cond ((= m2 0) 0)
                              ((= m2 1) m1)
                              ((product? m1)
                               (cond ((number? (firstop m1))
                                      (make-product
                                       (* m2 (firstop m1)) (secondop m1)))
                                     ((number? (secondop m1))
                                      (make-product
                                       (* m2 (secondop m1)) (firstop m1)))
                                     (else worstcase)))
                              ((quotient? m1)
                               (cond ((number? (firstop m1))
                                      (make-quotient
                                       (* m2 (firstop m1)) (secondop m1)))
                                     ((number? (secondop m1))
                                      (make-product
                                       (/ m2 (secondop m1)) (firstop m1)))
                                     (else worstcase)))
                              (else worstcase)))
          ((and (quotient? m1) (equal? (firstop m1) 1))
           (make-quotient m2 (secondop m1)))
          ((and (quotient? m2) (equal? (firstop m2) 1))
           (make-quotient m1 (secondop m2)))
          (else worstcase))))

(define (make-quotient m1 m2)
  (let ((worstcase (make-worstcase m1 '/ m2)))
    (cond ((and (number? m1) (number? m2)) (/ m1 m2))
          ((equal? m1 m2) 1)
          ((number? m1) (cond ((= m1 0) 0)
                              ((product? m2)
                               (cond ((number? (firstop m2))
                                      (make-quotient
                                       (/ m1 (firstop m2)) (secondop m2)))
                                     ((number? (secondop m2))
                                      (make-quotient
                                       (/ m1 (secondop m2)) (firstop m2)))
                                     (else worstcase)))
                              ((quotient? m2)
                               (cond ((number? (firstop m2))
                                      (make-product
                                       (/ m1 (firstop m2)) (secondop m2)))
                                     ((number? (secondop m2))
                                      (make-quotient
                                       (* m1 (secondop m2)) (firstop m2)))
                                     (else worstcase)))
                              (else worstcase)))
          ((number? m2) (cond ((= m2 1) m1)
                              ((product? m1)
                               (cond ((number? (firstop m1))
                                      (make-product
                                       (/ (firstop m1) m2) (secondop m1)))
                                     ((number? (secondop m1))
                                      (make-product
                                       (/ (secondop m1) m2) (firstop m1)))
                                     (else worstcase)))
                              ((quotient? m1)
                               (cond ((number? (firstop m1))
                                      (make-quotient
                                       (/ (firstop m1) m2) (secondop m1)))
                                     ((number? (secondop m1))
                                      (make-quotient
                                       (firstop m1) (* m2 (secondop m1))))
                                     (else worstcase)))
                              (else worstcase)))
          (else worstcase))))

(define (make-exponentiation b e)
  (let ((worstcase (make-worstcase b '** e)))
    (cond ((and (number? b) (number? e) (expt b e)))
          ((and (exponentiation? b) (number? (secondop b)) (number? e))
           (list (firstop b) '** (* (secondop b) e)))
          ((and (function? b) (eq? (ffunc b) 'sqrt) (= e 2)) (fop b))
          ((number? b) (if (or (= b 0) (= b 1)) 1 worstcase))
          ((number? e) (cond ((= e 0) 1)
                             ((= e 1) b)
                             (else worstcase)))
          (else worstcase))))

(define (make-logarithm b arg)
  (let ((worstcase (make-worstcase b 'log arg)))
    (cond ((and (number? b) (number? arg)) (/ (log arg) (log b)))
          ((equal? arg 1) 0)
          ((equal? b arg) 1)
          (else worstcase))))

(define (make-worstcase one two three)
  (cond ((equal? order 'prefix) (list two one three))
        ((equal? order 'infix) (list one two three))
        ((equal? order 'postfix) (list one three two))
        (else (error "Unknown ordering."))))

(define (firstop x)
  (cond ((equal? order 'prefix) (cadr x))
        ((equal? order 'infix) (car x))
        ((equal? order 'postfix) (car x))
        (else (error "Unknown ordering."))))

(define (secondop x)
  (cond ((equal? order 'prefix) (caddr x))
        ((equal? order 'infix) (caddr x))
        ((equal? order 'postfix) (cadr x))
        (else (error "Unknown ordering."))))

(define (func x)
  (cond ((equal? order 'prefix) (car x))
        ((equal? order 'infix) (cadr x))
        ((equal? order 'postfix) (caddr x))
        (else (error "Unknown ordering."))))

(define (sum? x)
  (if (not (atom? x)) (eq? (func x) '+) #f))

(define (difference? x)
  (if (not (atom? x)) (eq? (func x) '-) #f))

(define (product? x)
  (if (not (atom? x)) (eq? (func x) '*) #f))

(define (quotient? x)
  (if (not (atom? x)) (eq? (func x) '/) #f))

(define (exponentiation? x)
  (if (not (atom? x)) (eq? (func x) '**) #f))

(define (logarithm? x)
  (if (not (atom? x)) (eq? (func x) 'log) #f))

(define (ffunc x) (car x))

(define (fop x) (cadr x))

(define arctan atan)

(define (function? x)
  (if (not (atom? x))
      (case (ffunc x)
        ((sin cos sqrt arctan) #t)
        (else #f))))

(define (make-function f arg)
  (if (constant? arg)
      ((eval f) arg)
      (list f arg)))

(define (derive-x n f)
  (if (= n 0)
      f
      (derive-x (- n 1) (deriv f 'x))))

(define (derivations-x function start end)
  (do ((n start (+ n 1)))
      ((> n end) 'done)
      (display n)
      (display " ")
      (display (derive-x n function))
      (newline)))





nakias
 
Posts: 3
Joined: Tue Dec 23, 2008 5:17 am

Re: variable not acceptable

Postby Ali Clark » Sun Jan 25, 2009 7:07 pm

I ran your code in gambit and got the following error:

> (make-product 'x 2)
*** ERROR IN product?, UNKNOWN@288.13 -- Unbound variable: atom?

That's easy enough:

> (define (atom? x) (not (list? x)))

> (make-product 'x 2)
(x * 2)

Does that fix it? I'm surprised if your interpreter didn't mention atom? being undefined... you could consider having a second interpreter just to see which gave better debug info for errors.
Ali Clark
 
Posts: 15
Joined: Mon Aug 25, 2008 10:23 am


Return to Scheme

Who is online

Users browsing this forum: No registered users and 3 guests

cron