This revised patch documents the limitations of this module and adds more unit 
tests.
I've also changed the functions to short-circuit only results that are 
rational, since
the exactness property is already lost in any case when the square roots are 
irrational.

>From 5eb3be7ce0781068d8e0030c4e51e6f28d37e96e Mon Sep 17 00:00:00 2001
From: AwesomeAdam54321 <adam.f...@disroot.org>
Date: Sun, 16 Feb 2025 12:47:18 +0800
Subject: [PATCH v2] src: (math trigonometry): Add it.

* src/math/trigonometry.scm: New file.
* doc/guile-library.scm: Document it in the manual.
* unit-tests/math.trigonometry.scm: New unit test.
* src/Makefile.am: Register module.
* unit-tests/Makefile.am: Register unit test.
---
 doc/guile-library.scm            |   2 +
 src/Makefile.am                  |   1 +
 src/math/trigonometry.scm        | 132 +++++++++++++++++++++++++++++++
 unit-tests/Makefile.am           |   1 +
 unit-tests/math.trigonometry.scm |  69 ++++++++++++++++
 5 files changed, 205 insertions(+)
 create mode 100644 src/math/trigonometry.scm
 create mode 100644 unit-tests/math.trigonometry.scm

diff --git a/doc/guile-library.scm b/doc/guile-library.scm
index 496c283..d9593b7 100644
--- a/doc/guile-library.scm
+++ b/doc/guile-library.scm
@@ -102,6 +102,8 @@ License\".")
      "A golden-section minimum finder")
     ((math primes)
      "Functions related to prime numbers and factorization")
+    ((math trigonometry)
+     "Functions related to motion trigonometry")
     ((os process)
      "Spawning processes and capturing their output")
     ((scheme documentation)
diff --git a/src/Makefile.am b/src/Makefile.am
index 889a575..507bbab 100644
--- a/src/Makefile.am
+++ b/src/Makefile.am
@@ -86,6 +86,7 @@ SOURCES = \
        logging/rotating-log.scm        \
        math/minima.scm                 \
        math/primes.scm                 \
+       math/trigonometry.scm           \
        match-bind.scm                  \
        md5.scm                         \
        os/process.scm                  \
diff --git a/src/math/trigonometry.scm b/src/math/trigonometry.scm
new file mode 100644
index 0000000..00791d2
--- /dev/null
+++ b/src/math/trigonometry.scm
@@ -0,0 +1,132 @@
+;; (math trigonometry) -- More exact trigonometry for motion
+;; Copyright (C) 2025  Adam Faiz <adam.f...@disroot.org>
+
+;; 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/>.
+
+
+;;; Commentary:
+;;
+;; @cindex normalise angle
+;; @cindex sine
+;; @cindex cosine
+;; @cindex tangent
+;; @cindex arcsine
+;; @cindex arccosine
+;; @cindex arctan
+;; @cindex arctan2
+;; @cindex angle, normalised
+;; @cindex angle, sine of
+;; @cindex angle, cosine of
+;; @cindex angle, tangent of
+;; @cindex sine, inverse of
+;; @cindex cosine, inverse of
+;; @cindex tangent, inverse of
+;; This module defines trigonometry functions for an angle(given in degrees),
+;; as more flexible versions of the trigonometry functions in Guile.
+;; They return exact values for the special angles, regardless of whether
+;; they're negative or how many rotations occurred.
+;; Currently, only angles as real degrees are supported.
+;; When dealing with imaginary parts, radians have more convenient properties
+;; anyway.
+;;
+;;; Code:
+
+(define-module (math trigonometry)
+  #:use-module (scheme documentation)
+  #:export (pi
+            deg->rad
+            rad->deg
+            normalise-angle
+            sine
+            cosine
+            tangent
+            arcsine
+            arccosine
+            arctan
+            arctan2))
+
+(define pi (* 2 (acos 0)))
+
+(define (deg->rad degrees)
+  "Convert an angle in degrees to radians."
+  (* degrees (/ pi 180)))
+
+(define (rad->deg radians)
+  "Convert an angle in radians to degrees."
+  (* radians (/ 180 pi)))
+
+(define (normalise-angle angle)
+  "Return a normalised angle where 0 <= angle < 360."
+  (floor-remainder angle 360))
+
+(define (sine degrees)
+  "Calculate the sine of an angle."
+  (define angle (normalise-angle degrees))
+  (cond ((or (= angle 0) (= angle 180)) 0)
+        ((or (= angle 30) (= angle 150)) 1/2)
+        ((= angle 90) 1)
+        ((or (= angle 210) (= angle 330)) -1/2)
+        ((= angle 270) -1)
+        (else (sin (deg->rad angle)))))
+
+(define (cosine degrees)
+  "Calculate the cosine of an angle."
+  (define angle (normalise-angle degrees))
+  (cond ((= angle 0) 1)
+        ((or (= angle 60) (= angle 300)) 1/2)
+        ((or (= angle 90) (= angle 270)) 0)
+        ((or (= angle 120) (= angle 240)) -1/2)
+        ((= angle 180) -1)
+        (else (cos (deg->rad angle)))))
+
+(define (tangent angle)
+  "Calculate the tangent of an angle."
+  (/ (sine angle) (cosine angle)))
+
+(define (arcsine value)
+  "Calculate the smallest angle from the given sine value."
+  (cond ((= value 0) 0)
+        ((= value 1/2) 30)
+        ((= value 1) 90)
+        ((= value -1/2) 210)
+        ((= value -1) 180)
+        (else (rad->deg (asin value)))))
+
+(define (arccosine value)
+  "Calculate the smallest angle from the given cosine value."
+  (cond ((= value 1) 0)
+        ((= value 1/2) 60)
+        ((= value 0) 90)
+        ((= value -1/2) 120)
+        ((= value -1) 180)
+        (else (rad->deg (acos value)))))
+
+(define (arctan value)
+  "Calculate the smallest angle from the given tangent value."
+  (cond ((= value 0) 0)
+        ((= value 1) 45)
+        ((= value -1) 135)
+        (else (rad->deg (atan value)))))
+
+(define (arctan2 y x)
+  "Calculate the arc tangent from 2 coordinate components, y and x."
+  (cond ((zero? x)
+         (let ((sign (if (positive? y) + -)))
+           (sign 90)))
+        (else
+         (let ((arc-shift
+                (cond ((positive? x) 0)
+                      ((and (negative? x) (>= y 0)) 180)
+                      ((and (negative? x) (negative? y)) -180))))
+           (+ (arctan (/ y x)) arc-shift)))))
diff --git a/unit-tests/Makefile.am b/unit-tests/Makefile.am
index 00530ca..0a7ab37 100644
--- a/unit-tests/Makefile.am
+++ b/unit-tests/Makefile.am
@@ -58,6 +58,7 @@ TESTS= \
        match-bind.scm                  \
        math.minima.scm                 \
        math.primes.scm                 \
