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

  1. Outdated egg!
  2. aima
    1. AIMA
      1. aima
      2. define-record-and-printer
      3. debug?
      4. debug-print
      5. random-seed
      6. randomize!
      7. simulate
      8. compose-environments
      9. make-performance-measuring-environment
      10. default-steps
      11. make-step-limited-environment
      12. make-debug-environment
    2. AIMA-CSP
      1. aima-csp
      2. failure
      3. success?
      4. csp
        1. Examples
      5. backtracking-search
        1. Examples
      6. backtracking-enumeration
      7. ac-3
      8. xor
      9. neq?
      10. random-map
      11. shuffle
    3. AIMA-Tessellation
      1. aima-tessellation
      2. node
      3. tessellation
      4. tessellate
      5. point-distance
      6. predecessor-path
      7. plot-tessellation
      8. plot-tessellation/animation
      9. join-animations
    4. AIMA-Vacuum
      1. aima-vacuum
      2. Two-square vacuum-world
        1. display-world
        2. clean
        3. dirty
        4. unknown
        5. left
        6. left?
        7. right
        8. right?
        9. make-world
        10. world-location
        11. world-location-set!
        12. agent
        13. simple-agent-program
        14. make-stateful-agent-program
        15. make-reflex-agent
        16. make-simple-reflex-agent
        17. make-stateful-reflex-agent
        18. make-performance-measure
        19. make-score-update!
        20. simulate-vacuum
        21. simulate-penalizing-vacuum
      3. Graph-based vacuum-world
        1. make-graph
        2. up
        3. up?
        4. down
        5. down?
        6. location
        7. copy-world
        8. make-node
        9. connect!
        10. random-start
        11. make-randomized-graph-agent
        12. default-n-nodes
        13. make-linear-world
        14. make-preferential-depth-first-world
        15. make-graph-world
        16. write-world-as-dot
        17. write-world-as-pdf
        18. write-world-as-gif
        19. make-unknown-location
        20. reverse-move
        21. direction->move
        22. move->direction
        23. make-stateful-graph-agent
        24. simulate-graph
        25. simulate-graph/animation
        26. compare-graphs
    5. About this egg
      1. Author
      2. Repository
      3. License
      4. Dependencies
      5. Versions
      6. Colophon

AIMA

aima

[module] aima

AIMA contains functions common to agents and environments.

define-record-and-printer

[syntax] (define-record-and-printer) → unspecified

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?

[parameter] debug? → #t

Should 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) → environment

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

[procedure] (make-performance-measuring-environment measure-performance score-update!) → environment

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

[parameter] default-steps → 1000

Default 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) → environment

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

[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) → boolean

Success is defined negatively as the absence of failure.

result
The result to test
(define success? (complement failure?))

csp

[record] csp

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>
[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) → boolean

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

[syntax] (xor x y) → boolean

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?

[procedure] (neq? x y) → boolean

The complement to eq?

x
Comparandum
y
Comparator
(define neq? (complement eq?))

random-map

[procedure] (random-map n) → hash-table

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

[procedure] (shuffle list) → list

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

[record] node

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

[record] tessellation

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

[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) → distance

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

[procedure] (predecessor-path node) → list

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

[procedure] (plot-tessellation tessellation path title filename) → unspecified

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

[procedure] (plot-tessellation/animation tessellation path title filename) → unspecified

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

[procedure] (join-animations output . animations) → unspecified

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
[procedure] (display-world world) → unspecified

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
[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 → 0

Index of the left square

(define left 0)
left?
[procedure] (left? square) → true if it is the left square

Is this the left square?

square
The square to be lefted
(define left? zero?)
[constant] right → 1

Index of the right square

(define right 1)
[procedure] (right? square) → true if it is the right square

Is 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 world

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
[procedure] (world-location square) → the square-status

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!
[procedure] (world-location-set! square status) → unspecified

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
[record] agent

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
[procedure] (simple-agent-program location clean?) → one of 'left, 'right, 'suck, 'noop

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
[procedure] (make-stateful-agent-program) → stateful agent program

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
[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 agent

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
[procedure] (make-stateful-reflex-agent location) → a stateful reflex agent

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
[procedure] (make-performance-measure world) → environment

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!
[procedure] (make-score-update! agent) → a monadic procedure that takes the score to add

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
[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) → graph

Make a hash-table-based adjacency list.

(define make-graph make-hash-table)
up
[constant] up → 2

Index of the up square

(define up 2)
up?
[procedure] (up?) → true if it is the up square

Is this the up square?

(define up? (cute = <> 2))
down
[constant] down → 3

Index of the down square

(define down 3)
down?
[procedure] (down?) → true if this is the down square

Is this the down square?

(define down? (cute = <> 3))
location
[record] location

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
[procedure] (copy-world world) → graph-world

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
[procedure] (make-node) → symbol

Make a unique symbol suitable for a node-name.

(define make-node gensym)
connect!
[procedure] (connect! world connectend connector direction) → unspecified

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
[procedure] (random-start world) → symbol

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
[procedure] (make-randomized-graph-agent start) → agent

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
[parameter] default-n-nodes → 20

Default 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) → graph

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
[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) → unspecified

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
[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?) → location

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
[procedure] (reverse-move move) → direction

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
[procedure] (direction->move direction) → relative direction

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
[procedure] (move->direction move) → index

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
[procedure] (make-stateful-graph-agent start) → agent

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

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.