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


Ignore:
Timestamp:
12/01/08 06:47:14 (13 years ago)
Author:
Ivan Raikov
Message:

Bug fixes.

File:
1 edited

Legend:

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

    r12624 r12685  
    305305               
    306306
    307          
     307#|       
    308308(define (lineq->string/NMODL x val . rest)
    309309  (let-optionals rest ((width 72))
    310310    (s+ "~ " (sdoc->string (doc:format width (format-lineq/NMODL 2 x #f)))
    311311        " = " (number->string val))))
    312  
     312|# 
    313313         
    314314(define (conserve-lineq->string/NMODL x val . rest)
     
    464464
    465465
    466 (define (state-lineqs n transitions lineqs)
    467   (let* ((subst-convert  (subst-driver (lambda (x) (and (symbol? x) x)) binding? identity bind subst-term))
    468          (state-list     (let loop ((lst (list)) (tlst transitions))
    469                            (if (null? tlst)  (delete-duplicates lst eq?)
    470                                (match (car tlst)
    471                                       (('-> (and (? symbol?) s0) (and (? symbol?) s1) rate-expr)
    472                                        (loop (cons* s0 s1 lst) (cdr tlst)))
    473                                       (((and (? symbol?) s0) '-> (and (? symbol? s1)) rate-expr)
    474                                        (loop (cons* s0 s1 lst) (cdr tlst)))
    475                                       (('<-> (and (? symbol?) s0) (and (? symbol?) s1) rate-expr1 rate-expr2)
    476                                        (loop (cons* s0 s1 lst) (cdr tlst)))
    477                                       (((and (? symbol?) s0) 'M-> (and (? symbol? s1)) rate-expr1 rate-expr2)
    478                                        (loop (cons* s0 s1 lst) (cdr tlst)))
    479                                       (else
    480                                        (nemo:error 'nemo:state-lineq ": invalid transition equation "
    481                                                    (car tlst) " in state complex " n))
    482                                       (else (loop lst (cdr tlst)))))))
    483          (state-subs     (fold (lambda (s ax) (subst-extend s (nmodl-state-name n s) ax)) subst-empty state-list))
    484          (lineqs1        (map (lambda (lineq) (match lineq ((i '= . expr) `(,i = . ,(subst-convert expr state-subs)))))
    485                               lineqs)))
    486     (list (nmodl-name n) lineqs1)))
    487 
    488466(define (asgn-eq n rhs)
    489467  (let* ((fbody   (rhsexpr rhs))
     
    576554   (list) poset))
    577555
    578 
    579 (define (poset->state-init-eq-defs poset sys)
    580   (fold-right
    581    (lambda (lst ax)
    582      (fold  (lambda (x ax)
    583               (match-let (((i . n)  x))
    584                          (let ((en (environment-ref sys n)))
    585                            (if (nemo:quantity? en)
    586                                (cases nemo:quantity en
    587                                       (TSCOMP (name initial open transitions conserve power)
    588                                               (if (and (list? initial) (every nemo:lineq? initial))
    589                                                   (cons (state-lineqs name transitions initial) ax)
    590                                                   ax))
    591                                       (else  ax))
    592                                ax))))
    593             ax lst))
    594    (list) poset))
    595 
    596 
    597556(define (poset->state-conserve-eq-defs poset sys)
    598557  (fold-right
     
    605564                                      (TSCOMP (name initial open transitions conserve power)
    606565                                              (if (and (list? conserve) (every nemo:lineq? conserve))
    607                                                   (cons (state-lineqs name transitions conserve) ax)
     566                                                  (cons (state-lineqs (nmodl-name name) transitions conserve
     567                                                                      nmodl-state-name) ax)
    608568                                                  ax))
    609569                                      (else  ax))
     
    858818                   (if (not (null? locals)) (pp indent+ (LOCAL ,(sl\ ", " locals)))))
    859819#|
     820                 This seems to cause a segmentation fault in nrnoc:
     821
    860822                 (if (and table? min-v max-v table-with)
    861823                     (pp indent+ (TABLE ,(sl\ ", " (map first asgn-eq-defs))
     
    10451007                        (if conserve-eqs
    10461008                            (for-each (lambda (eq)
    1047                                       (let ((val  (first eq))
    1048                                             (expr (third eq)))
    1049                                         (pp indent+ ,(conserve-lineq->string/NMODL expr val))))
     1009                                        (let ((val  (first eq))
     1010                                              (expr (third eq)))
     1011                                          (pp indent+ ,(conserve-lineq->string/NMODL expr val))))
    10501012                                    conserve-eqs))
    10511013                        ))
     
    10551017           
    10561018           (let* ((init-defs         (poset->state-init-defs poset sys))
    1057                   (init-eq-defs      (poset->state-init-eq-defs poset sys))
    10581019                  (locals            (concatenate (find-locals (map second init-defs)))) )
    10591020               (pp indent ,nl (INITIAL "{"))
     
    10631024                           (let ((n (first def)) (b (second def)))
    10641025                             (pp indent+ ,(expr->string/NMODL b n)))) init-defs)
    1065                (cond ((and linear? (not (null? init-eq-defs)) )
    1066                     (pp indent+ (SOLVE initial_equilibrium)))
    1067                    (has-kinetic?
    1068                     (pp indent+ (SOLVE kstates STEADYSTATE sparse))))
     1026
     1027               (if has-kinetic?
     1028                   (pp indent+ (SOLVE kstates STEADYSTATE sparse)))
    10691029               
    10701030               (pp indent "}")
    10711031
    1072                (if (and linear? (not (null? init-eq-defs)) )
    1073                    (begin
    1074                      (pp indent ,nl (LINEAR initial_equilibrium "{"))
    1075                      (for-each
    1076                       (lambda (x)
    1077                         (let ((lineqs  (second x)))
    1078                           (for-each (lambda (eq)
    1079                                       (let ((val  (first eq))
    1080                                             (expr (third eq)))
    1081                                         (pp indent+ ,(lineq->string/NMODL expr val))))
    1082                                     lineqs)))
    1083                       init-eq-defs)
    1084                      (pp indent "}")))
    10851032               ))))
    10861033        ))))
Note: See TracChangeset for help on using the changeset viewer.