Output of file : MATH.L contained in archive : PCLISP30.ZIP

;================; Bill Forseth
; TRIG FUNCTIONS ; 817 1/2 N. 10 ave E.
; 11.27.89 ; Duluth, MN 55805
;================; (218) 724-8910

; NOTES: All function inputs evaluating to 'undefined' are returned as '0'.
; BUGS: PC-LISP's sin and cos functions evaluate pi at 3.141. In increasing
; the the length of the fractional part of pi cos and sin had to be
; semi-redefined (via functions chkman and round, mostly). Thus the
; angle functions return 0, -.5, .5, 1, -1, 2 etc. when they should -
; BUT for very small angle differences (i +/- 0.00001 radians where
; i is any integer) the result becomes rounded.
; As far as I know the equations are accurate - they were checked with
; formulas found in any standard algebra/trig/calc textbook.
; FUTURE: Elaboration of differentials, perhaps symbolic routines for
; factoring standard and differential combinations.

;-------------------------------------------------
; PPOWER
; Returns x to the n-th (where x and n may be
; positive or negative, whole numbers or fractions).
; Attmepts at taking the root of a negative are headed
; off and the function returns the abs value.
; Syntax: (ppower )
; ie: (ppower 25 -0.5)
;--------------------------------------------------
(defun ppower (x n)
(cond
((zerop x) 0) ((= 1 n) x)
((or (zerop n) (= 1 x)) 1)
((minusp n) (invert (ppower x (abs n))))
((> 1 n) (expt (abs x) n))
(t
(** x (ppower x (diff n 1))))))

;---------------------------------------
; LLOG
; Returns log(a) / log(b)
; Syntax: (llog )
; ie: (llog 2 16)
;---------------------------------------
(defun llog (a b)
(cond
((or (= 1 b) (= 1 a) (zerop a)
(zerop b) (minusp a) (minusp b)) 0)
(t (// (log b) (log a)))))

;----------------------------------------
; Puts x in the range of 0 <= x < 2pi,
;----------------------------------------
(cond
((= (abs x) (2pi)) 0)
(t x)))

;----------------------------------------
; Puts d in the range of 0 <= d < 360,
; d in degrees.
;----------------------------------------
(cond
((or (zerop d) (= (abs d) 360)) 0)
((> d 360) (adjdeg (diff d 360)))
(t d)))

;-------------------------------
; D2R
; Syntax: (d2r )
; ie: (d2r 180)
;-------------------------------
(defun d2r (x)
(// (** (adjdeg x) (pi)) 180))

;-------------------------------
; R2D
; Syntax: (r2d )
; ie: (r2d 3.14)
;-------------------------------
(defun r2d (x)

;---------------------------------------
; PI functions
; All arguments in positive or negative,
; whole numbers or fractions.
;---------------------------------------

(defun pi () 3.141592) ;Returns the value of pi to 6th place
;(not rounded)
;Syntax: (pi)

(defun pi/ (x) (// (pi) x)) ;Returns pi divided by x
;Syntax: (pi/ )

(defun pi* (x) (** (pi) x)) ;Returns pi times x
;Syntax: (pi* )

(defun pi*/ (n d) ;Returns pi times n/d
(** (pi) (// n d))) ;Syntax: (pi*/ )
(defun pi/* (n d) ;<-- forgiving function
(** (pi) (// n d)))

;Shorthand pi functions for frequently used angles - -

(defun 2pi () (pi* 2)) ;360 deg.
(defun pi2 () (pi/ 2)) ;90 "
(defun pi3 () (pi/ 3)) ;60 "
(defun pi4 () (pi/ 4)) ;45 "
(defun pi6 () (pi/ 6)) ;30 "

;-----------------------------------------
; SINr
; Modified sin for the current value of pi
; Syntax: (sinr )
;-----------------------------------------

;-----------------------------------------
; COSr
; Modified cos for the current value of pi
; Syntax: (cosr )
;-----------------------------------------

;--------------------------------------
; TANr
; Returns the tangent of x, where x is
; Syntax: (tanr )
;--------------------------------------
(defun tanr (x)
(cond
((or (zerop (cosr x)) (zerop (sinr x))) 0)

;-------------------------------
; SINd
; Returns sin of DEGREE argument
; Syntax: (sind )
;-------------------------------

;-------------------------------
; COSd
; Returns cos of DEGREE argument
; Syntax: (cosd )
;-------------------------------

;---------------------------------------
; TANd
; Returns the tangent of DEGREE argument
; Syntax: (tand )
;---------------------------------------
(defun tand (d)
(cond
((or (zerop (cosd d)) (zerop (sind d))) 0)

;-----------------------------
; INVERSE functions
; (___d) in degrees.
;-----------------------------

(defun secd (d) (adjdeg (invert (cosd d))))

(defun cscd (d) (adjdeg (invert (sind d))))

(defun cotd (d) (adjdeg (invert (tand d))))

;--------------------------
; DERIVITIVE functions
;--------------------------
(defun sin_prime (x) (cosr x))

(defun cos_prime (x) (neg (sinr x)))

;------------------------------------------------
; DOUBLE and HALF angles formulas.
; To use degrees use (d2r d) as the arguments.
; To have the return in degrees nest the function
; inside (r2d (<. . .>))
;-------------------------------------------------
(defun sinA+B (a b)

(defun sinA-B (a b)
(chkman (adjrad (diff (** (sinr a) (cosr b)) (** (cosr a) (sinr b))))))

(defun cosA+B (a b)
(chkman (adjrad (diff (** (cosr a) (cosr b)) (** (sinr a) (sinr b))))))

(defun cosA-B (a b)

(defun tanA+B (a b)
(cond
((zerop (cosA+B a b)) 0)

(defun tanA-B (a b)
(cond
((zerop (cosA-B a b)) 0)

(defun sin2A (a)

(defun cos2A (a)

(defun tan2A (a)
(cond
((zerop (cos2A a)) 0)

(defun sinhalfA (a)

(defun coshalfA (a)

(defun tanhalfA (a)
(cond
((zerop (coshalfA a)) 0)

;-------------------------
; MISC functions
;-------------------------

(defun invert (x) ;returns 1/x
(cond ((zerop x) 0) (t (chkman (// 1 x)))))

(defun neg (x) (** -1 x)) ;returns -x

(defun // fexpr(l) (eval (cons 'quotient l))) ;shorthand div. of floats

(defun ** fexpr(l) (eval (cons 'times l))) ;shorthand mult. of floats

(defun chkman (x) ;returns nearest whole number if
(cond ;fraction is very small or large
((< (abs (diff (abs x) (abs (round x)))) 0.00001)
(round x))
(t x)))

(defun round (x) ;rounding function
(cond
((zerop x) 0)
((plusp x)
(cond
((< (diff x (fix x)) .5) (fix x))
(t (cond
((< (diff (abs x) (fix (abs x))) .5) (fix x))
(t (neg (diff 1 (fix x))))))))

(defun gint (x) ;greatest integer function
(cond
((zerop x) 0)
((plusp x) (fix x))
((minusp x)
(cond
((= x (fix x)) x)
(t (diff (fix x) 1))))
(t x)))

(defun rangep (a x b) ;true if a <= x <= b
(cond
((and (not (< x a)) (not (> x b))) t)
(t nil)))



### 3 Responses to “Category : Miscellaneous Language Source CodeArchive   : PCLISP30.ZIPFilename : MATH.L”

1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/