Welcome to the CHICKEN Scheme pasting service
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))