Changeset 30620 in project


Ignore:
Timestamp:
03/31/14 17:01:18 (7 years ago)
Author:
Ivan Raikov
Message:

npccl: adding bounds constructor and random uniform point generation to the expression language

Location:
release/4/npccl/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/4/npccl/trunk/examples/GL.npccl

    r30618 r30620  
    2222
    2323      (
     24
     25       (const xExtent = 1500)
     26       (const yExtent = 1000)
    2427
    2528       (const PFlength   = 1500)
     
    5558       (const AAtoGoCzone = 5.0)
    5659
     60       (const nGC  = 400)
     61       (const nGoC = 1)
     62
    5763       (component (type local-cell-forest) (name GC)
    5864
     
    6066         (component (type layout) (name GranuleTcoordinates)
    6167
    62                     (s = (PointsFromFile ("GCTcoordinates.sorted.dat")))
     68                    (b = (Bounds (yExtent 0. 0. xExtent)))
     69
     70                    (s = (UniformRandomPointProcess (nGC ~ (randomInit (19)) ~ (randomInit (21)) ~ b)))
    6371                 
    64                     (output s)
     72                    (output s b)
    6573            )
    6674
     
    117125         (component (type layout) (name GolgiCoordinates)
    118126
    119                     (s = (PointsFromFile ("GoCcoordinates.sorted.dat")))
     127                    (b = (Bounds (yExtent 0. 0. xExtent)))
     128
     129                    (s = (UniformRandomPointProcess (nGoC ~ (randomInit (23)) ~ (randomInit (29)) ~ b)))
    120130                 
    121                     (output s)
     131                    (output s b)
    122132            )
    123133         
  • release/4/npccl/trunk/npccl-core.scm

    r30536 r30620  
    275275
    276276          ;; floating point precision (single or double; default is double)
     277          (define  inttype        'int)
    277278          (define  fptype (lookup-def 'fpprec alst 'double))
     279          (define  boundstype     'bounds)
    278280          (define  rngstatetype   'rngstate)
    279281          (define  stringtype     'string)
     
    298300                )
    299301
     302          (define builtin-bounds-ops
     303                `(Bounds)
     304                )
     305
    300306          (define builtin-pointset-ops
    301                 `(PointsFromFile)
     307                `(PointsFromFile UniformRandomPointProcess)
    302308                )
    303309
    304310          (define builtin-ops (append builtin-projection-ops
     311                                      builtin-bounds-ops
    305312                                      builtin-path-ops
    306313                                      builtin-pointset-ops
     
    311318            (let (
    312319                  (pointset-procs
    313                    (list load-points-from-file)
     320                   (list load-points-from-file UniformRandomPointProcess)
    314321                   )
    315322
    316323                  (pointset-exprs
    317                    '(load-points-from-file)
     324                   '(load-points-from-file UniformRandomPointProcess)
    318325                   )
    319326
     
    324331                  (path-exprs
    325332                   '(make-line-segment)
     333                   )
     334
     335                  (bounds-procs
     336                   (list Bounds)
     337                   )
     338
     339                  (bounds-exprs
     340                   '(Bounds)
    326341                   )
    327342
     
    375390                                         (rt ,rt) (formals ,fms)))))
    376391                            (hash-table-set! env n fb)))
     392                        builtin-bounds-ops
     393                        bounds-procs
     394                        bounds-exprs
     395                        `((,fptype ,fptype ,fptype ,fptype))
     396                        `(,boundstype)
     397                        )
     398
     399              (for-each (lambda (n v qb fms rt)
     400                          (let ((fb (extend-procedure
     401                                     v `((name ,n) (eval-body ,qb)
     402                                         (rt ,rt) (formals ,fms)))))
     403                            (hash-table-set! env n fb)))
    377404                        builtin-pointset-ops
    378405                        pointset-procs
    379406                        pointset-exprs
    380                         `((,stringtype))
    381                         `(,pointsettype)
     407                        `((,stringtype) (,inttype ,rngstatetype ,rngstatetype ,boundstype))
     408                        `(,pointsettype ,pointsettype)
    382409                        )
    383410
  • release/4/npccl/trunk/npccl-utils.scm

    r30536 r30620  
    109109
    110110
    111         (define-record-type bounds
    112           (make-bounds top left bottom right)
    113           bounds?
    114           (top       bounds-top )
    115           (left      bounds-left )
    116           (bottom    bounds-bottom )
    117           (right     bounds-right )
    118           )
    119111       
    120112
     
    481473
    482474
    483         (define bounds-empty (make-bounds -inf.0 +inf.0 +inf.0 -inf.0))
    484 
    485 
    486         (define (bounds-translate b dx dy)
    487           (make-bounds (+ dy (bounds-top b))
    488                        (+ dx (bounds-left b))
    489                        (+ dy (bounds-bottom b))
    490                        (+ dx (bounds-right b))))
    491 
    492 
    493         (define (bounds-add b p)
    494           (make-bounds (fpmax (coord 1  p) (bounds-top b))
    495                        (fpmin (coord 0  p) (bounds-left b))
    496                        (fpmin (coord 1  p) (bounds-bottom b))
    497                        (fpmax (coord 0  p) (bounds-right b))))
    498 
    499475
    500476        (define-datatype layer-boundary layer-boundary?
    501           (Bounds (b bounds?))
    502           (BoundsXZ (b bounds?) (n integer?) (k integer?) (x f64vector?) (y f64vector?) (d f64vector?) (d2 f64vector?))
    503           (BoundsYZ (b bounds?) (n integer?) (k integer?) (x f64vector?) (y f64vector?) (d f64vector?) (d2 f64vector?))
    504           )
    505 
    506 
    507         (define (layer-boundary-bounds b)
    508           (cases layer-boundary b
    509                  (Bounds (b) b)
    510                  (BoundsXZ (b n k x y d d2) b)
    511                  (BoundsYZ (b n k x y d d2) b)))
     477          (Bounds (top number?) (left number?) (bottom number?) (right number?))
     478          (BoundsXZ (top number?) (left number?) (bottom number?) (right number?)
     479                    (n integer?) (k integer?) (x f64vector?) (y f64vector?) (d f64vector?) (d2 f64vector?))
     480          (BoundsYZ (top number?) (left number?) (bottom number?) (right number?)
     481                    (n integer?) (k integer?) (x f64vector?) (y f64vector?) (d f64vector?) (d2 f64vector?))
     482          )
     483
    512484
    513485
    514486        (define (boundary-z-extent-function boundary)
    515487          (cases layer-boundary boundary
    516                  (Bounds (b)
     488                 (Bounds (top left bottom right)
    517489                         (lambda (x y) 0.))
    518                  (BoundsXZ (b n k x y d d2)
     490                 (BoundsXZ (top left bottom right n k x y d d2)
    519491                           (lambda (xp yp)
    520492                             (let-values (((y0tab y1tab y2tab res)
    521493                                           (bvsp-spline:evaluate n k x y d d2 (f64vector xp) 0)))
    522494                               (f64vector-ref y0tab 0))))
    523                  (BoundsYZ (b n k x y d d2)
     495                 (BoundsYZ (top left bottom right n k x y d d2)
    524496                           (lambda (xp yp)
    525497                             (let-values (((y0tab y1tab y2tab res)
     
    529501
    530502
    531         (define (point2d-rejection boundary)
    532           (let ((top    (bounds-top boundary))
    533                 (bottom (bounds-bottom boundary))
    534                 (left   (bounds-left boundary))
    535                 (right  (bounds-right boundary)))
     503        (define (point2d-rejection top left bottom right)
    536504            (lambda (p)
    537505              (let ((x (coord 0 p)) (y (coord 1 p)))
    538506                (and (fp> x left)  (fp< x right) (fp> y bottom) (fp< y top) p)))
    539             ))
     507            )
    540508
    541509
     
    563531         
    564532          (cases layer-boundary boundary
    565                  (Bounds (b) 
     533                 (Bounds (top left bottom right) 
     534
    566535                         (let-values (((d d2 constr errc diagn)
    567536                                       (bvsp-spline:compute n k x-points z-points)))
     
    570539                               (error 'generate-boundary "error in constructing spline from boundary points" errc))
    571540                           
    572                            (BoundsXZ b n k x-points z-points d d2)))
     541                           (BoundsXZ top left bottom right n k x-points z-points d d2)))
    573542                 
    574543                 (else (error 'generate-boundary "boundary argument to XZAxis is already a pseudo-3D boundary")))
     
    578547        (define (Grid x-spacing y-spacing z-spacing boundary)
    579548
     549          (match-let (((top left bottom right)
     550                       (cases layer-boundary boundary
     551                                   (Bounds (top left bottom right)
     552                                           (list top left bottom right))
     553                                   (BoundsXZ (top left bottom right n k x y d d2)
     554                                             (list top left bottom right))
     555                                   (BoundsYZ (top left bottom right n k x y d d2)
     556                                             (list top left bottom right))
     557                                   )))
     558
    580559          (let* (
    581                  (xybounds  (cases layer-boundary boundary
    582                                    (Bounds (b) b)
    583                                    (BoundsXZ (b n k x y d d2) b)
    584                                    (BoundsYZ (b n k x y d d2) b)))
    585                  (x-extent   (- (bounds-right xybounds) (bounds-left xybounds)))
    586                  (y-extent   (- (bounds-top xybounds) (bounds-bottom xybounds)))
     560                 (x-extent   (- right left))
     561                 (y-extent   (- top bottom))
    587562                 (z-extent-function
    588563                  (boundary-z-extent-function boundary))
     
    639614                  )))
    640615            ))
    641 
     616          )
    642617
    643618        (define (UniformRandomPointProcess n x-seed y-seed boundary)
    644619
     620          (match-let (((top left bottom right)
     621                       (cases layer-boundary boundary
     622                                   (Bounds (top left bottom right)
     623                                           (list top left bottom right))
     624                                   (BoundsXZ (top left bottom right n k x y d d2)
     625                                             (list top left bottom right))
     626                                   (BoundsYZ (top left bottom right n k x y d d2)
     627                                             (list top left bottom right))
     628                                   )))
     629
    645630          (let* (
    646                  (xybounds  (cases layer-boundary boundary
    647                                    (Bounds (b) b)
    648                                    (BoundsXZ (b n k x y d d2) b)
    649                                    (BoundsYZ (b n k x y d d2) b)))
    650                  (x-extent   (- (bounds-right xybounds) (bounds-left xybounds)))
    651                  (y-extent   (- (bounds-top xybounds) (bounds-bottom xybounds)))
     631                 (x-extent   (- right left))
     632                 (y-extent   (- top bottom))
    652633                 (z-extent-function (boundary-z-extent-function boundary))
    653634                 )
    654635
    655             (let ((x-points (random-mtzig:f64vector-randu! n (random-mtzig:init x-seed)))
    656                   (y-points (random-mtzig:f64vector-randu! n (random-mtzig:init y-seed)))
    657                   (z-points (random-mtzig:f64vector-randu! n (random-mtzig:init (current-milliseconds)))))
     636            (let ((x-points (random-mtzig:f64vector-randu! (inexact->exact n) (random-mtzig:init x-seed)))
     637                  (y-points (random-mtzig:f64vector-randu! (inexact->exact n) (random-mtzig:init y-seed)))
     638                  (z-points (random-mtzig:f64vector-randu! (inexact->exact n) (random-mtzig:init (current-milliseconds)))))
    658639             
    659               (let ((point-rejection1 (point2d-rejection xybounds)))
     640              (let ((point-rejection1 (point2d-rejection top left bottom right)))
    660641               
    661642                (let recur ((i 0) (ax '()))
     
    675656                ))
    676657            ))
     658          )
    677659
    678660
    679661        (define (ClusteredRandomPointProcess cluster-pts n mean-distance x-seed y-seed boundary)
    680662
     663          (match-let (((top left bottom right)
     664                       (cases layer-boundary boundary
     665                                   (Bounds (top left bottom right)
     666                                           (list top left bottom right))
     667                                   (BoundsXZ (top left bottom right n k x y d d2)
     668                                             (list top left bottom right))
     669                                   (BoundsYZ (top left bottom right n k x y d d2)
     670                                             (list top left bottom right))
     671                                   )))
     672
     673
    681674          (let* (
    682                  (xybounds  (cases layer-boundary boundary
    683                                    (Bounds (b) b)
    684                                    (BoundsXZ (b n k x y d d2) b)
    685                                    (BoundsYZ (b n k x y d d2) b)))
    686                  (x-extent   (- (bounds-right xybounds) (bounds-left xybounds)))
    687                  (y-extent   (- (bounds-top xybounds) (bounds-bottom xybounds)))
     675                 (x-extent   (- right left))
     676                 (y-extent   (- top bottom))
    688677                 (z-extent-function (boundary-z-extent-function boundary))
    689678                 )
     
    695684                    (z-points (random-mtzig:f64vector-randu! n (random-mtzig:init (current-milliseconds)))))
    696685               
    697                 (let ((point-rejection1 (point2d-rejection xybounds)))
     686                (let ((point-rejection1 (point2d-rejection top left bottom right)))
    698687                 
    699688                  (let inner-recur ((j 0) (ax pts))
     
    718707                ))
    719708            ))
     709          )
    720710
    721711
Note: See TracChangeset for help on using the changeset viewer.