Changeset 30630 in project


Ignore:
Timestamp:
04/01/14 11:13:16 (7 years ago)
Author:
Ivan Raikov
Message:

parametric-curve: more work on fold routines

Location:
release/4/parametric-curve/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/4/parametric-curve/trunk/parametric-curve.scm

    r30629 r30630  
    2828         map-curve translate-curve scale-curve
    2929         sample-curve sample-curve*
    30          iterate-curve perturb-curve bbox-curve
     30         iterate-curve fold-curve bbox-curve
    3131         arc-length
    3232         )
     
    3838        (import (only srfi-1 fold every list-tabulate zip concatenate)
    3939                (only srfi-4 f64vector make-f64vector list->f64vector f64vector->list f64vector-length f64vector-ref f64vector-set!)
    40                 (only srfi-4-utils f64vector-map)
     40                (only srfi-4-utils f64vector-fold)
    4141                (only extras fprintf pp)
    4242                (prefix bvsp-spline bvsp-spline:)
     
    163163
    164164
     165;; Folds a parametric equation at regular intervals in the range xmin..xmax inclusive.
     166(define (fold-peq c n f init)
     167  (let* (
     168         (g     (sample-peq* c))
     169         (xmin  (peq-xmin c))
     170         (xmax  (peq-xmax c))
     171         (delta (- xmax xmin))
     172         (dx    (if (zero? delta) 0
     173                    (if (< n 2)
     174                        (error 'fold-peq "number of iterations must be >= 2")
     175                        (/ (- xmax xmin) (- n 1)))))
     176         )
     177    (let ((res (g (list-tabulate n (lambda (i) (+ xmin (* dx i)))))))
     178    (f64vector-fold f init res)
     179    )))
     180
     181
    165182;; Transforms an equation using the given function.
    166183(define (map-peq f x)
     
    171188      )))
    172189
    173 
    174 ;; Transforms an equation using the given function and sample step.
    175 (define (fold-peq f n init x)
    176   (let ((fx (sample-peq x))
    177         (splx (peq-spl x)))
    178     (let ((f1 (lambda (u) (f (fx u)))))
    179       (simple-peq n (spline-k splx) f1 (peq-xmin x) (peq-xmax x))
    180       )))
    181190
    182191
     
    253262
    254263                         
    255 ;; Adds perturbation terms to a parametric curve.
    256 (define (perturb-curve fs c) (map perturb-peq fs c))
    257 
    258                          
    259264;; Obtain the bounding box of a curve
    260265(define (bbox-curve c) (append (map peq-ymin c) (map peq-ymax c)))
     
    263268;; Samples a parametric curve at regular intervals in the range xmin..xmax inclusive.
    264269(define (iterate-curve c n) (map (lambda (p) (iterate-peq p n)) c))
     270
     271
     272;; Folds a parametric curve at regular intervals in the range xmin..xmax inclusive.
     273(define (fold-curve c n fs inits) (map (lambda (p f init) (fold-peq p n f init)) c fs inits))
     274
    265275
    266276;; Computes the arc length of the parametric curve given step dx
  • release/4/parametric-curve/trunk/parametric-curve.setup

    r30625 r30630  
    1616
    1717  ;; Assoc list with properties for your extension:
    18   `((version 1.9)
     18  `((version 1.11)
    1919    ))
    2020
  • release/4/parametric-curve/trunk/tests/run.scm

    r30629 r30630  
    4949               ((sample-curve my-scaled-c) 1.)
    5050               (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 
    5551(assert (every
    5652         (lambda (xv yv) (map (lambda (x y) (< (abs (- x y)) machine-epsilon))
     
    6258               )))
    6359
    64 (assert (every (lambda (x y) (< (abs (- x y)) machine-epsilon))
    65                ((sample-curve my-scaled-c) 5) (list 3. 4. 25.)))
     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
    6667(assert (every
    6768         (lambda (xv yv) (map (lambda (x y) (< (abs (- x y)) machine-epsilon))
     
    7677
    7778(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
    7889
    7990(define s (line-segment 3 (list 1 2 3)))
     
    128139(define segrz (line-segment 3 (transform (Rz 60) (list 1 1 1))))
    129140(printf "z rotated segment (0,1) = ~A~%" ((sample-curve* segrz) (list 0 0.5 1)))
    130 
Note: See TracChangeset for help on using the changeset viewer.