chickadee » aima

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

AIMA

aima

[module] aima

AIMA contains functions common to agents and environments.

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

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>

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.

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.

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
pdf
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

Peter Danenberg

Repository

https://github.com/klutometis/aima-chicken

License

BSD

Dependencies

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.

Contents »