Changeset 12624 in project
 Timestamp:
 11/28/08 03:04:46 (12 years ago)
 Location:
 release/3/nemo/trunk
 Files:

 3 edited
Legend:
 Unmodified
 Added
 Removed

release/3/nemo/trunk/nemomatlab.scm
r12567 r12624 28 28 (requireextension lolevel) 29 29 (requireextension varsubst) 30 (requireextension digraph)31 30 (requireextension datatype) 32 31 … … 245 244 246 245 (define (stateeqs n initial open transitions power) 247 (let* ((substconvert (substdriver (lambda (x) (and (symbol? x) x)) binding? identity bind substterm)) 248 (g (makedigraph n (stringappend (>string n) " transitions graph"))) 249 (addnode! (g 'addnode!)) 250 (addedge! (g 'addedge!)) 251 (outedges (g 'outedges)) 252 (inedges (g 'inedges)) 253 (nodeinfo (g 'nodeinfo)) 254 (nodelist (let loop ((lst (list)) (tlst transitions)) 255 (if (null? tlst) (deleteduplicates lst eq?) 256 (match (car tlst) 257 (('> (and (? symbol?) s0) (and (? symbol?) s1) rateexpr) 258 (loop (cons* s0 s1 lst) (cdr tlst))) 259 (((and (? symbol?) s0) '> (and (? symbol? s1)) rateexpr) 260 (loop (cons* s0 s1 lst) (cdr tlst))) 261 (('<> (and (? symbol?) s0) (and (? symbol?) s1) rateexpr1 rateexpr2) 262 (loop (cons* s0 s1 lst) (cdr tlst))) 263 (((and (? symbol?) s0) 'M> (and (? symbol? s1)) rateexpr1 rateexpr2) 264 (loop (cons* s0 s1 lst) (cdr tlst))) 265 (else 266 (nemo:error 'nemo:matlabstateeqs ": invalid transition equation " 267 (car tlst) " in state complex " n)) 268 (else (loop lst (cdr tlst))))))) 269 (nodeids (listtabulate (length nodelist) identity)) 270 (name>idmap (zip nodelist nodeids)) 271 (nodesubs (fold (lambda (s ax) (substextend s (matlabstatename n s) ax)) substempty nodelist))) 272 ;; insert state nodes in the dependency graph 273 (foreach (lambda (i n) (addnode! i n)) nodeids nodelist) 274 (let* ((nodes ((g 'nodes))) 275 (snode (find (lambda (s) (not (eq? (second s) open))) nodes)) 276 (snex `( 1 ,(sum (filtermap (lambda (s) (and (not (= (first s) (first snode))) (second s))) nodes)))) 277 (addtredge (lambda (s0 s1 rexpr1 rexpr2) 278 (let ((i (car (alistref s0 name>idmap))) 279 (j (car (alistref s1 name>idmap))) 280 (x0 (if (eq? s0 (second snode)) snex s0)) 281 (x1 (if (eq? s1 (second snode)) snex s1))) 282 (addedge! (list i j `(* ,(substconvert x0 nodesubs) 283 ,(substconvert rexpr1 nodesubs)))) 284 (if rexpr2 (addedge! (list j i `(* ,(substconvert x1 nodesubs) 285 ,(substconvert rexpr2 nodesubs))))))))) 286 ;; create rate edges in the graph 287 (foreach (lambda (e) 288 (match e 289 (('> s0 s1 rexpr) (addtredge s0 s1 rexpr #f)) 290 ((s0 '> s1 rexpr) (addtredge s0 s1 rexpr #f)) 291 (('<> s0 s1 rexpr1 rexpr2) (addtredge s0 s1 rexpr1 rexpr2)) 292 ((s0 '<> s1 rexpr1 rexpr2) (addtredge s0 s1 rexpr1 rexpr2)) 293 )) 294 transitions) 295 246 (matchlet (((g nodesubs) (transitionsgraph n open transitions matlabstatename))) 247 (let* ((outedges (g 'outedges)) 248 (inedges (g 'inedges)) 249 (nodes ((g 'nodes))) 250 (snode (find (lambda (s) (not (eq? (second s) open))) nodes))) 296 251 ;; generate differential equations for each state in the transitions system 297 252 (let ((eqs (fold (lambda (s ax) … … 308 263 ((and (null? out) (not (null? in))) 309 264 (sum (map third in))))) 310 (fbody (rhsexpr/MATLAB rhs1))311 (fbody1 (canonicalizeexpr/MATLAB fbody)))265 (fbody0 (rhsexpr/MATLAB rhs1)) 266 (fbody1 (canonicalizeexpr/MATLAB fbody0))) 312 267 (cons (list name fbody1) ax))))) 313 268 (list) nodes))) 314 269 eqs)))) 315 316 317 270 318 271 … … 702 655 703 656 (let* ((initdefs (poset>stateinitdefs poset sys))) 704 ;; (initeqdefs (poset>stateiniteqdefs poset sys)))705 657 706 658 (pp indent+ (y0 = zeros(,(length stateindexmap) #\, 1) #\;)) … … 728 680 initdefs) 729 681 730 #731 (foreach732 (lambda (x)733 (let ((lineqs (second x)))734 (foreach (lambda (eq)735 (let ((val (first eq))736 (expr (third eq)))737 (pp indent+ ,(lineq>string/NMODL expr val))))738 lineqs)))739 initeqdefs)740 #741 682 742 683 ) 
release/3/nemo/trunk/nemonmodl.scm
r12558 r12624 28 28 (requireextension lolevel) 29 29 (requireextension varsubst) 30 (requireextension digraph)31 30 (requireextension datatype) 32 31 … … 378 377 379 378 (define (stateeqs n initial open transitions power method) 380 (let* ((substconvert (substdriver (lambda (x) (and (symbol? x) x)) binding? identity bind substterm)) 381 (g (makedigraph n (stringappend (>string n) " transitions graph"))) 382 (addnode! (g 'addnode!)) 383 (addedge! (g 'addedge!)) 384 (outedges (g 'outedges)) 385 (inedges (g 'inedges)) 386 (nodeinfo (g 'nodeinfo)) 387 (nodelist (let loop ((lst (list)) (tlst transitions)) 388 (if (null? tlst) (deleteduplicates lst eq?) 389 (match (car tlst) 390 (('> (and (? symbol?) s0) (and (? symbol?) s1) rateexpr) 391 (loop (cons* s0 s1 lst) (cdr tlst))) 392 (((and (? symbol?) s0) '> (and (? symbol? s1)) rateexpr) 393 (loop (cons* s0 s1 lst) (cdr tlst))) 394 (('<> (and (? symbol?) s0) (and (? symbol?) s1) rateexpr1 rateexpr2) 395 (loop (cons* s0 s1 lst) (cdr tlst))) 396 (((and (? symbol?) s0) 'M> (and (? symbol? s1)) rateexpr1 rateexpr2) 397 (loop (cons* s0 s1 lst) (cdr tlst))) 398 (else 399 (nemo:error 'nemo:nmodlstateeqs ": invalid transition equation " 400 (car tlst) " in state complex " n)) 401 (else (loop lst (cdr tlst))))))) 402 (nodeids (listtabulate (length nodelist) identity)) 403 (name>idmap (zip nodelist nodeids)) 404 (nodesubs (fold (lambda (s ax) (substextend s (nmodlstatename n s) ax)) substempty nodelist))) 405 ;; insert state nodes in the dependency graph 406 (foreach (lambda (i n) (addnode! i n)) nodeids nodelist) 407 (let* ((nodes ((g 'nodes))) 408 (snode (find (lambda (s) (not (eq? (second s) open))) nodes)) 409 (snex `( 1 ,(sum (filtermap (lambda (s) (and (not (= (first s) (first snode))) (second s))) nodes)))) 410 (addtredge (lambda (s0 s1 rexpr1 rexpr2) 411 (let ((i (car (alistref s0 name>idmap))) 412 (j (car (alistref s1 name>idmap))) 413 (x0 (if (eq? s0 (second snode)) snex s0)) 414 (x1 (if (eq? s1 (second snode)) snex s1))) 415 (addedge! (list i j `(* ,(substconvert x0 nodesubs) 416 ,(substconvert rexpr1 nodesubs)))) 417 (if rexpr2 (addedge! (list j i `(* ,(substconvert x1 nodesubs) 418 ,(substconvert rexpr2 nodesubs))))))))) 419 ;; create rate edges in the graph 420 (foreach (lambda (e) 421 (match e 422 (('> s0 s1 rexpr) (addtredge s0 s1 rexpr #f)) 423 ((s0 '> s1 rexpr) (addtredge s0 s1 rexpr #f)) 424 (('<> s0 s1 rexpr1 rexpr2) (addtredge s0 s1 rexpr1 rexpr2)) 425 ((s0 '<> s1 rexpr1 rexpr2) (addtredge s0 s1 rexpr1 rexpr2)) 426 )) 427 transitions) 428 429 ;; generate differential equations for each state in the transitions system 379 (matchlet (((g nodesubs) (transitionsgraph n open transitions nmodlstatename))) 380 (let* ((outedges (g 'outedges)) 381 (inedges (g 'inedges)) 382 (nodes ((g 'nodes))) 383 (snode (find (lambda (s) (not (eq? (second s) open))) nodes))) 384 ;; generate differential equations for each state in the transitions system 430 385 (let ((eqs (fold (lambda (s ax) 431 386 (if (= (first snode) (first s) ) ax 
release/3/nemo/trunk/nemoutils.scm
r12556 r12624 26 26 (requireextension srfi13) 27 27 (requireextension varsubst) 28 (requireextension digraph) 28 29 29 30 (defineextension nemoutils) … … 37 38 ifconvert letenum letelim letlift 38 39 s+ sw+ sl\ nl spaces ppf 40 transitionsgraph 39 41 )) 42 43 40 44 41 45 (define (lookupdef k lst . rest) … … 152 156 (else (print sp (if (list? x) (sw+ x) x)))))) 153 157 lst))) 158 159 160 (define (transitionsgraph n open transitions statename) 161 (let* ((substconvert (substdriver (lambda (x) (and (symbol? x) x)) binding? identity bind substterm)) 162 (g (makedigraph n (stringappend (>string n) " transitions graph"))) 163 (addnode! (g 'addnode!)) 164 (addedge! (g 'addedge!)) 165 (outedges (g 'outedges)) 166 (inedges (g 'inedges)) 167 (nodeinfo (g 'nodeinfo)) 168 (nodelist (let loop ((lst (list)) (tlst transitions)) 169 (if (null? tlst) (deleteduplicates lst eq?) 170 (match (car tlst) 171 (('> (and (? symbol?) s0) (and (? symbol?) s1) rateexpr) 172 (loop (cons* s0 s1 lst) (cdr tlst))) 173 (((and (? symbol?) s0) '> (and (? symbol? s1)) rateexpr) 174 (loop (cons* s0 s1 lst) (cdr tlst))) 175 (('<> (and (? symbol?) s0) (and (? symbol?) s1) rateexpr1 rateexpr2) 176 (loop (cons* s0 s1 lst) (cdr tlst))) 177 (((and (? symbol?) s0) 'M> (and (? symbol? s1)) rateexpr1 rateexpr2) 178 (loop (cons* s0 s1 lst) (cdr tlst))) 179 (else 180 (nemo:error 'stateeqs ": invalid transition equation " 181 (car tlst) " in state complex " n)) 182 (else (loop lst (cdr tlst))))))) 183 (nodeids (listtabulate (length nodelist) identity)) 184 (name>idmap (zip nodelist nodeids)) 185 (nodesubs (fold (lambda (s ax) (substextend s (statename n s) ax)) substempty nodelist))) 186 ;; insert state nodes in the dependency graph 187 (foreach (lambda (i n) (addnode! i n)) nodeids nodelist) 188 (let* ((nodes ((g 'nodes))) 189 (snode (find (lambda (s) (not (eq? (second s) open))) nodes)) 190 (snex `( 1 ,(sum (filtermap (lambda (s) (and (not (= (first s) (first snode))) (second s))) nodes)))) 191 (addtredge (lambda (s0 s1 rexpr1 rexpr2) 192 (let ((i (car (alistref s0 name>idmap))) 193 (j (car (alistref s1 name>idmap))) 194 (x0 (if (eq? s0 (second snode)) snex s0)) 195 (x1 (if (eq? s1 (second snode)) snex s1))) 196 (addedge! (list i j `(* ,(substconvert x0 nodesubs) 197 ,(substconvert rexpr1 nodesubs)))) 198 (if rexpr2 (addedge! (list j i `(* ,(substconvert x1 nodesubs) 199 ,(substconvert rexpr2 nodesubs))))))))) 200 ;; create rate edges in the graph 201 (foreach (lambda (e) 202 (match e 203 (('> s0 s1 rexpr) (addtredge s0 s1 rexpr #f)) 204 ((s0 '> s1 rexpr) (addtredge s0 s1 rexpr #f)) 205 (('<> s0 s1 rexpr1 rexpr2) (addtredge s0 s1 rexpr1 rexpr2)) 206 ((s0 '<> s1 rexpr1 rexpr2) (addtredge s0 s1 rexpr1 rexpr2)) 207 )) 208 transitions) 209 210 (list g nodesubs)))) 211
Note: See TracChangeset
for help on using the changeset viewer.