Welcome to the CHICKEN Scheme pasting service

final montecarlo added by bfig on Tue Mar 27 11:27:06 2012

(use srfi-1)
(use srfi-27)

(define-syntax while 
  (syntax-rules ()
    ((while condition things ... )
     (do () ((not condition)) things ...))))


(define (uniform min max)
  (+ min (* (- max min) (random-real))))

(define (dag-compute list-distributions list-dependencies) 
  (define samples (map (lambda (node-distribution) (cons (car node-distribution) ((cdr node-distribution)))) list-distributions))
  (define global-counter (map (lambda (node-distribution) (cons (car node-distribution) -1)) list-distributions))
  (define (dependencies node) (cdr (assq node list-dependencies)))
  (define (dependencies-solved node) (every (lambda (dependent-node) (not (= -1 (cdr (assq dependent-node global-counter))))) (dependencies node)))
  (define (max-dependency-times node) (apply max (cons 0 (map (lambda (dependent-node) (cdr (assq dependent-node global-counter))) (dependencies node)))))
  (while (any (lambda (node-times) (= -1 (cdr node-times))) global-counter)
	 (define ready-list (filter (lambda (node-times) (and (= -1 (cdr node-times)) (dependencies-solved (car node-times)))) global-counter))
	 (define compute-next-times (for-each (lambda (node-times) (set-cdr! node-times (+ (cdr (assq (car node-times) samples))
												   (max-dependency-times (car node-times))))) ready-list))
	   compute-next-times)
  global-counter)
(define mmc-ej1
  (lambda () (begin
    (define TRIES 10000)
    (define RESULT '())
    (define start-time (current-milliseconds))
    (do ((i 0 (+ i 1))) ((= i TRIES))
      (define obra (dag-compute `( ;; nodes and distributions
				  (T1 . ,(lambda () (uniform 32 48)))
				  (T2 . ,(lambda () (uniform 40 60)))
				  (T3 . ,(lambda () (uniform 15 25)))
				  (T4 . ,(lambda () (uniform 10 15)))
				  (T5 . ,(lambda () (uniform 10 15)))
				  (T6 . ,(lambda () (uniform 6 10)))
				  (T7 . ,(lambda () (uniform 18 24)))
				  (T8 . ,(lambda () (uniform 4 8))))
				'( ;; dependencies
				  (T1)
				  (T2 . (T1)) 
				  (T3 . (T1 T2))
				  (T4 . (T2))
				  (T5 . (T2 T3))
				  (T6 . (T2)) 
				  (T7 . (T2 T4 T5))
				  (T8 . (T4 T5 T6 T7)))))
      (set! RESULT (cons (cdr (assq 'T8 obra))  RESULT)))
    (define (square x) (* x x))
    (define time-taken (- (current-milliseconds) start-time))
    (define expected-value (/ (fold + 0 RESULT) TRIES))
    (define variance (/ (fold + 0 (map (lambda (try-result) (square (- expected-value try-result))) RESULT)) (- TRIES 1)))
    (newline) (newline)
    (display "RESULT OF EXPERIMENT:") (newline)
    (display "TRIES:") (display TRIES) (newline) 
    (display "EXPECTED VALUE:") (display expected-value) (display "hs.") (newline)
    (display "VARIANCE:") (display variance) (display "hs^2.") (newline)
    (display "RUNNING TIME:") (display time-taken) (display "ms.") (newline))))

Your annotation:

Enter a new annotation:

Your nick:
The title of your paste:
Your paste (mandatory) :
What's the procedure that returns the cdr of a car?
Visually impaired? Let me spell it for you (wav file) download WAV