diff --git a/collects/mztake/demos/dijkstra/dijkstra-test-uncommented.ss b/collects/mztake/demos/dijkstra/dijkstra-test-uncommented.ss new file mode 100644 index 0000000000..fc4f621702 --- /dev/null +++ b/collects/mztake/demos/dijkstra/dijkstra-test-uncommented.ss @@ -0,0 +1,42 @@ +(require "dijkstra-solver.ss" + (lib "match.ss")) + + +(define-mztake-process p + ("dijkstra.ss") + ("heap.ss" [inserts 49 6 bind 'item] + [removes 67 10 bind 'result])) + +(define (not-in-order e) + (filter-e + (match-lambda + [('reset _) false] + [(_ 'reset) false] + [(previous current) (> previous current)] + [else false]) + (history-e 2 e))) + + +(define inserts-and-removes-e (merge-e (removes . ==> . node-weight) + (inserts . -=> . 'reset))) +(define violations (not-in-order inserts-and-removes-e)) + + +(printf-b "all inserts and removes: ~a" (history-b inserts-and-removes-e)) +(printf-b "all violations: ~a" (history-b violations)) +(printf-b "latest-violation: ~a" (hold violations)) + + +#| Implementation of the local model follows... |# +(define ((insert-in-model item) model) + (printf "~nInserting ~a into model containing:~n~a~n" item (value-now model)) + (cons item model)) + +(define ((remove-from-model item) model) + (printf "~nRemoving ~a from model containing:~n~a~n" item (value-now model)) + (filter (lambda (i) (not (equal? i item))) model)) + +(define inserters (accum-b (inserts . ==> . insert-in-model) empty)) +(define removers (accum-b (removes . ==> . remove-from-model) inserters)) + +(start/resume p) \ No newline at end of file diff --git a/collects/mztake/demos/highway/highway-test-uncommented.ss b/collects/mztake/demos/highway/highway-test-uncommented.ss new file mode 100644 index 0000000000..415ae967ad --- /dev/null +++ b/collects/mztake/demos/highway/highway-test-uncommented.ss @@ -0,0 +1,28 @@ +(require (lib "animation.ss" "frtime")) + +(define-mztake-process radar-program ("highway.ss" [values-of-speed 3 4 bind 'speed])) + + +(printf-b "current speed: ~a" (hold values-of-speed)) +(printf-b "last ten speeds: ~a" (history-b 10 values-of-speed)) + + +(map-e (lambda (a-speed) (when (>= a-speed 55) (pause radar-program))) + values-of-speed) + + +(define (make-speed-gauge speed) + (let ([center (make-posn 200 200)]) + (list (make-circle center 170 "black") + (make-circle center 160 "white") + (make-rect (make-posn 0 202) 1000 1000 "white") + (make-line (make-posn 30 201) (make-posn 370 201) "black") + (make-line center + (posn+ center (make-posn (- (* 150 (cos (/ speed 30)))) + (- (* 150 (sin (/ speed 30)))))) + "red")))) + + +(display-shapes (make-speed-gauge (hold values-of-speed))) + +(start/resume radar-program) \ No newline at end of file diff --git a/collects/mztake/demos/misc/exception-test-uncommented.ss b/collects/mztake/demos/misc/exception-test-uncommented.ss new file mode 100644 index 0000000000..ddb41c3ee1 --- /dev/null +++ b/collects/mztake/demos/misc/exception-test-uncommented.ss @@ -0,0 +1,7 @@ +(define-mztake-process p ("exception.ss")) + +(printf-b "exception.ss exited? ~a" (process:exited? p)) + +(printf-b "last exception seen: ~a" (hold (process:exceptions p))) + +(start/resume p) \ No newline at end of file diff --git a/collects/mztake/demos/misc/first-class-test-uncommented.ss b/collects/mztake/demos/misc/first-class-test-uncommented.ss new file mode 100644 index 0000000000..c86bf13425 --- /dev/null +++ b/collects/mztake/demos/misc/first-class-test-uncommented.ss @@ -0,0 +1,14 @@ +(define-mztake-process p ("first-class.ss" [x-before-let 3 29 bind 'x] + [x-in-let 4 25 bind 'x] + [x-after-let 5 11 bind 'x])) + +(printf-b "Number of times x updates, should be 12: ~a" + (count-b (merge-e x-before-let + x-in-let + x-after-let))) + +(printf-b "x before let, should be (2 4 6 7): ~a" (history-b 4 x-before-let)) +(printf-b "x in let, should be (6 10 14 16): ~a" (history-b 4 x-in-let)) +(printf-b "x after let, should be (5 9 13 15): ~a" (history-b 4 x-after-let)) + +(start/resume p) \ No newline at end of file diff --git a/collects/mztake/demos/montecarlo/montecarlo-test-uncommented.ss b/collects/mztake/demos/montecarlo/montecarlo-test-uncommented.ss new file mode 100644 index 0000000000..98daa2cb31 --- /dev/null +++ b/collects/mztake/demos/montecarlo/montecarlo-test-uncommented.ss @@ -0,0 +1,33 @@ +(require (lib "graphics.ss" "graphics")) + + +(open-graphics) +(define window (open-viewport "Debugger" 400 400)) + + +(define-mztake-process p ("montecarlo.ss" [x/y/pi-trace 13 13 bind '(x y pi)])) + + +(define x/y/pi (hold x/y/pi-trace)) + + +(define x (+ 200 (first x/y/pi))) +(define y (+ 200 (second x/y/pi))) +(define current-pi (third x/y/pi)) + + +(printf-b "total points chosen: ~a" (count-b (changes x))) +(printf-b "current computed value of pi: ~a" current-pi) +(printf-b "log error: ~a" (log (abs (- current-pi 3.141592653)))) + + +((draw-viewport window) "wheat") +((draw-solid-ellipse window) (make-posn -4 -4) 408 408 "black") +((draw-solid-ellipse window) (make-posn 0 0) 400 400 "sienna") + + +(map-e (lambda (x/y) ((draw-solid-ellipse window) (make-posn (first x/y) (second x/y)) + 3 3 "black")) + (changes (list x y))) + +(start/resume p) diff --git a/collects/mztake/demos/random/random-test-uncommented.ss b/collects/mztake/demos/random/random-test-uncommented.ss new file mode 100644 index 0000000000..65ff57b256 --- /dev/null +++ b/collects/mztake/demos/random/random-test-uncommented.ss @@ -0,0 +1,43 @@ +(require (lib "graphics.ss" "graphics") + (lifted mzscheme + make-hash-table + hash-table-put! + hash-table-get)) + + +(open-graphics) +(define window (open-viewport "Debugger" 600 500)) +((draw-viewport window) (make-rgb 0.95 0.95 0.95)) + + +(define-mztake-process p ("random.ss" [x-trace 4 6 bind 'x])) + + +(define largest-bin 0) +(define valcount (make-hash-table)) + + +(hold (x-trace . -=> .(printf-b "largest count: ~a" largest-bin))) + + +(map-e (lambda (x) + (let* ([new-cnt (add1 (hash-table-get valcount x (lambda () 0)))] + [color (/ new-cnt (add1 largest-bin))]) + + (when (= largest-bin 250) + (kill p)) + + (when (> new-cnt largest-bin) (set! largest-bin new-cnt)) + + (hash-table-put! valcount x new-cnt) + + ((draw-solid-rectangle window) (make-posn (* x 6) (- 500 (* 2 new-cnt))) + 6 10 ;; width height + (make-rgb 0 (* 0.75 color) color)))) + x-trace) + + +(printf-b "count: ~a" (count-b x-trace)) + + +(start/resume p) \ No newline at end of file diff --git a/collects/mztake/demos/sine/sine-test-uncommented.ss b/collects/mztake/demos/sine/sine-test-uncommented.ss new file mode 100644 index 0000000000..f79692374a --- /dev/null +++ b/collects/mztake/demos/sine/sine-test-uncommented.ss @@ -0,0 +1,41 @@ +(require (lib "animation.ss" "frtime")) + + +(define-mztake-process p ("sine.ss" [x/sinx-trace 5 8 bind '(x sin-x)])) + + +(define x/sinx (hold x/sinx-trace)) + + +(define x (first x/sinx)) +(define sin-x (second x/sinx)) + + +(printf-b "x: ~a" x) +(printf-b "sin(x/20): ~a" sin-x) + + +(printf-b "largest x: ~a sin(x/20): ~a" + (largest-val-b (changes (first x/sinx))) + (largest-val-b (changes (second x/sinx)))) + +(printf-b "smallest x:~a sin(x/20):~a" + (smallest-val-b (changes (first x/sinx))) + (smallest-val-b (changes (second x/sinx)))) + + +(display-shapes + (list* (make-line (make-posn 0 200) (make-posn 400 200) "gray") + (make-line (make-posn 200 0) (make-posn 200 400) "gray") + + (let ([x (+ 200 x)] + [sin-x (+ 200 (* 100 sin-x))]) + (history-b 50 (changes (make-circle + (make-posn x sin-x) + 5 + (if (< 200 sin-x) + (if (< 200 x) "blue" "darkblue") #| Quadrants 3 and 4 |# + (if (< 200 x) "red" "darkred")))))))) #| 1 and 2 |# + + +(start/resume p) \ No newline at end of file