You are looking at historical revision 39572 of this page. It may differ significantly from its current revision.
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
- 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
[syntax] (define-record-and-printer) → unspecifiedDefine 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?
[parameter] debug? → #tShould we print debugging information to stdout?
(define debug? (make-parameter #t))
debug-print
[procedure] (debug-print key value) → unspecified[procedure] (debug-print key value out) → unspecified
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
[parameter] random-seed → #f`random-seed' is passed to `randomize!' during `simulate'.
(define random-seed (make-parameter #f))
randomize!
[parameter] randomize! → randomize`randomize!' is called before simulation and is seeded with `random-seed'.
(define randomize! (make-parameter randomize))
simulate
[procedure] (simulate environment) → #f[procedure] (simulate environment randomize! random-seed) → #f
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
[procedure] (compose-environments . environments) → environmentCompose 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
[procedure] (make-performance-measuring-environment measure-performance score-update!) → environmentMake 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
[parameter] default-steps → 1000Default number of steps for the step-limited environment
(define default-steps (make-parameter 1000))
make-step-limited-environment
[procedure] (make-step-limited-environment) → environment[procedure] (make-step-limited-environment steps) → environment
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
[syntax] (make-debug-environment object make-printable-object) → environmentMake 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
[constant] failure → (make-failure)The failure object: to distinguish bona-fide solutions to a CSP that are #f.
(define failure (make-failure))
success?
[procedure] (success? result) → booleanSuccess is defined negatively as the absence of failure.
- result
- The result to test
(define success? (complement failure?))
csp
[record] cspA 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
[procedure] (backtracking-search csp) → object or {{failure}}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
[procedure] (backtracking-enumeration csp) → list[procedure] (backtracking-enumeration n csp) → list
[procedure] (backtracking-enumeration csp cons nil stop?) → list
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
[procedure] (ac-3 csp) → booleanCheck 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
[syntax] (xor x y) → booleanLogical 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?
[procedure] (neq? x y) → booleanThe complement to eq?
- x
- Comparandum
- y
- Comparator
(define neq? (complement eq?))
random-map
[procedure] (random-map n) → hash-tableCreate 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
[procedure] (shuffle list) → listShuffle 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
[record] nodeData 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
[record] tessellationtessellation 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
[procedure] (tessellate) → tessellation[procedure] (tessellate n-vertices) → tessellation
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
[procedure] (point-distance p1 p2) → distanceCalculate 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
[procedure] (predecessor-path node) → listList 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
[procedure] (plot-tessellation tessellation path title filename) → unspecifiedPlot 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
[procedure] (plot-tessellation/animation tessellation path title filename) → unspecifiedPlot 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
[procedure] (join-animations output . animations) → unspecifiedJoin 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
[procedure] (display-world world) → unspecifiedDisplay 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
[constant] clean → (make-clean)A clean square
(define clean (make-clean))
dirty
[constant] dirty → (make-dirty)A dirty square
(define dirty (make-dirty))
unknown
[constant] unknown → (make-unknown)An unknown square (either clean or dirty)
(define unknown (make-unknown))
left
[constant] left → 0Index of the left square
(define left 0)
left?
[procedure] (left? square) → true if it is the left squareIs this the left square?
- square
- The square to be lefted
(define left? zero?)
right
[constant] right → 1Index of the right square
(define right 1)
right?
[procedure] (right? square) → true if it is the right squareIs this the right square?
- square
- The square to be righted
(define right? (cute = <> 1))
make-world
[procedure] (make-world left right) → a two-square vacuum worldMake 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
[procedure] (world-location square) → the square-statusGet 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!
[procedure] (world-location-set! square status) → unspecifiedSet 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
[record] agentThe 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
[procedure] (simple-agent-program location clean?) → one of 'left, 'right, 'suck, 'noopExample 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
[procedure] (make-stateful-agent-program) → stateful agent programMake 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
[procedure] (make-reflex-agent location) → unspecified[procedure] (make-reflex-agent location program) → unspecified
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
[procedure] (make-simple-reflex-agent location) → a simple reflex agentMake 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
[procedure] (make-stateful-reflex-agent location) → a stateful reflex agentMake 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
[procedure] (make-performance-measure world) → environmentMake 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!
[procedure] (make-score-update! agent) → a monadic procedure that takes the score to addMake 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
[procedure] (simulate-vacuum world agent) → the agent-score[procedure] (simulate-vacuum world agent steps) → the agent-score
[procedure] (simulate-vacuum world agent steps make-environment) → the agent-score
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
[procedure] (simulate-penalizing-vacuum world agent) → the agent-score[procedure] (simulate-penalizing-vacuum world agent steps) → the agent-score
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
[procedure] (make-graph) → graphMake a hash-table-based adjacency list.
(define make-graph make-hash-table)
up
[constant] up → 2Index of the up square
(define up 2)
up?
[procedure] (up?) → true if it is the up squareIs this the up square?
(define up? (cute = <> 2))
down
[constant] down → 3Index of the down square
(define down 3)
down?
[procedure] (down?) → true if this is the down squareIs this the down square?
(define down? (cute = <> 3))
location
[record] locationLocation-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
[procedure] (copy-world world) → graph-worldMake 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
[procedure] (make-node) → symbolMake a unique symbol suitable for a node-name.
(define make-node gensym)
connect!
[procedure] (connect! world connectend connector direction) → unspecifiedBi-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
[procedure] (random-start world) → symbolFind 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
[procedure] (make-randomized-graph-agent start) → agentMake 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
[parameter] default-n-nodes → 20Default number of nodes for a graph
(define default-n-nodes (make-parameter 20))
make-linear-world
[procedure] (make-linear-world) → graph[procedure] (make-linear-world n-nodes) → graph
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
[procedure] (make-preferential-depth-first-world) → graph[procedure] (make-preferential-depth-first-world n-nodes) → graph
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
[procedure] (make-graph-world n-nodes) → graphMake 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
[procedure] (write-world-as-dot world agent) → unspecified[procedure] (write-world-as-dot world agent step) → unspecified
[procedure] (write-world-as-dot world agent step width height font-size title) → unspecified
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
[procedure] (write-world-as-pdf world agent pdf) → unspecifiedOutput 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
[procedure] (write-world-as-gif world agent frame gif) → unspecified[procedure] (write-world-as-gif world agent frame gif width height font-size title) → unspecified
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
[procedure] (make-unknown-location clean?) → locationMake 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
[procedure] (reverse-move move) → directionReverse 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
[procedure] (direction->move direction) → relative directionConvert 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
[procedure] (move->direction move) → indexConvert 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
[procedure] (make-stateful-graph-agent start) → agentMake 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
[procedure] (simulate-graph world agent) → unspecified[procedure] (simulate-graph world agent steps) → unspecified
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
[procedure] (simulate-graph/animation world agent file) → unspecified[procedure] (simulate-graph/animation world agent file steps) → unspecified
[procedure] (simulate-graph/animation world agent file steps width height font-size title) → unspecified
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
[procedure] (compare-graphs world agent-one title-one agent-two title-two composite-file) → unspecified[procedure] (compare-graphs world agent-one title-one agent-two title-two composite-file steps width height font-size) → unspecified
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.