;;;;;
;;;;;
;;;;; Equations
;;;;;
;;;;;

(define $solve1
  (lambda [$f $expr $x]
    (inverse expr f x)))

(define $solve
  (lambda [$eqs]
    (solve' eqs {})))

(define $solve'
  (lambda [$eqs $rets]
    (match eqs (list [math-expr math-expr symbol-expr])
      {[<nil> rets]
       [<cons [$f $expr $x] $rs>
        (solve' rs {@rets [x (solve1 (substitute rets f) (substitute rets expr) x)]})]})))

;;;
;;; Quadratic Equations
;;;
(define $quadratic-formula q-f)

(define $q-f
  (lambda [$f $x]
    (match (coefficients f x) (list math-expr)
      {[<cons $a_0 <cons $a_1 <cons $a_2 <nil>>>>
        (q-f' a_2 a_1 a_0)]})))

(define $q-f'
  (lambda [$a $b $c]
    [(/ (+ (* -1 b) (sqrt (- (** b 2) (* 4 a c)))) (* 2 a))
     (/ (- (* -1 b) (sqrt (- (** b 2) (* 4 a c)))) (* 2 a))]))

;;;
;;; Cubic Equations
;;;
(define $cubic-formula c-f)

(define $c-f
  (lambda [$f $x]
    (match (coefficients f x) (list math-expr)
      {[<cons $a_0 <cons $a_1 <cons $a_2 <cons $a_3 <nil>>>>>
        (c-f' a_3 a_2 a_1 a_0)]})))

(define $c-f'
  (lambda [$a $b $c $d]
    (match [a b c d] [math-expr math-expr math-expr math-expr]
      {[[,1 ,0 $p $q]
        (let* {[[$s1 $s2] (2#[(rt 3 %1) (rt 3 %2)] (q-f' 1 (* 27 q) (* -27 p^3)))]}
          [(/ (+ s1 s2) 3)               ; r1
           (/ (+ (* w^2 s1) (* w s2)) 3) ; r2
           (/ (+ (* w s1) (* w^2 s2)) 3) ; r3
           ])]
       [[,1 _ _ _]
        (3#[(- %1 (/ b 3)) (- %2 (/ b 3)) (- %3 (/ b 3))]
           (with-symbols {x y}
             (c-f (substitute {[x (- y (/ b 3))]} (+ x^3 (* b x^2) (* c x) d)) y)))]
       [[_ _ _ _] (c-f' 1 (/ b a) (/ c a) (/ d a))]})))