montecarlo pasted by bfig on Tue Mar 27 02:06:32 2012

(use srfi-27)
(define-syntax while 
  (syntax-rules ()
    ((while condition things ... )
     (do () ((not condition)) things ...))))
(define x 0)
(while (< x 10) (set! x (+ x 1)) (display x))
(define obra (graph ;; nodes and distributions
	      (list 
	       (T1 (uniform 32 48))
	       (T2 (uniform 40 60))
	       (T3 (uniform 15 25))
	       (T4 (uniform 10 15))
	       (T5 (uniform 10 15))
	       (T6 (uniform 6 10))
	       (T7 (uniform 18 24))
	       (T8 (uniform 4 8)))
	      (list ;; dependencies
	       (T2 . T1) 
	       (T3 . T1) (T3 . T2) 
	       (T4 . T2)
	       (T5 . T2) (T5 . T3) 
	       (T6 . T2) 
	       (T7 . T2) (T7 . T4) (T7 . T5)
	       (T8 . T4) (T8 . T5) (T8 . T6) (T8 . T7))))

(define (uniform min max)
  (+ min (* (- max min) (random-real))))
(define (graph nodedist nodedep)
  (letrec (
	   ;; nodeinit -> to init all node values on -1
	   (nodeinit  
	    (lambda (ndlst) 
	      (if (null? ndlst)
		  '()
		  (begin
		    (define (caar ndlst) -1)
		    (nodeinit (cdr ndlst))))))
	   ;; nlist -> list of nodes
	   (nlist (crnode nodedist)) 
	   ;; crnode -> node builder
	   (crnode (lambda (x) 
		     (if (null? x)
			 '()
			 (cons (caar x)
			       (crnode (cdr x))))))
	   ;; crndtaken -> find if nodes have already ben set builder
	   (crndtaken (lambda (lst)
			(and (not (= (eval (caar lst)) -1)) (crndtaken (cdr lst)))))
	   ;; nodenottaken? -> find if there are unset nodes
	   (nodenottaken? (crndtaken nodedist))
	   (compute (lambda (ndlst)
		      (if (not (null? ndlst))
			  (begin
			    (
    (begin
      (nodeinit nodedist)
      (while (nodenottaken?)
	     (compute nodelist)))

partial clean-up attempt pasted by ski on Tue Mar 27 03:28:36 2012

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

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

;; (define x 0)
;; (while (< x 10) (set! x (+ x 1)) (display x))

(define obra
  (graph
   ;; nodes and distributions
   `((T1 ,(uniform 32 48))
     (T2 ,(uniform 40 60))
     (T3 ,(uniform 15 25))
     (T4 ,(uniform 10 15))
     (T5 ,(uniform 10 15))
     (T6 ,(uniform 6 10))
     (T7 ,(uniform 18 24))
     (T8 ,(uniform 4 8)))
   ;; dependencies
   '((T2 . T1)
     (T3 . T1) (T3 . T2)
     (T4 . T2)
     (T5 . T2) (T5 . T3)
     (T6 . T2)
     (T7 . T2) (T7 . T4) (T7 . T5)
     (T8 . T4) (T8 . T5) (T8 . T6) (T8 . T7))))

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

(define (graph nodes-with-distributions node-dependencies)
  ;; crnd-taken -> find if nodes have already ben set builder
  (define (crnd-taken lst)
    (every (lambda (node)
             (not (= (eval (car node)) -1)))
           lst))
  ;; node-not-taken? -> find if there are unset nodes
  (define (node-not-taken?) (crnd-taken nodes-with-distributions))
  (define (compute ndlst)
    (if (not (null? ndlst))
        (begin
          (...))
        ...))
  ;; nlist -> list of nodes
  (define nlist (map car node-with-distributions))
  ;; init all node values on -1
  (for-each (lambda (node)
              ;; hm, probably not what you want
              (set-car! node -1))
            nodes-with-distributions)
  (while (node-not-taken?)
         (compute nodes-with-distributions)))

new and improved montecarlo! pasted by bfig on Tue Mar 27 05:44:16 2012

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

(define-syntax while 
  (syntax-rules ()
    ((while condition things ... )
     (do () ((not condition)) things ...))))
(define x 0)
(while (< x 10) (set! x (+ x 1)) (display x))
(define obra (graph 
	      '( ;; nodes and distributions
		(T1 . (uniform 32 48))
		(T2 . (uniform 40 60))
		(T3 . (uniform 15 25))
		(T4 . (uniform 10 15))
		(T5 . (uniform 10 15))
		(T6 . (uniform 6 10))
		(T7 . (uniform 18 24))
		(T8 . (uniform 4 8)))
	      '( ;; dependencies
		(T2 . (T1)) 
		(T3 . (T1 T2))
		(T4 . (T2))
		(T5 . (T2 T3))
		(T6 . (T2)) 
		(T7 . (T2 T4 T5))
		(T8 . (T4 T5 T6 T7)))))

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

(define (graph ldist ldepd)
  (begin
    ;; start -> initializes alist of (TX . -1)
    (define start (lambda (lst) (map (lambda (node) (cons (car node) -1)) lst)))     (define globassoc (start ldist))
    (letrec (
	   ;; nodesleft? -> is there any node with -1?
	   (nodesleft? (any (lambda (x) (= -1 (cdr x))) globassoc))
	   ;; dependency -> dependencies of a certain element
	   (dependency (lambda (token) (cdr (assq token ldepd))))
	   ;; need-n-ready -> items which have both all deps and need a time
	   (need-n-ready (filter (lambda (node) (and (= -1 (cdr node)) (depsolved? (car node)))) globassoc))
	   ;; computeReadyNodes -> compute nodes which have no precedence problem
	   (computeReadyNodes
	    (map (lambda (nodes) (set-cdr! nodes (eval (cdr (assq (car nodes) ldist))))) 
		 (map (lambda (ready) (assq ready globassoc)) (need-n-ready))))
	   ;;depsolved -> all dependencies already have their value != 1
	   (depsolved? (lambda (token) 
			(not (any (map (lambda (dep) 
					 (= -1 (assq dep globassoc))) 
				       (dependency token)))))))
      (begin
	(while (nodesleft?)
	       (computeReadyNodes)
	       globassoc)))))

more clean-up pasted by ski on Tue Mar 27 06:16:31 2012

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

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

;; (define x 0)
;; (while (< x 10) (set! x (+ x 1)) (display x))

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

(define obra
  (graph
   ;; 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
   '((T2 . (T1))
     (T3 . (T1 T2))
     (T4 . (T2))
     (T5 . (T2 T3))
     (T6 . (T2))
     (T7 . (T2 T4 T5))
     (T8 . (T4 T5 T6 T7)))))

(define (graph list-of-distributions list-of-dependencies)
  ;; start -> initializes alist of (TX . -1)
  (define (start lst) (map (lambda (node) (cons (car node) -1)) lst))
  (define global-association-list (start list-of-distributions))
  ;; nodes-left? -> is there any node with -1?
  (define (nodes-left?) (any (lambda (x) (= -1 (cdr x))) global-association-list))
  ;; dependencies -> dependencies of a certain element
  (define (dependencies token) (cdr (assq token list-of-dependencies)))
  ;; dep-solved? -> all dependencies already have their value != 1
  (define (dep-solved? token)
    (not (any (lambda (dep)
                (= -1 (cdr (assq dep global-association-list))))
              (dependencies token))))
  ;; need-and-ready -> items which have both all deps and need a time
  (define (need-and-ready)
    (filter (lambda (node)
              (and (= -1 (cdr node))
                   (dep-solved? (car node))))
            global-association-list))
  ;; compute-ready-nodes! -> compute nodes which have no precedence problem
  (define (compute-ready-nodes!)
    (for-each (lambda (node)
                (set-cdr! node
                          (+ ((cdr (assq (car node) list-of-distributions)))
                             something-here)))
              (need-and-ready)))
  (while (nodes-left?)
    (compute-ready-nodes!))
  global-association-list)

montecarlo for the nth time pasted by bfig on Tue Mar 27 08:40:51 2012

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

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


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

(define (graph ldist ldepd)
  (begin
    ;; ltimes -> list of times
    (define ltimes (map 
		    (lambda (node-dist) (cons (car node-dist) ((cdr node-dist)))) 
		    ldist))
    ;; start -> initializes alist of (TX . -1)
    (define start (lambda (lst) 
		    (map (lambda (node) (cons (car node) -1)) 
			 lst)))
    ;; initialize the var dictionary
    (define globassoc (start ldist))
    ;; nodesleft? -> is there any node with -1?
    (define nodesleft? (any (lambda (x) (= -1 (cdr x))) globassoc))
    ;; dependency -> dependencies of a certain element
    (define (dependency token) (cdr (assq token ldepd)))
    ;;depsolved -> all dependencies already have their value != 1
    (define (depsolved? token) 
      (not (any (lambda (dep) (= -1 (cdr (assq dep globassoc)))) 
		 (dependency token))))
    ;; need-n-ready -> items which have both all deps and need a time
    (define need-n-ready 
      (filter (lambda (node)
		(and (= -1 (cdr node)) 
		     (depsolved? (car node)))) 
	      globassoc))
    ;; computeReadyNodes -> compute nodes which have no precedence problem
    (define computeReadyNodes
      (for-each (lambda (globassocnodes) 
		  (set-cdr! globassocnodes 
			    (+ ((cdr (assq (car globassocnodes) ldist)))
			       (apply 
				max 
				(cons 0 (map 
				 (lambda (x) (cdr (assq x ltimes))) 
				 (dependency globassocnodes)))))))
    
      (need-n-ready)))
  (while (nodesleft?)
	 (computeReadyNodes)
	 globassoc)))


(define obra (graph 
	      `( ;; 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)))))

montecarlo revamp added by bfig on Tue Mar 27 09:47:27 2012

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

(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 (dependency-times node) (cons 0 (map (lambda (dependent-node) (cdr (assq dependent-node samples))) (dependencies node))))
  (define abc 
    (begin
      (define ready-list (filter (lambda (node-times) (and (= -1 (cdr node-times)) (dependencies-solved (car node-times)))) global-counter))
      (define nodesleft? (any (lambda (node-times) (= -1 (cdr node-times))) global-counter))
      (define compute-next-times (for-each (lambda (node-times) (set-cdr! node-times (+ (cdr (assq (car node-times) samples))
											(apply max (dependency-times (car node-times)))))) ready-list))
      (while (nodesleft?)
	     (compute-next-times))
      global-counter)))

(define ob1 	      `( ;; 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)))))
(define ob2 
	      '( ;; dependencies
		(T1)
		(T2 . (T1)) 
		(T3 . (T1 T2))
		(T4 . (T2))
		(T5 . (T2 T3))
		(T6 . (T2)) 
		(T7 . (T2 T4 T5))
		(T8 . (T4 T5 T6 T7))))
(define obra (dag-compute ob1 ob2))