-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathexpand-trig.rkt
100 lines (84 loc) · 3.13 KB
/
expand-trig.rkt
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
94
95
96
97
98
99
100
#lang racket/base
;;;; This file has been changed from its original dharmatech/mpl version.
(provide expand-trig)
(require "misc.rkt"
"arithmetic.rkt"
"sin.rkt"
"cos.rkt")
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (binomial-coefficient n k)
(cond ( (= k 0) 1 )
( (= n k) 1 )
( else
(+ (binomial-coefficient (- n 1)
(- k 1))
(binomial-coefficient (- n 1)
k)) )))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (sigma f a b step)
(let loop ((a a) (sum 0))
(if (> a b)
sum
(loop (+ a step)
(+ sum (f a))))))
(define (multiple-angle-sin n angle)
(let ((f (if (sum? angle)
(expand-trig-rules angle)
(list (sin angle)
(cos angle)))))
(let ((sin-angle (list-ref f 0))
(cos-angle (list-ref f 1)))
(let ((sign (if (< n 0) -1 1))
(n (abs n)))
(* sign
(sigma (lambda (j) (* (^ -1 (/ (- j 1) 2))
(binomial-coefficient n j)
(^ cos-angle (- n j))
(^ sin-angle j)))
1 n 2))))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (multiple-angle-cos n angle)
(let ((f (if (sum? angle)
(expand-trig-rules angle)
(list (sin angle)
(cos angle)))))
(let ((sin-angle (list-ref f 0))
(cos-angle (list-ref f 1)))
(let ((n (abs n)))
(sigma (lambda (j) (* (^ -1 (/ j 2))
(binomial-coefficient n j)
(^ cos-angle (- n j))
(^ sin-angle j)))
0 n 2)))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (expand-trig-rules A)
(cond ( (sum? A)
(let ((f (expand-trig-rules (list-ref A 1)))
(r (expand-trig-rules (- A (list-ref A 1)))))
(let ((s (+ (* (list-ref f 0)
(list-ref r 1))
(* (list-ref f 1)
(list-ref r 0))))
(c (- (* (list-ref f 1)
(list-ref r 1))
(* (list-ref f 0)
(list-ref r 0)))))
(list s c))) )
( (and (product? A)
(integer? (list-ref A 1)))
(let ((f (list-ref A 1)))
(list (multiple-angle-sin f (/ A f))
(multiple-angle-cos f (/ A f)))) )
( else (list (sin A)
(cos A)) )))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Original version from book
(define (expand-trig u)
(if (or (number? u)
(symbol? u))
u
(let ((v (map expand-trig u)))
(case (operator-kind u)
( (sin) (list-ref (expand-trig-rules (list-ref v 1)) 0) )
( (cos) (list-ref (expand-trig-rules (list-ref v 1)) 1) )
( else v )))))