/[cmucl]/src/code/irrat.lisp
ViewVC logotype

Diff of /src/code/irrat.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.60.2.1 by rtoy, Mon Feb 8 17:15:47 2010 UTC revision 1.60.2.2 by rtoy, Tue Feb 9 20:23:02 2010 UTC
# Line 293  Line 293 
293  ;;;; Power functions.  ;;;; Power functions.
294    
295  (defun exp (number)  (defun exp (number)
296    "Return e raised to the power NUMBER."    _N"Return e raised to the power NUMBER."
297    (number-dispatch ((number number))    (number-dispatch ((number number))
298      (handle-reals %exp number)      (handle-reals %exp number)
299      ((complex)      ((complex)
# Line 308  Line 308 
308    ((base :initarg :base :reader intexp-base)    ((base :initarg :base :reader intexp-base)
309     (power :initarg :power :reader intexp-power))     (power :initarg :power :reader intexp-power))
310    (:report (lambda (condition stream)    (:report (lambda (condition stream)
311               (format stream "The absolute value of ~S exceeds limit ~S."               (format stream _"The absolute value of ~S exceeds limit ~S."
312                       (intexp-power condition)                       (intexp-power condition)
313                       *intexp-maximum-exponent*))))                       *intexp-maximum-exponent*))))
314    
# Line 332  Line 332 
332                 :base base                 :base base
333                 :power power)                 :power power)
334        (continue ()        (continue ()
335          :report "Continue with calculation")          :report _"Continue with calculation")
336        (new-limit ()        (new-limit ()
337          :report "Continue with calculation, update limit"          :report _"Continue with calculation, update limit"
338          (setq *intexp-maximum-exponent* (abs power)))))          (setq *intexp-maximum-exponent* (abs power)))))
339    (cond ((minusp power)    (cond ((minusp power)
340           (/ (intexp base (- power))))           (/ (intexp base (- power))))
# Line 358  Line 358 
358  ;;; the complex-real and real-complex cases from the general complex case.  ;;; the complex-real and real-complex cases from the general complex case.
359  ;;;  ;;;
360  (defun expt (base power)  (defun expt (base power)
361    "Returns BASE raised to the POWER."    _N"Returns BASE raised to the POWER."
362    (if (zerop power)    (if (zerop power)
363        ;; CLHS says that if the power is 0, the result is 1, subject to        ;; CLHS says that if the power is 0, the result is 1, subject to
364        ;; numeric contagion.  But what happens if base is infinity or        ;; numeric contagion.  But what happens if base is infinity or
# Line 674  Line 674 
674           (+ n frac))))))           (+ n frac))))))
675    
676  (defun log (number &optional (base nil base-p))  (defun log (number &optional (base nil base-p))
677    "Return the logarithm of NUMBER in the base BASE, which defaults to e."    _N"Return the logarithm of NUMBER in the base BASE, which defaults to e."
678    (if base-p    (if base-p
679        (cond ((zerop base)        (cond ((zerop base)
680               ;; ANSI spec               ;; ANSI spec
# Line 802  Line 802 
802           (complex-log number)))))           (complex-log number)))))
803    
804  (defun sqrt (number)  (defun sqrt (number)
805    "Return the square root of NUMBER."    _N"Return the square root of NUMBER."
806    (number-dispatch ((number number))    (number-dispatch ((number number))
807      (((foreach fixnum bignum ratio))      (((foreach fixnum bignum ratio))
808       (if (minusp number)       (if (minusp number)
# Line 827  Line 827 
827  ;;;; Trigonometic and Related Functions  ;;;; Trigonometic and Related Functions
828    
829  (defun abs (number)  (defun abs (number)
830    "Returns the absolute value of the number."    _N"Returns the absolute value of the number."
831    (number-dispatch ((number number))    (number-dispatch ((number number))
832      (((foreach single-float double-float fixnum rational      (((foreach single-float double-float fixnum rational
833                 #+double-double double-double-float))                 #+double-double double-double-float))
# Line 851  Line 851 
851              (scale-float (sqrt abs^2) scale))))))))              (scale-float (sqrt abs^2) scale))))))))
852    
853  (defun phase (number)  (defun phase (number)
854    "Returns the angle part of the polar representation of a complex number.    _N"Returns the angle part of the polar representation of a complex number.
855    For complex numbers, this is (atan (imagpart number) (realpart number)).    For complex numbers, this is (atan (imagpart number) (realpart number)).
856    For non-complex positive numbers, this is 0.  For non-complex negative    For non-complex positive numbers, this is 0.  For non-complex negative
857    numbers this is PI."    numbers this is PI."
# Line 878  Line 878 
878    
879    
880  (defun sin (number)  (defun sin (number)
881    "Return the sine of NUMBER."    _N"Return the sine of NUMBER."
882    (number-dispatch ((number number))    (number-dispatch ((number number))
883      (handle-reals %sin number)      (handle-reals %sin number)
884      ((complex)      ((complex)
# Line 888  Line 888 
888                  (* (cos x) (sinh y)))))))                  (* (cos x) (sinh y)))))))
889    
890  (defun cos (number)  (defun cos (number)
891    "Return the cosine of NUMBER."    _N"Return the cosine of NUMBER."
892    (number-dispatch ((number number))    (number-dispatch ((number number))
893      (handle-reals %cos number)      (handle-reals %cos number)
894      ((complex)      ((complex)
# Line 898  Line 898 
898                  (- (* (sin x) (sinh y))))))))                  (- (* (sin x) (sinh y))))))))
899    
900  (defun tan (number)  (defun tan (number)
901    "Return the tangent of NUMBER."    _N"Return the tangent of NUMBER."
902    (number-dispatch ((number number))    (number-dispatch ((number number))
903      (handle-reals %tan number)      (handle-reals %tan number)
904      ((complex)      ((complex)
905       (complex-tan number))))       (complex-tan number))))
906    
907  (defun cis (theta)  (defun cis (theta)
908    "Return cos(Theta) + i sin(Theta), AKA exp(i Theta)."    _N"Return cos(Theta) + i sin(Theta), AKA exp(i Theta)."
909    (if (complexp theta)    (if (complexp theta)
910        (error "Argument to CIS is complex: ~S" theta)        (error _"Argument to CIS is complex: ~S" theta)
911        (complex (cos theta) (sin theta))))        (complex (cos theta) (sin theta))))
912    
913  (defun asin (number)  (defun asin (number)
914    "Return the arc sine of NUMBER."    _N"Return the arc sine of NUMBER."
915    (number-dispatch ((number number))    (number-dispatch ((number number))
916      ((rational)      ((rational)
917       (if (or (> number 1) (< number -1))       (if (or (> number 1) (< number -1))
# Line 935  Line 935 
935       (complex-asin number))))       (complex-asin number))))
936    
937  (defun acos (number)  (defun acos (number)
938    "Return the arc cosine of NUMBER."    _N"Return the arc cosine of NUMBER."
939    (number-dispatch ((number number))    (number-dispatch ((number number))
940      ((rational)      ((rational)
941       (if (or (> number 1) (< number -1))       (if (or (> number 1) (< number -1))
# Line 960  Line 960 
960    
961    
962  (defun atan (y &optional (x nil xp))  (defun atan (y &optional (x nil xp))
963    "Return the arc tangent of Y if X is omitted or Y/X if X is supplied."    _N"Return the arc tangent of Y if X is omitted or Y/X if X is supplied."
964    (if xp    (if xp
965        (flet ((atan2 (y x)        (flet ((atan2 (y x)
966                 (declare (type double-float y x)                 (declare (type double-float y x)
# Line 998  Line 998 
998           (complex-atan y)))))           (complex-atan y)))))
999    
1000  (defun sinh (number)  (defun sinh (number)
1001    "Return the hyperbolic sine of NUMBER."    _N"Return the hyperbolic sine of NUMBER."
1002    (number-dispatch ((number number))    (number-dispatch ((number number))
1003      (handle-reals %sinh number)      (handle-reals %sinh number)
1004      ((complex)      ((complex)
# Line 1008  Line 1008 
1008                  (* (cosh x) (sin y)))))))                  (* (cosh x) (sin y)))))))
1009    
1010  (defun cosh (number)  (defun cosh (number)
1011    "Return the hyperbolic cosine of NUMBER."    _N"Return the hyperbolic cosine of NUMBER."
1012    (number-dispatch ((number number))    (number-dispatch ((number number))
1013      (handle-reals %cosh number)      (handle-reals %cosh number)
1014      ((complex)      ((complex)
# Line 1018  Line 1018 
1018                  (* (sinh x) (sin y)))))))                  (* (sinh x) (sin y)))))))
1019    
1020  (defun tanh (number)  (defun tanh (number)
1021    "Return the hyperbolic tangent of NUMBER."    _N"Return the hyperbolic tangent of NUMBER."
1022    (number-dispatch ((number number))    (number-dispatch ((number number))
1023      (handle-reals %tanh number)      (handle-reals %tanh number)
1024      ((complex)      ((complex)
1025       (complex-tanh number))))       (complex-tanh number))))
1026    
1027  (defun asinh (number)  (defun asinh (number)
1028    "Return the hyperbolic arc sine of NUMBER."    _N"Return the hyperbolic arc sine of NUMBER."
1029    (number-dispatch ((number number))    (number-dispatch ((number number))
1030      (handle-reals %asinh number)      (handle-reals %asinh number)
1031      ((complex)      ((complex)
1032       (complex-asinh number))))       (complex-asinh number))))
1033    
1034  (defun acosh (number)  (defun acosh (number)
1035    "Return the hyperbolic arc cosine of NUMBER."    _N"Return the hyperbolic arc cosine of NUMBER."
1036    (number-dispatch ((number number))    (number-dispatch ((number number))
1037      ((rational)      ((rational)
1038       ;; acosh is complex if number < 1       ;; acosh is complex if number < 1
# Line 1053  Line 1053 
1053       (complex-acosh number))))       (complex-acosh number))))
1054    
1055  (defun atanh (number)  (defun atanh (number)
1056    "Return the hyperbolic arc tangent of NUMBER."    _N"Return the hyperbolic arc tangent of NUMBER."
1057    (number-dispatch ((number number))    (number-dispatch ((number number))
1058      ((rational)      ((rational)
1059       ;; atanh is complex if |number| > 1       ;; atanh is complex if |number| > 1
# Line 1150  Line 1150 
1150    
1151  (declaim (inline scalb))  (declaim (inline scalb))
1152  (defun scalb (x n)  (defun scalb (x n)
1153    "Compute 2^N * X without compute 2^N first (use properties of the    _N"Compute 2^N * X without compute 2^N first (use properties of the
1154  underlying floating-point format"  underlying floating-point format"
1155    (declare (type float x)    (declare (type float x)
1156             (type double-float-exponent n))             (type double-float-exponent n))
# Line 1158  underlying floating-point format" Line 1158  underlying floating-point format"
1158    
1159  (declaim (inline logb-finite))  (declaim (inline logb-finite))
1160  (defun logb-finite (x)  (defun logb-finite (x)
1161    "Same as logb but X is not infinity and non-zero and not a NaN, so    _N"Same as logb but X is not infinity and non-zero and not a NaN, so
1162  that we can always return an integer"  that we can always return an integer"
1163    (declare (type float x))    (declare (type float x))
1164    (multiple-value-bind (signif expon sign)    (multiple-value-bind (signif expon sign)
# Line 1169  that we can always return an integer" Line 1169  that we can always return an integer"
1169      (1- expon)))      (1- expon)))
1170    
1171  (defun logb (x)  (defun logb (x)
1172    "Compute an integer N such that 1 <= |2^(-N) * x| < 2.    _N"Compute an integer N such that 1 <= |2^(-N) * x| < 2.
1173  For the special cases, the following values are used:  For the special cases, the following values are used:
1174    
1175      x             logb      x             logb
# Line 1197  For the special cases, the following val Line 1197  For the special cases, the following val
1197    
1198  (declaim (inline coerce-to-complex-type))  (declaim (inline coerce-to-complex-type))
1199  (defun coerce-to-complex-type (x y z)  (defun coerce-to-complex-type (x y z)
1200    "Create complex number with real part X and imaginary part Y such that    _N"Create complex number with real part X and imaginary part Y such that
1201  it has the same type as Z.  If Z has type (complex rational), the X  it has the same type as Z.  If Z has type (complex rational), the X
1202  and Y are coerced to single-float."  and Y are coerced to single-float."
1203    (declare (double-float x y)    (declare (double-float x y)
# Line 1248  and Y are coerced to single-float." Line 1248  and Y are coerced to single-float."
1248                 (values rho 0)))))))                 (values rho 0)))))))
1249    
1250  (defun complex-sqrt (z)  (defun complex-sqrt (z)
1251    "Principle square root of Z    _N"Principle square root of Z
1252    
1253  Z may be any number, but the result is always a complex."  Z may be any number, but the result is always a complex."
1254    (declare (number z))    (declare (number z))
# Line 1293  Z may be any number, but the result is a Line 1293  Z may be any number, but the result is a
1293          (coerce-to-complex-type eta nu z)))))          (coerce-to-complex-type eta nu z)))))
1294    
1295  (defun complex-log-scaled (z j)  (defun complex-log-scaled (z j)
1296    "Compute log(2^j*z).    _N"Compute log(2^j*z).
1297    
1298  This is for use with J /= 0 only when |z| is huge."  This is for use with J /= 0 only when |z| is huge."
1299    (declare (number z)    (declare (number z)
# Line 1328  This is for use with J /= 0 only when |z Line 1328  This is for use with J /= 0 only when |z
1328                                  z)))))                                  z)))))
1329    
1330  (defun complex-log (z)  (defun complex-log (z)
1331    "Log of Z = log |Z| + i * arg Z    _N"Log of Z = log |Z| + i * arg Z
1332    
1333  Z may be any number, but the result is always a complex."  Z may be any number, but the result is always a complex."
1334    (declare (number z))    (declare (number z))
# Line 1343  Z may be any number, but the result is a Line 1343  Z may be any number, but the result is a
1343  ;; never 0 since we have positive and negative zeroes.  ;; never 0 since we have positive and negative zeroes.
1344    
1345  (defun complex-atanh (z)  (defun complex-atanh (z)
1346    "Compute atanh z = (log(1+z) - log(1-z))/2"    _N"Compute atanh z = (log(1+z) - log(1-z))/2"
1347    (declare (number z))    (declare (number z))
1348    #+double-double    #+double-double
1349    (when (typep z '(or double-double-float (complex double-double-float)))    (when (typep z '(or double-double-float (complex double-double-float)))
# Line 1407  Z may be any number, but the result is a Line 1407  Z may be any number, but the result is a
1407                                    z)))))                                    z)))))
1408    
1409  (defun complex-tanh (z)  (defun complex-tanh (z)
1410    "Compute tanh z = sinh z / cosh z"    _N"Compute tanh z = sinh z / cosh z"
1411    (declare (number z))    (declare (number z))
1412    #+double-double    #+double-double
1413    (when (typep z '(or double-double-float (complex double-double-float)))    (when (typep z '(or double-double-float (complex double-double-float)))
# Line 1492  Z may be any number, but the result is a Line 1492  Z may be any number, but the result is a
1492    (complex (+ (realpart z) 1) (imagpart z)))    (complex (+ (realpart z) 1) (imagpart z)))
1493    
1494  (defun complex-acos (z)  (defun complex-acos (z)
1495    "Compute acos z = pi/2 - asin z    _N"Compute acos z = pi/2 - asin z
1496    
1497  Z may be any number, but the result is always a complex."  Z may be any number, but the result is always a complex."
1498    (declare (number z))    (declare (number z))
# Line 1511  Z may be any number, but the result is a Line 1511  Z may be any number, but the result is a
1511                                         sqrt-1-z))))))))                                         sqrt-1-z))))))))
1512    
1513  (defun complex-acosh (z)  (defun complex-acosh (z)
1514    "Compute acosh z = 2 * log(sqrt((z+1)/2) + sqrt((z-1)/2))    _N"Compute acosh z = 2 * log(sqrt((z+1)/2) + sqrt((z-1)/2))
1515    
1516  Z may be any number, but the result is always a complex."  Z may be any number, but the result is always a complex."
1517    (declare (number z))    (declare (number z))
# Line 1525  Z may be any number, but the result is a Line 1525  Z may be any number, but the result is a
1525    
1526    
1527  (defun complex-asin (z)  (defun complex-asin (z)
1528    "Compute asin z = asinh(i*z)/i    _N"Compute asin z = asinh(i*z)/i
1529    
1530  Z may be any number, but the result is always a complex."  Z may be any number, but the result is always a complex."
1531    (declare (number z))    (declare (number z))
# Line 1544  Z may be any number, but the result is a Line 1544  Z may be any number, but the result is a
1544                                         sqrt-1+z))))))))                                         sqrt-1+z))))))))
1545    
1546  (defun complex-asinh (z)  (defun complex-asinh (z)
1547    "Compute asinh z = log(z + sqrt(1 + z*z))    _N"Compute asinh z = log(z + sqrt(1 + z*z))
1548    
1549  Z may be any number, but the result is always a complex."  Z may be any number, but the result is always a complex."
1550    (declare (number z))    (declare (number z))
# Line 1558  Z may be any number, but the result is a Line 1558  Z may be any number, but the result is a
1558               (- (realpart result)))))               (- (realpart result)))))
1559    
1560  (defun complex-atan (z)  (defun complex-atan (z)
1561    "Compute atan z = atanh (i*z) / i    _N"Compute atan z = atanh (i*z) / i
1562    
1563  Z may be any number, but the result is always a complex."  Z may be any number, but the result is always a complex."
1564    (declare (number z))    (declare (number z))
# Line 1572  Z may be any number, but the result is a Line 1572  Z may be any number, but the result is a
1572               (- (realpart result)))))               (- (realpart result)))))
1573    
1574  (defun complex-tan (z)  (defun complex-tan (z)
1575    "Compute tan z = -i * tanh(i * z)    _N"Compute tan z = -i * tanh(i * z)
1576    
1577  Z may be any number, but the result is always a complex."  Z may be any number, but the result is always a complex."
1578    (declare (number z))    (declare (number z))

Legend:
Removed from v.1.60.2.1  
changed lines
  Added in v.1.60.2.2

  ViewVC Help
Powered by ViewVC 1.1.5