((section 2 "Outdated egg!" (p "This is an egg for CHICKEN 4, the unsupported old release.  You're almost certainly looking for " (int-link "/eggref/5/aima" "the CHICKEN 5 version of this egg") ", if it exists.") (p "If it does not exist, there may be equivalent functionality provided by another egg; have a look at the " (link "https://wiki.call-cc.org/chicken-projects/egg-index-5.html" "egg index") ". Otherwise, please consider porting this egg to the current version of CHICKEN.")) (section 2 "aima" (p "Support for Russell-Norvig's AIMA") (toc) (section 3 "AIMA" (section 4 (tt "aima") (p (b "[module]") " " (tt "aima")) (p "AIMA contains functions common to agents and environments.") (ul (li (int-link "#compose-environments" "compose-environments")) (li (int-link "#debug?" "debug?")) (li (int-link "#debug-print" "debug-print")) (li (int-link "#default-steps" "default-steps")) (li (int-link "#define-record-and-printer" "define-record-and-printer")) (li (int-link "#make-debug-environment" "make-debug-environment")) (li (int-link "#make-step-limited-environment" "make-step-limited-environment")) (li (int-link "#make-performance-measuring-environment" "make-performance-measuring-environment")) (li (int-link "#random-seed" "random-seed")) (li (int-link "#randomize!" "randomize!")) (li (int-link "#simulate" "simulate")))) (section 4 (tt "define-record-and-printer") (def (sig (syntax "(define-record-and-printer) → unspecified" (id define-record-and-printer))) (p "Define both a record type and a vector-form printer.") (highlight scheme "(define-syntax\n  define-record-and-printer\n  (lambda (expression rename compare)\n    (match expression\n           ((_ record . fields)\n            (let ((%define-record (rename 'define-record))\n                  (%define-record-printer (rename 'define-record-printer))\n                  (%begin (rename 'begin))\n                  (%lambda (rename 'lambda))\n                  (%write (rename 'write))\n                  (%record->vector (rename 'record->vector)))\n              `(,%begin\n                (,%define-record ,record ,@fields)\n                (,%define-record-printer\n                 ,record\n                 (,%lambda\n                  (record out)\n                  (,%write (,%record->vector record) out)))))))))"))) (section 4 (tt "debug?") (def (sig (parameter "debug? → #t" (id debug?))) (p "Should we print debugging information to stdout?") (highlight scheme "(define debug? (make-parameter #t))"))) (section 4 (tt "debug-print") (def (sig (procedure "(debug-print key value) → unspecified" (id debug-print)) (procedure "(debug-print key value out) → unspecified" (id debug-print))) (p "Print key-value pairs if the parameter `debug?' is true.") (dl (dt (tt "key")) (dd "The key to print") (dt (tt "value")) (dd "The value to print") (dt (tt "out")) (dd "The port to print to")) (highlight scheme "(define debug-print\n  (case-lambda\n    ((key value) (debug-print key value #t))\n    ((key value out) (if (debug?) (format out \"~a: ~a~%\" key value)))))"))) (section 4 (tt "random-seed") (def (sig (parameter "random-seed → #f" (id random-seed))) (p "`random-seed' is passed to `randomize!' during `simulate'.") (highlight scheme "(define random-seed (make-parameter #f))"))) (section 4 (tt "randomize!") (def (sig (parameter "randomize! → randomize" (id randomize!))) (p "`randomize!' is called before simulation and is seeded with `random-seed'.") (highlight scheme "(define randomize! (make-parameter randomize))"))) (section 4 (tt "simulate") (def (sig (procedure "(simulate environment) → #f" (id simulate)) (procedure "(simulate environment randomize! random-seed) → #f" (id simulate))) (p "Run an environment to completion; an environment is complete when it returns false.") (dl (dt (tt "environment")) (dd "The environment to simulate") (dt (tt "randomize!")) (dd "Function to seed the random-number generator for reproducible results") (dt (tt "random-seed")) (dd "Seed to seed the random-number generator")) (highlight scheme "(define simulate\n  (case-lambda\n    ((environment) (simulate environment (randomize!) (random-seed)))\n    ((environment randomize! random-seed)\n     (if random-seed (randomize! random-seed))\n     (loop ((while (environment)))))))"))) (section 4 (tt "compose-environments") (def (sig (procedure "(compose-environments . environments) → environment" (id compose-environments))) (p "Compose environments into a single environment suitable for `simulate'.") (p "`compose-environments' effectively `ands' over its constituent environments every step.") (dl (dt (tt "environments")) (dd "The environments to be composed")) (highlight scheme "(define (compose-environments . environments)\n  (lambda ()\n    (every identity (map (lambda (environment) (environment)) environments))))"))) (section 4 (tt "make-performance-measuring-environment") (def (sig (procedure "(make-performance-measuring-environment measure-performance score-update!) → environment" (id make-performance-measuring-environment))) (p "Make an environment that updates a score according to a performance measure.") (dl (dt (tt "measure-performance")) (dd "A nullary procedure which measures performance") (dt (tt "score-update!")) (dd "A function which receives the performance measure and updates the score accordingly")) (highlight scheme "(define (make-performance-measuring-environment\n         measure-performance\n         score-update!)\n  (lambda () (score-update! (measure-performance))))"))) (section 4 (tt "default-steps") (def (sig (parameter "default-steps → 1000" (id default-steps))) (p "Default number of steps for the step-limited environment") (highlight scheme "(define default-steps (make-parameter 1000))"))) (section 4 (tt "make-step-limited-environment") (def (sig (procedure "(make-step-limited-environment) → environment" (id make-step-limited-environment)) (procedure "(make-step-limited-environment steps) → environment" (id make-step-limited-environment))) (p "Make an environment that stops simulation after a certain number of steps.") (dl (dt (tt "steps")) (dd "The number of steps after which to stop simulating")) (highlight scheme "(define make-step-limited-environment\n  (case-lambda\n    (() (make-step-limited-environment (default-steps)))\n    ((steps)\n     (let ((current-step 0))\n       (lambda ()\n         (set! current-step (+ current-step 1))\n         (< current-step steps))))))"))) (section 4 (tt "make-debug-environment") (def (sig (syntax "(make-debug-environment object make-printable-object) → environment" (id make-debug-environment))) (p "Make an environment that prints debugging information (according to `debug?').") (dl (dt (tt "object")) (dd "The object to debug") (dt (tt "make-printable-object")) (dd "A function which optionally transforms the object before printing")) (highlight scheme "(define-syntax\n  make-debug-environment\n  (er-macro-transformer\n    (lambda (expression rename compare)\n      (let ((%print (rename 'debug-print)))\n        (match expression\n               ((_ object) `(lambda () (,%print ',object ,object)))\n               ((_ object make-printable-object)\n                `(lambda ()\n                   (,%print ',object (,make-printable-object ,object)))))))))")))) (section 3 "AIMA-CSP" (section 4 (tt "aima-csp") (p (b "[module]") " " (tt "aima-csp")) (p "Solver for constraint-satisfaction-problems") (ul (li (int-link "#ac-3" "ac-3")) (li (int-link "#backtracking-search" "backtracking-search")) (li (int-link "#backtracking-enumeration" "backtracking-enumeration")) (li (int-link "#consistent?" "consistent?")) (li (int-link "#csp-constraints" "csp-constraints")) (li (int-link "#csp-copy" "csp-copy")) (li (int-link "#csp-domains" "csp-domains")) (li (int-link "#csp-neighbors" "csp-neighbors")) (li (int-link "#display-map-as-png" "display-map-as-png")) (li (int-link "#failure" "failure")) (li (int-link "#failure?" "failure?")) (li (int-link "#inference" "inference")) (li (int-link "#make-csp" "make-csp")) (li (int-link "#neq?" "neq?")) (li (int-link "#random-map" "random-map")) (li (int-link "#set-alldiff-constraints!" "set-alldiff-constraints!")) (li (int-link "#set-bidirectional-constraint!" "set-bidirectional-constraint!")) (li (int-link "#set-pairwise-bidirectional-constraints!" "set-pairwise-bidirectional-constraints!")) (li (int-link "#set-pairwise-constraints!" "set-pairwise-constraints!")) (li (int-link "#set-domains!" "set-domains!")) (li (int-link "#shuffle" "shuffle")) (li (int-link "#success?" "success?")) (li (int-link "#write-map-as-dot" "write-map-as-dot")) (li (int-link "#write-map-as-png" "write-map-as-png")) (li (int-link "#xor" "xor")))) (section 4 (tt "failure") (def (sig (constant "failure → (make-failure)" (id failure))) (p "The failure object: to distinguish " (i "bona-fide") " solutions to a CSP that are " (tt "#f") ".") (highlight scheme "(define failure (make-failure))"))) (section 4 (tt "success?") (def (sig (procedure "(success? result) → boolean" (id success?))) (p "Success is defined negatively as the absence of failure.") (dl (dt (tt "result")) (dd "The result to test")) (highlight scheme "(define success? (complement failure?))"))) (section 4 (tt "csp") (def (sig (record "csp" (id csp))) (p "A constraint-satisfaction-problem") (dl (dt (tt "domains")) (dd "A hash-table mapping variables to possible values") (dt (tt "constraints")) (dd "A hash-table mapping pairs of variables to a dyadic lambda which returns " (tt "#f") " if the values don't satisfy the constraint") (dt (tt "neighbors")) (dd "A hash-table adjacency-list of constraints")) (highlight scheme "(define-record-and-printer csp domains constraints neighbors)")) (section 5 "Examples" (p "A trivial (but inconsistent) CSP") (pre "(define arc-inconsistent-coloring\n  (make-csp (alist->hash-table '((a white) (b white)))\n            (alist->hash-table\n             `(((a . b) unquote neq?) ((b . a) unquote neq?)))\n            (alist->hash-table '((a b) (b a)))))\n => #<unspecified>\n"))) (section 4 (tt "backtracking-search") (def (sig (procedure "(backtracking-search csp) → object or {{failure}}" (id backtracking-search))) (p "Find a solution to the CSP or return " (tt "failure") ".") (dl (dt (tt "csp")) (dd "The CSP to solve")) (highlight scheme "(define (backtracking-search csp)\n  (let ((enumeration (backtracking-enumeration 1 csp)))\n    (if (null? enumeration) failure (car enumeration))))")) (section 5 "Examples" (p "A trivial 2-coloring problem") (pre "(define arc-consistent-coloring\n  (make-csp (alist->hash-table '((a white black) (b white black)))\n            (alist->hash-table\n             `(((a . b) unquote neq?) ((b . a) unquote neq?)))\n            (alist->hash-table '((a b) (b a)))))\n => #<unspecified>\n\n(hash-table->alist (backtracking-search arc-consistent-coloring))\n => ((a . white) (b . black))\n"))) (section 4 (tt "backtracking-enumeration") (def (sig (procedure "(backtracking-enumeration csp) → list" (id backtracking-enumeration)) (procedure "(backtracking-enumeration n csp) → list" (id backtracking-enumeration)) (procedure "(backtracking-enumeration csp cons nil stop?) → list" (id backtracking-enumeration))) (p "Enumerate up to " (tt "n") " solutions of the " (tt "csp") "; enumerate all if " (tt "n") " is " (tt "#f") " or unspecified.") (dl (dt (tt "n")) (dd "Enumerate up to " (tt "n") " solutions") (dt (tt "csp")) (dd "The CSP to solve") (dt (tt "cons")) (dd "How to construct enumerations (" (tt "cons") " by default)") (dt (tt "nil")) (dd "Base enumeration (" (tt "()") " by default)") (dt (tt "stop?")) (dd "Unary function taking the current enumeration: " (tt "#t") " stops, " (tt "#f") " continues; by default, compares " (tt "n") " to the length of the current enumeration.")) (highlight scheme "(define backtracking-enumeration\n  (case-lambda\n    ((csp) (backtracking-enumeration #f csp))\n    ((n csp)\n     (backtracking-enumeration\n       csp\n       cons\n       '()\n       (lambda (enumeration) (and n (= (length enumeration) n)))))\n    ((csp cons nil stop?)\n     (let ((enumeration (make-parameter nil)))\n       (backtrack-enumerate enumeration (make-assignment csp) csp cons stop?)\n       (enumeration)))))"))) (section 4 (tt "ac-3") (def (sig (procedure "(ac-3 csp) → boolean" (id ac-3))) (p "Check arc-consistency of a csp; returns " (tt "#t") " if the object is arc-consistent.") (dl (dt (tt "csp")) (dd "A constraint-satisfaction object")) (highlight scheme "(define (ac-3 csp)\n  (let ((queue (list->queue (hash-table-keys (csp-constraints csp)))))\n    (let iter ()\n      (if (queue-empty? queue)\n        #t\n        (match (queue-remove! queue)\n               ((x . y)\n                (if (revise csp x y)\n                  (if (zero? (length (hash-table-ref (csp-domains csp) x)))\n                    #f\n                    (begin\n                      (for-each\n                        (lambda (neighbor)\n                          (queue-add! queue (cons neighbor x)))\n                        (delete y (hash-table-ref (csp-neighbors csp) x)))\n                      (iter)))\n                  (iter))))))))"))) (section 4 (tt "xor") (def (sig (syntax "(xor x y) → boolean" (id xor))) (p "Logical xor: whether one or the other proposition is true (but not both)") (dl (dt (tt "x")) (dd "A proposition") (dt (tt "y")) (dd "Another proposition")) (highlight scheme "(define-syntax\n  xor\n  (lambda (expression rename compare)\n    (match expression\n           ((_ x y)\n            (let ((%or (rename 'or)) (%and (rename 'and)) (%not (rename 'not)))\n              `(,%and (,%or ,x ,y) (,%not (,%and ,x ,y))))))))"))) (section 4 (tt "neq?") (def (sig (procedure "(neq? x y) → boolean" (id neq?))) (p "The complement to " (tt "eq?")) (dl (dt (tt "x")) (dd "Comparandum") (dt (tt "y")) (dd "Comparator")) (highlight scheme "(define neq? (complement eq?))"))) (section 4 (tt "random-map") (def (sig (procedure "(random-map n) → hash-table" (id random-map))) (p "Create a random k-coloring problem; returns an adjacency-list of nodes as a hash-table.") (dl (dt (tt "n")) (dd "The number of nodes in the problem")) (highlight scheme "(define (random-map n)\n  (let ((random-points (random-points n)) (connections (make-hash-table)))\n    (let iter-point ((points random-points) (modified? #f))\n      (if (null? points)\n        (if modified? (iter-point (shuffle random-points) #f) connections)\n        (let ((point (car points)))\n          (let iter-counter-point ((counter-points\n                                     (sort-by-proximity\n                                       point\n                                       (delete point random-points))))\n            (if (null? counter-points)\n              (iter-point (cdr points) modified?)\n              (let ((counter-point (car counter-points)))\n                (if (member\n                      point\n                      (hash-table-ref/default connections counter-point '()))\n                  (iter-counter-point (cdr counter-points))\n                  (if (intersects-other? connections point counter-point)\n                    (iter-counter-point (cdr counter-points))\n                    (begin\n                      (hash-table-update!/default\n                        connections\n                        point\n                        (lambda (counter-points)\n                          (lset-adjoin eq? counter-points counter-point))\n                        '())\n                      (hash-table-update!/default\n                        connections\n                        counter-point\n                        (lambda (points) (lset-adjoin eq? points point))\n                        '())\n                      (iter-point (cdr points) #t))))))))))))"))) (section 4 (tt "shuffle") (def (sig (procedure "(shuffle list) → list" (id shuffle))) (p "Shuffle a list.") (dl (dt (tt "list")) (dd "The list to shuffle")) (highlight scheme "(define (shuffle list)\n  (let ((vector (list->vector list))) (shuffle! vector) (vector->list vector)))")))) (section 3 "AIMA-Tessellation" (section 4 (tt "aima-tessellation") (p (b "[module]") " " (tt "aima-tessellation")) (p "aima-tessellation has procedures for tessellating a plane into disjoint, convex polygons suitable for exercise 3.7; and then plotting that tessellation with a path.") (ul (li (int-link "#join-animations" "join-animations")) (li (int-link "#make-point" "make-point")) (li (int-link "#make-node" "make-node")) (li (int-link "#n-vertices" "n-vertices")) (li (int-link "#node-state" "node-state")) (li (int-link "#node-state-set!" "node-state-set!")) (li (int-link "#node-parent" "node-parent")) (li (int-link "#node-parent-set!" "node-parent-set!")) (li (int-link "#node-action" "node-action")) (li (int-link "#node-action-set!" "node-action-set!")) (li (int-link "#node-path-cost" "node-path-cost")) (li (int-link "#node-path-cost-set!" "node-path-cost-set!")) (li (int-link "#point-distance" "point-distance")) (li (int-link "#plot-tessellation" "plot-tessellation")) (li (int-link "#plot-tessellation/animation" "plot-tessellation/animation")) (li (int-link "#point-x" "point-x")) (li (int-link "#point-y" "point-y")) (li (int-link "#predecessor-path" "predecessor-path")) (li (int-link "#tessellate" "tessellate")) (li (int-link "#tessellation-points" "tessellation-points")) (li (int-link "#tessellation-neighbors" "tessellation-neighbors")) (li (int-link "#tessellation-start" "tessellation-start")) (li (int-link "#tessellation-end" "tessellation-end")))) (section 4 (tt "node") (def (sig (record "node" (id node))) (p "Data structure for graphs") (dl (dt (tt "state")) (dd "An indexable point") (dt (tt "parent")) (dd "The node-predecessor") (dt (tt "action")) (dd "Not used") (dt (tt "path-cost")) (dd "Cost of the path up to this point")) (highlight scheme "(define-record node state parent action path-cost)"))) (section 4 (tt "tessellation") (def (sig (record "tessellation" (id tessellation))) (p "tessellation contains point and adjacency information for a tessellated-plane; as well as start and end nodes.") (dl (dt (tt "points")) (dd "The points in the tessellation") (dt (tt "neighbors")) (dd "The adjacency information for points") (dt (tt "start")) (dd "The start node for the problem") (dt (tt "end")) (dd "The end node for the problem")) (highlight scheme "(define-record-and-printer tessellation R-object points neighbors start end)"))) (section 4 (tt "tessellate") (def (sig (procedure "(tessellate) → tessellation" (id tessellate)) (procedure "(tessellate n-vertices) → tessellation" (id tessellate))) (p "Tessellate the plane into disjoint, convex polygons.") (dl (dt (tt "n-vertices")) (dd "The numbers of vertices in the tessellation")) (highlight scheme "(define tessellate\n  (case-lambda\n    (() (tessellate (n-vertices)))\n    ((n-vertices)\n     (let* ((R-voronoi (R-voronoi n-vertices)) (voronoi (voronoi R-voronoi)))\n       (let* ((neighbors (neighbors voronoi)) (points (points neighbors)))\n         (let ((start (start points)) (end (end points)))\n           (make-tessellation R-voronoi points neighbors start end)))))))"))) (section 4 (tt "point-distance") (def (sig (procedure "(point-distance p1 p2) → distance" (id point-distance))) (p "Calculate the distance between two points.") (dl (dt (tt "p1")) (dd "The first point") (dt (tt "p2")) (dd "The second point")) (highlight scheme "(define (point-distance p1 p2)\n  (sqrt (+ (expt (- (point-x p1) (point-x p2)) 2)\n           (expt (- (point-y p1) (point-y p2)) 2))))"))) (section 4 (tt "predecessor-path") (def (sig (procedure "(predecessor-path node) → list" (id predecessor-path))) (p "List the predecessors of this node.") (dl (dt (tt "node")) (dd "The node to predecess")) (highlight scheme "(define (predecessor-path node)\n  (let iter ((path (list node)))\n    (let ((parent (node-parent (car path))))\n      (if parent (iter (cons parent path)) path))))"))) (section 4 (tt "plot-tessellation") (def (sig (procedure "(plot-tessellation tessellation path title filename) → unspecified" (id plot-tessellation))) (p "Plot the tessellation with its start and end nodes, as well as the path taken from start to end.") (dl (dt (tt "tessellation")) (dd "The tessellation to plot") (dt (tt "path")) (dd "A list of nodes") (dt (tt "title")) (dd "Title for the graph") (dt (tt "filename")) (dd "The PNG to which to write")) (highlight scheme "(define (plot-tessellation tessellation path title filename)\n  (let ((title (make-title title (length path) (node-path-cost (car path)))))\n    (let ((start (tessellation-start tessellation))\n          (end (tessellation-end tessellation)))\n      (R (plot.voronoi\n           ,(tessellation-R-object tessellation)\n           ,(list->vector (path-x path))\n           ,(list->vector (path-y path))\n           ,(point-x start)\n           ,(point-y start)\n           ,(point-x end)\n           ,(point-y end)\n           ,filename\n           ,title)))))"))) (section 4 (tt "plot-tessellation/animation") (def (sig (procedure "(plot-tessellation/animation tessellation path title filename) → unspecified" (id plot-tessellation/animation))) (p "Plot the tessellation as an animation fit for YouTube.") (dl (dt (tt "tessellation")) (dd "The tessellation to plot") (dt (tt "path")) (dd "A list of nodes") (dt (tt "title")) (dd "Title for the animation") (dt (tt "filename")) (dd "A filename for the movie (ending in e.g. `.avi')")) (highlight scheme "(define (plot-tessellation/animation tessellation path title filename)\n  (let ((directory (create-temporary-directory)))\n    (let iter ((path path) (i (- (length path) 1)))\n      (if (null? path)\n        (let* ((frames\n                 (cdr (sort (glob (make-pathname directory \"*\")) string<?)))\n               (final-frame (last frames))\n               (epilogue (make-list 10 final-frame)))\n          (let ((frame-list (create-temporary-file)))\n            (with-output-to-file\n              frame-list\n              (lambda () (for-each write-line (append frames epilogue))))\n            (run (mencoder\n                   ,(format \"mf://@~a\" frame-list)\n                   -mf\n                   fps=4\n                   -o\n                   ,filename\n                   -ovc\n                   lavc))))\n        (let ((filename (animation-filename directory i)))\n          (format #t \"~a~%\" filename)\n          (plot-tessellation tessellation path title filename)\n          (iter (cdr path) (- i 1)))))))"))) (section 4 (tt "join-animations") (def (sig (procedure "(join-animations output . animations) → unspecified" (id join-animations))) (p "Join the animation files into one long file.") (dl (dt (tt "output")) (dd "The resultant file") (dt (tt "animations")) (dd "The input files")) (highlight scheme "(define (join-animations output . animations)\n  (run (mencoder -ovc copy -idx -o ,output ,@animations)))")))) (section 3 "AIMA-Vacuum" (section 4 (tt "aima-vacuum") (p (b "[module]") " " (tt "aima-vacuum")) (p "`aima-vacuum' has agents and environments for chapter 2: Intelligent Agents.") (ul (li (int-link "#agent-score" "agent-score")) (li (int-link "#agent-score-set!" "agent-score-set!")) (li (int-link "#agent-location" "agent-location")) (li (int-link "#agent-location-set!" "agent-location-set!")) (li (int-link "#agent-program" "agent-program")) (li (int-link "#agent-program-set!" "agent-program-set!")) (li (int-link "#clean" "clean")) (li (int-link "#clean?" "clean?")) (li (int-link "#compare-graphs" "compare-graphs")) (li (int-link "#copy-world" "copy-world")) (li (int-link "#cycle" "cycle")) (li (int-link "#cycle?" "cycle?")) (li (int-link "#connect!" "connect!")) (li (int-link "#default-n-nodes" "default-n-nodes")) (li (int-link "#direction->move" "direction->move")) (li (int-link "#dirty" "dirty")) (li (int-link "#dirty?" "dirty?")) (li (int-link "#display-world" "display-world")) (li (int-link "#display-pdf" "display-pdf")) (li (int-link "#down" "down")) (li (int-link "#down?" "down?")) (li (int-link "#left" "left")) (li (int-link "#left?" "left?")) (li (int-link "#location-status" "location-status")) (li (int-link "#location-status-set!" "location-status-set!")) (li (int-link "#location-neighbors" "location-neighbors")) (li (int-link "#location-neighbors-set!" "location-neighbors-set!")) (li (int-link "#make-agent" "make-agent")) (li (int-link "#make-graph" "make-graph")) (li (int-link "#make-graph-world" "make-graph-world")) (li (int-link "#make-linear-world" "make-linear-world")) (li (int-link "#make-location" "make-location")) (li (int-link "#make-node" "make-node")) (li (int-link "#make-performance-measure" "make-performance-measure")) (li (int-link "#make-preferential-depth-first-world" "make-preferential-depth-first-world")) (li (int-link "#make-randomized-graph-agent" "make-randomized-graph-agent")) (li (int-link "#make-reflex-agent" "make-reflex-agent")) (li (int-link "#make-simple-reflex-agent" "make-simple-reflex-agent")) (li (int-link "#make-stateful-reflex-agent" "make-stateful-reflex-agent")) (li (int-link "#make-stateful-graph-agent" "make-stateful-graph-agent")) (li (int-link "#make-score-update!" "make-score-update!")) (li (int-link "#make-unknown-location" "make-unknown-location")) (li (int-link "#make-world" "make-world")) (li (int-link "#move->direction" "move->direction")) (li (int-link "#random-start" "random-start")) (li (int-link "#reverse-move" "reverse-move")) (li (int-link "#right" "right")) (li (int-link "#right?" "right?")) (li (int-link "#simulate-graph" "simulate-graph")) (li (int-link "#simulate-graph/animation" "simulate-graph/animation")) (li (int-link "#simulate-penalizing-vacuum" "simulate-penalizing-vacuum")) (li (int-link "#simulate-vacuum" "simulate-vacuum")) (li (int-link "#unknown" "unknown")) (li (int-link "#unknown?" "unknown?")) (li (int-link "#up" "up")) (li (int-link "#up?" "up?")) (li (int-link "#world-location" "world-location")) (li (int-link "#world-location-set!" "world-location-set!")) (li (int-link "#write-world-as-pdf" "write-world-as-pdf")) (li (int-link "#write-world-as-dot" "write-world-as-dot")) (li (int-link "#write-world-as-gif" "write-world-as-gif")))) (section 4 "Two-square vacuum-world" (section 5 (tt "display-world") (def (sig (procedure "(display-world world) → unspecified" (id display-world))) (p "Display the two-square vacuum world as a vector.") (dl (dt (tt "world")) (dd "The two-square vacuum world to be displayed")) (highlight scheme "(define (display-world world)\n  (pp (vector-append\n        '#(world)\n        (vector-map\n          (lambda (i location) (if (clean? location) 'clean 'dirty))\n          world))))"))) (section 5 (tt "clean") (def (sig (constant "clean → (make-clean)" (id clean))) (p "A clean square") (highlight scheme "(define clean (make-clean))"))) (section 5 (tt "dirty") (def (sig (constant "dirty → (make-dirty)" (id dirty))) (p "A dirty square") (highlight scheme "(define dirty (make-dirty))"))) (section 5 (tt "unknown") (def (sig (constant "unknown → (make-unknown)" (id unknown))) (p "An unknown square (either clean or dirty)") (highlight scheme "(define unknown (make-unknown))"))) (section 5 (tt "left") (def (sig (constant "left → 0" (id left))) (p "Index of the left square") (highlight scheme "(define left 0)"))) (section 5 (tt "left?") (def (sig (procedure "(left? square) → true if it is the left square" (id left?))) (p "Is this the left square?") (dl (dt (tt "square")) (dd "The square to be lefted")) (highlight scheme "(define left? zero?)"))) (section 5 (tt "right") (def (sig (constant "right → 1" (id right))) (p "Index of the right square") (highlight scheme "(define right 1)"))) (section 5 (tt "right?") (def (sig (procedure "(right? square) → true if it is the right square" (id right?))) (p "Is this the right square?") (dl (dt (tt "square")) (dd "The square to be righted")) (highlight scheme "(define right? (cute = <> 1))"))) (section 5 (tt "make-world") (def (sig (procedure "(make-world left right) → a two-square vacuum world" (id make-world))) (p "Make a two-square vacuum-world.") (dl (dt (tt "left")) (dd "State of the left square (clean or dirty)") (dt (tt "right")) (dd "State of the left square (clean or dirty)")) (highlight scheme "(define make-world vector)"))) (section 5 (tt "world-location") (def (sig (procedure "(world-location square) → the square-status" (id world-location))) (p "Get a square-status (dirty, clean, unknown, &c.) from the two-square vacuum-world.") (dl (dt (tt "square")) (dd "The square's index (`left' or `right')")) (highlight scheme "(define world-location vector-ref)"))) (section 5 (tt "world-location-set!") (def (sig (procedure "(world-location-set! square status) → unspecified" (id world-location-set!))) (p "Set the status of a square to dirty, clean, unknown, &c.") (dl (dt (tt "square")) (dd "The square to be set") (dt (tt "status")) (dd "The status to set it to")) (highlight scheme "(define world-location-set! vector-set!)"))) (section 5 (tt "agent") (def (sig (record "agent" (id agent))) (p "The fundamental agent-record") (dl (dt (tt "location")) (dd "Where the agent is located") (dt (tt "score")) (dd "The agent's score at a given time") (dt (tt "program")) (dd "The agent's program: an n-ary procedure where each argument corresponds to a sensor; what is received by the sensors depends on the environments contract with its agents.")) (highlight scheme "(define-record agent location score program)"))) (section 5 (tt "simple-agent-program") (def (sig (procedure "(simple-agent-program location clean?) → one of 'left, 'right, 'suck, 'noop" (id simple-agent-program))) (p "Example of a simple two-square vacuum-agent that merely responds to its percept.") (dl (dt (tt "location")) (dd "The location of the agent") (dt (tt "clean?")) (dd "Whether or not this square is clean")) (highlight scheme "(define (simple-agent-program location clean?)\n  (if clean? (if (left? location) 'right 'left) 'suck))"))) (section 5 (tt "make-stateful-agent-program") (def (sig (procedure "(make-stateful-agent-program) → stateful agent program" (id make-stateful-agent-program))) (p "Make an agent program that models the two-square vacuum-world, and stops cleaning.") (highlight scheme "(define (make-stateful-agent-program)\n  (let ((world (make-world unknown unknown)))\n    (lambda (location clean?)\n      (if clean?\n        (begin\n          (vector-set! world location clean)\n          (if (all-clean? world) 'noop (if (right? location) 'left 'right)))\n        'suck))))"))) (section 5 (tt "make-reflex-agent") (def (sig (procedure "(make-reflex-agent location) → unspecified" (id make-reflex-agent)) (procedure "(make-reflex-agent location program) → unspecified" (id make-reflex-agent))) (p "Make a stateless agent that merely responds to its current percept.") (dl (dt (tt "location")) (dd "Where does the agent start? `left' or `right'") (dt (tt "program")) (dd "The agent's program; should be a binary procedure that takes a location and whether that location is clean. See `simple-agent-program'.")) (highlight scheme "(define make-reflex-agent\n  (case-lambda\n    ((location) (make-reflex-agent location (default-agent-program)))\n    ((location program) (make-agent location 0 program))))"))) (section 5 (tt "make-simple-reflex-agent") (def (sig (procedure "(make-simple-reflex-agent location) → a simple reflex agent" (id make-simple-reflex-agent))) (p "Make a simple reflex agent and place it in the given location.") (dl (dt (tt "location")) (dd "Where to place the agent: `left' or `right'")) (highlight scheme "(define (make-simple-reflex-agent location)\n  (make-reflex-agent location simple-agent-program))"))) (section 5 (tt "make-stateful-reflex-agent") (def (sig (procedure "(make-stateful-reflex-agent location) → a stateful reflex agent" (id make-stateful-reflex-agent))) (p "Make a stateful reflex agent and place it in the given location.") (dl (dt (tt "location")) (dd "Where to place the agent: `left' or `right'")) (highlight scheme "(define (make-stateful-reflex-agent location)\n  (make-reflex-agent location (make-stateful-agent-program)))"))) (section 5 (tt "make-performance-measure") (def (sig (procedure "(make-performance-measure world) → environment" (id make-performance-measure))) (p "Make a performance measure that awards one point for every clean square.") (highlight scheme "(define (make-performance-measure world)\n  (lambda () (vector-count (lambda (i square) (clean? square)) world)))"))) (section 5 (tt "make-score-update!") (def (sig (procedure "(make-score-update! agent) → a monadic procedure that takes the score to add" (id make-score-update!))) (p "Make a score-updater that adds score to the score of an agent.") (dl (dt (tt "agent")) (dd "The agent whose score to add to")) (highlight scheme "(define (make-score-update! agent)\n  (lambda (score) (agent-score-set! agent (+ (agent-score agent) score))))"))) (section 5 (tt "simulate-vacuum") (def (sig (procedure "(simulate-vacuum world agent) → the agent-score" (id simulate-vacuum)) (procedure "(simulate-vacuum world agent steps) → the agent-score" (id simulate-vacuum)) (procedure "(simulate-vacuum world agent steps make-environment) → the agent-score" (id simulate-vacuum))) (p "Simulate the two-square vacuum-world.") (dl (dt (tt "world")) (dd "The two-square vacuum world (see `make-world')") (dt (tt "agent")) (dd "The agent to inhabit the world") (dt (tt "steps")) (dd "The number of steps to simulate (default: 1000)") (dt (tt "make-environment")) (dd "The environment constructor (default: `make-environment')")) (highlight scheme "(define simulate-vacuum\n  (case-lambda\n    ((world agent) (simulate-vacuum world agent (default-steps)))\n    ((world agent steps) (simulate-vacuum world agent steps make-environment))\n    ((world agent steps make-environment)\n     (simulate\n       (compose-environments\n         (make-step-limited-environment steps)\n         (make-performance-measuring-environment\n           (make-performance-measure world)\n           (make-score-update! agent))\n         (make-debug-environment\n           agent\n           (lambda (agent)\n             (vector\n               (let ((location (agent-location agent)))\n                 (if (left? location) 'left 'right))\n               (agent-score agent))))\n         (make-debug-environment world)\n         (make-environment world agent)))\n     (agent-score agent))))"))) (section 5 (tt "simulate-penalizing-vacuum") (def (sig (procedure "(simulate-penalizing-vacuum world agent) → the agent-score" (id simulate-penalizing-vacuum)) (procedure "(simulate-penalizing-vacuum world agent steps) → the agent-score" (id simulate-penalizing-vacuum))) (p "Like `simulate-vacuum', but penalizes agents for every movement.") (dl (dt (tt "world")) (dd "The two-square vacuum world (see `make-world')") (dt (tt "agent")) (dd "The agent to inhabit the world") (dt (tt "steps")) (dd "The number of steps to simulate (default: 1000)")) (highlight scheme "(define simulate-penalizing-vacuum\n  (case-lambda\n    ((world agent) (simulate-penalizing-vacuum world agent (default-steps)))\n    ((world agent steps)\n     (simulate-vacuum world agent steps make-penalizing-environment))))")))) (section 4 "Graph-based vacuum-world" (section 5 (tt "make-graph") (def (sig (procedure "(make-graph) → graph" (id make-graph))) (p "Make a hash-table-based adjacency list.") (highlight scheme "(define make-graph make-hash-table)"))) (section 5 (tt "up") (def (sig (constant "up → 2" (id up))) (p "Index of the up square") (highlight scheme "(define up 2)"))) (section 5 (tt "up?") (def (sig (procedure "(up?) → true if it is the up square" (id up?))) (p "Is this the up square?") (highlight scheme "(define up? (cute = <> 2))"))) (section 5 (tt "down") (def (sig (constant "down → 3" (id down))) (p "Index of the down square") (highlight scheme "(define down 3)"))) (section 5 (tt "down?") (def (sig (procedure "(down?) → true if this is the down square" (id down?))) (p "Is this the down square?") (highlight scheme "(define down? (cute = <> 3))"))) (section 5 (tt "location") (def (sig (record "location" (id location))) (p "Location-records describing the status (e.g. clean, dirty) of the square and its neighbors at `left', `right', `down', `up'.") (p "`neighbors' is a ternary vector indexed by relative directions.") (highlight scheme "(define-record location status neighbors)"))) (section 5 (tt "copy-world") (def (sig (procedure "(copy-world world) → graph-world" (id copy-world))) (p "Make a deep copy of a graph-world.") (dl (dt (tt "world")) (dd "The world to copy")) (highlight scheme "(define (copy-world world)\n  (let ((world (hash-table-copy world)))\n    (hash-table-walk\n      world\n      (lambda (name location) (hash-table-update! world name copy-location)))\n    world))"))) (section 5 (tt "make-node") (def (sig (procedure "(make-node) → symbol" (id make-node))) (p "Make a unique symbol suitable for a node-name.") (highlight scheme "(define make-node gensym)"))) (section 5 (tt "connect!") (def (sig (procedure "(connect! world connectend connector direction) → unspecified" (id connect!))) (p "Bi-connect two locations over a direction and its inverse.") (dl (dt (tt "world")) (dd "The graph-world within which to connect") (dt (tt "connectend")) (dd "The node to be connected") (dt (tt "connector")) (dd "The connecting node") (dt (tt "direction")) (dd "The relative direction to connect over")) (highlight scheme "(define (connect! world connectend connector direction)\n  (hash-table-update!/default\n    world\n    connectend\n    (lambda (location)\n      (vector-set! (location-neighbors location) direction connector)\n      location)\n    (make-dirty-location))\n  (hash-table-update!/default\n    world\n    connector\n    (lambda (location)\n      (vector-set!\n        (location-neighbors location)\n        (reverse-direction direction)\n        connectend)\n      location)\n    (make-dirty-location)))"))) (section 5 (tt "random-start") (def (sig (procedure "(random-start world) → symbol" (id random-start))) (p "Find a random starting node in the given world.") (dl (dt (tt "world")) (dd "The world to search")) (highlight scheme "(define (random-start world)\n  (let ((nodes (hash-table-keys world)))\n    (list-ref nodes (bsd-random-integer (length nodes)))))"))) (section 5 (tt "make-randomized-graph-agent") (def (sig (procedure "(make-randomized-graph-agent start) → agent" (id make-randomized-graph-agent))) (p "Make a simply reflex agent that randomly searches the graph and cleans dirty squares.") (dl (dt (tt "start")) (dd "Starting square (see `random-start')")) (highlight scheme "(define (make-randomized-graph-agent start)\n  (make-reflex-agent\n    start\n    (lambda (location clean?)\n      (if clean? (list-ref '(left right up down) (random-direction)) 'suck))))"))) (section 5 (tt "default-n-nodes") (def (sig (parameter "default-n-nodes → 20" (id default-n-nodes))) (p "Default number of nodes for a graph") (highlight scheme "(define default-n-nodes (make-parameter 20))"))) (section 5 (tt "make-linear-world") (def (sig (procedure "(make-linear-world) → graph" (id make-linear-world)) (procedure "(make-linear-world n-nodes) → graph" (id make-linear-world))) (p "Make a world that consists of a line of nodes (for testing pathological cases.") (dl (dt (tt "n-nodes")) (dd "Number of nodes in the graph (default: (default-n-nodes))")) (highlight scheme "(define make-linear-world\n  (case-lambda\n    (() (make-linear-world (default-n-nodes)))\n    ((n-nodes)\n     (let ((world (make-graph))\n           (nodes (list-tabulate n-nodes (lambda i (make-node)))))\n       (for-each\n         (lambda (node1 node2) (connect! world node1 node2 right))\n         (drop nodes 1)\n         (drop-right nodes 1))\n       world))))"))) (section 5 (tt "make-preferential-depth-first-world") (def (sig (procedure "(make-preferential-depth-first-world) → graph" (id make-preferential-depth-first-world)) (procedure "(make-preferential-depth-first-world n-nodes) → graph" (id make-preferential-depth-first-world))) (p "Create a random-graph using depth-first search that nevertheless shows preference for connected nodes (á la Barabási-Albert).") (p "The graph has no cycles.") (dl (dt (tt "n-nodes")) (dd "The number of nodes in the graph (default: (default-n-nodes))")) (highlight scheme "(define make-preferential-depth-first-world\n  (case-lambda\n    (() (make-preferential-depth-first-world (default-n-nodes)))\n    ((n-nodes)\n     (let* ((world (make-seed-world)) (start (random-start world)))\n       (let iter ((node start)\n                  (n-nodes (max 0 (- n-nodes (count-nodes world))))\n                  (n-degrees (count-degrees world)))\n         (if (zero? n-nodes)\n           world\n           (let ((location\n                   (hash-table-ref/default world node (make-dirty-location))))\n             (let ((n-neighbors (n-neighbors location)))\n               (if (and (< n-neighbors 4)\n                        (< (bsd-random-real) (/ n-neighbors n-degrees)))\n                 (let* ((new-directions\n                          (vector-fold\n                            (lambda (direction directions neighbor)\n                              (if (no-passage? neighbor)\n                                (cons direction directions)\n                                directions))\n                            '()\n                            (location-neighbors location)))\n                        (new-direction\n                          (list-ref\n                            new-directions\n                            (bsd-random (length new-directions)))))\n                   (let ((new-node (make-node)))\n                     (connect! world node new-node new-direction)\n                     (iter new-node (- n-nodes 1) (+ n-degrees 2))))\n                 (let* ((neighbors\n                          (vector-fold\n                            (lambda (direction neighbors neighbor)\n                              (if (passage? neighbor)\n                                (cons neighbor neighbors)\n                                neighbors))\n                            '()\n                            (location-neighbors location)))\n                        (neighbor\n                          (list-ref\n                            neighbors\n                            (bsd-random (length neighbors)))))\n                   (iter neighbor n-nodes n-degrees)))))))))))"))) (section 5 (tt "make-graph-world") (def (sig (procedure "(make-graph-world n-nodes) → graph" (id make-graph-world))) (p "Make a random graph.") (dl (dt (tt "n-nodes")) (dd "The number of nodes in the graph (default: (default-n-nodes))")) (highlight scheme "(define make-graph-world make-preferential-depth-first-world)"))) (section 5 (tt "write-world-as-dot") (def (sig (procedure "(write-world-as-dot world agent) → unspecified" (id write-world-as-dot)) (procedure "(write-world-as-dot world agent step) → unspecified" (id write-world-as-dot)) (procedure "(write-world-as-dot world agent step width height font-size title) → unspecified" (id write-world-as-dot))) (p "Output the graph-world as in dot-notation (i.e. Graphviz).") (dl (dt (tt "world")) (dd "The graph-world to output") (dt (tt "agent")) (dd "The agent inhabiting the graph-world") (dt (tt "step")) (dd "The current step or false") (dt (tt "width")) (dd "Width of the output") (dt (tt "height")) (dd "Height of the output") (dt (tt "font-size")) (dd "Font-size of the output") (dt (tt "title")) (dd "Title of the output")) (highlight scheme "(define write-world-as-dot\n  (case-lambda\n    ((world agent) (write-world-as-dot world agent #f))\n    ((world agent step)\n     (write-world-as-dot\n       world\n       agent\n       step\n       (default-width)\n       (default-height)\n       (default-font-size)\n       (default-title)))\n    ((world agent step width height font-size title)\n     (write-dot-preamble agent step width height font-size title)\n     (write-dot-nodes world agent)\n     (write-dot-edges world)\n     (write-dot-postscript))))"))) (section 5 (tt "write-world-as-pdf") (def (sig (procedure "(write-world-as-pdf world agent pdf) → unspecified" (id write-world-as-pdf))) (p "Output the graph-world as a pdf via graphviz.") (dl (dt (tt "world")) (dd "The world to output") (dt (tt "agent")) (dd "The agent that inhabits the world") (dt (tt "pdf")) (dd "The file to write to")) (highlight scheme "(define (write-world-as-pdf world agent pdf)\n  (receive\n    (input output id)\n    (process \"neato\" `(\"-Tpdf\" \"-o\" ,pdf))\n    (with-output-to-port\n      output\n      (lambda () (write-world-as-dot world agent #f #f #f #f #f)))\n    (flush-output output)\n    (close-output-port output)\n    (close-input-port input)))"))) (section 5 (tt "write-world-as-gif") (def (sig (procedure "(write-world-as-gif world agent frame gif) → unspecified" (id write-world-as-gif)) (procedure "(write-world-as-gif world agent frame gif width height font-size title) → unspecified" (id write-world-as-gif))) (p "Output the graph-world as gif via Graphviz (useful for e.g. animations).") (dl (dt (tt "world")) (dd "The graph-world to output") (dt (tt "agent")) (dd "The agent inhabiting the graph-world") (dt (tt "frame")) (dd "The frame-number") (dt (tt "gif")) (dd "The base-name of the gif to write to") (dt (tt "width")) (dd "Width of the output") (dt (tt "height")) (dd "Height of the output") (dt (tt "font-size")) (dd "Font-size of the output") (dt (tt "title")) (dd "Title of the output")) (highlight scheme "(define write-world-as-gif\n  (case-lambda\n    ((world agent frame gif)\n     (write-world-as-gif\n       world\n       agent\n       frame\n       gif\n       (default-width)\n       (default-height)\n       (default-font-size)\n       (default-title)))\n    ((world agent frame gif width height font-size title)\n     (receive\n       (input output id)\n       (process \"neato\" `(\"-Tgif\" \"-o\" ,gif))\n       (with-output-to-port\n         output\n         (lambda ()\n           (write-world-as-dot\n             world\n             agent\n             frame\n             width\n             height\n             font-size\n             title)))\n       (flush-output output)\n       (close-output-port output)\n       (close-input-port input)))))"))) (section 5 (tt "make-unknown-location") (def (sig (procedure "(make-unknown-location clean?) → location" (id make-unknown-location))) (p "Make a graph-location whose neighbors are all unknown.") (dl (dt (tt "clean?")) (dd "Is the graph-location clean?")) (highlight scheme "(define (make-unknown-location clean?)\n  (make-location\n    (if clean? clean dirty)\n    (vector unknown unknown unknown unknown)))"))) (section 5 (tt "reverse-move") (def (sig (procedure "(reverse-move move) → direction" (id reverse-move))) (p "Reverse the relative direction.") (dl (dt (tt "move")) (dd "The relative direction to reverse")) (highlight scheme "(define (reverse-move move)\n  (case move ((left) 'right) ((right) 'left) ((up) 'down) ((down) 'up)))"))) (section 5 (tt "direction->move") (def (sig (procedure "(direction->move direction) → relative direction" (id direction->move))) (p "Convert a neighbor-index into a relative direction.") (dl (dt (tt "direction")) (dd "The index to convert")) (highlight scheme "(define (direction->move direction) (list-ref '(left right up down) direction))"))) (section 5 (tt "move->direction") (def (sig (procedure "(move->direction move) → index" (id move->direction))) (p "Convert a relative direction into a neighbor index.") (dl (dt (tt "move")) (dd "The relative direction to convert")) (highlight scheme "(define (move->direction move)\n  (case move ((left) left) ((right) right) ((up) up) ((down) down)))"))) (section 5 (tt "make-stateful-graph-agent") (def (sig (procedure "(make-stateful-graph-agent start) → agent" (id make-stateful-graph-agent))) (p "Make a graph-traversal agent that models the graph and searches it thoroughly, stopping when the world is clean.") (p "The agent can detect cycles.") (dl (dt (tt "start")) (dd "Starting position of the agent (see `random-start')")) (highlight scheme "(define (make-stateful-graph-agent start)\n  (make-reflex-agent\n    start\n    (let ((world (make-hash-table))\n          (nodes (list->stack (list start)))\n          (moves (make-stack)))\n      (lambda (node clean?)\n        (if (stack-empty? nodes)\n          'noop\n          (if (not clean?)\n            'suck\n            (let ((location\n                    (hash-table-ref/default\n                      world\n                      node\n                      (make-unknown-location clean?))))\n              (if (stack-empty? moves)\n                (hash-table-set! world node location)\n                (let ((last-move (stack-peek moves)))\n                  (if (eq? last-move 'backtrack)\n                    (stack-pop! moves)\n                    (if (eq? (stack-peek nodes) node)\n                      (let ((last-move (stack-pop! moves)))\n                        (vector-set!\n                          (location-neighbors location)\n                          (move->direction last-move)\n                          no-passage))\n                      (let* ((last-node (stack-peek nodes))\n                             (last-location (hash-table-ref world last-node)))\n                        (if (hash-table-exists? world node)\n                          (stack-push! nodes cycle)\n                          (begin\n                            (hash-table-set! world node location)\n                            (stack-push! nodes node)))\n                        (vector-set!\n                          (location-neighbors location)\n                          (move->direction (reverse-move last-move))\n                          last-node)\n                        (vector-set!\n                          (location-neighbors last-location)\n                          (move->direction last-move)\n                          node))))))\n              (let ((new-moves\n                      (map direction->move\n                           (undiscovered-directions location))))\n                (if (or (cycle? (stack-peek nodes)) (null? new-moves))\n                  (begin\n                    (stack-pop! nodes)\n                    (if (stack-empty? moves)\n                      'noop\n                      (let ((move (stack-pop! moves)))\n                        (stack-push! moves 'backtrack)\n                        (reverse-move move))))\n                  (let ((move (list-ref\n                                new-moves\n                                (bsd-random (length new-moves)))))\n                    (stack-push! moves move)\n                    move))))))))))"))) (section 5 (tt "simulate-graph") (def (sig (procedure "(simulate-graph world agent) → unspecified" (id simulate-graph)) (procedure "(simulate-graph world agent steps) → unspecified" (id simulate-graph))) (p "Simulate the graph world.") (dl (dt (tt "world")) (dd "The world to simulate") (dt (tt "agent")) (dd "The agent to inhabit the world") (dt (tt "steps")) (dd "The steps to simulate (default: (default-steps))")) (highlight scheme "(define simulate-graph\n  (case-lambda\n    ((world agent) (simulate-graph world agent (default-steps)))\n    ((world agent steps)\n     (parameterize\n       ((randomize! bsd-randomize))\n       (simulate\n         (compose-environments\n           (make-step-limited-environment steps)\n           (make-debug-environment agent)\n           (make-graph-environment world agent)\n           (make-graph-performance-measure world agent)))))))"))) (section 5 (tt "simulate-graph/animation") (def (sig (procedure "(simulate-graph/animation world agent file) → unspecified" (id simulate-graph/animation)) (procedure "(simulate-graph/animation world agent file steps) → unspecified" (id simulate-graph/animation)) (procedure "(simulate-graph/animation world agent file steps width height font-size title) → unspecified" (id simulate-graph/animation))) (p "Simulate the graph world, creating an animation along the way; see, for instance, <http://youtu.be/EvZvyxAoNdo>.") (p "Requires Graphviz.") (dl (dt (tt "world")) (dd "The world to simulate") (dt (tt "agent")) (dd "The agent that inhabits the world") (dt (tt "file")) (dd "The base-name of the animation file") (dt (tt "steps")) (dd "The steps to simulation (default: `(default-steps)'") (dt (tt "width")) (dd "Width of the animation in pixels") (dt (tt "hight")) (dd "Height of the animation in pixels") (dt (tt "font-size")) (dd "Font-size of the animation in points") (dt (tt "title")) (dd "Title of the animation")) (highlight scheme "(define simulate-graph/animation\n  (case-lambda\n    ((world agent file)\n     (simulate-graph/animation world agent file (default-steps)))\n    ((world agent file steps)\n     (simulate-graph/animation\n       world\n       agent\n       file\n       steps\n       (default-width)\n       (default-height)\n       (default-font-size)\n       (default-title)))\n    ((world agent file steps width height font-size title)\n     (let ((directory (create-temporary-directory)))\n       (parameterize\n         ((randomize! bsd-randomize))\n         (simulate\n           (compose-environments\n             (make-step-limited-environment steps)\n             (make-graph-animating-environment\n               world\n               agent\n               directory\n               width\n               height\n               font-size\n               title)\n             (make-finalizing-environment\n               (make-animation-finalizer directory file)\n               steps)\n             (make-debug-environment agent)\n             (make-graph-environment world agent)\n             (make-graph-performance-measure world agent))))\n       directory))))"))) (section 5 (tt "compare-graphs") (def (sig (procedure "(compare-graphs world agent-one title-one agent-two title-two composite-file) → unspecified" (id compare-graphs)) (procedure "(compare-graphs world agent-one title-one agent-two title-two composite-file steps width height font-size) → unspecified" (id compare-graphs))) (p "Simulate two agents in a given world and animate their progress side-by-side; see, for instance, <http://youtu.be/B28ay_zSnoY>.") (p "Requires Graphviz.") (dl (dt (tt "world")) (dd "The world to simulate") (dt (tt "agent-one")) (dd "The first inhabiting agent") (dt (tt "title-one")) (dd "Title of the first agent") (dt (tt "agent-two")) (dd "The second inhabiting agent") (dt (tt "title-two")) (dd "Title of the second agent") (dt (tt "composite-file")) (dd "Base-name of the composite animation")) (highlight scheme "(define compare-graphs\n  (case-lambda\n    ((world agent-one title-one agent-two title-two composite-file)\n     (compare-graphs\n       world\n       agent-one\n       title-one\n       agent-two\n       title-two\n       composite-file\n       (default-steps)\n       (/ (default-width) 2)\n       (default-height)\n       (/ (default-font-size) 2)))\n    ((world agent-one\n            title-one\n            agent-two\n            title-two\n            composite-file\n            steps\n            width\n            height\n            font-size)\n     (let ((directory-one\n             (simulate-comparatively\n               (copy-world world)\n               agent-one\n               steps\n               width\n               height\n               font-size\n               title-one))\n           (directory-two\n             (simulate-comparatively\n               world\n               agent-two\n               steps\n               width\n               height\n               font-size\n               title-two)))\n       (let ((composite-directory (create-temporary-directory)))\n         (system*\n           \"cd ~a && for i in *; do echo $i; convert +append $i ~a/$i ~a/$i; done\"\n           directory-one\n           directory-two\n           composite-directory)\n         ((make-animation-finalizer composite-directory composite-file)))))))"))))) (section 3 "About this egg" (section 4 "Author" (p (int-link "/users/klutometis" "Peter Danenberg"))) (section 4 "Repository" (p (link "https://github.com/klutometis/aima-chicken"))) (section 4 "License" (p "BSD")) (section 4 "Dependencies" (ul (li (int-link "debug")) (li (int-link "define-record-and-printer")) (li (int-link "foof-loop")) (li (int-link "format")) (li (int-link "graphviz")) (li (int-link "hahn")) (li (int-link "heap")) (li (int-link "list-utils")) (li (int-link "matchable")) (li (int-link "numbers")) (li (int-link "R")) (li (int-link "random-bsd")) (li (int-link "setup-helper")) (li (int-link "shell")) (li (int-link "srfi-95")) (li (int-link "stack")) (li (int-link "vector-lib")))) (section 4 "Versions" (dl (dt (link "https://github.com/klutometis/aima-chicken/releases/tag/0.1" "0.1")) (dd "Version 0.1") (dt (link "https://github.com/klutometis/aima-chicken/releases/tag/0.2" "0.2")) (dd "0.2") (dt (link "https://github.com/klutometis/aima-chicken/releases/tag/0.3" "0.3")) (dd "Version 0.3") (dt (link "https://github.com/klutometis/aima-chicken/releases/tag/0.4" "0.4")) (dd "Version 0.4") (dt (link "https://github.com/klutometis/aima-chicken/releases/tag/0.5" "0.5")) (dd "Version 0.5") (dt (link "https://github.com/klutometis/aima-chicken/releases/tag/0.5.1" "0.5.1")) (dd "Add some docs.") (dt (link "https://github.com/klutometis/aima-chicken/releases/tag/0.5.2" "0.5.2")) (dd "Add cock to depends.") (dt (link "https://github.com/klutometis/aima-chicken/releases/tag/0.5.3" "0.5.3")) (dd "Generate docs at setup-time.") (dt (link "https://github.com/klutometis/aima-chicken/releases/tag/0.6" "0.6")) (dd "Version 0.6") (dt (link "https://github.com/klutometis/aima-chicken/releases/tag/0.7" "0.7")) (dd "Tessellation!") (dt (link "https://github.com/klutometis/aima-chicken/releases/tag/0.7.1" "0.7.1")) (dd "Animated plots of tessellations") (dt (link "https://github.com/klutometis/aima-chicken/releases/tag/0.7.2" "0.7.2")) (dd "Fix dependency in R.") (dt (link "https://github.com/klutometis/aima-chicken/releases/tag/0.7.3" "0.7.3")) (dd "Add lolevel.") (dt (link "https://github.com/klutometis/aima-chicken/releases/tag/0.7.4" "0.7.4")) (dd "Use lavc.") (dt (link "https://github.com/klutometis/aima-chicken/releases/tag/0.7.5" "0.7.5")) (dd "With a note about cock-utils") (dt (link "https://github.com/klutometis/aima-chicken/releases/tag/0.7.6" "0.7.6")) (dd "Use numbers.") (dt (link "https://github.com/klutometis/aima-chicken/releases/tag/0.7.7" "0.7.7")) (dd "Add test-exit.") (dt (link "https://github.com/klutometis/aima-chicken/releases/tag/0.8" "0.8")) (dd "Search") (dt (link "https://github.com/klutometis/aima-chicken/releases/tag/0.8.1" "0.8.1")) (dd "Fix +inf; `goal?' is node, not state.") (dt (link "https://github.com/klutometis/aima-chicken/releases/tag/0.8.2" "0.8.2")) (dd "make-random-points") (dt (link "https://github.com/klutometis/aima-chicken/releases/tag/0.8.3" "0.8.3")) (dd "Add random-bsd.") (dt (link "https://github.com/klutometis/aima-chicken/releases/tag/0.8.4" "0.8.4")) (dd "Tessellation has its own point?") (dt (link "https://github.com/klutometis/aima-chicken/releases/tag/0.9" "0.9")) (dd "Add CSPs.") (dt (link "https://github.com/klutometis/aima-chicken/releases/tag/0.9.1" "0.9.1")) (dd "Add some csp-functions.") (dt (link "https://github.com/klutometis/aima-chicken/releases/tag/0.9.2" "0.9.2")) (dd "CSP: Use null-neighbors as default.") (dt (link "https://github.com/klutometis/aima-chicken/releases/tag/0.9.3" "0.9.3")) (dd "Debug") (dt (link "https://github.com/klutometis/aima-chicken/releases/tag/0.9.4" "0.9.4")) (dd "Fix some tests; export a few functions; &c.") (dt (link "https://github.com/klutometis/aima-chicken/releases/tag/0.9.5" "0.9.5")) (dd "Fix test.") (dt (link "https://github.com/klutometis/aima-chicken/releases/tag/0.9.6" "0.9.6")) (dd "Random-map") (dt (link "https://github.com/klutometis/aima-chicken/releases/tag/0.9.7" "0.9.7")) (dd "Graph visualization functions") (dt (link "https://github.com/klutometis/aima-chicken/releases/tag/0.9.8" "0.9.8")) (dd "Cons in enumeration") (dt (link "https://github.com/klutometis/aima-chicken/releases/tag/0.9.9" "0.9.9")) (dd "Export shuffle.") (dt (link "https://github.com/klutometis/aima-chicken/releases/tag/0.9.10" "0.9.10")) (dd "Use the new graphviz.") (dt (link "https://github.com/klutometis/aima-chicken/releases/tag/0.9.11" "0.9.11")) (dd "Remove the dependency on setup-helper-cock.") (dt (link "https://github.com/klutometis/aima-chicken/releases/tag/0.9.12" "0.9.12")) (dd "Remove the dependency on debug.") (dt (link "https://github.com/klutometis/aima-chicken/releases/tag/0.9.13" "0.9.13")) (dd "Evaluate examples.") (dt (link "https://github.com/klutometis/aima-chicken/releases/tag/0.9.14" "0.9.14")) (dd "Use hahn."))) (section 4 "Colophon" (p "Documented by " (int-link "/egg/hahn" "hahn") ".")))))