Changeset 30639 in project


Ignore:
Timestamp:
04/03/14 17:00:50 (7 years ago)
Author:
Ivan Raikov
Message:

parametric-curve: refactoring fold-curve again

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

Legend:

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

    r30625 r30639  
    1818 ; A list of eggs parametric-curve depends on.
    1919
    20  (needs bvsp-spline srfi-4-utils)
     20 (needs bvsp-spline)
    2121
    2222 (author "Ivan Raikov")
  • release/4/parametric-curve/trunk/parametric-curve.scm

    r30631 r30639  
    2828         map-curve translate-curve scale-curve
    2929         sample-curve sample-curve*
    30          iterate-curve fold-curve bbox-curve
    31          arc-length
     30         iterate-curve fold-curve fold-curve*
     31         bbox-curve arc-length
    3232         )
    3333       
    3434        (import scheme chicken data-structures)
    3535 
    36         (require-library srfi-1 srfi-4 srfi-4-utils extras bvsp-spline)
     36        (require-library srfi-1 srfi-4 extras bvsp-spline)
    3737
    3838        (import (only srfi-1 fold every list-tabulate zip concatenate)
    39                 (only srfi-4 f64vector make-f64vector list->f64vector f64vector->list f64vector-length f64vector-ref f64vector-set!)
    40                 (only srfi-4-utils f64vector-fold)
     39                (only srfi-4 f64vector make-f64vector list->f64vector f64vector->list f64vector-length f64vector-ref f64vector-set!
     40                      list->u32vector u32vector-ref)
    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 ((vs (g (list-tabulate n (lambda (i) (+ xmin (* dx i)))))))
    178     (f64vector-fold f init vs)
    179     )))
    180 
    181165
    182166;; Transforms an equation using the given function.
     
    251235  (map (lambda (f p) (map-peq f p)) fs c))
    252236
     237;; Composes the parametric curves using the given functions.
     238(define (compose-curve fs c1 c2)
     239  (map (lambda (f p1 p2) (compose-peq f p1 p2)) fs c1 c2))
     240
    253241
    254242;; Translates a parametric curve.
     
    271259
    272260;; 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))
     261(define (fold-curve c n f init)
     262  (let* (
     263         (gs     (map sample-peq* c))
     264         (xmins  (map peq-xmin c))
     265         (xmaxs  (map peq-xmax c))
     266         (deltas (map - xmaxs xmins))
     267         (dxs    (map (lambda (xmin xmax delta)
     268                        (if (zero? delta) 0
     269                            (if (< n 2)
     270                                (error 'fold-curve "number of iterations must be >= 2")
     271                                (/ (- xmax xmin) (- n 1)))))
     272                      xmins xmaxs deltas))
     273         (inds   (map (lambda (xmin dx)
     274                        (list-tabulate n (lambda (i) (+ xmin (* dx i)))))
     275                      xmins dxs))
     276         (vs     (map (lambda (g ind) (g ind)) gs inds))
     277         )
     278    (let recur ((i 0) (init init))
     279      (if (< i n)
     280          (let* ((vsi   (map (lambda (vect) (f64vector-ref vect i)) vs))
     281                 (init1 (f vsi init)))
     282            (recur (+ 1 i) init1))
     283          init))
     284    ))
     285         
     286
     287;; Like fold-curve, but F is of the form F(I,V,INIT)
     288
     289;; Folds a parametric curve at regular intervals in the range xmin..xmax inclusive.
     290(define (fold-curve* c n f init)
     291  (let* (
     292         (gs     (map sample-peq* c))
     293         (xmins  (map peq-xmin c))
     294         (xmaxs  (map peq-xmax c))
     295         (deltas (map - xmaxs xmins))
     296         (dxs    (map (lambda (xmin xmax delta)
     297                        (if (zero? delta) 0
     298                            (if (< n 2)
     299                                (error 'fold-curve "number of iterations must be >= 2")
     300                                (/ (- xmax xmin) (- n 1)))))
     301                      xmins xmaxs deltas))
     302         (inds   (map (lambda (xmin dx)
     303                        (list-tabulate n (lambda (i) (+ xmin (* dx i)))))
     304                      xmins dxs))
     305         (vs     (map (lambda (g ind) (g ind)) gs inds))
     306         )
     307    (let recur ((i 0) (init init))
     308      (if (< i n)
     309          (let* ((vsi   (map (lambda (vect) (f64vector-ref vect i)) vs))
     310                 (init1 (f i vsi init)))
     311            (recur (+ 1 i) init1))
     312          init))
     313    ))
     314         
    274315
    275316
  • release/4/parametric-curve/trunk/tests/run.scm

    r30631 r30639  
    1 (use numbers srfi-4 parametric-curve)
     1(use numbers srfi-4 parametric-curve matchable)
    22
    33(define machine-epsilon
     
    8181(printf "fold my-scaled-c = ~A~%"
    8282        (fold-curve my-scaled-c 5
    83            (list (lambda (x init) (cons (* x 10) init))
    84                  (lambda (x init) (cons (* x 20) init))
    85                  (lambda (x init) (cons (* x 30) init)))
    86            (list '() '() '())
     83           (match-lambda* (((x y z) init) (cons (list (* x 10) (* y 20) (* z 30)) init)))
     84           '()
    8785           ))
    8886
     
    139137(define segrz (line-segment 3 (transform (Rz 60) (list 1 1 1))))
    140138(printf "z rotated segment (0,1) = ~A~%" ((sample-curve* segrz) (list 0 0.5 1)))
     139
     140(define PI 3.14159265358979323846)
     141(define (rad t) (/ (* t PI) 180))
     142
     143(define ellipse-c
     144  (let ((a 0.2) (b 0.5))
     145    (simple-curve
     146     10 1
     147     (list
     148      (lambda (t) (* a (cos (rad t))))
     149      (lambda (t) (* b (sin (rad t))))
     150      (lambda (t) (cos (rad t)))
     151      )
     152     0.0 360.0)))
     153
     154(printf "ellipse (0,360) = ~A~%"
     155        (iterate-curve ellipse-c 10))
     156
     157(define (sqr x) (* x x))
     158
     159(define (vel x y z ax)
     160  (print "ax = " ax)
     161  (match-let
     162   (((lst (x0 y0 z0)) ax))
     163   (print "lst = " lst)
     164   (print "x0 = " x0)
     165   (print "y0 = " y0)
     166   (print "z0 = " z0)
     167   (print "x = " x)
     168   (print "y = " y)
     169   (print "z = " z)
     170   (let* ((v (sqrt (+ (sqr (- x x0))
     171                      (sqr (- y y0))
     172                      (sqr (- z z0)))))
     173          (ax1 (list (cons v lst) (list x y z))))
     174     (print "ax1 = " ax1)
     175     ax1)
     176   ))
     177
     178(printf "ellipse velocities = ~A~%"
     179        (car
     180         (fold-curve ellipse-c 10
     181                     (match-lambda*
     182                      (((x y z) init) (begin (print "init = " init) (vel x y z init))))
     183                     '(() (0.0 0.0 0.0))
     184                    )))
     185
Note: See TracChangeset for help on using the changeset viewer.