Move pi to trig and e to exp, fix atan2

library/big-float/impl-default.lisp

@@ -675,7 +675,9 @@ returns the nth SeriesSplit, return the series evaluated to the Nth element."
     (define (asin x)
       (atan (* x (reciprocal-sqrt (- 1 (* x x))))))
     (define (acos x)
-      (- (scale (bf-pi) -1) (asin x))))
+      (- (scale (bf-pi) -1) (asin x)))
+    (define pi
+      (bf-pi)))
 
   (define-instance (Exponentiable Big-Float)
     (define (exp x)
@@ -760,7 +762,9 @@ returns the nth SeriesSplit, return the series evaluated to the Nth element."
         ((Tuple x (BFConst f)) (pow x (f)))
         (_ (exp (* y (ln x))))))
     (define (log b x)
-      (/ (ln x) (ln b))))
+      (/ (ln x) (ln b)))
+    (define ee
+      (exp 1)))
 
   (define-instance (Radical Big-Float)
     (define (sqrt x)
@@ -770,27 +774,11 @@ returns the nth SeriesSplit, return the series evaluated to the Nth element."
 
   (define-instance (Polar Big-Float)
     (define (phase z)
-      (let prec = (get-precision))
-      (let x = (real-part z))
-      (let y = (imag-part z))
-      (match (Tuple (<=> x 0) (<=> y 0))
-        ((Tuple (GT) _)    (atan (/ y x)))
-        ((Tuple (LT) (LT)) (- (atan (/ y x)) pi))
-        ((Tuple (LT) _)    (+ (atan (/ y x)) pi))
-        ((Tuple (EQ) (GT)) (/ pi 2))
-        ((Tuple (EQ) (LT)) (/ pi -2))
-        ((Tuple (EQ) (EQ)) 0)))
+      (atan2 (imag-part z) (real-part z)))
     (define (polar z)
       (Tuple (magnitude z) (phase z))))
 
-  (declare bf-ee (Unit -> Big-Float))
-  (define (bf-ee)
-    "Return the value of ee = exp(1) to the currently set precision."
-    (exp 1))
-
-  (define-instance (Elementary Big-Float)
-    (define pi (BFConst bf-pi))
-    (define ee (BFConst bf-ee)))
+  (define-instance (Elementary Big-Float))
 
   (define (big-float->string x)
     "Returns a Big-Float in scientific notation."

library/big-float/impl-sbcl.lisp

@@ -274,7 +274,11 @@
         (cl:values (sb-mpfr:acos x))))
     (define (atan x)
       (lisp Big-Float (x)
-        (cl:values (sb-mpfr:atan x)))))
+        (cl:values (sb-mpfr:atan x))))
+    (define pi
+      "Return the value of pi to the currently set precision."
+      (lisp Big-Float ()
+        (cl:values (sb-mpfr:const-pi)))))
 
   ;; Exp/Log
   (define-instance (Exponentiable Big-Float)
@@ -299,7 +303,11 @@
         (True (/ (ln x) (ln n)))))
     (define (ln x)
       (lisp Big-Float (x)
-        (cl:values (sb-mpfr:log x)))))
+        (cl:values (sb-mpfr:log x))))
+    (define ee 
+      "Return the value of ee = exp(1) to the currently set precision."
+      (lisp Big-Float ()
+        (cl:values (sb-mpfr:exp (sb-mpfr:coerce 1 'sb-mpfr:mpfr-float))))))
 
   (define-instance (Radical Big-Float)
     (define (sqrt x)
@@ -310,34 +318,16 @@
 
   (define-instance (Polar Big-Float)
     (define (phase z)
-      (let x = (real-part z))
-      (let y = (imag-part z))
-      (match (Tuple (<=> x 0) (<=> y 0))
-        ((Tuple (GT) _)    (atan (/ y x)))
-        ((Tuple (LT) (LT)) (- (atan (/ y x)) (bf-pi)))
-        ((Tuple (LT) _)    (+ (atan (/ y x)) (bf-pi)))
-        ((Tuple (EQ) (GT)) (/ (bf-pi) 2))
-        ((Tuple (EQ) (LT)) (/ (bf-pi) -2))
-        ((Tuple (EQ) (EQ)) 0)))
+      (atan2 (imag-part z) (real-part z)))
     (define (polar z)
       (Tuple (magnitude z) (phase z))))
 
-  ;; Elementary
-  (define (bf-pi _)
-    "Return the value of pi to the currently set precision."
-    (lisp Big-Float ()
-      (cl:values (sb-mpfr:const-pi))))
-  (define (bf-ee _)
-    "Return the value of ee = exp(1) to the currently set precision."
-    (lisp Big-Float ()
-      (cl:values (sb-mpfr:exp (sb-mpfr:coerce 1 'sb-mpfr:mpfr-float)))))
 
   ;; BUG: These are calculated just once, so if we change precision,
   ;; these will *NOT* get updated.
-  (define-instance (Elementary Big-Float)
-    (define pi (bf-pi))
-    (define ee (bf-ee)))
-)                                       ; COALTON-TOPLEVEL
+  (define-instance (Elementary Big-Float)))
+
+;COALTON-TOPLEVEL
 
 #+sb-package-locks
 (sb-ext:lock-package "COALTON-LIBRARY/BIG-FLOAT")

library/math/dual.lisp

@@ -150,7 +150,9 @@ Note: `Eq`, and `Ord` and `Hash` only make use of the primal component."
 
     (define (atan (Dual p1 d1))
       (Dual (atan p1)
-            (/ d1 (+ 1 (sq p1))))))
+            (/ d1 (+ 1 (sq p1)))))
+
+    (define pi (Dual pi 0)))
 
   (define-instance ((Num :t) (Exponentiable :t) (Reciprocable :t) => (Exponentiable (Dual :t)))
     (define (exp (Dual p1 d1))
@@ -165,7 +167,9 @@ Note: `Eq`, and `Ord` and `Hash` only make use of the primal component."
       (exp (* dual2 (ln dual1))))
 
     (define (log dual1 dual2)
-      (/ (ln dual2) (ln dual1))))
+      (/ (ln dual2) (ln dual1)))
+
+    (define ee (exp 1)))
 
   (define-instance ((Num :t) (Radical :t) (Reciprocable :t) (Exponentiable :t) => (Radical (Dual :t)))
     (define (nth-root n (Dual p1 d1))

library/math/elementary.lisp

@@ -48,13 +48,26 @@
     (tan   (:a -> :a))
     (asin  (:a -> :a))
     (acos  (:a -> :a))
-    (atan  (:a -> :a)))
+    (atan  (:a -> :a))
+    (pi    (:a)))
 
   (declare sincos (Trigonometric :a => :a -> (Tuple :a :a)))
   (define (sincos x)
     "Computes the sine and cosine of X."
     (Tuple (sin x) (cos x)))
 
+  (declare atan2 ((Ord :f) (Trigonometric :f) (Reciprocable :f) => :f -> :f -> :f))
+  (define (atan2 y x)
+    "Computes the two-argument arctangent of y and x, which is roughly the same
+as (atan (/ y x)) when defined and accounting for the quadrant of the (x,y)."
+    (match (Tuple (<=> x 0) (<=> y 0))
+      ((Tuple (GT) _)    (atan (/ y x)))
+      ((Tuple (LT) (LT)) (- (atan (/ y x)) pi))
+      ((Tuple (LT) _)    (+ (atan (/ y x)) pi))
+      ((Tuple (EQ) (GT)) (/ pi 2))
+      ((Tuple (EQ) (LT)) (/ pi -2))
+      ((Tuple (EQ) (EQ)) 0)))
+
   (define-class (Exponentiable :a)
     "Exponential maps obeying:
 
@@ -66,7 +79,8 @@
     (exp (:a -> :a))
     (pow (:a -> :a -> :a))
     (ln  (:a -> :a))
-    (log  (:a -> :a -> :a)))
+    (log (:a -> :a -> :a))
+    (ee  (:a)))
 
   (define-class (Radical :a)
     "Obeys:
@@ -106,9 +120,7 @@
       ((Reciprocable :a) (Polar :a)
        (Trigonometric :a) (Exponentiable :a) (Radical :a)
        => Elementary :a)
-    "Numbers that can be can be passed to elementary functions."
-    (ee :a)
-    (pi :a))
+    "Numbers that can be can be passed to elementary functions.")
 
   ;; See http://clhs.lisp.se/Body/f_sinh_.htm
 
@@ -136,18 +148,6 @@
   (define (atanh x)
     (/ (- (ln (+ 1 x)) (ln (- 1 x))) (fromInt 2)))
 
-  (declare atan2 ((Ord :f) (Elementary :f) => :f -> :f -> :f))
-  (define (atan2 y x)
-    "Computes the two-argument arctangent of y and x, which is roughly the same
-as (atan (/ y x)) when defined and accounting for the quadrant of the (x,y)."
-    (match (Tuple (<=> x 0) (<=> y 0))
-      ((Tuple (GT) _)    (atan (/ y x)))
-      ((Tuple (LT) (LT)) (- (atan (/ y x)) pi))
-      ((Tuple (LT) _)    (+ (atan (/ y x)) pi))
-      ((Tuple (EQ) (GT)) (/ pi 2))
-      ((Tuple (EQ) (LT)) (/ pi -2))
-      ((Tuple (EQ) (EQ)) 0)))
-
   (define (canonical-nth-root n x)
     "By definition implementation of `nth-root` for reals"
     (pow x (reciprocal (fromInt n))))
@@ -248,7 +248,10 @@ as (atan (/ y x)) when defined and accounting for the quadrant of the (x,y)."
             (lisp ,coalton-type (x)
               (#+(not ccl) cl:progn
                  #+ccl ff:with-float-traps-masked #+ccl cl:t
-                 (cl:atan x)))))))
+                 (cl:atan x))))))
+       (define pi
+         (lisp ,coalton-type ()
+           (cl:coerce cl:pi ',underlying-type))))
 
      (define-instance (Polar ,coalton-type)
        (define (phase x)
@@ -323,7 +326,10 @@ as (atan (/ y x)) when defined and accounting for the quadrant of the (x,y)."
             (lisp ,coalton-type (x)
               (cl:log x)))
            ((< x 0) nan)
-           (True negative-infinity))))
+           (True negative-infinity)))
+        (define ee
+         (lisp ,coalton-type ()
+           (cl:exp (cl:coerce 1 ',underlying-type)))))
 
      (define-instance (Radical ,coalton-type)
        (define (sqrt x)
@@ -336,13 +342,7 @@ as (atan (/ y x)) when defined and accounting for the quadrant of the (x,y)."
        (define (nth-root n x)
          (canonical-nth-root n x)))
 
-     (define-instance (Elementary ,coalton-type)
-       (define ee
-         (lisp ,coalton-type ()
-           (cl:exp (cl:coerce 1 ',underlying-type))))
-       (define pi
-         (lisp ,coalton-type ()
-           (cl:coerce cl:pi ',underlying-type))))))
+     (define-instance (Elementary ,coalton-type))))
 
 (%define-real-float-elementary Single-Float cl:single-float)
 (%define-real-float-elementary Double-Float cl:double-float)
@@ -377,7 +377,8 @@ as (atan (/ y x)) when defined and accounting for the quadrant of the (x,y)."
     (define (pow x y)
       (exp (* y (ln x))))
     (define (log b x)
-      (/ (ln x) (ln b))))
+      (/ (ln x) (ln b)))
+    (define ee (Complex (exp 1) 0)))
 
   (define-instance ((Elementary :a) => Radical (Complex :a))
     (define (sqrt z)
@@ -431,7 +432,8 @@ as (atan (/ y x)) when defined and accounting for the quadrant of the (x,y)."
       ;; atan = (- i/2 (ln (i - z)/(i+z))
       (* (complex 0 (/ -1 2))
          (ln (/ (- ii z)
-                (+ ii z))))))
+                (+ ii z)))))
+    (define pi (Complex pi 0)))
 
   ;; This doesn't have much mathematical meaning
   (define-instance ((Elementary :a) => Polar (Complex :a))
@@ -448,9 +450,7 @@ as (atan (/ y x)) when defined and accounting for the quadrant of the (x,y)."
             (* 2 (atan (/ y (+ r x))))))
       (Tuple r p)))
 
-  (define-instance ((Elementary :a) => Elementary (Complex :a))
-    (define ee (complex ee 0))
-    (define pi (complex pi 0))))
+  (define-instance ((Elementary :a) => Elementary (Complex :a))))
 
 #+sb-package-locks
 (sb-ext:lock-package "COALTON-LIBRARY/MATH/ELEMENTARY")