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

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

nemo: updated copyright year

File size: 24.7 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)
26       
27        (require-extension lolevel matchable strictly-pretty environments
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      fpvector-ref))
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 (environment-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 (environment-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 (environment-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 (environment-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 (environment-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 (environment-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      (for-each (lambda (x)
473                  (pp indent ,(expr->string/python (cadr x) (python-name (car x)))))
474                const-defs)
475
476      (pp indent ,nl)
477
478      (let recur ((i-params i-params) 
479                  (property-tuples '() ))
480
481        (if (null? i-params)
482           
483            (for-each (lambda (t)
484                        (pp indent (,(car t) = ,(doc->string (format-tuple/python indent+ (cdr t))))))
485                      property-tuples)
486
487            (let ((paramset (car i-params)))
488              (let ((alst (cdr paramset)))
489                (let ((label (lookup-def 'label alst))
490                      (maximal-permeability (lookup-def 'maximal-permeability alst))
491                      (maximal-conductance  (lookup-def 'maximal-conductance alst))
492                      (reversal-potential   (lookup-def 'reversal-potential alst)))
493                  (recur (cdr i-params)
494                         (let* ((property-tuples1 
495                                 (fold (lambda (l x ax)
496                                         (or (and x (cons `(,l ,(symbol->string (python-name x)) 
497                                                               ,(s+ "'" (nmodl-name x) "'")) ax))
498                                             ax))
499                                       property-tuples
500                                       (list (s+ label "_MAXIMAL_PERMEABILITY")
501                                             (s+ label "_MAXIMAL_CONDUCTANCE")
502                                             (s+ label "_REVERSAL_POTENTIAL"))
503                                       (list maximal-permeability
504                                             maximal-conductance 
505                                             reversal-potential)
506                                       )))
507                           property-tuples1))
508                  )))
509            ))
510
511    ))
512
513(define (pyparams-translator1 sys . rest)
514  (define (cid x)  (second x))
515  (define (cn x)   (first x))
516  (let-optionals rest ((mode 'multiple) (filename #f))
517  (match-let ((($ nemo:quantity 'DISPATCH  dis) (environment-ref sys (nemo-intern 'dispatch))))
518    (let ((imports  ((dis 'imports)  sys))
519          (exports  ((dis 'exports)  sys)))
520      (let* ((indent      0)
521             (indent+     (+ 2 indent ))
522             (eval-const  (dis 'eval-const))
523             (sysname     (python-name ((dis 'sysname) sys)))
524             (prefix      sysname)
525             (filename    (or filename (s+ sysname ".py")))
526             (deps*       ((dis 'depgraph*) sys))
527             (consts      ((dis 'consts)  sys))
528             (asgns       ((dis 'asgns)   sys))
529             (states      ((dis 'states)  sys))
530             (reactions   ((dis 'reactions) sys))
531             (defuns      ((dis 'defuns)  sys))
532             (components  ((dis 'components) sys))
533             
534             (g             (match-let (((state-list asgn-list g) ((dis 'depgraph*) sys))) g))
535             (poset         (vector->list ((dis 'depgraph->bfs-dist-poset) g)))
536
537             (const-defs       (filter-map
538                                (lambda (nv)
539                                  (and (not (member (first nv) python-builtin-consts))
540                                       (let ((v1 (canonicalize-expr/python (second nv))))
541                                         (list (python-name (first nv)) v1))))
542                                consts))
543             
544             (gate-complex-info    (nemo:gate-complex-query sys))
545
546             (gate-complexes       (lookup-def 'gate-complexes gate-complex-info))
547             (perm-ions     (map (match-lambda ((comp i e erev) `(,comp ,(python-name i) ,(python-name e) ,erev)))
548                                 (lookup-def 'perm-ions gate-complex-info)))
549             (acc-ions      (map (match-lambda ((comp i in out) `(,comp ,@(map python-name (list i in out)))))
550                                 (lookup-def 'acc-ions gate-complex-info)))
551             (epools        (lookup-def 'pool-ions gate-complex-info))
552             (pool-ions     (map (lambda (lst) (map python-name lst)) epools))
553
554             (i-gates       (lookup-def 'i-gates gate-complex-info))
555
556             (capcomp       (any (match-lambda ((name 'membrane-capacitance id) (list name id)) (else #f)) components))
557             (mcap          (and capcomp (car ((dis 'component-exports) sys (cid capcomp)))))
558               
559             (i-eqs+params
560              (filter-map
561                     (lambda (gate-complex) 
562                       
563                       (let* ((label             (first gate-complex))
564                              (n                 (second gate-complex))
565                              (subcomps          ((dis 'component-subcomps) sys n))
566                              (acc               (lookup-def 'accumulating-substance subcomps))
567                              (perm              (lookup-def 'permeating-ion subcomps))
568                              (permqs            (and perm ((dis 'component-exports) sys (cid perm))))
569                              (pore              (lookup-def 'pore subcomps))
570                              (permeability      (lookup-def 'permeability subcomps))
571                              (gate              (lookup-def 'gate subcomps))
572                              (sts               (and gate ((dis 'component-exports) sys (cid gate)))))
573                         
574                         (if (not (or pore permeability))
575                             (nemo:error 'nemo:python-translator ": ion channel definition " label
576                                         "lacks any pore or permeability components"))
577
578
579                         (cond ((and perm permeability gate)
580                                     (let* ((i     (python-name (s+ 'i (cn perm))))
581                                            (pmax  (cadr ((dis 'component-exports) sys (cid permeability))))
582                                            (pwrs  (map (lambda (n) (reaction-power sys n)) sts))
583                                            (sptms (map (lambda (st pwr) `(pow ,st ,pwr)) sts pwrs))
584                                            (gion  `(* ,pmax ,@sptms)))
585                                         (list i #f gion (python-name (s+ 'i_ label) )
586                                               `((label . ,label) 
587                                                 (maximal-permeability . ,pmax) ))))
588
589                               ((and perm pore gate)
590                                (case (cn perm)
591                                  ((non-specific)
592                                   (let* ((i     (python-name 'i))
593                                          (e     (car permqs))
594                                          (gmax  (car ((dis 'component-exports) sys (cid pore))))
595                                          (pwrs  (map (lambda (n) (reaction-power sys n)) sts))
596                                          (sptms (map (lambda (st pwr) `(pow ,st ,pwr)) sts pwrs))
597                                          (gion  `(* ,gmax ,@sptms)))
598                                     (list i e gion  (python-name (s+ 'i_ label))
599                                           `((label . ,label)
600                                             (maximal-conductance . ,gmax)
601                                             (reversal-potential . ,e))
602                                           )))
603
604                                  (else
605                                   (let* ((i     (python-name (s+ 'i (cn perm))))
606                                          (e     (car permqs))
607                                          (gmax  (car ((dis 'component-exports) sys (cid pore))))
608                                          (pwrs  (map (lambda (n) (reaction-power sys n)) sts))
609                                          (sptms (map (lambda (st pwr) `(pow ,st ,pwr)) sts pwrs))
610                                          (gion  `(* ,gmax ,@sptms)))
611                                     (list i e gion (python-name (s+ 'i_ label))
612                                           `((label . ,label)
613                                             (maximal-conductance . ,gmax)
614                                             (reversal-potential . ,e))
615                                           )))))
616                               
617                               ((and perm pore)
618                                (case (cn perm)
619                                  ((non-specific)
620                                   (let* ((i     (python-name 'i))
621                                          (e     (car permqs))
622                                          (gmax  (car ((dis 'component-exports) sys (cid pore)))))
623                                     (list i e gmax (python-name (s+ 'i_ label))
624                                           `((label . ,label)
625                                             (maximal-conductance . ,gmax)
626                                             (reversal-potential . ,e))
627                                           )))
628                                  (else
629                                   (nemo:error 'nemo:python-translator ": invalid ion channel definition " label))))
630                               
631                               ((and acc pore gate)
632                                (let* ((i     (python-name (s+ 'i (cn acc))))
633                                       (gmax  (car ((dis 'component-exports) sys (cid pore))))
634                                       (pwrs  (map (lambda (n) (reaction-power sys n)) sts))
635                                       (sptms (map (lambda (st pwr) `(pow ,st ,pwr)) sts pwrs))
636                                       (gion  `(* ,gmax ,@sptms)))
637                                  (list i #f gion  (python-name (s+ 'i_ label))
638                                           `((label . ,label)
639                                             (maximal-conductance . ,gmax)))
640                                        ))
641                               (else (nemo:error 'nemo:python-translator ": invalid ion channel definition " label))
642                               )))
643                     gate-complexes))
644
645             (i-params (map (lambda (i-eq) (cons (car i-eq) (cadr (cdddr i-eq)))) i-eqs+params))
646             (i-eqs    (map (lambda (i-eq) (take i-eq 4)) i-eqs+params))
647
648             (i-names (delete-duplicates (map first i-eqs)))
649               
650             (i-eqs  (fold  (lambda (i-gate ax) 
651                              (let ((i-gate-var (first i-gate)))
652                                (cons (list (python-name 'i) #f i-gate-var (s+ 'i_ (second i-gate))) ax)))
653                            i-eqs i-gates))
654
655             (i-bkts (bucket-partition (lambda (x y) (eq? (car x) (car y))) i-eqs))
656             
657             (i-eqs  (fold (lambda (b ax) 
658                             (match b 
659                                    ((and ps ((i e gion ii) . rst)) 
660                                     (let loop ((ps ps) (summands (list)) (eqs (list)))
661                                       (if (null? ps)
662                                           
663                                           (let* ((sum0  (sum summands))
664                                                  (sum1  (rhsexpr/python sum0))
665                                                  (sum2  (canonicalize-expr/python sum1)))
666                                             (append eqs (list (list i sum2)) ax))
667                                           
668                                           (match-let (((i e gion ii) (car ps)))
669                                                      (loop (cdr ps) 
670                                                            (cons ii summands) 
671                                                            (let* ((expr0 (rhsexpr/python (if e `(* ,gion (- v ,e)) gion)))
672                                                                   (expr1 (canonicalize-expr/python expr0)))
673                                                              (cons (list ii expr1) eqs)))))))
674                                   
675                                    ((i e gion ii)
676                                     (let* ((expr0  (rhsexpr/python (if e `(* ,gion (- v ,e)) gion)))
677                                            (expr1  (canonicalize-expr/python expr0)))
678                                       (cons (list i expr1) ax)))
679                                   
680                                    (else ax)))
681                           (list) i-bkts))
682
683             (asgn-eq-defs     (poset->asgn-eq-defs poset sys))
684             
685             (rate-eq-defs       (reverse (poset->rate-eq-defs poset sys)))
686             
687             (reaction-eq-defs   (poset->reaction-eq-defs poset sys))
688
689             (init-eq-defs       (poset->init-defs poset sys))
690             
691             (conserve-eq-defs   (map (lambda (eq) (list 0 `(- ,(second eq) ,(first eq)))) 
692                                      (poset->state-conserve-eq-defs poset sys)))
693             
694             (v-eq    (if mcap 
695                          (list 'v (rhsexpr/python `(/ (neg ,(sum i-names)) ,mcap)))
696                          (list 'v 0.0)))
697             
698             (dfenv 
699              (map (lambda (x) (let ((n (first x)))
700                                 (list n (python-name (s+ "d_" n )))))
701                   defuns))
702
703             )
704       
705        (for-each
706         (lambda (a)
707           (let ((acc-ion   (car a)))
708             (if (assoc acc-ion perm-ions)
709                 (nemo:error 'nemo:python-translator 
710                             ": ion species " acc-ion " cannot be declared as both accumulating and permeating"))))
711         acc-ions)
712
713        (for-each
714         (lambda (p)
715           (let ((pool-ion  (car p)))
716             (if (assoc pool-ion perm-ions)
717                 (nemo:error 'nemo:python-translator 
718                             ": ion species " pool-ion " cannot be declared as both pool and permeating"))))
719         pool-ions)
720       
721        (let ((output 
722               (case mode
723                 ((single)  (open-output-file filename #:append))
724                 (else #f))))
725         
726             (let ((output1 (or output (open-output-file (s+ prefix "_params.py")))))
727
728               (with-output-to-port output1
729                 (lambda ()
730                   (output-pyparams sysname i-params i-eqs const-defs asgn-eq-defs init-eq-defs pool-ions perm-ions indent indent+)
731                   (pp indent ,nl)))
732
733               (if (not output) (close-output-port output1)))
734
735           (if output (close-output-port output)))
736
737           )))))
738
739
740(define (nemo:pyparams-translator syss . rest)
741  (let-optionals rest ((filename #f))
742    (close-output-port (open-output-file filename))
743    (for-each
744     (lambda (sys)
745       (apply pyparams-translator1 (cons sys (cons 'single rest))))
746     syss)))
747
748
749)
Note: See TracBrowser for help on using the repository browser.