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