Changeset 30629 in project
 Timestamp:
 04/01/14 10:33:20 (7 years ago)
 Location:
 release/4/parametriccurve/trunk
 Files:

 2 edited
Legend:
 Unmodified
 Added
 Removed

release/4/parametriccurve/trunk/parametriccurve.scm
r30625 r30629 55 55 56 56 57 ;; A parametric equation with an associated interval, interpolating 58 ;; spline, and perturbation function. 59 (definerecordtype peq (makepeq fn xmin xmax ymin ymax spl pfn) 57 ;; A parametric equation with an associated interval and interpolating spline 58 (definerecordtype peq (makepeq fn xmin xmax ymin ymax spl) 60 59 peq? 61 60 (fn peqfn ) … … 65 64 (ymax peqymax) 66 65 (spl peqspl) 67 (pfn peqpfn)68 66 ) 69 67 70 68 71 69 (definerecordprinter (peq x out) 72 (fprintf out "#(peq fn=~A xmin=~A xmax=~A ymin=~A ymax=~A spl=~A pfn=~A)"70 (fprintf out "#(peq fn=~A xmin=~A xmax=~A ymin=~A ymax=~A spl=~A)" 73 71 (peqfn x) 74 72 (peqxmin x) … … 77 75 (peqymax x) 78 76 (peqspl x) 79 (peqpfn x)80 77 )) 81 78 … … 88 85 ;; Defines a simple parametric equation. 89 86 (define (simplepeq n k fn xmin xmax) 87 90 88 (if (> xmin xmax) 91 89 … … 111 109 ) 112 110 113 (makepeq fn xmin xmax ymin ymax spl #f)111 (makepeq fn xmin xmax ymin ymax spl) 114 112 )) 115 113 )) … … 120 118 (define (samplepeq c) 121 119 (let ((s (peqspl c)) 122 (p (peqpfn c))123 120 (min (peqxmin c)) 124 121 (max (peqxmax c))) … … 129 126 (splined s) (splined2 s) 130 127 (f64vector xp) 0))) 131 (and v (or (and p (p (f64vectorref v 0))) 132 (f64vectorref v 0)))) 128 (and v (f64vectorref v 0))) 133 129 )) 134 130 )) … … 137 133 ;; Samples a parametric equation at the given points of interest. 138 134 (define (samplepeq* c) 139 (let ((s (peqspl c)) 140 (p (peqpfn c))) 135 (let ((s (peqspl c))) 141 136 (lambda (xps) 142 137 (let ((xpsv (if (list? xps) (list>f64vector xps) xps))) … … 145 140 (splined s) (splined2 s) 146 141 xpsv 0))) 147 (or (and p (f64vectormap p res)) res)142 res 148 143 )) 149 144 )) … … 170 165 ;; Transforms an equation using the given function. 171 166 (define (mappeq f x) 172 (let ((fx (samplepeq x)) (splx (peqspl x))) 167 (let ((fx (samplepeq x)) 168 (splx (peqspl x))) 173 169 (let ((f1 (lambda (u) (f (fx u))))) 174 170 (simplepeq (splinen splx) (splinek splx) f1 (peqxmin x) (peqxmax x)) … … 176 172 177 173 178 ;; Adds a perturbation term to an equation using the given function. 179 (define (perturbpeq f x) 180 (makepeq (peqfn x) (peqxmin x) (peqxmax x) (peqymin x) (peqymax x) (peqspl x) f) 181 ) 174 ;; Transforms an equation using the given function and sample step. 175 (define (foldpeq f n init x) 176 (let ((fx (samplepeq x)) 177 (splx (peqspl x))) 178 (let ((f1 (lambda (u) (f (fx u))))) 179 (simplepeq n (splinek splx) f1 (peqxmin x) (peqxmax x)) 180 ))) 181 182 182 183 183 
release/4/parametriccurve/trunk/tests/run.scm
r30416 r30629 1 (use srfi4 parametriccurve)1 (use numbers srfi4 parametriccurve) 2 2 3 3 (define machineepsilon … … 6 6 (* 2 e) 7 7 (loop (/ e 2))))) 8 9 (printf "machineepsilon = ~A~%" machineepsilon) 10 11 (define myc (linearcurve 3 '((0 3) (0 4) (1 0)) 0 20)) 12 (define myscaledc (scalecurve '(1. 1. 5.) myc)) 8 13 9 14 (print "machineepsilon = " machineepsilon) … … 45 50 (list 4. 5. 5.))) 46 51 52 (assert (every (lambda (x y) (print (abs ( x y))) (< (abs ( x y)) machineepsilon)) 53 ((samplecurve myc) 5) (list 3. 4. 5.))) 54 47 55 (assert (every 48 (lambda (xv yv) 49 (map (lambda (x y) (<= (abs ( x y)) machineepsilon)) 50 (f64vector>list xv) (f64vector>list yv))) 56 (lambda (xv yv) (map (lambda (x y) (< (abs ( x y)) machineepsilon)) 57 (f64vector>list xv) (f64vector>list yv))) 58 ((samplecurve* myc) (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)) machineepsilon)) 65 ((samplecurve myscaledc) 5) (list 3. 4. 25.))) 66 (assert (every 67 (lambda (xv yv) (map (lambda (x y) (< (abs ( x y)) machineepsilon)) 68 (f64vector>list xv) (f64vector>list yv))) 51 69 ((samplecurve* myscaledc) (list 0 5 10 15 20)) 52 70 (list (f64vector 3.0 3.0 3.0 3.0 3.0)
Note: See TracChangeset
for help on using the changeset viewer.