Changeset 29952 in project


Ignore:
Timestamp:
10/24/13 04:09:22 (8 years ago)
Author:
Ivan Raikov
Message:

9ML-toolkit: bringing octave and scheme backends up to date; changed Izhikevich FS example to use heaviside function

Location:
release/4/9ML-toolkit/trunk
Files:
8 edited

Legend:

Unmodified
Added
Removed
  • release/4/9ML-toolkit/trunk/examples/IzhikevichFS_AL.xml

    r28653 r29952  
    3131
    3232        <Alias name="UU" argument="V">
    33           <MathInline> if (V &lt; Vb) then 0 else (b * (V - Vb) * (V - Vb) * (V - Vb)) </MathInline>
     33          <MathInline> heaviside (V - Vb) * (b * (V - Vb) * (V - Vb) * (V - Vb)) </MathInline>
    3434        </Alias>
    3535
  • release/4/9ML-toolkit/trunk/examples/IzhikevichFS_UL.xml

    r28653 r29952  
    262262        </properties>
    263263
    264         <IVP name="TestIzhikevichFS_Iext400">
     264        <ivp name="TestIzhikevichFS_Iext400">
    265265          <timestep>0.001</timestep>
    266266          <duration>800.0</duration>
    267         </IVP>
     267        </ivp>
    268268
    269269    </Component>
  • release/4/9ML-toolkit/trunk/ivp-chicken.scm

    r29732 r29952  
    3434(define nl "\n")
    3535       
     36(define (chicken-value v)
     37  (cond
     38   ((pair? v)
     39    (case (car v)
     40      ((realsig)   (chicken-value (caddr v)))
     41      ((realconst) (chicken-value (cadr v)))
     42      ((generator) (sprintf "~A ()" (cadr v)))
     43      ((random)    (sprintf "~A ()" (cadr v)))
     44      ((neg)       (sprintf "(- (~A))" (chicken-value (cadr v))))
     45      ((+ - * / >= <= > <)
     46       (sprintf "(~A ~A ~A)"
     47                (car v)
     48                (chicken-value (cadr v))
     49                (chicken-value (caddr v))))
     50      ((log ln sin cos cosh tanh exp)
     51       (sprintf "(~A ~A)"
     52                (car v) (chicken-value (cadr v)) ))
     53      (else (error 'chicken-value "invalid value" v))))
     54   ((boolean? v)  (if v "#t" "#f"))
     55   (else (sprintf "~A" v))))
    3656
    3757(define chicken-run
     
    176196                                        (map (lambda (x)
    177197                                               (let ((n (car x))
    178                                                      (v (cdr x)))
    179                                                  (if (pair? v)
    180                                                      (case (car v)
    181                                                        ((generator) (sprintf "(~A)" (cadr v)))
    182                                                        (else (error 'ivp-chicken-codegen "invalid initial value" v)))
    183                                                      x)))
     198                                                     (v (chicken-value (cdr x))))
     199                                                 (cons n v)))
    184200                                             ic)))
    185201                         (sprintf "(define parameters (quote ~A))~%~%"
     
    227243                                        (map (lambda (x)
    228244                                               (let ((n (car x))
    229                                                      (v (cdr x)))
    230                                                  (if (pair? v)
    231                                                      (case (car v)
    232                                                        ((generator) (sprintf "(~A)" (cadr v)))
    233                                                        (else (error 'ivp-chicken-codegen "invalid initial value" v)))
    234                                                      x)))
     245                                                     (v (chicken-value (cdr x))))
     246                                                 (cons n v)))
    235247                                             ic)))
    236248                         (sprintf "(define parameters (quote ~A))~%~%"
     
    271283                         (sprintf "(include \"~A_solver.scm\")~%~%" ivp-id)
    272284                         chicken-run nl
    273                         (sprintf "(define initial (quote ~A))~%~%"
     285                        (sprintf "(define initial (quote ~A))~%~%"
    274286                                  (cons (cons ivar 0.0)
    275287                                        (map (lambda (x)
    276288                                               (let ((n (car x))
    277                                                      (v (cdr x)))
    278                                                  (if (pair? v)
    279                                                      (case (car v)
    280                                                        ((generator) (sprintf "(~A)" (cadr v)))
    281                                                        (else (error 'ivp-chicken-codegen "invalid initial value" v)))
    282                                                      x)))
     289                                                     (v (chicken-value (cdr x))))
     290                                                 (cons n v)))
    283291                                             ic)))
    284292                         (sprintf "(define parameters (quote ~A))~%~%"
     
    318326                                        (map (lambda (x)
    319327                                               (let ((n (car x))
    320                                                      (v (cdr x)))
    321                                                  (if (pair? v)
    322                                                      (case (car v)
    323                                                        ((generator) (sprintf "(~A)" (cadr v)))
    324                                                        (else (error 'ivp-chicken-codegen "invalid initial value" v)))
    325                                                      x)))
     328                                                     (v (chicken-value (cdr x))))
     329                                                 (cons n v)))
    326330                                             ic)))
    327331                         (sprintf "(define parameters (quote ~A))~%~%"
  • release/4/9ML-toolkit/trunk/ivp-lib.scm

    r29808 r29952  
    184184        ((chicken)
    185185         (begin
    186            (ivp-chicken prefix ivp-id ivar dvars pvars events ic sd)
     186           (ivp-chicken-codegen prefix ivp-id ivar dvars pvars events ic sd method)
    187187           `((ivp-id . ,ivp-id) . ,sdinfo)))
    188188       
     
    207207             (else #f)))))
    208208
     209    (d "generate-ivp-table: sexpr = ~A~%" (sxml-value->sexpr sxml-tuple))
     210
    209211      (and sexpr
    210212           (match-let (((ivar hvar start end) (cdr sexpr)))
     
    213215                    (sd (construct (car diagram+initial)))
    214216                    (ic (cadr diagram+initial)))
     217
     218               (d "generate-ivp-table: ic = ~A~%" ic)
    215219
    216220               (if (not (alist-ref ivar ic))
     
    277281(define (make-ivp-data-hook #!key (ivp #f) (diagram #f))
    278282  (lambda (prefix name label value)
     283
    279284    (cond
    280285     ((and diagram
  • release/4/9ML-toolkit/trunk/ivp-mlton.scm

    r29808 r29952  
    5656       (sprintf "Math.~A (~A)"
    5757                (car v) (mlton-value (cadr v)) ))
    58       (else (error 'mlton-initial "invalid initial value" v))))
     58      (else (error 'mlton-value "invalid value" v))))
    5959   ((and (number? v) (negative? v)) (string-append "~" (sprintf "~A" (abs v))))
    6060   ((boolean? v)  (if v "true" "false"))
     
    125125             (let ((show (cond ((number? v) "showReal")
    126126                               ((boolean? v) "showBoolean")
    127                                (else         ""))))
     127                               (else         "showReal"))))
    128128               (sprintf "^ \" \" ^ (~A (#~A(input)))" show dvar)))) dvars))
    129129   ")" ))
     
    187187                          `(("$(SML_LIB)/basis/basis.mlb" ,nl )
    188188                            ("$(RK_LIB)/rk.mlb" ,nl )
     189                            ("$(RANDMTZIG_LIB)/randmtzig.mlb" ,nl )
    189190                            ("local " ,nl)
    190191                            (,(sprintf "    ~A_solver.sml" ivp-id) ,nl)
     
    198199                      (run (,mlton-path -link-opt -s
    199200                                        -mlb-path-var ,(string-append "'RK_LIB " flsim-dir "/sml-lib/rk'")
     201                                        -mlb-path-var ,(string-append "'RANDMTZIG_LIB " flsim-dir "/sml-lib/randmtzig'")
    200202                                        ,mlb-path)))
    201203           
     
    238240                          `(("$(SML_LIB)/basis/basis.mlb" ,nl )
    239241                            ("$(RK_LIB)/rk.mlb" ,nl )
     242                            ("$(RANDMTZIG_LIB)/randmtzig.mlb" ,nl )
    240243                            ("local " ,nl)
    241244                            (,(sprintf "    ~A_solver.sml" ivp-id) ,nl)
  • release/4/9ML-toolkit/trunk/ivp-octave.scm

    r29732 r29952  
    3939(define nl "\n")
    4040
     41       
     42(define (octave-value v)
     43  (cond
     44   ((pair? v)
     45    (case (car v)
     46      ((realsig)   (octave-value (caddr v)))
     47      ((realconst) (octave-value (cadr v)))
     48      ((generator) (sprintf "~A ()" (cadr v)))
     49      ((random)    (sprintf "~A ()" (cadr v)))
     50      ((neg)       (sprintf "-(~A))" (octave-value (cadr v))))
     51      ((+ - * / >= <= > <)
     52       (sprintf "(~A ~A ~A)"
     53                (octave-value (cadr v))
     54                (car v)
     55                (octave-value (caddr v))))
     56      ((log ln sin cos cosh tanh exp)
     57       (sprintf "~A (~A)"
     58                (car v) (octave-value (cadr v)) ))
     59      (else (error 'octave-value "invalid value" v))))
     60   ((boolean? v)  (if v "true" "false"))
     61   (else (sprintf "~A" v))))
    4162
    4263(define (octave-m ivp-id start ivar hvar dvars events ic imax log-path adir solver-path)
     
    5273               (intersperse
    5374                (map (lambda (x)
    54                        (let ((n (car x)) (v (cdr x)))
    55                          (if (pair? v)
    56                              (case (car v)
    57                                ((generator) (sprintf "~A ()" (cadr v)))
    58                                (else (error 'octave-m "invalid initial value" v)))
    59                              (let ((v (if (boolean? v) (if v "true" "false") v)))
    60                                (sprintf "\"~A\",~A" n v)))))
     75                       (let ((n (car x)) (v (octave-value (cdr x))))
     76                         (sprintf "\"~A\",~A" n v)))
    6177                     (cons (cons ivar start) ic))
    6278                ",")))
  • release/4/9ML-toolkit/trunk/network.scm

    r29929 r29952  
    554554        (initialns  ((sxpath `(// nml:properties nml:Initial nml:label))  x))
    555555        (initialvs  ((sxpath `(// nml:properties nml:Initial nml:value))  x))
    556         (ivp        (safe-car ((sxpath `(// nml:IVP))  x)))
     556        (ivp        (safe-car ((sxpath `(// nml:ivp))  x)))
    557557        )
    558558
  • release/4/9ML-toolkit/trunk/parse.scm

    r29838 r29952  
    178178(define diagram-rtransition   (Longid (Pdot (Pident (ident-create "Diagram")) "RTRANSITION")))
    179179(define diagram-relation      (Longid (Pdot (Pident (ident-create "Diagram")) "RELATION")))
     180(define diagram-identity      (Longid (Pdot (Pident (ident-create "Diagram")) "IDENTITY")))
    180181
    181182(define signal-realconst     (Longid (Pdot (Pident (ident-create "Signal")) "realconst")))
     
    358359
    359360(define (make-algebraic-eqn-lst-expr eqlst)
    360   (let ((qs (map (lambda (x) (Const `(label ,(algebraic-eqn-quantity x)))) eqlst)))
    361     (Apply (Apply diagram-assign (make-list qs))
    362            (make-group (map make-pure (map algebraic-eqn-rhs eqlst))))))
     361  (and (not (null? eqlst))
     362      (let ((qs (map (lambda (x) (Const `(label ,(algebraic-eqn-quantity x)))) eqlst)))
     363        (Apply (Apply diagram-assign (make-list qs))
     364               (make-group (map make-pure (map algebraic-eqn-rhs eqlst)))))))
    363365
    364366
     
    421423                 (make-algebraic-eqn trigger-name2 (make-signal-expr trigger-rhs2)))
    422424           )))
     425
     426        (odes1
     427         (if (null? relations)
     428                         
     429             (make-ode-eqn-lst-expr
     430              (map (lambda (var rhs) (make-ode-eqn 't var 'h (make-signal-expr rhs)))
     431                   ode-variables1 ode-rhss1))
     432             
     433             (make-dae-eqn-lst-expr
     434              (append relations
     435                      (map (lambda (var rhs) (make-ode-eqn 't var 'h (make-signal-expr rhs)))
     436                           ode-variables1 ode-rhss1)))
     437             ))
     438
     439        (odes2
     440         (and (not (null? ode-variables2))
     441              (if (null? relations)
     442                 
     443                  (make-ode-eqn-lst-expr
     444                   (map (lambda (var rhs) (make-ode-eqn 't var 'h (make-signal-expr rhs)))
     445                        ode-variables2 ode-rhss2))
     446                 
     447                  (make-dae-eqn-lst-expr
     448                   (append relations
     449                           (map (lambda (var rhs) (make-ode-eqn 't var 'h (make-signal-expr rhs)))
     450                                ode-variables2 ode-rhss2)))
     451                  )))
     452         
     453
    423454        )
    424455                     
     
    433464      (Apply diagram-rtransition
    434465             
    435              (Apply
    436              
    437               (Apply diagram-sequence
    438                      
    439                      (if (null? relations)
    440                          
    441                          (make-ode-eqn-lst-expr
    442                           (map (lambda (var rhs) (make-ode-eqn 't var 'h (make-signal-expr rhs)))
    443                                ode-variables1 ode-rhss1))
    444                          
    445                          (make-dae-eqn-lst-expr
    446                           (append relations
    447                                   (map (lambda (var rhs) (make-ode-eqn 't var 'h (make-signal-expr rhs)))
    448                                        ode-variables1 ode-rhss1)))
    449                          ))
    450                                    
    451               assignments1))
     466              (if assignments1
     467                  (Apply
     468                   (Apply diagram-sequence odes1)
     469                   assignments1)
     470                  odes1))
    452471     
    453472      (if (null? ode-variables2)
     
    459478              (make-relations relations assignments2))
    460479         
    461           (Apply
    462            
    463            (Apply diagram-sequence
    464                  
    465                   (if (null? relations)
    466                      
    467                       (make-ode-eqn-lst-expr
    468                        (map (lambda (var rhs) (make-ode-eqn 't var 'h (make-signal-expr rhs)))
    469                             ode-variables2 ode-rhss2))
    470                      
    471                       (make-dae-eqn-lst-expr
    472                        (append relations
    473                                (map (lambda (var rhs) (make-ode-eqn 't var 'h (make-signal-expr rhs)))
    474                                     ode-variables2 ode-rhss2)))
    475                       ))
    476            
    477            assignments2)))
     480          (if assignments2
     481              (Apply
     482               (Apply diagram-sequence odes2)
     483               assignments2)
     484              odes2)))
    478485     
    479486     (Apply
     
    488495    (Apply signal-boolsig (Const `(label ,state-name)))
    489496    (Apply signal-boolconst (Const `(bool #f)))))
     497
    490498  ))
    491499
     
    507515                  (map (lambda (var rhs) (make-algebraic-eqn var (make-signal-expr rhs))  )
    508516                       assign-variables1 assign-rhss1))))
     517
     518
     519          (odes
     520
     521           (Apply
     522
     523            (Apply diagram-union
     524                   (Apply (Apply diagram-assign (make-list (list (Const `(label ,trigger-name)))))
     525                          (make-pure (make-signal-expr trigger-rhs))))
     526
     527            (if (null? relations)
     528               
     529                (make-ode-eqn-lst-expr
     530                 (map (lambda (var rhs) (make-ode-eqn 't var 'h (make-signal-expr rhs))) 
     531                      ode-variables ode-rhss))
     532               
     533                (make-dae-eqn-lst-expr
     534                 (append relations
     535                         (map (lambda (var rhs) (make-ode-eqn 't var 'h (make-signal-expr rhs))) 
     536                              ode-variables ode-rhss)))
     537                )))
     538
     539          (odes1
     540            (if (null? relations)
     541
     542                (make-ode-eqn-lst-expr
     543                 (map (lambda (var rhs)
     544                        (make-ode-eqn 't var 'h (make-signal-expr rhs))) 
     545                      ode-variables1 ode-rhss1))
     546
     547                (make-dae-eqn-lst-expr
     548                 (append relations
     549                         (map (lambda (var rhs)
     550                                (make-ode-eqn 't var 'h (make-signal-expr rhs))) 
     551                              ode-variables1 ode-rhss1)))
     552                ))
    509553          )
    510554     
    511555
    512556      (Apply
    513        
     557
    514558       (Apply
    515559       
    516560        (Apply diagram-transient
    517                (Apply
    518                 (Apply
    519                  diagram-sequence
    520                  (Apply
    521                   (Apply diagram-union
    522                          (Apply (Apply diagram-assign (make-list (list (Const `(label ,trigger-name)))))
    523                                 (make-pure (make-signal-expr trigger-rhs))))
    524                  
    525                   (if (null? relations)
    526                      
    527                       (make-ode-eqn-lst-expr
    528                        (map (lambda (var rhs) (make-ode-eqn 't var 'h (make-signal-expr rhs))) 
    529                             ode-variables ode-rhss))
    530                      
    531                       (make-dae-eqn-lst-expr
    532                        (append relations
    533                                (map (lambda (var rhs) (make-ode-eqn 't var 'h (make-signal-expr rhs))) 
    534                                     ode-variables ode-rhss)))
    535                       )
    536                   ))
    537                 assignments
    538                 ))
     561
     562               (if assignments
     563                   (Apply
     564                    (Apply diagram-sequence odes)
     565                    assignments)
     566                   odes))
    539567       
    540         (if (null? ode-variables1)
    541            
    542             assignments1
    543            
    544             (Apply
    545              (Apply
    546               diagram-sequence
    547 
    548               (make-ode-eqn-lst-expr
    549                (map (lambda (var rhs)
    550                       (make-ode-eqn 't var 'h (make-signal-expr rhs))) 
    551                     ode-variables1 ode-rhss1)))
     568         (if (null? ode-variables1)
    552569             
    553570             assignments1
    554571             
    555              ))
    556         )
    557      
    558        (Apply
    559         (Apply signal-boolsig (Const `(label ,trigger-name)))
    560         (Apply signal-boolconst (Const `(bool #f)))))
    561 
    562     ))
     572             (Apply
     573              (Apply
     574               diagram-sequence odes1)
     575              assignments1)
     576             
     577            ))
     578
     579        (Apply
     580         (Apply signal-boolsig (Const `(label ,trigger-name)))
     581         (Apply signal-boolconst (Const `(bool #f)))))
     582
     583       ))
    563584
    564585
Note: See TracChangeset for help on using the changeset viewer.