Changeset 31144 in project for release/4/picnic/trunk/picnic.scm


Ignore:
Timestamp:
07/23/14 11:58:27 (6 years ago)
Author:
Ivan Raikov
Message:

picnic: working support for swc morphologies

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/4/picnic/trunk/picnic.scm

    r31049 r31144  
    333333                             (match-lambda
    334334                              (('section name id) (list name id))
     335                              (else #f))
     336                             subcomponents))))
     337                  cell-forests))
     338
     339            (cell-swc-section-comps
     340             (map (lambda (forest)
     341                    (let ((subcomponents (subcomps sys (cid forest))))
     342                      (cons forest
     343                            (filter-map
     344                             (match-lambda
     345                              (('swc-section name id) (list name id))
    335346                              (else #f))
    336347                             subcomponents))))
     
    458469              cell-section-comps))
    459470
     471            (cell-swc-sections
     472              (map
     473               (lambda (sections)
     474                 (let ((forest (first sections)))
     475                   (cons forest
     476                         (reverse
     477                          (second
     478                           (fold
     479                            (match-lambda* ((section (start-index lst))
     480                             (let* (
     481                                    (label    (cn section))
     482                                    (exports  (component-exports sys (cid section)))
     483                                    (imports  (component-imports sys (cid section)))
     484                                    (swcs     (let recur ((swcs '()) (exports exports))
     485                                                (if (null? exports)
     486                                                    (reverse swcs)
     487                                                    (recur (cons (car exports) swcs)
     488                                                           (cdr exports))))
     489                                              )
     490                                   )
     491                               (d "label of ~A = ~A~%" (cid section) label)
     492                               (d "exports in ~A = ~A~%" section exports)
     493                               (d "imports in ~A = ~A~%" section imports)
     494                               (d "swcs in ~A = ~A~%" section swcs)
     495                               (list
     496                                (fold (lambda (x ax) (+ 1 ax)) start-index swcs)
     497                                (cons (cons label (make-section-descriptor label start-index swcs '())) lst))
     498                               )))
     499                            (list 0 '())
     500                            (rest sections)))
     501                          ))
     502                   ))
     503               cell-swc-section-comps)
     504              )
     505
    460506            ;; TODO: check that source/target populations are either:
    461507            ;; local/global
     
    503549              (match-lambda
    504550               ((forest layout . rest)
    505                 (let ((sections (map cdr (alist-ref forest cell-sections))))
    506                   (pp (forest-codegen/scheme sys forest layout sections))
     551                (let ((sections (map cdr (alist-ref forest cell-sections)))
     552                      (swc-sections (map cdr (alist-ref forest cell-swc-sections))))
     553                  (pp (forest-codegen/scheme sys forest layout sections swc-sections))
    507554                  )))
    508555              cell-layouts)
     
    536583(use srfi-1 mathh matchable kd-tree mpi getopt-long picnic-utils)
    537584(include "mathh-constants")
     585
     586(define (choose lst n) (list-ref lst (random n)))
    538587
    539588(define picnic-write-pointsets (make-parameter #f))
     
    833882     ))
    834883 
     884                               
     885(define (invoke-swc-loader/scheme sys section-name section-start-index
     886                                 section-swcs layout-name forest-name forest-type)
     887  (d "invoke-swc-loader: sections-swcs = ~A~%" section-swcs)
     888  (let* (
     889         (origin (gensym 'p))
     890
     891         (make-section 'make-segmented-section)
     892
     893         (swc-exprs
     894          (map
     895           
     896           (match-lambda*
     897            ((swc-name)
     898             (d "invoke-swc-loader: swc quantity = ~A~%"
     899                (hash-table-ref sys swc-name))
     900             
     901             (cases picnic:quantity (hash-table-ref sys swc-name)
     902                   
     903                    (SWC (name path type nsegs)   
     904                         `(load-swcdir ,path (quote ,name) ,type (inexact->exact ,nsegs)) )
     905                    )))
     906
     907           section-swcs))
     908
     909         ;;
     910         )
     911
     912      `(let*
     913           (
     914            (swc-pools (list . ,swc-exprs))
     915
     916
     917            (result
     918             (fold-right
     919              (match-lambda*
     920               (((gid ,origin) lst)
     921                (match-let
     922                 (((i pts)
     923                   (fold
     924
     925                    (match-lambda*
     926                     ((f (i lst))
     927                      (list (+ i 1)
     928                            (append
     929                             (list-tabulate
     930                              1 (lambda (j) (list (+ i j 1) (f gid ,origin))))
     931                             lst))))
     932
     933                    (list (inexact->exact ,section-start-index) '())
     934                    (map (lambda (swc-pool)
     935                           (let ((swc-pool-n (length swc-pool)))
     936                             (lambda (cell-index cell-origin)
     937                               (match-let (((type g gdistv gsegv) (choose swc-pool swc-pool-n)))
     938                                          (tree-graph->section-points cell-index cell-origin type g gdistv gsegv)))))
     939                         swc-pools)
     940                    )))
     941                 
     942                 (cons (,make-section gid ,origin (quote ,section-name) pts)
     943                       lst))
     944                ))
     945              '()
     946              ,layout-name))
     947            )
     948
     949         (if (picnic-write-sections)
     950             ,(case forest-type
     951                ((local)
     952                 `(write-sections (quote ,forest-name) (quote ,section-name) ,layout-name result myrank))
     953                ((global)
     954                 `(write-sections (quote ,forest-name) (quote ,section-name) ,layout-name result))))
     955         result
     956         ))
     957
     958     )
     959 
    835960
    836961
     
    8771002
    8781003
    879 (define (forest-codegen/scheme sys forest layout sections)
     1004(define (forest-codegen/scheme sys forest layout sections swc-sections)
    8801005
    8811006  (define (forest-type x)  (third x))
     
    8871012  (d "layout = ~A~%" layout)
    8881013  (d "sections = ~A~%" sections)
     1014  (d "swc-sections = ~A~%" swc-sections)
    8891015
    8901016
     
    9051031                   (->string (section-descriptor-label section))))))
    9061032              sections))
     1033
     1034        (swc-section-names
     1035         (map (lambda (section)
     1036                (gensym
     1037                 (string->symbol
     1038                  (string-append
     1039                   (->string (cn forest))
     1040                   (->string (section-descriptor-label section))))))
     1041              swc-sections))
    9071042        )
    9081043
     
    9481083               layout
    9491084               ))
    950             .
    951             ,(map
    952               (lambda (section section-name)
    953                 (let ((section-perturbations (section-descriptor-perturbations section))
    954                       (section-processes (section-descriptor-processes section))
    955                       (section-label (section-descriptor-label section))
    956                       (section-start-index (section-descriptor-start-index section)))
    957                   `(,section-name
    958                     ,(invoke-generator/scheme sys section-label section-start-index
    959                                               section-processes section-perturbations
    960                                               layout-name (cn forest) (forest-type forest)))
    961                   ))
     1085           
     1086            ,@(map
     1087               (lambda (section section-name)
     1088                 (let ((section-perturbations (section-descriptor-perturbations section))
     1089                       (section-processes (section-descriptor-processes section))
     1090                       (section-label (section-descriptor-label section))
     1091                       (section-start-index (section-descriptor-start-index section)))
     1092                   `(,section-name
     1093                     ,(invoke-generator/scheme sys section-label section-start-index
     1094                                               section-processes section-perturbations
     1095                                               layout-name (cn forest) (forest-type forest)))
     1096                   ))
    9621097              sections
    9631098              section-names)
     1099           
     1100            ,@(map
     1101               (lambda (section section-name)
     1102                 (let (
     1103                       (section-swcs  (section-descriptor-processes section))
     1104                       (section-label (section-descriptor-label section))
     1105                       (section-start-index (section-descriptor-start-index section))
     1106                       )
     1107                   `(,section-name
     1108                     ,(invoke-swc-loader/scheme sys section-label section-start-index
     1109                                                section-swcs layout-name
     1110                                                (cn forest) (forest-type forest)))
     1111                   ))
     1112              swc-sections
     1113              swc-section-names)
    9641114           
    9651115            )
     
    9691119            (((gid p) ,@section-names lst)
    9701120             (cons (make-cell (quote ,(cn forest)) gid p
    971                               (list . ,section-names)) lst)
     1121                              (list . ,(append section-names swc-section-names)))
     1122                   lst)
    9721123             ))
    9731124           '()
Note: See TracChangeset for help on using the changeset viewer.