(define <_e <)

(define dual-number?
 (let ((pair? pair?))
  (lambda (p) (and (pair? p) (eq? (car p) 'dual-number)))))

(define (dual-number e x x-prime)
 (if (zero? x-prime) x (list 'dual-number e x x-prime)))

(define epsilon cadr)

(define (primal e p)
 (if (or (not (dual-number? p)) (<_e (epsilon p) e)) p (caddr p)))

(define (perturbation e p)
 (if (or (not (dual-number? p)) (<_e (epsilon p) e)) 0 (cadddr p)))

(define (lift-real->real f df/dx)
 (letrec ((self (lambda (p)
		 (if (dual-number? p)
		     (let ((e (epsilon p)))
		      (dual-number
		       e
		       (self (primal e p))
		       (* (df/dx (primal e p)) (perturbation e p))))
		     (f p)))))
  self))

(define (lift-real*real->real f df/dx1 df/dx2)
 (letrec ((self
	   (lambda (p1 p2)
	    (if (or (dual-number? p1)
		    (dual-number? p2))
		(let ((e (if (or (not (dual-number? p1))
				 (and (dual-number? p2)
				      (<_e (epsilon p1) (epsilon p2))))
			     (epsilon p2)
			     (epsilon p1))))
		 (dual-number
		  e
		  (self (primal e p1) (primal e p2))
		  (+ (* (df/dx1 (primal e p1) (primal e p2))
			(perturbation e p1))
		     (* (df/dx2 (primal e p1) (primal e p2))
			(perturbation e p2)))))
		(f p1 p2)))))
  self))

(define (primal* p)
 (if (dual-number? p) (primal* (primal (epsilon p) p)) p))

(define (lift-real^n->boolean f) (lambda ps (apply f (map primal* ps))))

(define pair?
 (let ((pair? pair?))
  (lambda (x) (and (pair? x) (not (dual-number? x))))))

(define + (lift-real*real->real + (lambda (x1 x2) 1) (lambda (x1 x2) 1)))

(define - (lift-real*real->real - (lambda (x1 x2) 1) (lambda (x1 x2) -1)))

(define *
 (lift-real*real->real * (lambda (x1 x2) x2) (lambda (x1 x2) x1)))

(define /
 (lift-real*real->real
  / (lambda (x1 x2) (/ 1 x2)) (lambda (x1 x2) (- 0 (/ x1 (* x2 x2))))))

(define sqrt (lift-real->real sqrt (lambda (x) (/ 1 (* 2 (sqrt x))))))

(define exp (lift-real->real exp (lambda (x) (exp x))))

(define log (lift-real->real log (lambda (x) (/ 1 x))))

(define sin (lift-real->real sin (lambda (x) (cos x))))

(define cos (lift-real->real cos (lambda (x) (- 0 (sin x)))))

(define atan (lift-real*real->real
              atan
              (lambda (x1 x2) (/ (- 0 x2) (+ (* x1 x1) (* x2 x2))))
              (lambda (x1 x2) (/ x1 (+ (* x1 x1) (* x2 x2))))))

(define = (lift-real^n->boolean =))

(define < (lift-real^n->boolean <))

(define > (lift-real^n->boolean >))

(define <= (lift-real^n->boolean <=))

(define >= (lift-real^n->boolean >=))

(define zero? (lift-real^n->boolean zero?))

(define positive? (lift-real^n->boolean positive?))

(define negative? (lift-real^n->boolean negative?))

(define real? (lift-real^n->boolean real?))

(define derivative
 (let ((e 0))
  (lambda (f)
   (lambda (x)
    (fluid-let ((e (+ e 1)))
     (perturbation e (f (dual-number e x 1))))))))