Changeset 30629 in project


Ignore:
Timestamp:
04/01/14 10:33:20 (7 years ago)
Author:
Ivan Raikov
Message:

parametric-curve: another attempt at perturbation functionality

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

Legend:

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

    r30625 r30629  
    5555
    5656
    57 ;; A parametric equation with an associated interval, interpolating
    58 ;; spline, and perturbation function.
    59 (define-record-type peq (make-peq fn xmin xmax ymin ymax spl pfn)
     57;; A parametric equation with an associated interval and interpolating spline
     58(define-record-type peq (make-peq fn xmin xmax ymin ymax spl)
    6059  peq?
    6160  (fn      peq-fn )
     
    6564  (ymax    peq-ymax)
    6665  (spl     peq-spl)
    67   (pfn     peq-pfn)
    6866  )
    6967
    7068
    7169(define-record-printer (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)"
    7371           (peq-fn x)
    7472           (peq-xmin x)
     
    7775           (peq-ymax x)
    7876           (peq-spl x)
    79            (peq-pfn x)
    8077           ))
    8178
     
    8885;; Defines a simple parametric equation.
    8986(define (simple-peq n k fn xmin xmax)
     87
    9088  (if (> xmin xmax)
    9189
     
    111109                )
    112110
    113               (make-peq fn xmin xmax ymin ymax spl #f)
     111              (make-peq fn xmin xmax ymin ymax spl)
    114112              ))
    115113          ))
     
    120118(define (sample-peq c)
    121119  (let ((s (peq-spl c))
    122         (p (peq-pfn c))
    123120        (min (peq-xmin c))
    124121        (max (peq-xmax c)))
     
    129126                                          (spline-d s) (spline-d2 s)
    130127                                          (f64vector xp) 0)))
    131              (and v (or (and p (p (f64vector-ref v 0)))
    132                         (f64vector-ref v 0))))
     128             (and v (f64vector-ref v 0)))
    133129           ))
    134130    ))
     
    137133;; Samples a parametric equation at the given points of interest.
    138134(define (sample-peq* c)
    139   (let ((s (peq-spl c))
    140         (p (peq-pfn c)))
     135  (let ((s (peq-spl c)))
    141136    (lambda (xps)
    142137      (let ((xpsv (if (list? xps) (list->f64vector xps) xps)))
     
    145140                                         (spline-d s) (spline-d2 s)
    146141                                         xpsv 0)))
    147           (or (and p (f64vector-map p res)) res)
     142          res
    148143          ))
    149144      ))
     
    170165;; Transforms an equation using the given function.
    171166(define (map-peq f x)
    172   (let ((fx (sample-peq x)) (splx (peq-spl x)))
     167  (let ((fx (sample-peq x))
     168        (splx (peq-spl x)))
    173169    (let ((f1 (lambda (u) (f (fx u)))))
    174170      (simple-peq (spline-n splx) (spline-k splx) f1 (peq-xmin x) (peq-xmax x))
     
    176172
    177173
    178 ;; Adds a perturbation term to an equation using the given function.
    179 (define (perturb-peq f x)
    180   (make-peq (peq-fn x) (peq-xmin x) (peq-xmax x) (peq-ymin x) (peq-ymax x) (peq-spl x) f)
    181   )
     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      )))
     181
    182182
    183183
  • release/4/parametric-curve/trunk/tests/run.scm

    r30416 r30629  
    1 (use srfi-4 parametric-curve)
     1(use numbers srfi-4 parametric-curve)
    22
    33(define machine-epsilon
     
    66         (* 2 e)
    77         (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))
    813
    914(print "machine-epsilon = " machine-epsilon)
     
    4550               (list 4. 5. 5.)))
    4651
     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
    4755(assert (every
    48          (lambda (xv yv)
    49            (map (lambda (x y) (<= (abs (- x y)) machine-epsilon))
    50                 (f64vector->list xv) (f64vector->list yv)))
     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)))
    5169         ((sample-curve* my-scaled-c) (list 0 5 10 15 20))
    5270         (list (f64vector 3.0 3.0 3.0 3.0 3.0)
Note: See TracChangeset for help on using the changeset viewer.