Changeset 30671 in project


Ignore:
Timestamp:
04/09/14 09:02:54 (7 years ago)
Author:
Ivan Raikov
Message:

picnic: reformulated gid assignment based on layout; added mpi-aware write-layouts procedure

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

Legend:

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

    r30663 r30671  
    7171         (component (type layout) (name GranuleTcoordinates)
    7272
    73                     (s = (PointsFromFile ("GCTcoordinates1.dat")))
     73                    (s = (PointsFromFile ("GCTcoordinates.dat")))
    7474                 
    7575                    (output s)
  • release/4/picnic/trunk/picnic-utils.scm

    r30670 r30671  
    136136            (call-with-output-file (sprintf "~A.sorted.dat" name)
    137137              (lambda (out)
    138                 (for-each (lambda (x)
    139                             (fprintf out "~A ~A ~A~%"
    140                                      (coord 0 x)
    141                                      (coord 1 x)
    142                                      (coord 2 x)))
     138                (for-each (match-lambda
     139                           ((gid p)
     140                            (fprintf out "~A ~A ~A ~A~%"
     141                                     gid
     142                                     (coord 0 p)
     143                                     (coord 1 p)
     144                                     (coord 2 p))))
    143145                          pts))
    144146              ))
    145147
    146         (define (write-sections forest-name section-name sections)
    147           (call-with-output-file (sprintf "~A.~A.section.dat" forest-name section-name)
     148       
     149        (define (write-layout name pts #!optional rank)
     150            (call-with-output-file (if rank
     151                                       (sprintf "~A.~A.layout.dat" name rank)
     152                                       (sprintf "~A.layout.dat" name))
     153              (lambda (out)
     154                (for-each (match-lambda
     155                           ((gid p)
     156                            (fprintf out "~A ~A ~A ~A~%"
     157                                     gid
     158                                     (coord 0 p)
     159                                     (coord 1 p)
     160                                     (coord 2 p))))
     161                          pts))
     162              ))
     163
     164        (define (write-sections forest-name section-name layout sections #!optional rank)
     165          (call-with-output-file (if rank
     166                                     (sprintf "~A.~A.~A.section.dat" forest-name section-name rank)
     167                                     (sprintf "~A.~A.section.dat" forest-name section-name))
    148168            (lambda (out)
    149               (fold-right
    150                (lambda (section i)
    151                  (fprintf out "~A " i)
     169              (for-each
     170               (match-lambda*
     171                (((gid p) section)
     172                 (fprintf out "~A " gid)
    152173                 (for-each
    153174                  (lambda (neurites)
     
    160181                                  (coord 2 p))))
    161182                     (cdr neurites)))
    162                     (cdr section))
    163                   (fprintf out "~%")
    164                   (+ i 1))
    165                1
     183                  (cdr section))
     184                 (fprintf out "~%")
     185                 ))
     186               layout
    166187               sections))))
    167188
  • release/4/picnic/trunk/picnic.scm

    r30669 r30671  
    470470
    471471(define picnic-write-pointsets (make-parameter #f))
     472(define picnic-write-layouts (make-parameter #f))
    472473(define picnic-write-sections (make-parameter #f))
    473474(define local-config (make-parameter '()))
     
    479480  `(
    480481
    481     (write-pointsets "write generated pointsets to files"
     482    (write-pointsets "write generated or loaded pointsets to files"
    482483                     (single-char #\p))
     484   
     485    (write-layouts "write layouts to files"
     486                   (single-char #\l))
    483487   
    484488    (write-sections "write generated sections to files"
     
    516520(if (opt 'write-pointsets)
    517521    (picnic-write-pointsets #t))
     522
     523(if (opt 'write-layouts)
     524    (picnic-write-layouts #t))
    518525
    519526(if (opt 'write-sections)
     
    598605
    599606                               
    600 (define (invoke-generator/scheme sys section-name section-processes layout-name forest-name)
     607(define (invoke-generator/scheme sys section-name section-processes layout-name forest-name forest-type)
    601608  (let* ((origin (gensym 'p))
    602609         (make-section (cases picnic:quantity
     
    643650                        x exprs))
    644651      `(let ((result
    645               (second
    646                (fold
    647                 (match-lambda*
    648                  ((,origin (gid lst))
    649                   (list (+ 1 gid)
    650                         (cons (,make-section
    651                                gid ,origin (quote ,section-name)
    652                                (second
    653                                 (fold (match-lambda*
    654                                        (((f n) (i lst))
    655                                         (list (+ i n)
    656                                               (append
    657                                                (list-tabulate
    658                                                 n (lambda (j) (list (+ i j) (f)))) lst))))
    659                                       (list 0 '())
    660                                       (list . ,(map (match-lambda
    661                                                      ((expr init init-var n)
    662                                                       `(list (lambda () ,expr)
    663                                                              (inexact->exact ,n))))
    664                                                     exprs)))))
    665                               lst))))
    666                 (list 0 (list))
    667                 ,layout-name))))
     652              (fold
     653               (match-lambda*
     654                (((gid ,origin) lst)
     655                 (cons (,make-section
     656                        gid ,origin (quote ,section-name)
     657                        (second
     658                         (fold (match-lambda*
     659                                (((f n) (i lst))
     660                                 (list (+ i n)
     661                                       (append
     662                                        (list-tabulate
     663                                         n (lambda (j) (list (+ i j) (f)))) lst))))
     664                               (list 0 '())
     665                               (list . ,(map (match-lambda
     666                                              ((expr init init-var n)
     667                                               `(list (lambda () ,expr)
     668                                                      (inexact->exact ,n))))
     669                                             exprs)))))
     670                       lst)))
     671                (list)
     672                ,layout-name)))
    668673         (if (picnic-write-sections)
    669              (write-sections (quote ,forest-name) (quote ,section-name) result))
     674             ,(case forest-type
     675                ((local)
     676                 `(write-sections (quote ,forest-name) (quote ,section-name) ,layout-name result myrank))
     677                ((global)
     678                 `(write-sections (quote ,forest-name) (quote ,section-name) ,layout-name result))))
    670679         result
    671680         ))
     
    713722           (
    714723            (,layout-name
    715              (let* ((pts (kd-tree->list 
     724             (let* ((pts (kd-tree->list*
    716725                          (car ,(fold-right
    717726                                 (lambda (xs ax)
     
    737746                    )
    738747               (if (picnic-write-pointsets)
    739                    (write-pointset (quote ,(cn forest)) layout))
     748                   (write-pointset (quote ,(cn forest)) pts))
     749               (if (picnic-write-layouts)
     750                   ,(case (forest-type forest)
     751                      ((local)
     752                       `(write-layout (quote ,(cn forest)) layout myrank))
     753                      ((global)
     754                       `(write-layout (quote ,(cn forest)) layout))))
    740755               layout
    741756               ))
     
    746761                      (section-label (section-descriptor-label section)))
    747762                  `(,section-name
    748                     ,(invoke-generator/scheme sys section-label section-processes layout-name (cn forest)))
     763                    ,(invoke-generator/scheme sys section-label section-processes layout-name
     764                                              (cn forest) (forest-type forest)))
    749765                  ))
    750766              sections
     
    753769            )
    754770         
    755          (first
    756771          (fold-right
    757772           (match-lambda*
    758             ((p ,@section-names (lst i))
    759              (list (cons (make-cell (quote ,(cn forest)) i p
    760                                     (list . ,section-names)) lst)
    761                    (+ i 1) )))
    762            (list '() 0)
    763            ,layout-name . ,section-names))
     773            (((gid p) ,@section-names lst)
     774             (cons (make-cell (quote ,(cn forest)) gid p
     775                              (list . ,section-names)) lst)
     776             ))
     777           '()
     778           ,layout-name . ,section-names)
    764779         
    765780         ))
Note: See TracChangeset for help on using the changeset viewer.