-
Notifications
You must be signed in to change notification settings - Fork 9
/
bt-maths.scm
93 lines (87 loc) · 3.01 KB
/
bt-maths.scm
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
;; This file is part of Bintracker.
;; Copyright (c) utz/irrlicht project 2019-2020
;; See LICENSE for license details.
;;; Mathematical helper procedures.
(module bt-maths
*
(import scheme (chicken base) (chicken string)
srfi-1)
;;; Scale the list of FIELD-VALUES to fill the integer range AMIN,AMAX. See
;;; also `fit-to-range`.
(define (scale-values field-values amin amax)
(let ((rmin (min amin amax))
(rmax (max amin amax)))
(if (every null? field-values)
field-values
(let ((minval (apply min (remove null? field-values)))
(maxval (apply max (remove null? field-values))))
(map (lambda (x)
(if (null? x)
'()
(if (= minval maxval)
(cond
((< x rmin) minval)
((> x rmax) maxval)
(else x))
(inexact->exact (round (+ (/ (* (- rmax rmin)
(- x minval))
(- maxval minval))
rmin))))))
field-values)))))
;;; Scale down the list of FIELD-VALUES so that its contents fit into the
;;; range AMIN,AMAX. Unlike `scale-values`, this only scales down so that all
;;; values fit into the range, it does not increase spread, eg:
;;;
;;; (scale-values '(63 64) 0 63) => '(0 63)
;;; (fit-to-range '(64 64) 0 63) => '(62 63)
(define (fit-to-range field-values amin amax)
(cddr (scale-values (cons amin (cons amax field-values))
amin
amax)))
;;; Interpolate the list of integer values VALS. The input list may contain
;;; `null` values. By default, linear interpolation is used. This may be
;;; overridden by specifying TYPE. Currently, the only other available
;;; interpolation type is `cosine`.
(define (interpolate vals #!optional (type 'linear))
(cond
((< (length (remove null? vals)) 2) vals)
((null? (car vals))
(append (take-while null? vals)
(interpolate (drop-while null? vals) type)))
(else
(case type
((linear)
(let ((start-val (car vals))
(end-val (car (drop-while null? (cdr vals))))
(len (+ 1 (length (take-while null? (cdr vals))))))
(if (< len 2)
(cons start-val (interpolate (cdr vals) type))
(append
(cons start-val
(map (o inexact->exact round)
(iota (sub1 len)
(+ start-val (/ (- end-val start-val) len))
(/ (- end-val start-val) len))))
(interpolate (drop vals len) type)))))
((cosine)
(let* ((start-val (car vals))
(end-val (car (drop-while null? (cdr vals))))
(len (+ 1 (length (take-while null? (cdr vals)))))
(cosine-interpolate
(lambda (mu)
(let ((mu2 (/ (- 1 (cos (* mu 3.1415926535)))
2)))
(inexact->exact (round (+ (* start-val (- 1 mu2))
(* end-val mu2))))))))
(if (< len 2)
(cons start-val (interpolate (cdr vals) type))
(append
(cons start-val
(map cosine-interpolate (iota (sub1 len) 0 (/ 1 len))))
(interpolate (drop vals len) type)))))
;; spline, trigonometric
((polynominal) vals)
(else (error 'interpolate
(string-append "Unknown interpolation type "
(->string type))))))))
) ;; end module bt-maths