Changeset 29296 in project


Ignore:
Timestamp:
07/02/13 05:15:45 (8 years ago)
Author:
Ivan Raikov
Message:

nemo: support for overriding default units

Location:
release/4/nemo/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/4/nemo/trunk/nemo-nest.scm

    r29294 r29296  
    2727       
    2828        (require-extension lolevel posix matchable strictly-pretty
    29                            varsubst datatype nemo-core nemo-utils
     29                           varsubst datatype nemo-core nemo-utils nemo-units
    3030                           nemo-geometry nemo-defaults nemo-constraints
    3131                           nemo-gate-complex nemo-synapse nemo-currents
     
    17681768(define (output-accessors+modifiers
    17691769         sysname imports state-index-map const-defs asgn-eq-defs rate-eq-defs
    1770          reaction-eq-defs i-eqs pool-ions perm-ions
     1770         reaction-eq-defs i-eqs pool-ions perm-ions constraints
    17711771         indent indent+)
    17721772
    1773   (pp indent ,nl (,(sprintf "void ~A::Parameters_::get (DictionaryDatum &d) const" sysname) ))
    1774   (pp indent  #\{)
    1775 
    1776   (for-each
    1777    (lambda (def)
    1778      (let ((n (first def)))
    1779        (pp indent+ (,(sprintf "def<double_t>(d, ~S, ~A);" (->string n) n)))))
    1780    const-defs)
    1781 
    1782   (pp indent  #\})
    1783 
    1784   (pp indent ,nl (,(sprintf "void ~A::Parameters_::set (const DictionaryDatum &d)" sysname) ))
    1785   (pp indent  #\{)
    1786 
    1787   (for-each
    1788    (lambda (def)
    1789      (let ((n (first def)))
    1790        (pp indent+ (,(sprintf "updateValue<double_t>(d, ~S, ~A);" (->string n) n)))))
    1791    const-defs)
    1792 
    1793   (pp indent  #\})
    1794 
    1795   (pp indent ,nl (,(sprintf "void ~A::State_::get (DictionaryDatum &d) const" sysname) ))
    1796   (pp indent  #\{)
    1797 
    1798   (for-each
    1799    (lambda (def)
    1800      (let ((n (first def)) (i (second def)))
    1801        (pp indent+ (,(sprintf "def<double_t>(d, ~S, y_[~A]);" (->string n) i)))))
    1802    state-index-map)
    1803 
    1804   (let ((vi (lookup-def 'v state-index-map)))
    1805     (if vi
    1806         (pp indent+ (,(sprintf "def<double_t>(d, names::V_m, y_[~A]);"  vi) ))
    1807         ))
    1808 
    1809   (pp indent  #\})
    1810 
    1811   (pp indent ,nl (,(sprintf "void ~A::State_::set (const DictionaryDatum &d, const Parameters_&)" sysname) ))
    1812   (pp indent  #\{)
    1813 
    1814   (for-each
    1815    (lambda (def)
    1816      (let ((n (first def)) (i (second def)))
    1817        (pp indent+ (,(sprintf "updateValue<double_t>(d, ~S, y_[~A]);" (->string n) i)))))
    1818    state-index-map)
    1819 
    1820   (let ((vi (lookup-def 'v state-index-map)))
    1821     (if vi
    1822         (pp indent+ (,(sprintf "updateValue<double_t>(d, names::V_m, y_[~A]);"  vi) ))
    1823         ))
    1824 
    1825   (pp indent  #\})
    1826 
    1827 )
     1773  (let ((c-eqs (lookup-def 'c-eqs constraints))
     1774       
     1775        (c-units (map (lambda (x) (let ((n (first x)) (v (second x)))
     1776                                     (list (nest-name n) v)))
     1777                      (lookup-def 'c-units constraints)))
     1778        )
     1779
     1780    (pp indent ,nl (,(sprintf "void ~A::Parameters_::get (DictionaryDatum &d) const" sysname) ))
     1781    (pp indent  #\{)
     1782   
     1783    (for-each
     1784     (lambda (def)
     1785       (let ((n (first def)))
     1786         (pp indent+ (,(sprintf "def<double_t>(d, ~S, ~A);" (->string n) n)))))
     1787     const-defs)
     1788   
     1789    (pp indent  #\})
     1790   
     1791    (pp indent ,nl (,(sprintf "void ~A::Parameters_::set (const DictionaryDatum &d)" sysname) ))
     1792    (pp indent  #\{)
     1793   
     1794    (for-each
     1795     (lambda (def)
     1796       (let* ((n (first def))
     1797              (nu (lookup-def n c-units))
     1798              (scale (and nu (nemo:unit-scale nu)))
     1799              )
     1800         (pp indent+ (,(sprintf "updateValue<double_t>(d, ~S, ~A);" (->string n) n)))
     1801         (if scale (pp indent+ (,(sprintf "~A = ~A * ~A;" n scale n ))))
     1802         ))
     1803     const-defs)
     1804   
     1805    (pp indent  #\})
     1806   
     1807    (pp indent ,nl (,(sprintf "void ~A::State_::get (DictionaryDatum &d) const" sysname) ))
     1808    (pp indent  #\{)
     1809   
     1810    (for-each
     1811     (lambda (def)
     1812       (let* ((n     (first def)) (i (second def))
     1813              (nu    (lookup-def n c-units))
     1814              (scale (and nu (nemo:unit-scale nu)))
     1815             )
     1816         (pp indent+ (,(sprintf "def<double_t>(d, ~S, y_[~A]);" (->string n) i)))
     1817         (if scale (pp indent+ (,(sprintf "y_[~A] = ~A * y_[~A];" i scale i ))))
     1818         ))
     1819     state-index-map)
     1820   
     1821    (let ((vi (lookup-def 'v state-index-map)))
     1822      (if vi
     1823          (pp indent+ (,(sprintf "def<double_t>(d, names::V_m, y_[~A]);"  vi) ))
     1824          ))
     1825   
     1826    (pp indent  #\})
     1827   
     1828    (pp indent ,nl (,(sprintf "void ~A::State_::set (const DictionaryDatum &d, const Parameters_&)" sysname) ))
     1829    (pp indent  #\{)
     1830   
     1831    (for-each
     1832     (lambda (def)
     1833       (let ((n (first def)) (i (second def)))
     1834         (pp indent+ (,(sprintf "updateValue<double_t>(d, ~S, y_[~A]);" (->string n) i)))))
     1835     state-index-map)
     1836   
     1837    (let ((vi (lookup-def 'v state-index-map)))
     1838      (if vi
     1839          (pp indent+ (,(sprintf "updateValue<double_t>(d, names::V_m, y_[~A]);"  vi) ))
     1840          ))
     1841   
     1842    (pp indent  #\})
     1843   
     1844    ))
    18281845
    18291846
     
    19171934    (for-each
    19181935     (lambda (x)
    1919        (let* ((n  (first x))
    1920               (n1 (nest-name n))
    1921               (nu (lookup-def n c-units)))
    1922          (pp indent+ ,(expr->string/C++ (sprintf "p.~A" n1) n1))))
     1936       (let* ((n  (first x)))
     1937         (pp indent+ ,(expr->string/C++ (sprintf "p.~A" n) n))))
    19231938     const-defs)
    19241939
     
    25202535               const-defs asgn-eq-defs rate-eq-defs
    25212536               reaction-eq-defs i-eqs pool-ions perm-ions
     2537               constraints
    25222538               indent indent+)
    25232539              (pp indent ,nl)
  • release/4/nemo/trunk/nemo-units.scm

    r29294 r29296  
    2424  nemo:basic-units
    2525  nemo:unit?
     26  nemo:default-units
     27  nemo:quantity-name
     28  nemo:quantity-int
     29  nemo:unit-dims
     30  nemo:unit-scale
    2631  )
    2732
    28  (import scheme chicken (only srfi-1 zip))
     33
     34 (import scheme chicken (only srfi-1 zip) srfi-69 data-structures)
    2935 
    3036 (require-extension unitconv)
     
    3541(define-unit-prefix    milli volt    mV)
    3642(define-unit-prefix    milli amp     mA)
     43(define-unit-prefix    pico  amp     pA)
    3744(define-unit-prefix    nano  amp     nA)
     45(define-unit-prefix    micro amp     uA)
    3846(define-unit-prefix    micro siemens uS)
     47(define-unit-prefix    milli siemens mS)
    3948(define-unit-prefix    milli mole    mM)
    4049 
    4150(define-quantity   CurrentDensity        (/ Current Area))
    42 (define-quantity   CapacitanceArea       (/ Capacitance Area))
    43 (define-quantity   ConductanceArea       (/ Conductance Area))
     51(define-quantity   CapacitanceDensity    (/ Capacitance Area))
     52(define-quantity   ConductanceDensity    (/ Conductance Area))
    4453(define-quantity   Resistivity           (* Resistance Length))
    4554(define-quantity   ReactionRate1         (** Time -1))
     
    4958
    5059(define-unit milliamp-per-square-centimeter   CurrentDensity  (/ mA (* cm cm)) mA/cm2)
    51 (define-unit microfarad-per-square-centimeter CapacitanceArea (/ uF (* cm cm)) uf/cm2)
    52 (define-unit siemens-per-square-centimeter    ConductanceArea (/ S (* cm cm)) S/cm2)
     60(define-unit microfarad-per-square-centimeter CapacitanceDensity (/ uF (* cm cm)) uf/cm2)
     61(define-unit siemens-per-square-centimeter    ConductanceDensity (/ S (* cm cm)) S/cm2)
    5362(define-unit ohm.cm                           Resistivity     (* ohm cm) ohm.cm)
    5463
     
    6170(define nemo:basic-units
    6271  (zip
    63    `(ms mV mA/cm2 nA mM uf/cm2 um S/cm2 uS ohm.cm ohm degC /ms /mM-ms /mV /mV-ms)
    64    (list ms mV mA/cm2 nA mM uf/cm2 um S/cm2 uS ohm.cm ohm degC /ms /mM-ms /mV /mV-ms)))
     72   `(ms mV mA/cm2 pA nA uA mA mM uf/cm2 um S/cm2 uS mS ohm.cm ohm degC /ms /mM-ms /mV /mV-ms)
     73   (list ms mV mA/cm2 pA nA uA mA mM uf/cm2 um S/cm2 uS mS ohm.cm ohm degC /ms /mM-ms /mV /mV-ms)))
    6574     
    6675(define nemo:unitless unitless)
     
    6877(define nemo:unit? unit?)
    6978
     79(define nemo:default-units
     80  (make-parameter
     81   (map cons
     82        (list Time Potential CurrentDensity Current Substance
     83              CapacitanceDensity Length ConductanceDensity Conductance
     84              Resistivity Resistance Temperature ReactionRate1 ReactionRate2
     85              InversePotential InversePotentialTime)
     86        (list ms mV mA/cm2 nA mM
     87              uf/cm2 um S/cm2 uS
     88              ohm.cm ohm degC /ms /mM-ms
     89              /mV /mV-ms)
     90        ))
     91  )
     92
     93
     94(define nemo:quantity-name quantity-name)
     95(define nemo:quantity-int quantity-int)
     96(define nemo:unit-dims unit-dims)
     97
     98
     99(define (nemo:unit-scale u)
     100  (let* (
     101         (defu (alist-ref (unit-dims u) (nemo:default-units)
     102                          (lambda (x y)
     103                            (= (quantity-int x) (quantity-int y)))
     104                          ))
     105         )
     106    (and defu (unit-convert defu u))
     107    ))
     108
    70109)
  • release/4/nemo/trunk/nemo.scm

    r28861 r29296  
    2222
    2323
    24 (require-extension nemo-core nemo-macros nemo-hh nemo-vclamp nemo-iclamp nemo-utils)
     24(require-extension nemo-core nemo-macros nemo-hh nemo-vclamp nemo-iclamp
     25                   nemo-utils nemo-units)
    2526(require-library iexpr ersatz-lib)
    2627(require-extension datatype matchable lalr-driver
     
    134135    (hh-markov
    135136     "convert HH rate equations to Markov chain form")
     137
     138    (print-default-units
     139     "print default units used for target platform")
     140
     141    (default-units
     142     "set default units used for target platform"
     143     (value (required QUANTITY:UNIT)
     144            (transformer
     145             ,(lambda (x)
     146                (map (lambda (x)
     147                       (match-let (((dimstr unitstr) (string-split x ":")))
     148                                  (let ((dimsym (string->symbol dimstr))
     149                                        (unitsym (string->symbol unitstr)))
     150                                    (let* ((alldims (map (lambda (x)
     151                                                           (cons (nemo:quantity-name (car x)) (car x)))
     152                                                         (nemo:default-units)))
     153                                           (dim (lookup-def dimsym alldims))
     154                                           (u   (lookup-def unitsym nemo:basic-units)))
     155                                      (if (not (and u (= (nemo:quantity-int (nemo:unit-dims u)))
     156                                                    (nemo:quantity-int dim)))
     157                                          (error 'default-units "invalid unit for given quantity"
     158                                                 unitsym dimsym)
     159                                          (cons dim u))))
     160                                  ))
     161                          (string-split x ","))))
     162             )
     163            )
    136164
    137165    ,@(if nemo-nest?
     
    17881816        (exit 0)))
    17891817
     1818  (let ((v (opt 'default-units)))
     1819    (if v
     1820        (nemo:default-units (fold (lambda (x ax) (alist-update (car x) (cdr x) ax))
     1821                                  (nemo:default-units) v))
     1822        ))
     1823
     1824  (if (opt 'print-default-units)
     1825      (begin
     1826        (for-each (lambda (x)
     1827                    (printf "~A: ~A~%" (nemo:quantity-name (car x)) (cdr x)))
     1828                  (nemo:default-units))))
     1829     
    17901830  (if (null? operands)
    17911831
Note: See TracChangeset for help on using the changeset viewer.