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

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

parametric-curve: another attempt at perturbation functionality

File size: 4.5 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
52(assert (every (lambda (x y) (print (abs (- x y))) (< (abs (- x y)) machine-epsilon))
53               ((sample-curve my-c) 5) (list 3. 4. 5.)))
54
55(assert (every
56         (lambda (xv yv) (map (lambda (x y) (< (abs (- x y)) machine-epsilon)) 
57                              (f64vector->list xv) (f64vector->list yv)))
58         ((sample-curve* my-c) (list 0 5 10 15 20)) 
59         (list (f64vector 3.0 3.0 3.0 3.0 3.0)
60               (f64vector 4.0 4.0 4.0 4.0 4.0)
61               (f64vector 0.0 5.0 10.0 15.0 20.0)
62               )))
63
64(assert (every (lambda (x y) (< (abs (- x y)) machine-epsilon)) 
65               ((sample-curve my-scaled-c) 5) (list 3. 4. 25.)))
66(assert (every
67         (lambda (xv yv) (map (lambda (x y) (< (abs (- x y)) machine-epsilon)) 
68                              (f64vector->list xv) (f64vector->list yv)))
69         ((sample-curve* my-scaled-c) (list 0 5 10 15 20)) 
70         (list (f64vector 3.0 3.0 3.0 3.0 3.0)
71               (f64vector 4.0 4.0 4.0 4.0 4.0)
72               (f64vector 0.0 25.0 50.0 75.0 100.0)
73               )))
74
75(printf "my-scaled-c = ~A~%" my-scaled-c)
76
77(printf "iterate my-scaled-c = ~A~%" (iterate-curve my-scaled-c 5))
78
79(define s (line-segment 3 (list 1 2 3)))
80
81(printf "line segment = ~A~%" s)
82
83(printf "line segment arc length (analytical) = ~A~%" (sqrt (+ 9 4 1)))
84(printf "line segment arc length (step = 0.1) = ~A~%" (arc-length s 0.1))
85
86(printf "iterate line segment = ~A~%" (iterate-curve s 5))
87
88(define ts (translate-curve (list 4 5 6) s))
89
90(printf "translated line segment = ~A~%" ts)
91
92(printf "iterate translated line segment = ~A~%" (iterate-curve ts 5))
93
94(printf "iterate translated line segment = ~A~%" (iterate-curve ts 2))
95
96
97(define (Rx theta)
98  (list (f64vector 1 0 0)
99        (f64vector 0 (cos theta) (sin theta))
100        (f64vector 0 (- (sin theta)) (cos theta))
101        ))
102
103(define (Ry theta)
104  (list (f64vector (cos theta) 0 (- (sin theta)))
105        (f64vector 0 1 0)
106        (f64vector (sin theta) 0 (cos theta))
107        ))
108
109(define (Rz theta)
110  (list (f64vector (cos theta) (sin theta) 0)
111        (f64vector (- (sin theta)) (cos theta) 0)
112        (f64vector 0 0 1)
113        ))
114
115(define (transform a v)
116  (let ((r1 (map (lambda (u) (f64vector-ref u 0)) a))
117        (r2 (map (lambda (u) (f64vector-ref u 1)) a))
118        (r3 (map (lambda (u) (f64vector-ref u 2)) a)))
119    (list (fold + 0.0 (map * r1 v))
120          (fold + 0.0 (map * r2 v))
121          (fold + 0.0 (map * r3 v)))
122    ))
123
124(define segrx (line-segment 3 (transform (Rx 60) (list 1 1 1))))
125(printf "x rotated segment (0,1) = ~A~%" ((sample-curve* segrx) (list 0 0.5 1)))
126(define segry (line-segment 3 (transform (Ry 60) (list 1 1 1))))
127(printf "y rotated segment (0,1) = ~A~%" ((sample-curve* segry) (list 0 0.5 1)))
128(define segrz (line-segment 3 (transform (Rz 60) (list 1 1 1))))
129(printf "z rotated segment (0,1) = ~A~%" ((sample-curve* segrz) (list 0 0.5 1)))
130
Note: See TracBrowser for help on using the repository browser.