project1.scm

; default infinitesimal approximation
(define h 0.0001)

; helpers
(define (square x) (* x x))
(define (*4 x) (* x 4))

(define (close-enough? a b)
    (< (abs (- a b)) 0.001))

(define (foldr func acc xs)
    (if (null? xs)
        acc
        (func (car xs) (foldr func acc (cdr xs)))))

(define (foldl func acc xs)
    (if (null? xs)
        acc
        (foldl func (func acc (car xs)) (cdr xs))))

; Requires special form to be lazy
(define (thunk val) (lambda () val))

(define (stream f current end?)
    (if (end? current)
        '()
        (cons (f current) (thunk (stream f (f current) end?)))))

(define (next s) ((cdr s)))

(define (pour s)
    (if (null? s)
        '()
        (cons (car s) (pour (next s)))))

(define (stream-range a b inc)
    (stream (lambda (x) (+ x inc))
            a
            (lambda (x) (close-enough? x b))))

; Problem 1
(define (integral func num-steps x1 x2)
  (if (zero? num-steps)
        0
        (let ((delta-x (/ (- x2 x1) num-steps))
              (height (func x1)))
          (+ (* height delta-x)
             (integral func (- num-steps 1) (+ x1 delta-x) x2)))))

; Problem 2
(define (circle-func x) (sqrt (- 1 (expt x 2))))

(define (approx-pi num-steps)
    (* 4
      (integral circle-func num-steps 0 1)))

; Problem 3
(define (integral-with piece func num-steps x1 x2)
    (if (zero? num-steps)
        0
        (let* ((delta-x (/ (- x2 x1) num-steps))
              (area (piece func x1 (+ x1 delta-x))))
          (+ area
             (integral-with piece func (- num-steps 1) (+ x1 delta-x) x2)))))

(define (rectangle func x1 x2)
    (* (func x1) (- x2 x1)))

(define (trapezoid func x1 x2)
    (* (/ (+ (func x1) (func x2))
          2)
      (- x2 x1)))

; Problem 4
(define (better-pi num-steps)
    (* 4
      (integral-with trapezoid circle-func num-steps 0 1)))

; Optional Integration Function
; (define (numer-derivative func x)
;     (/ (- (func (+ x h)) (func x))
;       h))
; (define (integrate))

(define (numer-second-derivative func x)
    (/ (+ (- (func (+ x h))
             (* 2 (func x)))
          (func (- x h)))
      (expt h 2)))


; variable width intervals
; determines width of interval based on acceleration of the curve at a point
; delta-x = h / |f''(x)| when f''(x) > 1
; Pros: more accurate and faster on constant and linear functions
; Cons: less accurate and slower on most other functions,
;       does not handle cases where second dervative is undefined
(define (integral-vwi func x1 x2)
    (if (close-enough? x1 x2)
        0
        (let* ((curvature (numer-second-derivative func x1))
              ; delta-x in range (0, x2 - x1]
              (delta-x (min (- x2 x1)
                            (/ h
                               (if (= 0 curvature) h (abs curvature))))) ; avoid dividing by zero
              (area (trapezoid func x1 (+ x1 delta-x))))
          (+ area
              (integral-vwi func (+ x1 delta-x) x2)))))
; Tests
(print (integral-vwi square 0 1))
;Value .33233
;Should be: .33_

(print (integral-vwi *4 0 1))
;Value 2
;Should be: 2

; Part 2
(define (deriv-constant wrt constant)
    0)

; Problem 5
(define (deriv-variable wrt var)
    (if (equal? wrt var) 1 0))

; Problem 6
(define constant? number?)
(define variable? symbol?)

(define (sum? expr) (equal? (car expr) '+))
(define (product? expr) (equal? (car expr) '*))

(define (derivative wrt expr)
    (cond ((constant? expr) (deriv-constant wrt expr))
          ((variable? expr) (deriv-variable wrt expr))
          ((sum? expr) (deriv-sum wrt expr))
          ((product? expr) (deriv-product wrt expr))
          (else (print "Don't know how to differentiate" expr))))

(define (deriv-sum wrt expr)
    (let ((terms (cdr expr))) ; terms = expressions after operator
         ; make list of differentiated terms, preprend with '+ operator to form new sum
         (cons '+
              (map (lambda (subexpr) (derivative wrt subexpr)) (cdr expr)))))

(define (deriv-product wrt expr)
    (let* ((terms (cdr expr)))
      ; Run product rule on pairs of the accumulated term and current term
      (foldr (lambda (A B)
                  (list '+
                        (list '* (derivative wrt A) B)
                        (list '* (derivative wrt B) A)))
              (car terms) ; use the first term as the initial value of the accumulator
              (cdr terms))))

;Tests
;(print (derivative 'x '(+ 1 2 3)))
;Value: (+ 0 0 0) equivalent to 0
;Should be equivalent to: 0

;(print (derivative 'x '(* x (* x 1))))
;Value: (+ (* (+ (* 0 x) (* 1 1)) x) (* 1 (* x 1))) equivalent to (* 2 x)
;Should be equivalent to (* 2 x)

;(print (derivative 'y '(* x y)))
;Value: (+ (* 1 x) (* 0 y)) equivalent to x
;Should be equivalent to x

;(print (derivative 'x '(* x x x)))
;Value (+ (* 1 (+ (* 1 x) (* 1 x))) (* (+ (+ (* 1 1) (* 0 x)) (+ (* 1 1) (* 0 x))) x)) equivalent to (* 3 (* x x))
;Should be equivalent to (* 3 (* x x))


; (define (simplify-bin-expr expr)
;     (let ((op (eval (car expr)))
;           (A (cadr expr))
;           (B (caddr expr)))
;       (cond ())))

; (define (simplify-sum sum)
;     (let ((terms (cdr expr)))
;          (foldr (lambda (acc curr)
;                     (cond (?)))

;; Extra (incomplete) algebra system for simplification
(define raw-constant? number?)
(define raw-variable? symbol?)

(define (const? expr) (equal? (exprtype expr) 'const))
(define (var? expr) (equal? (exprtype expr) 'var))
(define (op? expr) (equal? (exprtype expr) 'op))

(define exprtype car)
(define exprvalue cdr)
(define (mkconst const) (cons 'const const))
(define (mkvar var) (cons 'var var))
(define (mkop op) (list 'op (car op) (mkexpr (cadr op)) (mkexpr (caddr op))))

; (Number | Symbol | [Number|Symbol]) -> Expr
(define (mkexpr raw-expr)
    (cond ((raw-constant? raw-expr) (mkconst raw-expr))
          ((raw-variable? raw-expr) (mkvar raw-expr))
          ((list? raw-expr) (mkop raw-expr)) ; should have a stronger condition based on first element of the list
          (else (print "Cannot make expression from" raw-expr))))

(define (simplify-expr expr)
    (cond ((const? expr) expr)
          ((var? expr) expr)
          ((op? expr) ; 3 cases, is there a better way to handle this?
                (let* ((op (eval (cadr expr)))
                      (operand1 (caddr expr))
                      (operand2 (cadddr expr))
                      (t1 (exprtype operand1))
                      (t2 (exprtype operand2)))
                  (cond ((and (const? operand1) (const? operand2))
                         (mkconst (op (exprvalue operand1)
                                      (exprvalue operand2))))
                        ((and (var? ))))))))

; (type (Expr)
;       | (cons 'const Number)
;       | (cons 'var Symbol)
;       | (list 'op Symbol Expr Expr)) ; Generalize to [Expr]