Changeset 30940 in project


Ignore:
Timestamp:
05/29/14 11:14:42 (6 years ago)
Author:
Ivan Raikov
Message:

signal-diagram: support for variable timestep integration

Location:
release/4/signal-diagram/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/4/signal-diagram/trunk/examples/Morris-Lecar81.scm

    r23951 r30940  
    2626
    2727    (initial .
    28              ((t      0.0)
    29              (h       1e-3)
    30              (v       -60.899)
    31              (w       0.0149)
    32              (Isyn    ,Isyn)
    33              (vk      ,vk)   
    34              (vl      ,vl)
    35              (vca     ,vca)
    36              (gk      ,gk)
    37              (gl      ,gl)
    38              (gca     ,gca)
    39              (c       ,c)
    40              (v1      ,v1)
    41              (v2      ,v2)
    42              (v3      ,v3)
    43              (v4      ,v4)
    44              (phi     ,phi))))
    45 
    46 
     28             ((t       0.0)
     29              (h       1.0)
     30              (v       -60.899)
     31              (w       0.0149)
     32              (Isyn    ,Isyn)
     33              (vk      ,vk)   
     34              (vl      ,vl)
     35              (vca     ,vca)
     36              (gk      ,gk)
     37              (gl      ,gl)
     38              (gca     ,gca)
     39              (c       ,c)
     40              (v1      ,v1)
     41              (v2      ,v2)
     42              (v3      ,v3)
     43              (v4      ,v4)
     44              (phi     ,phi))))
    4745
    4846  )
     
    6664                     ((scheme Scheme) codegen/scheme)
    6765                     ((ML) codegen/ML))))
    68       (codegen name (construct f) initial: initial solver: solver ))
     66      (codegen name (construct f adaptive-integral-method:
     67                               (case solver
     68                                     ((rkhe rkbs rkf45 rkck rkdp rkf78 rkv65) #t)
     69                                     (else #f)))
     70               initial: initial solver: solver ))
    6971    ))
    7072
     
    7375(define Morris-Lecar81 (Morris-Lecar81:construct 2.0 8.0 4.0 -50.0 -70.0 100.0 -1.0 15.0 10.0 14.5 0.0667 20.0 50.0))
    7476
    75 (with-output-to-file "Morris-Lecar81_solver.m"
    76   (lambda () (codegen 'Morris_Lecar81 Morris-Lecar81  language: 'octave solver: #f)))
     77;(with-output-to-file "Morris-Lecar81_solver.m"
     78;  (lambda () (codegen 'Morris_Lecar81 Morris-Lecar81  language: 'octave solver: #f)))
    7779
    78 (with-output-to-file "Morris-Lecar81_solver.scm"
    79   (lambda () (codegen 'Morris_Lecar81 Morris-Lecar81  language: 'scheme)))
     80;(with-output-to-file "Morris-Lecar81_solver.scm"
     81;  (lambda () (codegen 'Morris_Lecar81 Morris-Lecar81  language: 'scheme)))
    8082
    8183(with-output-to-file "Morris-Lecar81_solver.sml"
    82   (lambda () (codegen 'Morris-Lecar81 Morris-Lecar81 language: 'ML)))
     84  (lambda () (codegen 'Morris-Lecar81 Morris-Lecar81 language: 'ML solver: 'rkdp)))
    8385
    8486
  • release/4/signal-diagram/trunk/signal-diagram-dynamics.scm

    r29652 r30940  
    127127      (let ((du (ACTUATE dqs (INTEGRALH indep dqs h dfs))))
    128128
    129         (make-relation (zip aqs ads afs) (make-union (list du (make-assign-system `((,indep (+ ,indep ,h)))))))
    130 
     129        (make-relation (zip aqs ads afs) ;;(SEQUENCE du (make-assign-system `((,indep (+ ,indep ,h))))))
     130                       (SEQUENCE du (ACTUATE (list indep h) (PURE (make-function (list indep h) `(+ ,indep ,h)))))
     131                       )
    131132      ))
    132133    ))
     
    158159                     )))
    159160
    160         (make-union (list u (make-assign-system `((,indep (+ ,indep ,h))))))
     161        (SEQUENCE u (ACTUATE (list indep h) (PURE (make-function (list indep h) `(+ ,indep ,h)))))
    161162
    162         ))))
     163        ))
     164    ))
    163165
    164166
  • release/4/signal-diagram/trunk/signal-diagram.scm

    r30916 r30940  
    3333        (PURE PRIM RELATION IDENTITY
    3434         SENSE ACTUATE SEQUENCE UNION REDUCE
    35          INTEGRAL INTEGRALH
    36          TRANSITION RTRANSITION TRANSIENT ON
     35         INTEGRAL TRANSITION RTRANSITION TRANSIENT ON
    3736
    3837         function? make-function function-formals function-body
     
    4443
    4544         construct dataflow events codegen/Octave codegen/scheme codegen/ML
    46 
    4745         )
    4846
     
    202200  (TRANSIENT    (f diagram?) (g diagram?) (e symbol?) )
    203201  (ON           (f diagram?) (e symbol?) )
    204   (INTEGRAL     (i symbol?) (d symbol-list?) (f function-list?))
    205   (INTEGRALH    (i symbol?) (d symbol-list?) (h (lambda (x) (or (symbol? x) (number? x))))
     202  (INTEGRAL     (i symbol?) (d symbol-list?) (h (lambda (x) (or (symbol? x) (number? x))))
    206203                (f function-list?))
    207204  )
     
    353350             (dfe1 (make-dfe (dfe-gen dfe) (dfe-kill dfe)
    354351                             (lambda (s) (delete-duplicates
    355                                           (lset-difference eq?
    356                                               (append ((dfe-in dfe) s)
    357                                                       (relations-inputs sf))
    358                                               (relation-vars r))))
     352                                          (append ((dfe-in dfe) s)
     353                                                  (relations-inputs sf))))
    359354                             (dfe-out dfe))))
    360355        (make-sfarrow dfe1
     
    485480      ;; codegen
    486481      (lambda (s env dfe)
     482
    487483        (let* (
    488484               (fgx      (lset-intersection eq? (fe-gen s) (ge-gen s)))
     
    570566       
    571567       ;; in
    572        (lambda (s)  (lset-union eq? (fe-in s)
    573                                 (lset-difference eq? (ge-in s)
    574                                                  (fe-out s))))
     568       (lambda (s) 
     569         (lset-union eq? (fe-in s)
     570                     (lset-difference eq? (ge-in s)
     571                                      (fe-out s))))
    575572       
    576573       ;; out
     
    780777              (rv        (gensym 'actuate))
    781778              (renv      (codegen-renv fcodegen))
    782               (fldr      (lambda (n n1)
    783                            (list n (select-signal 'actuate n1 renv))))
     779              (fldr      (lambda (n n1) (list n (select-signal 'actuate n1 renv))))
    784780              )
    785781
     
    12501246
    12511247
    1252 (define (sf-integral0 x ys h fs)
     1248(define (sf-integral0 x ys h fs method)
    12531249
    12541250  (let* ((xn     (gensym (string->symbol (s+ x "+h"))))
    1255          (yis    (list-tabulate (length ys)  (lambda (i) i)))
     1251         (yis    (if (and (adaptive-integral) (symbol? h))
     1252                     (list-tabulate (length ys) (lambda (i) (+ 1 i)))
     1253                     (list-tabulate (length ys) (lambda (i) i))))
    12561254         (yns    (map (lambda (y) (gensym (string->symbol (s+ y "(" xn ")")))) ys))
    12571255         (ynvs   (map (lambda (yn) (gensym (string->symbol (s+ yn "v")))) yns))
     
    12621260         )
    12631261
    1264     (let (
    1265           (fs-formals (map function-formals fs))
    1266           )
     1262    (let ((fs-formals (map function-formals fs)))
    12671263
    12681264      (make-sfarrow
     
    12721268
    12731269        ;; gen
    1274         (lambda (s) yns)
     1270        (lambda (s) (if (and (adaptive-integral) (symbol? h))
     1271                        (cons h yns) yns))
    12751272       
    12761273        ;; kill
     
    12781275       
    12791276        ;; in
    1280         (lambda (s) (lset-union eq?
    1281                       (dynvector-ref integral-events idx)
    1282                       (lset-union eq?
    1283                         (concatenate fs-formals)
    1284                         (append (if (symbol? h) (list h) '())
    1285                                 (cons x ys)))))
     1277        (lambda (s)
     1278          (let ((x (lset-union eq?
     1279                               (dynvector-ref integral-events idx)
     1280                               (lset-union eq?
     1281                                           (concatenate fs-formals)
     1282                                           (append (if (symbol? h) (list h) '())
     1283                                                   (cons x ys))))))
     1284            x))
    12861285       
    12871286        ;; out
    1288         (lambda (s) yns)
     1287        (lambda (s) (if (and (adaptive-integral) (symbol? h))
     1288                        (cons h yns) yns))
    12891289        )
    12901290       
     
    13161316
    13171317              rv2
    1318              
    1319               (map (lambda (s) (cons s rv2)) yns)
     1318
     1319              ((lambda (env) (if (and (adaptive-integral) (symbol? h))
     1320                                 (cons (cons h rv2) env) env))
     1321               (map (lambda (s) (cons s rv2)) yns))
    13201322
    13211323              (append
     
    13411343
    13421344
    1343                 (B:Val rv2     (V:Rec (map (lambda (yn yi) `(,yn ,(V:Sub yi (V:Var rv1)) )) yns yis)) )
     1345                (B:Val rv2
     1346                       (V:Rec ((lambda (flds)
     1347                                 (if (and (adaptive-integral) (symbol? h))
     1348                                     (cons `(,h ,(V:Sub 0 (V:Var rv1))) flds)
     1349                                     flds))
     1350                               (map (lambda (yn yi) `(,yn ,(V:Sub yi (V:Var rv1)) )) yns yis)) ))
    13441351                )
    13451352               ))
     
    13481355
    13491356       ;; signature
    1350        `(INTEGRAL ,idx ,x ,ys)
     1357       `(INTEGRAL ,idx ,h ,x ,ys)
    13511358
    13521359       ;; children
     
    13641371  (sf-integral0 x y h f))
    13651372
    1366 (define (sf-integral x y f)
    1367   (sf-integral0 x y 1e-3 f))
    1368 
    1369 
    1370 (define (construct d)
     1373
     1374(define (construct d #!key (method 'rk3))
    13711375  (integral-index 0)
    13721376  (dynvector-clear! integral-events 0)
    1373   (construct1 d))
    1374 
    1375 (define (construct1 d)
    1376   (cases diagram d
    1377          (IDENTITY (f)             (sf-identity (construct1 f)))
    1378          (PURE (f)                 (sf-pure f))
    1379          (PRIM (f name)            (sf-prim f name))
    1380          (RELATION (r f)           (sf-relation r (construct1 f)))
    1381          (SEQUENCE (f g)           (sf-sequence (construct1 f) (construct1 g)))
    1382          (UNION (f g)              (sf-union (construct1 f) (construct1 g)))
    1383          (SENSE (s f)              (sf-sense s (construct1 f)))
    1384          (ACTUATE (s f)            (sf-actuate s (construct1 f)))
    1385          (REDUCE (f n i)           (sf-reduce f n i))
    1386          (RTRANSITION (f g ef eg s)  (sf-rtransition (construct1 f) (construct1 g) ef eg s))
    1387          (TRANSITION (f g ef s)      (sf-transition (construct1 f) (construct1 g) ef s))
    1388          (TRANSIENT (f g e)          (sf-transient (construct1 f) (construct1 g) e))
    1389          (ON (f e)                   (sf-on (construct1 f) e))
    1390          (INTEGRAL  (x ys fs)        (sf-integral x ys fs))
    1391          (INTEGRALH (x ys h fs)      (sf-integralh x ys h fs))
    1392          ))
     1377  (construct1 d method))
     1378
     1379
     1380(define (construct1 d method)
     1381  (let recur ((d d))
     1382    (cases diagram d
     1383           (IDENTITY (f)               (sf-identity (recur f)))
     1384           (PURE (f)                   (sf-pure f))
     1385           (PRIM (f name)              (sf-prim f name))
     1386           (RELATION (r f)             (sf-relation r (recur f)))
     1387           (SEQUENCE (f g)             (sf-sequence (recur f) (recur g)))
     1388           (UNION (f g)                (sf-union (recur f) (recur g)))
     1389           (SENSE (s f)                (sf-sense s (recur f)))
     1390           (ACTUATE (s f)              (sf-actuate s (recur f)))
     1391           (REDUCE (f n i)             (sf-reduce f n i))
     1392           (RTRANSITION (f g ef eg s)  (sf-rtransition (recur f) (recur g) ef eg s))
     1393           (TRANSITION (f g ef s)      (sf-transition (recur f) (recur g) ef s))
     1394           (TRANSIENT (f g e)          (sf-transient (recur f) (recur g) e))
     1395           (ON (f e)                   (sf-on (recur f) e))
     1396           (INTEGRAL  (x ys h fs)      (sf-integralh method x ys h fs))
     1397           )))
    13931398
    13941399
     
    15001505(define (codegen/scheme name f #!key (initial #f) (pre #t) (solver 'rk4b))
    15011506
    1502   (if (and solver (not (member solver '(cvode rkfe rk3 rk4a rk4b rkhe rkbs rkf45))))
     1507  (if (and solver (not (member solver '(cvode rkfe rk3 rk4a rk4b rkhe rkbs rkf45 rkck rkdp rkf78 rkv65))))
    15031508      (error 'codegen/scheme "unknown solver" solver))
    15041509
     
    15461551(define (codegen/ML name f #!key (initial #f) (pre #t) (post #t) (solver 'rk4b))
    15471552
    1548   (if (and solver (not (member solver '(rkfe rk3 rk4a rk4b rkhe rkbs rkf45))))
     1553  (if (and solver (not (member solver '(rkfe rk3 rk4a rk4b rkhe rkbs rkf45 rkck rkdp rkf78 rkv65))))
    15491554      (error 'codegen/ML "unknown solver" solver))
    15501555
     
    15531558    (codegen-state '())
    15541559
    1555     (let* ((input    (or (and initial (lset-intersection eq? (map car initial) ((dfe-in dfe) '())))
     1560    (let* ((input    (or (and initial ((dfe-in dfe) (map car initial)))
    15561561                         ((dfe-in dfe) '())))
    15571562           (fenv     (map (lambda (s) (cons s 'input)) input))
    15581563           (fcodegen ((sfarrow-codegen f) input fenv dfe ))
    1559            (relations-expr (relations-codegen f input)))
    1560 
     1564           (relations-expr (relations-codegen f input))
     1565           )
    15611566
    15621567      (if pre (print-fragments (prelude/ML solver: solver)))
Note: See TracChangeset for help on using the changeset viewer.