Changeset 27072 in project


Ignore:
Timestamp:
07/19/12 07:49:11 (9 years ago)
Author:
Ivan Raikov
Message:

9ML-toolkit: factoring out plotting functions into a separate module

Location:
release/4/9ML-toolkit/trunk
Files:
2 added
9 edited
1 moved

Legend:

Unmodified
Added
Removed
  • release/4/9ML-toolkit/trunk/9ML-toolkit.setup

    r26895 r27072  
    44  (make-pathname #f fn ##sys#load-dynamic-extension))   
    55
    6 (define version 1.15)
     6(define version 1.16)
    77
    88(use make)
     
    2525        (compile  -s 9ML-parse.import.scm))
    2626
    27        ((dynld-name "9ML-repr") ("repr.scm" "SXML.scm" "SXML-to-XML.scm" (dynld-name "9ML-parse") )
    28         (compile -O -d2 -S -s repr.scm -o ,(dynld-name "9ML-repr") -j 9ML-repr))
    29 
    30        ((dynld-name "9ML-repr.import") ("9ML-repr.import.scm")
    31         (compile  -s 9ML-repr.import.scm))
     27       ((dynld-name "9ML-eval") ("eval.scm" "SXML.scm" "SXML-to-XML.scm" (dynld-name "9ML-parse") )
     28        (compile -O -d2 -S -s eval.scm -o ,(dynld-name "9ML-eval") -j 9ML-eval))
     29
     30       ((dynld-name "9ML-eval.import") ("9ML-eval.import.scm")
     31        (compile  -s 9ML-eval.import.scm))
     32
     33       ((dynld-name "9ML-plot") ("plot.scm" (dynld-name "9ML-eval") )
     34        (compile -O -d2 -S -s plot.scm -o ,(dynld-name "9ML-plot") -j 9ML-plot))
     35
     36       ((dynld-name "9ML-plot.import") ("9ML-plot.import.scm")
     37        (compile  -s 9ML-plot.import.scm))
    3238
    3339       ((dynld-name "9ML-ivp-octave") ("ivp-octave.scm" )
     
    8490       )
    8591
    86   (list (dynld-name "9ML-toolkit") (dynld-name "9ML-toolkit.import")
    87         (dynld-name "9ML-repr") (dynld-name "9ML-repr.import")
    88         (dynld-name "9ML-parse") (dynld-name "9ML-parse.import")
    89         (dynld-name "9ML-ivp-octave") (dynld-name "9ML-ivp-octave.import")
     92  (list (dynld-name "9ML-toolkit")     (dynld-name "9ML-toolkit.import")
     93        (dynld-name "9ML-plot")        (dynld-name "9ML-plot.import")
     94        (dynld-name "9ML-eval")        (dynld-name "9ML-eval.import")
     95        (dynld-name "9ML-parse")       (dynld-name "9ML-parse.import")
     96        (dynld-name "9ML-ivp-octave")  (dynld-name "9ML-ivp-octave.import")
    9097        (dynld-name "9ML-ivp-chicken") (dynld-name "9ML-ivp-chicken.import")
    91         (dynld-name "9ML-ivp-mlton") (dynld-name "9ML-ivp-mlton.import")
     98        (dynld-name "9ML-ivp-mlton")   (dynld-name "9ML-ivp-mlton.import")
    9299        (dynld-name "9ML-ivp-octave-mlton") (dynld-name "9ML-ivp-octave-mlton.import")
    93100        "9ML-report" "9ML-ivp" "9ML-shell" "9ML-ulp" )
     
    159166
    160167  ; Name of your extension:
    161   '9ML-repr
    162 
    163   ; Files to install for your extension:
    164   `(,(dynld-name "9ML-repr") ,(dynld-name "9ML-repr.import") )
     168  '9ML-eval
     169
     170  ; Files to install for your extension:
     171  `(,(dynld-name "9ML-eval") ,(dynld-name "9ML-eval.import") )
    165172
    166173  ; Assoc list with properties for your extension:
  • release/4/9ML-toolkit/trunk/eval.scm

    r27071 r27072  
    11
    22;;
    3 ;; Different external representations of NineML.
     3;; Support for evaluation of NineML.
    44;;
    55;; Copyright 2010-2012 Ivan Raikov and the Okinawa Institute of
     
    2121
    2222
    23 (module 9ML-repr
    24 
    25         (repr-verbose
     23(module 9ML-eval
     24
     25        (eval-verbose
    2626         print-eval-env print-type-env print-source-defs
    2727         traverse-definitions definition-apply
    28          generate-diagram html-report
    29          sxml-value->sexpr sexpr->diagram+initial print-fragments
     28         sxml-value->sexpr sexpr->function sexpr->diagram+initial
    3029         sigfun-eval real-eval
     30         print-fragments
     31         html-report
    3132         )
    3233
     
    5859
    5960
    60 (define repr-verbose (make-parameter 0))
     61(define eval-verbose (make-parameter 0))
    6162
    6263(define (d fstr . args)
    6364  (let ([port (current-error-port)])
    64     (if (positive? (repr-verbose))
     65    (if (positive? (eval-verbose))
    6566        (begin (apply fprintf port fstr args)
    6667               (flush-output port) ) )))
    6768
    68 
    69 (define (run:execute explist)
    70   (define (smooth lst)
    71     (let ((slst (map ->string lst)))
    72       (string-intersperse (cons (car slst) (cdr slst)) " ")))
    73   (for-each (lambda (cmd) (system (->string cmd)))
    74             (map smooth explist)))
    75 
    76 (define (run:execute* explist)
    77   (define (smooth lst)
    78     (let ((slst (map ->string lst)))
    79       (string-intersperse (cons (car slst) (cdr slst)) " ")))
    80   (for-each (lambda (cmd) (system* "~a" cmd))
    81             (map smooth explist)))
    82 
    83 
    84 (define-syntax run
    85   (syntax-rules ()
    86     ((_ exp ...)
    87      (begin
    88        (d "running ~A ...~%" (list `exp ...))
    89        (run:execute* (list `exp ...))))))
    90 
    91 (define-syntax run-
    92   (syntax-rules ()
    93     ((_ exp ...)
    94      (begin
    95        (d "running ~A ...~%" (list `exp ...))
    96        (run:execute (list `exp ...))))))
    9769
    9870(define (enumvars expr ax)
     
    10274        (else  (if (symbol? (car expr))  (fold (lambda (x ax) (enumvars x ax)) ax (cdr expr)) ax)))
    10375      (if (symbol? expr) (cons expr ax) ax)))
     76
    10477
    10578(define (sexpr->function sexpr)  (make-function (enumvars sexpr '()) sexpr))
     
    772745 
    773746
    774 
    775 (define (generate-diagram prefix diagram-id tree)
    776 
    777     (let ((sexpr (sxml-value->sexpr tree)))
    778 
    779       (reset-graph)
    780       (let recur ((sexpr sexpr))
    781         (or (and (pair? sexpr)
    782                  (case (car sexpr)
    783                         ((diagram)
    784                          (let ((sexpr (cdr sexpr)))
    785 
    786                             (case (car sexpr)
    787 
    788                               ((RTRANSITION) 
    789                                 (let ((f (cadr sexpr)) (fk (caddr sexpr))
    790                                       (e (recur (cadddr sexpr))) (ek (recur (car (cddddr sexpr)))))
    791                                   (let ((node (register-node (gensym 'rtransition)))
    792                                         (fnode (recur f))
    793                                         (fknode (recur fk)))
    794                                     (set-label node "RTRANSITION")
    795                                     (let ((edge1  (register-edge node fnode))
    796                                           (edge2  (register-edge node fknode)))
    797                                       (set-label edge1 e)
    798                                       (set-label edge2 ek)
    799                                       node
    800                                       ))))
    801                                
    802                               ((TRANSITION) 
    803                                 (let ((f (cadr sexpr)) (fk (caddr sexpr))
    804                                       (e (recur (cadddr sexpr))) )
    805                                   (let ((node (register-node (gensym 'transition)))
    806                                         (fnode (recur f))
    807                                         (fknode (recur fk)))
    808                                     (set-label node "TRANSITION")
    809                                     (let ((edge1  (register-edge node fnode)))
    810                                       (set-label edge1 e)
    811                                       node
    812                                       ))))
    813                                
    814                               ((TRANSIENT) 
    815                                 (let ((f (cadr sexpr)) (fk (caddr sexpr))
    816                                       (e (recur (cadddr sexpr))) )
    817                                   (let ((node (register-node (gensym 'transient)))
    818                                         (fnode (recur f))
    819                                         (fknode (recur fk)))
    820                                     (set-label node "TRANSIENT")
    821                                     (let ((edge1  (register-edge node fnode)))
    822                                       (set-label edge1 e)
    823                                       node
    824                                       ))))
    825                                
    826                                ((IDENTITY)       (let ((n1 (recur (cadr sexpr))))
    827                                                    (let ((node (register-node (gensym 'IDENTITY))))
    828                                                      (set-label node "IDENTITY")
    829                                                      (let ((edge1 (register-edge node n1)))
    830                                                        (set-label edge1 "n1")
    831                                                        node))))
    832                                ((PURE)           (let ((f (sexpr->function (cadr sexpr))))
    833                                                    (let ((node (register-node (gensym 'function))))
    834                                                      (set-label node (sprintf "fn ~A => ~A"
    835                                                                               (function-formals f)
    836                                                                               (function-body f)))
    837                                                      node)))
    838                                ((GROUP)          (let ((n1 (recur (cadr sexpr)))
    839                                                        (n2 (recur (caddr sexpr))))
    840                                                    (let ((node (register-node (gensym 'UNION))))
    841                                                      (set-label node "UNION")
    842                                                      (let ((edge1 (register-edge node n1))
    843                                                            (edge2 (register-edge node n2)))
    844                                                        (set-label edge1 "n1")
    845                                                        (set-label edge1 "n2")
    846                                                        node
    847                                                        ))))
    848                                ((SEQUENCE)       (let ((n1 (recur (cadr sexpr)))
    849                                                        (n2 (recur (caddr sexpr))))
    850                                                    (let ((node (register-node (gensym 'sequence))))
    851                                                      (set-label node "SEQUENCE")
    852                                                      (let ((edge1 (register-edge node n1))
    853                                                            (edge2 (register-edge node n2)))
    854                                                        (set-label edge1 "n1")
    855                                                        (set-label edge1 "n2")
    856                                                        node
    857                                                        ))))
    858                                ((UNION)          (let ((n1 (recur (cadr sexpr)))
    859                                                        (n2 (recur (caddr sexpr))))
    860                                                    (let ((node (register-node (gensym 'UNION))))
    861                                                      (set-label node "UNION")
    862                                                      (let ((edge1 (register-edge node n1))
    863                                                            (edge2 (register-edge node n2)))
    864                                                        (set-label edge1 "n1")
    865                                                        (set-label edge1 "n2")
    866                                                        node
    867                                                        ))))
    868                                ((SENSE)          (let ((sns (cadr sexpr)) (n (recur (caddr sexpr))))
    869                                                    (let ((node (register-node (gensym 'SENSE))))
    870                                                      (set-label node (sprintf "SENSE ~A" sns))
    871                                                      (let ((edge (register-edge node n)))
    872                                                        node
    873                                                        ))))
    874                                                    
    875                                ((ACTUATE)        (let ((sns (cadr sexpr)) (n (recur (caddr sexpr))))
    876                                                    (let ((node (register-node (gensym 'ACTUATE))))
    877                                                      (set-label node (sprintf "ACTUATE ~A" sns))
    878                                                      (let ((edge (register-edge node n)))
    879                                                        node
    880                                                        ))))
    881                                ((ODE)            (let ((ivar (cadr sexpr)) (dvar (caddr sexpr))
    882                                                        (rhs (recur (cadddr sexpr))))
    883                                                    (let ((node (register-node (gensym 'ODE))))
    884                                                      (set-label node (sprintf "D (~A ~A) = ~A" dvar ivar rhs))
    885                                                      node
    886                                                      )))
    887                                ((ASSIGN)         (let ((var (cadr sexpr))
    888                                                        (rhs (recur (caddr sexpr))))
    889                                                    (let ((node (register-node (gensym 'ASSGIN))))
    890                                                      (set-label node (sprintf "~A = ~A" var rhs))
    891                                                      node
    892                                                      )))
    893 
    894                                (else (error 'generate-diagram "invalid diagram constructor" sexpr)))))
    895 
    896                         ((realsig)   (let ((name (cadr sexpr))
    897                                            (value (caddr sexpr)))
    898                                        name))
    899 
    900                         ((boolsig)   (let ((name (cadr sexpr))
    901                                            (value (caddr sexpr)))
    902                                        name))
    903 
    904                         (else (map recur sexpr))
    905                         ))
    906              sexpr))
    907 
    908       (let* ((dir (pathname-directory prefix))
    909              (dot-path (make-pathname dir (string-append (->string diagram-id) ".dot")))
    910              (png-path (make-pathname dir (string-append (->string diagram-id) ".png"))))
    911         (with-output-to-file  dot-path
    912           (lambda ()
    913             (render-graph/dot (current-output-port))
    914             ))
    915        
    916         (run (dot -Tpng ,dot-path > ,png-path))
    917         )
    918        
    919       ))
    920 
    921 
    922747(define variable-names (make-parameter '()))
    923748
  • release/4/9ML-toolkit/trunk/ivp-chicken.scm

    r25988 r27072  
    2929(import (only files make-pathname pathname-directory pathname-file)
    3030        (only data-structures conc))
    31 (require-extension make datatype signal-diagram 9ML-repr setup-api)
     31(require-extension make datatype signal-diagram 9ML-eval setup-api)
    3232
    3333
  • release/4/9ML-toolkit/trunk/ivp-mlton.scm

    r25988 r27072  
    3030        (only data-structures conc alist-ref intersperse)
    3131        (only srfi-13 string-concatenate))
    32 (require-extension make datatype signal-diagram 9ML-repr setup-api)
     32(require-extension make datatype signal-diagram 9ML-eval setup-api)
    3333
    3434
  • release/4/9ML-toolkit/trunk/ivp-octave-mlton.scm

    r25988 r27072  
    3232        (only srfi-1 filter list-index)
    3333        (only srfi-13 string-concatenate))
    34 (require-extension make datatype signal-diagram 9ML-repr 9ML-ivp-mlton setup-api)
     34(require-extension make datatype signal-diagram 9ML-eval 9ML-ivp-mlton setup-api)
    3535
    3636
  • release/4/9ML-toolkit/trunk/ivp-octave.scm

    r25988 r27072  
    3333        (only srfi-1 filter list-index)
    3434        (only srfi-13 string-concatenate))
    35 (require-extension make datatype signal-diagram 9ML-repr setup-api)
     35(require-extension make datatype signal-diagram 9ML-eval setup-api)
    3636
    3737
  • release/4/9ML-toolkit/trunk/ivp.scm

    r25988 r27072  
    2222(require-extension posix srfi-13 datatype static-modules miniML miniMLsyntax miniMLvalue miniMLeval)
    2323(require-extension getopt-long ssax sxml-transforms sxpath sxpath-lolevel object-graph signal-diagram)
    24 (require-extension 9ML-parse 9ML-repr )
     24(require-extension 9ML-parse 9ML-eval 9ML-plot)
    2525(require-extension 9ML-ivp-octave 9ML-ivp-chicken 9ML-ivp-mlton 9ML-ivp-octave-mlton )
    2626       
     
    286286
    287287
    288 (define (generate-ivp-plot prefix ivp-info #!key (format 'png) (index #f))
    289   (let ((ivp-id (car ivp-info))
    290         (dvars (caddr ivp-info)))
    291     (let* ((n (+ 1 (length dvars)))
    292            (range (if (and index (integer? index)) (number->string index) (sprintf "2:~A" n)))
    293            (linewidth 3)
    294            (dir (or (pathname-directory prefix) "."))
    295            (log-path (make-pathname dir (sprintf "~A_~A.log" (pathname-file prefix) ivp-id)))
    296            (png-path (make-pathname dir (sprintf "~A_~A.png" (pathname-file prefix) ivp-id)))
    297            (eps-path (make-pathname dir (sprintf "~A_~A.eps" (pathname-file prefix) ivp-id)))
    298            )
    299       (case format
    300              ((png)
    301               (run (octave -q --eval
    302                            #\'
    303                            log = load (,(sprintf "\"~A\"" log-path)) #\;
    304                            h = plot ("log(:,1)" #\, ,(sprintf "log(:,~A)" range)) #\;
    305                            ,@(if index
    306                                  (concatenate (list-tabulate 1 (lambda (i) `(set (h(,(+ 1 i)) #\, "\"linewidth\"" #\, ,linewidth) #\;))))
    307                                  (concatenate (list-tabulate (- n 1) (lambda (i) `(set (h(,(+ 1 i)) #\, "\"linewidth\"" #\, ,linewidth) #\;)))))
    308                            print (,(sprintf "\"~A\"" png-path) #\, "\"-dpng\"") #\;
    309                            #\')))
    310              ((eps)
    311               (run (octave -q --eval
    312                            #\'
    313                            log = load (,(sprintf "\"~A\"" log-path)) #\;
    314                            h = plot ("log(:,1)" #\, ,(sprintf "log(:,~A)" range)) #\;
    315                            ,@(if index
    316                                  (concatenate (list-tabulate 1 (lambda (i) `(set (h(,(+ 1 i)) #\, "\"linewidth\"" #\, ,linewidth) #\;))))
    317                                  (concatenate (list-tabulate (- n 1) (lambda (i) `(set (h(,(+ 1 i)) #\, "\"linewidth\"" #\, ,linewidth) #\;)))))
    318                            print (,(sprintf "\"~A\"" eps-path) #\, "\"-depsc2\"") #\;
    319                            #\')))
    320              (else (error 'generate-ivp-plot "unrecognized format" format)))
    321       )))
    322 
    323 
    324288
    325289(define (make-ivp-hook #!key (ivp #f) (diagram #f) (ivp-plot #f) (plot-format 'png) (plot-index #f))
     
    331295      (let* ((diagram-id (gensym 'diagram))
    332296             (diagram-link `(img (@ (src ,(sprintf "~A.png" diagram-id))) (alt "NineML diagram"))))
    333         (generate-diagram prefix diagram-id value)
     297        (plot-diagram prefix diagram-id value)
    334298        diagram-link
    335299        ))
     
    341305
    342306        (let ((ivp-info (generate-ivp-table prefix ivp-id value platform: (simulation-platform))))
    343           (if ivp-plot (generate-ivp-plot prefix ivp-info format: plot-format index: plot-index))
     307          (if ivp-plot (plot-ivp prefix ivp-info format: plot-format index: plot-index))
    344308          (and ivp-plot ivp-plot-link))
    345309        ))
     
    399363                               (else #f)))
    400364            (unified-envs (map (lambda (x) (interpreter x xml: (options 'xml))) operands)))
    401         (if (options 'verbose) (begin (repr-verbose 1) (ivp-verbose 1)))
     365        (if (options 'verbose) (begin (eval-verbose 1) (ivp-verbose 1)))
    402366        (simulation-platform (or (options 'platform) (defopt 'platform) ))
    403367        (for-each
  • release/4/9ML-toolkit/trunk/report.scm

    r25988 r27072  
    2222(require-extension srfi-13 datatype static-modules miniML miniMLsyntax miniMLeval )
    2323(require-extension getopt-long object-graph sxpath sxpath-lolevel ssax)
    24 (require-extension 9ML-parse 9ML-repr )
     24(require-extension 9ML-parse 9ML-eval )
    2525
    2626(require-library sxml-transforms)
     
    260260       (let* ((diagram-id (gensym 'diagram))
    261261              (diagram-link `(img (@ (src ,(string-append (->string diagram-id) ".png"))) (alt "NineML diagram"))))
    262          (generate-diagram prefix diagram-id value)
     262         (plot-diagram prefix diagram-id value)
    263263         `(,(line "binding " `(b ,name) " = ") ,diagram-link))))
    264264
  • release/4/9ML-toolkit/trunk/shell.scm

    r25988 r27072  
    2222(require-extension  srfi-13 datatype matchable static-modules miniML miniMLsyntax miniMLeval )
    2323(require-extension getopt-long object-graph)
    24 (require-extension 9ML-parse 9ML-repr)
     24(require-extension 9ML-parse 9ML-eval)
    2525
    2626
  • release/4/9ML-toolkit/trunk/ulp.scm

    r26805 r27072  
    2424(require-extension datatype matchable static-modules miniML miniMLsyntax miniMLvalue miniMLeval)
    2525(require-extension signal-diagram ssax sxml-transforms sxpath sxpath-lolevel object-graph uri-generic getopt-long )
    26 (require-extension 9ML-parse 9ML-repr )
     26(require-extension 9ML-parse 9ML-eval )
    2727
    2828(define (string-match rx str)
     
    467467                               ((options 'output-sxml) 'sxml)
    468468                               (else #f))))
    469         (if (options 'verbose) (begin (repr-verbose 1) (ivp-verbose 1)))
     469        (if (options 'verbose) (begin (eval-verbose 1) (ivp-verbose 1)))
    470470        (simulation-platform (or (options 'platform) (defopt 'platform) ))
    471471        (for-each
Note: See TracChangeset for help on using the changeset viewer.