Changeset 8001 in project


Ignore:
Timestamp:
01/31/08 05:58:57 (12 years ago)
Author:
Ivan Raikov
Message:

Bug fixes and changes to ode-hhsm and the solvers.

Location:
ode/trunk
Files:
8 edited

Legend:

Unmodified
Added
Removed
  • ode/trunk/abm4.scm

    r7961 r8001  
    9494  (define lowerror?  (ode-runtime 'lowerror?))
    9595
    96   (define printq  (ode-runtime 'print))
    97   (define eval-rhs  (ode-runtime 'eval-expr))
     96  (define printq    (ode-runtime 'print))
     97  (define eval-rhs  (ode-runtime 'eval-rhs))
    9898  (define is-state? (ode-runtime 'is-state?))
    9999  (define is-asgn?  (ode-runtime 'is-asgn?))
     
    127127                  (sym  (second xrec))
    128128                  (rhs  (third xrec)))
    129               (let ((v     (eval-rhs rhs))
     129              (let ((v     (eval-rhs sym rhs))
    130130                    (svec  (solve-env-ref sym)))
    131131                (cond ((is-state? sym)  (case df
     
    207207
    208208        (for-each (lambda (g)
    209                     (if (not (eval-rhs g))
     209                    (if (not (eval-rhs 'guard g))
    210210                        (numerror "guard failed: " g))) guards)
    211211
     
    378378
    379379          (for-each (lambda (g)
    380                       (if (not (eval-rhs g))
     380                      (if (not (eval-rhs 'guard g))
    381381                          (numerror "guard failed: " g))) guards)
    382382
  • ode/trunk/euler.scm

    r7961 r8001  
    3838
    3939  (define printq  (ode-runtime 'print))
    40   (define eval-rhs  (ode-runtime 'eval-expr))
     40  (define eval-rhs  (ode-runtime 'eval-rhs))
    4141  (define is-state? (ode-runtime 'is-state?))
    4242  (define is-asgn?  (ode-runtime 'is-asgn?))
     
    8282                  (sym  (second xrec))
    8383                  (rhs  (third xrec)))
    84             (let ((v     (eval-rhs rhs))
     84            (let ((v     (eval-rhs sym rhs))
    8585                  (svec  (solve-env-ref sym)))
    8686              (cond ((is-state? sym)  (begin
     
    113113
    114114      (for-each (lambda (g)
    115                   (if (not (eval-rhs g))
     115                  (if (not (eval-rhs 'guard g))
    116116                      (numerror "guard failed: " g))) guards)
    117117
  • ode/trunk/extensions/ode-hhs.scm

    r7357 r8001  
    3939(require-extension environments)
    4040
     41(define s+ string-append)
    4142
    42 
    43 (define (sstr s)
    44   (if (symbol? s) (symbol->string s) s))
    45  
    46 (define ($ p n) (string->symbol (string-append (sstr p) "_" (sstr n))))
     43(define ($ p n) (string->symbol (s+ (->string p) "_" (->string n))))
    4744
    4845
     
    9996                     (('ionic-conductance)  ('name ion) . alst))
    10097                 (check-decls ion '(gbar gamma delta minf taum) alst)
    101                  (let ((suffix (sstr ion)))
     98                 (let ((suffix (->string ion)))
    10299                   (let ((g        ($ "g" suffix))
    103100                         (gbar     ($ "gbar" suffix))
  • ode/trunk/extensions/ode-hhsm.scm

    r7940 r8001  
    3131(define c+  concatenate)
    3232
    33 (define (sstr s)
    34   (or (and (symbol? s) (symbol->string s)) s))
    35 
    36 (define ($ p n) (string->symbol (s+ (sstr p) "_" (sstr n))))
     33(define ($ p n) (string->symbol (s+ (->string p) "_" (->string n))))
    3734
    3835(define (lookup-car k lst . rest)
     
    9592        (msym  (msym suf)))
    9693  (let-optionals rest ((delta 0) (eps 0))
    97    (let ((suf (sstr suf))
     94   (let ((suf (->string suf))
    9895         (m (inexact->exact (+ 1 gamma)))
    9996         (h (inexact->exact (+ 1 delta)))
     
    170167
    171168    (let-optionals rest ((delta 0) (eps 0))
    172       (let ((suf (sstr suf))
     169      (let ((suf (->string suf))
    173170            (m (inexact->exact gamma))
    174171            (h (inexact->exact delta))
     
    195192(define (ion-transformer new-sys env-extend! eqdef! eval-const ion alst)
    196193  (check-decls ion '(gamma delta minf taum density area phi) alst)
    197   (let ((suffix (sstr ion)))
     194  (let ((suffix (->string ion)))
    198195    (let ((g        ($ "g" suffix))
    199196          (gamma    ($ "gamma" suffix))
     
    329326                 (('coupled-ionic-conductance)   ('name ion) . lst))
    330327
    331              (let* ((suffix (sstr ion))
     328             (let* ((suffix (->string ion))
     329                    (g      ($ "g" suffix))
    332330                    (chains
    333                     (filter-map
    334                      (lambda (x)
    335                        (match x (('species (species . alst))
    336                           (let ((ion-species ($ ion species)))
    337                             (cons ion-species (ion-transformer new-sys env-extend! eqdef! eval-const ion-species alst))))
    338                           (else #f)))
    339                      lst))
     331                     (filter-map
     332                      (lambda (x)
     333                        (match x (('species (species . alst))
     334                                  (let ((ion-species ($ ion species)))
     335                                    (cons ion-species
     336                                          (ion-transformer new-sys env-extend! eqdef! eval-const ion-species alst))))
     337                               (else #f)))
     338                      lst))
    340339                    (chain-names (map car chains))
    341340                    (coupling-factor (lookup-car 'coupling-factor lst))
     
    356355                                         " must be a numeric constant"))
    357356                          (let ((k     (min 100 (abs (round (* 100 prob-val)))))
    358                                 (inq   ($ "in" (sstr ion)))
    359                                 (outq  ($ "out" (sstr ion))))
     357                                (inq   ($ "in"  suffix))
     358                                (outq  ($ "out" suffix)))
    360359                               
    361360                            (randomize)
     
    368367                              (env-extend! inq  '(asgn)   'none in)
    369368                              (env-extend! outq '(asgn)   'none out)
     369                             
    370370                              (env-extend! (gensym 'rate) '(rate) (c+ chains1)))))))
    371371
     
    405405                     (else
    406406                      (ode:error 'ode:hhsm-transformer "coupled conductance declaration " ion
    407                                  " has neither coupling factor nor coupling scheme specified")))))
     407                                 " has neither coupling factor nor coupling scheme specified")))
     408               
     409               (let ((g-rhs   `(+ . ,(map (lambda (x) ($ "g" (car x))) chains))))
     410                 (env-extend! g '(asgn)   'none g-rhs))))
    408411           
    409412           
  • ode/trunk/ode-eggdoc.scm

    r7963 r8001  
    2727
    2828     (history
     29      (version "3.2" "Bug fix in the coupled chains code of ode-hhsm")
    2930      (version "3.1" "Changes to the solver interface for compatibility with other implementations of Scheme")
    3031      (version "3.0" "Added support for configurable single/double floating point format")
     
    389390                                                 "in the solve environment "))
    390391
    391               (describe "'eval-expr"  ("Evaluates the given expression in the evaluation environment "
    392                                        "for the current system."))
     392              (describe "'eval-rhs"  ("Evaluates the given expression in the evaluation environment "
     393                                      "for the current system."))
    393394
    394395              (describe "'relmax" "Returns the upper bound relative error for the current system. ")
  • ode/trunk/ode.scm

    r7955 r8001  
    838838                                 asgn-list)))
    839839
    840                         ((eval-expr)  eval-expr)
     840                        ((eval-rhs)  (lambda (n rhs) (eval-expr rhs)))
    841841
    842842                        ((hmax-factor)    hmax-factor)
  • ode/trunk/ode.setup

    r7963 r8001  
    2424
    2525  ; Assoc list with properties for your extension:
    26   `((version 3.1)
     26  `((version 3.2)
    2727    (documentation "ode.html")
    2828    ,@(if has-exports? `((exports "ode.exports")) (list)) ))
     
    5454
    5555  ; Assoc list with properties for your extension:
    56   `((version 3.1)
     56  `((version 3.2)
    5757    ,@(if has-exports? `((exports "ode-abm4.exports")) (list)) ))
    5858
     
    6868
    6969  ; Assoc list with properties for your extension:
    70   `((version 3.1)
     70  `((version 3.2)
    7171    ,@(if has-exports? `((exports "ode-rkf45.exports")) (list)) ))
    7272
     
    8181    ,@(if has-exports? '("ode-euler.exports") (list)) )
    8282  ; Assoc list with properties for your extension:
    83   `((version 3.1)
     83  `((version 3.2)
    8484    ,@(if has-exports? `((exports "ode-euler.exports")) (list)) ))
    8585
     
    133133
    134134  ; Assoc list with properties for your extension:
    135   `((version 3.1)
     135  `((version 3.2)
    136136    ,@(if has-exports? `((exports "ode-solvers.exports")) (list)) ))
    137137
     
    147147
    148148  ; Assoc list with properties for your extension:
    149   `((version 3.1)
     149  `((version 3.2)
    150150    ,@(if has-exports? `((exports "ode-ctranslator.exports")) (list)) ))
    151151
     
    161161
    162162  ; Assoc list with properties for your extension:
    163   `((version 3.1)
     163  `((version 3.2)
    164164    ,@(if has-exports? `((exports "ode-hhsm.exports")) (list)) ))
    165165
     
    175175
    176176  ; Assoc list with properties for your extension:
    177   `((version 3.1)
     177  `((version 3.2)
    178178    ,@(if has-exports? `((exports "ode-bpr.exports")) (list)) ))
    179179
     
    190190
    191191  ; Assoc list with properties for your extension:
    192   `((version 3.1)
     192  `((version 3.2)
    193193    ,@(if has-exports? `((exports "ode-waveform.exports")) (list)) ))
    194194
     
    204204
    205205  ; Assoc list with properties for your extension:
    206   `((version 3.1)
     206  `((version 3.2)
    207207    ,@(if has-exports? `((exports "ode-hhs.exports")) (list)) ))
    208208
     
    218218
    219219  ; Assoc list with properties for your extension:
    220   `((version 3.1)
     220  `((version 3.2)
    221221    ,@(if has-exports? `((exports "ode-lambda.exports")) (list)) ))
    222222
     
    232232
    233233  ; Assoc list with properties for your extension:
    234   `((version 3.1)
     234  `((version 3.2)
    235235    ,@(if has-exports? `((exports "ode-rate.exports")) (list)) ))
    236236
     
    241241 'ode-macros
    242242 `("ode-macros.scm" )
    243  `((version 3.1)
     243 `((version 3.2)
    244244   (syntax)
    245245   (require-at-runtime ode)))
  • ode/trunk/rkf45.scm

    r7961 r8001  
    123123
    124124  (define printq  (ode-runtime 'print))
    125   (define eval-rhs  (ode-runtime 'eval-expr))
     125  (define eval-rhs  (ode-runtime 'eval-rhs))
    126126  (define is-state? (ode-runtime 'is-state?))
    127127  (define is-asgn?  (ode-runtime 'is-asgn?))
     
    156156                  (sym  (second xrec))
    157157                  (rhs  (third xrec)))
    158             (let ((v     (eval-rhs rhs))
     158            (let ((v     (eval-rhs sym rhs))
    159159                  (svec  (solve-env-ref sym)))
    160160              (cond ((is-state? sym)  (case df
     
    211211
    212212      (for-each (lambda (g)
    213                   (if (not (eval-rhs g))
     213                  (if (not (eval-rhs 'guard g))
    214214                      (numerror "guard failed: " g))) guards)
    215215     
Note: See TracChangeset for help on using the changeset viewer.