Changeset 12367 in project


Ignore:
Timestamp:
11/06/08 01:37:23 (13 years ago)
Author:
Ivan Raikov
Message:

Added support for conservation equations and updated AKP model accordingly.

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

Legend:

Unmodified
Added
Removed
  • release/3/nemo/trunk/examples/AKP06/Na.nemo

    r12238 r12367  
    9393                      (<-> C4 I4 fi4 bi4)
    9494                      (<-> C5 I5 fi5 bi5))
     95
     96                      (conserve (1 = (C1 + C2 + C3 + C4 + C5 + O + B + I1 + I2 + I3 + I4 + I5 + I6)))
    9597                     
    9698                     (initial-equilibrium
  • release/3/nemo/trunk/examples/AKP06/Narsg.nemo

    r12238 r12367  
    9393                      (<-> C4 I4 fi4 bi4)
    9494                      (<-> C5 I5 fi5 bi5))
     95                     
     96                      (conserve (1 = (C1 + C2 + C3 + C4 + C5 + O + B + I1 + I2 + I3 + I4 + I5 + I6)))
    9597                     
    96                      (initial-equilibrium 
     98                     (initial-equilibrium       
    9799                      (0 = ((I1 * bi1) + (C2 * b01) + (neg (C1 * (fi1 + f01)) )))
    98100                      (0 = ((C1 * f01) + (I2 * bi2) + (C3 * b02) + (neg (C2 * (b01 + fi2 + f02)) )))
  • release/3/nemo/trunk/nemo-core.scm

    r12232 r12367  
    104104  (ASGN       (name symbol?) (value number?) (rhs rhs?) )
    105105  (CONST      (name symbol?) (value number?))
    106   (TSCOMP     (name symbol?) (initial (lambda (x) (or (rhs? x) (and (list? x) (every lineq? x)))))
    107               (open (lambda (x) (or (symbol? x) (and (list? x) (every symbol? x) ))))
    108               (transitions (lambda (x) (and (list? x) (every transition? x))))
    109               (power integer?))
     106  (TSCOMP     (name symbol?)
     107              (initial      (lambda (x) (or (rhs? x) (and (list? x) (every lineq? x)))))
     108              (open         (lambda (x) (or (symbol? x) (and (list? x) (every symbol? x) ))))
     109              (transitions  (lambda (x) (and (list? x) (every transition? x))))
     110              (conserve     (lambda (x) (or (not x) (and (list? x) (every lineq? x)))))
     111              (power        integer?))
    110112  (PRIM       (name symbol?) (value identity))
    111113  (EXTERNAL   (local-name symbol?) (name symbol?) (namespace (optional symbol?)))
     
    344346                                                  (nemo:error 'env-extend! ": invalid transition " t))))
    345347                                        (or (alist-ref 'transitions alst) (list))))
     348                                  (conserve      (lookup-def 'conserve alst))
    346349                                  (open          (lookup-def 'open alst)))
    347350                              (if (null? transitions)
     
    354357                                              ": definition for state " sym
    355358                                              " requires an integer power (" power  " was given)"))
    356                               (let ((en (TSCOMP name initial open transitions power)))
     359                             
     360                              (let ((en (TSCOMP name initial open transitions (and conserve (list conserve)) power)))
    357361                                (environment-extend! nemo-env sym en)))))
    358362
     
    567571                      (if (nemo:quantity? x)
    568572                           (cases nemo:quantity x
    569                                   (TSCOMP (name initial open transitions power)
     573                                  (TSCOMP (name initial open transitions conserve power)
    570574                                          (let* ((ss1 (delete-duplicates (append (map second transitions)
    571575                                                                                 (map third transitions))))
     
    582586                      (if (nemo:quantity? x)
    583587                           (cases nemo:quantity x
    584                                   (TSCOMP (name initial open transitions power)
     588                                  (TSCOMP (name initial open transitions conserve power)
    585589                                          (cons name ax))
    586590                                  (else ax))
     
    622626                              (fprintf out "    value: ~a\n" value)))
    623627
    624                      (TSCOMP (name initial open transitions power)
     628                     (TSCOMP (name initial open transitions conserve power)
    625629                             (begin
    626630                               (fprintf out "~a: transition state complex\n" name)
     
    909913                                    (let ((initial      (lookup-def 'initial alst))
    910914                                          (initial-eq   (alist-ref 'initial-equilibrium alst))
     915                                          (conserve-eq  (alist-ref 'conserve alst))
    911916                                          (power        (eval-const (parse-expr (lookup-def 'power alst))))
    912917                                          (transitions
     
    932937                                             (and initial-eq (map (lambda (eq)
    933938                                                                    `(,(first eq) = ,(parse-expr (third eq))))
    934                                                                   initial-eq))))
     939                                                                  initial-eq)))
     940                                            (conserve-eq
     941                                             (and conserve-eq (map (lambda (eq)
     942                                                                     `(,(first eq) = ,(parse-expr (third eq))))
     943                                                                   conserve-eq))))
    935944
    936945                                        (if (and initial-eq
     
    940949                                                        "must be a list of linear equations"))
    941950                                       
     951                                        (if (and (list? conserve-eq) (not (every lineq? conserve-eq)))
     952                                            (nemo:error 'env-extend!
     953                                                        ": conservation equation for " id
     954                                                        " must be a linear equation: " conserve-eq))
     955
    942956                                        (let ((initialv (and initial (eval-const (parse-expr initial)))))
    943957                                          (apply env-extend!
    944958                                                 (cons* id '(tscomp) (or initialv initial-eq) `(power ,power)
    945                                                         (alist-update! 'transitions transitions alst)))
     959                                                        (alist-update! 'conserve conserve-eq
     960                                                          (alist-update! 'transitions transitions alst))
     961                                                        ))
    946962                                          (cons id qs)))))
    947963
  • release/3/nemo/trunk/nemo-nmodl.scm

    r12353 r12367  
    9999(define (s+ . lst)    (string-concatenate (map ->string lst)))
    100100(define (sw+ lst)     (string-intersperse (filter-map (lambda (x) (and x (->string x))) lst) " "))
    101 (define (s\ p . lst)  (string-intersperse (map ->string lst) p))
    102101(define (sl\ p lst)   (string-intersperse (map ->string lst) p))
    103102(define nl "\n")
     
    137136                                (binop/NMODL (format-op/NMODL indent op (take lst n/2 )) op1
    138137                                         (format-op/NMODL indent op (drop lst n/2 )))))))))
     138
     139
     140(define (format-lineq-op/NMODL indent op args)
     141  (let ((op1 (doc:text (->string op))))
     142    (if (null? args) op1
     143        (match args
     144               ((x)      (doc:concat (list op1 x)))
     145               ((x y)    (doc:concat (intersperse (list x op1 y) (doc:space))))
     146               ((x y z)  (doc:concat (intersperse (list x op1 y op1 z) (doc:space))))
     147               (lst      (let* ((n   (length lst))
     148                                (n/2 (inexact->exact (round (/ n 2)))))
     149                           (doc:concat
     150                            (intersperse
     151                             (list (format-lineq-op/NMODL indent op (take lst n/2 )) op1
     152                                   (format-lineq-op/NMODL indent op (drop lst n/2 )))
     153                             (doc:space)))))))))
    139154
    140155(define (format-fncall/NMODL indent op args)
     
    338353                       (block/NMODL (format-lineq/NMODL indent e (first x)))))
    339354                     (else
    340                       (format-op/NMODL indent+ " = "
     355                      (format-lineq-op/NMODL indent+ " = "
    341356                                       (list (format-lineq/NMODL indent (first x) )
    342357                                             (format-lineq/NMODL indent (second x))))))
     
    344359           (doc:empty) bindings)
    345360         (let ((body1 (doc:nest indent (format-lineq/NMODL indent body))))
    346            (if rv  (format-op/NMODL indent " = " (list (format-lineq/NMODL indent+ rv ) body1))
     361           (if rv  (format-lineq-op/NMODL indent " = " (list (format-lineq/NMODL indent+ rv ) body1))
    347362               body1))))
    348363       
     
    358373                      (case op
    359374                        ((/) 
    360                          (format-op/NMODL indent op
     375                         (format-lineq-op/NMODL indent op
    361376                                          (map (lambda (x)
    362377                                                 (let ((fx (format-lineq/NMODL indent+ x)))
     
    364379                                                       (if (or mul? plmin?) (group/NMODL fx) fx)))) rest)))
    365380                        ((*) 
    366                          (format-op/NMODL indent op
     381                         (format-lineq-op/NMODL indent op
    367382                                          (map (lambda (x)
    368383                                                 (let ((fx (format-lineq/NMODL indent+ x)))
     
    371386                       
    372387                        ((^) 
    373                          (format-op/NMODL indent op
     388                         (format-lineq-op/NMODL indent op
    374389                                          (map (lambda (x)
    375390                                                 (let ((fx (format-lineq/NMODL indent+ x)))
     
    378393                       
    379394                        (else
    380                          (format-op/NMODL indent op
     395                         (format-lineq-op/NMODL indent op
    381396                                          (map (lambda (x)
    382397                                                 (let ((fx (format-lineq/NMODL indent+ x))) fx)) rest)))))
    383398                   
    384399                    (case op
    385                       ((neg) (format-op/NMODL indent '* (map (lambda (x) (format-lineq/NMODL indent+ x))
     400                      ((neg) (format-lineq-op/NMODL indent '* (map (lambda (x) (format-lineq/NMODL indent+ x))
    386401                                                             (cons "(-1)" rest))))
    387402                      (else  (format-fncall/NMODL indent op (map (lambda (x) (format-lineq/NMODL indent+ x))
    388403                                                                 rest)))))))
    389404
    390            (if rv (format-op/NMODL indent " = " (list (format-lineq/NMODL indent+ rv ) fe)) fe))))
     405           (if rv (format-lineq-op/NMODL indent " = " (list (format-lineq/NMODL indent+ rv ) fe)) fe))))
    391406     
    392407      (else  (let ((fe (doc:text (->string expr))))
    393408               (if rv
    394                    (format-op/NMODL indent " = " (list (format-lineq/NMODL indent+ rv ) fe))
     409                   (format-lineq-op/NMODL indent " = " (list (format-lineq/NMODL indent+ rv ) fe))
    395410                   fe)))))))
    396411               
     
    400415  (let-optionals rest ((width 72))
    401416    (s+ "~ " (sdoc->string (doc:format width (format-lineq/NMODL 2 x #f)))
     417        " = " (number->string val))))
     418 
     419         
     420(define (conserve-lineq->string/NMODL x val . rest)
     421  (let-optionals rest ((width 72))
     422    (s+ "CONSERVE " (sdoc->string (doc:format width (format-lineq/NMODL 2 x #f)))
    402423        " = " (number->string val))))
    403424 
     
    519540         (state-subs     (fold (lambda (s ax) (subst-extend s (nmodl-state-name n s) ax)) subst-empty state-list)))
    520541    ;; generate kinetic equations for each edge in the transitions system
    521     (map
    522      (lambda (e)
    523        (match e
    524               (('-> s0 s1 rexpr)
    525                (let ((i  (lookup-def s0 state-subs))
    526                      (j  (lookup-def s1 state-subs)))
    527                  `(-> ,i ,j ,(subst-convert rexpr state-subs))))
    528              
    529               ((s0 '-> s1 rexpr)
    530                (let ((i  (lookup-def s0 state-subs))
    531                      (j  (lookup-def s1 state-subs)))
    532                  `(-> ,i ,j ,(subst-convert rexpr state-subs))))
    533              
    534               (('<-> s0 s1 rexpr1 rexpr2)
    535                (let ((i  (lookup-def s0 state-subs))
    536                      (j  (lookup-def s1 state-subs)))
    537                  `(<-> ,i ,j ,(subst-convert rexpr1 state-subs) ,(subst-convert rexpr2 state-subs))))
    538              
    539               ((s0 '<-> s1 rexpr1 rexpr2)
    540                (let ((i  (lookup-def s0 state-subs))
    541                      (j  (lookup-def s1 state-subs)))
    542                  `(<-> ,i ,j ,(subst-convert rexpr1 state-subs) ,(subst-convert rexpr2 state-subs))))
    543              
    544                  
    545               (else (nemo:error 'nemo:nmodl-kstate-eqs ": invalid transition equation "
    546                                 e " in state complex " n))))
    547      transitions)))
     542    (list n
     543          (map
     544           (lambda (e)
     545             (match e
     546                    (('-> s0 s1 rexpr)
     547                     (let ((i  (lookup-def s0 state-subs))
     548                           (j  (lookup-def s1 state-subs)))
     549                       `(-> ,i ,j ,(subst-convert rexpr state-subs))))
     550                   
     551                    ((s0 '-> s1 rexpr)
     552                     (let ((i  (lookup-def s0 state-subs))
     553                           (j  (lookup-def s1 state-subs)))
     554                       `(-> ,i ,j ,(subst-convert rexpr state-subs))))
     555                   
     556                    (('<-> s0 s1 rexpr1 rexpr2)
     557                     (let ((i  (lookup-def s0 state-subs))
     558                           (j  (lookup-def s1 state-subs)))
     559                       `(<-> ,i ,j ,(subst-convert rexpr1 state-subs) ,(subst-convert rexpr2 state-subs))))
     560                   
     561                    ((s0 '<-> s1 rexpr1 rexpr2)
     562                     (let ((i  (lookup-def s0 state-subs))
     563                           (j  (lookup-def s1 state-subs)))
     564                       `(<-> ,i ,j ,(subst-convert rexpr1 state-subs) ,(subst-convert rexpr2 state-subs))))
     565                   
     566                   
     567                    (else (nemo:error 'nemo:nmodl-kstate-eqs ": invalid transition equation "
     568                                      e " in state complex " n))))
     569           transitions))))
    548570       
    549571
     
    555577
    556578
    557 (define (state-init-eq n transitions init)
     579(define (state-lineqs n transitions lineqs)
    558580  (let* ((subst-convert  (subst-driver (lambda (x) (and (symbol? x) x)) binding? identity bind subst-term))
    559581         (state-list     (let loop ((lst (list)) (tlst transitions))
     
    569591                                       (loop (cons* s0 s1 lst) (cdr tlst)))
    570592                                      (else
    571                                        (nemo:error 'nemo:state-init-eq ": invalid transition equation "
     593                                       (nemo:error 'nemo:state-lineq ": invalid transition equation "
    572594                                                   (car tlst) " in state complex " n))
    573595                                      (else (loop lst (cdr tlst)))))))
    574596         (state-subs     (fold (lambda (s ax) (subst-extend s (nmodl-state-name n s) ax)) subst-empty state-list))
    575          (init1          (map (lambda (lineq) (match lineq ((i '= . expr) `(,i = . ,(subst-convert expr state-subs)))))
    576                               init)))
    577     (list (nmodl-name n) init1)))
     597         (lineqs1        (map (lambda (lineq) (match lineq ((i '= . expr) `(,i = . ,(subst-convert expr state-subs)))))
     598                              lineqs)))
     599    (list (nmodl-name n) lineqs1)))
    578600
    579601(define (asgn-eq n rhs)
     
    610632                           (if (and (not (member n kinetic)) (nemo:quantity? en))
    611633                               (cases nemo:quantity en
    612                                       (TSCOMP  (name initial open transitions power)
     634                                      (TSCOMP  (name initial open transitions conserve power)
    613635                                               (append (state-eqs name initial open transitions power) ax))
    614636                                      (else  ax))
     
    626648                           (if (and (member n kinetic) (nemo:quantity? en))
    627649                               (cases nemo:quantity en
    628                                       (TSCOMP  (name initial open transitions power)
    629                                                (append (kstate-eqs name initial open transitions power) ax))
     650                                      (TSCOMP  (name initial open transitions conserve power)
     651                                               (cons (kstate-eqs name initial open transitions power) ax))
    630652                                      (else  ax))
    631653                               ax))))
     
    642664                           (if (nemo:quantity? en)
    643665                               (cases nemo:quantity en
    644                                       (TSCOMP  (name initial open transitions power)
     666                                      (TSCOMP  (name initial open transitions conserve power)
    645667                                               (cons (stcomp-eq name open transitions) ax))
    646668                                      (else  ax))
     
    657679                           (if (nemo:quantity? en)
    658680                               (cases nemo:quantity en
    659                                       (TSCOMP  (name initial open transitions power)
     681                                      (TSCOMP  (name initial open transitions conserve power)
    660682                                               (if (nemo:rhs? initial)
    661683                                                   (cons* (state-init name initial)
     
    676698                           (if (nemo:quantity? en)
    677699                               (cases nemo:quantity en
    678                                       (TSCOMP (name initial open transitions power)
     700                                      (TSCOMP (name initial open transitions conserve power)
    679701                                              (if (and (list? initial) (every nemo:lineq? initial))
    680                                                   (cons (state-init-eq name transitions initial) ax)
     702                                                  (cons (state-lineqs name transitions initial) ax)
    681703                                                  ax))
    682704                                      (else  ax))
     
    686708
    687709
     710(define (poset->state-conserve-eq-defs poset sys)
     711  (fold-right
     712   (lambda (lst ax)
     713     (fold  (lambda (x ax)
     714              (match-let (((i . n)  x))
     715                         (let ((en (environment-ref sys n)))
     716                           (if (nemo:quantity? en)
     717                               (cases nemo:quantity en
     718                                      (TSCOMP (name initial open transitions conserve power)
     719                                              (if (and (list? conserve) (every nemo:lineq? conserve))
     720                                                  (cons (state-lineqs name transitions conserve) ax)
     721                                                  ax))
     722                                      (else  ax))
     723                               ax))))
     724            ax lst))
     725   (list) poset))
     726
     727
    688728(define (find-locals defs)
    689729  (concatenate (map (lambda (def) (match def (('let bnds _) (map first bnds)) (else (list)))) defs)))
     
    694734    (if (nemo:quantity? en)
    695735        (cases nemo:quantity en
    696                (TSCOMP  (name initial open transitions power)  power)
     736               (TSCOMP  (name initial open transitions conserve power)  power)
    697737               (else  #f))  #f)))
     738
    698739
    699740(define (bucket-partition p lst)
     
    706747                    (loop (cdr lst) (append (cdr old-bkts) (cons (cons x (car old-bkts)) new-bkts)))
    707748                    (bkt-loop (cdr old-bkts) (cons (car old-bkts) new-bkts)))))))))
     749
    708750
    709751(define (collect-epools sys)
     
    727769  (define (cn x)   (first x))
    728770  (let-optionals rest ((method 'cnexp) (table? #f) (min-v -100) (max-v 100) (step 0.5)
    729                        (depend #f)  (kinetic (list)) )
     771                       (depend #f)  (kinetic (list)) (linear? #f))
    730772  (match-let ((($ nemo:quantity 'DISPATCH  dis) (environment-ref sys (nemo-intern 'dispatch))))
    731773    (let ((imports  ((dis 'imports)  sys))
     
    746788             (epools      (collect-epools sys)))
    747789
    748 
    749790        (match-let (((state-list asgn-list g) deps*))
    750          (let* ((poset          (vector->list ((dis 'depgraph->bfs-dist-poset) g)))
    751                 (asgn-eq-defs   (poset->asgn-eq-defs poset sys))
    752                 (perm-ions (fold (lambda (ionch ax)
    753                                     (let* ((subcomps ((dis 'component-subcomps) sys (cid ionch)))
    754                                            (perm      (lookup-def 'permeating-substance subcomps)))
    755                                       (if perm
    756                                           (case (cn perm)
    757                                             ((non-specific)   
    758                                              (let* ((erev (car ((dis 'component-exports) sys (cid perm))))
    759                                                     (i    (nmodl-name 'i))
    760                                                     (e    (nmodl-name 'e)))
    761                                                (cons `(,(cn perm) ,i ,e ,erev) ax)))
    762                                             (else (let* ((erev (car ((dis 'component-exports) sys (cid perm))))
    763                                                          (i    (nmodl-name (s+ 'i (cn perm))))
    764                                                          (e    (nmodl-name (s+ 'e (cn perm)))))
    765                                                     (cons `(,(cn perm) ,i ,e ,erev) ax))))
    766                                           ax)))
    767                                   (list) ionchs))
    768                (acc-ions (fold (lambda (ionch ax)
    769                                   (let* ((subcomps ((dis 'component-subcomps) sys (cid ionch)))
    770                                         (acc   (lookup-def 'accumulating-substance subcomps))
    771                                         (i     (and acc (nmodl-name (s+ 'i (cn acc)))))
    772                                         (in    (and acc (nmodl-name (s+ (cn acc) 'i))))
    773                                         (out   (and acc (nmodl-name (s+ (cn acc) 'o)))))
    774                                     (if acc  (cons `(,(cn acc) ,i ,in ,out) ax) ax)))
    775                                 (list) ionchs))
    776                (pool-ions (map (lambda (ep)
    777                                   (let ((ion (car ep)))
    778                                     `(,(nmodl-name ion) ,(nmodl-name (s+ 'i ion)) ,(nmodl-name (s+ ion 'i)))))
    779                                epools))
    780                (has-kinetic? (or (not (null? (filter (lambda (x) (member (car x) kinetic)) states)))))
    781                (has-ode?     (or (not (null? (filter (lambda (x) (not (member (car x) kinetic))) states)))
    782                                  (not (null? pool-ions)))))
     791         (let* ((poset             (vector->list ((dis 'depgraph->bfs-dist-poset) g)))
     792                (asgn-eq-defs      (poset->asgn-eq-defs poset sys))
     793                (perm-ions         (fold (lambda (ionch ax)
     794                                           (let* ((subcomps ((dis 'component-subcomps) sys (cid ionch)))
     795                                                  (perm      (lookup-def 'permeating-substance subcomps)))
     796                                             (if perm
     797                                                (case (cn perm)
     798                                                   ((non-specific)   
     799                                                    (let* ((erev (car ((dis 'component-exports) sys (cid perm))))
     800                                                           (i    (nmodl-name 'i))
     801                                                           (e    (nmodl-name 'e)))
     802                                                      (cons `(,(cn perm) ,i ,e ,erev) ax)))
     803                                                   (else (let* ((erev (car ((dis 'component-exports) sys (cid perm))))
     804                                                                (i    (nmodl-name (s+ 'i (cn perm))))
     805                                                                (e    (nmodl-name (s+ 'e (cn perm)))))
     806                                                           (cons `(,(cn perm) ,i ,e ,erev) ax))))
     807                                                ax)))
     808                                        (list) ionchs))
     809               (acc-ions           (fold (lambda (ionch ax)
     810                                           (let* ((subcomps ((dis 'component-subcomps) sys (cid ionch)))
     811                                                  (acc   (lookup-def 'accumulating-substance subcomps))
     812                                                  (i     (and acc (nmodl-name (s+ 'i (cn acc)))))
     813                                                  (in    (and acc (nmodl-name (s+ (cn acc) 'i))))
     814                                                  (out   (and acc (nmodl-name (s+ (cn acc) 'o)))))
     815                                             (if acc  (cons `(,(cn acc) ,i ,in ,out) ax) ax)))
     816                                         (list) ionchs))
     817               (pool-ions          (map (lambda (ep)
     818                                          (let ((ion (car ep)))
     819                                            `(,(nmodl-name ion) ,(nmodl-name (s+ 'i ion)) ,(nmodl-name (s+ ion 'i)))))
     820                                        epools))
     821               (has-kinetic?       (or (not (null? (filter (lambda (x) (member (car x) kinetic)) states)))))
     822               (has-ode?           (or (not (null? (filter (lambda (x) (not (member (car x) kinetic))) states)))
     823                                       (not (null? pool-ions)))))
    783824
    784825
     
    803844           (pp indent ,nl (NEURON "{"))
    804845           (if (not (null? exports)) (pp indent+ (RANGE ,(sl\ ", " exports))))
     846
    805847           (for-each (lambda (x)
    806848                       (case (first x)
     
    10491091                 (pp indent "}")))
    10501092           
     1093
    10511094           (if has-kinetic?
    1052                  (begin
    1053                    (pp indent ,nl (KINETIC kstates "{"))
    1054                    (let* ((keq-defs (reverse (poset->kstate-eq-defs poset sys kinetic)))
    1055                           (locals  (find-locals (map third keq-defs))) )
    1056                      (if (not (null? locals)) (pp indent+ (LOCAL ,(sl\ ", " locals))))
    1057                      (for-each (lambda (def)
    1058                                  (match def
    1059                                         (('-> s0 s1 rexpr)
    1060                                          (pp indent+ (~ ,s0 -> ,s1 (,(expr->string/NMODL rexpr)))))
    1061                                         (('<-> s0 s1 rexpr1 rexpr2) 
    1062                                          (pp indent+ (~ ,s0 <-> ,s1 (,(expr->string/NMODL rexpr1) #\,
    1063                                                                      ,(expr->string/NMODL rexpr2)
    1064                                                                      ))))))
    1065                                keq-defs))
    1066                    (pp indent "}")))
    1067            
    1068            
    1069            (let* ((init-defs     (poset->state-init-defs poset sys))
    1070                   (init-eq-defs  (poset->state-init-eq-defs poset sys))
    1071                   (locals        (concatenate (find-locals (map second init-defs)))) )
     1095               (begin
     1096                 (pp indent ,nl (KINETIC kstates "{"))
     1097                 (let* ((keq-defs          (poset->kstate-eq-defs poset sys kinetic))
     1098                        (locals            (concatenate (find-locals (map third (map second keq-defs)))))
     1099                        (conserve-eq-defs  (poset->state-conserve-eq-defs poset sys)))
     1100                   (if (not (null? locals)) (pp indent+ (LOCAL ,(sl\ ", " locals))))
     1101                   (for-each
     1102                    (lambda (def)
     1103                      (let* ((n             (first def))
     1104                             (eqs           (second def))
     1105                             (conserve-eqs  (lookup-def n conserve-eq-defs)))
     1106                       
     1107                        (for-each
     1108                         (lambda (eq)
     1109                           (match eq
     1110                                  (('-> s0 s1 rexpr)
     1111                                   (pp indent+ (~ ,s0 -> ,s1 (,(expr->string/NMODL rexpr)))))
     1112                                  (('<-> s0 s1 rexpr1 rexpr2) 
     1113                                   (pp indent+ (~ ,s0 <-> ,s1 (,(expr->string/NMODL rexpr1) #\,
     1114                                                               ,(expr->string/NMODL rexpr2)
     1115                                                               ))))
     1116                                  ))
     1117                           eqs)
     1118                        (if conserve-eqs
     1119                            (for-each (lambda (eq)
     1120                                      (let ((val  (first eq))
     1121                                            (expr (third eq)))
     1122                                        (pp indent+ ,(conserve-lineq->string/NMODL expr val))))
     1123                                    conserve-eqs))
     1124                        ))
     1125                    keq-defs))
     1126                 (pp indent "}")))
     1127           
     1128           
     1129           (let* ((init-defs         (poset->state-init-defs poset sys))
     1130                  (init-eq-defs      (poset->state-init-eq-defs poset sys))
     1131                  (locals            (concatenate (find-locals (map second init-defs)))) )
    10721132               (pp indent ,nl (INITIAL "{"))
    10731133               (if (not (null? locals)) (pp indent+ (LOCAL ,(sl\ ", " locals))))
     
    10761136                           (let ((n (first def)) (b (second def)))
    10771137                             (pp indent+ ,(expr->string/NMODL b n)))) init-defs)
    1078                ;;(for-each (lambda (x)  (pp indent+ (,(third x) = ,(fourth x))))  perm-ions)
    1079                (if (not (null? init-eq-defs)) (pp indent+ (SOLVE initial_equilibrium)))
     1138               (cond ((and linear? (not (null? init-eq-defs)) )
     1139                    (pp indent+ (SOLVE initial_equilibrium)))
     1140                   (has-kinetic?
     1141                    (pp indent+ (SOLVE kstates STEADYSTATE sparse))))
     1142               
    10801143               (pp indent "}")
    1081                (if (not (null? init-eq-defs))
     1144
     1145               (if (and linear? (not (null? init-eq-defs)) )
    10821146                   (begin
    10831147                     (pp indent ,nl (LINEAR initial_equilibrium "{"))
Note: See TracChangeset for help on using the changeset viewer.