source: project/release/4/nemo/trunk/nemo-gate-complex.scm @ 27145

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

nemo: added support for modulating ions in nmodl backend

File size: 6.5 KB
Line 
1;;       
2;;
3;; Procedures for querying ion channel descriptions in 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-gate-complex
22
23 (nemo:ion-pool-query
24  nemo:gate-complex-query)
25
26 (import scheme chicken srfi-1 srfi-13 srfi-69)
27
28 (require-extension matchable nemo-core nemo-utils)
29
30(define (cid x)  (second x))
31(define (cn x)   (first x))
32
33
34(define (ispool? x)
35  (match x (('decaying-pool name id) id) (('decaying 'pool name id) id) 
36         (else #f)))
37
38(define (nemo:ion-pool-query sys)
39   (match-let ((($ nemo:quantity 'DISPATCH  dis) (hash-table-ref sys (nemo-intern 'dispatch))))
40     (let recur ((comp-name (nemo-intern 'toplevel)) (ax (list)))
41       (let ((subcomps  ((dis 'component-subcomps)  sys comp-name)))
42         (let-values (((epool-comps other-comps)  (partition ispool? subcomps)))
43                     (let ((epools (map (lambda (x) 
44                                          (let ((exports ((dis 'component-exports) sys (third x))))
45                                            (if (null? exports)
46                                                (nemo:error 'nemo:epool-query 
47                                                            ": ion pool component " (third x)
48                                                            " must export a state"))
49                                            `(,@(cdr x) . ,(reverse exports))))
50                                           epool-comps)))
51                       (fold recur (append epools ax) (map third other-comps))))))))
52
53(define (nemo:gate-complex-query sys . rest)
54  (let-optionals rest ((ionic-current-name     (lambda (ion-name) (s+ 'i ion-name)))
55                       (rev-potential-name     (lambda (ion-name) (s+ 'e ion-name )))
56                       (in-concentration-name  (lambda (ion-name) (s+ ion-name 'i)))
57                       (out-concentration-name (lambda (ion-name) (s+ ion-name 'o))))
58
59  (match-let ((($ nemo:quantity 'DISPATCH  dis) (hash-table-ref sys (nemo-intern 'dispatch))))
60    (let ((imports  ((dis 'imports)  sys))
61          (exports  ((dis 'exports)  sys)))
62      (let* ((consts      ((dis 'consts)  sys))
63             (asgns       ((dis 'asgns)   sys))
64             (states      ((dis 'states)  sys))
65             (reactions   ((dis 'reactions) sys))
66             (rates       ((dis 'rates) sys))
67             (defuns      ((dis 'defuns)  sys))
68             (components  ((dis 'components) sys))
69             (gate-complexes     (filter-map (match-lambda 
70                                                 ((name 'gate-complex id) (list name id)) 
71                                                 ((name 'ionic-current id) (list name id)) 
72                                                 (else #f)) 
73                                             components))
74             (ion-pools   (nemo:ion-pool-query sys))
75
76             (perm-ions         (fold (lambda (gate-complex ax) 
77                                        (let* ((subcomps ((dis 'component-subcomps) sys (cid gate-complex)))
78                                               (perm      (lookup-def 'permeating-ion subcomps)))
79                                          (cond (perm 
80                                                 (case (cn perm)
81                                                   ((non-specific)   
82                                                    (let* ((erev (car ((dis 'component-exports) sys (cid perm))))
83                                                           (i 'i) (e 'e))
84                                                      (cons `(,(cn perm) ,i ,e ,erev) ax)))
85                                                   (else (let* ((erev ((lambda (x) (and (pair? x) (car x))) ((dis 'component-exports) sys (cid perm))))
86                                                                (i    (ionic-current-name (cn perm)))
87                                                                (e    (rev-potential-name (cn perm))))
88                                                           (cons `(,(cn perm) ,i ,e ,erev) ax)))))
89                                                (else ax))))
90                                      (list) gate-complexes))
91             
92             (perm-ions         (fold (lambda (gate-complex ax) 
93                                        (let* ((subcomps ((dis 'component-subcomps) sys (cid gate-complex)))
94                                               (bingate   (lookup-def 'binary-gate subcomps)))
95                                          (cond
96                                                (bingate 
97                                                 (cons `(non-specific i e #f) ax))
98                                                (else ax))))
99                                      perm-ions gate-complexes))
100             
101             (acc-ions           (fold (lambda (gate-complex ax) 
102                                         (let* ((subcomps ((dis 'component-subcomps) sys (cid gate-complex)))
103                                                (acc   (lookup-def 'accumulating-substance subcomps))
104                                                (i     (and acc (ionic-current-name (cn acc))))
105                                                (in    (and acc (in-concentration-name (cn acc))))
106                                                (out   (and acc (out-concentration-name (cn acc)))))
107                                           (if acc  (cons `(,(cn acc) ,i ,in ,out) ax) ax)))
108                                       (list) gate-complexes))
109
110             (pool-ions          (map (lambda (ep)
111                                        (let* ((ion     (first ep))
112                                               (state   (third ep))
113                                               (valence (and (> (length ep) 3) (fourth ep)))
114                                               (i       (ionic-current-name ion))
115                                               (in      (in-concentration-name ion)))
116                                          `(,state ,i ,in ,ion ,valence)))
117                                      ion-pools))
118
119             (mod-ions         (fold (lambda (gate-complex ax) 
120                                        (let* ((subcomps ((dis 'component-subcomps) sys (cid gate-complex)))
121                                               (modcomp   (lookup-def 'modulating-ion subcomps)))
122                                          (cond
123                                                (modcomp 
124                                                 (let ((ion (cn modcomp)))
125                                                   (cons `(,ion ,(in-concentration-name ion)) ax)))
126                                                (else ax))))
127                                      '() gate-complexes))
128
129             (i-gates           (fold (lambda (gate-complex ax) 
130                                        (let* ((subcomps     ((dis 'component-subcomps) sys (cid gate-complex)))
131                                               (i-gate-comp  (lookup-def 'binary-gate subcomps)))
132                                          (if i-gate-comp
133                                              (let* ((i-gate-exps  ((dis 'component-exports) sys (cid i-gate-comp)))
134                                                     (asgn-names   asgns)
135                                                     (i-gate-var   (find (lambda (x) (member x asgn-names)) 
136                                                                         i-gate-exps)))
137                                                (if (not i-gate-var)
138                                                    (nemo:error 'nemo:gate-complex-query 
139                                                                ": binary gate in gate complex " (cn gate-complex)
140                                                                " must export an assignment"))
141                                                (cons (list i-gate-var (cn i-gate-comp) ) ax))
142                                              ax)))
143                                      (list) gate-complexes)))
144
145           (for-each
146            (lambda (a)
147              (let ((acc-ion   (car a)))
148                (if (assoc acc-ion perm-ions)
149                    (nemo:error 'nemo:gate-complex-query 
150                                ": ion species " acc-ion " cannot be declared as both accumulating and permeating"))))
151            acc-ions)
152
153           (for-each
154            (lambda (p)
155              (let ((pool-ion  (car p)))
156                (if (assoc pool-ion perm-ions)
157                    (nemo:error 'nemo:gate-complex-query 
158                                ": ion species " pool-ion " cannot be declared as both pool and permeating"))))
159            pool-ions)
160       
161        `((gate-complexes ,gate-complexes)
162          (perm-ions    ,perm-ions)
163          (acc-ions     ,acc-ions)
164          (mod-ions     ,mod-ions)
165          (pool-ions    ,pool-ions)
166          (i-gates      ,i-gates)
167          ))))))
168         
169)
Note: See TracBrowser for help on using the repository browser.