home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / lisp / interpre / pclisp / math.l < prev    next >
Encoding:
Text File  |  1989-11-27  |  9.4 KB  |  321 lines
  1.  
  2. ;================;           Bill Forseth
  3. ; TRIG FUNCTIONS ;           817 1/2 N. 10 ave E.
  4. ;    11.27.89    ;           Duluth, MN 55805
  5. ;================;           (218) 724-8910
  6.  
  7.  
  8.  
  9. ; NOTES:  All function inputs evaluating to 'undefined' are returned as '0'.
  10. ; BUGS:   PC-LISP's sin and cos functions evaluate pi at 3.141. In increasing
  11. ;         the the length of the fractional part of pi cos and sin had to be
  12. ;         semi-redefined (via functions chkman and round, mostly). Thus the
  13. ;         angle functions return 0, -.5, .5, 1, -1, 2 etc. when they should -
  14. ;         BUT for very small angle differences (i +/- 0.00001 radians where
  15. ;         i is any integer) the result becomes rounded.
  16. ;         As far as I know the equations are accurate - they were checked with
  17. ;         formulas found in any standard algebra/trig/calc textbook.
  18. ; FUTURE: Elaboration of differentials, perhaps symbolic routines for
  19. ;         factoring standard and differential combinations.
  20.  
  21.  
  22. ;-------------------------------------------------
  23. ; PPOWER
  24. ; Returns x to the n-th (where x and n may be
  25. ; positive or negative, whole numbers or fractions).
  26. ; Attmepts at taking the root of a negative are headed
  27. ; off and the function returns the abs value.
  28. ; Syntax: (ppower <constant> <exponent>)
  29. ;     ie: (ppower 25 -0.5)
  30. ;--------------------------------------------------
  31. (defun ppower (x n)
  32.     (cond
  33.         ((zerop x) 0) ((= 1 n) x)
  34.         ((or (zerop n) (= 1 x)) 1)
  35.         ((minusp n) (invert (ppower x (abs n))))
  36.         ((> 1 n) (expt (abs x) n))
  37.         (t
  38.             (** x (ppower x (diff n 1))))))
  39.  
  40. ;---------------------------------------
  41. ; LLOG
  42. ; Returns log(a) / log(b)
  43. ; Syntax: (llog <argument1> <argument2>)
  44. ;     ie: (llog 2 16)
  45. ;---------------------------------------
  46. (defun llog (a b)
  47.     (cond
  48.         ((or (= 1 b) (= 1 a) (zerop a)
  49.              (zerop b) (minusp a) (minusp b)) 0)
  50.         (t (// (log b) (log a)))))
  51.  
  52. ;----------------------------------------
  53. ; ADJRAD
  54. ; Puts x in the range of 0 <= x < 2pi,
  55. ; x in radians.
  56. ; Syntax: (adjrad <argument>)
  57. ;     ie: (adjrad 31.41)
  58. ;----------------------------------------
  59. (defun adjrad (x)
  60.     (cond
  61.         ((= (abs x) (2pi)) 0)
  62.         ((< x 0) (adjrad (add x (2pi))))
  63.         ((> x (2pi)) (adjrad (diff x (2pi))))
  64.         (t  x)))
  65.  
  66. ;----------------------------------------
  67. ; ADJDEG
  68. ; Puts d in the range of 0 <= d < 360,
  69. ; d in degrees.
  70. ; Syntax: (adjdeg <argument>)
  71. ;     ie: (adjdeg -780)
  72. ;----------------------------------------
  73. (defun adjdeg (d)
  74.     (cond
  75.         ((or (zerop d) (= (abs d) 360)) 0)
  76.         ((> d 360) (adjdeg (diff d 360)))
  77.         ((< d 0) (adjdeg (add d 360)))
  78.         (t d)))
  79.  
  80. ;-------------------------------
  81. ; D2R
  82. ; Converts degrees to radians.
  83. ; Syntax: (d2r <argument>)
  84. ;     ie: (d2r 180)
  85. ;-------------------------------
  86. (defun d2r (x)
  87.     (// (** (adjdeg x) (pi)) 180))
  88.  
  89. ;-------------------------------
  90. ; R2D
  91. ; Converts radians to degrees.
  92. ; Syntax: (r2d <argument>)
  93. ;     ie: (r2d 3.14)
  94. ;-------------------------------
  95. (defun r2d (x)
  96.     (// (** (adjrad x) 180) (pi)))
  97.  
  98. ;---------------------------------------
  99. ; PI functions
  100. ; All arguments in positive or negative,
  101. ; whole numbers or fractions.
  102. ;---------------------------------------
  103.  
  104. (defun pi () 3.141592)               ;Returns the value of pi to 6th place
  105.                                      ;(not rounded)
  106.                                      ;Syntax: (pi)
  107.  
  108. (defun pi/ (x) (// (pi) x))          ;Returns pi divided by x
  109.                                      ;Syntax: (pi/ <argument>)
  110.  
  111. (defun pi* (x) (** (pi) x))          ;Returns pi times x
  112.                                      ;Syntax: (pi* <argument>)
  113.  
  114. (defun pi*/ (n d)                    ;Returns pi times n/d
  115.     (** (pi) (// n d)))              ;Syntax: (pi*/ <argument1> <argument2>)
  116. (defun pi/* (n d)                    ;<-- forgiving function
  117.     (** (pi) (// n d)))
  118.  
  119.  
  120. ;Shorthand pi functions for frequently used angles - -
  121.  
  122. (defun 2pi () (pi* 2))     ;360 deg.
  123. (defun pi2 () (pi/ 2))     ;90   "
  124. (defun pi3 () (pi/ 3))     ;60   "
  125. (defun pi4 () (pi/ 4))     ;45   "
  126. (defun pi6 () (pi/ 6))     ;30   "
  127.  
  128. ;-----------------------------------------
  129. ; SINr
  130. ; Modified sin for the current value of pi
  131. ; Syntax: (sinr <argument>)
  132. ;-----------------------------------------
  133. (defun sinr (x) (chkman (sin (adjrad x))))
  134.  
  135. ;-----------------------------------------
  136. ; COSr
  137. ; Modified cos for the current value of pi
  138. ; Syntax: (cosr <argument>)
  139. ;-----------------------------------------
  140. (defun cosr (x) (chkman (cos (adjrad x))))
  141.  
  142. ;--------------------------------------
  143. ; TANr
  144. ; Returns the tangent of x, where x is
  145. ; in radians.
  146. ; Syntax: (tanr <argument>)
  147. ;--------------------------------------
  148. (defun tanr (x)
  149.     (cond
  150.         ((or (zerop (cosr x)) (zerop (sinr x))) 0)
  151.         (t (chkman (adjrad (// (sinr x) (cosr x)))))))
  152.  
  153. ;-------------------------------
  154. ; SINd
  155. ; Returns sin of DEGREE argument
  156. ; Syntax: (sind <argument>)
  157. ;-------------------------------
  158. (defun sind (d) (chkman (adjrad (sinr (d2r d)))))
  159.  
  160. ;-------------------------------
  161. ; COSd
  162. ; Returns cos of DEGREE argument
  163. ; Syntax: (cosd <argument>)
  164. ;-------------------------------
  165. (defun cosd (d) (chkman (adjrad (cosr (d2r d)))))
  166.  
  167. ;---------------------------------------
  168. ; TANd
  169. ; Returns the tangent of DEGREE argument
  170. ; Syntax: (tand <argument>)
  171. ;---------------------------------------
  172. (defun tand (d)
  173.     (cond
  174.         ((or (zerop (cosd d)) (zerop (sind d))) 0)
  175.         (t (chkman (adjrad (// (sind d) (cosd d)))))))
  176.  
  177. ;-----------------------------
  178. ; INVERSE functions
  179. ; Arguments (___r) in radians,
  180. ; (___d) in degrees.
  181. ;-----------------------------
  182. (defun secr (x) (adjrad (invert (cosr x))))
  183.  
  184. (defun cscr (x) (adjrad (invert (sinr x))))
  185.  
  186. (defun cotr (x) (adjrad (invert (tanr x))))
  187.  
  188. (defun secd (d) (adjdeg (invert (cosd d))))
  189.  
  190. (defun cscd (d) (adjdeg (invert (sind d))))
  191.  
  192. (defun cotd (d) (adjdeg (invert (tand d))))
  193.  
  194.  
  195. ;--------------------------
  196. ; DERIVITIVE functions
  197. ; All arguments in radians.
  198. ;--------------------------
  199. (defun sin_prime (x) (cosr x))
  200.  
  201. (defun cos_prime (x) (neg (sinr x)))
  202.  
  203. (defun tan_prime (x) (chkman (adjrad (ppower (secr x) 2))))
  204.  
  205. (defun sec_prime (x) (chkman (adjrad (** (secr x) (tanr x)))))
  206.  
  207. (defun csc_prime (x) (chkman (adjrad (neg (** (cscr x) (cotr x))))))
  208.  
  209. (defun cot_prime (x) (chkman (adjrad (ppower (cscr x) 2))))
  210.  
  211.  
  212. ;------------------------------------------------
  213. ; DOUBLE and HALF angles formulas.
  214. ; All arguments in radians.
  215. ; To use degrees use (d2r d) as the arguments.
  216. ; To have the return in degrees nest the function
  217. ; inside (r2d (<. . .>))
  218. ;-------------------------------------------------
  219. (defun sinA+B (a b)
  220.     (chkman (adjrad (add (** (sinr a) (cosr b)) (** (cosr a) (sinr b))))))
  221.  
  222. (defun sinA-B (a b)
  223.     (chkman (adjrad (diff (** (sinr a) (cosr b)) (** (cosr a) (sinr b))))))
  224.  
  225. (defun cosA+B (a b)
  226.     (chkman (adjrad (diff (** (cosr a) (cosr b)) (** (sinr a) (sinr b))))))
  227.  
  228. (defun cosA-B (a b)
  229.     (chkman (adjrad (add (** (cosr a) (cosr b)) (** (sinr a) (sinr b))))))
  230.  
  231. (defun tanA+B (a b)
  232.     (cond
  233.         ((zerop (cosA+B a b)) 0)
  234.         (t (chkman (adjrad (// (sinA+B a b) (cosA+B a b)))))))
  235.  
  236. (defun tanA-B (a b)
  237.     (cond
  238.         ((zerop (cosA-B a b)) 0)
  239.         (t (chkman (adjrad (// (sinA-B a b) (cosA-B a b)))))))
  240.  
  241.  
  242.  
  243. (defun sin2A (a)
  244.     (chkman (adjrad (** 2 (sinr a) (cosr a)))))
  245.  
  246. (defun cos2A (a)
  247.     (chkman (adjrad (diff (ppower (cosr a) 2) (ppower (sinr a) 2)))))
  248.  
  249. (defun tan2A (a)
  250.     (cond
  251.         ((zerop (cos2A a)) 0)
  252.         (t (chkman (adjrad (// (sin2A a) (cos2A a)))))))
  253.  
  254.  
  255.  
  256. (defun sinhalfA (a)
  257.     (chkman (adjrad (sqrt (abs (// (diff 1 (cosr a)) 2))))))
  258.  
  259. (defun coshalfA (a)
  260.     (chkman (adjrad (sqrt (abs (// (add 1 (cosr a)) 2))))))
  261.  
  262. (defun tanhalfA (a)
  263.     (cond
  264.         ((zerop (coshalfA a)) 0)
  265.         (t (chkman (adjrad (// (sinhalfA a) (coshalfA a)))))))
  266.  
  267.  
  268. ;-------------------------
  269. ; MISC functions
  270. ;-------------------------
  271.  
  272. (defun invert (x)                          ;returns 1/x
  273.     (cond ((zerop x) 0) (t (chkman (// 1 x)))))
  274.  
  275.  
  276. (defun neg (x) (** -1 x))                  ;returns -x
  277.  
  278.  
  279. (defun // fexpr(l) (eval (cons 'quotient l)))  ;shorthand div. of floats
  280.  
  281.  
  282. (defun ** fexpr(l) (eval (cons 'times l)))     ;shorthand mult. of floats
  283.  
  284.  
  285. (defun chkman (x)                          ;returns nearest whole number if
  286.     (cond                                  ;fraction is very small or large
  287.         ((< (abs (diff (abs x) (abs (round x)))) 0.00001)
  288.             (round x))
  289.         (t x)))
  290.  
  291.  
  292. (defun round (x)                           ;rounding function
  293.     (cond
  294.         ((zerop x) 0)
  295.         ((plusp x)
  296.            (cond
  297.                 ((< (diff x (fix x)) .5) (fix x))
  298.                 (t (add 1 (fix x)))))
  299.         (t (cond
  300.                 ((< (diff (abs x) (fix (abs x))) .5) (fix x))
  301.                 (t (neg (diff 1 (fix x))))))))
  302.  
  303.  
  304.  
  305. (defun gint (x)                            ;greatest integer function
  306.     (cond
  307.         ((zerop x) 0)
  308.         ((plusp x) (fix x))
  309.         ((minusp x)
  310.             (cond
  311.                 ((= x (fix x)) x)
  312.                 (t (diff (fix x) 1))))
  313.         (t x)))
  314.  
  315.  
  316. (defun rangep (a x b)                      ;true if a <= x <= b
  317.     (cond
  318.         ((and (not (< x a)) (not (> x b))) t)
  319.         (t nil)))
  320.  
  321.