source: project/release/4/parametric-curve/trunk/tests/run.scm @ 30630

Last change on this file since 30630 was 30630, checked in by Ivan Raikov, 7 years ago

parametric-curve: more work on fold routines

File size: 4.7 KB
Line 
1(use numbers srfi-4 parametric-curve)
2
3(define machine-epsilon
4  (let loop ((e 1.0))
5     (if (= 1.0 (+ e 1.0))
6         (* 2 e)
7         (loop (/ e 2)))))
8
9(printf "machine-epsilon = ~A~%" machine-epsilon)
10
11(define my-c (linear-curve 3 '((0 3) (0 4) (1 0)) 0 20))
12(define my-scaled-c (scale-curve '(1. 1. 5.) my-c))
13
14(print "machine-epsilon = " machine-epsilon)
15
16(define my-c (linear-curve 4 '((1 3) (1 4) (1 0)) 0 20))
17
18(printf "my-c (5) = ~A~%" ((sample-curve my-c) 5))
19(printf "my-c (0,5,10,15,20) = ~A~%" ((sample-curve* my-c) (list 0 5 10 15 20)))
20(printf "my-c bbox = ~A~%" (bbox-curve my-c))
21
22(assert (every (lambda (x y) 
23                 (printf "x = ~A y = ~A abs (x-y) = ~A~%" x y (abs (- x y) ))
24                 (<= (abs (- x y)) machine-epsilon))
25               ((sample-curve my-c) 1.) (list 4. 5. 1.)))
26
27(assert (every
28         (lambda (xv yv) 
29           (every (lambda (x y) 
30                    (printf "x = ~A y = ~A abs (x-y) = ~A~%" x y (abs (- x y) ))
31                    (<= (abs (- x y)) machine-epsilon))
32                (f64vector->list xv) (f64vector->list yv)))
33
34         ((sample-curve* my-c) (list 0. 5. 10. 15. 20.)) 
35         (list (f64vector 3.0 8.0 13.0 18.0 23.0)
36               (f64vector 4.0 9.0 14.0 19.0 24.0)
37               (f64vector 0.0 5.0 10.0 15.0 20.0)
38               )))
39
40(define my-scaled-c (scale-curve '(1. 1. 5.) my-c))
41
42(printf "my-scaled-c (5) = ~A~%" ((sample-curve my-scaled-c) 5))
43(printf "my-scaled-c (0,5,10,15,20) = ~A~%" ((sample-curve* my-scaled-c) (list 0 5 10 15 20)))
44(printf "my-scaled-c bbox = ~A~%" (bbox-curve my-scaled-c))
45
46(assert (every (lambda (x y)
47                 (printf "x = ~A y = ~A abs (x-y) = ~A~%" x y (abs (- x y) ))
48                 (<= (abs (- x y)) machine-epsilon))
49               ((sample-curve my-scaled-c) 1.) 
50               (list 4. 5. 5.)))
51(assert (every
52         (lambda (xv yv) (map (lambda (x y) (< (abs (- x y)) machine-epsilon)) 
53                              (f64vector->list xv) (f64vector->list yv)))
54         ((sample-curve* my-c) (list 0 5 10 15 20)) 
55         (list (f64vector 3.0 3.0 3.0 3.0 3.0)
56               (f64vector 4.0 4.0 4.0 4.0 4.0)
57               (f64vector 0.0 5.0 10.0 15.0 20.0)
58               )))
59
60(assert (every (lambda (x y) 
61                 (printf "x = ~A y = ~A abs (x-y) = ~A~%" x y (abs (- x y) ))
62                 (< (abs (- x y)) machine-epsilon))
63               (list 8. 9. 25.)
64               ((sample-curve my-scaled-c) 5) 
65               ))
66
67(assert (every
68         (lambda (xv yv) (map (lambda (x y) (< (abs (- x y)) machine-epsilon)) 
69                              (f64vector->list xv) (f64vector->list yv)))
70         ((sample-curve* my-scaled-c) (list 0 5 10 15 20)) 
71         (list (f64vector 3.0 3.0 3.0 3.0 3.0)
72               (f64vector 4.0 4.0 4.0 4.0 4.0)
73               (f64vector 0.0 25.0 50.0 75.0 100.0)
74               )))
75
76(printf "my-scaled-c = ~A~%" my-scaled-c)
77
78(printf "iterate my-scaled-c = ~A~%" (iterate-curve my-scaled-c 5))
79
80
81(printf "fold my-scaled-c = ~A~%" 
82        (fold-curve my-scaled-c 5 
83           (list (lambda (x init) (* x 10))
84                 (lambda (x init) (* x 20))
85                 (lambda (x init) (* x 30)))
86           (list '() '() '())
87           ))
88
89
90(define s (line-segment 3 (list 1 2 3)))
91
92(printf "line segment = ~A~%" s)
93
94(printf "line segment arc length (analytical) = ~A~%" (sqrt (+ 9 4 1)))
95(printf "line segment arc length (step = 0.1) = ~A~%" (arc-length s 0.1))
96
97(printf "iterate line segment = ~A~%" (iterate-curve s 5))
98
99(define ts (translate-curve (list 4 5 6) s))
100
101(printf "translated line segment = ~A~%" ts)
102
103(printf "iterate translated line segment = ~A~%" (iterate-curve ts 5))
104
105(printf "iterate translated line segment = ~A~%" (iterate-curve ts 2))
106
107
108(define (Rx theta)
109  (list (f64vector 1 0 0)
110        (f64vector 0 (cos theta) (sin theta))
111        (f64vector 0 (- (sin theta)) (cos theta))
112        ))
113
114(define (Ry theta)
115  (list (f64vector (cos theta) 0 (- (sin theta)))
116        (f64vector 0 1 0)
117        (f64vector (sin theta) 0 (cos theta))
118        ))
119
120(define (Rz theta)
121  (list (f64vector (cos theta) (sin theta) 0)
122        (f64vector (- (sin theta)) (cos theta) 0)
123        (f64vector 0 0 1)
124        ))
125
126(define (transform a v)
127  (let ((r1 (map (lambda (u) (f64vector-ref u 0)) a))
128        (r2 (map (lambda (u) (f64vector-ref u 1)) a))
129        (r3 (map (lambda (u) (f64vector-ref u 2)) a)))
130    (list (fold + 0.0 (map * r1 v))
131          (fold + 0.0 (map * r2 v))
132          (fold + 0.0 (map * r3 v)))
133    ))
134
135(define segrx (line-segment 3 (transform (Rx 60) (list 1 1 1))))
136(printf "x rotated segment (0,1) = ~A~%" ((sample-curve* segrx) (list 0 0.5 1)))
137(define segry (line-segment 3 (transform (Ry 60) (list 1 1 1))))
138(printf "y rotated segment (0,1) = ~A~%" ((sample-curve* segry) (list 0 0.5 1)))
139(define segrz (line-segment 3 (transform (Rz 60) (list 1 1 1))))
140(printf "z rotated segment (0,1) = ~A~%" ((sample-curve* segrz) (list 0 0.5 1)))
Note: See TracBrowser for help on using the repository browser.