Commit 11103f64 authored by Liam M. Healy's avatar Liam M. Healy

Add #'nanp, #'with-new-units, #'length-law-of-cosines

parent dce41413
;; Generic functions arithmetic functions on generalized numbers
;; Liam Healy Tue Feb 9 1999 - 21:38
;; Time-stamp: <2017-09-13 16:42:19CDT generic.lisp>
;; Time-stamp: <2017-12-16 16:12:51EST generic.lisp>
;; Copyright 2011, 2013, 2014, 2015, 2017 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
......@@ -57,6 +57,11 @@
(let ,lets
,@body))))
;;; Test
(defgeneric nanp (x)
(:method ((x number)) (/= x x)))
;;;;****************************************************************************
;;;; Dyadic functions
;;;;****************************************************************************
......@@ -171,18 +176,20 @@
(defgeneric acos (arg)
(:documentation "The arccosine of the generalized or regular number.")
(:method ((arg number))
(when (and (not (complexp arg)) (> (abs arg) 1))
(restart-case
(error 'making-complex-number :operation 'acos :number arg)
(accept () :report "Accept complex answer.")
(truncate ()
:report "Truncate argument to ±1."
(return-from acos
(if (plusp arg) (cl:acos 1.0d0) (cl:acos -1.0d0))))
(hyperbolic-function ()
:report "Use the inverse hyperbolic cosine."
(return-from acos (cl:acosh arg)))))
(make-radian (cl:acos arg))))
(if (nanp arg)
arg
(if (and (not (complexp arg)) (> (abs arg) 1))
(restart-case
(error 'making-complex-number :operation 'acos :number arg)
(accept () :report "Accept complex answer.")
(truncate ()
:report "Truncate argument to ±1."
(return-from acos
(if (plusp arg) (cl:acos 1.0d0) (cl:acos -1.0d0))))
(hyperbolic-function ()
:report "Use the inverse hyperbolic cosine."
(return-from acos (cl:acosh arg))))
(make-radian (cl:acos arg))))))
(defgeneric atan (num &optional den default zero-enough)
(:documentation "The arctangent of the generalized or regular number. If absolute value of the arguments are below zero-enough, default is returned.")
......
;; Trigonometric functions
;; Liam Healy Wed Dec 7 2005 - 22:53
;; Time-stamp: <2011-01-18 15:46:56EST trigonometry.lisp>
;; Time-stamp: <2017-11-17 17:57:20EST trigonometry.lisp>
;; Copyright 2017 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
;;
;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;;
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
(in-package :antik)
(export '(angle-law-of-cosines))
(export '(angle-law-of-cosines length-law-of-cosines))
(defun angle-law-of-cosines
(length-opp length-adj1 length-adj2)
"Solve for the angle when lengths of a triangle are known."
(acos (/ (+ (expt length-adj1 2) (expt length-adj2 2)
(- (expt length-opp 2)))
(* 2 length-adj1 length-adj2))))
(- (expt length-opp 2)))
(* 2 length-adj1 length-adj2))))
(defun length-law-of-cosines
(angle length-adj1 length-adj2)
"Solve for the opposite length when angle and adjacent lengths of a triangle are known."
(sqrt (+ (expt length-adj1 2)
(expt length-adj2 2)
(* -2 length-adj1 length-adj2 (cos angle)))))
;; Functions on angles
;; Liam Healy Fri Mar 26 1999 - 13:48
;; Time-stamp: <2015-01-01 13:20:21EST angle.lisp>
;; Time-stamp: <2017-11-17 17:52:32EST angle.lisp>
;; Copyright 2011, 2013, 2014 Liam M. Healy
;; Copyright 2011, 2013, 2014, 2017 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
;;
;; This program is free software: you can redistribute it and/or modify
......@@ -132,7 +132,7 @@
"The angle as a list degrees, minutes, seconds."
(let ((*print-circle* nil))
(multiple-value-bind (degrees dfrac)
(cl:floor (with-system-of-units (degree) (pqval (antik:abs angle))))
(cl:floor (with-system-of-units (nil degree) (pqval (antik:abs angle))))
(multiple-value-bind (mins mfrac)
(cl:floor (cl:* 60 dfrac))
(list
......
;; Arithmetic with physical dimension quantities.
;; Liam Healy Fri Apr 22 2005 - 09:58
;; Time-stamp: <2015-12-17 15:49:44EST arithmetic.lisp>
;; Time-stamp: <2017-11-17 17:07:48EST arithmetic.lisp>
;; Copyright 2011, 2013, 2015 Liam M. Healy
;; Copyright 2011, 2013, 2015, 2017 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
;;
;; This program is free software: you can redistribute it and/or modify
......@@ -22,6 +22,8 @@
(export '(flatten-angle))
(defmethod nanp ((x physical-quantity)) (nanp (pq-magnitude x)))
(defgeneric flatten-angle (object)
(:documentation
"Remove the angular dimension; the number is not changed
......
;; Define physical dimensions and units of measure and systems of units.
;; Liam Healy Wed Feb 27 2002 - 13:18
;; Time-stamp: <2015-04-20 12:51:32EDT units.lisp>
;; Time-stamp: <2017-11-17 16:59:08EST units.lisp>
;; Copyright 2011, 2013, 2015 Liam M. Healy
;; Copyright 2011, 2013, 2015, 2017 Liam M. Healy
;; Distributed under the terms of the GNU General Public License
;;
;; This program is free software: you can redistribute it and/or modify
......@@ -28,6 +28,7 @@
define-system-of-units
set-system-of-units
with-system-of-units
with-new-units
with-si-units
dimensionless))
......@@ -222,6 +223,10 @@
(:system-of-units (make-sysunits ',units ',system-of-units))
,@body))
(defmacro with-new-units ((&rest units) &body body)
"Augment the current system of units with the named units."
`(with-system-of-units (nil ,@units) ,@body))
(defmacro with-si-units (&body body)
"Use the SI system of units in the body."
`(with-system-of-units (si) ,@body))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment