Add quadratic-complex-solutions

- Also switch to potentially more numerically stable quadratic formulas - Closes racket#21
dieggsy · Feb 24, 2019 · 69834a9 · 69834a9
1 parent 58f5d62
commit 69834a9
Show file tree

Hide file tree

Showing 3 changed files with 33 additions and 18 deletions.
diff --git a/math-doc/math/scribblings/math-number-theory.scrbl b/math-doc/math/scribblings/math-number-theory.scrbl
@@ -793,22 +793,30 @@ lowest term is the number @math-style{(p+r)/(q+s)}.
 @; ----------------------------------------
 @section[#:tag "quadratics"]{The Quadratic Equation}
 
-@defproc[(quadratic-solutions [a Real] [b Real] [c Real]) (Listof Real)]{
+@defproc[(quadratic-complex-solutions [a Complex] [b Complex] [c Complex]) (Listof Complex)]{
+Returns a list of all complex solutions to the equation @math-style{a x^2 + b x +c = 0}.
+  @interaction[#:eval untyped-eval
+                      (quadratic-solutions 1 0 -1)
+                      (quadratic-solutions 1 2 1)
+                      (quadratic-solutions 1 0 1)]
+}
+
+@defproc[(quadratic-solutions [a Complex] [b Complex] [c Complex]) (Listof Real)]{
 Returns a list of all real solutions to the equation @math-style{a x^2 + b x +c = 0}.
   @interaction[#:eval untyped-eval
                       (quadratic-solutions 1 0 -1)
                       (quadratic-solutions 1 2 1)
                       (quadratic-solutions 1 0 1)]  
 }
 
-@defproc[(quadratic-integer-solutions [a Real] [b Real] [c Real]) (Listof Integer)]{
+@defproc[(quadratic-integer-solutions [a Complex] [b Complex] [c Complex]) (Listof Integer)]{
 Returns a list of all integer solutions to the equation @math-style{a x^2 + b x +c = 0}.
   @interaction[#:eval untyped-eval
                       (quadratic-integer-solutions 1 0 -1)
                       (quadratic-integer-solutions 1 0 -2)]  
 }
 
-@defproc[(quadratic-natural-solutions [a Real] [b Real] [c Real]) (Listof Natural)]{
+@defproc[(quadratic-natural-solutions [a Complex] [b Complex] [c Complex]) (Listof Natural)]{
 Returns a list of all natural solutions to the equation @math-style{a x^2 + b x +c = 0}.
   @interaction[#:eval untyped-eval
                       (quadratic-natural-solutions 1 0 -1)

diff --git a/math-lib/math/private/number-theory/quadratic.rkt b/math-lib/math/private/number-theory/quadratic.rkt
@@ -3,28 +3,32 @@
 (require racket/list
          "types.rkt")
 
-(provide quadratic-solutions
+(provide quadratic-complex-solutions
+         quadratic-solutions
          quadratic-integer-solutions
          quadratic-natural-solutions)
 
-(: quadratic-solutions : Real Real Real -> (Listof Real))
-(define (quadratic-solutions a b c)
+(: quadratic-complex-solutions  : Complex Complex Complex -> (Listof Complex))
+(define (quadratic-complex-solutions a b c)
   ; return list of solutions to a a x^2 + b x + c = 0
   (let ([d (- (* b b) (* 4 a c))])
-    (cond
-      [(< d 0) '()]
-      [(= d 0) (list (/ b (* -2 a)))]
-      [else
-       (let ([sqrt-d (sqrt d)])
-         (list (/ (- (- b) sqrt-d) (* 2 a))
-               (/ (+ (- b) sqrt-d) (* 2 a))))])))
+    (if (= d 0)
+        (make-list 2 (/ b (* -2 a)))
+        (let* ([sqrt-d (sqrt d)]
+               [sign (if (>= 0 (real-part (* (conjugate b) sqrt-d))) 1 -1)]
+               [q (/ (+ b (* sign sqrt-d)) -2)])
+          (list (/ q a) (/ c q))))))
+
+(: quadratic-solutions : Complex Complex Complex -> (Listof Real))
+(define (quadratic-solutions a b c)
+  (filter real? (quadratic-solutions a b c)))
 
-(: quadratic-integer-solutions : Real Real Real -> (Listof Integer))
+(: quadratic-integer-solutions : Complex Complex Complex -> (Listof Integer))
 (define (quadratic-integer-solutions a b c)
   ; return list of integer solutions to a x^2 + b x + c = 0
   (filter exact-integer? (quadratic-solutions a b c)))
 
-(: quadratic-natural-solutions : Real Real Real -> (Listof Natural))
+(: quadratic-natural-solutions : Complex Complex Complex -> (Listof Natural))
 (define (quadratic-natural-solutions a b c)
   ; return list of nonnegative-integer solutions to a x^2 + b x + c = 0
   (filter natural? (quadratic-solutions a b c)))
diff --git a/math-test/math/tests/number-theory-tests.rkt b/math-test/math/tests/number-theory-tests.rkt
@@ -3,15 +3,18 @@
 (require typed/rackunit)
 
 ; "quadratic.rkt"
+(check-equal? (quadratic-complex-solutions 1 0 -4) '(-2 2))
+(check-equal? (quadratic-complex-solutions 1 0 +4) '(0-2i 0+2i))
+(check-equal? (quadratic-complex-solutions 1 0 0)  '(0 0))
 (check-equal? (quadratic-solutions 1 0 -4) '(-2 2))
 (check-equal? (quadratic-solutions 1 0 +4) '())
-(check-equal? (quadratic-solutions 1 0 0)  '(0))
+(check-equal? (quadratic-solutions 1 0 0)  '(0 0))
 (check-equal? (quadratic-integer-solutions 1 0 -4) '(-2 2))
 (check-equal? (quadratic-integer-solutions 1 0 +4) '())
-(check-equal? (quadratic-integer-solutions 1 0 0)  '(0))
+(check-equal? (quadratic-integer-solutions 1 0 0)  '(0 0))
 (check-equal? (quadratic-natural-solutions 1 0 -4) '(2))
 (check-equal? (quadratic-natural-solutions 1 0 +4) '())
-(check-equal? (quadratic-natural-solutions 1 0 0)  '(0))
+(check-equal? (quadratic-natural-solutions 1 0 0)  '(0 0))
 
 ; "eulerian-number.rkt"
 (check-equal? (map (λ: ([x : Natural]) (eulerian-number 5 x)) '(0 1 2 3 4))