Changeset 12167 in project
 Timestamp:
 10/15/08 06:28:44 (12 years ago)
 Location:
 release/3/nemo/trunk
 Files:

 3 edited
Legend:
 Unmodified
 Added
 Removed

release/3/nemo/trunk/examples/AKP06/PotIhCa.scm
r12129 r12167 316 316 (b03 = (* 3.0 Narsg_beta (exp (/ v Narsg_x2)))) 317 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))))318 (b0O = (* Narsg_delta (exp (/ v Narsg_x4)))) 319 (bip = (* Narsg_zeta (exp (/ v Narsg_x6)))) 320 320 321 321 (b11 = (* Narsg_beta Narsg_btfac (exp (/ v Narsg_x2)))) … … 354 354 355 355 (initialequilibrium 356 (0 = (+ (* I1 bi1) (* C2 b01) (neg (* C1 (+ fi1 +f01)) )))356 (0 = (+ (* I1 bi1) (* C2 b01) (neg (* C1 (+ fi1 f01)) ))) 357 357 (0 = (+ (* C1 f01) (* I2 bi2) (* C3 b02) (neg (* C2 (+ b01 fi2 f02)) ))) 358 358 (0 = (+ (* C2 f02) (* I3 bi3) (* C4 b03) (neg (* C3 (+ b02 fi3 f03)) ))) … … 364 364 (0 = (+ (* I1 f11) (* C2 fi2) (* I3 b12) (neg (* I2 (+ b11 bi2 f12)) ))) 365 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)) )))366 (0 = (+ (* I3 f13) (* C4 fi4) (* I5 b14) (neg (* I4 (+ b13 bi4 f14)) ))) 367 367 (0 = (+ (* I4 f14) (* C5 fi5) (* I6 b1n) (neg (* I5 (+ b14 bi5 f1n)) ))) 368 368 (1 = (+ C1 C2 C3 C4 C5 O B I1 I2 I3 I4 I5 I6 ))) 
release/3/nemo/trunk/nemocore.scm
r12129 r12167 39 39 (declare (export makenemocore nemo:error nemo:warning 40 40 nemo:envcopy nemointern nemo:quantity? 41 nemo:rhs? nemo:lineq? 41 42 evalnemosystemdecls 42 43 TSCOMP ASGN CONST PRIM)) … … 80 81 (define (optional pred?) (lambda (x) (or (not x) (pred? x)))) 81 82 82 (define (rhs? x) (or (symbol? x) (number? x) (and (list? x) (every rhs? x)))) 83 (define (rhs? x) 84 (or (symbol? x) (number? x) 85 (match x (((? symbol?) . rest) (every rhs? rest)) (else #f)))) 83 86 84 87 (define (lineq? x) (match x (((? integer?) '= (? rhs?)) #t) (else #f))) 88 89 (define nemo:rhs? rhs?) 90 (define nemo:lineq? lineq?) 85 91 86 92 (define (transition? x) … … 96 102 (ASGN (name symbol?) (value number?) (rhs rhs?) ) 97 103 (CONST (name symbol?) (value number?)) 98 (TSCOMP (name symbol?) (initial ( optional rhs?)) (initialeq (optional lineq?))104 (TSCOMP (name symbol?) (initial (lambda (x) (or (rhs? x) (and (list? x) (every lineq? x))))) 99 105 (open (lambda (x) (or (symbol? x) (and (list? x) (every symbol? x) )))) 100 106 (transitions (lambda (x) (and (list? x) (every transition? x)))) … … 897 903 (('statecomplex (id . alst) ) 898 904 (cond ((and (symbol? id) (list? alst)) 899 (let ((initial (evalconst (lookupdef 'initial alst))) 905 (let ((initial (lookupdef 'initial alst)) 906 (initialeq (alistref 'initialequilibrium alst)) 900 907 (power (evalconst (lookupdef 'power alst)))) 901 (apply ((nemocore 'envextend!) sys) 902 (cons* id '(tscomp) initial `(power ,power) alst))) 903 (cons id qs)) 908 (if (not (or initial initialeq)) 909 (nemo:error 'evalnemosystemdecls 910 "state complex declarations require initial value or " 911 "initial equilibrium equations")) 912 (if (and initialeq 913 (or (not (list? initialeq)) (not (every lineq? initialeq)))) 914 (nemo:error 'evalnemosystemdecls 915 "initial equilibrium field in state complex declarations " 916 "must be a list of linear equations")) 917 (let ((initialv (and initial (evalconst initial)))) 918 (apply ((nemocore 'envextend!) sys) 919 (cons* id '(tscomp) (or initialv initialeq) `(power ,power) alst)) 920 (cons id qs)))) 904 921 (else (nemo:error 'evalnemosystemdecls 905 922 "state complex declarations must be of the form: " 
release/3/nemo/trunk/nemonmodl.scm
r12129 r12167 1 1 2 ;; TODO: * include option for generating kinetic eqs 3 ;; * check that open states are valid 2 ;; TODO: * check that open states are valid 4 3 ;; 5 4 ;; … … 237 236 (expr4 (namenormalize expr3))) 238 237 expr4))) 238 239 239 240 240 (define (formatexpr/NMODL indent expr . rest) … … 314 314 (letoptionals rest ((rv #f) (width 72)) 315 315 (sdoc>string (doc:format width (formatexpr/NMODL 2 x rv))))) 316 317 318 (define (formatlineq/NMODL indent expr . rest) 319 (letoptionals rest ((rv #f)) 320 (let ((indent+ (+ 2 indent))) 321 (match expr 322 (('let bindings body) 323 (letblk/NMODL 324 (foldright 325 (lambda (x ax) 326 (letblk/NMODL 327 (match (second x) 328 (('if c t e) 329 (ifthen/NMODL 330 (group/NMODL (formatlineq/NMODL indent c)) 331 (block/NMODL (formatlineq/NMODL indent t (first x))) 332 (block/NMODL (formatlineq/NMODL indent e (first x))))) 333 (else 334 (formatop/NMODL indent+ " = " 335 (list (formatlineq/NMODL indent (first x) ) 336 (formatlineq/NMODL indent (second x)))))) 337 ax)) 338 (doc:empty) bindings) 339 (let ((body1 (doc:nest indent (formatlineq/NMODL indent body)))) 340 (if rv (formatop/NMODL indent " = " (list (formatlineq/NMODL indent+ rv ) body1)) 341 body1)))) 342 343 (('if . rest) (error 'formatlineq/NMODL "invalid if statement " expr)) 344 345 ((op . rest) 346 (let ((op (case op ((pow) '^) ((abs) 'fabs) (else op)))) 347 (let ((fe 348 (if (member op nmodlops) 349 (let ((mdiv? (any (lambda (x) (match x (('* . _) #t) (('/ . _) #t) (else #f))) rest)) 350 (mul? (any (lambda (x) (match x (('* . _) #t) (else #f))) rest)) 351 (plmin? (any (lambda (x) (match x (('+ . _) #t) ((' . _) #t) (else #f))) rest))) 352 (case op 353 ((/) 354 (formatop/NMODL indent op 355 (map (lambda (x) 356 (let ((fx (formatlineq/NMODL indent+ x))) 357 (if (or (symbol? x) (number? x)) fx 358 (if (or mul? plmin?) (group/NMODL fx) fx)))) rest))) 359 ((*) 360 (formatop/NMODL indent op 361 (map (lambda (x) 362 (let ((fx (formatlineq/NMODL indent+ x))) 363 (if (or (symbol? x) (number? x)) fx 364 (if plmin? (group/NMODL fx) fx)))) rest))) 365 366 ((^) 367 (formatop/NMODL indent op 368 (map (lambda (x) 369 (let ((fx (formatlineq/NMODL indent+ x))) 370 (if (or (symbol? x) (number? x)) fx 371 (if (or mdiv? plmin?) (group/NMODL fx) fx)))) rest))) 372 373 (else 374 (formatop/NMODL indent op 375 (map (lambda (x) 376 (let ((fx (formatlineq/NMODL indent+ x))) fx)) rest))))) 377 378 (case op 379 ((neg) (formatop/NMODL indent '* (map (lambda (x) (formatlineq/NMODL indent+ x)) 380 (cons "(1)" rest)))) 381 (else (formatfncall/NMODL indent op (map (lambda (x) (formatlineq/NMODL indent+ x)) 382 rest))))))) 383 384 (if rv (formatop/NMODL indent " = " (list (formatlineq/NMODL indent+ rv ) fe)) fe)))) 385 386 (else (let ((fe (doc:text (>string expr)))) 387 (if rv 388 (formatop/NMODL indent " = " (list (formatlineq/NMODL indent+ rv ) fe)) 389 fe))))))) 390 391 392 393 (define (lineq>string/NMODL x val . rest) 394 (letoptionals rest ((width 72)) 395 (s+ "~ " (sdoc>string (doc:format width (formatlineq/NMODL 2 x #f))) 396 " = " (number>string val)))) 316 397 317 398 … … 467 548 (list (nmodlname n) init1))) 468 549 550 551 (define (stateiniteq n transitions init) 552 (let* ((substconvert (substdriver (lambda (x) (and (symbol? x) x)) binding? identity bind substterm)) 553 (statelist (let loop ((lst (list)) (tlst transitions)) 554 (if (null? tlst) (deleteduplicates lst eq?) 555 (match (car tlst) 556 (('> (and (? symbol?) s0) (and (? symbol?) s1) rateexpr) 557 (loop (cons* s0 s1 lst) (cdr tlst))) 558 (((and (? symbol?) s0) '> (and (? symbol? s1)) rateexpr) 559 (loop (cons* s0 s1 lst) (cdr tlst))) 560 (('<> (and (? symbol?) s0) (and (? symbol?) s1) rateexpr1 rateexpr2) 561 (loop (cons* s0 s1 lst) (cdr tlst))) 562 (((and (? symbol?) s0) 'M> (and (? symbol? s1)) rateexpr1 rateexpr2) 563 (loop (cons* s0 s1 lst) (cdr tlst))) 564 (else 565 (nemo:error 'nemo:stateiniteq ": invalid transition equation " 566 (car tlst) " in state complex " n)) 567 (else (loop lst (cdr tlst))))))) 568 (statesubs (fold (lambda (s ax) (substextend s (nmodlstatename n s) ax)) substempty statelist)) 569 (init1 (map (lambda (lineq) (match lineq ((i '= . expr) `(,i = . ,(substconvert expr statesubs))))) 570 init))) 571 (list (nmodlname n) init1))) 572 469 573 (define (asgneq n rhs) 470 574 (let* ((fbody (rhsexpr rhs)) … … 547 651 (if (nemo:quantity? en) 548 652 (cases nemo:quantity en 549 (TSCOMP (name initial open transitions power) 550 (cons* (stateinit name initial) 551 (stateinit (nmodlstatename name open) name) ax)) 653 (TSCOMP (name initial open transitions power) 654 (if (nemo:rhs? initial) 655 (cons* (stateinit name initial) 656 (stateinit (nmodlstatename name open) name) ax) 657 ax)) 552 658 (else ax)) 553 659 ax)))) 554 660 ax lst)) 555 661 (list) poset)) 662 663 664 (define (poset>stateiniteqdefs poset sys) 665 (foldright 666 (lambda (lst ax) 667 (fold (lambda (x ax) 668 (matchlet (((i . n) x)) 669 (let ((en (environmentref sys n))) 670 (if (nemo:quantity? en) 671 (cases nemo:quantity en 672 (TSCOMP (name initial open transitions power) 673 (if (and (list? initial) (every nemo:lineq? initial)) 674 (cons (stateiniteq name transitions initial) ax) 675 ax)) 676 (else ax)) 677 ax)))) 678 ax lst)) 679 (list) poset)) 680 556 681 557 682 (define (findlocals defs) … … 816 941 817 942 818 (pp indent ,nl (INITIAL "{")) 819 (let* ((initdefs (poset>stateinitdefs poset sys)) 820 (locals (concatenate (findlocals (map second initdefs)))) ) 943 (let* ((initdefs (poset>stateinitdefs poset sys)) 944 (initeqdefs (poset>stateiniteqdefs poset sys)) 945 (locals (concatenate (findlocals (map second initdefs)))) ) 946 (pp indent ,nl (INITIAL "{")) 821 947 (if (not (null? locals)) (pp indent+ (LOCAL ,(sl\ ", " locals)))) 822 948 (if (not (null? asgns)) (pp indent+ (rates ()))) … … 824 950 (let ((n (first def)) (b (second def))) 825 951 (pp indent+ ,(expr>string/NMODL b n)))) initdefs) 826 (foreach (lambda (x) (pp indent+ (,(third x) = ,(fourth x)))) 827 permions)) 828 (pp indent "}") 829 830 ))) 952 (foreach (lambda (x) (pp indent+ (,(third x) = ,(fourth x)))) permions) 953 (if (not (null? initeqdefs)) (pp indent+ (SOLVE initial_equilibrium))) 954 (pp indent "}") 955 (if (not (null? initeqdefs)) 956 (begin 957 (pp indent ,nl (LINEAR initial_equilibrium "{")) 958 (foreach 959 (lambda (x) 960 (let ((lineqs (second x))) 961 (foreach (lambda (eq) 962 (let ((val (first eq)) 963 (expr (third eq))) 964 (pp indent+ ,(lineq>string/NMODL expr val)))) 965 lineqs))) 966 initeqdefs) 967 (pp indent "}"))) 968 )))) 831 969 )))))
Note: See TracChangeset
for help on using the changeset viewer.