derivative.egi

;;;;;
;;;;;
;;;;; Differentiation
;;;;;
;;;;;

(define $∂/∂
  (lambda [$f $x]
    (match f math-expr
      {; symbol
       [,x 1]
       [?symbol? 0]
       ; function application
       [(,exp $g) (* (exp g) (∂/∂ g x))]
       [(,log $g) (* (/ 1 g) (∂/∂ g x))]
       [(,cos $g) (* (* -1 (sin g)) (∂/∂ g x))]
       [(,sin $g) (* (cos g) (∂/∂ g x))]
       [(,sqrt $g) (* (/ 1 (* 2 (sqrt g))) (∂/∂ g x))]
       [(,** $g $h) (* f (∂/∂ (* (log g) h) x))]
       [<apply $g $args>
        (sum (map 2#(* (capply `(add-user-script 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})))))