misc-code/solve-triangle.lisp

;;;; solve-triangle.lisp
(defpackage #:solve-triangle
  (:use :cl)
  (:export #:solve-asa
           #:solve-ssa))

(in-package #:solve-triangle)

;; SAA, ASA -- Law of Sines
;; SSA -- Law of Sines, (or 0 1 2) solutions
;; SAS -- Law of Cosines
;; SSS -- Law of Cosines

(defun between-p (lower number upper)
  (and (>= number lower)
     (<= number upper)))

(defun solve-asa (anglea sidea angleb)
  "Solve a ASA triangle using the method of sines.  Angles assumed to be in degrees."
  (let* ((anglec (- 180 anglea angleb))
         (sideb (/ (* (sin angleb)
                      sidea)
                   (sin anglea)))
         (sidec (/ (* (sin anglec)
                      sidea)
                   (sin anglea))))
    (list :angle-a anglea
          :angle-b angleb
          :angle-c anglec
          :side-a sidea
          :side-b sideb
          :side-c sidec)))

(defun solve-ssa (sidea sideb anglea)
  "Solve an SSA triangle using the method of sines.  Angles are assumed to be in degrees."
  (let ((sinb (/ (* sideb (sin anglea))
                 sidea)))
    (if (between-p -1 sinb 1)
        (let* ((angleb (asin sinb))
               (anglec (- 180 anglea angleb))
               (sidec (asin (/ (* (sin anglec) sidea)
                               (sin anglea)))))
          (if (< (+ anglea angleb))
              (let* ((angleb-prime (- 180 angleb))
                     (anglec-prime (- 180 anglea angleb-prime))
                     (sidec-prime (/ (* (sin anglec-prime) sidea)
                                     (sin anglea))))
                (values (list :angle-a anglea
                            :angle-b angleb
                            :angle-c anglec
                            :side-a sidea
                            :side-b sideb
                            :sidec sidec)
                        (list :angle-a anglea
                              :angle-b angleb-prime
                              :angle-c anglec-prime
                              :sidea sidea
                              :sideb sideb
                              :sidec sidec-prime)))
              (values (list :angle-a anglea
                            :angle-b angleb
                            :angle-c anglec
                            :side-a sidea
                            :side-b sideb
                            :sidec sidec)
                      nil)))
        (values nil nil))))