Changeset 27270 in project


Ignore:
Timestamp:
08/19/12 16:02:46 (9 years ago)
Author:
Ivan Raikov
Message:

9ML-toolkit: added Random module and supporting procedures

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

Legend:

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

    r25988 r27270  
    77 (files "9ML-toolkit.setup" "9ML-toolkit.meta"
    88        "NineML.l" "NineML.grm" "expr.grm" "NineMLparse.scm" "expr-parser.scm"
    9         "NineMLcore.scm" "NineMLdiagram.scm" "NineMLsignal.scm" "NineMLinterval.scm" "NineMLgraph.scm" "NineMLivp.scm"
     9        "NineMLcore.scm" "NineMLreal.scm" "NineMLrandom.scm"
     10        "NineMLdiagram.scm" "NineMLsignal.scm" "NineMLivp.scm"
     11        "NineMLinterval.scm" "NineMLgraph.scm"
    1012        "repr.scm" "SXML.scm" "SXML-to-XML.scm" "shell.scm" "report.scm"
    1113        "ivp-chicken.scm" "ivp-mlton.scm" "ivp-octave-mlton.scm" "ivp.scm"
     
    2628 (needs make matchable datatype static-modules (miniML 1.4) (getopt-long  1.8)
    2729        uri-generic ssax sxml-transforms sxpath object-graph format-graph
    28         mathh silex (lalr 2.4.2) setup-helper (signal-diagram 2.1) )
     30        silex (lalr 2.4.2) setup-helper mathh (signal-diagram 2.1) random-mtzig)
    2931
    3032 (author "Ivan Raikov")
  • release/4/9ML-toolkit/trunk/9ML-toolkit.scm

    r25756 r27270  
    2626         datacon
    2727         Real:module-initialize   
     28         Random:module-initialize
    2829         Signal:module-initialize   
    2930         Diagram:module-initialize 
     
    3738                (only data-structures ->string)
    3839                )
    39         (require-extension static-modules miniML miniMLsyntax miniMLvalue miniMLeval)
     40        (require-extension  static-modules miniML miniMLsyntax miniMLvalue miniMLeval)
    4041
    4142
     
    5455(include "NineMLcore.scm")
    5556(include "NineMLreal.scm")
     57(include "NineMLrandom.scm")
    5658(include "NineMLsignal.scm")
    5759(include "NineMLdiagram.scm")
  • release/4/9ML-toolkit/trunk/9ML-toolkit.setup

    r27072 r27270  
    6969
    7070       ("9ML-report"
    71         ("NineMLcore.scm" "NineMLreal.scm" "NineMLsignal.scm" "NineMLdiagram.scm" "NineMLinterval.scm"  "NineMLgraph.scm"
     71        ("NineMLcore.scm" "NineMLreal.scm" "NineMLrandom.scm" "NineMLsignal.scm" "NineMLdiagram.scm" "NineMLinterval.scm"  "NineMLgraph.scm"
    7272         "report.scm" )
    7373        (compile -O -d2 -S report.scm -o 9ML-report ))
    7474
    7575       ("9ML-ivp"
    76         ("NineMLcore.scm" "NineMLreal.scm" "NineMLsignal.scm" "NineMLdiagram.scm" "NineMLinterval.scm" "NineMLgraph.scm" "NineMLivp.scm" 
     76        ("NineMLcore.scm" "NineMLreal.scm" "NineMLrandom.scm" "NineMLsignal.scm" "NineMLdiagram.scm" "NineMLinterval.scm" "NineMLgraph.scm"
     77         "NineMLivp.scm" 
    7778         "ivp.scm" )
    7879        (compile -O -d2 -S ivp.scm -o 9ML-ivp ))
    7980
    8081       ("9ML-shell"
    81         ("NineMLcore.scm" "NineMLreal.scm" "NineMLsignal.scm" "NineMLdiagram.scm" "NineMLinterval.scm" "NineMLgraph.scm" 
     82        ("NineMLcore.scm" "NineMLreal.scm" "NineMLrandom.scm" "NineMLsignal.scm" "NineMLdiagram.scm" "NineMLinterval.scm" "NineMLgraph.scm" 
    8283         "shell.scm" )
    8384        (compile -O -d2 -S shell.scm -o 9ML-shell ))
    8485
    8586       ("9ML-ulp"
    86         ("NineMLcore.scm" "NineMLreal.scm" "NineMLsignal.scm" "NineMLdiagram.scm" "NineMLinterval.scm" "NineMLgraph.scm" 
     87        ("NineMLcore.scm" "NineMLreal.scm" "NineMLrandom.scm" "NineMLsignal.scm" "NineMLdiagram.scm" "NineMLinterval.scm" "NineMLgraph.scm" 
    8788         "ulp.scm" )
    8889        (compile -O -d2 -S ulp.scm -o 9ML-ulp ))
  • release/4/9ML-toolkit/trunk/NineMLreal.scm

    r25731 r27270  
     1(include "mathh-constants.scm")
    12
    23(define (Real:module-initialize module-name enter-module find-module eval-env)
     
    2728           (lambda (name)
    2829             (Value_sig (ident-create name)
     30                        (make-valtype '() real-type)))
     31           '("PI"))
     32
     33          (map
     34           (lambda (name)
     35             (Value_sig (ident-create name)
    2936                        (make-valtype '() (arrow-type real-type (arrow-type real-type real-type)))))
    3037           '("add" "sub" "mul" "div"))
     
    4047             (Value_sig (ident-create name)
    4148                        (make-valtype '() (arrow-type real-type real-type))))
    42            '("neg" "log" "ln" "cosh" "tanh" ))
     49           '("neg" "log" "ln" "sin" "cos" "cosh" "tanh" ))
    4350
    4451          (list (Value_sig (ident-create "toNat")
     
    5057         (append
    5158
     59          (map (lambda (x v) (Value_def (ident-create (->string x))
     60                                        (Const `(real ,v))))
     61               '(PI) `(,PI))
     62
    5263          (map (lambda (name op) (datacon 'real name 2 op))
    5364               '(add sub mul div gte lte gt lt)
     
    5566
    5667          (map (lambda (name) (datacon 'real name 1))
    57                '(log ln tanh cosh neg toNat))
     68               '(log ln sin cos tanh cosh neg toNat))
    5869         
    5970          ))
  • release/4/9ML-toolkit/trunk/eval.scm

    r27072 r27270  
    2727         traverse-definitions definition-apply
    2828         sxml-value->sexpr sexpr->function sexpr->diagram+initial
    29          sigfun-eval real-eval
     29         sigfun-eval real-eval random-eval
    3030         print-fragments
    3131         html-report
     
    3636        (require-library srfi-1 srfi-13 data-structures extras utils files irregex mathh)
    3737        (import (only srfi-1 fold combine every zip unzip2 filter-map partition delete-duplicates)
    38                 (only srfi-13 string-downcase )
     38                (only srfi-13 string-downcase string-concatenate)
    3939                (only data-structures conc compose identity atom? intersperse string-intersperse ->string )
    4040                (only extras fprintf pp)
     
    5252        (require-extension signal-diagram signal-diagram-dynamics)
    5353        (require-extension object-graph)
    54 
     54        (require-extension random-mtzig)
    5555
    5656(include "SXML.scm")
     
    5858
    5959
     60(define random-state (random-mtzig:init))
    6061
    6162(define eval-verbose (make-parameter 0))
     
    7980
    8081
     82(define (sxml-path->symbol p)
     83  (let recur ((p p) (ax '()))
     84    (case (car p)
     85      ((Pident)
     86       (let ((id (cadr p)))
     87         (let ((ax1 (cons id ax)))
     88           (string-concatenate (intersperse  (reverse ax1) "."))
     89           )))
     90      ((Pdot)
     91       (let ((name (sxml:attr p 'name)))
     92         (recur (sxml:kid p) (cons name ax))))
     93      (else (error 'sxml-path->symbol "invalid path" p))
     94      )))
     95   
     96
     97(define (sxml-term->sexpr term)
     98  (let ((tree
     99         (sxml:pre-post-order*
     100          term
     101          `(
     102            (Const . ,(lambda (tag elems)  (car elems)))
     103            (Longid . ,(lambda (tag elems) (sxml-path->symbol (car elems))))
     104            (Function *macro* . ,(lambda (tag elems)
     105                                   (let ((formal (string->symbol (sxml:attr term 'formal))))
     106                                     `(lambda (,formal) ,elems))))
     107            (Apply *macro* . ,(lambda (tag elems) elems))
     108            (Let0 *macro* . ,(lambda (tag elems)
     109                               (let ((name (sxml:attr term 'name))
     110                                     (value (sxml:kidn-cadr 'value term))
     111                                     (body (sxml:kidn-cadr 'body term)))
     112                                 `(let ((,name ,value))
     113                                    ,body))))
     114            ))))
     115    tree))
     116
     117
     118(define (sxml-eval-env->sexpr env fin)
     119  (let recur ((env env) (ax '()))
     120    (if (null? env)
     121        `(let ,ax ,fin)
     122        (let ((en (car env)))
     123          (let ((name (string->symbol (sxml:attr en 'name)))
     124                (value (sxml-value->sexpr (sxml:kid en))))
     125            (let ((en (list name value)))
     126              (recur (cdr env) (cons en ax))
     127              )))
     128        )))
     129
     130                                         
    81131(define (sxml-value->sexpr tree)
    82132    (let* ((tree
     
    84134            tree
    85135            `(
     136              (Closure *macro* .
     137                       ,(lambda (tag elems)
     138                          (let ((node (cons tag elems)))
     139                            (let ((body (sxml:kidn-cadr 'body node))
     140                                  (env  (sxml:kidn-cdr 'env node)))
     141                              (let ((term (sxml-term->sexpr body)))
     142                                (sxml-eval-env->sexpr env term)
     143                                )))
     144                          ))
     145             
    86146              (Tuple *macro* .
    87147                     ,(lambda (tag elems)
     
    89149                          (let ((left (sxml:kidn-cadr 'left node))
    90150                                (right (sxml:kidn-cdr 'right node)))
    91                             (cons left right)))))
     151                            (cons left right)))
     152                        ))
    92153             
    93154              (Const . ,(lambda (tag elems) (car elems)))
     
    258319                                 ,(recur (caddr sexpr)))))
    259320                       
    260                       ((neg log ln cosh tanh)
     321                      ((neg log ln sin cos cosh tanh)
    261322                       (let ((name (signal-op->mathml (car sexpr))))
    262323                         `(apply (,name) ,(recur (cadr sexpr)) )))
     
    532593  (if (and (pair? x) (equal? 'boolsig (car x))) (cadr x)
    533594      (error 'boolsig-value "invalid boolean signal" x)))
     595
    534596
    535597
     
    594656        (case (car sexpr)
    595657          ((real)      (recur (cdr sexpr)))
     658          ((random)    (random-eval (cdr sexpr)))
    596659          ((neg)       (let ((x (recur (cadr sexpr))))
    597660                         (- (real-eval x))))
     
    631694                        (inexact->exact (abs (round v)))))
    632695          (else (map recur sexpr))
    633               ))
     696          ))
     697    ))
     698
     699
     700(define (random-eval sexpr)
     701  (let recur ((sexpr sexpr))
     702    (if (number? sexpr) sexpr
     703        (case (car sexpr)
     704
     705          ((random)     
     706           (recur (cdr sexpr)))
     707
     708          ((uniform)     
     709           (let ((low   (real-eval (cadr sexpr)))
     710                 (high  (real-eval (caddr sexpr))))
     711             (let ((rlo (if (< low high) low high))
     712                   (rhi (if (< low high) high low)))
     713               (let ((delta (+ 1 (- rhi rlo)))
     714                     (v (random-mtzig:randu! random-state)))
     715                 (+ rlo (floor (* delta v)))
     716                 ))
     717             ))
     718
     719          ((normal)     
     720           (let ((mean   (real-eval (cadr sexpr)))
     721                 (stddev (sqrt (real-eval (caddr sexpr)))))
     722             (let ((v (random-mtzig:randn! random-state)))
     723               (+ (* v stddev) mean))))
     724
     725          ((exponential)
     726           (let ((mean   (real-eval (cadr sexpr))))
     727             (let ((v (random-mtzig:rande! random-state)))
     728               (* v mean))))
     729
     730          (else (error 'random-eval "unknown random constructor" sexpr))
     731          ))
    634732    ))
    635733
  • release/4/9ML-toolkit/trunk/ivp.scm

    r27072 r27270  
    4444(include "NineMLcore.scm")
    4545(include "NineMLreal.scm")
     46(include "NineMLrandom.scm")
    4647(include "NineMLsignal.scm")
    4748(include "NineMLdiagram.scm")
     
    350351    (for-each (lambda (init name) (init name enter-module find-module init-eval-env))
    351352              (list Real:module-initialize   
     353                    Random:module-initialize   
    352354                    Signal:module-initialize   
    353355                    Diagram:module-initialize 
     
    355357                    Graph:module-initialize
    356358                    IVP:module-initialize )
    357               (list "Real" "Signal" "Diagram" "Interval" "Graph" "IVP" )) )
     359              (list "Real" "Random" "Signal" "Diagram" "Interval" "Graph" "IVP" )) )
    358360
    359361  (if (null? operands)
  • release/4/9ML-toolkit/trunk/report.scm

    r27072 r27270  
    4343(include "NineMLcore.scm")
    4444(include "NineMLreal.scm")
     45(include "NineMLrandom.scm")
    4546(include "NineMLsignal.scm")
    4647(include "NineMLdiagram.scm")
     
    271272    (for-each (lambda (init name) (init name enter-module find-module init-eval-env))
    272273              (list Real:module-initialize   
     274                    Random:module-initialize   
    273275                    Signal:module-initialize   
    274276                    Diagram:module-initialize 
    275277                    Interval:module-initialize
    276278                    Graph:module-initialize )
    277               (list "Real" "Signal" "Diagram" "Interval" "Graph" )))
     279              (list "Real" "Random" "Signal" "Diagram" "Interval" "Graph" )))
    278280
    279281  (let ((output-type (cond ((options 'output-xml)  'xml)
  • release/4/9ML-toolkit/trunk/shell.scm

    r27072 r27270  
    3737(include "NineMLcore.scm")
    3838(include "NineMLreal.scm")
     39(include "NineMLrandom.scm")
    3940(include "NineMLsignal.scm")
    4041(include "NineMLdiagram.scm")
  • release/4/9ML-toolkit/trunk/ulp.scm

    r27072 r27270  
    5858(include "NineMLcore.scm")
    5959(include "NineMLreal.scm")
     60(include "NineMLrandom.scm")
    6061(include "NineMLsignal.scm")
    6162(include "NineMLdiagram.scm")
     
    455456    (for-each (lambda (init name) (init name enter-module find-module current-eval-env))
    456457              (list Real:module-initialize   
     458                    Random:module-initialize   
    457459                    Signal:module-initialize   
    458460                    Diagram:module-initialize 
     
    460462                    Graph:module-initialize
    461463                    IVP:module-initialize )
    462               (list "Signal" "Diagram" "Interval" "Graph" "IVP" )) )
     464              (list "Real" "Random" "Signal" "Diagram" "Interval" "Graph" "IVP" )) )
    463465
    464466  (if (null? operands)
Note: See TracChangeset for help on using the changeset viewer.