quartic-formula.egi

(define $quartic-formula qt-f)

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

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

;(define $w (/ (+ -1 (* i (sqrt 3))) 2))