Changeset 12129 in project


Ignore:
Timestamp:
10/09/08 01:39:06 (12 years ago)
Author:
Ivan Raikov
Message:

Updates related to kinetic equations.

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

Legend:

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

    r12041 r12129  
    233233                                   (state-complex
    234234                                    (CaBK_z
    235                                      (transitions (-> zC zO  (/ (CaBK_zinf cai) CaBK_ztau))
    236                                                   (-> zO zC  (/ (- 1 (CaBK_zinf cai)) CaBK_ztau)))
     235                                     (transitions (<-> zC zO
     236                                                       (/ (CaBK_zinf cai) CaBK_ztau)
     237                                                       (/ (- 1 (CaBK_zinf cai)) CaBK_ztau)))
    237238                                     (initial   (CaBK_zinf 1e-4))
    238239                                     (open zO)  (power 2)))
     
    266267             
    267268             
     269             (component (type ion-channel) (name Narsg)
     270                       
     271                        (component (type gate)
     272                                   
     273                                   (const Con   = 0.005)
     274                                   (const Coff  = 0.5)
     275                                   (const Oon   = 0.75)
     276                                   (const Ooff  = 0.005)
     277
     278                                   (const Narsg_alfac = (pow (/ Oon Con) (/ 1.0 4.0)))
     279                                   (const Narsg_btfac = (pow (/ Ooff Coff) (/ 1.0 4.0)))
     280
     281                                   (const Narsg_alpha = 150)
     282                                   (const Narsg_beta  = 3)
     283                                   (const Narsg_gamma = 150)
     284                                   (const Narsg_delta = 40)
     285                                   (const Narsg_epsilon = 1.75)
     286                                   (const Narsg_zeta = 0.03)
     287                                   (const Narsg_x1 = 20)
     288                                   (const Narsg_x2 = -20)
     289                                   (const Narsg_x3 = 1000000000000.0)
     290                                   (const Narsg_x4 = -1000000000000.0)
     291                                   (const Narsg_x5 = 1000000000000.0)
     292                                   (const Narsg_x6 = -25)
     293
     294                                   ;; rate functions
     295                                   (f01 = (* 4.0 Narsg_alpha (exp (/ v Narsg_x1))))
     296                                   (f02 = (* 3.0 Narsg_alpha (exp (/ v Narsg_x1))))
     297                                   (f03 = (* 2.0 Narsg_alpha (exp (/ v Narsg_x1))))
     298                                   (f04 = (* Narsg_alpha (exp (/ v Narsg_x1))))
     299                                   (f0O = (* Narsg_gamma (exp (/ v Narsg_x3))))
     300                                   (fip = (* Narsg_epsilon (exp (/ v Narsg_x5))))
     301                                   (f11 = (* 4.0 Narsg_alpha Narsg_alfac (exp (/ v Narsg_x1))))
     302                                   (f12 = (* 3.0 Narsg_alpha Narsg_alfac (exp (/ v Narsg_x1))))
     303                                   (f13 = (* 2.0 Narsg_alpha Narsg_alfac (exp (/ v Narsg_x1))))
     304                                   (f14 = (* Narsg_alpha Narsg_alfac (exp (/ v Narsg_x1))))
     305                                   (f1n = (* Narsg_gamma (exp (/ v Narsg_x3))))
     306
     307                                   (fi1 = Con)
     308                                   (fi2 = (* Con Narsg_alfac))
     309                                   (fi3 = (* Con Narsg_alfac Narsg_alfac))
     310                                   (fi4 = (* Con Narsg_alfac Narsg_alfac Narsg_alfac))
     311                                   (fi5 = (* Con Narsg_alfac Narsg_alfac Narsg_alfac Narsg_alfac))
     312                                   (fin = Oon)
     313
     314                                   (b01 = (* Narsg_beta (exp (/ v Narsg_x2))))
     315                                   (b02 = (* 2.0 Narsg_beta (exp (/ v Narsg_x2))))
     316                                   (b03 = (* 3.0 Narsg_beta (exp (/ v Narsg_x2))))
     317                                   (b04 = (* 4.0 Narsg_beta (exp (/ v Narsg_x2))))
     318                                   (b0O = (* Narsg_delta * (exp (/ v Narsg_x4))))
     319                                   (bip = (* Narsg_zeta * (exp (/ v Narsg_x6))))
     320
     321                                   (b11 = (* Narsg_beta Narsg_btfac (exp (/ v Narsg_x2))))
     322                                   (b12 = (* 2.0 Narsg_beta Narsg_btfac (exp (/ v Narsg_x2))))
     323                                   (b13 = (* 3.0 Narsg_beta Narsg_btfac (exp (/ v Narsg_x2))))
     324                                   (b14 = (* 4.0 Narsg_beta Narsg_btfac (exp (/ v Narsg_x2))))
     325                                   (b1n = (* Narsg_delta (exp (/ v Narsg_x4))))
     326
     327                                   (bi1 = Coff)
     328                                   (bi2 = (* Coff Narsg_btfac))
     329                                   (bi3 = (* Coff Narsg_btfac Narsg_btfac))
     330                                   (bi4 = (* Coff Narsg_btfac Narsg_btfac Narsg_btfac))
     331                                   (bi5 = (* Coff Narsg_btfac Narsg_btfac Narsg_btfac Narsg_btfac))
     332                                   (bin = Ooff)
     333
     334                                   (state-complex
     335                                    (Narsg_z
     336                                     (transitions
     337                                      (<-> C1 C2 f01 b01)
     338                                      (<-> C2 C3 f02 b02)
     339                                      (<-> C3 C4 f03 b03)
     340                                      (<-> C4 C5 f04 b04)
     341                                      (<-> C5 O  f0O b0O)
     342                                      (<-> O  B  fip bip)
     343                                      (<-> O  I6 fin bin)
     344                                      (<-> I1 I2 f11 b11)
     345                                      (<-> I2 I3 f12 b12)
     346                                      (<-> I3 I4 f13 b13)
     347                                      (<-> I4 I5 f14 b14)
     348                                      (<-> I5 I6 f1n b1n)
     349                                      (<-> C1 I1 fi1 bi1)
     350                                      (<-> C2 I2 fi2 bi2)
     351                                      (<-> C3 I3 fi3 bi3)
     352                                      (<-> C4 I4 fi4 bi4)
     353                                      (<-> C5 I5 fi5 bi5))
     354
     355                                     (initial-equilibrium
     356                                        (0 = (+ (* I1 bi1) (* C2 b01) (neg (* C1 (+ fi1 + f01)) )))
     357                                        (0 = (+ (* C1 f01) (* I2 bi2) (* C3 b02) (neg (* C2 (+ b01 fi2 f02)) )))
     358                                        (0 = (+ (* C2 f02) (* I3 bi3) (* C4 b03) (neg (* C3 (+ b02 fi3 f03)) )))
     359                                        (0 = (+ (* C3 f03) (* I4 bi4) (* C5 b04) (neg (* C4 (+ b03 fi4 f04)) )))
     360                                        (0 = (+ (* C4 f04) (* I5 bi5) (* O b0O)  (neg (* C5 (+ b04 fi5 f0O)) )))
     361                                        (0 = (+ (* C5 f0O) (* B bip)  (* I6 bin) (neg (* O  (+ b0O fip fin)) )))
     362                                        (0 = (+ (* O fip)  (* B bip)))
     363                                        (0 = (+ (* C1 fi1) (* I2 b11) (neg (* I1 (+ bi1 f11)) )))
     364                                        (0 = (+ (* I1 f11) (* C2 fi2) (* I3 b12) (neg (* I2 (+ b11 bi2 f12)) )))
     365                                        (0 = (+ (* I2 f12) (* C3 fi3) (* I4 bi3) (neg (* I3 (+ b12 bi3 f13)) )))
     366                                        (0 = (+ (* I3 * f13) (* C4 fi4) (* I5 b14) (neg (* I4 (+ b13 bi4 f14)) )))
     367                                        (0 = (+ (* I4 f14) (* C5 fi5) (* I6 b1n) (neg (* I5 (+ b14 bi5 f1n)) )))
     368                                        (1 = (+ C1 C2 C3 C4 C5 O B I1 I2 I3 I4 I5 I6 )))
     369
     370                                     (open O)   (power 1)))
     371                                   
     372                                   (output Narsg_z ) 
     373                                   
     374                                   )
     375                       
     376                        (component (type pore)
     377                                   (const  gbar_Narsg  = 0.016)
     378                                   (output gbar_Narsg ))
     379                       
     380                        (component (type permeating-substance) (name na)
     381                                   (const e_Narsg = -88)
     382                                   (output e_Narsg ))
     383                       
     384                        ) ;; end Narsg current
     385             
     386             
     387             
    268388             )) ;; end model
  • release/3/nemo/trunk/extensions/nemo-hh.scm

    r12116 r12129  
    102102                   (closed     'C)
    103103                   (mst        `((power ,m-power)  (open  ,open)
    104                                  (transitions (-> ,closed ,open ,m-alpha)
    105                                               (-> ,open ,closed ,m-beta)))))
     104                                 (transitions (<-> ,closed ,open ,m-alpha ,m-beta)))))
    106105              (if m-inf (env-extend! m-inf-sym '(asgn) 'none `(rhs ,m-inf)))
    107106              (if m-tau (env-extend! m-tau-sym '(asgn) 'none `(rhs ,m-tau)))
     
    127126                       (hst        `((power ,h-power)
    128127                                     (open  ,open)
    129                                      (transitions (-> ,closed ,open ,h-alpha)
    130                                                   (-> ,open ,closed ,h-beta)))))
     128                                     (transitions (<-> ,closed ,open ,h-alpha ,h-beta) ))))
    131129                  (apply env-extend! (cons* (p$ ion 'h) '(tscomp) initial-h hst))
    132130                  (add-external! (p$ ion 'h) 'output)
  • release/3/nemo/trunk/nemo-core.scm

    r12113 r12129  
    7878            (loop (cdr objs)))))))
    7979
     80(define (optional pred?) (lambda (x) (or (not x) (pred? x))))
     81
    8082(define (rhs? x)  (or (symbol? x) (number? x) (and (list? x) (every rhs? x))))
    8183
     84(define (lineq? x)  (match x (((? integer?) '= (? rhs?))  #t) (else #f)))
     85
    8286(define (transition? x)
    83   (match x (('-> a b x) (and (symbol? a) (symbol? b) (rhs? x)))
     87  (match x
     88         (('-> a b r)       (and (symbol? a) (symbol? b) (rhs? r)))
     89         ((a '-> b r)       (and (symbol? a) (symbol? b) (rhs? r)))
     90         (('<-> a b r1 r2)  (and (symbol? a) (symbol? b) (rhs? r1) (rhs? r2)))
     91         ((a '<-> b r1 r2)  (and (symbol? a) (symbol? b) (rhs? r1) (rhs? r2)))
    8492         (else #f)))
    8593
     
    8896  (ASGN       (name symbol?) (value number?) (rhs rhs?) )
    8997  (CONST      (name symbol?) (value number?))
    90   (TSCOMP     (name symbol?) (initial rhs?)
     98  (TSCOMP     (name symbol?) (initial (optional rhs?)) (initial-eq (optional lineq?))
    9199              (open (lambda (x) (or (symbol? x) (and (list? x) (every symbol? x) ))))
    92100              (transitions (lambda (x) (and (list? x) (every transition? x))))
    93101              (power integer?))
    94102  (PRIM       (name symbol?) (value identity))
    95   (EXTERNAL   (local-name symbol?) (name symbol?) (namespace (lambda (x) (or (not x) (symbol? x)))))
     103  (EXTERNAL   (local-name symbol?) (name symbol?) (namespace (optional symbol?)))
    96104  (DISPATCH   (value procedure?))
    97105  (EXPORTS    (lst (lambda (x) (and (list? x) (every symbol? x)))))
     
    316324              (('tscomp)  (begin
    317325                            (let ((power         (or (lookup-def 'power alst) 1))
    318                                 (transitions   (map (lambda (t)
    319                                                       `(-> ,(second t) ,(third t) ,(normalize-expr (fourth t ))))
     326                                  (transitions
     327                                   (map (lambda (t)
     328                                          (match-let (((src dst rate1 rate2)
     329                                                       (match t
     330                                                              (('-> a b r) (list a b r #f))
     331                                                              ((a '-> b r) (list a b r #f))
     332                                                              (('<-> a b r1 r2) (list a b r1 r2))
     333                                                              ((a '<-> b r1 r2) (list a b r1 r2)))))
     334                                                     (if (and rate1 rate2)
     335                                                         `(<-> ,src ,dst ,(normalize-expr rate1) ,(normalize-expr rate2) )
     336                                                         `(-> ,src ,dst ,(normalize-expr rate1)))))
    320337                                                    (or (alist-ref 'transitions alst) (list))))
    321                                 (open         (lookup-def 'open alst)))
     338                                  (open         (lookup-def 'open alst)))
    322339                            (if (null? transitions)
    323340                                (nemo:error 'env-extend!
  • release/3/nemo/trunk/nemo-nmodl.scm

    r12116 r12129  
    11
    2 ;; TODO: * check that open states are valid
    3 ;;       * include option for generating kinetic eqs
     2;; TODO: * include option for generating kinetic eqs
     3;;       * check that open states are valid
     4;;       
    45;;
    56;; An extension for translating NeuroML models to NMODL descriptions.
     
    351352                       (if (null? tlst)  (delete-duplicates lst eq?)
    352353                           (match (car tlst)
    353                                   (('-> s0 s1 rate-expr)
    354                                    (loop (cons s0 (cons s1 lst)) (cdr tlst)))
    355                                   (('-> _)
     354                                  (('-> (and (? symbol?) s0) (and (? symbol?) s1) rate-expr)
     355                                   (loop (cons* s0 s1 lst) (cdr tlst)))
     356                                  (((and (? symbol?) s0) '-> (and (? symbol? s1)) rate-expr)
     357                                   (loop (cons* s0 s1 lst) (cdr tlst)))
     358                                  (('<-> (and (? symbol?) s0) (and (? symbol?) s1) rate-expr1 rate-expr2)
     359                                   (loop (cons* s0 s1 lst) (cdr tlst)))
     360                                  (((and (? symbol?) s0) 'M-> (and (? symbol? s1)) rate-expr1 rate-expr2)
     361                                   (loop (cons* s0 s1 lst) (cdr tlst)))
     362                                  (else
    356363                                   (nemo:error 'nemo:nmodl-state-eqs ": invalid transition equation "
    357364                                                  (car tlst) " in state complex " n))
     
    364371    (let* ((nodes  ((g 'nodes)))
    365372           (snode   (find (lambda (s) (not (eq? (second s) open))) nodes))
    366            (snex   `(- 1 ,(sum (filter-map (lambda (s) (and (not (= (first s) (first snode))) (second s))) nodes)))))
     373           (snex   `(- 1 ,(sum (filter-map (lambda (s) (and (not (= (first s) (first snode))) (second s))) nodes))))
     374           (add-tredge (lambda (s0 s1 rexpr1 rexpr2)
     375                         (let ((i   (car (alist-ref s0 name->id-map)))
     376                               (j   (car (alist-ref s1 name->id-map)))
     377                               (x0  (if (eq? s0 (second snode)) snex s0))
     378                               (x1  (if (eq? s1 (second snode)) snex s1)))
     379                           (add-edge! (list i j `(* ,(subst-convert x0 node-subs)
     380                                                    ,(subst-convert rexpr1 node-subs))))
     381                           (if rexpr2 (add-edge! (list j i `(* ,(subst-convert x1 node-subs)
     382                                                               ,(subst-convert rexpr2 node-subs)))))))))
    367383      ;; create rate edges in the graph
    368384      (for-each (lambda (e)
    369                   (match e (('-> s0 s1 rexpr)
    370                             (let ((i  (car (alist-ref s0 name->id-map)))
    371                                   (j  (car (alist-ref s1 name->id-map)))
    372                                   (x  (if (eq? s0 (second snode)) snex s0)))
    373                               (add-edge! (list i j `(* ,(subst-convert x node-subs)
    374                                                        ,(subst-convert rexpr node-subs))))))
    375                          (else (void))))
     385                  (match e
     386                         (('-> s0 s1 rexpr)  (add-tredge s0 s1 rexpr #f))
     387                         ((s0 '-> s1 rexpr)  (add-tredge s0 s1 rexpr #f))
     388                         (('<-> s0 s1 rexpr1 rexpr2)  (add-tredge s0 s1 rexpr1 rexpr2))
     389                         ((s0 '<-> s1 rexpr1 rexpr2)  (add-tredge s0 s1 rexpr1 rexpr2))
     390                         ))
    376391                transitions)
     392
    377393      ;; generate differential equations for each state in the transitions system
    378394      (let ((eqs    (fold (lambda (s ax)
     
    397413       
    398414
     415(define (kstate-eqs n initial open transitions power)
     416  (let* ((subst-convert  (subst-driver (lambda (x) (and (symbol? x) x)) binding? identity bind subst-term))
     417         (state-list     (let loop ((lst (list)) (tlst transitions))
     418                           (if (null? tlst)  (delete-duplicates lst eq?)
     419                               (match (car tlst)
     420                                      (('-> (and (? symbol?) s0) (and (? symbol?) s1) rate-expr)
     421                                       (loop (cons* s0 s1 lst) (cdr tlst)))
     422                                      (((and (? symbol?) s0) '-> (and (? symbol? s1)) rate-expr)
     423                                       (loop (cons* s0 s1 lst) (cdr tlst)))
     424                                      (('<-> (and (? symbol?) s0) (and (? symbol?) s1) rate-expr1 rate-expr2)
     425                                       (loop (cons* s0 s1 lst) (cdr tlst)))
     426                                      (((and (? symbol?) s0) 'M-> (and (? symbol? s1)) rate-expr1 rate-expr2)
     427                                       (loop (cons* s0 s1 lst) (cdr tlst)))
     428                                      (else
     429                                       (nemo:error 'nemo:nmodl-kstate-eqs ": invalid transition equation "
     430                                                   (car tlst) " in state complex " n))
     431                                      (else (loop lst (cdr tlst)))))))
     432         (state-subs     (fold (lambda (s ax) (subst-extend s (nmodl-state-name n s) ax)) subst-empty state-list)))
     433    ;; generate kinetic equations for each edge in the transitions system
     434    (map
     435     (lambda (e)
     436       (match e
     437              (('-> s0 s1 rexpr)
     438               (let ((i  (lookup-def s0 state-subs))
     439                     (j  (lookup-def s1 state-subs)))
     440                 `(-> ,i ,j ,(subst-convert rexpr state-subs))))
     441             
     442              ((s0 '-> s1 rexpr)
     443               (let ((i  (lookup-def s0 state-subs))
     444                     (j  (lookup-def s1 state-subs)))
     445                 `(-> ,i ,j ,(subst-convert rexpr state-subs))))
     446             
     447              (('<-> s0 s1 rexpr1 rexpr2)
     448               (let ((i  (lookup-def s0 state-subs))
     449                     (j  (lookup-def s1 state-subs)))
     450                 `(<-> ,i ,j ,(subst-convert rexpr1 state-subs) ,(subst-convert rexpr2 state-subs))))
     451             
     452              ((s0 '<-> s1 rexpr1 rexpr2)
     453               (let ((i  (lookup-def s0 state-subs))
     454                     (j  (lookup-def s1 state-subs)))
     455                 `(<-> ,i ,j ,(subst-convert rexpr1 state-subs) ,(subst-convert rexpr2 state-subs))))
     456             
     457                 
     458              (else (nemo:error 'nemo:nmodl-kstate-eqs ": invalid transition equation "
     459                                e " in state complex " n))))
     460     transitions)))
     461       
     462
    399463
    400464(define (state-init n init)
     
    428492
    429493
    430 (define (poset->state-eq-defs poset sys)
     494(define (poset->state-eq-defs poset sys kinetic)
    431495  (fold-right
    432496   (lambda (lst ax)
     
    434498              (match-let (((i . n)  x))
    435499                         (let ((en (environment-ref sys n)))
    436                            (if (nemo:quantity? en)
     500                           (if (and (not (member n kinetic)) (nemo:quantity? en))
    437501                               (cases nemo:quantity en
    438502                                      (TSCOMP  (name initial open transitions power)
    439503                                               (append (state-eqs name initial open transitions power) ax))
     504                                      (else  ax))
     505                               ax))))
     506            ax lst))
     507   (list) poset))
     508
     509
     510(define (poset->kstate-eq-defs poset sys kinetic)
     511  (fold-right
     512   (lambda (lst ax)
     513     (fold  (lambda (x ax)
     514              (match-let (((i . n)  x))
     515                         (let ((en (environment-ref sys n)))
     516                           (if (and (member n kinetic) (nemo:quantity? en))
     517                               (cases nemo:quantity en
     518                                      (TSCOMP  (name initial open transitions power)
     519                                               (append (kstate-eqs name initial open transitions power) ax))
    440520                                      (else  ax))
    441521                               ax))))
     
    476556
    477557(define (find-locals defs)
    478   (concatenate
    479    (map (lambda (def) (match (second def) (('let bnds _) (map first bnds)) (else (list))))
    480         defs)))
     558  (concatenate (map (lambda (def) (match def (('let bnds _) (map first bnds)) (else (list)))) defs)))
    481559
    482560
     
    500578
    501579(define (nemo:nmodl-translator sys . rest)
    502   (define (cid x) (second x))
    503   (define (cn x) (first x))
    504   (let-optionals rest ((method 'cnexp) (table? #f) (min-v -100) (max-v 100) (step 0.5) (depend #f) )
     580  (define (cid x)  (second x))
     581  (define (cn x)   (first x))
     582  (let-optionals rest ((method 'cnexp) (table? #f) (min-v -100) (max-v 100) (step 0.5) (depend #f)
     583                       (kinetic (list)))
    505584  (match-let ((($ nemo:quantity 'DISPATCH  dis) (environment-ref sys (nemo-intern 'dispatch))))
    506585    (let ((imports  ((dis 'imports)  sys))
    507586          (exports  ((dis 'exports)  sys)))
    508       (let* ((indent  0)
    509              (indent+ (+ 2 indent ))
    510              (sysname (nmodl-name ((dis 'sysname) sys)))
    511              (deps*   ((dis 'depgraph*) sys))
    512              (consts  ((dis 'consts) sys))
    513              (asgns   ((dis 'asgns) sys))
    514              (states  ((dis 'states) sys))
    515              (stcomps ((dis 'stcomps) sys))
    516              (defuns  ((dis 'defuns) sys))
    517              (components ((dis 'components) sys))
    518              (ionchs  (filter-map (match-lambda ((name 'ion-channel id) (list name id)) (else #f)) components)))
     587      (let* ((indent      0)
     588             (indent+     (+ 2 indent ))
     589             (sysname     (nmodl-name ((dis 'sysname) sys)))
     590             (deps*       ((dis 'depgraph*) sys))
     591             (consts      ((dis 'consts) sys))
     592             (asgns       ((dis 'asgns) sys))
     593             (states      ((dis 'states) sys))
     594             (stcomps     ((dis 'stcomps) sys))
     595             (defuns      ((dis 'defuns) sys))
     596             (components  ((dis 'components) sys))
     597             (ionchs      (filter-map (match-lambda ((name 'ion-channel id) (list name id)) (else #f)) components)))
    519598        (match-let (((state-list asgn-list g) deps*))
    520599         (let* ((poset          (vector->list ((dis 'depgraph->bfs-dist-poset) g)))
     
    588667                                        (list (first nv) v1))))
    589668                                   consts))
    590                   (locals  (find-locals const-defs)))
     669                  (locals  (find-locals (map second const-defs))))
    591670             (if (not (null? locals)) (pp indent+ (LOCAL ,(sl\ ", " locals))))
    592671             (for-each (lambda (def)
     
    624703                 (begin
    625704                   (pp indent ,nl (PROCEDURE rates () "{"))
    626                    (let ((locals    (find-locals asgn-eq-defs)))
     705                   (let ((locals    (find-locals (map second asgn-eq-defs))) )
    627706                     (if (not (null? locals)) (pp indent+ (LOCAL ,(sl\ ", " locals)))))
    628707                   (for-each (lambda (def)
     
    636715                   (pp indent ,nl (PROCEDURE stcomps () "{"))
    637716                   (let* ((eq-defs   (poset->stcomp-eq-defs poset sys))
    638                           (locals    (find-locals eq-defs)))
     717                          (locals    (find-locals (map second eq-defs))) )
    639718                     (if (not (null? locals)) (pp indent+ (LOCAL ,(sl\ ", " locals))))
    640719                     (for-each (lambda (def)
     
    697776                                           (else ax)))
    698777                                  (list) i-bkts))
    699                     (locals (find-locals i-eqs)))
     778                    (locals (find-locals (map second i-eqs))))
    700779               (if (not (null? locals))   (pp indent+ (LOCAL ,(sl\ ", " locals))))
    701780               (if (not (null? asgns))    (pp indent+ (rates ())))
    702781               (if (not method) (pp indent+ (SOLVE states))
    703782                   (pp indent+ (SOLVE states METHOD ,method)))
     783               (if (not (null? kinetic))
     784                   (pp indent+  (SOLVE kstates METHOD sparse)))
    704785               (if (not (null? stcomps))  (pp indent+ (stcomps ())))
    705786               (for-each (lambda (p) (pp indent+ ,(expr->string/NMODL (second p) (first p)))) i-eqs)
     
    709790                 (begin
    710791                   (pp indent ,nl (DERIVATIVE states "{"))
    711                    (let* ((eq-defs (reverse (poset->state-eq-defs poset sys)))
    712                           (locals (find-locals eq-defs)))
     792                   (let* ((eq-defs (reverse (poset->state-eq-defs poset sys kinetic)))
     793                          (locals (find-locals (map second eq-defs))) )
    713794                     (if (not (null? locals)) (pp indent+ (LOCAL ,(sl\ ", " locals))))
    714795                     (for-each (lambda (def)
     
    716797                                   (pp indent+ ,(expr->string/NMODL b n)))) eq-defs))
    717798                   (pp indent "}")))
     799
     800             (if (not (null? kinetic))
     801                 (begin
     802                   (pp indent ,nl (KINETIC kstates "{"))
     803                   (let* ((keq-defs (reverse (poset->kstate-eq-defs poset sys kinetic)))
     804                          (locals  (find-locals (map third keq-defs))) )
     805                     (if (not (null? locals)) (pp indent+ (LOCAL ,(sl\ ", " locals))))
     806                     (for-each (lambda (def)
     807                                 (match def
     808                                        (('-> s0 s1 rexpr)
     809                                         (pp indent+ (~ ,s0 -> ,s1 (,(expr->string/NMODL rexpr)))))
     810                                        (('<-> s0 s1 rexpr1 rexpr2) 
     811                                         (pp indent+ (~ ,s0 <-> ,s1 (,(expr->string/NMODL rexpr1) #\,
     812                                                                     ,(expr->string/NMODL rexpr2)
     813                                                                     ))))))
     814                               keq-defs))
     815                   (pp indent "}")))
     816                 
    718817             
    719818             (pp indent ,nl (INITIAL "{"))
    720819             (let* ((init-defs  (poset->state-init-defs poset sys))
    721                     (locals     (concatenate (find-locals init-defs))))
     820                    (locals     (concatenate (find-locals (map second init-defs)))) )
    722821               (if (not (null? locals)) (pp indent+ (LOCAL ,(sl\ ", " locals))))
    723822               (if (not (null? asgns))  (pp indent+ (rates ())))
  • release/3/nemo/trunk/nemo.scm

    r12026 r12129  
    6464    ,(args:make-option (nmodl)      (optional: "FILE")   
    6565                       (s+ "write NMODL output to file (default: <model-name>.mod)"))
     66    ,(args:make-option (nmodl-kinetic)       (required: "STATES")
     67                       (s+ "use NMODL kinetic equations for the given states"))
    6668    ,(args:make-option (nmodl-method)       (required: "METHOD")
    6769                       (s+ "specify NMODL integration method (cnexp, derivimplicit)")
     
    167169         (else (error 'sexp->model "unknown model format"))))
    168170
     171
    169172(define (model->nmodl options model)
    170   (nemo:nmodl-translator model (lookup-def 'method options) (lookup-def 'table options) -150 150 1))
     173  (nemo:nmodl-translator model (lookup-def 'method options) (lookup-def 'table options)
     174                         -150 150 1 #f
     175                         (lookup-def 'kinetic options)))
    171176
    172177
    173178(define (transition->ncml-transition x)
    174   (match x (('-> src dst rate)
    175             `(ncml:transition (@ (src ,src) (dst ,dst))
    176                               (ncml:rate ,(expr->ncml-expr rate))))
     179  (match x
     180         (('-> src dst rate)
     181          `((ncml:transition (@ (src ,src) (dst ,dst))  (ncml:rate ,(expr->ncml-expr rate)))))
     182         ((src '-> dst rate)
     183          `((ncml:transition (@ (src ,src) (dst ,dst))  (ncml:rate ,(expr->ncml-expr rate)))))
     184         (('<-> src dst rate1 rate2)
     185          `((ncml:transition (@ (src ,src) (dst ,dst))  (ncml:rate ,(expr->ncml-expr rate1)))
     186            (ncml:transition (@ (src ,dst) (dst ,src))  (ncml:rate ,(expr->ncml-expr rate2)))))
     187         ((src '<-> dst rate1 rate2)
     188          `((ncml:transition (@ (src ,src) (dst ,dst))  (ncml:rate ,(expr->ncml-expr rate1)))
     189            (ncml:transition (@ (src ,dst) (dst ,src))  (ncml:rate ,(expr->ncml-expr rate2)))))
    177190         (else (error 'transition->ncml-transition "invalid transition " x))))
    178191
     
    240253                   
    241254                    (($ nemo:quantity 'TSCOMP name initial open trs p)
    242                      (let ((sxml-trs (map transition->ncml-transition trs)))
     255                     (let ((sxml-trs (append-map transition->ncml-transition trs)))
    243256                       `(ncml:state_complex (@ (id ,name))
    244257                                            (ncml:open ,open) (ncml:initial ,(expr->ncml-expr initial))
     
    566579               (with-output-to-file
    567580                   mod-fname  (lambda ()
    568                                 (model->nmodl `((method . ,nmodl-method)
    569                                                 (table  . ,(assoc 't options))) model))))
     581                                (model->nmodl `((method  . ,nmodl-method)
     582                                                (table   . ,(assoc 't options))
     583                                                (kinetic
     584                                                 ,(map string->symbol
     585                                                       (string-split (or (alist-ref 'nmodl-kinetic options) "") ","))))
     586                                              model))))
    570587           ))
    571588       operands)))
Note: See TracChangeset for help on using the changeset viewer.