+       math.trigonometry.scm           \
        md5.scm                         \
        os.process.scm                  \
        search.basic.scm                \
diff --git a/unit-tests/math.trigonometry.scm b/unit-tests/math.trigonometry.scm
new file mode 100644
index 0000000..956e5c9
--- /dev/null
+++ b/unit-tests/math.trigonometry.scm
@@ -0,0 +1,69 @@
+;;; ----------------------------------------------------------------------
+;;;    unit test
+;;;    Copyright (C) 2025 Adam Faiz <adam.f...@disroot.org>
+;;;
+;;;    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/>.
+;;; ----------------------------------------------------------------------
+
+(use-modules (math trigonometry)
+             (unit-test)
+             (oop goops))
+
+;; **********************************************************************
+;; Test of trigonometry
+;; **********************************************************************
+(define-class <test-trigonometry> (<test-case>)
+  (angles #:accessor test-angles)
+  (x-coords #:accessor test-x-values)
+  (y-coords #:accessor test-y-values))
+
+(define-method (set-up-test (self <test-trigonometry>))
+  (set! (test-angles self)
+        (list -720 -360 -270 -180 -90 -60 -45 -30 -15 -0
+              0     15   30   45   60  90 180 270 360 720))
+  (set! (test-y-values self)
+        (list 1 -1 -1 0  0 1/2 1/3 1/4 1/3 1/2))
+  (set! (test-x-values self)
+        (list 0  0 -1 1 -1 1/3 1/4 1/3 1/2 1)))
+
+(define (within-margin? value estimate)
+  (define margin 0.001)
+  (< (sqrt (expt (- value estimate) 2)) margin))
+
+(define (assert-estimates results estimates)
+  (not (member #f (map within-margin? results estimates))))
+
+(define-method (test-sine (self <test-trigonometry>))
+  (assert-estimates (map sine (test-angles self))
+                    (list 0 0     1   0     -1    -0.866 -0.707 -1/2 -0.259 0 
+                          0 0.259 1/2 0.707  0.866 1      0     -1    0     
0)))
+
+(define-method (test-cosine (self <test-trigonometry>))
+  (assert-estimates (map cosine (test-angles self))
+                    (list 1 1     0     -1    0    1/2   0.707 0.866 0.966 1
+                          1 0.966 0.866 0.707 1/2  0     -1    0     1     1)))
+
+(define-method (test-arcsine (self <test-trigonometry>))
+  (assert-estimates (map (lambda (t) (normalise-angle (arcsine (sine t)))) 
(test-angles self))
+                    (map normalise-angle (test-angles self))))
+
+(define-method (test-arccosine (self <test-trigonometry>))
+  (assert-estimates (map (lambda (t) (normalise-angle (arccosine (sine t)))) 
(test-angles self))
+                    (map normalise-angle (test-angles self))))
+
+(define-method (test-arctan2 (self <test-trigonometry>))
+  (assert-estimates (map arctan2 (test-y-values self) (test-x-values self))
+                    (list 90 -90 -135 0 180 56.31 53.13 36.87 33.69 26.57)))
+
+(exit-with-summary (run-all-defined-test-cases))
-- 
2.46.0

Reply via email to