uncommented versions of demos

svn: r168

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)

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)

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)

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)

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)

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)

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)