source: project/release/4/nemo/trunk/nemo-pyparams.scm @ 27093

Last change on this file since 27093 was 27093, checked in by Ivan Raikov, 9 years ago

nemo: eliminated dependency on environments

File size: 24.8 KB
Line 
1;;       
2;;
3;; An extension for generating Python code describing the parameters of NEMO models.
4;;
5;; Copyright 2008-2012 Ivan Raikov and the Okinawa Institute of Science and Technology
6;;
7;; This program is free software: you can redistribute it and/or
8;; modify it under the terms of the GNU General Public License as
9;; published by the Free Software Foundation, either version 3 of the
10;; License, or (at your option) any later version.
11;;
12;; This program is distributed in the hope that it will be useful, but
13;; WITHOUT ANY WARRANTY; without even the implied warranty of
14;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
15;; General Public License for more details.
16;;
17;; A full copy of the GPL license can be found at
18;; <http://www.gnu.org/licenses/>.
19;;
20
21(module nemo-pyparams
22
23        (nemo:pyparams-translator)
24
25        (import scheme chicken utils data-structures lolevel ports srfi-1 srfi-13 srfi-69)
26       
27        (require-extension lolevel matchable strictly-pretty 
28                           varsubst datatype nemo-core nemo-utils
29                           nemo-gate-complex)
30
31(define python-builtin-consts
32  `())
33
34(define python-ops
35  `(+ - * / > < <= >= = ^))
36
37(define builtin-fns
38  `(+ - * / pow neg abs atan asin acos sin cos exp ln
39      sqrt tan cosh sinh tanh hypot gamma lgamma log10 log2 log1p ldexp cube
40      > < <= >= = and or round ceiling floor max min
41      ))
42
43(define (python-name s)
44  (let ((cs (string->list (->string s))))
45    (let loop ((lst (list)) (cs cs))
46      (if (null? cs) (string->symbol (list->string (reverse lst)))
47          (let* ((c (car cs))
48                 (c1 (cond ((or (char-alphabetic? c) (char-numeric? c) (char=? c #\_)) c)
49                           (else #\_))))
50            (loop (cons c1 lst) (cdr cs)))))))
51           
52
53(define (nmodl-name s)
54  (let ((cs (string->list (->string s))))
55    (let loop ((lst (list)) (cs cs))
56      (if (null? cs) (string->symbol (list->string (reverse lst)))
57          (let* ((c (car cs))
58                 (c1 (cond ((or (char-alphabetic? c) (char-numeric? c) (char=? c #\_)) c)
59                           (else #\_))))
60            (loop (cons c1 lst) (cdr cs)))))))
61
62
63(define (rhsexpr/python expr)
64  (match expr 
65         (('if . es)  `(if . ,(map (lambda (x) (rhsexpr/python x)) es)))
66         (('pow x y)  (if (and (integer? y)  (positive? y))
67                          (if (> y 1)  (let ((tmp (gensym "x")))
68                                         `(let ((,tmp ,x)) (* . ,(list-tabulate (inexact->exact y) (lambda (i) tmp)))))
69                              x)
70                            expr))
71         ((s . es)    (if (symbol? s)  (cons (if (member s builtin-fns) s (python-name s)) (map (lambda (x) (rhsexpr/python x)) es)) expr))
72         (id          (if (symbol? id) (python-name id) id))))
73
74(define (python-state-name n s)
75  (python-name (s+ n s)))
76
77(define-syntax pp
78  (syntax-rules ()
79    ((pp indent val ...) (ppf indent (quasiquote val) ...))))
80
81
82(define tuple/python   (doc:block 2 (doc:text "(") (doc:text ")")))
83(define dict/python    (doc:block 2 (doc:text "{") (doc:text "}")))
84(define group/python   (doc:block 2 (doc:text "(") (doc:text ")")))
85(define block/python   (doc:block 2 (doc:empty) (doc:empty)))
86
87(define (stmt/python x) 
88  (match x
89         (($ doc 'DocCons _ ($ doc 'DocText "")) x)
90         (else  (doc:cons x (doc:text "")))))
91
92
93(define (ifthen/python c e1 e2)
94  (doc:nest 
95   2 (doc:connect
96      (doc:connect (doc:group (doc:connect (doc:text "if") c))
97                   (doc:connect (doc:nest 2 e1)
98                                (doc:nest 2 (doc:connect (doc:text "else") e2))))
99      (doc:text "end"))))
100
101(define (letblk/python e1 e2)
102  (cond ((equal? e1 (doc:empty)) (doc:group (doc:nest 2 e2)))
103        ((equal? e2 (doc:empty)) (doc:group (doc:nest 2 e1)))
104        (else (doc:connect (doc:group (doc:nest 2 (stmt/python e1)))
105                           (doc:group (doc:nest 2 e2))))))
106       
107
108(define (format-op/python indent op args)
109  (let ((op1 (doc:text (->string op))))
110    (if (null? args) op1
111        (match args
112               ((x)      (doc:concat (list op1 x)))
113               ((x y)    (doc:concat (intersperse (list x op1 y) (doc:space))))
114               ((x y z)  (doc:concat (intersperse (list x op1 y op1 z) (doc:space))))
115               (lst      (let* ((n   (length lst))
116                                (n/2 (inexact->exact (round (/ n 2)))))
117                           (doc:concat 
118                            (intersperse 
119                             (list (format-op/python indent op (take lst n/2 )) op1 
120                                   (format-op/python indent op (drop lst n/2 )))
121                             (doc:space)))))))))
122
123
124(define (format-fncall/python indent op args)
125  (let ((op1 (doc:text (->string op))))
126    (doc:cons op1 (group/python ((doc:list indent identity (lambda () (doc:text ", "))) args)))))
127
128
129(define (format-dict/python indent args)
130  (dict/python ((doc:list indent 
131                          (lambda (x) 
132                            (let ((k (car x)) (v (cdr x)))
133                              (doc:cons (doc:text k) 
134                                        (doc:cons (doc:text ": ") 
135                                                  (doc:cons (doc:text v) 
136                                                            (doc:empty))))))
137                          (lambda () (doc:cons (doc:text ", ") 
138                                               (doc:cons (doc:break) 
139                                                         (doc:empty)))))
140                args)))
141
142(define (format-tuple/python indent args)
143  (tuple/python ((doc:list indent 
144                          (lambda (v) (doc:text v))
145                          (lambda () (doc:cons (doc:text ", ") 
146                                               (doc:cons (doc:break) 
147                                                         (doc:empty)))))
148                args)))
149
150
151(define (name-normalize expr)
152  (match expr 
153         (('if c t e)  `(if ,(name-normalize c) ,(name-normalize t) ,(name-normalize e)))
154         (('let bs e)
155          `(let ,(map (lambda (b) `(,(car b) ,(name-normalize (cadr b)))) bs) ,(name-normalize e)))
156         ((f . es) 
157          (cons f (map name-normalize es)))
158         ((? symbol? ) (python-name expr))
159         ((? atom? ) expr)))
160
161
162(define (canonicalize-expr/python expr)
163  (let ((subst-convert  (subst-driver (lambda (x) (and (symbol? x) x)) nemo:binding? identity nemo:bind nemo:subst-term)))
164    (let* ((expr1 (if-convert expr))
165           (expr2 (subst-convert expr1 subst-empty))
166           (expr3 (let-lift expr2))
167           (expr4 (name-normalize expr3)))
168      expr4)))
169
170
171(define (format-expr/python indent expr . rest) 
172  (let-optionals rest ((rv #f))
173   (let ((indent+ (+ 2 indent)))
174    (match expr
175       (('let bindings body)
176        (letblk/python
177         (fold-right 
178           (lambda (x ax)
179             (letblk/python
180              (match (second x)
181                     (('if c t e)
182                      (ifthen/python
183                       (group/python (format-expr/python indent c))
184                       (block/python (format-expr/python indent t (first x)))
185                       (block/python (format-expr/python indent e (first x)))))
186                     (else
187                      (stmt/python
188                       (format-op/python indent+ " = "
189                                         (list (format-expr/python indent (first x) )
190                                               (format-expr/python indent (second x)))))))
191              ax))
192           (doc:empty) bindings)
193         (match body
194                (('let _ _) (format-expr/python indent body rv))
195                (else
196                 (let ((body1 (doc:nest indent (format-expr/python indent body))))
197                   (if rv (stmt/python (format-op/python indent " = " (list (format-expr/python indent+ rv ) body1)))
198                       body1))))))
199       
200       (('if . rest) (error 'format-expr/python "invalid if statement " expr))
201
202       ((op . rest) 
203       (let ((op (case op ((pow)  '^)  ((ln) 'log) (else op))))
204         (let ((fe
205                (if (member op python-ops)
206                    (let ((mdiv?  (any (lambda (x) (match x (('* . _) #t) (('/ . _) #t) (else #f))) rest))
207                          (mul?   (any (lambda (x) (match x (('* . _) #t) (else #f))) rest))
208                          (plmin? (any (lambda (x) (match x (('+ . _) #t) (('- . _) #t) (else #f))) rest)))
209                      (case op
210                        ((/) 
211                         (format-op/python indent op 
212                                          (map (lambda (x) 
213                                                 (let ((fx (format-expr/python indent+ x)))
214                                                   (if (or (symbol? x) (number? x)) fx
215                                                       (if (or mul? plmin?) (group/python fx) fx)))) rest)))
216                        ((*) 
217                         (format-op/python indent op 
218                                          (map (lambda (x) 
219                                                 (let ((fx (format-expr/python indent+ x)))
220                                                   (if (or (symbol? x) (number? x)) fx
221                                                       (if plmin? (group/python fx) fx)))) rest)))
222                       
223                        ((^) 
224                         (format-op/python indent op 
225                                          (map (lambda (x) 
226                                                 (let ((fx (format-expr/python indent+ x)))
227                                                   (if (or (symbol? x)  (number? x)) fx
228                                                       (if (or mdiv? plmin?) (group/python fx) fx)))) rest)))
229                       
230                        (else
231                         (format-op/python indent op 
232                                          (map (lambda (x) 
233                                                 (let ((fx (format-expr/python indent+ x))) fx)) rest)))))
234                   
235                    (let ((op (case op ((neg) '-) (else op))))
236                      (format-fncall/python indent op (map (lambda (x) (format-expr/python indent+ x)) rest))))))
237           (if rv 
238               (stmt/python (format-op/python indent " = " (list (format-expr/python indent+ rv ) fe)))
239               fe))))
240     
241      (else  (let ((fe (doc:text (->string expr))))
242               (if rv 
243                   (stmt/python (format-op/python indent " = " (list (format-expr/python indent+ rv ) fe)))
244                   fe)))))))
245
246(define (doc->string x . rest)
247  (let-optionals rest ((width 72))
248   (sdoc->string (doc:format width x))))
249         
250(define (expr->string/python x . rest)
251  (let-optionals rest ((rv #f) (width 72))
252     (doc->string
253      (format-expr/python 2 x rv)
254      width)))
255
256
257(define (state-init n init)
258  (let* ((init  (rhsexpr/python init))
259         (init1 (canonicalize-expr/python init)))
260    (list (python-name n) init1)))
261
262
263(define (asgn-eq n rhs)
264  (let* ((fbody   (rhsexpr/python rhs))
265         (fbody1  (canonicalize-expr/python fbody)))
266    (list (python-name n) fbody1)))
267
268
269(define (reaction-eq n open transitions conserve)
270  (match-let (((g cnode node-subs)  (transitions-graph n open transitions conserve python-state-name)))
271    (let ((nodes ((g 'nodes))))
272;      (if (< 2 (length nodes))
273;         (list (python-name n) `(abs (/ ,(python-state-name n open)
274;                                        ,(sum (filter-map (lambda (x) (and (not (= (first x) (first cnode)))
275;                                                                           (python-state-name n (second x)))) nodes)))))
276          (list (python-name n) (python-state-name n open)))))
277
278(define (reaction-transition-eqs n initial open transitions conserve power)
279  (match-let (((g cnode node-subs)  (transitions-graph n open transitions conserve python-state-name)))
280     (let* ((out-edges  (g 'out-edges))
281            (in-edges   (g 'in-edges))
282            (nodes      ((g 'nodes))))
283       ;; generate differential equations for each state in the transitions system
284      (let ((eqs    (fold (lambda (s ax) 
285                            (if (and cnode (= (first cnode) (first s) )) ax
286                                (let* ((out   (out-edges (first s)))
287                                       (in    (in-edges (first s)))
288                                       (open? (eq? (second s) open))
289                                       (name  (python-name (lookup-def (second s) node-subs))))
290                                  (let* ((rhs1  (cond ((and (not (null? out)) (not (null? in)))
291                                                       `(+ (neg ,(sum (map third out)))
292                                                           ,(sum (map third in))))
293                                                      ((and (not (null? out)) (null? in))
294                                                       `(neg ,(sum (map third out))))
295                                                      ((and (null? out) (not (null? in)))
296                                                       (sum (map third in)))))
297                                         (fbody0 (rhsexpr/python rhs1))
298                                         (fbody1 (canonicalize-expr/python fbody0)))
299                                    (cons (list name fbody1) ax))
300                                  )))
301                          (list) nodes)))
302        eqs))))
303
304       
305
306(define (poset->asgn-eq-defs poset sys)
307  (fold-right
308   (lambda (lst ax)
309     (fold  (lambda (x ax) 
310              (match-let (((i . n)  x))
311                         (let ((en (hash-table-ref sys n)))
312                           (if (nemo:quantity? en)
313                               (cases nemo:quantity en
314                                      (ASGN  (name value rhs) (cons (asgn-eq name rhs) ax))
315                                      (else  ax))
316                               ax))))
317            ax lst))
318   (list) poset))
319
320(define (poset->rate-eq-defs poset sys)
321  (fold-right
322   (lambda (lst ax)
323     (fold  (lambda (x ax) 
324              (match-let (((i . n)  x))
325                         (let ((en (hash-table-ref sys n)))
326                           (if (nemo:quantity? en)
327                               (cases nemo:quantity en
328
329                                      (REACTION  (name initial open transitions conserve power) 
330                                                 (append (reaction-transition-eqs name initial open transitions 
331                                                                                  conserve power) ax))
332                                     
333                                      (RATE (name initial rhs power)
334                                            (let ((fbody0  (rhsexpr/python rhs))
335                                                  (dy      (python-name name) ))
336                                              (cons (list dy (canonicalize-expr/python fbody0)) ax)))
337
338                                      (else  ax))
339                               ax))))
340            ax lst))
341   (list) poset))
342
343
344(define (poset->reaction-eq-defs poset sys)
345  (fold-right
346   (lambda (lst ax)
347     (fold  (lambda (x ax) 
348              (match-let (((i . n)  x))
349                         (let ((en (hash-table-ref sys n)))
350                           (if (nemo:quantity? en)
351                               (cases nemo:quantity en
352                                      (REACTION  (name initial open transitions conserve power) 
353                                                 (cons (reaction-eq name open transitions conserve) ax))
354                                      (else  ax))
355                               ax))))
356            ax lst))
357   (list) poset))
358
359
360(define (poset->init-defs poset sys)
361  (fold-right
362   (lambda (lst ax)
363     (fold-right
364      (lambda (x ax) 
365              (match-let (((i . n)  x))
366                         (let ((en (hash-table-ref sys n)))
367                           (if (nemo:quantity? en)
368                               (cases nemo:quantity en
369                                      (REACTION  (name initial open transitions conserve power)
370                                                 (if (nemo:rhs? initial)
371                                                     (cons* (state-init name initial) 
372                                                            (state-init (python-state-name name open) name) ax) 
373                                                     ax))
374
375                                      (RATE  (name initial rhs power)
376                                             (if (and initial (nemo:rhs? initial))
377                                                 (cons (state-init name initial) ax) 
378                                                 ax))
379
380                                      (else  ax))
381                               ax))))
382            ax lst))
383   (list) poset))
384
385
386(define (poset->state-conserve-eq-defs poset sys)
387  (fold-right
388   (lambda (lst ax)
389     (fold  (lambda (x ax) 
390              (match-let (((i . n)  x))
391                         (let ((en (hash-table-ref sys n)))
392                           (if (nemo:quantity? en)
393                               (cases nemo:quantity en
394                                      (REACTION (name initial open transitions conserve power)
395                                                (if (and (list? conserve) (every nemo:conseq? conserve))
396                                                    (cons (state-conseqs (python-name name) transitions conserve
397                                                                        python-state-name) ax) 
398                                                    ax))
399                                      (else  ax))
400                               ax))))
401            ax lst))
402   (list) poset))
403
404
405(define (reaction-power sys n)
406  (let ((en (hash-table-ref sys n)))
407    (if (nemo:quantity? en)
408        (cases nemo:quantity en
409               (REACTION  (name initial open transitions conserve power)  power)
410               (else  #f))  #f)))
411
412
413(define (bucket-partition p lst)
414  (let loop ((lst lst) (ax (list)))
415    (if (null? lst) ax
416        (let ((x (car lst)))
417          (let bkt-loop ((old-bkts ax) (new-bkts (list)))
418            (if (null? old-bkts) (loop (cdr lst) (cons (list x) new-bkts))
419                (if (p x (caar old-bkts ))
420                    (loop (cdr lst) (append (cdr old-bkts) (cons (cons x (car old-bkts)) new-bkts)))
421                    (bkt-loop (cdr old-bkts) (cons (car old-bkts) new-bkts)))))))))
422
423 
424(define (make-define-fn)
425  (lambda (indent n proc)
426    (let ((lst (procedure-data proc))
427          (indent+ (+ 2 indent)))
428      (let ((retval   (python-name (gensym "retval")))
429            (rt       (lookup-def 'rt lst))
430            (formals  (lookup-def 'formals lst))
431            (vars     (lookup-def 'vars lst))
432            (body     (lookup-def 'body lst)))
433        (pp indent ,nl (function ,retval = ,(python-name n) (,(slp ", " vars)) ))
434        (let* ((body0 (rhsexpr/python body))
435               (body1 (canonicalize-expr/python body0))
436               (lbs   (enum-bnds body1 (list))))
437          (pp indent+ ,(expr->string/python body1 retval))
438          (pp indent end))
439          ))))
440
441
442
443
444(define (output-pyparams sysname i-params i-eqs
445                         const-defs asgn-eq-defs init-eq-defs 
446                         pool-ions perm-ions indent indent+)
447
448   
449    (let* ((init-eqs 
450            (append
451             
452             const-defs
453             asgn-eq-defs
454             init-eq-defs
455             
456             (map (lambda (pool-ion)
457                    (let ((n (third pool-ion))
458                          (b (first pool-ion)))
459                      (list n b)))
460                  pool-ions)))
461
462           (init-dag 
463            (map (lambda (def)
464                   (cons (first def) (enum-freevars (second def) '() '())))
465                 init-eqs))
466
467           (init-order
468            (reverse
469             (topological-sort init-dag 
470               (lambda (x y) (string=? (->string x) (->string y)))))))
471
472      (pp indent ,nl (Parameters = collections.namedtuple ("'Parameters'" "," []) ))
473
474      (for-each (lambda (x)
475                  (pp indent ,(expr->string/python (cadr x) (python-name (car x)))))
476                const-defs)
477
478      (pp indent ,nl)
479
480      (let recur ((i-params i-params) 
481                  (property-tuples '() ))
482
483        (if (null? i-params)
484           
485            (for-each (lambda (t)
486                        (pp indent (,(car t) = ,(doc->string (format-tuple/python indent+ (cdr t))))))
487                      property-tuples)
488
489            (let ((paramset (car i-params)))
490              (let ((alst (cdr paramset)))
491                (let ((label (lookup-def 'label alst))
492                      (maximal-permeability (lookup-def 'maximal-permeability alst))
493                      (maximal-conductance  (lookup-def 'maximal-conductance alst))
494                      (reversal-potential   (lookup-def 'reversal-potential alst)))
495                  (recur (cdr i-params)
496                         (let* ((property-tuples1 
497                                 (fold (lambda (l x ax)
498                                         (or (and x (cons `(,l ,(symbol->string (python-name x)) 
499                                                               ,(s+ "'" (nmodl-name x) "'")) ax))
500                                             ax))
501                                       property-tuples
502                                       (list (s+ label "_MAXIMAL_PERMEABILITY")
503                                             (s+ label "_MAXIMAL_CONDUCTANCE")
504                                             (s+ label "_REVERSAL_POTENTIAL"))
505                                       (list maximal-permeability
506                                             maximal-conductance 
507                                             reversal-potential)
508                                       )))
509                           property-tuples1))
510                  )))
511            ))
512
513    ))
514
515(define (pyparams-translator1 sys . rest)
516  (define (cid x)  (second x))
517  (define (cn x)   (first x))
518  (let-optionals rest ((mode 'multiple) (filename #f))
519  (match-let ((($ nemo:quantity 'DISPATCH  dis) (hash-table-ref sys (nemo-intern 'dispatch))))
520    (let ((imports  ((dis 'imports)  sys))
521          (exports  ((dis 'exports)  sys)))
522      (let* ((indent      0)
523             (indent+     (+ 2 indent ))
524             (eval-const  (dis 'eval-const))
525             (sysname     (python-name ((dis 'sysname) sys)))
526             (prefix      sysname)
527             (filename    (or filename (s+ sysname ".py")))
528             (deps*       ((dis 'depgraph*) sys))
529             (consts      ((dis 'consts)  sys))
530             (asgns       ((dis 'asgns)   sys))
531             (states      ((dis 'states)  sys))
532             (reactions   ((dis 'reactions) sys))
533             (defuns      ((dis 'defuns)  sys))
534             (components  ((dis 'components) sys))
535             
536             (g             (match-let (((state-list asgn-list g) ((dis 'depgraph*) sys))) g))
537             (poset         (vector->list ((dis 'depgraph->bfs-dist-poset) g)))
538
539             (const-defs       (filter-map
540                                (lambda (nv)
541                                  (and (not (member (first nv) python-builtin-consts))
542                                       (let ((v1 (canonicalize-expr/python (second nv))))
543                                         (list (python-name (first nv)) v1))))
544                                consts))
545             
546             (gate-complex-info    (nemo:gate-complex-query sys))
547
548             (gate-complexes       (lookup-def 'gate-complexes gate-complex-info))
549             (perm-ions     (map (match-lambda ((comp i e erev) `(,comp ,(python-name i) ,(python-name e) ,erev)))
550                                 (lookup-def 'perm-ions gate-complex-info)))
551             (acc-ions      (map (match-lambda ((comp i in out) `(,comp ,@(map python-name (list i in out)))))
552                                 (lookup-def 'acc-ions gate-complex-info)))
553             (epools        (lookup-def 'pool-ions gate-complex-info))
554             (pool-ions     (map (lambda (lst) (map python-name lst)) epools))
555
556             (i-gates       (lookup-def 'i-gates gate-complex-info))
557
558             (capcomp       (any (match-lambda ((name 'membrane-capacitance id) (list name id)) (else #f)) components))
559             (mcap          (and capcomp (car ((dis 'component-exports) sys (cid capcomp)))))
560               
561             (i-eqs+params
562              (filter-map
563                     (lambda (gate-complex) 
564                       
565                       (let* ((label             (first gate-complex))
566                              (n                 (second gate-complex))
567                              (subcomps          ((dis 'component-subcomps) sys n))
568                              (acc               (lookup-def 'accumulating-substance subcomps))
569                              (perm              (lookup-def 'permeating-ion subcomps))
570                              (permqs            (and perm ((dis 'component-exports) sys (cid perm))))
571                              (pore              (lookup-def 'pore subcomps))
572                              (permeability      (lookup-def 'permeability subcomps))
573                              (gate              (lookup-def 'gate subcomps))
574                              (sts               (and gate ((dis 'component-exports) sys (cid gate)))))
575                         
576                         (if (not (or pore permeability))
577                             (nemo:error 'nemo:python-translator ": ion channel definition " label
578                                         "lacks any pore or permeability components"))
579
580
581                         (cond ((and perm permeability gate)
582                                     (let* ((i     (python-name (s+ 'i (cn perm))))
583                                            (pmax  (cadr ((dis 'component-exports) sys (cid permeability))))
584                                            (pwrs  (map (lambda (n) (reaction-power sys n)) sts))
585                                            (sptms (map (lambda (st pwr) `(pow ,st ,pwr)) sts pwrs))
586                                            (gion  `(* ,pmax ,@sptms)))
587                                         (list i #f gion (python-name (s+ 'i_ label) )
588                                               `((label . ,label) 
589                                                 (maximal-permeability . ,pmax) ))))
590
591                               ((and perm pore gate)
592                                (case (cn perm)
593                                  ((non-specific)
594                                   (let* ((i     (python-name 'i))
595                                          (e     (car permqs))
596                                          (gmax  (car ((dis 'component-exports) sys (cid pore))))
597                                          (pwrs  (map (lambda (n) (reaction-power sys n)) sts))
598                                          (sptms (map (lambda (st pwr) `(pow ,st ,pwr)) sts pwrs))
599                                          (gion  `(* ,gmax ,@sptms)))
600                                     (list i e gion  (python-name (s+ 'i_ label))
601                                           `((label . ,label)
602                                             (maximal-conductance . ,gmax)
603                                             (reversal-potential . ,e))
604                                           )))
605
606                                  (else
607                                   (let* ((i     (python-name (s+ 'i (cn perm))))
608                                          (e     (car permqs))
609                                          (gmax  (car ((dis 'component-exports) sys (cid pore))))
610                                          (pwrs  (map (lambda (n) (reaction-power sys n)) sts))
611                                          (sptms (map (lambda (st pwr) `(pow ,st ,pwr)) sts pwrs))
612                                          (gion  `(* ,gmax ,@sptms)))
613                                     (list i e gion (python-name (s+ 'i_ label))
614                                           `((label . ,label)
615                                             (maximal-conductance . ,gmax)
616                                             (reversal-potential . ,e))
617                                           )))))
618                               
619                               ((and perm pore)
620                                (case (cn perm)
621                                  ((non-specific)
622                                   (let* ((i     (python-name 'i))
623                                          (e     (car permqs))
624                                          (gmax  (car ((dis 'component-exports) sys (cid pore)))))
625                                     (list i e gmax (python-name (s+ 'i_ label))
626                                           `((label . ,label)
627                                             (maximal-conductance . ,gmax)
628                                             (reversal-potential . ,e))
629                                           )))
630                                  (else
631                                   (nemo:error 'nemo:python-translator ": invalid ion channel definition " label))))
632                               
633                               ((and acc pore gate)
634                                (let* ((i     (python-name (s+ 'i (cn acc))))
635                                       (gmax  (car ((dis 'component-exports) sys (cid pore))))
636                                       (pwrs  (map (lambda (n) (reaction-power sys n)) sts))
637                                       (sptms (map (lambda (st pwr) `(pow ,st ,pwr)) sts pwrs))
638                                       (gion  `(* ,gmax ,@sptms)))
639                                  (list i #f gion  (python-name (s+ 'i_ label))
640                                           `((label . ,label)
641                                             (maximal-conductance . ,gmax)))
642                                        ))
643                               (else (nemo:error 'nemo:python-translator ": invalid ion channel definition " label))
644                               )))
645                     gate-complexes))
646
647             (i-params (map (lambda (i-eq) (cons (car i-eq) (cadr (cdddr i-eq)))) i-eqs+params))
648             (i-eqs    (map (lambda (i-eq) (take i-eq 4)) i-eqs+params))
649
650             (i-names (delete-duplicates (map first i-eqs)))
651               
652             (i-eqs  (fold  (lambda (i-gate ax) 
653                              (let ((i-gate-var (first i-gate)))
654                                (cons (list (python-name 'i) #f i-gate-var (s+ 'i_ (second i-gate))) ax)))
655                            i-eqs i-gates))
656
657             (i-bkts (bucket-partition (lambda (x y) (eq? (car x) (car y))) i-eqs))
658             
659             (i-eqs  (fold (lambda (b ax) 
660                             (match b 
661                                    ((and ps ((i e gion ii) . rst)) 
662                                     (let loop ((ps ps) (summands (list)) (eqs (list)))
663                                       (if (null? ps)
664                                           
665                                           (let* ((sum0  (sum summands))
666                                                  (sum1  (rhsexpr/python sum0))
667                                                  (sum2  (canonicalize-expr/python sum1)))
668                                             (append eqs (list (list i sum2)) ax))
669                                           
670                                           (match-let (((i e gion ii) (car ps)))
671                                                      (loop (cdr ps) 
672                                                            (cons ii summands) 
673                                                            (let* ((expr0 (rhsexpr/python (if e `(* ,gion (- v ,e)) gion)))
674                                                                   (expr1 (canonicalize-expr/python expr0)))
675                                                              (cons (list ii expr1) eqs)))))))
676                                   
677                                    ((i e gion ii)
678                                     (let* ((expr0  (rhsexpr/python (if e `(* ,gion (- v ,e)) gion)))
679                                            (expr1  (canonicalize-expr/python expr0)))
680                                       (cons (list i expr1) ax)))
681                                   
682                                    (else ax)))
683                           (list) i-bkts))
684
685             (asgn-eq-defs     (poset->asgn-eq-defs poset sys))
686             
687             (rate-eq-defs       (reverse (poset->rate-eq-defs poset sys)))
688             
689             (reaction-eq-defs   (poset->reaction-eq-defs poset sys))
690
691             (init-eq-defs       (poset->init-defs poset sys))
692             
693             (conserve-eq-defs   (map (lambda (eq) (list 0 `(- ,(second eq) ,(first eq)))) 
694                                      (poset->state-conserve-eq-defs poset sys)))
695             
696             (v-eq    (if mcap 
697                          (list 'v (rhsexpr/python `(/ (neg ,(sum i-names)) ,mcap)))
698                          (list 'v 0.0)))
699             
700             (dfenv 
701              (map (lambda (x) (let ((n (first x)))
702                                 (list n (python-name (s+ "d_" n )))))
703                   defuns))
704
705             )
706       
707        (for-each
708         (lambda (a)
709           (let ((acc-ion   (car a)))
710             (if (assoc acc-ion perm-ions)
711                 (nemo:error 'nemo:python-translator 
712                             ": ion species " acc-ion " cannot be declared as both accumulating and permeating"))))
713         acc-ions)
714
715        (for-each
716         (lambda (p)
717           (let ((pool-ion  (car p)))
718             (if (assoc pool-ion perm-ions)
719                 (nemo:error 'nemo:python-translator 
720                             ": ion species " pool-ion " cannot be declared as both pool and permeating"))))
721         pool-ions)
722       
723        (let ((output 
724               (case mode
725                 ((single)  (open-output-file filename #:append))
726                 (else #f))))
727         
728             (let ((output1 (or output (open-output-file (s+ prefix "_params.py")))))
729
730               (with-output-to-port output1
731                 (lambda ()
732                   (output-pyparams sysname i-params i-eqs const-defs asgn-eq-defs init-eq-defs pool-ions perm-ions indent indent+)
733                   (pp indent ,nl)))
734
735               (if (not output) (close-output-port output1)))
736
737           (if output (close-output-port output)))
738
739           )))))
740
741
742(define (nemo:pyparams-translator syss . rest)
743  (let-optionals rest ((filename #f))
744    (close-output-port (open-output-file filename))
745    (for-each
746     (lambda (sys)
747       (apply pyparams-translator1 (cons sys (cons 'single rest))))
748     syss)))
749
750
751)
Note: See TracBrowser for help on using the repository browser.