Changeset 30852 in project


Ignore:
Timestamp:
05/12/14 09:39:39 (6 years ago)
Author:
Ivan Raikov
Message:

picnic: continuing work on non-uniform point sampling

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

Legend:

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

    r30851 r30852  
    121121                               output s n
    122122                   
    123                     component (type perturbation)
    124                                
    125                                fun pf (gid origin init)
    126                                  let ((period (randomUniform ((PFlength / 4.0) ~ (PFlength / 10.0) ~ init)))
    127                                       (phase  (randomUniform (0.0 ~ 10.0 ~ init))))
    128                                    ;; Harmonic (amplitude period phase npts)
    129                                    Harmonic (1 0.5 period phase 50)
    130                                
    131                                const n = 2
    132                                
    133                                p (s) = (generator pf) (initial (randomInit (43)))
    134                                
    135                                output s n
    136123                   
    137124                    fun f (gid origin)
  • release/4/picnic/trunk/picnic-core.scm

    r30851 r30852  
    181181          (SEGPS      (name    symbol?)
    182182                      (gfun    symbol?)
     183                      (sfun    (lambda (x) (or (not x) (symbol? x))))
    183184                      (initial (lambda (x) (or (not x) (rhs? x))))
    184185                      (nsegs   integer?)
     
    187188          (PS         (name     symbol?)
    188189                      (gfun     symbol?)
     190                      (sfun     (lambda (x) (or (not x) (symbol? x))))
    189191                      (initial  (lambda (x) (or (not x) (rhs? x))))
    190192                      (npts     integer?)
     
    738740                                   (alst  (filter identity alst))
    739741                                   (gfun  (lookup-def 'gfun alst))
     742                                   (sfun  (lookup-def 'sampling alst))
    740743                                   (npts  (lookup-def 'npts alst))
    741744                                   (initial (lookup-def 'initial alst))
     
    763766                                                          (sprintf "initial value for process ~A" sym)))))
    764767
    765                                 (hash-table-set! picnic-env sym (PS name gfun initial-expr (or npts 3))))
     768                                (hash-table-set! picnic-env sym (PS name gfun sfun initial-expr (or npts 3))))
    766769                             
    767770                              ))
     
    771774                                   (alst    (filter identity alst))
    772775                                   (gfun    (lookup-def 'gfun alst))
     776                                   (sfun    (lookup-def 'sampling alst))
    773777                                   (nsegs   (lookup-def 'nsegs alst))
    774778                                   (nsegpts (lookup-def 'nsegpts alst))
     
    801805                                                          (sprintf "initial value for process ~A" sym)))))
    802806
    803                                 (hash-table-set! picnic-env sym (SEGPS name gfun initial-expr nsegs nsegpts)))
     807                                (hash-table-set! picnic-env sym (SEGPS name gfun sfun initial-expr nsegs nsegpts)))
    804808                             
    805809                              ))
     
    11721176                      (if (picnic:quantity? x)
    11731177                          (cases picnic:quantity x
    1174                                  (PS (name gfun initial-expr npts)
     1178                                 (PS (name gfun sfun initial-expr npts)
    11751179                                     (cons name ax))
    1176                                  (SEGPS (name gfun initial-expr nsegs nsegpts)
     1180                                 (SEGPS (name gfun sfun initial-expr nsegs nsegpts)
    11771181                                        (cons name ax))
    11781182                                 (else ax))
     
    11861190                      (if (picnic:quantity? x)
    11871191                          (cases picnic:quantity x
    1188                                  (PS (name gfun initial npts)
     1192                                 (PS (name gfun sfun initial npts)
    11891193                                     (cons name ax))
    11901194                                 (else ax))
     
    11971201                      (if (picnic:quantity? x)
    11981202                          (cases picnic:quantity x
    1199                                  (SEGPS (name gfun initial-expr nsegs nsegpts)
     1203                                 (SEGPS (name gfun sfun initial-expr nsegs nsegpts)
    12001204                                        (cons name ax))
    12011205                                 (else ax))
     
    12941298            (and (picnic:quantity? x)
    12951299                 (cases picnic:quantity x
    1296                         (PS        (name gfun initial npts)  #t)
    1297                         (SEGPS     (name gfun initial-expr nsegs nsegpts) #t)
     1300                        (PS        (name gfun sfun initial npts)  #t)
     1301                        (SEGPS     (name gfun sfun initial-expr nsegs nsegpts) #t)
    12981302                        (else #f))
    12991303                 ))
     
    13081312                                                   (('union l r) (append (recur l) (recur r)))
    13091313                                                   (else rhs))))
    1310                         (PS (name gfun initial npts)   gfun)
    1311                         (SEGPS (name gfun initial-expr nsegs nsegpts) gfun)
     1314                        (PS (name gfun sfun initial npts)   gfun)
     1315                        (SEGPS (name gfun sfun initial-expr nsegs nsegpts) gfun)
    13121316                        (ASGN  (name value rhs)  rhs)
    13131317                        (INITIAL  (name rhs)  rhs)
     
    14031407                               (and (picnic:quantity? x)
    14041408                                    (cases picnic:quantity x
    1405                                            (PS  (name gfun initial npts)
     1409                                           (PS  (name gfun sfun initial npts)
    14061410                                                (list 'ps sym gfun))
    1407                                            (SEGPS  (name gfun initial nsegs nsegpts)
     1411                                           (SEGPS  (name gfun sfun initial nsegs nsegpts)
    14081412                                                   (list 'segps sym gfun))
    14091413                                           (ASGN  (name value rhs)
     
    16591663                                               (scope-subst1 (update-subst id qid scope-subst))
    16601664                                               (alst    (filter identity rest))
    1661                                                (gfun    ((lambda (x) (and x (subst-expr (parse-expr x `(segprocess ,id)) scope-subst)))
     1665                                               (gfun    ((lambda (x) (and x (subst-expr (parse-expr x `(process ,id)) scope-subst)))
    16621666                                                         (lookup-def 'generator alst)))
    1663                                                (initial ((lambda (x) (and x (subst-expr (parse-expr x `(segprocess ,id)) scope-subst)))
     1667                                               (sfun    ((lambda (x) (and x (subst-expr (parse-expr x `(process ,id)) scope-subst)))
     1668                                                         (lookup-def 'sampling alst)))
     1669                                               (initial ((lambda (x) (and x (subst-expr (parse-expr x `(process ,id)) scope-subst)))
    16641670                                                         (lookup-def 'initial alst)))
    16651671                                               (npts    ((lambda (x) (if x (subst-expr (parse-expr x `(process ,id)) scope-subst) 2))
     
    16711677                                                       (and npts `(npts ,(eval-const npts (sprintf "~A.npts" id)) ))
    16721678                                                       (and gfun `(gfun ,gfun))
     1679                                                       (and sfun `(sfun ,sfun))
    16731680                                                       (and initial `(initial ,initial))
    16741681                                                       ))
     
    16841691                                               (gfun    ((lambda (x) (and x (subst-expr (parse-expr x `(segprocess ,id)) scope-subst)))
    16851692                                                          (lookup-def 'generator alst)))
     1693                                               (sfun    ((lambda (x) (and x (subst-expr (parse-expr x `(segprocess ,id)) scope-subst)))
     1694                                                          (lookup-def 'sampling alst)))
    16861695                                               (initial ((lambda (x) (and x (subst-expr (parse-expr x `(segprocess ,id)) scope-subst)))
    16871696                                                          (lookup-def 'initial alst)))
     
    16971706                                                       (and nsegpts `(nsegpts ,(eval-const nsegpts (sprintf "~A.nsegpts" id)) ))
    16981707                                                       (and gfun `(gfun ,gfun))
     1708                                                       (and sfun `(sfun ,sfun))
    16991709                                                       (and initial `(initial ,initial))
    17001710                                                       ))
Note: See TracChangeset for help on using the changeset viewer.