Changeset 30948 in project


Ignore:
Timestamp:
06/02/14 07:51:21 (6 years ago)
Author:
Ivan Raikov
Message:

picnic: added non-uniform sampling functionality

Location:
release/4/picnic/trunk
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • release/4/picnic/trunk/examples/GLHP.picnic

    r30852 r30948  
    106106                               
    107107                               output s n
    108                    
     108                                                   
    109109                    component (type perturbation)
    110110                               
     
    136136                    ;; process u grows in the positive X direction
    137137                    ;; process v grows in the negative X direction
    138                     p (u) = (generator f) (npts 200)
    139                     p (v) = (generator g) (npts 200)
     138                    p (u) = (generator f) (sampler (polynomial 0.3 0.7)) (npts 200)
     139                    p (v) = (generator g) (sampler (polynomial 0.3 0.7)) (npts 200)
    140140                   
    141141                    output u n v n
     
    193193                    segp (v) = (generator g) (initial (randomInit (17))) (nsegs GoC_Ad_nseg) (nsegpts GoC_Ad_nsegpts)
    194194                    output u n v n
     195
    195196         component (type section) (name Axons)
    196197                    const n = numAxonGolgi
  • release/4/picnic/trunk/picnic-core.scm

    r30852 r30948  
    170170        (define picnic:expr?   expr?)
    171171        (define picnic:rhs?    rhs?)
    172 
     172        (define (picnic:sampler? x)
     173          (match x
     174                 ((uniform) #t)
     175                 ((polynomial c1 c2) #t)
     176                 (else #f)))
     177         
    173178
    174179        (define-datatype picnic:quantity picnic:quantity?
     
    181186          (SEGPS      (name    symbol?)
    182187                      (gfun    symbol?)
    183                       (sfun    (lambda (x) (or (not x) (symbol? x))))
     188                      (sfun    picnic:sampler?)
    184189                      (initial (lambda (x) (or (not x) (rhs? x))))
    185190                      (nsegs   integer?)
     
    188193          (PS         (name     symbol?)
    189194                      (gfun     symbol?)
    190                       (sfun     (lambda (x) (or (not x) (symbol? x))))
     195                      (sfun     picnic:sampler?)
    191196                      (initial  (lambda (x) (or (not x) (rhs? x))))
    192197                      (npts     integer?)
     
    740745                                   (alst  (filter identity alst))
    741746                                   (gfun  (lookup-def 'gfun alst))
    742                                    (sfun  (lookup-def 'sampling alst))
     747                                   (sfun  (or (lookup-def 'sfun alst) '(uniform)))
    743748                                   (npts  (lookup-def 'npts alst))
    744749                                   (initial (lookup-def 'initial alst))
     
    774779                                   (alst    (filter identity alst))
    775780                                   (gfun    (lookup-def 'gfun alst))
    776                                    (sfun    (lookup-def 'sampling alst))
     781                                   (sfun    (or (lookup-def 'sfun alst) '(uniform)))
    777782                                   (nsegs   (lookup-def 'nsegs alst))
    778783                                   (nsegpts (lookup-def 'nsegpts alst))
     
    16651670                                               (gfun    ((lambda (x) (and x (subst-expr (parse-expr x `(process ,id)) scope-subst)))
    16661671                                                         (lookup-def 'generator alst)))
    1667                                                (sfun    ((lambda (x) (and x (subst-expr (parse-expr x `(process ,id)) scope-subst)))
    1668                                                          (lookup-def 'sampling alst)))
     1672                                               (sfun    (lookup-def 'sampler alst))
    16691673                                               (initial ((lambda (x) (and x (subst-expr (parse-expr x `(process ,id)) scope-subst)))
    16701674                                                         (lookup-def 'initial alst)))
     
    16771681                                                       (and npts `(npts ,(eval-const npts (sprintf "~A.npts" id)) ))
    16781682                                                       (and gfun `(gfun ,gfun))
    1679                                                        (and sfun `(sfun ,sfun))
     1683                                                       (or (and sfun `(sfun ,sfun)) `(sfun (uniform)))
    16801684                                                       (and initial `(initial ,initial))
    16811685                                                       ))
     
    16911695                                               (gfun    ((lambda (x) (and x (subst-expr (parse-expr x `(segprocess ,id)) scope-subst)))
    16921696                                                          (lookup-def 'generator alst)))
    1693                                                (sfun    ((lambda (x) (and x (subst-expr (parse-expr x `(segprocess ,id)) scope-subst)))
    1694                                                           (lookup-def 'sampling alst)))
     1697                                               (sfun    (lookup-def 'sampler alst))
    16951698                                               (initial ((lambda (x) (and x (subst-expr (parse-expr x `(segprocess ,id)) scope-subst)))
    16961699                                                          (lookup-def 'initial alst)))
     
    17061709                                                       (and nsegpts `(nsegpts ,(eval-const nsegpts (sprintf "~A.nsegpts" id)) ))
    17071710                                                       (and gfun `(gfun ,gfun))
    1708                                                        (and sfun `(sfun ,sfun))
     1711                                                       (or (and sfun `(sfun ,sfun)) `(sfun (uniform)))
    17091712                                                       (and initial `(initial ,initial))
    17101713                                                       ))
  • release/4/picnic/trunk/picnic-utils.scm

    r30851 r30948  
    266266
    267267        ;; Samples a parametric curve at regular intervals in the range xmin..xmax inclusive.
    268         (define (uniform-sample n)
    269           (let* (
    270                  (xmin  0.0)
    271                  (xmax  1.0)
    272                  (delta (- xmax xmin))
    273                  (dx    (if (zero? delta) 0
    274                             (if (< n 2)
    275                                 (error 'uniform-sample "number of iterations must be >= 2")
     268        (define (sample-uniform)
     269          (lambda (n)
     270            (let* (
     271                   (xmin  0.0)
     272                   (xmax  1.0)
     273                   (delta (- xmax xmin))
     274                   (dx    (if (zero? delta) 0
     275                              (if (< n 2)
     276                                (error 'sample-uniform "number of iterations must be >= 2")
    276277                                (/ (- xmax xmin) (- n 1)))))
    277                  )
    278             (list-tabulate n (lambda (i) (+ xmin (* dx i))))
    279             ))
     278                   )
     279              (list-tabulate n (lambda (i) (+ xmin (* dx i))))
     280              )))
     281
     282
     283        ;; Samples a parametric curve according to a polynomial
     284        ;; c1 x + c2 x^2 in the range xmin..xmax inclusive.
     285        (define (sample-polynomial c1 c2)
     286          (lambda (n)
     287            (let* (
     288                   (f (lambda (x) (+ (* x c1) (* x x c2))))
     289                   (dx (/ 1.0 n))
     290                   )
     291              (list-tabulate n (lambda (i) (f (* dx i))))
     292              )))
    280293
    281294
  • release/4/picnic/trunk/picnic.scm

    r30851 r30948  
    276276  (and (picnic:quantity? x)
    277277       (cases picnic:quantity x
    278               (PS (name gfun init npts)   init)
    279               (SEGPS (name gfun init nsegs nsegpts)   init)
     278              (PS (name gfun sfun init npts)   init)
     279              (SEGPS (name gfun sfun init nsegs nsegpts)   init)
    280280              (else #f))))
    281281
     
    283283  (and (picnic:quantity? x)
    284284       (cases picnic:quantity x
    285               (PS (name gfun init npts)   gfun)
    286               (SEGPS (name gfun init nsegs nsegpts)   gfun)
     285              (PS (name gfun sfun init npts)   gfun)
     286              (SEGPS (name gfun sfun init nsegs nsegpts)   gfun)
    287287              (else #f))))
    288288
     
    655655         (make-section (cases picnic:quantity
    656656                              (hash-table-ref sys (first (car section-processes)))
    657                               (PS (name gfun init npts)   
     657                              (PS (name gfun sfun init npts)   
    658658                                  'make-section)
    659                               (SEGPS (name gfun init npts)   
     659                              (SEGPS (name gfun sfun init npts)   
    660660                                     'make-segmented-section)))
    661661
     
    664664                               ((process-name process-n)
    665665                                (cases picnic:quantity (hash-table-ref sys process-name)
    666                                        (PS (name gfun init npts)   
     666                                       (PS (name gfun sfun init npts)   
    667667                                           (let ((init-var (and init (gensym 'v))))
    668668                                             (list
     
    674674                                              process-n)))
    675675                                       
    676                                        (SEGPS (name gfun init nsegs nsegpts)   
     676                                       (SEGPS (name gfun sfun init nsegs nsegpts)   
    677677                                              (error 'invoke-generator/scheme
    678678                                                     "perturbation process cannot be segmented"
     
    703703                   
    704704                    (cases picnic:quantity (hash-table-ref sys process-name)
    705                            (PS (name gfun init npts)   
     705                           (PS (name gfun sfun init npts)   
    706706                               (let ((init-var (and init (gensym 'v))))
    707707                                 (list
     
    711711                                          `(,gfun gid ,origin ,init-var)
    712712                                          `(,gfun gid ,origin) ))
    713                                     uniform-sample
     713                                    ,(case (car sfun)
     714                                       ((uniform) `(sample-uniform))
     715                                       ((polynomial) `(sample-polynomial . ,(cdr sfun)))
     716                                       (else (error 'picnic "unknown sampling method" sfun)))
    714717                                    (inexact->exact ,npts))
    715718                                  init
     
    717720                                  process-n)))
    718721                           
    719                            (SEGPS (name gfun init nsegs nsegpts)   
     722                           (SEGPS (name gfun sfun init nsegs nsegpts)   
    720723                                  (let ((init-var (and init (gensym 'v))))
    721724                                    (list
     
    725728                                             `(,gfun gid ,origin ,init-var)
    726729                                             `(,gfun gid ,origin) ))
    727                                        uniform-sample
     730                                       ,(case (car sfun)
     731                                          ((uniform) `(sample-uniform))
     732                                          ((polynomial) `(sample-polynomial . ,(cdr sfun)))
     733                                          (else (error 'picnic "unknown sampling method" sfun)))
    728734                                       (inexact->exact ,nsegs)
    729735                                       (inexact->exact ,nsegpts))
Note: See TracChangeset for help on using the changeset viewer.