Permalink
Fetching contributors…
Cannot retrieve contributors at this time
88 lines (77 sloc) 2.64 KB
;;;;;
;;;;;
;;;;; Differentiation
;;;;;
;;;;;
(define $∂/∂
(lambda [$f *$x]
(match f math-expr
{; symbol
[,x 1]
[?symbol? 0]
; function expression
[<func _ $argnames $args _> (sum (map2 (lambda [$s $r] (* (user-refs f {s}) (∂/∂ r x))) argnames args))]
; function application
[(,exp $g) (* (exp g) (∂/∂ g x))]
[(,log $g) (* (/ 1 g) (∂/∂ g x))]
[(,sqrt $g) (* (/ 1 (* 2 (sqrt g))) (∂/∂ g x))]
[(,** $g $h) (* f (∂/∂ (* (log g) h) x))]
[(,cos $g) (* (* -1 (sin g)) (∂/∂ g x))]
[(,sin $g) (* (cos g) (∂/∂ g x))]
[(,arccos $g) (* (/ 1 (sqrt (- 1 (** g 2)))) (∂/∂ g x))]
[<apply $g $args>
(sum (map 2#(* (capply `(user-refs g {%1}) args) (∂/∂ %2 x))
(zip nats args)))]
; quote
[<quote $g>
(let {[$g' (∂/∂ g x)]}
(if (monomial? g')
g'
(let {[$d (capply gcd (from-poly g'))]}
(*' d '(map-poly (/' $ d) g')))))]
; term (constant)
[,0 0]
[(* _ ,1) 0]
; term (multiplication)
[(* ,1 $fx^$n) (* n (** fx (- n 1)) (∂/∂ fx x))]
[(* $a $fx^$n $r)
(+ (* a (∂/∂ (**' fx n) x) r)
(* a (**' fx n) (∂/∂ r x)))]
; polynomial
[<poly $ts> (sum (map (∂/∂ $ x) ts))]
; quotient
[(/ $p1 $p2)
(let {[$p1' (∂/∂ p1 x)]
[$p2' (∂/∂ p2 x)]}
(/ (- (* p1' p2) (* p2' p1)) (** p2 2)))]
})))
(define $d/d ∂/∂)
(define $pd/pd ∂/∂)
(define $∇ ∂/∂)
(define $nabla ∇)
(define $grad ∇)
;(define $taylor-expansion
; (lambda [$f $x $a]
; (map2 *
; (map 1#(/ (** (- x a) %1) (fact %1)) nats0)
; (map (substitute {[x a]} $) (iterate (∂/∂ $ x) f)))))
(define $taylor-expansion
(lambda [$f $x $a]
(multivariate-taylor-expansion f [| x |] [| a |])))
(define $maclaurin-expansion (taylor-expansion $ $ 0))
(define $multivariate-taylor-expansion
(lambda [%f %xs %as]
(with-symbols {h}
(let {[$hs (generate-tensor 1#h_%1 (tensor-size xs))]}
(map2 *
(map 1#(/ 1 (fact %1)) nats0)
(map (compose 1#(V.substitute xs as %1)
1#(V.substitute hs (with-symbols {i} (- xs_i as_i)) %1))
(iterate (compose 1#(∇ %1 xs) 1#(V.* hs %1)) f)))))))
(define $multivariate-maclaurin-expansion
(lambda [%f %xs]
(multivariate-taylor-expansion f xs (tensor-map 1#0 xs))))
(define $add-user-script
(lambda [$f $i]
(let {[[$g $is] (decons-user-scripts f)]}
(append-user-scripts g (sort {@is i})))))