extra/math/quadratic/quadratic.factor

   1 ! Copyright (C) 2007 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel math math.functions ;
   4 IN: math.quadratic
   5
   6 : monic ( c b a -- c' b' ) tuck [ / ] 2bi@ ;
   7
   8 : discriminant ( c b -- b d ) tuck sq 4 / swap - sqrt ;
   9
  10 : critical ( b d -- -b/2 d ) [ -2 / ] dip ;
  11
  12 : +- ( x y -- x+y x-y ) [ + ] [ - ] 2bi ;
  13
  14 : quadratic ( c b a -- alpha beta )
  15     #! Solve a quadratic equation ax^2 + bx + c = 0
  16     monic discriminant critical +- ;
  17
  18 : qeval ( x c b a -- y )
  19     #! Evaluate ax^2 + bx + c
  20     [ pick * ] dip roll sq * + + ;