Changeset 30625 in project


Ignore:
Timestamp:
04/01/14 06:48:52 (7 years ago)
Author:
Ivan Raikov
Message:

parametric-curve: added perturbation term to curve structure

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

Legend:

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

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

    r30416 r30625  
    2828         map-curve translate-curve scale-curve
    2929         sample-curve sample-curve*
    30          iterate-curve bbox-curve
     30         iterate-curve perturb-curve bbox-curve
    3131         arc-length
    3232         )
     
    3434        (import scheme chicken data-structures)
    3535 
    36         (require-library srfi-1 srfi-4 extras bvsp-spline)
     36        (require-library srfi-1 srfi-4 srfi-4-utils extras bvsp-spline)
    3737
    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)
    4041                (only extras fprintf pp)
    4142                (prefix bvsp-spline bvsp-spline:)
     
    5556
    5657;; A parametric equation with an associated interval, interpolating
    57 ;; spline.
    58 (define-record-type peq (make-peq fn xmin xmax ymin ymax spl)
     58;; spline, and perturbation function.
     59(define-record-type peq (make-peq fn xmin xmax ymin ymax spl pfn)
    5960  peq?
    6061  (fn      peq-fn )
     
    6465  (ymax    peq-ymax)
    6566  (spl     peq-spl)
     67  (pfn     peq-pfn)
    6668  )
    6769
    6870
    6971(define-record-printer (peq x out)
    70   (fprintf out "#(peq fn=~A xmin=~A xmax=~A ymin=~A ymax=~A spl=~A)"
     72  (fprintf out "#(peq fn=~A xmin=~A xmax=~A ymin=~A ymax=~A spl=~A pfn=~A)"
    7173           (peq-fn x)
    7274           (peq-xmin x)
     
    7577           (peq-ymax x)
    7678           (peq-spl x)
     79           (peq-pfn x)
    7780           ))
    7881
     
    8689(define (simple-peq n k fn xmin xmax)
    8790  (if (> xmin xmax)
     91
    8892      (simple-peq n k fn xmax xmin)
     93
    8994      (let ((dx (/ (- xmax xmin) n)))
     95
    9096        (let* ((x (list-tabulate (+ 1 n) (lambda (i) (+ xmin (* i dx)))))
    9197               (y (map fn x))
     
    105111                )
    106112
    107 
    108 
    109               (make-peq fn xmin xmax ymin ymax spl)
     113              (make-peq fn xmin xmax ymin ymax spl #f)
    110114              ))
    111115          ))
     
    116120(define (sample-peq c)
    117121  (let ((s (peq-spl c))
     122        (p (peq-pfn c))
    118123        (min (peq-xmin c))
    119124        (max (peq-xmax c)))
     
    124129                                          (spline-d s) (spline-d2 s)
    125130                                          (f64vector xp) 0)))
    126              (and v (f64vector-ref v 0)))
     131             (and v (or (and p (p (f64vector-ref v 0)))
     132                        (f64vector-ref v 0))))
    127133           ))
    128134    ))
     
    131137;; Samples a parametric equation at the given points of interest.
    132138(define (sample-peq* c)
    133   (let ((s (peq-spl c)))
     139  (let ((s (peq-spl c))
     140        (p (peq-pfn c)))
    134141    (lambda (xps)
    135142      (let ((xpsv (if (list? xps) (list->f64vector xps) xps)))
    136         (bvsp-spline:evaluate (spline-n s) (spline-k s)
    137                               (spline-x s) (spline-y s)
    138                               (spline-d s) (spline-d2 s)
    139                               xpsv 0))
    140       )))
     143        (let ((res (bvsp-spline:evaluate (spline-n s) (spline-k s)
     144                                         (spline-x s) (spline-y s)
     145                                         (spline-d s) (spline-d2 s)
     146                                         xpsv 0)))
     147          (or (and p (f64vector-map p res)) res)
     148          ))
     149      ))
     150  )
    141151
    142152
     
    166176
    167177
     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  )
     182
     183
    168184;; Combines two equations using the given function.
    169185(define (compose-peq f x y)
     
    235251(define (scale-curve xs c)
    236252  (map (lambda (x p) (scale-peq x p)) xs c))
     253
     254                         
     255;; Adds perturbation terms to a parametric curve.
     256(define (perturb-curve fs c) (map perturb-peq fs c))
    237257
    238258                         
  • release/4/parametric-curve/trunk/parametric-curve.setup

    r30417 r30625  
    1616
    1717  ;; Assoc list with properties for your extension:
    18   `((version 1.8)
     18  `((version 1.9)
    1919    ))
    2020
Note: See TracChangeset for help on using the changeset viewer.