Changeset 30710 in project


Ignore:
Timestamp:
04/15/14 09:32:20 (7 years ago)
Author:
Ivan Raikov
Message:

picnic: a number of bug fixes in point projection and perturbations

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

Legend:

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

    r30701 r30710  
    101101                               
    102102                               (defun pf (gid origin init)
    103                                  (let ((period (randomUniform (1.0 ~ (PFlength / 40.0) ~ init)))
    104                                        (phase  (randomUniform (0.0 ~ 0.5 ~ init))))
    105                                    ;; Harmonic (amplitude period phase)
    106                                    (Harmonic (1.0 period phase))))
     103                                 (let ((period (randomUniform (1.0 ~ (PFlength / 100.0) ~ init)))
     104                                       (phase  (randomUniform (0.0 ~ 10.0 ~ init))))
     105                                   ;; Harmonic (amplitude period phase n)
     106                                   (Harmonic (10.0 period phase 30))))
    107107                               
    108                                (const n = 4)
     108                               (const n = 3)
    109109                               
    110                                (p (s) = (generator pf) (npts 200))
     110                               (p (s) = (generator pf) (npts 200) (initial (randomInit (39))))
    111111
    112112                               (output s n)
     
    307307            (output GoCtoGoCgap)
    308308            )
    309 
    310309       
    311310       ))
  • release/4/picnic/trunk/picnic-core.scm

    r30701 r30710  
    386386                        path-exprs
    387387                        `((,pointtype ,fptype  ,fptype  ,fptype)
    388                           (,fptype ,fptype ,fptype))
     388                          (,fptype ,fptype ,fptype ,inttype))
    389389                        `(,pathtype ,pathtype)
    390390                        )
  • release/4/picnic/trunk/picnic-utils.scm

    r30701 r30710  
    263263
    264264
     265        (define (compose-curves c1 c2)
     266          (let ((c (pcurve:compose-curve (list + + +) c1 c2)))
     267;            (print "compose-curves: c1 = ") (pp (pcurve:iterate-curve c1 10))
     268;            (print "compose-curves: c2 = ") (pp (pcurve:iterate-curve c2 10))
     269;            (print "compose-curves: c = ") (pp (pcurve:iterate-curve c 10))
     270            c))
     271             
    265272
    266273        (define (make-simple-curve fx fy fz n)
     
    270277       
    271278
    272         (define (make-harmonic amp period phase)
    273           (let* ((freq (/ (* 2 PI) period))
     279        (define (make-harmonic amp period phase n)
     280          (let* ((freq (/ (* 2 PI) (/ 1.0 period)))
    274281                 (c (pcurve:simple-curve
    275                     10 1 (list (lambda (t) (* amp (cos (+ (* freq t) phase))))
    276                                (lambda (t) t)
    277                                (lambda (t) 0.0))
     282                    (inexact->exact n) 1
     283                    (list (lambda (t) (* amp (cos (+ (* freq t) phase))))
     284                          (lambda (t) t)
     285                          (lambda (t) 0.0))
    278286                    0.0 1.0)))
    279287            c
     
    491499                         (dd (d "~A: rank ~A: querying point ~A (root ~A)~%" prefix myrank px root))
    492500                         (query-data
    493                           (fold
    494                            (lambda (pd ax)
    495                              (fold
    496                               (lambda (x ax)
    497                                 (let ((source (car x))
    498                                       (target i)
    499                                       (distance (cadr x)))
    500                                   (if (and (> distance  0.) (not (= source target)))
    501                                       (append (list source target distance) ax)
    502                                       ax)
    503                                   ))
    504                               ax
    505                               (delete-duplicates
    506                                (map (lambda (x)
    507                                       (let ((res (list (car (cadar x)) 
    508                                                        (+ (caddr x) (cadr (cadar x))))))
    509                                         (d "~A: x = ~A res = ~A~%" prefix x res)
    510                                         res))
    511                                     (nn-filter pd (kd-tree-near-neighbors* fibers zone pd))
    512                                     )
    513                                (lambda (u v) (= (car u) (car v)))
    514                                )
    515                               ))
    516                            '() (cadr px)))
    517                          )
     501                          (let ((pd (cadr px)))
     502                            (fold
     503                             (lambda (x ax)
     504                               (let ((source (car x))
     505                                     (target i)
     506                                     (distance (cadr x)))
     507                                 (if (and (> distance  0.) (not (= source target)))
     508                                     (append (list source target distance) ax)
     509                                     ax)
     510                                 ))
     511                             '()
     512                             (delete-duplicates
     513                              (map (lambda (x)
     514                                     (let ((res (list (car (cadar x)) 
     515                                                      (+ (caddr x) (cadr (cadar x))))))
     516                                       (d "~A: x = ~A res = ~A~%" prefix x res)
     517                                       res))
     518                                   (nn-filter pd (kd-tree-near-neighbors* fibers zone pd))
     519                                   )
     520                              (lambda (u v) (= (car u) (car v)))
     521                              )
     522                             ))
     523                          ))
     524
    518525
    519526                    (let* ((res0 (MPI:gatherv-f64vector (list->f64vector query-data) root my-comm))
  • release/4/picnic/trunk/picnic.scm

    r30701 r30710  
    591591(define PointsFromFile load-points-from-file)
    592592(define LineSegment make-line-segment)
     593(define Harmonic make-harmonic)
    593594
    594595
     
    637638                                 layout-name forest-name forest-type)
    638639  (let* ((origin (gensym 'p))
     640
    639641         (make-section (cases picnic:quantity
    640642                              (hash-table-ref sys (first (car section-processes)))
     
    643645                              (SEGPS (name gfun init npts)   
    644646                                     'make-segmented-section)))
     647
     648         (perturbation-exprs (map
     649                              (match-lambda
     650                               ((process-name process-n)
     651                                (cases picnic:quantity (hash-table-ref sys process-name)
     652                                       (PS (name gfun init npts)   
     653                                           (let ((init-var (and init (gensym 'v))))
     654                                             (list
     655                                              (if init
     656                                                  `(,gfun gid ,origin ,init-var)
     657                                                  `(,gfun gid ,origin))
     658                                              init
     659                                              init-var
     660                                              process-n)))
     661                                       
     662                                       (SEGPS (name gfun init nsegs nsegpts)   
     663                                              (error 'invoke-generator/scheme
     664                                                     "perturbation process cannot be segmented"
     665                                                     process-name))
     666                                       )))
     667                              section-perturbations))
     668
     669         (make-perturbations (lambda (expr)
     670                               (fold (match-lambda*
     671                                      (((pexpr init init-var n) ax)
     672                                        (let ((pvar (gensym 'p)))
     673                                          (if init
     674                                              `(let* ((,init-var ,init)
     675                                                      (,pvar (list-tabulate (inexact->exact ,n) (lambda (i) ,pexpr))))
     676                                                 (fold (lambda (p ax) (compose-curves p ax)) ,ax ,pvar))
     677                                              `(let* ((,pvar (list-tabulate (inexact->exact ,n) (lambda (i) ,pexpr))))
     678                                                 (fold (lambda (p ax) (compose-curves p ax)) ,ax ,pvar))
     679                                              ))
     680                                        ))
     681                                     expr
     682                                     perturbation-exprs)))
     683                             
     684
    645685         (exprs  (map
     686
    646687                  (match-lambda
    647688                   ((process-name process-n)
     689
    648690                    (cases picnic:quantity (hash-table-ref sys process-name)
    649691                           (PS (name gfun init npts)   
     
    651693                                 (list
    652694                                  `(make-process
    653                                     ,(if init
    654                                          `(,gfun gid ,origin ,init-var)
    655                                          `(,gfun gid ,origin) )
     695                                    ,(make-perturbations
     696                                      (if init
     697                                          `(,gfun gid ,origin ,init-var)
     698                                          `(,gfun gid ,origin) ))
    656699                                    (inexact->exact ,npts))
    657700                                  init
     
    663706                                    (list
    664707                                     `(make-segmented-process
    665                                        ,(if init
    666                                             `(,gfun gid ,origin ,init-var)
    667                                             `(,gfun gid ,origin) )
     708                                       ,(make-perturbations
     709                                         (if init
     710                                             `(,gfun gid ,origin ,init-var)
     711                                             `(,gfun gid ,origin) ))
    668712                                       (inexact->exact ,nsegs)
    669713                                       (inexact->exact ,nsegpts))
Note: See TracChangeset for help on using the changeset viewer.