;;;; math-utils-test.scm -*- Scheme -*- ;;;; Kon Lovett, Oct '22 (import test) (test-begin "Math Utils") ;;; (import math-utils) (import (chicken fixnum) (chicken random)) ;; (define (fibonacci/naive n) (case n ((0) 0) ((1) 1) (else (+ (fibonacci/naive (- n 1)) (fibonacci/naive (- n 2)))) ) ) (test-group "seqs" (define (fxrand #!optional (rng most-positive-fixnum)) (pseudo-random-integer rng)) (test "true fib" (fibonacci/naive 10) (fibonacci 10)) (test "approx fib" (fibonacci/naive 10) (inexact->exact (floor (*fibonacci 10)))) (test 3628800 (factorial 10)) ;https://en.wikipedia.org/wiki/Falling_and_rising_factorials (let ((thernd (fxrand))) (test 1 (factorial- thernd 0)) (test 1 (factorial+ thernd 0)) (test thernd (factorial- thernd 1)) (test thernd (factorial+ thernd 1)) (test (- (square thernd) thernd) (factorial- thernd 2)) (test (+ (square thernd) thernd) (factorial+ thernd 2)) ;quit while ahead (test (+ (- (expt thernd 4) (* 6 (cube thernd))) (- (* 11 (square thernd)) (* 6 thernd))) (factorial- thernd 4)) (test (+ (expt thernd 4) (* 6 (cube thernd)) (* 11 (square thernd)) (* 6 thernd)) (factorial+ thernd 4)) ) (test 137/60 (harmonic 4)) ) (define (approx-points b e pts) (map (lambda (c) (cons (exact->inexact (car c)) (exact->inexact (round (+ (* b (car c)) e))))) pts)) (test-group "stats" (define area-3ln (trapezoid (lambda (x) (* 3 (log x))) 3 4)) (define some-pts '((0 . 0) (1 . 2) (2 . 4) (3 . 8) (4 . 16))) (define data-pts '((1.47 . 52.21) (1.50 . 53.12) (1.52 . 54.48) (1.55 . 55.84) (1.57 . 57.20) (1.60 . 58.57) (1.63 . 59.93) (1.65 . 61.29) (1.68 . 63.11) (1.70 . 64.47) (1.73 . 66.28) (1.75 . 68.10) (1.78 . 69.92) (1.80 . 72.19) (1.83 . 74.46))) (define data-pts/exact (map (lambda (x) (cons (inexact->exact (car x)) (inexact->exact (cdr x)))) data-pts)) (test-assert (procedure? area-3ln)) (test 3.7478 (area-3ln 10)) (test 3.7480 (area-3ln 10000)) (test 1 (average 1)) (test 2 (average 1 3)) (test 3 (average 1 3 5)) (test 9/2 (average 4 5)) (test 9/2 (average 4 5 4 5)) (test 70 (binomial 8 4)) (test-group "Least Squares" (define (average-least-squares-error m e pts) (/ (foldl (lambda (r pt) (+ r (- (cdr pt) (+ (* m (car pt)) e)))) 0 pts) (length pts)) ) (receive (m e) (least-squares some-pts) (test 0 (average-least-squares-error m e some-pts)) ) (receive (m e) (least-squares data-pts) (test 0.0 (average-least-squares-error m e data-pts)) ) ) ;https://en.wikipedia.org/wiki/Cross-ratio (test-group "Cross Ratio (identity)" (let* ((a 1) (b 2) (c 3) (d 4) (l (cross-ratio a b c d))) (test 4/3 l) (test (/ 1 l) (cross-ratio a b d c)) (test (/ 1 (- 1 l)) (cross-ratio a c d b)) (test (- 1 l) (cross-ratio a c b d)) (test (/ l (- l 1)) (cross-ratio a d c b)) (test (/ (- l 1) l) (cross-ratio a d b c)) ) ) ) (test-group "interest" (test 1758.0 (simple-interest 0.043 4 1500)) (test 1887.0 (simple-interest 0.043 6 1500)) (test 1780.42 (compound-interest 0.043 6 4 1500)) (test 1938.84 (compound-interest 0.043 4 6 1500)) ) (test-group "log-with-base" (define log256 (log-with-base 256)) (test-assert (procedure? log256)) (test "log/base 256" 9 (inexact->exact (round (log256 995972255318008407568)))) ) (test-group "coprime" (test-assert (coprime? 2 1)) (test-assert (coprime? 3 1)) (test-assert (coprime? 81 19)) (test-assert (coprime? 1 1)) (test-assert (not (coprime? 9 3))) (test-assert (coprime? (* 3 7) (* 5 19))) (test-assert (not (coprime? (* 3 7 5) (* 5 19 2)))) (test-assert (coprime? 6 10 15)) ) (test-group "pairwise coprime" (test-assert (pairwise-coprime? 10 7 33 13)) (test-assert (not (pairwise-coprime? 10 7 33 14))) (test-assert (not (pairwise-coprime? 6 10 15))) ) (test-group "*coprime" (test-assert (fxcoprime? 2 1)) (test-assert (fxcoprime? 3 1)) (test-assert (fxcoprime? 81 19)) (test-assert (fxcoprime? 1 1)) (test-assert (not (fxcoprime? 9 3))) (test-assert (fxcoprime? (* 3 7) (* 5 19))) (test-assert (not (fxcoprime? (* 3 7 5) (* 5 19 2)))) ) (test-group "to-places" (test 3.141 (to-places 3 (truncate (acos -1)))) (test 3.0 (to-places 0 (truncate (acos -1)))) (test 3.14159 (to-places 5 (truncate (acos -1)))) ) ;;; (test-end "Math Utils") (test-exit)