Changeset 13012 in project for release/3/nemo/trunk/nemo-nmodl.scm


Ignore:
Timestamp:
01/15/09 09:14:55 (12 years ago)
Author:
Ivan Raikov
Message:

Save.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/3/nemo/trunk/nemo-nmodl.scm

    r13004 r13012  
    5757  (enum-freevars rhs (list) (list)))
    5858
    59 (define (rhsexpr expr)
     59(define (rhsexpr/NMODL expr)
    6060  (match expr
    61          (('if . es)  `(if . ,(map (lambda (x) (rhsexpr x)) es)))
     61         (('if . es)  `(if . ,(map (lambda (x) (rhsexpr/NMODL x)) es)))
    6262         (('pow x y)  (if (and (integer? y)  (positive? y))
    6363                          (if (> y 1)  (let ((tmp (gensym "x")))
     
    6565                              x)
    6666                            expr))
    67          ((s . es)    (if (symbol? s)  (cons s (map (lambda (x) (rhsexpr x)) es)) expr))
     67         ((s . es)    (if (symbol? s)  (cons s (map (lambda (x) (rhsexpr/NMODL x)) es)) expr))
    6868         (id          (if (symbol? id) (nmodl-name id) id))))
    6969
     
    322322            (body     (lookup-def 'body lst)))
    323323        (pp indent ,nl (FUNCTION ,n (,(sl\ ", " vars)) "{" ))
    324         (let* ((body1 (canonicalize-expr/NMODL (rhsexpr body)))
     324        (let* ((body1 (canonicalize-expr/NMODL (rhsexpr/NMODL body)))
    325325               (lbs   (enum-bnds body1 (list))))
    326326          (if (not (null? lbs)) (pp indent+ (LOCAL ,(sl\ ", " lbs))))
     
    368368 
    369369
    370 (define (reaction-eqs n initial open transitions power method)
     370(define (reaction-transition-eqs n initial open transitions power method)
    371371  (match-let (((g  node-subs)  (transitions-graph n open transitions nmodl-state-name)))
    372372     (let* ((out-edges  (g 'out-edges))
     
    388388                                                      ((and (null? out) (not (null? in)))
    389389                                                       (sum (map third in)))))
    390                                          (fbody0 (rhsexpr rhs1)))
     390                                         (fbody0 (rhsexpr/NMODL rhs1)))
    391391                                    (case method
    392392                                      ((expeuler)  (cons (list name (canonicalize-expr/NMODL (expeuler 'dt name fbody0)))
     
    452452
    453453(define (state-init n init)
    454   (let* ((init  (rhsexpr init))
     454  (let* ((init  (rhsexpr/NMODL init))
    455455         (init1 (canonicalize-expr/NMODL init)))
    456456    (list (nmodl-name n) init1)))
     
    458458
    459459(define (asgn-eq n rhs)
    460   (let* ((fbody   (rhsexpr rhs))
     460  (let* ((fbody   (rhsexpr/NMODL rhs))
    461461         (fbody1  (canonicalize-expr/NMODL fbody)))
    462462    (list (nmodl-name n) fbody1)))
     
    498498
    499499
    500 (define (poset->state-eq-defs poset sys kinetic method)
     500(define (poset->rate-eq-defs poset sys kinetic method)
    501501  (fold-right
    502502   (lambda (lst ax)
     
    507507                               (cases nemo:quantity en
    508508                                      (REACTION  (name initial open transitions conserve power)
    509                                                  (append (reaction-eqs name initial open transitions power method) ax))
     509                                                 (append (reaction-transition-eqs name initial open transitions
     510                                                                                  power method) ax))
    510511                                     
    511512                                      (RATE (name initial rhs)
    512                                             (let ((fbody0  (rhsexpr rhs))
     513                                            (let ((fbody0  (rhsexpr/NMODL rhs))
    513514                                                  (dy      name ))
    514515                                              (case method
     
    525526
    526527
    527 (define (poset->kstate-eq-defs poset sys kinetic)
     528(define (poset->kinetic-eq-defs poset sys kinetic)
    528529  (fold-right
    529530   (lambda (lst ax)
     
    631632             (g             (match-let (((state-list asgn-list g) ((dis 'depgraph*) sys))) g))
    632633             (poset         (vector->list ((dis 'depgraph->bfs-dist-poset) g)))
    633              (asgn-eq-defs  (poset->asgn-eq-defs poset sys))
    634634             (ionch-info    (nemo:ionch-query sys))
    635635             (ionchs        (lookup-def 'ion-channels ionch-info))
     
    645645             (has-kinetic?  (or (not (null? (filter (lambda (x) (member (car x) kinetic)) states)))))
    646646             (has-ode?      (or (not (null? (filter (lambda (x) (not (member (car x) kinetic))) states)))
    647                                 (not (null? pool-ions)))))
     647                                (not (null? pool-ions))))
     648
     649             (asgn-eq-defs       (poset->asgn-eq-defs poset sys))
     650             (reaction-eq-defs   (poset->reaction-eq-defs poset sys kinetic))
     651             (rate-eq-defs       (reverse (poset->rate-eq-defs poset sys kinetic method)))
     652             (kstate-eq-defs     (poset->kinetic-eq-defs poset sys kinetic))
     653             (conserve-eq-defs   (poset->state-conserve-eq-defs poset sys))
     654             (state-init-defs    (poset->state-init-defs poset sys))
     655
     656             )
    648657
    649658
     
    762771               (begin
    763772                 (pp indent ,nl (PROCEDURE reactions () "{"))
    764                  (let* ((eq-defs   (poset->reaction-eq-defs poset sys kinetic))
    765                         (locals    (find-locals (map second eq-defs))) )
     773                 (let ((locals    (find-locals (map second reaction-eq-defs))) )
    766774                   (if (not (null? locals)) (pp indent+ (LOCAL ,(sl\ ", " locals))))
    767775                   (for-each (lambda (def)
    768776                               (let ((n (nmodl-name (first def))) (b (second def)))
    769                                  (pp indent+ ,(expr->string/NMODL b n)))) eq-defs))
     777                                 (pp indent+ ,(expr->string/NMODL b n)))) reaction-eq-defs))
    770778                 
    771779                 (pp indent "}")))
     
    852860                                            (if (null? ps)
    853861                                                (let* ((sum0  (sum summands))
    854                                                        (sum1  (rhsexpr sum0))
     862                                                       (sum1  (rhsexpr/NMODL sum0))
    855863                                                       (sum2  (canonicalize-expr/NMODL sum1)))
    856864                                                  (cons (list i sum2) ax))
     
    859867                                           
    860868                                         ((i e gion)
    861                                           (let* ((expr0  (rhsexpr (if e `(* ,gion (- v ,e)) gion)))
     869                                          (let* ((expr0  (rhsexpr/NMODL (if e `(* ,gion (- v ,e)) gion)))
    862870                                                 (expr1  (canonicalize-expr/NMODL expr0)))
    863871                                            (cons (list i expr1) ax)))
     
    879887           
    880888           (if has-ode?
    881                (let* ((eq-defs  (reverse (poset->state-eq-defs poset sys kinetic method)))
    882                       (locals   (find-locals (map second eq-defs))))
     889               (let ((locals   (find-locals (map second rate-eq-defs))))
    883890                 (case method
    884891                   ((expeuler) (pp indent ,nl (PROCEDURE states () "{")))
     
    892899                                     (b (second def)))
    893900                                 (pp indent+ ,(expr->string/NMODL b n))))
    894                              eq-defs))
     901                             rate-eq-defs))
    895902                 (pp indent "}")))
    896903
     
    898905               (begin
    899906                 (pp indent ,nl (KINETIC kstates "{"))
    900                  (let* ((keq-defs          (poset->kstate-eq-defs poset sys kinetic))
    901                         (locals            (concatenate (find-locals (map third (map second keq-defs)))))
    902                         (conserve-eq-defs  (poset->state-conserve-eq-defs poset sys)))
     907                 (let ((locals            (concatenate (find-locals (map third (map second kstate-eq-defs))))))
    903908                   (if (not (null? locals)) (pp indent+ (LOCAL ,(sl\ ", " locals))))
    904909                   (for-each
     
    907912                             (eqs           (second def))
    908913                             (conserve-eqs  (lookup-def n conserve-eq-defs)))
    909                        
    910914                        (for-each
    911915                         (lambda (eq)
     
    926930                                    conserve-eqs))
    927931                        ))
    928                     keq-defs))
     932                    kstate-eq-defs))
    929933                 (pp indent "}")))
    930934           
    931935           
    932            (let* ((init-defs         (poset->state-init-defs poset sys))
    933                   (locals            (concatenate (find-locals (map second init-defs)))) )
     936           (let ((locals (concatenate (find-locals (map second state-init-defs)))) )
    934937               (pp indent ,nl (INITIAL "{"))
    935938               (if (not (null? locals)) (pp indent+ (LOCAL ,(sl\ ", " locals))))
     
    937940               (for-each (lambda (def)
    938941                           (let ((n (first def)) (b (second def)))
    939                              (pp indent+ ,(expr->string/NMODL b n)))) init-defs)
     942                             (pp indent+ ,(expr->string/NMODL b n)))) state-init-defs)
    940943
    941944               (if has-kinetic?
     
    944947               (pp indent "}")
    945948
     949               (pp indent ,nl (PROCEDURE print_state () "{"))
     950
     951               (let ((lst (sort (map (compose ->string first) rate-eq-defs) string<?)))
     952                 (for-each (lambda (x)
     953                             (pp indent+ (printf (,(s+ #\" x " = %g\\n"  #\") ", " ,x ))))
     954                           lst))
     955
     956               (pp indent "}")
     957
    946958               ))))))
Note: See TracChangeset for help on using the changeset viewer.