Some notes and solutions to Russell and Norvig's Artificial Intelligence: A Modern Approach (AIMA, 3rd edition)

CLOSED: 2012-06-11 Mon 17:18
Page 38 describes an environment which is partially observable, deterministic and static; as such, the tabular agent in Fig. 2.3 can expect to maximize its utility in no more than four actions (the worst case is A: dirty, B: dirty; which results in either suck, right, suck, left, ... or suck, left, suck, right, ...).

There is no time to e.g. build a model of dirt, since the dirt doesn't replentish itself.

CLOSED: 2012-06-11 Mon 17:18
The agent does require internal state: it should know, for instance, whether it has cleaned every square; and, if so, should stop.

CLOSED: 2012-06-11 Mon 17:18
It should learn the geography of its environment to avoid wasting time trying to move off of it; it could maintain, furthermore, a dirt-distribution across the grid and favor those squares that tend to get dirty.

Performance measure

Score and defend

Environment

Field

Actuators

Kicking, thrwing, catching

Sensors

Topology, ball, agents

Characteristics

Fully observable, multiagent, stochastic, sequential, dynamic, continuous, known

Performance measure

Like TiME for surface lakes, it would determine the presence of biological compounds.

Environment

Titan

Actuators

Drill, satellite, landing gear

Sensors

Mass spectrometer, camera

Characteristics

Partially observable, multiagent? stochastic, sequential, dynamic, continuous, known

Performance measure

Finding used AI books

Environment

The internet

Actuators

Form completion, HTTP request, cookie storage

Sensors

HTML parser

Characteristics

Partially observable, multiagent, stochastic, sequential, dynamic, continuous, known

Performance measure

Winning the match

Environment

Tennis court

Actuators

Tennis racket

Sensors

Location, trajectory of ball, opponent; topology

Characteristics

Fully observable, multiagent, stochastic, sequential, dynamic, continuous, known

Performance measure

Length of rally

Environment

Half-court with wall

Actuators

See above.

Sensors

See above (sans opponent).

Characteristics

Fully observable, single agent, stochastic, sequential, dynamic, continuous, known

Performance measure

Height jumped

Environment

Measuring stick

Actuators

Spring

Sensors

Balance

Characteristics

Fully observable, single agent, deterministic, episodic, static, continuous, known

Performance measure

Consistency of stitch, conformance to the recipient's body

Environment

Yarn, recipient's body

Actuators

Needle

Sensors

Yarn on needle

Characteristics

Fully observable, single agent, deterministic, sequential, static, continuous, known

Performance measure

Win, save cash

Environment

Auction

Actuators

Signify bid

Sensors

See the artifact, understand the auctioneer

Characteristics

Partially observable ⁴, stochastic, sequential, dynamic, continuous, known

,- let
,  - state
,  - model
,  - goals
,  - action
,    - define (goal-based-agent percept)
,      - set! state (update-state state action percept model)
,      - let
,        # Shouldn't we distinguish between many different
,        action-sequences; and, if so, how to do so without a utility
,        function: evaluate them against the performance measure?
,        - action-sequence (search goals state)
,          - return (first action-sequence)

,- let
,  - state
,  - model
,  - goals
,  - action
,    - define (utility-based-agent percept)
,      - set! state (update-state state action percept model)
,      - let
,        - probabilities (map probability goals)
,        - utilities (map utility goals)
,          - let
,            - expected-utilities (map * probabilities utilities)
,            - goal-of-maximum-expected-utility (max goals expected-utilities)
,            - action-sequence (search goal-of-maximum-expected-utility state)
,              - return (first action-sequence)

CLOSED: 2012-06-29 Fri 13:29
With a partially observable environment, a simple reflex agent will not be rational (in the sense that its expected performance is not as good as any other's); in other words, it should be scoring about twice as much as this:

(use aima-vacuum
     test)

(test
 "Penalizing vacuum with reflex agent"
 998
 (simulate-penalizing-vacuum (make-world dirty dirty)
                             (make-reflex-agent left)))     

The reflex agent would require state to determine that e.g. the world was clean and that it didn't need to move anymore.

CLOSED: 2012-06-29 Fri 17:52

(use aima
     aima-vacuum
     test
     vector-lib)

(debug? #f)

(define-record unknown)

(define unknown (make-unknown))

(define (all-clean? world)
  ;; Vector bleeds a little world.
  (vector-every (lambda (location) (clean? location)) world))

(test
 "Stateful agent in penalizing environment"
 1995
 (simulate-penalizing-vacuum
  (make-world dirty dirty)
  (make-reflex-agent
   left
   ;; We could also make an initial pessimistic hypothesis of all-dirty.
   (let ((world (make-world unknown unknown)))
     (lambda (location clean?)
       (if clean?
           (begin
             ;; Extra work here every time; otherwise, we'd have an
             ;; extra `all-clean?' check after we set the state.
             ;; `vector-set!', I'd wager, is cheaper than
             ;; `all-clean?'.
             (vector-set! world location clean)
             (if (all-clean? world)
                 ;; Symbols appropriate here, or should we have predefined
                 ;; go-left, go-right, clean, do-nothing? We're message
                 ;; passing, after all; I suppose a lambda wouldn't make any
                 ;; sense?
                 ;;
                 ;; Can't be lambdas unless we redefine e.g. `go-right'
                 ;; to penalize in the case of
                 ;; `make-penalizing-environment'; better to keep as
                 ;; symbols and dispatch, right? There should be some
                 ;; sort of data-directed model we could use, though,
                 ;; instead of the case-based dispatch.
                 'noop
                 (if (right? location)
                     'left
                     'right)))
           'suck))))))

(test
 "Stateful agent in penalizing environment (from the egg)"
 1995
 (simulate-penalizing-vacuum
  (make-world dirty dirty)
  (make-stateful-reflex-agent left)))

CLOSED: 2012-06-29 Fri 17:52

• CLOSING NOTE 2012-06-29 Fri 17:52
  Should we actually implement it?

If the simple and stateful reflex agents are omniscient w.r.t. the environment, they are equivalent; the stateful agent will simply update its state according to its omniscient percept and the simple one will simply act accordingly.

CLOSED: 2012-07-16 Mon 14:00
A simple reflex agent wouldn't be able to explore an environment of unknown extent without exhausting all possible paths of the corresponding \(n \times n\) space; given sufficient time, such an exhaustive agent would asymptotically approach rationality toward \(t = \infty\).

Given reasonable time constraints, however, or e.g. penalties for moving, such an agent would not be rational; if it maintained all possible paths in a table, it would also contravene the directive on p. 47:

The key challenge for AI is to find out how to write programs that, to the extent possible, produce rational behavior from a smallish program rather than from a vast table.

More fundamentally, an agent wouldn't be able to exhaust the space without maintaining some sort of state (e.g. paths traversed).

Even more fundamentally, however, the agent can't discern whether it's hit a wall; this changes in 2.12, however, when the agent gets a bump sensor.

CLOSED: 2012-07-16 Mon 14:00

The average score for a randomized agent in a 20-node world is roughly \(17300.0\); see the demonstration-video.

(use aima aima-vacuum test)

(parameterize ((current-test-epsilon 0.005))
  (test
   "Test the randomized graph agent on 100 different worlds."
   17300.0
   (let* ((scores
           (list-tabulate
            100
            (lambda (i)
              (let* ((world (make-graph-world))
                     (start (random-start world))
                     (agent (make-randomized-graph-agent start)))
                (parameterize ((random-seed i)
                               (debug? #f))
                  (simulate-graph world agent))
                (agent-score agent))))))
     (/ (apply + scores) (length scores)))))

CLOSED: 2012-07-16 Mon 14:49
The randomized agent will perform poorly in a linear environment, since many of its movement choices will be no-op; in fact, the average score of a randomized agent on a linear world of 20 nodes is roughly \(15000.0\) (\(\approx13\%\) less than the random 20-node world in 2.11b):

(use aima aima-vacuum debug test)

(parameterize ((current-test-epsilon 0.1))
  (test
   "Test the randomized graph agent on a linear world 100 times."
   15000.0
   (let* ((world (make-linear-world))
          (start (random-start world)))
     (let ((scores (list-tabulate
                    100
                    (lambda (i)
                      (let* ((world (copy-world world))
                             (agent (make-randomized-graph-agent start)))
                        (parameterize ((debug? #f))
                          (simulate-graph world agent))
                        (agent-score agent))))))
       (/ (apply + scores) (length scores))))))

See the video.

CLOSED: 2012-07-16 Mon 16:58
An agent with state can outperform a stateless agent and maximize its performance by systematically exploring the environment á la e.g. depth-first search; in a 20 node environment, the stateful agent performs \(\approx 20\%\) better than its randomized counterpart (cf. 2.11c).

See the video.

(use aima aima-vacuum test)

(parameterize ((current-test-epsilon 0.005))
  (test
   "Test the stateful graph agent on 100 different worlds."
   19176.35
   (let* ((scores
           (list-tabulate
            100
            (lambda (i)
              (let* ((world (make-graph-world))
                     (start (random-start world))
                     (agent (make-stateful-graph-agent start)))
                (parameterize ((random-seed i)
                               (debug? #f))
                  (simulate-graph world agent))
                (agent-score agent))))))
     (/ (apply + scores) (length scores)))))

The basic algorithm is as follows:

1. Is the current location dirty? Clean it.
2. Otherwise, visit and clean (if necessary) all the current-location's unvisited neighbors.
3. If there are no unvisited neighbors for the current location, go back the way we came.
4. If there are no unvisited (and uncleaned) locations, stop.

Traversing the world in this fashion is linearly complex.

CLOSED: 2012-07-16 Mon 17:20
By expending an extra step at each square to make sure that it is, in fact, clean (and repeatedly cleaning otherwise); one can still clean the entire environment in linear time.

If the dirt sensor is wrong some percentage of the time, one would repeatedly sense the status of the location until some significance criterion is reached. For instance, it appears as though one would have to sense the status \(17\) times per location to achieve a confidence level of \(95\%\).

CLOSED: 2012-07-16 Mon 17:20
I don't see how you could avoid repeatedly exploring and cleaning the world according to some acceptable interval; if the dirt is not evenly distributed, store statistics about dirty hotspots (and hit those locations more frequently).

CLOSED: 2012-08-19 Sun 19:23

States

A graph whose nodes point east, west, north, south (pointing to a special sentinel-node in the case of adjoining walls); the orientation of the robot; the square currently occupied by the robot.

Initial state

Graph of one central node; northward orientation

Actions

Turn east, west, north, south; move forward.

Transition model

Moves in the currently oriented direction wherever a wall does not intervene; where a wall intervenes, however, the robot stays put.

Goal test

Is the robot out of the maze?

Path cost

None

The state space is infinite: you can reach any square, for instance, over an unlimited number of noöps (e.g. pressing forward into a wall, turning redundantly, &c.).⁵

Let's say that redundant noöps have been pruned, however; and that the graph, furthermore, doesn't have any cycles: the state space is at least \(n\), corresponding to the number of nodes in the graph. It is at least \(4n\), though, since the robot can be in any of the four orientations in each square. Let's say, furthermore, for every node \(n_i\) there are \(m_i\) unique paths (i.e. sequences \(n_{0, 1, \dots, i}\)) from the initial node \(n_0\) to \(n_i\): the state space for \(n_i\) alone becomes all the ways to fulfill each path in \(m_i\) including unnecessary turns and false-forwards into walls. Let the set of all fulfillments for a given \(m_i\) be \(M_i\).

The state space is the sum of \(M_i\) over the number of nodes in the graph; plus the robots current position; plus the robot's orientation.

CLOSED: 2012-08-19 Sun 19:23

States

A graph whose nodes point to one or more of east, west, north, south if a neighbor exists in that direction; the orientation of the robot; the square currently occupied by the robot.

Initial state

Graph of one central node; northward orientation

Actions

Turn east, west, north, south if the robot is at an intersection; or move forward.

Transition model

Moves in the currently oriented direction wherever a wall does not intervene; where a wall intervenes, however, the robot stays put.

Goal test

Is the robot out of the maze?

Path cost

None

The state-space is still infinite, since the problem admits of redundant forwards at intersections; the pruned state space is smaller than 3.2a, however, since the fulfillment of \(m_i\) doesn't involve unnecessary turns in corridors.

CLOSED: 2012-08-19 Sun 19:23

States

A graph whose nodes point to one or more of east, west, north, south if a neighbor exists in that direction; the square currently occupied by the robot.

Initial state

Graph of one central node

Actions

Turn east, west, north, south

Transition model

Move east, west, north, south until the robot is at a turning point.

Goal test

Is the robot out of the maze?

Path cost

None

If the maze has loops, the state space is infinite; otherwise, the state-space is significantly smaller than even 3.2b, since \(M_i\) doesn't require any superfluous movement to exhaust it.

The robot's orientation is irrelevant, since we'll travel along the chosen direction to the next turning point.

CLOSED: 2012-08-19 Sun 19:23
At least three simplifications; that:

1. the maze is oriented along strict cardinal directions;
2. the passages are straight;
3. the passages are passable;
4. the robot has unlimited energy.

CLOSED: 2012-08-20 Mon 04:29

State

A state specifies the location of each friend on the map \(n(\{i, j\})\), and the respective paths that led them there \(P(\{i, j\})\).

Initial state

A friend a each city \(n(\{i, j\})_0\), \(P(\{i, j\})\) are empty.

Actions

Each friend moves to a neighboring city ⁶.

Transition model

Each friend moves to a neighboring city.

Goal test

\(n(i) = n(j)\), the two friends are in the same city.

Path cost

\(max(T(i_n, i_{n+1}), T(j_n, j_{n+1}))\), where \(T\) is the time required to move from one city to the next.

This is reminiscent of bidirectional search (\S 3.4.6) with a heuristic.

CLOSED: 2012-08-20 Mon 04:29
An admissible heuristic is one that never overestimates the cost to reach a goal.

1. \(D(i, j)\), the straight-line-distance heuristic, is admissible (by the triangle inequality).
2. \(2D(i, j)\), on the other hand, is not admissible; since it might overestimate the cost of reaching the goal.
3. \(D(i, j)/2\) is admissible, since \(D(i, j)/2 < D(i, j)\) and \(D(i, j)\) is admissible.

CLOSED: 2012-08-20 Mon 04:29
If noöp is allowed, no completely connected map exists for which there is no solution: one friend stays still, the other meets her; if noöps are not allowed, on the other hand, even a completely connected graph with two-nodes has no solution (since the problem states that \(i\) and \(j\) are different cities).

CLOSED: 2012-08-20 Mon 04:40
With friends located at \(a\) and \(f\), one friend must end up taking the \(a \to b \to c \to a\) loop to offset the even displacement of friends.

CLOSED: 2012-08-24 Fri 08:09

States

An upper bound on the number of 4-colorings is \(4^n\), where \(n\) is the number of regions in the plane; finding the exact number of colorings (the so-called chromatic polynomial) is #P-complete.⁷

The map can be modeled as a graph where the nodes correspond to regions and edges are drawn between nodes whose corresponding regions are adjacent.

Initial state

A planar graph with the topology mentioned above, whose nodes are all uncolored.

Actions

Color node; add children to queue.

Transition model

After the node is colored, it is removed from the queue; the next node in the queue becomes the current node.

Goal test

The graph is colored (there are no more nodes in the queue) and is a valid 4-coloring.

This assumes that we've brute-forced all \(4^n\) color-assignments, and are checking them for validity; more efficient algorithms exist.⁸

CLOSED: 2012-08-24 Fri 08:09

States

In a square room with \(n \times n\) tiles, there are \(n^2\) possible arrangements of bananas.

The room could be modeled as an \(n \times n\) array, with the location of the two crates, the monkey and bananas.

Initial state

An \(n \times n\) array with random bananas; monkey and two crates in position 0.

Actions

Move up, down, left, right; move crates up, down, left, right.

Transition model

If the monkey moves up, down, left, right and is not encumbered by a wall, update the position; the monkey, incidentally, has a banana sensor which rings true if the current square has bananas.

If the monkey moves a box, update the position of the box.

Goal test

Has the graph been explored, and are there no more bananas?

Involves an e.g. breadth-first search of the banana-space with backtracking so as to relocate the boxes from their last position.

CLOSED: 2012-08-24 Fri 08:09

States

An array of records with one or more of them illegal. An list of indices with illegal records.

Initial state

Some array of records; an empty list of illegal records.

Actions

Parse record and next record.

Transition model

If parse-record returns false, the record is illegal: add it to the list of illegal records; next-record examines the next record.

Goal test

Have we examined all the records?

CLOSED: 2012-08-24 Fri 08:09

States

Three jugs in various states of fullness.

Initial state

All three jugs are empty.

Actions

Fill, empty into jug, empty onto ground.

Transition model

Filling or emptying updates the water level of the corresponding jug(s).

Goal test

Does any jug contain one gallon?

Is this reminiscent of Knuth's conjecture?

CLOSED: 2012-10-01 Mon 05:10
If the space is continuous, there are infinitely many states and paths; if discrete, there are \(xy\) states and \(< (xy)!\) paths to the goal. (Take the special case where the start and end are in opposite corners: is it the case that you have \({x + y \choose x} paths\)?)

CLOSED: 2012-10-01 Mon 05:10
By the triangle inequality, any divergence from the vertices could be shortened by travelling straight to a vertex; the state space is now the vertices corresponding to edges of polygons.

CLOSED: 2012-10-01 Mon 05:10

(use aima-tessellation
     data-structures
     debug
     heap
     stack)

(define (search start
                end
                neighbors
                make-frontier
                frontier-add!
                frontier-delete!
                frontier-empty?)
  (let ((visited (make-hash-table))
        (frontier (make-frontier)))
    (frontier-add! frontier (make-node start #f #f 0))
    (let search ()
      ;; (debug frontier)
      (if (frontier-empty? frontier)
          (error "Search failed -- SEARCH")
          (let* ((parent (frontier-delete! frontier))
                 (children (hash-table-ref neighbors (node-state parent))))
            ;; (debug parent)
            (hash-table-set! visited (node-state parent) #f)
            (if (eq? (node-state parent) end)
                (reverse (predecessor-path parent))
                (let ((unvisited-children
                       (filter (lambda (child)
                                 (hash-table-ref/default
                                  visited
                                  child
                                  #t))
                               children)))
                  ;; (debug parent children unvisited-children)
                  (for-each
                      (lambda (child)
                        ;; (debug child parent (node-state parent))
                        (let ((node (make-node child
                                               parent
                                               #f
                                               (+ (node-path-cost parent)
                                                  (point-distance
                                                   child
                                                   (node-state parent))))))
                          (frontier-add! frontier node)))
                    unvisited-children)
                  (search))))))))

(define (depth-first start end neighbors)
  (search start
          end
          neighbors
          make-stack
          stack-push!
          stack-pop!
          stack-empty?))

(define (breadth-first start end neighbors)
  (search start
          end
          neighbors
          make-queue
          queue-add!
          queue-remove!
          queue-empty?))

(define (best-first start end neighbors f)
  (search start
          end
          neighbors
          make-min-heap
          (lambda (heap node)
            (let ((key (heap-key heap node))
                  (path-cost (f node)))
              (if key
                  (if (< path-cost key)
                      (heap-change-key! heap node path-cost))
                  (heap-insert! heap path-cost node))))
          heap-extract-extremum!
          heap-empty?))

(define (uniform-cost start end neighbors)
  (best-first start end neighbors node-path-cost))

(define (make-straight-line-distance-heuristic end)
  (lambda (node) (point-distance (node-state node) end)))

(define (greedy-best-first start end neighbors)
  (best-first
   start
   end
   neighbors
   (make-straight-line-distance-heuristic end)))

(define (a* start end neighbors)
  (best-first
   start
   end
   neighbors
   (let ((straight-line-distance-heuristic
          (make-straight-line-distance-heuristic end)))
     (lambda (node) (+ (node-path-cost node)
                  (straight-line-distance-heuristic node))))))

(let ((tessellation (tessellate)))
  (let ((start (tessellation-start tessellation))
        (end (tessellation-end tessellation))
        (neighbors (tessellation-neighbors tessellation)))
    (let ((breadth-first (breadth-first start end neighbors))
          (depth-first (depth-first start end neighbors))
          (uniform-cost (uniform-cost start end neighbors))
          (greedy-best-first (greedy-best-first start end neighbors))
          (a* (a* start end neighbors)))
      (plot-tessellation/animation
       tessellation
       a*
       "A*"
       "a-star.avi")
      (plot-tessellation/animation
       tessellation
       uniform-cost
       "Uniform-cost"
       "uniform-cost.avi")
      (plot-tessellation/animation
       tessellation
       greedy-best-first
       "Greedy best-first"
       "greedy-best-first.avi")
      (plot-tessellation/animation
       tessellation
       depth-first
       "Depth-first"
       "depth-first.avi")
      (plot-tessellation/animation
       tessellation
       breadth-first
       "Breadth-first"
       "breadth-first.avi")
      (join-animations "search.avi"
                       "a-star.avi"
                       "uniform-cost.avi"
                       "greedy-best-first.avi"
                       "breadth-first.avi"
                       "depth-first.avi"))))

CLOSED: 2012-10-01 Mon 05:10
See the video: A* = uniform-cost > greedy-best-first > breadth-first > depth-first.

CLOSED: 2012-11-26 Mon 15:06
Whereas the TSP states that all points should be connected (minimizing total distance) and traversable only once, MSTs connect all points (minimizing total distance; relaxing the single-visit constraint.

CLOSED: 2012-11-26 Mon 15:06
MST dominates⁹ straight-line distance by the triangle inequality: straight-line distance must be the shortest distance between points \(A\) and \(C\), but an MST might have zero or more intermediate points $B₀ … \(B_n\) between \(A\) and \(B\).

Best case, \(B_0 \dots B_N\) follow a straight line; and cannot do any better (if constrained by three-dimension space, or disregarding quantum effects).

CLOSED: 2012-11-26 Mon 15:06

(use aima-search
     debug
     extras
     lolevel
     random-bsd
     test)

(define (make-random-points n)
  (do ((points '() (cons (make-point (random-real) (random-real)) points))
       (n n (- n 1)))
      ((zero? n) points)))

(randomize 0)
(test '(#(point 0.917756787181357 0.014503760244948)
        #(point 0.182243740737884 0.222769906458184)
        #(point 0.254000634233175 0.179812326085674)
        #(point 0.926341976132823 0.118316212304605)
        #(point 0.467849216952573 0.0142746775993328)
        #(point 0.913224195689647 0.430542990820318)
        #(point 0.360349150321226 0.64218713670766)
        #(point 0.0427818455795276 0.919137354588936)
        #(point 0.203195544766634 0.0902104548313956)
        #(point 0.72382773905288 0.00514485046497615))
      (map record->vector (make-random-points 10)))

CLOSED: 2012-11-26 Mon 15:06

Here's a link to the video.

Let's start with Kruskal on a completely connected graph. We can do disjoint sets with hash-tables, I think; the elements of the hash-table can either point to the hash-table itself (which we'll compare with e.g. eq?), or a data-structure with a tag generated by e.g. gensym. With hash-table-merge!, the first hash-table becomes canonical; the second is removed from the set of sets.

Data-structure with gensym-tag is the most dependable, isn't it? What happens if the identity of the hash-table changes, somehow?

Since we don't have a combinations package (or can we use R?), iterate through the edges and the list of edges; combining it in a hash-table with all but itself.

The algorithm will have another hash-table where we construct the resultant MST; as well as a hash-table for every node, which represents its disjoint set.

We can use a heap to pop things off.

(use aima-search
     debug
     define-record-and-printer
     files
     format
     heap
     R
     random-bsd
     shell
     srfi-69
     vector-lib)

(define (connect! graph from to)
  (hash-table-update!/default graph
                              from
                              (lambda (tos)
                                (cons to tos))
                              '()))

(define (biconnect! graph from to)
  (connect! graph from to)
  (connect! graph to from))

(define (complete-graph points)
  (let ((graph (make-hash-table)))
    (for-each (lambda (p1)
                (for-each (lambda (p2)
                            (if (not (eq? p1 p2))
                                (connect! graph p1 p2)))
                  points))
      points)
    graph))

(define make-disjoint-set make-hash-table)

(define (make-set set element)
  (let ((set-marker (gensym)))
    (hash-table-set! set element set-marker)
    set-marker))

(define (find-set set element)
  (hash-table-ref set element))

;;; This is a painful linear-time union; according to CLRS, we can do
;;; better.
(define (set-union! set e1 e2)
  (let ((m1 (hash-table-ref set e1))
        (m2 (hash-table-ref set e2)))
    (hash-table-walk set
                     (lambda (element marker)
                       (if (eq? marker m2)
                           (hash-table-set! set element m1))))))

(define (minimum-spanning-tree graph)
  (let ((set (make-disjoint-set))
        (tree (make-hash-table)))
    (for-each (lambda (node) (make-set set node))
      (hash-table-keys graph))
    (let ((edges (make-min-heap)))
      (hash-table-walk
       graph
       (lambda (from tos)
         (for-each (lambda (to)
                     (heap-insert! edges (point-distance from to) (cons from to)))
           tos)))
      (do ((edges edges))
          ((heap-empty? edges))
        (let ((edge (heap-extract-extremum! edges)))
          (let ((from (car edge))
                (to (cdr edge)))
            (unless (eq? (find-set set from)
                         (find-set set to))
              (biconnect! tree from to)
              ;; (connect! tree from to)
              (set-union! set from to)))))
      tree)))

(define (tree-cost tree)
  (apply + (hash-table-map tree
                           (lambda (from tos)
                             (apply +
                                    (map (lambda (to) (point-distance from to))
                                         tos))))))

(define (make-tour points)
  (let ((tour (make-hash-table)))
    (do ((from (drop-right points 1) (cdr from))
         (to (cdr points) (cdr to)))
        ((null? from) tour)
      (hash-table-set! tour (car from) (car to)))
    ;; (debug (hash-table->alist tour))
    tour))

(define (tour-length tour)
  (apply + (hash-table-map tour point-distance)))

(define (tree->vectors tree)
  (let ((tree
         (hash-table-fold
          tree
          (lambda (from tos segments)
            (append
             (map (lambda (to)
                    (list (point-x from)
                          (point-y from)
                          (point-x to)
                          (point-y to)))
                  tos)
             segments))
          '())))
    (values (list->vector (map car tree))
            (list->vector (map cadr tree))
            (list->vector (map caddr tree))
            (list->vector (map cadddr tree)))))

(define (points->vectors points)
  (let ((tour (map (lambda (from to)
                     (list (point-x from)
                           (point-y from)
                           (point-x to)
                           (point-y to)))
                   (drop-right points 1)
                   (cdr points))))
    (values (list->vector (map car tour))
            (list->vector (map cadr tour))
            (list->vector (map caddr tour))
            (list->vector (map cadddr tour)))))

(define with-R-output-to-png
  (case-lambda
   ((output thunk) (with-R-output-to-png output thunk 1600 900))
   ((output thunk width height)
    (R (png ,output
            width: ,width
            height: ,height
            type: "cairo"))
    (thunk)
    (R (dev.off)))))

(define (plot-points x y main)
  (R (plot ,x
           ,y
           xlab: "x"
           ylab: "y"
           main: ,main
           cex.lab: 2
           cex.axis: 2
           cex.main: 2))
  (R (text ,x
           ,y
           ,(vector-map (lambda (i x y)
                          (format "(~,2f ~,2f)" x y))
                        x
                        y)
           pos: 1
           cex: 2)))

(define plot-segments
  (case-lambda
   ((x y xend yend)
    (plot-segments x y xend yend 1))
   ((x y xend yend col)
    (R (segments ,x ,y ,xend ,yend col: ,col lwd: 3)))))

(define (highlight-segments x y xend yend)
  (plot-segments x y xend yend 2))

(define (plot-tree x y xend yend)
  (plot-segments x y xend yend 3))

(define (make-main main tour)
  (format "~a (length: ~,2f)" main
          (if (> (length tour) 1)
           (tour-length (make-tour tour))
           0)))

(define (graph-tour-with-tree output main x-points y-points visited-points tree)
  (let-values (((x y xend yend) (points->vectors visited-points))
               ((x-tree y-tree xend-tree yend-tree) (tree->vectors tree)))
    (with-R-output-to-png
     output
     (lambda ()
       (plot-points x-points y-points
                    (make-main main
                               (cdr visited-points)))
       (when (positive? (vector-length x))
         (plot-segments x y xend yend)
         (highlight-segments (vector-ref x 0)
                             (vector-ref y 0)
                             (vector-ref xend 0)
                             (vector-ref yend 0)))
       (when (positive? (vector-length x-tree))
         (plot-tree x-tree y-tree xend-tree yend-tree))))))

(define (x-points points)
  (list->vector (map point-x points)))

(define (y-points points)
  (list->vector (map point-y points)))

(define (graph-tour output main points tour)
  (with-R-output-to-png
   output
   (lambda ()
     (plot-points (x-points points)
                  (y-points points)
                  (make-main main tour))
     (call-with-values (lambda () (points->vectors tour))
       (lambda (x y xend yend)
         (plot-segments x y xend yend))))))

(define A*-tour
  (case-lambda
   ((start graph points)
    (A*-tour start graph points #f))
   ((start graph points animation)
    (define (goal? node)
      (= (length (predecessor-path node))
         (length points)))
    (let ((dir (create-temporary-directory))
          (n 0)
          (x-points (x-points points))
          (y-points (y-points points))
          (main "TSP with A* and MST"))
      (cons start
            (reverse
             (map node-state
                  (A* start
                      (lambda (node)
                        (let ((point (node-state node)))
                          (hash-table-ref/default graph point '())))
                      point-distance
                      goal?
                      (lambda (node)
                        (let* ((visited-points (map node-state (predecessor-path node)))
                               (unvisited-points (lset-difference eq? points visited-points))
                               (unvisited-tree (minimum-spanning-tree
                                                (complete-graph unvisited-points))))
                          (when animation
                            (debug n)
                            (graph-tour-with-tree
                             (begin (set! n (+ n 1))
                                    (make-pathname dir (format "~4,48d" n) ".png"))
                             main
                             x-points
                             y-points
                             visited-points
                             unvisited-tree)
                            (when (goal? node)
                              (let ((fps 6))
                                ;; Make the animation pause at the
                                ;; finished frame for a couple seconds.
                                (let ((tour
                                       (cons start
                                             (map node-state
                                                  (predecessor-path node)))))
                                  (do ((i (* fps 2) (- i 1)))
                                      ((zero? i))
                                    (debug (+ n i))
                                    (graph-tour
                                     (make-pathname dir (format "~4,48d" (+ n i)) ".png")
                                     main
                                     points
                                     tour)))
                                (run (cd ,dir &&
                                         mencoder mf://*.png
                                         -mf ,(format "type=png:fps=~a" fps)
                                         -ovc lavc
                                         -o ,(make-pathname (current-directory) animation))))))
                          (tree-cost unvisited-tree)))))))))))

(use format)

(include "tsp.scm")

(let* ((graph (complete-graph (make-random-points 20)))
       (points (hash-table-keys graph))
       (start (car points)))
  (let* ((tour (A*-tour start graph points "3.30.avi")))
    (graph-tour "3.30.png" "TSP with A* and MST" points tour)))

We have the MST; how to use it as a heuristic? This cat works an example; some skepticism; thorough; dynamic programming? Reasoning answers; a solution for the heuristic: nearest neighbor + 2 * length(MST) for unvisited nodes + nearest distance from unvisited city to start city.

We're going to have to modify search, unfortunately, since it only work on a goal-state; we're going to have to look at the whole graph and see whether we've visited every node.

On the other hand, if we pass the node to goal? and not merely the node's state; we could do a predecessor-path. Step-cost, too, only compares states; that's ok, though, isn't it?

library(ggplot2)

## data <- read.csv("tour.csv")
## start <- data[1,]
plot.tour <- function(data) {
  str(data)
  p <- ggplot() +
    geom_segment(aes(x=x, y=y, xend=xend, yend=yend, color="A*"), data=data) +
      geom_text(aes(x=data$x + (data$xend - data$x) / 2,
                    y=data$y + (data$yend - data$y) / 2),
                label=signif(sqrt((data$xend - data$x) ^ 2 +
                  (data$yend - data$y) ^ 2),
                  digits=2)) +
                    geom_point(aes(x=x, y=y), data=data) +
                      geom_text(aes(x=data$x, y=data$y),
                                label=sprintf('(%s, %s)',
                                  signif(data$x, digits=2),
                                  signif(data$y, digits=2))) +
                                    labs(color="Search")
  plot(p)
}

Try to use ggplot more effectively; actual values? Given ggplot2's aesthetic weirdness with layers, we might have to move to a plot that takes actual vectors.

Don't forget the eternal:

mencoder mf://*.png -mf type=png:fps=4 -ovc lavc -o harro.avi

CLOSED: 2012-12-20 Thu 15:19
Thanks, John Montgomery, for the suggestion to reverse pairs of cities or the cities intervening pairs.

Shuffling a list; Riastradh's; O(n log n), I believe.

(use aima-search
     data-structures
     debug
     heap
     srfi-1
     statistics
     vector-lib)

(define (shuffle! v)
  (do ((n (vector-length v) (- n 1)))
      ((zero? n) v)
    (let* ((r (random n)) (t (vector-ref v r)))
      (vector-set! v r (vector-ref v (- n 1)))
            (vector-set! v (- n 1) t))))

(define (shuffle v)
  (let ((v (vector-copy v)))
    (shuffle! v)
    v))

(define (tour-distance tour)
  (do ((i 0 (+ i 1))
       (j 1 (modulo (+ j 1) (vector-length tour)))
       (distance 0 (+ distance (point-distance (vector-ref tour i)
                                               (vector-ref tour j)))))
      ((= i (vector-length tour)) distance)))

(define (successors tour)
  (do ((i 0 (+ i 1))
       (successors
        '()
        (append
         (do ((j i (+ j 1))
              (successors '() (cons (let ((tour (vector-copy tour)))
                                      (vector-swap! tour i j)
                                      tour)
                                    successors)))
             ((= j (vector-length tour)) successors))
         successors)
        ))
      ((= i (- (vector-length tour) 1)) successors)))

(define (min-successor successors)
  (let ((tours (make-min-heap)))
    (for-each (lambda (successor)
                (heap-insert! tours (tour-distance successor) successor))
      successors)
    (heap-extract-extremum! tours)))

(define (hill-climbing-tsp points)
  (let iter ((tour (shuffle (list->vector points))))
    (let ((next-tour (min-successor (successors tour))))
      (if (>= (tour-distance next-tour)
              (tour-distance tour))
          ;; No, don't cons it; tour-distance takes this into account.
          ;; (cons (vector-ref tour (- (vector-length tour) 1))
          ;;       (vector->list tour))
          tour
          (iter next-tour)))))

;; (let ((points (make-random-points 10)))
;;   (let ((hill-climbing-tour (hill-climbing points))
;;         (A*-tour (A*-tour (car points) (complete-graph points) points)))
;;     (debug (tour-length (make-tour hill-climbing-tour))
;;            (tour-length (make-tour A*-tour)))
;;     ;; (graph-tour (make-tour (cons (vector-ref tour (- (vector-length tour) 1))
;;     ;;                              (vector->list tour)))
;;     ;;             "Hill-climbing"
;;     ;;             "img/4-3.png")
;;     ))

;; (map (lambda (i)
;;        (let ((points (make-random-points 10)))
;;          (debug i)
;;          (let ((hill-climbing-tour (hill-climbing points))
;;                (A*-tour (A*-tour (car points)
;;                                  (complete-graph points)
;;                                  points
;;                                  #f)))
;;            (cons (tour-length (make-tour hill-climbing-tour))
;;                  (tour-length (make-tour A*-tour))))))
;;      (iota 100))

(use format)

(include "tsp.scm")
(include "tsp-local.scm")

(debug
 (let iter ((n 100)
            (hill-climbing-tours '())
            (A*-tours '()))
   (debug n)
   (if (zero? n)
       (cons (mean hill-climbing-tours)
             (mean A*-tours))
       (let ((points (make-random-points 10)))
         (let ((hill-climbing-tour (hill-climbing-tsp points))
               (A*-tour (A*-tour (car points)
                                 (complete-graph points)
                                 points
                                 #f)))
           ;; (debug hill-climbing-tour
           ;;        (tour-length (make-tour hill-climbing-tour))
           ;;        A*-tour
           ;;        (tour-length (make-tour A*-tour)))
           ;; (graph-tour (make-tour hill-climbing-tour)
           ;;             "Hill climbing"
           ;;             "hill-climbing.png")
           ;; (graph-tour (make-tour A*-tour)
           ;;             "A*"
           ;;             "a-star.png")
           (iter (- n 1)
                 (cons (tour-length (make-tour hill-climbing-tour))
                       hill-climbing-tours)
                 (cons (tour-length (make-tour A*-tour))
                       A*-tours)))))))

CLOSED: 2012-12-20 Thu 15:19
See the movie.

(use debug
     format
     miscmacros
     ;; numbers
     random-bsd
     srfi-1
     srfi-95
     test)

(include "tsp.scm")
(include "tsp-local.scm")

(define (shuffle-bounded! v p r)
  (let* ((n (vector-length v))
         (r (if (> r p) r (+ n r))))
    (do ((i r (- i 1)))
        ((< i p) v)
      (let* ((j (+ p (random (+ (- r p) 1))))
             (j (modulo j n)))
        (let ((i (modulo i n))
              (t (vector-ref v j)))
          (vector-set! v j (vector-ref v i))
          (vector-set! v i t))))))

(define (scramble-mutate! offspring)
  (let ((n (vector-length offspring)))
    (shuffle-bounded! offspring
                      (random n)
                      (random n))))

(define (crossover-alternating-positions p1 p2)
  (let ((n (vector-length p1)))
    (let ((child (make-vector n))
          (present? (make-hash-table)))
      (let iter ((p1 (vector->list p1))
                 (p2 (vector->list p2))
                 (p1? #f)
                 (i 0))
        (if (= i n)
            child
            (let ((element (if p1? (car p1) (car p2))))
              (if (hash-table-ref/default present? element #f)
                  (iter (if p1? (cdr p1) p1)
                        (if p1? p2 (cdr p2))
                        (not p1?)
                        i)
                  (begin (vector-set! child i element)
                         (hash-table-set! present? element #t)
                         (iter (if p1? (cdr p1) p1)
                               (if p1? p2 (cdr p2))
                               (not p1?)
                               (+ i 1))))))))))



(define (logarithmically-biased-random n)
  (inexact->exact (floor (log (+ (* (random-real) (- (exp n) 1)) 1)))))

(define (logarithmically-biased-random-pair population)
  (let* ((n (length population))
         (x (logarithmically-biased-random n)))
    (do ((y (logarithmically-biased-random n)
            (begin
              ;; (debug x y)
              (logarithmically-biased-random n))))
        ((not (= x y)) (values (list-ref population x)
                               (list-ref population y))))))

(define (sort-population population fitness)
  (sort population > fitness))

(define max-time (make-parameter 100))

(define mutation-probability (make-parameter 0.01))

(define mean-threshold (make-parameter 0.0005))

(define mutation-decay (make-parameter 0.8))

(define (genetic-algorithm population fitness reproduce mutate!)
  (let ((directory (create-temporary-directory)))
    (let iter ((population (sort-population population fitness))
               (i (max-time)))
      ;; (debug (map fitness population))
      (if (negative? i)
          (begin
            (let ((outfile (make-pathname directory (format "~4,48d" (+ (- (max-time) i) 1)) ".png"))
                  (grapheon (vector->list (car population))))
              (debug outfile)
              (graph-tour outfile
                          (format "TSP with GA (~a)" (- (max-time) i))
                          grapheon
                          (cons (last grapheon)
                                grapheon)))
            (run (cd ,directory &&
                     mencoder mf://*.png
                     -mf ,(format "type=png:fps=~a" 6)
                     -ovc lavc
                     -o ,(make-pathname (current-directory) "ga.avi")))
            (car population))
          (begin
            (let ((outfile (make-pathname directory (format "~4,48d" (- (max-time) i)) ".png"))
                  (grapheon (vector->list (car population))))
              (debug outfile)
              (graph-tour outfile
                          (format "TSP with GA (~a)" (- (max-time) i))
                          grapheon
                          (cons (last grapheon)
                                grapheon)))
            ;; (debug (sort
            ;;         (map (lambda (offspring) (cons (fitness offspring)
            ;;                                   offspring))
            ;;              population)
            ;;         <
            ;;         car))
            (mutation-probability (* (mutation-probability) (mutation-decay)))
            (let ((new-population
                   (do ((new-population
                         '()
                         (cons
                          (let ((offspring
                                 (receive (x y)
                                   (logarithmically-biased-random-pair population)
                                   (reproduce x y))))
                            (if (< (random-real) (mutation-probability))
                                (mutate! offspring))
                            offspring)
                          new-population)))
                       ((= (length new-population)
                           (length population))
                        new-population))))
              ;; (debug (abs
              ;;         (- (mean (map fitness population))
              ;;            (mean (map fitness new-population)))))
              (iter (sort-population new-population fitness)
                    (if (< (abs
                            (- (mean (map fitness population))
                               (mean (map fitness new-population))))
                           (mean-threshold))
                        -1
                        (- i 1)))))))))

;; (let ((p1 '#(1 2 3 4 5 6 7 8)))
;;   (shuffle! p1 6 2)
;;   (debug p1))

;; (let ((sample (list-tabulate 100 (lambda (i) (logarithmically-biased-random 100)))))
;;   (debug (sort sample >)
;;          (exact->inexact (mean sample))
;;          (exact->inexact (median sample))))

(define (populate-tour n points)
  (let ((path (list->vector points)))
    (list-tabulate n (lambda (i) (shuffle path)))))

(define population-n (make-parameter 100))

(define (genetic-tsp points)
  (let ((population (populate-tour (population-n) points)))
    (genetic-algorithm population
                       tour-distance
                       crossover-alternating-positions
                       scramble-mutate!)))

(let ((points (make-random-points 10)))
  (let ((genetic-tour
         (parameterize ((max-time 50)
                        (population-n 500)
                        (mutation-probability 0.5)
                        (mutation-decay 0.8)
                        (mean-threshold 0.0000))
           (genetic-tsp points)))
        (hill-climbing-tour (hill-climbing-tsp points)))
    ;; (graph-tour "harro.png" "harro" points (cons (vector-ref genetic-tour
    ;;                                                          (- (vector-length genetic-tour) 1))
    ;;                                              (vector->list genetic-tour)))
    (debug genetic-tour
           (tour-distance genetic-tour)
           (tour-distance hill-climbing-tour))))

Can we construct a suitable data-frame to visualize the top n-offspring with path-lengths?

(include "online-navigation.scm")

(define (maybe-update-untried! untried state)
  (unless (hash-table-exists? untried state)
    (hash-table-set!
     untried
     state
     (list->stack state))))

(define (maybe-update-labels! labels state)
  (unless (hash-table-exists? labels state)
    (hash-table-set!
     labels
     state
     (gensym))))

(define (maybe-update-result! result previous-state previous-action state)
  (hash-table-update!
   result
   previous-state
   (lambda (state->action)
     (hash-table-set! state->action state previous-action)
     state->action)
   (lambda () (make-hash-table))))

(define (maybe-update-unbacktracked! unbacktracked backtrack? previous-state state)
  (unless backtrack?
    (hash-table-update!
     unbacktracked
     state
     (lambda (backtracks)
       (stack-push! backtracks previous-state)
       backtracks)
     (lambda () (make-stack)))))

(define (maybe-update-coordinates! coordinates previous-state previous-action state time)
  ;; We could probably set this as a state variable
  ;; and avoid the lookup.
  (let* ((previous-coordinate
          (hash-table-ref coordinates previous-state))
         (previous-point (coordinate-point previous-coordinate)))
    (if (hash-table-exists? coordinates state)
        (let* ((coordinate (hash-table-ref coordinates state))
               (point (coordinate-point coordinate)))
          (when (< (coordinate-time coordinate) time)
            (let ((delta-x
                   (- (point-x point)
                      (+ (point-x previous-point)
                         (point-x previous-action))))
                  (delta-y
                   (- (point-y point)
                      (+ (point-y previous-point)
                         (point-y previous-action)))))
              (hash-table-walk coordinates
                (lambda (state old-coordinate)
                  (when (< (coordinate-time old-coordinate) time)
                    ;; (debug ;; (coordinate-time old-coordinate)
                    ;;  ;; time
                    ;;  delta-x
                    ;;  delta-y)
                    (coordinate-time-set! old-coordinate time)
                    (let ((old-point (coordinate-point old-coordinate)))
                      (coordinate-point-set!
                       old-coordinate
                       (make-point (- (point-x old-point) delta-x)
                                   (- (point-y old-point) delta-y))))))))))
        (hash-table-set!
         coordinates
         state
         (make-coordinate
          (make-point (+ (point-x previous-point)
                         (point-x previous-action))
                      (+ (point-y previous-point)
                         (point-y previous-action)))
          time)))))

(define (maybe-update-origin! coordinates state time)
  (unless (hash-table-exists? coordinates state)
    (hash-table-set!
     coordinates
     state
     (make-coordinate origin time))))

(define (untried? untried state)
  (not (stack-empty? (hash-table-ref/default untried state (make-stack)))))

(define (unbacktracked? unbacktracked state)
  (not (stack-empty? (hash-table-ref/default unbacktracked state (make-stack)))))

(define (make-agent-online-dfs start next-frame)
  (make-agent
   start
   0
   (let ((coordinates (make-hash-table))
         (labels (make-hash-table))
         (result (make-hash-table))
         (untried (make-hash-table))
         (unbacktracked (make-hash-table))
         (previous-state #f)
         (previous-action #f)
         (backtrack? #f)
         (time 0)
         (start #f)
         (goal #f))
     (define (reset-state! state)
       (set! goal state)
       (set! start #f)
       (set! previous-state #f)
       (set! previous-action #f)
       (set! backtrack? #f)
       (set! untried (make-hash-table))
       (set! unbacktracked (make-hash-table))
       (inc! time))
     (define (maybe-write-agent-as-png state score)
       (unless (zero? (hash-table-size result))
         (write-agent-as-png (next-frame)
                             state
                             coordinates
                             labels
                             result
                             untried
                             unbacktracked
                             previous-state
                             previous-action
                             start
                             goal
                             score)))
     (define (maybe-set-start! state)
       (unless start
         (set! start state)))
     (define (set-unbacktracked! state)
       (let* ((backtrack (stack-pop! (hash-table-ref unbacktracked state)))
              (backtrack-action
               (hash-table-ref (hash-table-ref result state) backtrack)))
         (set! backtrack? #t)
         (set! previous-action backtrack-action)))
     (define (set-untried! state)
       (set! backtrack? #f)
       (set! previous-action (stack-pop! (hash-table-ref untried state))))
     (lambda (state goal? score)
       (maybe-set-start! state)
       ;; (maybe-write-agent-as-png state score)
       (maybe-update-untried! untried state)
       (maybe-update-labels! labels state)
       (if previous-state
           (begin
             (maybe-update-result! result previous-state previous-action state)
             (maybe-update-unbacktracked! unbacktracked backtrack? previous-state state)
             ;; We could probably set this as a state variable
             ;; and avoid the lookup.
             (maybe-update-coordinates! coordinates previous-state previous-action state time))
           ;; We've been teleported to some previously unknow
           ;; location; let's designate it as the origin.
           (maybe-update-origin! coordinates state time))
       (if goal?
           (begin
             (debug "Goal found -- ONLINE-DFS-AGENT")
             (reset-state! state)
             zero-motion)
           (begin
             (if (untried? untried state)
                 (set-untried! state) 
                 (if (unbacktracked? unbacktracked state)
                     (set-unbacktracked! state)
                     (begin
                       (set! previous-action stop)
                       (error "Goal not found -- AGENT-ONLINE-DFS"))))
             (set! previous-state state)
             previous-action))))))

;; (simulate-navigation 50 100 "online-dfs.avi" make-agent-online-dfs)
(simulate-navigation make-agent-online-dfs
                     n-points: 10
                     n-steps: 100
                     ;; animation-file: "online-dfs.avi"
                     )

(include "online-navigation.scm")

(define (make-agent-random-walk start next-frame)
  (make-agent
   start
   0
   (lambda (points goal? score)
     (if goal?
         zero-motion
         (list-ref points (random (length points)))))))

(use aima-tessellation
     animation
     define-record-and-printer
     debug
     files
     format
     miscmacros
     random-bsd
     shell
     srfi-95
     stack)

(define-record-and-printer agent
  point
  score
  program)

(define zero-motion (make-point 0 0))
(define (zero-motion? move) (equal? move zero-motion))

(define origin (make-point 0 0))
(define (origin? move) (equal? move zero-motion))

(define-record-and-printer stop)
(define stop (make-stop))

(define (write-dot-preamble width height title score)
 (display "digraph G {")
 (display "node [shape=point];")
 (let ((width-in-inches (/ width 96))
       (height-in-inches (/ height 96)))
   (format #t "graph [fontsize=48, label=\"~a (Score: ~,2f)\", ratio=fill, viewport=\"~a,~a\", size=\"~a,~a!\", labelloc=t];"
           title
           score
           (* width-in-inches 72)
           (* height-in-inches 72)
           width-in-inches
           height-in-inches)))

;;; Oh, shit; we're going to have to assign absolute points here
;;; starting arbitrarily with the first node.
;;;
;;; Unless we have some kind of path, this is problematic; should we
;;; assign absolute coördinates as we discover them?
;;;
;;; Christ, maybe we should label these things as we find them, too.
;;;
;;; No, in order to coordinates rigorously; we're going to have to
;;; backtrack. Can we update as we go along? The map may change,
;;; depending on what root we find.
;;;
;;; No; let's wipe the absolute coordinates clean every time we
;;; teleport, but keep the relative ones.
(define (write-agent-as-dot points
                            coordinates
                            labels
                            result
                            untried
                            unbacktracked
                            previous-state
                            previous-action
                            start
                            goal
                            score)
  (write-dot-preamble 1600 900 "Online DFS" score)
  (let ((displayed (make-hash-table))
        (linear-scale (* 5 72)))
    (define (node-maybe-display state label)
      (hash-table-update!
       displayed
       state
       identity
       (lambda ()
         (let ((coordinate
                (coordinate-point
                 (hash-table-ref coordinates state))))
           (format #t "~a [pos=\"~a,~a\"~a];"
                   label
                   (* (point-x coordinate) linear-scale)
                   (* (point-y coordinate) linear-scale)
                   (cond ((equal? state start)
                          ", shape=circle, label=S")
                         ((equal? state goal)
                          ", shape=circle, label=G")
                         (else ""))))
         #t)))
    (hash-table-walk result
      (lambda (whence whither->action)
        (hash-table-walk whither->action
          (lambda (whither action)
            (let ((whence-label
                   (hash-table-ref labels whence))
                  (whither-label
                   (hash-table-ref labels whither)))
              (node-maybe-display whence whence-label)
              (node-maybe-display whither whither-label)
              (format #t "~a -> ~a [color=~a, penwidth=~a];"
                      whence-label
                      whither-label
                      (if (equal? whence previous-state)
                          "orange"
                          "blue")
                      (if (equal? whence previous-state)
                          2
                          1))))))))
  (display "}"))

(define (write-agent-as-png png
                            points
                            coordinates
                            labels
                            result
                            untried
                            unbacktracked
                            previous-state
                            previous-action
                            start
                            goal
                            score)
  (let ((dot (create-temporary-file ".dot")))
    (with-output-to-file dot
      (lambda () (write-agent-as-dot points
                                coordinates
                                labels
                                result
                                untried
                                unbacktracked
                                previous-state
                                previous-action
                                start
                                goal
                                score)))
    (run (neato -n1 -Tpng -o ,png < ,dot))))

(define-record-and-printer coordinate
  point
  time)

(define (simulate-navigation make-agent
                             #!key
                             (n-points 50)
                             (n-steps 1000)
                             (p-slippage 0)
                             (animation-file #f))
  (let ((world (tessellate n-points)))
    (let ((points (tessellation-points world))
          (neighbors (tessellation-neighbors world))
          (goal (tessellation-end world)))
      ;; (debug (length points))
      (receive (next-frame finalize!)
        (make-animator)
        (let* ((start (list-ref points (random (length points))))
               (agent (make-agent start next-frame)))
          (dotimes (step n-steps agent)
            (let* ((agent-point (agent-point agent))
                   (visible-points (hash-table-ref neighbors agent-point))
                   (relative-points
                    (map (lambda (point)
                           (make-point (- (point-x point) (point-x agent-point))
                                       (- (point-y point) (point-y agent-point))))
                         visible-points)))
              (let* ((goal? (equal? agent-point goal))
                     ;; Initial hypothesis: agent dictates a move.
                     (move ((agent-program agent) relative-points goal? (agent-score agent)))
                     ;; We may revise this to wind up somewhere else
                     ;; (ends up being less than p-slippage, because
                     ;; it may randomly select the point it meant to
                     ;; move to).
                     (move (if (< (random-real) p-slippage)
                               ;; Add the zero-motion case.
                               (list-ref (cons zero-motion relative-points)
                                         (random (add1 (length relative-points))))
                               move)))
                (debug move)
                (let* ((relative->visible-points
                        (alist->hash-table (zip relative-points visible-points)))
                       (new-point
                        (if (and (zero-motion? move) goal?)
                            (begin
                              (agent-score-set! agent (+ (agent-score agent) 1000))
                              (list-ref points (random (length points))))
                            (if (stop? move)
                                (error "Stop!")
                                (if (zero-motion? move)
                                    agent-point
                                    (begin
                                      (agent-score-set! agent
                                                        (- (agent-score agent)
                                                           (point-distance zero-motion move)))
                                      (make-point (+ (point-x move) (point-x agent-point))
                                                  (+ (point-y move) (point-y agent-point)))
                                      (car (hash-table-ref relative->visible-points move))))))))
                  (if goal? (debug (agent-score agent)))
                  (agent-point-set! agent new-point)))))
          (debug (agent-score agent))
          (when animation-file
            (finalize! animation-file)
            ;; (run (sudo -E vt mplayer -really-quiet -vo fbdev2 -loop 0 ,animation-file))
            ;; sudo mplayer -really-quiet -vo fbdev2 -vf scale=1440:900 online-dfs-random-statistics.avi
            ;; (run (sudo mplayer -vo fbdev2 -loop 0 ,animation-file))
            ;; (run (vt mplayer -really-quiet -vo fbdev2 -loop 0 ,animation-file))
            (run (mplayer -really-quiet -loop 0 ,animation-file)))
          (agent-score agent))))))

During the non-deterministic walk, we should update the statistics during each run; and show e.g. the most probably route when drawing the map.

(include "online-navigation.scm")

(define (maybe-update-untried! untried state)
  (unless (hash-table-exists? untried state)
    (hash-table-set!
     untried
     state
     (list->stack state))))

(define (maybe-update-labels! labels state)
  (unless (hash-table-exists? labels state)
    (hash-table-set!
     labels
     state
     (gensym))))

(define (maybe-update-result! result previous-state previous-action state)
  (hash-table-update!
   result
   previous-state
   (lambda (state->action)
     (hash-table-set! state->action state previous-action)
     state->action)
   (lambda () (make-hash-table))))

(define (maybe-update-unbacktracked! unbacktracked backtrack? previous-state state)
  (unless backtrack?
    (hash-table-update!
     unbacktracked
     state
     (lambda (backtracks)
       (stack-push! backtracks previous-state)
       backtracks)
     (lambda () (make-stack)))))

(define (maybe-update-coordinates! coordinates previous-state previous-action state time)
  ;; We could probably set this as a state variable
  ;; and avoid the lookup.
  (let* ((previous-coordinate
          (hash-table-ref coordinates previous-state))
         (previous-point (coordinate-point previous-coordinate)))
    (if (hash-table-exists? coordinates state)
        (let* ((coordinate (hash-table-ref coordinates state))
               (point (coordinate-point coordinate)))
          (when (< (coordinate-time coordinate) time)
            (let ((delta-x
                   (- (point-x point)
                      (+ (point-x previous-point)
                         (point-x previous-action))))
                  (delta-y
                   (- (point-y point)
                      (+ (point-y previous-point)
                         (point-y previous-action)))))
              (hash-table-walk coordinates
                (lambda (state old-coordinate)
                  (when (< (coordinate-time old-coordinate) time)
                    ;; (debug ;; (coordinate-time old-coordinate)
                    ;;  ;; time
                    ;;  delta-x
                    ;;  delta-y)
                    (coordinate-time-set! old-coordinate time)
                    (let ((old-point (coordinate-point old-coordinate)))
                      (coordinate-point-set!
                       old-coordinate
                       (make-point (- (point-x old-point) delta-x)
                                   (- (point-y old-point) delta-y))))))))))
        (hash-table-set!
         coordinates
         state
         (make-coordinate
          (make-point (+ (point-x previous-point)
                         (point-x previous-action))
                      (+ (point-y previous-point)
                         (point-y previous-action)))
          time)))))

(define (maybe-update-origin! coordinates state time)
  (unless (hash-table-exists? coordinates state)
    (hash-table-set!
     coordinates
     state
     (make-coordinate origin time))))

(define (untried? untried state)
  (stack-empty? (hash-table-ref/default untried state (make-stack))))

(define (unbacktracked? unbacktracked state)
  (stack-empty? (hash-table-ref/default unbacktracked state (make-stack))))

(define (make-agent-online-dfs start next-frame)
  (make-agent
   start
   0
   (let ((coordinates (make-hash-table))
         (labels (make-hash-table))
         ;; state->state->[[action_0, p_0], ..., [action_n, p_n]]
         (result (make-hash-table))
         ;; state->action->[[state_0, p_0], ..., [state_n, p_n]]
         (state->action->state (make-hash-table))
         (untried (make-hash-table))
         (unbacktracked (make-hash-table))
         (previous-state #f)
         (previous-action #f)
         (backtrack? #f)
         (time 0)
         (start #f)
         (goal #f))
     (define (reset-state! state)
       (set! goal state)
       (set! start #f)
       (set! previous-state #f)
       (set! previous-action #f)
       (set! backtrack? #f)
       (set! untried (make-hash-table))
       (set! unbacktracked (make-hash-table))
       (inc! time)
       ;; (if previous-state
       ;;     (hash-table-update!
       ;;      result
       ;;      previous-state
       ;;      (lambda (state->action)
       ;;        (hash-table-set! state->action state previous-action)
       ;;        state->action)
       ;;      (lambda () (make-hash-table))))
       )
     (define (maybe-write-agent-as-png state score)
       (unless (zero? (hash-table-size result))
         (write-agent-as-png (next-frame)
                             state
                             coordinates
                             labels
                             result
                             untried
                             unbacktracked
                             previous-state
                             previous-action
                             start
                             goal
                             score)))
     (lambda (state goal? score)
       (unless start
         (set! start state))
       (maybe-write-agent-as-png state score)
       (maybe-update-untried! untried state)
       (maybe-update-labels! labels state)
       (if previous-state
           (begin
             ;; (hash-table-update!
             ;;  state->action->state
             ;;  previous-state
             ;;  (lambda (action->state)
             ;;    (let* ((expected-state
             ;;            (hash-table-ref/default
             ;;             action->state
             ;;             previous-action
             ;;             #f))
             ;;           (navigation-error?
             ;;            (and expected-state
             ;;                 (equal? expected-state state))))
             ;;      (if expected-state
             ;;          (when navigation-error?
             ;;            (debug 'navigation-error))
             ;;          (hash-table-set!
             ;;           action->state
             ;;           previous-action
             ;;           state)))
             ;;    action->state)
             ;;  (lambda () (make-hash-table)))
             (maybe-update-result! result previous-state previous-action state)
             (maybe-update-unbacktracked! unbacktracked backtrack? previous-state state)
             (maybe-update-coordinates! coordinates previous-state previous-action state time))
           ;; We've been teleported to some previously unknown
           ;; location; let's designate it as the origin.
           (maybe-update-origin! coordinates state time))
       (if goal?
           (begin
             (debug "Goal found -- ONLINE-DFS-AGENT")
             (reset-state! state)
             zero-motion)
           (begin
             (if (untried? untried state)
                 (if (unbacktracked? unbacktracked state)
                     (begin
                       ;; (set! previous-action stop)
                       ;; (error "Goal not found -- AGENT-ONLINE-DFS")
                       (set! previous-action (list-ref state (random (length state))))
                       (debug "Goal not found -- AGENT-ONLINE-DFS"))
                     (let* ((backtrack (stack-pop! (hash-table-ref unbacktracked state)))
                            (backtrack-action
                             (hash-table-ref (hash-table-ref result state) backtrack)))
                       (debug 'backtrack)
                       (set! backtrack? #t)
                       (set! previous-action backtrack-action)
                       (set! previous-action (list-ref state (random (length state))))))
                 (begin
                   (set! backtrack? #f)
                   (set! previous-action (stack-pop! (hash-table-ref untried state)))))
             (set! previous-state state)
             previous-action))))))

(simulate-navigation make-agent-online-dfs
                     n-points: 10
                     n-steps: 100
                     p-slippage: 0
                     animation-file: "slippage.avi")

On the other hand, untried and unbacktraced are deterministic; movement and error correction are non-deterministic.

state->action->state can be statistical; state->state->action deterministic, based on best-guess?

That’s still going to have implications for backtracking, though; we’re going to have to implement error correction into backtracking. Can we do that by integrating it with the error stack? The error stack is more generally the planning stack?

I want to implement the error correction planner with the random walker, because it’s simpler; worry about integration with the online depth-first-search later.

God, it would be great to integrate it with a LRTA*, too.

Let’s see if we can try it out on the random-walk, to avoid the depth-first overhead?

(include "online-navigation.scm")

(use heap)

(define (write-dot-preamble width height title)
 (display "digraph G {")
 (display "node [shape=point];")
 (let ((width-in-inches (/ width 96))
       (height-in-inches (/ height 96)))
   (format #t "graph [fontsize=48, label=\"~a\", ratio=fill, viewport=\"~a,~a\", size=\"~a,~a!\", labelloc=t];"
           title
           (* width-in-inches 72)
           (* height-in-inches 72)
           width-in-inches
           height-in-inches)))

(define (make-agent-random-walk start next-frame)
  (make-agent
   start
   0
   (let ((state->action->states (make-hash-table))
         (state->state->actions (make-hash-table))
         (previous-state #f)
         (previous-action #f)
         (expectations 0)
         (met-expectations 0)
         (contingency-plans (make-stack))
         (coordinates (make-hash-table))
         (labels (make-hash-table))
         (time 0))

     (define (update-labels! state)
       (unless (hash-table-exists? labels state)
         (hash-table-set!
          labels
          state
          (gensym))))

     ;; Coordinates are a little different here: takes best-guess into
     ;; account.
     (define (update-coordinates! state)
       (let* ((possible-actions
               (hash-table-ref/default
                (hash-table-ref/default
                 state->state->actions
                 previous-state
                 (make-hash-table))
                state
                (make-max-heap)))
              (action
               (if (heap-empty? possible-actions)
                   previous-action
                   (heap-extremum possible-actions))))
         (let* ((previous-coordinate
                 (hash-table-ref/default
                  coordinates
                  previous-state
                  (make-coordinate origin time)))
                (previous-point
                 (coordinate-point previous-coordinate)))
           (if (hash-table-exists? coordinates state)
               (let* ((coordinate (hash-table-ref coordinates state))
                      (point (coordinate-point coordinate)))
                 (when (< (coordinate-time coordinate) time)
                   (let ((delta-x
                          (- (point-x point)
                             (+ (point-x previous-point)
                                (point-x previous-action))))
                         (delta-y
                          (- (point-y point)
                             (+ (point-y previous-point)
                                (point-y previous-action)))))
                     (hash-table-walk coordinates
                       (lambda (state old-coordinate)
                         (when (< (coordinate-time old-coordinate) time)
                           (coordinate-time-set! old-coordinate time)
                           (let ((old-point (coordinate-point old-coordinate)))
                             (coordinate-point-set!
                              old-coordinate
                              (make-point (- (point-x old-point) delta-x)
                                          (- (point-y old-point) delta-y))))))))))
               (hash-table-set!
                coordinates
                state
                (make-coordinate
                 (make-point (+ (point-x previous-point)
                                (point-x action))
                             (+ (point-y previous-point)
                                (point-y action)))
                 time))))))

     (define (update-statistics! state)
       (hash-table-update!
        state->action->states
        previous-state
        (lambda (action->states)
          (hash-table-update!
           action->states
           previous-action
           (lambda (states)
             (if (heap-member? states state)
                 (heap-change-key! states
                                   state
                                   (add1 (heap-key states state)))
                 (heap-insert! states
                               1
                               state))
             states)
           (lambda () (make-max-heap)))
          action->states)
        ;; Too bad we don't have multi-dimensional hash-tables.
        (lambda () (make-hash-table)))
       (hash-table-update!
        state->state->actions
        previous-state
        (lambda (state->actions)
          (hash-table-update!
           state->actions
           state
           (lambda (actions)
             (if (heap-member? actions previous-action)
                 (heap-change-key! actions
                                   previous-action
                                   (add1 (heap-key actions previous-action)))
                 (heap-insert! actions
                               1
                               previous-action))
             actions)
           (lambda () (make-max-heap)))
          state->actions)
        (lambda () (make-hash-table))))

     (define (update-goals! previous-state expected-state state)
       (if (not-unexpected-state? expected-state state)
           (begin
             (debug "This state is not unexpected."))
           (begin
             (debug "This state is statistically anomolous.")
             (debug "Pushing the expected-state unto contingency-plans.")
             (debug expected-state)
             ;; (stack-push! contingency-plans expected-state)
             (stack-push! contingency-plans (lambda (state) expected-state))
             (unless (equal? previous-state state)
               (debug "Pushing the previous-state unto contingency-plans.")
               (debug previous-state)
               (stack-push! contingency-plans (lambda (state) previous-state))))))

     (define (expected-state)
       (let* ((possible-states
               (hash-table-ref/default
                (hash-table-ref/default
                 state->action->states
                 previous-state
                 (make-hash-table))
                previous-action
                (make-max-heap))))
         (and (not (heap-empty? possible-states))
              (heap-extremum possible-states))))

     (define (not-unexpected-state? expected-state state)
       (or (not expected-state)
           (equal? state expected-state)))

     (define (reset!)
       (set! previous-state #f)
       (set! previous-action #f)
       (set! contingency-plans (make-stack))
       (inc! time))

     (define (move state action)
       (set! previous-state state)
       (set! previous-action action)
       (debug action)
       action)

     (define (move-randomly state)
       (debug "Moving randomly.")
       (move state (list-ref state (random (length state)))))

     (define (move-backwards-or-randomly expected-state state)
       (let* ((return
               (hash-table-ref/default
                (hash-table-ref/default
                 state->state->actions
                 state
                 (make-hash-table))
                expected-state
                (make-max-heap)))
              (return
               (and (not (heap-empty? return))
                    (heap-extremum return))))
         (if return
             (begin
               (debug "Attempting to return.")
               (move state return))
             (begin
               (debug "Can't return.")
               (debug "Pushing a contingency unto contingency plans.")
               (stack-push! contingency-plans
                            (lambda (state)
                              (if (equal? state expected-state)
                                  expected-state
                                  state)))
               (move-randomly state)))))

     (define (iterate-over-goals state)
       (if (stack-empty? contingency-plans)
           (begin
             (debug "There are no expected states.")
             (move-randomly state))
           (begin
             ;; (debug (map (lambda (plan) (plan state))
             ;;             (stack->list contingency-plans)))
             (debug (stack-count contingency-plans))
             (let ((expected-state ((stack-peek contingency-plans) state)))
               (debug expected-state state)
               (if (equal? state expected-state)
                   (begin
                     (debug "We're at the expected state; popping contingency plans.")
                     (stack-pop! contingency-plans)
                     (iterate-over-goals state))
                   (begin
                     (debug "We're not at the expected state; trying to backtrack.")
                     (move-backwards-or-randomly expected-state state)))))))

     (define (write-agent-as-dot state)
       (let ((displayed (make-hash-table))
             (linear-scale (* 5 72))
             (contingencies (map (lambda (contingency-plan)
                                   (contingency-plan state))
                                 (stack->list contingency-plans))))

         (define (node-display state label)
           (unless (hash-table-exists? displayed state)
             (hash-table-set! displayed state #t)
             (let ((coordinate
                    (hash-table-ref/default coordinates
                                            state
                                            (make-coordinate origin time))))
               (format #t "~a [pos=\"~a,~a\"~a];"
                       label
                       (* (point-x (coordinate-point coordinate)) linear-scale)
                       (* (point-y (coordinate-point coordinate)) linear-scale)
                       (if (member state contingencies equal?)
                           ", shape=circle, label=E, color=red"
                           "")))))

         ;; (write-dot-preamble 800 450 "Random walk with error correction")
         (write-dot-preamble 1600 900 "Random walk with error correction")

         (hash-table-walk state->action->states
           (lambda (whence action->states)
             (let ((whence-label (hash-table-ref labels whence)))
               (node-display whence whence-label)
               (hash-table-walk action->states
                 (lambda (action whithers)
                   (let ((whithers (reverse (heap->list whithers))))
                     (let ((solid (car whithers))
                           (non-solids (cdr whithers)))
                       (let ((solid-label (hash-table-ref labels solid))
                             (non-solids-labels
                              (map (lambda (non-solid)
                                     (hash-table-ref labels non-solid))
                                   non-solids)))
                         (node-display solid solid-label)
                         (format #t "~a -> ~a [color=~a];"
                                 whence-label
                                 solid-label
                                 (if (or (member whence contingencies equal?)
                                         (member solid contingencies equal?))
                                     "red"
                                     (if (and (equal? whence previous-state)
                                              (equal? solid state))
                                         "orange"
                                         "blue")))
                         (for-each (lambda (non-solid non-solid-label)
                                     (node-display non-solid non-solid-label)
                                     (format #t "~a -> ~a [style=dashed, color=~a];"
                                             whence-label
                                             non-solid-label
                                             (if (or (member whence contingencies equal?)
                                                     (member non-solid contingencies equal?))
                                                 "red"
                                                 (if (and (equal? whence previous-state)
                                                          (equal? non-solid state))
                                                     "orange"
                                                     "blue"))))
                           non-solids
                           non-solids-labels)))))))))

         ;; Let's just take the top one for now? Theoretically, we'd
         ;; take state->action->states; make solid the top and dash
         ;; the rest.
         ;; (hash-table-walk state->state->actions
         ;;   (lambda (whence state->actions)
         ;;     (hash-table-walk state->actions
         ;;       (lambda (whither actions)
         ;;         (let ((whence-label (hash-table-ref labels whence))
         ;;               (whither-label (hash-table-ref labels whither)))
         ;;           (node-display whence whence-label)
         ;;           (node-display whither whither-label)
         ;;           (format #t "~a -> ~a [color=~a];"
         ;;                   whence-label
         ;;                   whither-label
         ;;                   (if (equal? whence previous-state)
         ;;                       "orange"
         ;;                       "blue")))))))
         (display "}")))

     (define (write-agent-as-png png state)
       (unless (zero? (hash-table-size state->state->actions))  
       (let ((dot (create-temporary-file ".dot")))
           (with-output-to-file dot
             (lambda ()
               (write-agent-as-dot state)))
           (run (neato -n1 -Tpng -o ,png < ,dot)))))

     (lambda (state goal? score)
       (debug state goal?)
       (update-labels! state)

       (when previous-action
         (update-statistics! state)
         (update-coordinates! state))

       (write-agent-as-png (next-frame) state)

       (if goal?
           (begin
             (debug "Found goal.")
             (reset!)
             zero-motion)
           (if previous-action         ; Implied: previous-state, too.
               (let ((expected-state (expected-state)))
                 (update-goals! previous-state expected-state state)
                 (iterate-over-goals state))
               (move-randomly state)))))))

(parameterize ((debug? #f))
  (simulate-navigation make-agent-random-walk
                       n-points: 20
                       n-steps: 200
                       p-slippage: 0.3
                       animation-file: "online-dfs-random-statistics.avi"
                       ;; animation-file: #f
                       ))

After about \(10,000\) trials, converges on an expected-location / movement ratio of about \(0.81\):

(((exact->inexact (/ met-expectations expectations)) 0.811181118111811))

defies-expectation? is either because we have a plan that failed (i.e. tried to backtrack to some known square), or we have a statistical anomaly; in that case: need an expectation-stack. Do the reduce to the same case?

Backtrack preemptively pushes to expectation-square; this for LRTA*, or any goal-directed plan, for that matter.

With the latest code, by the way, the ratio is even higher:

(((/ met-expectations expectations) 0.900673569920579))

Have to think about why this is the case.

Don’t we have to distinguish somehow between: I’m not at an unexpected state (statistically speaking or de novo) vs. I’ve achieved this error-correction goal?

Maybe we should call it the error-correction stack instead of the expected-states stack.

Here’s an interesting case:

((move #(point 0 0)))
((state (#(point 0.232025 -0.019276)
         #(point -0.024151 -0.03691)
         #(point -0.065342 0.178348))))
(("This state contradicts my expectations based on stats."
  "This state contradicts my expectations based on stats."))
(("Here's the first expected state on the stack:"
  "Here's the first expected state on the stack:")
 (expected-state
   (#(point 0.037821 -0.306753)
    #(point 0.024151 0.03691)
    #(point -0.303238 -0.132122))))
(((stack-count expected-states) 1))
(("Trying to return" "Trying to return"))
((action #(point -0.024151 -0.03691)))
((move #(point 0 0)))
((state (#(point 0.232025 -0.019276)
         #(point -0.024151 -0.03691)
         #(point -0.065342 0.178348))))
(("This state contradicts my expectations based on stats."
  "This state contradicts my expectations based on stats."))
(("Here's the first expected state on the stack:"
  "Here's the first expected state on the stack:")
 (expected-state
   (#(point 0.037821 -0.306753)
    #(point 0.024151 0.03691)
    #(point -0.303238 -0.132122))))
(((stack-count expected-states) 2))
(("Trying to return" "Trying to return"))
((action #(point -0.024151 -0.03691)))
((move #(point -0.024151 -0.03691)))
((state (#(point 0.037821 -0.306753)
         #(point 0.024151 0.03691)
         #(point -0.303238 -0.132122))))
(("I'm not at an unexpected state." "I'm not at an unexpected state."))
(("Popping from expected states" "Popping from expected states"))
(("Popping from expected states" "Popping from expected states"))
(("There aren't any expected states on the stack."
  "There aren't any expected states on the stack."))
((move #(point -0.303238 -0.132122)))

It tries to move and sticks, then tries to recover and sticks; two of the same state are on the expected-states stack. It recovers and removes them successively.

Should we watch out for this case somehow?

This looks like trouble:

((move #(point 0 0)))
((state (#(point -0.27045 0.081585)
         #(point 0.128703 -0.166269)
         #(point 0.268297 0.066291))))
(("This state contradicts my expectations based on stats."
  "This state contradicts my expectations based on stats."))
(("Here's the first expected state on the stack:"
  "Here's the first expected state on the stack:")
 (expected-state
   (#(point 0.065893 0.021618)
    #(point 0.570076 -0.385706)
    #(point -0.268297 -0.066291))))
(((stack-count expected-states) 1))
(("Trying to return" "Trying to return"))
((action #(point 0.268297 0.066291)))
((move #(point -0.27045 0.081585)))
((state (#(point 0.27045 -0.081585)
         #(point -0.124748 -1.105556)
         #(point -0.0990089999999999 0.105484))))
(("I'm not at an unexpected state." "I'm not at an unexpected state."))
(("Here's the first expected state on the stack:"
  "Here's the first expected state on the stack:")
 (expected-state
   (#(point 0.065893 0.021618)
    #(point 0.570076 -0.385706)
    #(point -0.268297 -0.066291))))
(((stack-count expected-states) 1))
(("Trying to return" "Trying to return"))
((action #(point -0.124748 -1.105556)))
((move #(point -0.124748 -1.105556)))
((state (#(point 0.124748 1.105556)
         #(point 0.214512 -0.149823)
         #(point -0.885656 -0.313053))))
(("I'm not at an unexpected state." "I'm not at an unexpected state."))
(("Here's the first expected state on the stack:"
  "Here's the first expected state on the stack:")
 (expected-state
   (#(point 0.065893 0.021618)
    #(point 0.570076 -0.385706)
    #(point -0.268297 -0.066291))))
(((stack-count expected-states) 1))
(("Trying to return" "Trying to return"))
((action #(point 0.124748 1.105556)))
((move #(point -0.885656 -0.313053)))

Attempts to return; fails; but doesn’t put failure on the expected stack. Makes me believe that we’re not distinguishing the proper cases.

Cases for popping something on expectation stack: 1. statistical anomaly (based on current data); 2. we didn’t achieve the last expected goal.

The cases are not mutually exclusive; given 2., 1. is not sufficient to push unto the expected-values stack. (2. should be generalized to include any goal on the stack, no matter how deep; that leads to some kind of stack data-structure with O(1) membership testing and random access.)

,- Update statistics
,- A: Are there goals to be achieved?
,  - Did we achieve the latest goal?
,    - Begin
,      - Pop off the goal-stack
,      - Goto A
,    - Begin
,      - B: Push previous-state unto goals
,      - Do we have a hypothesis as to how to get back to the latest
,        goal?
,        - Try it
,        - Move randomly
,  - Did we reach terminal goal?
,    - Begin
,      - Reset!
,      - Null-move
,    - Is this state statistically anomolous?
,      - Goto B
,      - Move randomly

• Might accidentally encounter a node somewhere in the error-correction stack
• Heap? Hash-table-backed stack? Indexed heap?
• Keep statistics during the excursion.
• Diverge? Depth-first back.
• Stastistical model of “next” node.
• Random distribution of probabilities, some asymmetrical.

• A related drawback of A * and IDA* is that they must search all the way to a solution before making a commitment to even the first move in the solution. The reason is that an optimal first move cannot be guararteed until the entire solution is found and shown to be at least as good as any other solution. As a result, A * and IDA* are run to completion in a planning or simulation phase before the first move of the resulting solution is executed in the real world.
• Whereas the focus on optimal solutions has seriously limited the applicabality of heuristic search in single-agent problems, the search paradigm has been spectacularly succesful in two-player games.
• The goal of this research is to apply the assumptions of two-player games, namely limited search horizon and commitment to moves in constant time, to single-agent heuristic searches.
• In RTA*, the merit of a node n is f(n) = g(n) + h(n), as in A*. However, unlike A*, the interpretation of g(n) in RTA* is the actual distance of node n from the current state of the problem solver, rather than from the original initial state.
• The key difference between RTA* and A* is that in RTA* the merit of every node is measured relative to the current position of the problem solver, and the initial state is irrelevant.
• RTA* is simply a best-first search given this slightly different cost function.
• The algorithm maintains in a hash table a list of those nodes that have been visited by an actual move of the problem solver, together with an h value for those nodes.
• At each cycle of the algorithm, the current state is expanded, generating its neighbors, and the heuristic function, possibly augment by lookahead search, is applied to each state which is not in the hash table.
• For those states in the table, the stored value of h is used instead.
• In addition, the cost of the edge to each neighboring state is added to this value, resulting in an f value for each neighbor of the current state.
• The node with the minimum f-value is chose for the new current state and a move to that state is executed.
  • This implies that h(s) is 0?
• At the same time, the previous current state is stored in the hash table, and associated with it is the second best f value.
• The second best f value is the best of the alternatives that were not chosen, and represents the estimated h cost of solving the problem by returning to this state, from the perspective of the new current state.
• If there is a tie among the best values, then the second best will equal the best.
• The running time is also linear in the number of moves made. . . Even though the lookahead requires time that is exponential in the search depth, the search depth is bounded by a constant.
• For each of the children c_i of x, if c_i is not in the table, minimin search will be used to compute f_x(c_i).
• Both minimin lookahead search and RTA* must be significantly modified to guarantee locally optimal decisions on a graph.
• The only way to remove such systematic biases, without further information, is to break ties randomly.
• A more sophisticated approach to tie-breaking would use a secondary search to discriminate between tied alternatives.
  • h(n) = 0 until we find the goal and come up with absolute coordinates; that’s a little tricky: we need to be in the same time space as the goal to trust the absolute coordinates, don’t we?
• Solution lengths tend to decrease with increasing search depth.
• Learning RTA*: successively solving multiple problem instances in the same problem space with the same set of goals.
• The information saved from one trial to the next is the hash table of values recorded for previously visited states.
• If the best estimate turns out to be correct, then storing the second best value can result in inflated values for some states. These inflated values will direct the agent in the wrong direction on subsequent problem solving trials.
• This difficulty can be overcome simply by modifying the algorithm to store the best value in the previous state instead of the second best value.
• LRTA* retains the completeness property of RTA*; it does not, however, always make locally optimal decisions.
• Will bounce back and forth between the 5 states until it “fills in the hole.”
• Repeated problem solving trials cause the heuristic values to converge to their exact values.
• Heuristic values are admissible: do not overestimate the distance to the nearest goal. Ties are broken randomly.
  • h(n) = 0 until appropriate straight-line-heuristic; that’s some work. Let’s do it.
• As before, if node n has never been visited, then h(n) is its heuristic static evaluation.
  • What the fuck is this?
• Otherwise, h(n) is the heuristic value stored with node n the last time it was visited by LRTA*.
• A node n is correct if h(n) = h*(n), where h*(n) is the actual cost of an optimal path from node n to a goal node.
• When a node n is visited by LRTA*, its new value h(n) is equal to the minimum value of k(n, n') + h(n') over all neighbors of n' of n, where k(n, n') is the cost of the edge from n to n'.
• Consider a path (n_s, n₂, …, n_g) about to be traversed by LRTA* from an initial state n_s to a goal state n_g. Since we assume non-overestimating heuristic values, h(n_g) = 0 = h*(n_g).
  • The “optimism under uncertainty” principle dictates unknown h(n) are 0, right? “One important detail is that actions that have not yet been tried in a state s are always assumed to lead immediately to the goal with the least possible cost, namely h(s).”
• The initial heuristic values are all zero, demonstrating that perfect values can be learned with no initial information.
  • Voilà! A refinement of this is: if we have straight-line distance (i.e. we’re in a contiguous absolute plane which contains the goal in the same time-series), and the straight-line distance is greater than h(n), use straight-line.

CLOSED: 2013-04-17 Wed 14:21

States

Location of the eight tiles and blank for each puzzle

Initial state

Each puzzle in any state (due to even/odd permutations, though, only half of which are solvable for a given end-state)

Actions

Left, right, up, down applied to one of the puzzles

Transition model

Given state, action, puzzle: the result of applying action to that puzzle’s state

Goal test

Whether each puzzle matches its goal configuration (arbitrary)

Path cost

Unit per move

CLOSED: 2013-04-17 Wed 14:21
An 8-puzzle has \(9!/2 = 181,440\) reachable states; for each state of one puzzle, the other has \(9!/2\) reachable state; total states are therefore \(9!/2 * 9!/2 = 9!^2/4 = 32,920,473,600\).

CLOSED: 2013-04-17 Wed 14:21
Expectiminimax is appropriate in the adversarial case.

CLOSED: 2013-04-17 Wed 14:21
Provided that the end-state belongs to the same (even or odd) permutation as the start-state, every 8-puzzle is solvable.

Let’s say heads = puzzle 1, tails = puzzle 2. In the case where the coin comes up perpetually heads and the solution is an even number of moves away, it may be possible to defer loss by scrambling tiles; the adversary will unscramble to restore win by an odd number of moves.

This will go on until tails is produced; upon returning to heads, the player will attempt to restore win-by-odd. Given a fair coin, the lose-by-even player can only defer loss for so long.

CLOSED: 2013-04-18 Thu 19:16

CLOSED: 2013-04-18 Thu 19:16

CLOSED: 2013-04-18 Thu 19:16

CLOSED: 2013-04-18 Thu 19:15

ce and cf lead back to bd with an additional penalty of \(-4\); same with ae and af. ac, however, leads to cc with a score of \(-4\) but (assuming that the adversary minimizes the pursuer’s score) will choose instead bd, also with a total penalty of \(-8\).

CLOSED: 2013-04-18 Thu 19:15

CLOSED: 2013-04-18 Thu 19:15
If the map is a tree and the adversaries start an even number of squares apart, the pursuer can always force mate; odd, however, the pursuee can evade by slipping past the pursuer.

In a graph with cycles, the pursuee can evade by sticking to the cycle of a circuit and reversing direction if need be.

• Had to redefine the rational from "exercizing reason" to "maximizing utility function" because they gave up an AI as thinking machines in the 60s.
• Mitochondria were once autonomous agents; cells as composite agents
• Thin vs. thick agents and skynet
• In games like poker, the mind of the adversarial agents are part of the environment; requires a theory of mind to discern things like: "is he bluffing?"

• David has the international version, which would have you write an essay on evolution and autonomy; see e.g. Turing on child AI:

  We have thus divided our problem into two parts. The and child-programme the education process. These two remain very closely connected. We cannot expect to find a good child-machine at the first attempt. One must experiment with teaching one such machine and see how well it learns. One can then try another and see if it is better or worse. There is an obvious connection between this process and evolution, by the identifications

  Structure of the child machine

  Hereditary material

  Changes

  Mutations

  Natural selection

  Judgment of the experimenter

  One may hope, however, that this process will be more expeditious than evolution. The survival of the fittest is a slow method for measuring advantages. The experimenter, by the exercise of intelligence, should be able to speed it up. Equally important is the fact that he is not restricted to random mutations. If he can trace a cause for some weakness he can probably think of the kind of mutation which will improve it.

• Each parameter in the agent-program corresponds to a sensor.
• Should we pass a status-variable into the sensor instead of a boolean? Might be more consistent with the singletons. Nah, fuck it.

• Michael mentioned that the triangle-inequality based consistency (monotonicity) condition states merely that the heuristic function monotonically decrease as you approach the goal.

One dimensional n-square puzzles cannot move even within even or odd permutations.

This is even:

[ 1 2 3 Ø ]

and this is also even:

[ 3 1 2 Ø ]

However, the latter state is unreachable from the former.

Does three dimensions allow us to switch between even and odd sets just like one dimension took that away (vis à vis degrees of freedom)? Jury is out; make the game graph, search.

Three-dimensional cube:

[ 2 1 ]
[ 3 4 ]

[ 7 Ø ]
[ 6 5 ]

Using the triangle inequality, a straight line between S and E that is interrupted by a convex polygon, must have a shortest path along the vertices of the interrupting polygon?

At the LA Hackathon with Ryan; proposed a thing wherein people cherry-pick interesting problems, present them. Optionally collaborate.

• Come up with pathological cases: different costs from A \(\to\) B vs. B \(\to\) A.
• Recombination of paths?
• A*, hill-climbing, and GA applied to TSP.
• Matt Forbes

• Absolute position of goal vs. relative position of goal every turn.

• Teleported to free-space or vertex?
• Identify nodes as percepts
• Hash points
• Polar vs. cartesian relativism
• Similarity to simulated annealing
• Expanding frontier

• Two dimensions: thought vs. action, humanity vs. rationality.
• Physical simulation of a person is unnecessary for intelligence.
  • Mind-body dualism of Descartes?
• Cognitive science brings together computer models from AI and experimental techniques from psychology.
• Real cognitive science, however, is necessarily based on experimental investigation of actual humans.
• The standard of rationality is mathematically well defined and completely general.
• We will adopt the working hypothesis that perfect rationality is a good starting point for analysis.
• Limited rationality: acting appropriately when there is not enough time
• Materialism, which holds that the brain's operation according to the laws of physicas constitutes the mind.
• Logical positivism
• Carnap, The Logical Structures of the World, was probably the first theory of mind as a computational process.
• Intelligence requires action as well as reasoning.
• Actions are justified by a logical connection between goals and knowledge of the action's outcome.
• Regression planning system
• The leap to a formal science required a level of mathematical formalization: logic, computation, probability.
• The world is an extremely large problem instance.
• Models based on satisficing—making decisions that are "good enough"—gave a better description of actual human behavior.
• Searle: brains cause minds.
• Behaviorism
• "A cognitive theory should be like a computer program."
• Intelligence and an artifact
• Parallelism—a curious convergence with the properties of the brain.
• The state of a neuron was conceived of as "factually equivalent to a proposition which proposed its adequate stimulus." McCulloch and Pitts (1943)
  • Neural events and the relations among them can be treated by means of propositional logic.
  • For any logical expression satisfying certain conditions, one can find a net behaving in the fashion it describes.
  • For every net behaving under one assumption, there exists another net which behaves under the other and gives the same results.
• Perhaps "computational rationality" would have been more precise and less threatening, but "AI" stuck.
• AI from the start embraced the idea of duplicating human faculties such as creativity.
• John McCarthy referred to this period as the "Look, Ma, no hands!" era.
• "A physical symbol system has the necessary and sufficient means for general intelligent action."
• 1958 . . . McCarthy define Lisp, which was to become the dominant AI programming language for the next 30 years.
• It is useful to have a formal, explicit representation of the world and its workings and to be able to maniplutae that representation with deductive processes.
• McCarthy, Programs with Common Sense
  • In this program the procedures will be described as much as possible in the language itself and, in particular, the heuristics are all so described.
  • If one wants a machine to be able to discover an abstraction, it seems most likely that the machine must be able to represent this abstraction in some relatively simple way.
  • The improving mechanism should be improvable.
  • Must have or evolve concepts of partial success.
    • Something about ~1995 that made for a cute blog.
  • For example, to mest people, the number 3812 is not an object: they have nothing to say about it except what can be deduced from its structure. On the other hand, to most Americans the number 1776 is an object because they have filed somewhere the fact that it represents the year when the American Revolution started.
  • One might conjecture that division in man between conscious and unconscious thought occurs at the boundary between stimulus-response heuristics which do not have to be reasoned about but only obeyed, and the others which have to serve as premises in deductions.
• Machine evolution (genetic algorithms): Friedberg, 1958, 1959.
  • Friedberg. 1958. A learning machine Part 1. IBM Journal of Research and Development, 2, 2–13.
    • From and intent, to be sure, are related quite discontinuously in the compact, economical programs that programmers wrte.
  • Friedberg, Dunham, North. 1959. A learning machine, Part 2. IBM Journal of Research and Development, 3, 282–287.
• Failure to come to grips with the "combinatorial explosion"
• The new back-propagation learning algorithms for multilayer netwrks that were to cause an enormous resurgence in neural-net research in the late 1980s were actually discovered first in 1969.
• Bruce Buchanan: a philosopher turned computer scientist
• DENDRAL was the first successful knowledge-intensive system (expert system).
• AI Winter
• Parallel Distributed Processing (Rumelhart, McClelland. 1986)
• Connectionist models: competitors to symbols models and logicist approach
• Ones that act rationally according to the laws of decision theory and do not try to imitate the thought steps of human experts
• Control theory deals with designing devices that act optimally on the basis of feedback from the environment.

• Rational agents
• Agents behaves as well as possible (utility function?)
• Agent perceives its environment through sensors and acts through actuators.
  • Hands are actuators and sensors.
• agent's perceptual inputs at any given instant
• Agent's choice depends on percept sequence to date.
• maps percept sequence to action.
• External characterization of agent (agent function): table mapping percept sequences to actions; internally: agent program.
• In a sense, all areas of engineering can be seen as designing artifacts that intaract with the world.
  • Trivializing agents to view e.g. calculators as such.
• Intelligent agents, on the other hand: non-trivial decision making.
• Rational agents: does the right thing (utility).
• Performance measure
  • (This all sounds reminiscent of Mitchell, by the way.)
• Sequence of actions causes the environment to go through states: environmental states are distinct from agent states.
  • Basing performance merely off of agent-states is a form of coherentism.
• Design performance measures according to what one actually wants in the environment.
• "We leave these question as an exercise for the diligent reader."
  • Classic.
• Rationality: performance measure, agent's prior (i.e. a priori) knowledge, agent's actions, agent's percept sequence.¹⁰
  • "Percept," it turns out, is the converse of "concept": "A Percept or Intuition is a single representation . . . a Concept is a collective (general or universal) representation of a whole class of things." (F. C. Bowen Treat. Logic)
• For each percept sequence, a rational agent should select an action that is expected to maximize its performance measure, given its percept sequence and a priori knowledge.
• Omniscience vs. rationality
• Rationality maximizes expected performance; perfection, actual performance.
• Our definition of rationality does not require omniscience.
  • It's possible sometimes, by the way, to detect transitions in authorship.
• Information gathering: actions in order to modify future percepts.
• a priori rather than percepts: lacks autonomy.
• Ration agent: autonomous; boostrap with a priori, though.
• Just as evolution provides animals with built-in reflexes to survive long enough to learn for themselves
• Task environments
• Performance, Environment, Actuators, Sensors
  • Mitchell has: task, performance measure, training experience, target function, target function representation.
• Fully observable vs. partially observable environment.
• Task environment effectively fully observable if the sensors detect all aspects that are relevant to the choice of action, performance measure.
• Single agent vs. multiagent
• Entity may vs. must be viewed as an agent.
• Competitive vs. cooperative multiagent environment
• Communication
• In some competitive environments, randomized behavior is rational because it avoids predictability.
• Deterministic vs. stochastic environment
• "Uncertain" environment: not fully observable or not deterministic
• Stochastic: uncertainty about outcomes quantified in terms of probabilities; nondeterministic: actions characterized by possible outcomes, no probabilities attached.
• Episodal vs. sequential: atomic episodes: receives percept and performs single action; sequential: current decision affect all future decisions.
• Static vs. dynamic: environment change while agent is deliberating.
• Discrete vs. continuous: state of the environment, time, percepts, actions.
• Known vs. unknown: "laws of physics" of the environment
• Hardest: partially observable, multiagent, stochastic, sequential, dynamic, continuous, unknown.
• Code repository includes environment simulator that places one or more agents in a simulated environment, observes their behavior over time, evaluates them according to a given performance measure.
  • Shit: this is something we could implement in Scheme (java, python, lisp, data); lot of work, though? Glory?
    • A lot of the utilities are in SRFI-1; e.g. transpose is zip.
    • Infinity is there.
    • Might have to write rms-error; ms-error.
    • sample-with-replacement; sample-without-replacement
      • Combinatorics SRFI, anyone?
    • fuzz
    • print-grid, &c.
    • the-biggest, the-biggest-random-tie, the-biggest-that, &c.
    • Binary tree stuff
    • Queue
    • Heap
    • They did CLOS-like stuff
  • Damn, they put some work in; could do it incrementally? Will be ad-hoc, I guarantee it.
  • Maybe we can program it, given the agents API.
    • run-environment looks like something central.
  • What would happen if we merely translated the code to Chicken? Could do so, perhaps, without fully understanding it; write an idiomatically Scheme-port later.
  • In that case, find some alternative to CLOS; or use tinyCLOS?
  • Also, beginning to think that we misnamed our repo: we're calling it aima, but we'd like to write an aima egg; with aima-agents, aima-search, aima-logic, aima-planning, aima-uncertainty, aima-learning, aima-language modules.
    • Call it aima-egg? aima-chicken?
  • Translation seems like the way to go: relatively mechanical.
  • Incidentally, "We need a new language for logical expressions, since we don't have all the nice characters (like upside-down A) that we would like to use." We can use ∀ in Scheme, can't we? Sure. Tough to type? Maybe. Also, think font-lock.
  • May not be up-to-date for 3e; let's see; also, rife with defmethod and other OOisms. Can ignore it, possibly, and its type-checking; defstructure is similar, I think, to SRFI-9.
  • Damn, they implemented unification.
  • Not to mention: the learning stuff (e.g. decision trees).
  • Man, should we implement this stuff ad-hoc; or otherwise depend on the existing implementations?
  • Path of least resistance: do it in Allegro? Ouch.
• The job of AI is to design an agent program that implements the agent function, the mapping from percepts to actions.
• Agent = architecture + program
• The agent program takes the current percept as input; the agent function, which takes the entire percept history.
• The agent function that the program embodies
• Write programs that produce rational behavior from a smallish program rather than a vast table.
• Reflex agents; model-based reflex agents; goal-based agents; utility-based agents.

• ,- table-driven-agent percept
  ,  - persistent
  ,    - percepts ()
  ,    - table
  ,  - append percept to percepts
  ,  - lookup percepts table
  
  

• ,- reflex-vacuum-agent location status
  ,  - if dirty? status
  ,    - suck
  ,    - else if location = A
  ,      - right
  ,    - else
  ,      - left
  

• Simple reflex agent: select actions on the basis of the current precept
  • Learned responses, innate reflexes

  • ,- simple-reflex-agent percept
    ,  - persistent
    ,    - rules
    ,  - state = interpret-input(percept)
    ,  - rule = rule-match(state rules)
    ,  - rule.action
    

  • Works only if the correct decision can be made on the current percept: i.e. if the environment is fully observable.
  • Escape from infinite loops is possible if the agent can randomize its actions.
  • In single-agent environments, randomization is usually not rational.
  • In most cases we can do better with more sophisticated deterministic agents.
• Model-based reflex agents
  • Partial observability: keep track of the part of the world it can't see now.
  • Internal state
  • Knowledge of how world evolves independently from agent
  • Knowledge of actions affect the world
  • Model of the world

  • ,- model-based-reflex-agent percept
    ,  - persistent
    ,    - state
    ,    - model
    ,    - rules
    ,    - action
    ,  - state = update-state(state action percept model)
    ,  - rule = rule-match(state)
    ,  - (action rule)
    

  • State of the world can contain goals.
• Goal-based agents
  • In addition to current state, goal information that describes situations that are desirable
  • Search, planning
  • Flexible, reason about world vis à vis goals
• Utility-based agents
  • Whereas goals are happy/unhappy, more general performance measure: utility
  • Utility functional: internalization of performance measure
  • This is not the only way to be rational: rational agent for vacuum has no idea what its utility function is (see exercise 1.3).
  • When there are conflicting goals, utility function opts for the appropriate tradeoff.
  • Partial observability, stochasticity: decision making under uncertainty.
  • Expected utility of the action outcomes: derive, given the probabilities and utilities of each outcome.
  • Any rational agent must behave as if it possesses a utility function.
  • An agent that possesses an explicit utility function can make rational decisions with a general-purpose algorithm that does not depend on the specific utility function being maximized.
  • Global rationality: local constraint on rational-agent designs.
  • Choosing utility-maximizing course of action
• Learning agents
  • Now we're getting into some Mitchell-action: critic, learning element, performance element, problem generator, &c.
    • Need a book on big data?
  • Operate in initially unknown environments and become more competent.
  • Learning element
    • Making improvements
  • Performance element
    • Selecting external actions
  • Critic
    • How performance element should be modified vis à vis fixed performance standard.
    • Performance standard must be fixed (i.e. checkmate).
    • Performance standard outside agent; conforms thereto.
  • Problem generator
    • Suggesting actions that will lead to new and informative experiences.
    • Suboptimal actions short run, better actions long run.
  • Utility-based agents learning utility information
  • Performance standard distinguishes percept as reward or penalty.
  • Process of modification of each component
• Atomic, factored, structured environments
  • Atomic
    • Each state of the world indivisible
  • Factored
    • Variables, attributes
  • Structured
    • Objects and relationships can be described explicitly
  • Increasing expressiveness
  • Intelligent systems: operate at all points along the expressiveness-axis simultaneously.
• Agents perceives and acts; agent function maps percept seq -> action.
• Performance measure evaluates behavior.
• Maximize expected performance measure.
• Task environment: performance measure, external environment, actuators, sensors.
• Nicomachean Ethics
• McCarthy, Programs with Common Sense
• Newell and Simon, Human Problem Solving
• Horvitz suggests the use of rationality conceived as the maximization of expected utility as the basis for AI. Pearl, 1988.¹¹
  • Horvitz, E., 1988. Reasoning Under Varying and Uncertain Resource Constraints, Proc. of the 7th National Conference on AI, Minneapolis, MN, Morgan Kauffman, pp:111-116.
  • Horvitz, E. J., Breese, J.S., Henrion, M. 1988. Decision The- ory in Expert Systems and Artificial Intelligence, Journal of Approximate Reasoning, 2, pp247-302.

• If environment is unknown, agent has no choice but to try actionsat random (see exercise 2.11).
• Atomic representation: states of world, wholes: no internalstructure visible. (What the fuck does this mean?)
• Informed search algorithms
• Goal vs. problem formulation
• Search, solution, execution
• Open-loop: executed while ignoring its precepts: breaks loop between agent and environment.
  • http://en.m.wikipedia.org/wiki/Open-loop_controller:

    Computes its input using only its model and the current state.

• (Wow: formulates plan in one pass and executes.)
• in(arad)
• in(arad) -> { go(Sibiu), &c. }
• result(s, a) -> successor; result(in(arad), go(zerind)) -> in(zerind)
• initial state, actions, transitions; graph; path
• given state = goal state; enumerable or abstract
• step cost: c(s, a, s')
• Solution: leads from initial to goal state. Optimal solution minimizes cost.
• Abstraction: removing detail from representation. (Strange that it's formulated negatively.)
• Valid: expanded to more detailed environment; useful: easier than original problem.
• Toy problems: sliding block, n-queens
• N-queens: no path cost; incremental vs. complete-state
• Knuth conjecture: factorial, square root and floor reach any desired positive integer.
• Protein design
• Search tree: branches are actions, nodes: states
• Leaf nodes, frontier
• Expanding nodes on frontier, until solution (or not)
• State space: finite; search tree: infinite (loopy)
• Frontier separates the state-space graph into the explored region and the unexplored region.
• Node: state, parent, action (whence), path-cost (cumulative)
  • (They're getting implementationy.)
  • (Seem to be talking about breadth-first search here: there's a queue.)
• solution function: following parents up to root

  ,- child-node(problem, parent, action) -> node
  ,  - let
  ,    - state (problem-result (node-state parent) action)
  ,    - parent parent
  ,    - action action
  ,    - path-cose (+ (path-cost parent) (step-cost problem (node-state
  ,      parent) action)
  

• (Oh, never mind: queues are supersets of stacks, apparently; LIFOs queues being the latter. Also, priority queues.)
• Canonical form: bit-vector, sorted list (keys for hash-tables)
• Completeness, optimality, time complexity, space complexity
• In AI, graph represented implicitly by initial state, actions, transition model; frequently infinite.
• Complexity:

  b

  branching factor (maximum successors)

  d

  depth

  m

  maximum path in state space

• (State space: finally.)
• Search cost
• Total cost: search cost + path cost
• Uninformed search (blind search)
• Order in which nodes are expanded: informed search, heuristic search
• Breadth-first: root and successors expanded first
  • FIFO queue
  • Goal-test applied to each node when it is generated
  • Breadth first expands the shallowest nodes
• Uniform-cost search: expands \(n\) with lowest path-cost
  • (Greedy algorithm? Apparently not, since the goal-test is applied at expansion.)
  • Frontier: priority queue ordered by \(g\)
  • Goal-test applied when node selected for expansion; goal node that is generated may be on a suboptimal path
  • Second test added, in case a better path is found to a node currently on the frontier. (Where is it in the algorithm?)
  • Properties of priority queue and hash-table
  • (There are these negative proofs.)
  • Completeness is guaranteed, provided the cost of every step exceeds some small positive constant \(\epsilon\).
    • (\(\epsilon\) and floats)
  • \(C^*\): optimal value for \(C\).
  • Uniform-cost does more work than breadth-first, expanding nodes even after finding a solution.
• Depth-first search
  • Expands deepest node in current frontier.
  • LIFO
  • In infinite state spaces, fails if infinite non-goal path encountered.
  • Depth-first search not optimal.
    • (Really? Interesting; depends, of course, on the order of nodes selected.)
  • \(m\) itself can be much larger than \(d\); infinite, if tree unbounded.
  • Space complexity: for a graph search, no advantage; for a tree search: need store only a single path from root to leaf (plus unexplored siblings).
  • Depth first: constraint satisfaction, propositional satisfiability, logic programming
    • (Remember, though, that kanren had some breadth-first facilities.)
  • Backtracking search: modifying current state description
• Depth-limited search
  • Time complexity \(O(b^l)\); space complexity \(O(bl)\)
  • Two kinds of failure: search failure, cutoff failure.
  • Diameter of state space: any node can reach any other node in at most \(D\) steps
• Iterative deepening (depth-first) search
  • Gradually increases the depth limit
  • Like depth-first: \(O(bd)\) space complexity
  • Like breadth-first: complete when branching factor is finite and optimal when the path cost is non-decreasing

    ,- iterative-deepening-search(problem) -> solution or failure
    ,  - for depth = 0 to infinity do
    ,    - result = depth-limited-search(problem, depth)
    ,    - if result != cutoff
    ,      - return result
    

  • Iterative deepening, preferred uninformed search method when search space is large and depth unknown
  • Do breadth-first until almost all memory consumed; iterative deepening on all nodes in the frontier.
  • Iterative analog to uniform-cost search? (Overhead, apparently.)
• Bidirectional search
  • Forward from the initial state and backwards from the goal: \(b^{d/2} + b^{d/2} << b^d\)
  • Replace goal-test to see whether frontiers intersect
  • Check when node selected for expansion; with hash-table: constant time
    • (Hash-tables for membership testing: I like it. Hence: canonical form, &c.)
  • Time, space complexity: \(O(b^{d/2})\)
  • Reduce by half if one of the two searches done by iterative deepening; at least one of the frontiers must be kept in memory
  • Requires mechanism for computing predecessors; in reversible case: reverse successor. Non-reversible: ingenuity
  • Explicitly listed goal-states: construct dummy goal-states whose predecessors are actual goal states.
    • (Why?)
  • Informed search
    • Problem-specific knowledge
    • Best-first search
      • Evaluation function, \(f(n)\); cost estimate
      • Uniform-cost search, except that \(f\) instead of \(g\) orders the priority queue
      • A component of \(f(n)\), the heuristic function \(h(n)\): estimated cost of cheapest path from the state at node \(n\) to a goal state.
      • \(h(n)\), unlike \(g(n)\), depends only on the \(state\) at that node.
      • If \(n\) is a goal node, \(h(n)\) = 0.
    • Greedy best-first search
      • \(f(n) = h(n)\)
      • E.g. straight-line distance heuristic
      • The amount of reduction depends on the particualr problem and on the quality of the heuristic.
    • \(A^*\) search (minimizing total estimated cost)
      • \(f(n) = h(n) + g(n) =\) estimated cost of the cheapest solution through \(n\).
      • Provided that the heuristic function (\(h(n)\)) satisfies certain conditions, \(A^*\) is complete and optimal.
      • Identical to uniform-cost search, except that \(A^*\) uses \(g + h\) instead of \(g\).
      • Never overestimates the cost to reach the goal.
      • \(h(n) \leq c(n, a, n^\prime) + h(n^\prime)\); triangle inequality: if there were a route from \(n\) to \(G_n\) via \(n^\prime\) that was cheaper than \(h(n)\), that would violate the property that \(h(n)\) is a lower bound on the cost to reach \(G_n\).
      • Every consistent heuristic, admissible.
      • \(h_{SLD}\): consistent heuristic; straight line between \(n\) and \(n^\prime\) no greater than \(c(n, a, n^\prime)\).
      • The tree-search version of \(A^*\) is optimal if \(h(n)\) is admissible, while the graph-search version is optimal if \(h(n)\) is consistent.
      • If \(h(n)\) is consistent, values of \(f(n)\) along any path are non-decreasing.
      • \(f(n^\prime) = g(n^\prime) + h(n^\prime) = g(n) + c(n, a, n^\prime) + h(n^\prime) \geq g(n) + h(n) = f(n)\)
      • There would have to be another frontier node \(n^\prime\) on the optimal path, by the graph selection property of 3.9.
      • See page 77: The frontier separates the state-space graph into the explored region and the unexplored region, so that every path from the inital state to an unexplored state has to pass through a state in the frontier. (This is the graph separation property.)
      • With an admissible but inconsistent heuristic, \(A^*\) requires some extra book-keeping to ensure optimality.
      • It follows that the sequence of nodes expanded by \(A^*\) is in non-decreasing order of \(f(n)\). Hence, the first goal node selected for expansion must be an optimal solutian because \(f\) is the true cost for goal nodes (which have \(h=0\)) and all later goal nodes will be at least as expensive.
      • The fact that \(f\)-costs are non-decreasing means we can draw contours in the state space.
      • \(A^*\) fans out from the start node, adding nodes in concertric bands of increasing \(f\)-cost.
      • With uniform-cost search (\(A^*\) using \(h(n) = 0\)), the bands will be circular; more accurate heuristics: bands will stretch toward the goal state and become more narrowlsy focused around the optimal path.
      • \(A^*\) expands all nodes with \(f(n) < C^*\).
      • \(A^*\) might expand some nodes on the goal-contour before selecting the goal node.
      • Completeness requires that there be only finitely many nodes with cost less than or equal to \(C^*\), a condition that is true if all step costs exceed some finite \(\epsilon\) and if \(b\) is finite.
        • (Actually (i.e. accidentally) finite, or finite in principle? The latter doesn't matter; but we can put upper bounds on \(b\) in the case of e.g. tries.
      • Subtree below Timisoara is pruned: because \(h_{SLD}\) is admissible.
      • \(A^*\) is optimally efficient for any given consistent heuristic: no other optimal algorithm is guaranteed to expand fewer nodes than \(A^*\) (except possibly tie-breaking). Any algorithm that does not expand all nodes with \(f(n) < C\) runs the risk of missing the optimal solution.
      • The catch is that the number of states within the goal contour search space is still exponential.
      • Absolute error, relative error
      • Simplest model: state space, single goal, tree with reversible actions
      • \(A^*\) usually runs out of space before it runs out of time
    • Memory-bounded heuristic search
      • Iterative-deepening \(A^*\) (IDA*): cutoff is the \(f\)-cost (\(g + h\)) rather than the depth. Practical for unit step costs; avoid the overhead of sorted queue of nodes.
      • Recursive best-first search: using linear space
        • Modifies currnt f; unwinds along the recursion
        • Somewhat more efficient than IDA*, suffers from excessive node regeneration
        • Space complexity: linear; time-complexity: depends on heuristic and how often best path changes.
      • Memory-bounded A*
        • Drop oldest worst leaf when memory full
        • SMA* is a fairly robust choice for finding optimal solutions, particularly when the state space is a graph.
    • Metalevel state-space
      • Goal of learning is to minimize total cost of problem solving.
• 8-puzzle: exhaustive tree search: 3²²; graph search: 181,440 distinct states.
• Manhattan distance
• Quality of heuristic: effective branching factor \(b^*\). (If the total nuber of nodes generated by \(A^*\) for a particualr problem is \(N\) and the solution depth is \(d\), then \(b^*\) is the branching factor that a uniform tree of depth \(d\) would have to have in order to contain \(N + 1\) nodes.)
• Experimental measurements of \(b^*\) on a small set of problems can provide a good uide to the heuristic's overall usefulness
• A well-designed heuristic would have a value of \(b^*\) close to \(1\).
• "\(h_2\) dominates \(h_1\)."
• Problem with fewer restrictions on the actions is called a relaxed problem: whence heuristic. The state-space of the relaxed problem is a supergraph of the original state space.
• The relaxed problem may have better solutions of the added edges provide short cuts.
• The cost of an optimal solution to a relaxed problem is an admissible heuristic for the original problem.
• It must obey the triangle inequality and is therefore consistent.
• Relaxed problems solved without search, otherwise: too expensive.
• Absolver: Prieditis
• \(h(n) = max{h_1(n), ... , h_m(n)}\)
• Composite heuristic: \(h\) is admissible; consistent, dominates component heuristics.
• Pattern databases
• Solutions share moves, cannot be additively combined
• Disjoint pattern databases
• Nonadditive heuristic
• Inductive methods supplied with features of a state that are relevant to predicting the state's value.
• Goal identified, well-defined problem formulated.
• Initial state, actions, transition model, goal test, path cost. This is the state space. Path through state space to goal state: solution.
• States and actions: atomic; don't consider internal structure. (What the fuck does this mean: features?)
• Tree-search: all paths; graph-search: avoids redundant paths.
• Completeness, optimality, time complexity, space complexity.
• Uninformed search
  • Breadth-first
  • Uniform-cost
  • Depth-first
  • Depth-limited
  • Iterative deepening
  • Bidirectional
• Informed search
  • Heuristic function
  • Best-first search
  • Greedy best-first search
  • \(A^*\) search
  • RBFS
  • SMA*
• Dynamic programming can be seen as a form of depth-first search on graphs.

• Local search algorithms operate an a single current node (rather than multiple paths).
• Optimization problems, objective function
• State-space landscape: location (state), elevation (heuristic cost or objective function
• Global minimum, global maximum

• Plan ahead in a world where other agents are planning against us
• Multi-agent
• Contingencies
• Competitive
• Game theory
• Very many agents: economies rather than games
• Significant, regardless of whether the agents are cooperative or competitive
• Deterministic, turn-taking, two-player, zero-sum games of perfect information (such as chess)
• Pruning
• Heuristic evaluation function
• Imperfect information
• Max, min
• initial state
• who moves
• legal moves
• Terminal test, game is over; terminal states
• Utility function (objective function, payoff function); win, loss, draw: 1, 0, 1/2. Payoffs in backgammon 0 to 192. Zero-sum game: total payoff is the same for every instance of game.
• Initial state, actions and result define the game tree.
• Search tree superimposed on full game tree
• Max must find a contingent strategy, max’s moves in the states resulting from every possible response by min; analogous to AND-OR search.
• Max nodes, min nodes, terminal nodes
• Half-moves: ply
• Minimax value of each node
• Utility for max of being in the corresponding state, assuming that both players play optimally.
• Max prefers to move to a state of maximum value, min prefers to move to a state of minimum value.
• $$minimax(s) = utility(s) if terminal-test(s), max_{a \in actions(s)} minimax(result(s, a)) if player(s) = max, min_{a \in actions(s)} minimax(result(s, a)) if player(s) = min$$
• Minimax decision at root, maximizes worst-case outcome for max
• Minimax algorithm: recursive computation of the minimax values of each successor state
• Recursion proceeds to leaves, minimax values backed up
• Minimax performs a complete depth-first exploration of game tree
• Time complexity: \(O(b^m)\), space: \(O(bm)\) (all actions at once), \(O(m)\) (actions one at a time).
• Maximum depth \(m\), \(b\) legal moves at each point (branching factor)
• Muliplayer: vector \(<v_a, v_b, v_c>\) associated with each node
• In two-player, zero-sum games, the two-element vector can be reduced to a single value because the values are always opposite.
• The backed-up value of a node \(n\) is always the utility vector of the successor state with the highest values for the player choosing at \(n\).
• In this way, collaboration emerges from purely selfish behavior.
• Not a zero-sum, collaboration with just two players.

  ,- minimax-decision(state) -> action
  ,  - return arg max_{a \in actions(s)} min-value(result(state, a))
  ,- max-value(state) -> utility
  ,  - if terminal-test(state) return utility(state)
  ,  - v <- -inf
  ,  - for each a in actions(state) do
  ,    - v <- max(v, min-value(result(s, a)))
  ,  - return v
  ,- min-value(state) -> utility
  ,  - if terminal-test(state) then return utility(state)
  ,  - v <- inf
  ,  - for each a in actions(state) do
  ,    - v <- min(v, max-value(result(s, a)))
  ,  - return v   - Minimax decision:
  

  • Dynamic programming, by the way?
• Exponential, depth of tree; effectively cut it in half
• Alpha-beta pruning; returns same move as minimax would, but prunes away branches that cannot possibly influence the final decision
• Values of root and minimax decision independent of the values of the pruned leaves \(x\) and \(y\).
• If player has a better choice \(m\) at the parent node of \(n\) or at any choice point further up, then n will never be reached in actual play.
• α is the best (highest-value) choice along the path for max; β is the best (lowest-value) choice along the path for min
• alpha-beta dependent on the order in which the states are examined
• Alpha-beta highly dependent on the order in which the states are examined
• Examine the first successors that are likely to be the best; then alpha-beta needs examine only \(O(b^{m/2})\) instead of \(O(b^m)\). Effective branching factor becomes \(\sqrt{b}\) instead of \(b\).
• In random order instead of best-first: \(O(b^{3m/4})\) for moderate \(b\).
• Alpha-beta:

  ,- alpha-beta-search(state) -> action
  ,  - v <- max-value(state, -inf, inf)
  ,  - return action in actions(state) with v
  ,- max-value(state, alpha, beta) -> utility
  ,  - if terminal-test(state) return utility(state)
  ,  - v <- -inf
  ,  - for each a in actions(state)
  ,    - v <- max(v, min-value(result(s, a), alpha, beta))
  ,    - if v >= beta return v
  ,    - alpha <- max(alpha, v)
  ,  - return v
  ,- min-value(state, alpha, beta) -> utility
  ,  - if terminal-test(state) return utility(state)
  ,  - v <- inf
  ,  - for a in actions(state)
  ,    - v <- min(v, max-value(result(s, a), alpha, beta)
  ,    - if v <= alpha the return v
  ,    - beta <- min(beta, v)
  ,  - return v
  

• Dynamic move-ordering scheme: trying moves that were found to be best in the past
• Iterative deepening search
• Iterativet deepening on an exponential game tree adds only a constant fraction to the total search time, which can be more than made up from better move ordering.
• Best moves: killer moves; killer move heuristic
• Hash-table of previously seen positions: transposition table; various strategies to choose which nodes to keep and which to discard.
• Alpha-beta still has to search all the way to terminal states
• Cut off search early and apply a heuristic evaluation function to states in the search, effectively turning nontermanil nodes into terminal leaves.
• Replace utility function by a heuristic evaluation function eval, which estimates the position’s utility; replace the terminal test by a cutoff test that decides when to apply eval.
• H-minimax(s, d) = eval(s) if cutoff-test(s, d); max_{a ∈ actions(s)} h-minimax(result(s, a), d + 1) if player(s) = max, min_{a ∈ actions(s)} h-minimax(result(s, a), d + 1) if player(s) = min.
• Evaluation function: estimate of utility, just as heuristic return an estamet of the distance to the goal.
• Evaluation function should order the terminal states in the same way as the true utility function. Efficient. For nonterminal states, evaluation should be strongly correlated with chances of winning.
• If the search must be cut off at non-terminal states, the algorithm will necessarily be uncertain about the final outcomes of those states.
• Features of the state: pawns, queens, &c.
• Evaluation for states in the category is the expected value: $0.72 * 1 + 0.20 * 0 + 0.08 * 12 = 0.76.$
• Evaluation function need not return actual expected values as long as the ordering of the states is the same.
• Separate numerical contributions from each feature and combine them to find the total value.
• Material value to each piece
• Weighted linear function: \(eval(s) = w_1f_1(s) + ... + w_nf_n(s) = \sum^n_{i=1}w_if_i(s)\)
• Strong assumption: contribution of each feature is independent of the values of the other features.
• Nonlinear combinations of features: e.g. pair of bishops worth slightly more than a single one, and a bishop is worth more in the engame (when the move number feature is high or number of remaining pieces feature is low).
• Feature and weight not part of the rules of chess.
• cutoff-test(state, depth) returns true for all depth greater than some fixed depth d (d is chose so that a move is selected within the allocated time); more robust: apply iterative deepening. When time runs out, the program returns the move selected by the deepest completed search. Iterative deepening help with move ordering.
• The evaluation function should be applied only to positions that are quiescent: unlikely to exhibit wild swings in value in the near future.
• Positions in which favorable captures can be made are not quiescent for an evaluation function that just counts material.
• Non-quiescent positions can be expanded further until quiescent positions are reached.
• Quiescent search: restricted to certain moves, capture moves, quickly resolve uncertainties.
• Horizon effect: program is facing opponent’s move that causes serious damage but can be temporarily avoided by delaying tactics.
• All it has done is push the inevitable capture of the bishop beyond the horizon that black can see.
• Singular extension: move that is “clearly better” in a given position.
• Forward pruning: some moves at a given node are pruned immediately without further consideration.
• Beam search: on each ply, consider only a “beam” of the \(n\) best moves.
• No guarantee that the best move will not be pruned away.
• probcut: probabilitistic cut (Buro, 1995) is a forward-pruning version of alpha-beta search that uses statistics gained from prior experience to lessen the chance that the best move will be pruned.
• Table lookup
• Usually, after ten moves we end up in a rarely seen position, and the program must switch from table lookup to search.
• Policy: mapping from every possible state to the best move in that state.
• Retrograde minimax search
• Stochastic games (backgammon)
• Game tree in backgammon must include chance nodes in addition to max and min nodes
• Expected value of a position: average over all possible outcomes of the chance nodes
• minimax -> expectiminimax
• $$expectiminimax(s) = utility(s) if terminal-test(s), max_a expectiminimax(result(s, a)) if player(s) = max, min_a expectiminimax(result(s, a)) if player(s) = min, \sum_r P(r) expectiminimax(result(s, r)) if player(s) = chance$$
• The evaluation function must be a positive linear transformation of the probability of winning from a position (of the expected utility of the position)
• expectiminimax considers all the possible dice rolls \(O(b^mn^m)\), \(n\) number of distinct rolls
• Bound the average
• Monte Carlo simulation
• Partially observable games
• Kriegspiel
• Belief state: logically possible board positions
• State estimation
• Probabilistic checkmate
• Minimize information
• Optimal play in partially observable games requires a willingness to play somewhat randomly
• Equilibrium solution
• Card games: stochastic partial observability
• Bridge, whist, hearts, poker
• $$argmax_a\sum_s P(s) minimax(result(s, a))$$
• Monte Carlo approximation: random sample of \(N\) deals
• Averaging over clairvoyance
• Actions that gather information
• Singular extensions beyond the depth-limit; 8000 features
• Effective branching factor 3 (actual 35)
• Null move heuristic: opponent moves twice
• Randomness from deal, not adversarial play
• Utility of node expansion
• Metareasoning
• Goal-directed reasoning
• Dynamic programming, retrograde analysis
• Bidirectional search

• Can machines think?
• It is A's object in the game to try and cause C to make the wrong identification.
  • Didn't realize there was an adversarial element to the Turing test.
• What will happen when a machine takes the part of A in this game?
• . . . drawing a fairly sharp line between the physical and the intellectual capacities of man.
  • A reasonable dualism
• May not machines carry out something which ought to be described as thinking but which is very different from what a man does?
  • The humanity/rationality plane of AI?
• Imitation game
  • Simulacrum sufficeth
• It is probably possible to rear a complete individual from a single cell of the skin (say) of a man . . . but we would not be inclined to regard it as a case of "constructing a thinking machine".
• Digital computer:
  1. Store
  2. Executive unit
  3. Control
• It is not normally possible to determine from observing a machine whether it has a random element, for a similar effect can be produced by such devices as making the choices depend on the digits of the decimal for \(\pi\).
• Discrete state machines: strictly speaking there are no such machines. Everything really moves continuously.
• This is reminiscent of Laplace's view that from the complete state of the universe at one moment of time, as described by the positions and velocities of all particles, it should be possible to predict all future states.
• This special property of digital computers, that they can mimic any discrete state machine, is described by saying that they are universal machines.
• "Are there imaginable digital computers which would do well in the imitation game?" \(\to\) "Are there discrete state machines which would do well?"
• I believe that in about fifty years' time it will be possible to programme computers, with a storage capacity of about \(10^9\), to make them play the imitation game so well that an average interrogator will not have more than \(70\%\) chance of making the right identification after five minutes of questioning.
  • Russell/Norvig, 12: storage units: \(10^15\)
  • Loebner prize:

    Elbot of Artificial Solutions won the 2008 Loebner Prize bronze award, for most human-like artificial conversational entity, through fooling three of the twelve judges who interrogated it (in the human-parallel comparisons) into believing it was human. This is coming very close to the \(30\%\) traditionally required to consider that a program has actually passed the Turing test.

    • From a judge:

      He predicted that by the end of the century, computers would have a 30 per cent chance of being mistaken for a human being in five minutes of text-based conversation.

      I thought this was mistaken (should be \(70\)), but it is indeed correct.

  • In other words, a damn-good guess.
• Conjectures are of great importance since they suggest useful lines of research.
• We might expect that He would only exercise this power in conjunction with a mutation which provided the elephant with an appropriately improved brain to minister to the needs of this soul.
• We like to believe that Man is in some subtle way superior to the rest of creation.
• "The consequences of machines thinking would be too dreadful." I do not think that this argument sufficiently substantial to require refutation. Consolation would would be more appropriate: perhaps this should be sought the transmigration of souls.
• There are limitations to the powers of discrete-state machines. The best known of these results is known as Gödel's theorem, and shows that in any sufficiently powerful logical system statements can be formulated which can neither be proved nor disproved within the system, unless possibly the system itself is inconsistent.
• "Will this machine every answer 'Yes' to any question?" It can be shown that the answer is either wrong or not forthcoming.
• The only way to know that a man thinks is to be that particular man. It is in fact the solipsist point of view.
• I do not wish to give the impression that I think there is no mystery about consciousness. There is, for instance, something of a paradox connected with any attempt to localise it.
• When a burnt child fears the fire and shows that he fears it by avoiding it, I should say that he was applying scientific induction.
• It would deliberately introduce mistakes in a manner calculated to confuse the interrogator.
• By observing the results of its own behaviour it can modify its own programmes so as to achieve some purpose more effectively.
• This is the assumption that as soon as a fact is presented to a mind all consequences of that fact spring into the mind simultaneously with it.
• The undistributed middle is glaring.
• I would defy anyone to learn from these replies sufficint about the programme to be able to predict any replies to untried values.
• A smallish proportion are super-critical. An idea presented to such a mind may give rise to a whole "theory" consisting of secondary, tertiary and more remote ideas.
  • Sponteneity
• These last two paragraphs should be described as "recitations tending to produce belief."
• The only satisfactory support that can be given will be that provided by waiting for the end of the century and then doing the experiment described.
• Estimates for the storage capacity of the brain vary from \(10^10\) to \(10^15\) binary digits.
  • Russell/Norvig (12): \(10^13\) synapses
• At my present rate of working I produce about a thousand digits of programme a day, so that about sixty workers, working steadily through the fifty years might accomplish the job, if nothing went into the waste-paper basket.
  • Mythical man-month?
• The child-programme and the education process
• One might have a complete system of logical inference "built in". The store would be largely occupied with definitions and propositions. Certain propositions may be described as "imperatives". As soon as an imperative is classed as "well-established" the appropriate action takes place.
  • Compare McCarthy, Programs with Common Sense, regarding imperatives.
• These choices make the difference between a brilliant and a footling reasoner.
• We can only see a short distance ahead, but we can see plenty there that needs to be done.

• Crossover and mutation
• Mutation: helps avoid local optima
• Stopping criteria: uniformity of population; average object function, average individual.
• Brady, Grefenstette, Goldberg and Lingle, Oliver, et al.: GA to TSP.
• Binary representation, matrix representation: binary alphabets.
• In the TSP, crossover and mutation operators don't constitute closed operations: the results obtained using the above mentioned operators are not valid tours.
• Path representation: great number of crossover and mutation operators have been developed.
• Schemata analysis: chain formed by any characters, amplified by *: lack of information: hyperplane in search space.
• Provides lower bound of expected number of individuals that in the following generation will be associated with the determined schema.
• Adjacency representation allows schemata analysis; ordinal representation: crossover and mutation can be used without designing new operators. Experimental results, poor.
• Binary representation: city encoded as a string of \(\log{n}_2\) bits.
  • Classical crossover: random crossover; do not represent legal tours. Change created offspring, legal tours: repair algorithm: transfers individuals that do not belong to the search space into individual of that search space.
  • Classal mutation: alters one or more bits with a probability equal to the mutation rate: close to zero.
• Path representation: list of \(n\) cities; classical operators also not suitable.
  • Partially mapped crossover (PMX): selects two random cut points . . .

Never got a chance to implement from scratch; should have watched?

The former produces nice hubs and cycles, but the problem of aligning complementary directions (like graph-coloring?) is NP-complete. Resorting to depth-first with no cycles; would have to have an exponential adjunct for cycles.

Way to quantify the difference between the two with respect to e.g. average degree of nodes?

Can we create a jekyll-based blog from this org-doc and push it to the github pages?

That would be beautiful: we could get rid of the generated pdf and might not be confined to the relative obscurity of org (relative to, say, html).

See this survey. Algorithm2e isn't bad; doesn't seem to have a function, though. Pseudocode seems to be relatively natural; even if the output is a little ugly.

The alternative, I suppose, is straight up lists.

Algorithm2e has to be wrapped in dollars, which sucks; also: bizarre camel-case macros. Looks good, otherwise. Has no functions, apparently, either.

CLOSED: 2013-05-01 Wed 16:47
Scrabble: is it the case that the utility and evaluation functions are the same? Not necessary, see Appel, The World’s Fastest Scrabble Program (emphasis mine):

Peter Turcan of the University of Reading in England has written a SCRABBLE-player [8, 9] for some unspecified micro-computer. It appears that he generates moves by iterating over the wards in his lexicon in reverse order of length. He somehow decides for each word whether and where it can be played on the current board with the current rack. His program doesn’t attempt any adversary search, but it does use an evaluation function more sophisticated than the score of the prospective move. It takes the score and conditionally adds terms depending on simple strategic features of the new position and tiles left in the rack.

Need a good lexicon; how about just /usr/share/dict/words? Sure. (Apparently, there’s the tournament word list; SOWPODS; Player's Dictionary.) See word lists.

It looks like the evaluation function is the score plus some heuristics.

Weiiiberger’s program has no concept of strategy, and simply chooses the highest-scoring play available.

Using a trie:

They represent their lexicon as a tree-structure of letters where each path down the tree has an associated list of words that can be formed using exactly those letters on the path. The letters along each path appear in a canonical order corresponding (approximately) to the point value of the tile in SCRABBLE, by decreasing value. The reason for the putting the higher-valued letters higher in the tree is to help find the most valuable words first, in case a full search cannot be completed.

We implemented a so-called radix tree for unicode Greek, I think.

Some heuristic action:

Shapiro’s move generator iterates over board posi- tions, taking the tiles in the rack and at the proposed board position, and searching down from the root for acceptable words that can be formed with those letters. His programs do not generally examine all possible board positions where words could be played, only those positions judged worthwhile. Once a move is found yielding at least some pre-determined threshold score, that move is chosen.

This is cool:

Instead of scanning through the entire lexicon each turn for playable words, we begin by scanning over the board for places where a word could connect to letters already on the board. Then we try to build the word up incrementally, using letters from the rack and the board near the proposed place of attachment. We main- tain data structures that make this search one-dimen- sional, so we never have to look outside of a single row or column of the board during move generation.

Let’s just read them into memory, check infix and available letters.

How does scrabble work mechanically?

Because a two-way dawg has a node for each sub- string of each word, we imagine that it would be a great deal larger than the one-way dawg, although we have never tried to build one. It would be interesting to see just how much space it would occupy, and by how much it would speed up move generation. *

Heuristics:

Preserving tiles and tile combinations in the rack that are likely to lead to higher scores in the next move(s). Avoiding leaving the board open for the opponent to make high-scoring moves.

Initially, let’s ignore triple word scores; &c.: just a board of dimensions \(m \times n\) on which to place words. Don’t forget blanks!

There’s left-hand and right-hand search; or: prefix and suffix. How to use a trie effectively? Brute force:

Also, two dimensional problem: must make sense up and down; although Appel claims to have reduced it to a one-dimensional problem.

Don’t forget: can use individual letters, too.

No prefix: all rows and columns; one letter prefix; to n letter prefices. And this plus suffices. Also: bounded by letters on the board (which become prefices and suffices).

Need to generalize the problem somehow; wish I had a board.

We’re going to have to consider the board row by row (and column by column), I think; considering all combinations of blanks and preëxisting tiles. Also, contiguous tiles.

See Gordon's paper on GADDAGs; also, Boyer-Moore string search.

Need some function to determine contiguous words.

Build the tree; find the anchor points; try the permutations. Maybe we can ignore blanks for the time being; ignore other contiguous words. First, build the DAGs (nested hash-tables, or some kind of array? Former if the space is sparse; otherwise, latter); anchor squares, by the way, are “a square on the board onto which a word could be hooked” (review the Appel paper). Let’s build the GADDAGs first.

(Had a feeling, by the way, some NP-complete shit lurking under the surface.)

Play on the edges, since that will generate intermediate matches?

There is no need to generate plays from every other internal anchor square of a sequence of contiguous anchor squares (e.g. the square left or right of the B in Figure 2), since every play from a given anchor square would be generated from the adjacent anchor square either to the right (above) or to the left (below).

Letter records: character, whether terminal; score kept elsewhere. Board: two dimensional array of vectors. Need a special sentinel that signifies reversal.

(use debug
     define-record-and-printer
     extras
     format
     heap
     loops
     matchable
     srfi-1
     vector-lib)

(define-record-and-printer sentinel)
(define sentinel (make-sentinel))

(define sentinel-index (make-parameter 26))
(define terminal-index (make-parameter 27))

(define (character->index character)
  (if (sentinel? character)
      (sentinel-index)
      (- (char->integer character) 65)))

(define (index->character index)
  (if (= index (sentinel-index))
      sentinel
      (integer->char (+ index 65))))

(define dag-length (make-parameter (+ 26 ; Alphabet
                                      1 ; Sentinel
                                      1 ; Terminal?
                                      )))
(define (make-dag) (make-vector (dag-length) #f))
(define (dag-terminal? dag) (vector-ref dag (terminal-index)))
(define (dag-terminal?-set! dag terminal?)
  (vector-set! dag (terminal-index) terminal?))
(define (dag-ref dag character)
  (vector-ref dag (character->index character)))
(define (dag-set! dag character value)
  (vector-set! dag (character->index character) value))

(define (integrate-fixes dag prefix suffix)
  (let ((characters (if (null? suffix)
                      prefix
                      (append (append prefix (list sentinel))
                              suffix))))
    (dag-terminal?-set!
     (fold (lambda (character dag)
             (unless (dag-ref dag character)
               (dag-set! dag character (make-dag)))
             (dag-ref dag character))
           dag
           characters)
     #t)))

(define (update-dag! dag word)
  (let ((characters (string->list word)))
    (do ((prefix (list (car characters)) (cons (car suffix) prefix))
         (suffix (cdr characters) (cdr suffix)))
        ((null? suffix) (integrate-fixes dag prefix suffix))
      (integrate-fixes dag prefix suffix))))

(define (dag-debug dag depth)
  (vector-for-each
   (lambda (i x)
     (when (vector? x)
       ;; (debug (index->character i))
       (format #t "~a~a~%" (make-string depth #\_) (index->character i))
       (dag-debug x (add1 depth))))
   dag))

;;; Be nice to store these fuckers in a graph database or something.
(define (make-dag-from-file file)
  (let ((dag (make-dag)))
    (with-input-from-file file
      (lambda ()
        (do ((word (read-line) (read-line)))
            ((eof-object? word))
          (debug word)
          (update-dag! dag word))))
    dag))

(define make-square cons)
(define square-x car)
(define square-y cdr)

(define (above square)
  (cons (square-x square)
        (+ (square-y square) 1)))

(define (below square)
  (cons (square-x square)
        (- (square-y square) 1)))

(define (left-of square)
  (cons (- (square-x square) 1)
        (square-y square)))

(define (right-of square)
  (cons (+ (square-x square) 1)
        (square-y square)))

(define (above? s1 s2)
  (below? s2 s1))

(define (below? s1 s2)
  (= 1 (- (square-y s2) (square-y s1))))

(define (left-of? s1 s2)
  (right-of? s2 s1))

(define (right-of? s1 s2)
  (= 1 (- (square-x s1) (square-x s2))))

(define (match? dag word)
  (let iter ((dag dag)
             (word word))
    (if (null? word)
        (dag-terminal? dag)
        (let* ((character (car word))
               (subdag (dag-ref dag character)))
          (if subdag
              (iter subdag (cdr word))
              #f)))))

(define make-board make-hash-table)
(define (board-empty? board) (zero? (hash-table-size board)))
(define board-copy hash-table-copy)
(define board-set! hash-table-set!)
(define board-ref hash-table-ref)
(define board-ref/default hash-table-ref/default)

(define (reverse-of orientation)
  (cond ((eq? orientation right-of) left-of)
        ((eq? orientation left-of) right-of)
        ((eq? orientation above) below)
        ((eq? orientation below) above)))

(define (orthogonal-to orientation)
  (cond ((eq? orientation right-of) above)
        ((eq? orientation left-of) below)
        ((eq? orientation above) right-of)
        ((eq? orientation below) left-of)))

(define (crosscheck-of orientation)
  (cond ((eq? orientation right-of) left-of)
        ((eq? orientation left-of) left-of)
        ((eq? orientation above) above)
        ((eq? orientation below) above)))

(define (word-scan board square next-square)
  (let ((previous-square (reverse-of next-square)))
    (do ((square square (next-square square)))
        ((not (board-ref/default board square #f))
         (do ((square (previous-square square)
                      (previous-square square))
              (word '() (cons (board-ref/default board square #f) word)))
             ((not (board-ref/default board square #f)) word))))))

(define (word-score word)
  (fold (lambda (character score)
          (+ (hash-table-ref character->points character)
             score))
        0
        word))

;;; This is a misnomer: it may not be a crosscheck, but merely a
;;; check, in the case where we're testing for parallel contiguous
;;; words.
(define (crosscheck dag word)
  (and (or (= (length word) 1)
           (match? dag word))
       (word-score word)))

(define (square-neighbors square)
  (list (left-of square)
        (right-of square)
        (above square)
        (below square)))

(define (square-occupied? board square)
  (board-ref/default board square #f))

(define (unoccupied-neighbors board square)
  (filter (cut (complement square-occupied?) board <>)
          (square-neighbors square)))

(define (board-display board)
  (match
      (hash-table-fold
       board
       (lambda (square character minimum-maximum)
         (match minimum-maximum
           ((minimum . maximum)
            (cons (make-square (inexact->exact (min (square-x minimum)
                                                    (square-x square)))
                               (inexact->exact (min (square-y minimum)
                                                    (square-y square))))
                  (make-square (inexact->exact (max (square-x maximum)
                                                    (square-x square)))
                               (inexact->exact (max (square-y maximum)
                                                    (square-y square))))))))
       (cons (make-square +inf.0 +inf.0)
             (make-square -inf.0 -inf.0)))
    ((minimum . maximum)
     (do ((y (square-y maximum) (sub1 y)))
         ((< y (square-y minimum)))
       (when (= y (square-y maximum))
         (display " ")
         (do ((x (square-x minimum) (add1 x)))
             ((> x (square-x maximum)))
           (display (abs (remainder x 10))))
         (newline))
       (display (abs (remainder y 10)))
       (do ((x (square-x minimum) (add1 x)))
           ((> x (square-x maximum)) (newline))
         (display (board-ref/default board (make-square x y) " ")))))))

(define (anchor? board square)
  (not (every (cut square-occupied? board <>)
              (square-neighbors square))))

(define origin (make-square 0 0))

(define (board-anchors board next-square)
  (if (board-empty? board)
      (list origin)
      (let* ((above (orthogonal-to next-square))
             (below (reverse-of above)))
        (hash-table-fold
         board
         (lambda (square character anchors)
           (append
            (filter
             identity
             (list (and (anchor? board square)
                        square)
                   (and (not (square-occupied? board (above square)))
                        (above square))
                   (and (not (square-occupied? board (below square)))
                        (below square))))
            anchors))
         '()))))

(define-record-and-printer word
  start
  characters
  orientation)

(define (normalize-characters characters)
  (if (member sentinel characters)
      (let iter ((characters characters)
                 (word '()))
        (if (null? characters)
            word
            (let ((character (car characters)))
              (if (sentinel? character)
                  (iter (reverse (cdr characters))
                        word)
                  (iter (cdr characters)
                        (cons character word))))))
      characters))

(define (word->string characters)
  (list->string (normalize-characters characters)))

(define delete-first
  (case-lambda
   ((x list) (delete-first x list equal?))
   ((x list =)
    (receive (prefix suffix)
      (break (lambda (y) (= x y)) list)
      (if (null? suffix)
          prefix
          (append prefix (cdr suffix)))))))

(define-record-and-printer player
  play
  score
  rack
  name)

(define-record-and-printer scrabble-move
  start
  word
  orientation)

(define-record-and-printer scrabble
  board
  tiles
  lexicon)

(define-record-and-printer game
  state
  init
  terminal?
  play)

;;; Scrabble is also known as: "game"; return a copy of the board, so
;;; we don't have to propagate later?
;;;
;;; Let's also test against the lexicon here instead of waiting for
;;; the end.
(define (scrabble-score scrabble player move)
  (let ((board (board-copy (scrabble-board scrabble)))
        (next-square (word-orientation move)))
    (let iter ((square (word-start move))
               (characters (word-characters move))
               (score 0)
               (next-square next-square))
      (if (null? characters)
          (and (match? (scrabble-lexicon scrabble)
                       (word-scan board
                                  (word-start move)
                                  (crosscheck-of next-square)))
               (scrabble-board-set! scrabble board)
               score)
          (let ((character (board-ref/default board square #f)))
            ;; TODO: We have to test this against their rack, don't
            ;; we? Every placement, for that matter.
            (if character
                (if (sentinel? (car characters))
                    (iter square
                          (reverse (cdr characters))
                          score
                          next-square)
                    (and (char=? character (car characters))
                         (iter (next-square square)
                               (cdr characters)
                               (+ score (hash-table-ref character->points character))
                               next-square)))
                (let ((character (car characters)))
                  (if (sentinel? character)
                      (iter square
                            (reverse (cdr characters))
                            score
                            next-square)
                      (begin
                        (board-set! board square character)
                        (let* ((orthogonal
                                (word-scan board
                                           square
                                           (crosscheck-of
                                            (orthogonal-to next-square))))
                               (crosscheck (crosscheck (scrabble-lexicon scrabble)
                                                       orthogonal)))
                          (and crosscheck
                               (iter (next-square square)
                                     (cdr characters)
                                     (+ score crosscheck)
                                     next-square))))))))))))

(define n-tiles-in-rack (make-parameter 7))

(define (plenish-rack! scrabble player)
  (let ((rack-deficit (- (n-tiles-in-rack)
                         (length (player-rack player))))
        (n-tiles (length (scrabble-tiles scrabble))))
    (when (and (positive? rack-deficit)
               (positive? n-tiles))
      (let* ((n-new-tiles (min rack-deficit n-tiles))
             (new-tiles
              (take (scrabble-tiles scrabble) n-new-tiles)))
        (player-rack-set! player
                          (append (player-rack player)
                                  new-tiles))
        (scrabble-tiles-set! scrabble
                             (drop (scrabble-tiles scrabble)
                                   n-new-tiles))))))

(define n-wrong-moves (make-parameter 3))

(define (shuffle! v)
  (do ((n (vector-length v) (- n 1)))
      ((zero? n) v)
    (let* ((r (random n)) (t (vector-ref v r)))
      (vector-set! v r (vector-ref v (- n 1)))
      (vector-set! v (- n 1) t))))

(define character->points
  (alist->hash-table
   `((,sentinel . 0)
     (#\E . 1)
     (#\A . 1)
     (#\I . 1)
     (#\O . 1)
     (#\N . 1)
     (#\R . 1)
     (#\T . 1)
     (#\L . 1)
     (#\S . 1)
     (#\U . 1)
     (#\D . 2)
     (#\G . 2)
     (#\B . 3)
     (#\C . 3)
     (#\M . 3)
     (#\P . 3)
     (#\F . 4)
     (#\H . 4)
     (#\V . 4)
     (#\W . 4)
     (#\Y . 4)
     (#\K . 5)
     (#\J . 8)
     (#\X . 8)
     (#\Q . 10)
     (#\Z . 10))))

(define (make-scrabble-tiles)
  (let ((tiles
         (list->vector
          (append
           (make-list 12 #\E)
           (make-list 9 #\A)
           (make-list 9 #\I)
           (make-list 8 #\O)
           (make-list 6 #\N)
           (make-list 6 #\R)
           (make-list 6 #\T)
           (make-list 4 #\L)
           (make-list 4 #\S)
           (make-list 4 #\U)
           (make-list 4 #\D)
           (make-list 3 #\G)
           (make-list 2 #\B)
           (make-list 2 #\C)
           (make-list 2 #\M)
           (make-list 2 #\P)
           (make-list 2 #\F)
           (make-list 2 #\H)
           (make-list 2 #\V)
           (make-list 2 #\W)
           (make-list 2 #\Y)
           (make-list 1 #\K)
           (make-list 1 #\J)
           (make-list 1 #\X)
           (make-list 1 #\Q)
           (make-list 1 #\Z)))))
    (shuffle! tiles)
    (vector->list tiles)))

(define (make-play-tiles)
  (list #\C #\A #\R #\E))

(define (make-scrabble-game lexicon)
  (let ((pass (make-hash-table))
        (wrong-moves (make-hash-table)))
    (make-game
     (make-scrabble
      (make-board)
      (make-scrabble-tiles)
      lexicon)
     (lambda (scrabble players)
       (for-each (cut plenish-rack! scrabble <>) players))
     (lambda (scrabble players)
       (or (and (zero? (length (scrabble-tiles scrabble)))
                (any zero?
                     (map (lambda (player) (length (player-rack player)))
                          players)))
           (and (positive? (hash-table-size pass))
                (every values (hash-table-values pass)))))
     (lambda (scrabble player)
       (plenish-rack! scrabble player)
       (let ((move ((player-play player)
                    (scrabble-board scrabble)
                    (player-rack player))))
         (debug move (player-rack player))
         (if move
             (let ((score (scrabble-score scrabble player move)))
               ;; Must also take player into consideration: do they have the
               ;; appropriate tiles, &c.?
               (debug score)
               (if score
                   (begin
                     (board-display (scrabble-board scrabble))
                     (player-score-set! player (+ (player-score player) score))
                     (hash-table-set! wrong-moves (player-name player) 0)
                     (hash-table-set! pass (player-name player) #f)
                     (let iter ((characters (word-characters move))
                                (square (word-start move)))
                       (unless (null? characters)
                         (let ((character (car characters)))
                           (player-rack-set! player (delete-first character (player-rack player)))
                           (iter (cdr characters)
                                 ((word-orientation move) square))))))
                   (begin
                     (hash-table-update!/default
                      wrong-moves
                      (player-name player)
                      add1
                      0)
                     (and (= (hash-table-ref/default wrong-moves (player-play name) 0)
                             (n-wrong-moves))
                          (hash-table-set! pass (player-name player) #t)))))
             (begin
               (hash-table-set! pass (player-name player) #t)
               #t)))))))

(define (calculate-moves! lexicon moves next-square board rack)
  (for-each
      (lambda (square)
        (let iter ((current-square square)
                   (rack (cons sentinel rack))
                   (subdag lexicon)
                   (next-square next-square)
                   (score 0)
                   (board board)
                   (word '())
                   (played-yet? #f))
          (when subdag
            (when (and played-yet? (dag-terminal? subdag))
              ;; We need to account for horizontally adjoining words
              ;; (if any): count the current word plus horizontally
              ;; adjoining words and the subtract the current word.
              (let ((crosscheck
                     (crosscheck lexicon
                                 (word-scan board
                                            square
                                            (crosscheck-of next-square)))))
                (when crosscheck
                  (let ((score (+ score (- crosscheck (length (delete sentinel word))))))
                    (heap-insert! moves
                                  score
                                  (make-word ((reverse-of next-square) current-square)
                                             word
                                             (reverse-of next-square)))))))
            (let ((character (board-ref/default board current-square #f)))
              (if character
                  (iter (next-square current-square)
                        rack
                        (dag-ref subdag character)
                        next-square
                        (+ score (hash-table-ref character->points character))
                        board
                        (cons character word)
                        played-yet?)
                  (for-each (lambda (character)
                              (if (sentinel? character)
                                  (let ((next-square (reverse-of next-square)))
                                    (iter (next-square square)
                                          (delete sentinel rack)
                                          (dag-ref subdag sentinel)
                                          next-square
                                          score
                                          board
                                          (cons character word)
                                          played-yet?))
                                  (begin
                                    (let ((board (board-copy board)))
                                      (board-set! board current-square character)
                                      (let* ((orthogonal
                                              (word-scan board
                                                         current-square
                                                         (crosscheck-of
                                                          (orthogonal-to next-square))))
                                             (crosscheck (crosscheck lexicon orthogonal)))
                                        (when crosscheck
                                          (iter (next-square current-square)
                                                (delete-first character rack)
                                                (dag-ref subdag character)
                                                next-square
                                                (+ score crosscheck)
                                                board
                                                (cons character word)
                                                #t)))))))
                    rack))))))
    (board-anchors board next-square)))

(define (make-scrabble-player lexicon)
  (make-player
   (lambda (board rack)
     (let ((moves (make-max-heap)))
       (calculate-moves! lexicon moves left-of board rack)
       (calculate-moves! lexicon moves above board rack)
       (and (not (heap-empty? moves))
            (heap-extract-extremum! moves))))
   0
   '()
   (gensym)))

(define (play game players)
  ((game-init game) (game-state game) players)
  (let iter ((round-robin (apply circular-list players)))
    ;; Players isn't part of the game-state, huh?
    (if ((game-terminal? game) (game-state game) players)
        (game-state game)
        (if ((game-play game) (game-state game) (car round-robin))
            ;; Successful move, go to the next player.
            (iter (cdr round-robin))
            ;; Circular; some failure to move. Should the player
            ;; forfeit? That's up to the game, isn't it?
            (iter round-robin)))))

(define (make-play-dag)
  (let ((lexicon (make-dag)))
    (update-dag! lexicon "ABLE")
    (update-dag! lexicon "AR")
    (update-dag! lexicon "ABLER")
    (update-dag! lexicon "BE")
    (update-dag! lexicon "CABLE")
    (update-dag! lexicon "CARE")
    lexicon))

(let ((lexicon (parameterize ((debug? #f))
                 (make-dag-from-file "words.txt"))))
  (let ((game (make-scrabble-game lexicon))
        (players (list (make-scrabble-player lexicon)
                       (make-scrabble-player lexicon))))
    (let ((scrabble (game-state game)))
     (play game players)
     (board-display (scrabble-board scrabble))
     (debug (map player-score players)
            (map player-rack players)))))

First pass: let’s ascribe to the word arbitrary origin; and move as far as we need to in any direction. (Board-boundaries are probably a trivial part of the problem.)

Game state contains \(x, y\) coördinates; can we do it in graphviz with pre-computation?

Append to the anchors according to prefices; do crosschecks.

(use debug srfi-1 test)

(define delete-first
  (case-lambda
   ((x list) (delete-first x list equal?))
   ((x list =)
    (receive (prefix suffix)
      (break (lambda (y) (= x y)) list)
      (if (null? suffix)
          prefix
          (append prefix (cdr suffix)))))))

(test '(#\B #\A #\Z)
      (delete-first #\A '(#\B #\A #\A #\Z)))

What we call a “dag” is really a lexicon. Games and players will have them; hopefully they correspond.

No tile-swapping mechanism yet; need to clean up nominations (“word” vs. “move”). Also, the scoring and move-generation code has a lot of duplication.

Debug with rack, move, board. Let’s do a primitive reader for human interaction.

Back to the database problem: can we compile something and load it as a library?

Consolidate scoring and generation; we’re dealing with some shitty sync problems right now.

CLOSED: 2013-04-18 Thu 19:18

CLOSED: 2013-04-18 Thu 19:18

Need a graph of possible moves (initially hard-coded for 3x3?); and a Manhattan distance calculator. Can we have an abstract game-graph?

(use data-structures
     debug
     heap
     stack)

(define-record node
  ;; @("Data structure for graphs"
  ;;   (state "An indexable point")
  ;;   (predecessor "The node-predecessor")
  ;;   (action "Not used")
  ;;   (path-cost "Cost of the path up to this point"))
  state
  predecessor
  action
  path-cost)

(define (make-initial-node state)
  (make-node state #f #f 0))

(define (predecessor-path node)
  ;; @("List the predecessors of this node."
  ;;   (node "The node to predecess")
  ;;   (@to "list"))
  (let iter ((path (list node)))
    (let ((predecessor (node-predecessor (car path))))
      (if predecessor
          (iter (cons predecessor path))
          ;; Do we want to reverse?
          (reverse path)))))

(define (search start
                successors
                step-cost
                goal?
                make-frontier
                frontier-add!
                frontier-delete!
                frontier-empty?)
  (let ((visited (make-hash-table))
        (frontier (make-frontier)))
    (frontier-add! frontier (make-initial-node start))
    (let search ()
      ;; (debug frontier)
      (if (frontier-empty? frontier)
          (error "Search failed -- SEARCH")
          (let* ((predecessor (frontier-delete! frontier))
                 (successors (successors predecessor)))
            ;; (debug predecessor)
            (hash-table-set! visited (node-state predecessor) #f)
            (if (goal? (node-state predecessor))
                (reverse (predecessor-path predecessor))
                (let ((unvisited-successors
                       (filter (lambda (successor)
                                 (hash-table-ref/default
                                  visited
                                  successor
                                  #t))
                               successors)))
                  ;; (debug predecessor successors unvisited-successors)
                  (for-each
                      (lambda (successor)
                        ;; (debug successor predecessor (node-state predecessor))
                        (let ((node (make-node successor
                                               predecessor
                                               #f
                                               (+ (node-path-cost predecessor)
                                                  ;; Should this be
                                                  ;; between two
                                                  ;; nodes?
                                                  (step-cost
                                                   successor
                                                   (node-state predecessor))))))
                          (frontier-add! frontier node)))
                    unvisited-successors)
                  (search))))))))

(define (search-depth-first start successors step-cost goal?)
  (search start
          successors
          step-cost
          goal?
          make-stack
          stack-push!
          stack-pop!
          stack-empty?))

(define (search-breadth-first start successors step-cost goal?)
  (search start
          successors
          step-cost
          goal?
          make-queue
          queue-add!
          queue-remove!
          queue-empty?))

(define (search-best-first start successors step-cost goal? f)
  (search start
          successors
          step-cost
          goal?
          make-min-heap
          (lambda (heap node)
            (let ((key (heap-key heap node))
                  (path-cost (f node)))
              (if key
                  (if (< path-cost key)
                      (heap-change-key! heap node path-cost))
                  (heap-insert! heap path-cost node))))
          heap-extract-extremum!
          heap-empty?))

(define (search-uniform-cost start successors step-cost goal?)
  (search-best-first start
                     successors
                     step-cost
                     goal?
                     node-path-cost))

(define (search-greedy-best-first start
                                  successors
                                  step-cost
                                  goal?
                                  heuristic)
  (search-best-first start
                     successors
                     step-cost
                     goal?
                     heuristic))

(define (A* start successors step-cost goal? heuristic)
  (search-best-first start
                     successors
                     step-cost
                     goal?
                     (lambda (node) (+ (node-path-cost node)
                                  (heuristic node)))))

(define (search-recursive-best-first start
                                     successors
                                     step-cost
                                     goal?
                                     heuristic)
  (define (search return predecessor f-limit)
    (debug (node-state predecessor))
    (if (goal? (node-state predecessor))
        (return (predecessor-path predecessor))
        (let ((successors (successors predecessor)))
          (if (null? successors)
              (values #f +inf)
              (let ((heap (make-min-heap)))
                (for-each
                    (lambda (successor)
                      (let ((successor
                              (make-node successor
                                         predecessor
                                         #f
                                         (step-cost
                                          successor
                                          (node-state predecessor)))))
                        (node-path-cost-set!
                         successor
                         (max (length (predecessor-path successor))
                              (node-path-cost predecessor)))
                        (heap-insert! heap
                                      (node-path-cost successor)
                                      successor)))
                  successors)
                (let iter ()
                  (let* ((best (heap-extremum heap))
                         (best-path-cost (node-path-cost best)))
                    (debug heap
                           (heap-size heap)
                           (node-state (heap-extremum heap)))
                    (if (> best-path-cost f-limit)
                        (values #f best-path-cost)
                        (let ((alternative
                               (if (= (heap-size heap) 1)
                                   +inf
                                   (let ((first
                                          (heap-extract-extremum! heap))
                                         (alternative
                                          (node-path-cost
                                           (heap-extremum heap))))
                                     (debug heap
                                            (heap-size heap)
                                            (node-state (heap-extremum heap))
                                            (node-path-cost first)
                                            first
                                            (node-state first)
                                            'iter
                                            (heap-member? heap first))
                                     (heap-delete! heap first)
                                     (debug 'iter (heap-member? heap first))
                                     (heap-insert!
                                      heap
                                      (node-path-cost first)
                                      first)
                                     alternative))))
                          (receive (predecessor best-path-cost)
                            (search return
                                    best
                                    (min f-limit alternative))
                            (if predecessor
                                (values predecessor best-path-cost)
                                (iter))))))))))))
  (call/cc (lambda (return)
             (search return (make-initial-node start) +inf))))

(define-record-and-printer point x y)

(define (point-distance p1 p2)
  ;; @("Calculate the distance between two points."
  ;;   (p1 "The first point")
  ;;   (p2 "The second point")
  ;;   (@to "distance"))
  (sqrt (+ (expt (- (point-x p1) (point-x p2)) 2)
           (expt (- (point-y p1) (point-y p2)) 2))))

(define (make-straight-line-distance-heuristic end)
  (lambda (node) (point-distance (node-state node) end)))

blank? could just as well be zero?, which would aid in testing vector-equality (could use e.g. (vector= = g1 g2).

Animated ditaa for visualization?

(use debug
     vector-lib)

(define (hamming-distance v1 v2)
  (vector-fold (lambda (i distance x1 x2)
                 (if (= x1 x2)
                     distance
                     (+ distance 1)))
               0
               v1
               v2))

(define (transpositions v1 v2)
  (let iter ((i 0)
             (transpositions 0))
    (if (= i (vector-length v1))
        transpositions
        ())))

(debug (hamming-distance '#(0 1 2 3 4 5 6 7 8)
                         '#(3 6 1 4 2 8 5 0 7))
       (hamming-distance '#(0 1 2 3 4 5 6 7 8)
                         '#(8 1 3 4 0 2 7 6 5))
       (hamming-distance '#(1 2 3 4 5 6 7 8 0)
                         '#(1 2 3 4 5 6 8 7 0)))
;;; edit

(use data-structures
     debug
     srfi-69
     test
     vector-lib)

(define (kendall-tau-distance v1 v2)
  (if (vector= = (sort v1 <) (sort v2 <))
      (let ((x->i (make-hash-table)))
        (vector-for-each (lambda (i x) (hash-table-set! x->i x i)) v2)
        (let iter ((i 0)
                   (distance 0))
          (if (or (= i (vector-length v1))
                  (= i (vector-length v2)))
              distance
              (let ((x1 (vector-ref v1 i))
                    (x2 (vector-ref v2 i)))
                (if (= x1 x2)
                    (iter (+ i 1) distance)
                    (let ((i2 (hash-table-ref x->i x1)))
                      (vector-swap! v1 i i2)
                      (iter (+ i 1) (+ distance 1))))))))
      (error "Vectors incomparable -- KENDALL-TAU-DISTANCE")))

(test 3
      (kendall-tau-distance (vector 1 2 3 4 5)
                            (vector 3 4 5 2 1)))

(debug (kendall-tau-distance
        (vector 1 2 3 4 5 6 7 8 9 10 11 12 13 15 14 0)
        (vector 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 0)))

(debug (kendall-tau-distance
        (vector 1 2 3 4 5 6 7 8 9 10 11 12 13 15 14 0)
        (vector 1 2 3 4 5 6 7 8 9 10 11 12 13 14 0 15)))

(define (contiguize! k v)
  (do ((i k (+ i (* 2 k))))
      ((>= i (vector-length v)))
    (vector-reverse! v i (+ i k))))

(define (contiguize k v)
  (let ((v (vector-copy v)))
    (contiguize! k v)
    v))

(debug (kendall-tau-distance
        (contiguize 4 (vector 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 0))
        (contiguize 4 (vector 1 2 3 4 5 6 7 8 9 10 11 12 13 15 14 0))))

(debug (kendall-tau-distance
        (contiguize 4 (vector 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 0))
        (contiguize 4 (vector 1 2 3 4 5 6 7 8 9 10 11 0 13 14 15 12))))

(use debug test vector-lib)

(define (contiguize! k v)
  (do ((i k (+ i (* 2 k))))
      ((>= i (vector-length v)))
    (vector-reverse! v i (+ i k))))

(let ((v '#(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15)))
  (contiguize! 4 v)
  (test v '#(0 1 2 3 7 6 5 4 8 9 10 11 15 14 13 12)))

Sign of permutation, with reference to n-puzzles; parity of permutation.

(use debug
     srfi-69
     vector-lib)

(define (unvisited? unvisited i)
  (hash-table-ref/default unvisited i #t))

(define (cycles v)
  (let ((visited (make-hash-table)))
    (vector-for-each
        (lambda (i x)
          (debug i x)
          (let iter ((next i)
                     (length 0))
            (debug next length)
            (if (unvisited? visited next)
                (begin
                  (hash-table-set! visited next #f)
                  (iter x
                        (+ length 1)))
                (debug length))))
        v)))

(define (cycles v)
  (let ((visited (make-hash-table)))
    (let iter ((i 0)
               (even-cycles 0))
      (if (= i (vector-length v))
          even-cycles
          (let iter-cycle ((next i)
                           (length 0))
            (debug next length)
            (if (unvisited? visited next)
                (begin
                  (hash-table-set! visited next #f)
                  (iter-cycle (vector-ref v next) (+ length 1)))
                (if (even? length)
                    (iter (+ i 1) (+ even-cycles 1))
                    (iter (+ i 1) even-cycles))))))))

(debug (cycles '#(3 4 5 2 1 0))
       (cycles '#(0 1 2 4 3 5))
       (cycles '#(3 1 2 0 4 5))
       (cycles '#(0 1 2 3))
       (cycles '#(0 1 3 2))
       (cycles '#(0 1 2))
       (cycles '#(2 1 0))
       (cycles '#(1 0 2))
       (cycles '#(0 1 2 5 4 3 6 7 8))
       (cycles '#(1 2 3 4 5 6 7 8 9 10 11 12 13 15 14 0)))

http://www.math.umt.edu/oliver/parity/nelson.pdf

https://stat.ethz.ch/pipermail/r-help/2008-April/159732.html

library(debug)

n <- 16
## p <- sample(1:n)
## p <- c(0,1,2,5,4,3,7,6,8)
p <- c(1,2,3,4,5,6,7,8,9,10,11,12,13,15,14,0)
p <- c(1,2,3,4,5,6,7,8,9,10,11,12,13,15,14)
p <- c(1,2,3,4,8,7,6,5,9,10,11,12,15,14,13)
p <- c(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,0)
p <- c(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15)
x <- integer(n)
print(p)
for (i in 1:n) {
  ## debug(x)
  z <- which(!x)[1]
  print(x)
  debug("outer", i, z)
  if (is.na(z)) break
  repeat {
    debug("inner", i, z, x[z], p[z], x[p[z]])
    x[z] <- i
    z <- p[z]
    if (x[z]) break
  }
}
x
clen <- table(x)
clen
1L - (sum(clen %% 2 == 0) %% 2)*2L

(use debug
     miscmacros
     srfi-1
     srfi-69
     vector-lib)

(define (cycles v)
  (let ((seen (make-vector (vector-length v) #f)))
    (let iter ((i 0)
               (cycles '()))
      (debug seen)
      (if (= i (vector-length v))
          (begin
            (debug cycles)
            (length (filter even? cycles)))
          (let iter-cycle ((j i)
                           (length 0))
            (debug j length)
            (if (vector-ref seen j)
                (iter (+ i 1)
                      (cons length cycles))
                (begin
                  (vector-set! seen j #t)
                  (iter-cycle (vector-ref v j)
                              (+ length 1)))))))))

(define (cycles v)
  (let ((seen (make-vector (vector-length v) 0)))
    (do ((i 1 (+ i 1)))
        ((> i (vector-length v)))
      (let ((z (vector-index zero? seen)))
        (debug z)
        (when z
          (while (zero? (vector-ref seen z))
            (debug z)
            (vector-set! seen z i)
            (set! z (vector-ref v z))))))
    seen))

(define (cycles v)
  (let ((cycles (make-hash-table))
        (seen (make-vector (vector-length v) #f)))
    (do ((i 0 (+ i 1)))
        ((= i (vector-length v)))
      (let iter ((j i))
        (unless (vector-ref seen j)
          (vector-set! seen j #t)
          (hash-table-update!/default
           cycles
           i
           (lambda (length) (+ length 1))
           0)
          (iter (vector-ref v j)))))
    (hash-table->alist cycles)))


(cycles '#(1 2 3 4 5 6 7 8 9 10 11 12 13 15 14 0))
(cycles '#(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 0))
(cycles '#(2 1 3 4 5 6 7 8 9 10 11 12 13 14 15 0))
(cycles '#(13 10 11 6 5 7 4 8 1 12 14 9 3 15 2 0))
(cycles '#(6 1 10 2 7 11 4 14 5 0 9 15 8 12 13 3))

http://stackoverflow.com/questions/7701345/how-to-programatically-create-a-valid-15-puzzle-in-code http://mathworld.wolfram.com/15Puzzle.html http://www.cs.bham.ac.uk/~mdr/teaching/modules04/java2/TilesSolvability.html http://kevingong.com/Math/SixteenPuzzle.html

(use debug
     srfi-69
     test
     vector-lib)

(define (inversions v)
  (let ((inversions (make-hash-table)))
    (vector-for-each
     (lambda (i x)
       (do ((j i (+ j 1)))
           ((= j (vector-length v)))
         ;; (debug i j x (vector-ref v j) (> x (vector-ref v j)))
         (when (and (> x (vector-ref v j)) (positive? (vector-ref v j)))
           (hash-table-update!/default inversions x add1 0))))
     v)
    (hash-table-fold
     inversions
     (lambda (x inversions total) (+ inversions total))
     0)))

;;; But see
;;; <http://www.cs.bham.ac.uk/~mdr/teaching/modules04/java2/TilesSolvability.html>.
(define soluble? (compose even? inversions))

(test-assert
 (not (soluble? '#(1 2 3 4 5 6 7 8 9 10 11 12 13 15 14 0))))
(test-assert
 (soluble? '#(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 0)))
(test-assert
 (not (soluble? '#(2 1 3 4 5 6 7 8 9 10 11 12 13 14 15 0))))
(test-assert
 (soluble? '#(6 1 10 2 7 11 4 14 5 0 9 15 8 12 13 3)))
(test-assert
 (not (soluble? '#(13 10 11 6 5 7 4 8 1 12 14 9 3 15 2 0))))
(test-assert
 (soluble? '#(1 2 3 0)))
(test-assert
 (not (soluble? '#(2 1 3 0))))
(test-assert
 (soluble? '#(1 2 0 3)))
(test-assert
 (soluble? '#(0 2 1 3)))

(debug (inversions '#(3 6 5 2 4 7 0 8 1)))

Chapter 3:

The transition model, specified by (result s a), returns the state that results from doing action a in state s.

A path in the state space is a sequence of states connected by a sequence of actions.

Sometimes the goal is specified by an abstract property rather than an explicitly enumerated set of states (e.g. checkmate).

A solution to a problem is an action sequence that leads from the initial state to a goal state. Solution quality is measured by the path-cost function.

Rather than returning a sequence of states (which might be expensive); return, rather, a sequence of actions and reconstitute the state as needed?

Actions constitute a kind of diff; it's also necessary when instructing an agent based on search.

Or, maybe it's ok: even AIMA-nodes have state.

We're lacking actions and transition models; step-cost apparently takes state and action. We're using states as a proxy for actions.

We'll have to adopt the action-model if we want to make this applicable to agents.

See this recursive best-first-search in Python, by the way.

CLOSED: 2012-10-01 Mon 03:29
Testing a node for a goal-state when it is selected for expansion is more conservative; does it lead to suboptimal results if we fail to do so for breadth-first?

We're going to have to use our own heap-implementation, incidentally, for e.g. uniform-cost and A*; since Ivan's binary-heap doesn't do key-resizing.

We're going to have to handle dynamic resizing, though (heap-merge!?); and add key- and payload-accessors.

CLOSED: 2012-10-01 Mon 03:29
See convex hulls. It turns out that we don't have to model it as all positions in the plane; let's model it as the corners of polygons. We have to have a notion of "reachable" vertices, however. Can we create the space as random polygons; and draw a graph of reachable vertices? What's the best way to draw the vertices and path?

What's the trick for coming up with non-intersecting polygons? Is this important? I think so, since we'll otherwise search unreachable vertices; unless we can merge the polygons: but there's no guarantee that the polygons will intersect at integer-valued x-ys.

See random simple polygons (might be best to avoid self-intersecting ones); also, random orthogonal polygons. Nothing yet on random-non-intersecting polygons; does it suffice to reject points-in-preëxisting-polygons? You also have to take care not to enclose prexisting points in new polygons. If we were drawing parallel planes in e.g. three dimensions, this would be less of a concern. Feasible? Sure. How do we draw it?

"Random non-overlapping polygons" might be more fruitful; seems like it would be worthwhile to simply start drawing them at random, rejecting overlapping ones until we reach \(n\).

(See CGAL, incidentally: it even contains visualization and polygon-operations; random polygons.)

Talking about convex hulls and voronoi diagrams to construct random simple polygons; I wonder if CGAL wouldn't come in handy, after all. Write the Scheme bindings? Ouch.

Can we just do a Voronoi tesselation and call it a day? It seems like it has all the properties we're looking for: non-overlapping simple polygons, unreachable points. Let's do it!

At this point, though, isn't it indistinguishable from drawing random points in the plane and searching with a straight-line heuristic? Yes. Voronoi diagrams are irrelevant. We could, of course, generate them for the hell of it (using continuous, not discrete, coördinates); and use their boundaries as our vertices. Why? It's pretty. Still have to figure out how to draw them, though.

Delaunay triangulation in R, incidentally; using spatstat and maptools, also latticeExtra.

Voronoi diagrams are one-liners in R; another example. See also sp and deldir. CGAL does it, too, of course.

See Lloyd's algorithm, Bowyer-Watson, and Fortune; an alternative is Delaunay triangulation, too. Basically, we have random points; and want to divvy them up into coincident, non-overlapping, convex polygons. There's a number of algorithms for Delaunay triangulation; one of which is \(O(n^2)\).

What about just a Euclidean minimum spanning tree? We can even find one in O(n log n).

Look no further than Computational Geometry: implementable algorithms, detailed explanations. Next candidate for LACSRG, incidentally?

We might as well go straight to Fortune; Berg is somewhat irritating with internal references; Èuk Roman did a sub-adequate job.

Steven's own implementation in c

Has some good non-optimal algorithms; n².

Good prose from AMS:

If the next event that the sweep line encounters is a site event, we simply insert the new site into our list of sites in the order in which the corresponding parabolic arc appears on the beach line. We then record the fact that we have encountered a new edge in the diagram.

If the next event that the sweep line encounters is a circle event, we record the fact that we have encountered a vertex in the diagram and that this vertex is the endpoint of the edges corresponding to the two breakpoints that have come together. We also record the new edge corresponding to the new breakpoint that results from the circle event.

Whether we encounter a site or circle event, we will always check to see if we have added a new triple of parabolic arcs on the beach line that may lead to a future circle event. It is also possible that we will remove a future circle event from consideration if the triple of parabolic arcs that led to it no longer exists after the event.

Berg is pretty good, actually:

Now we know where and how the combinatorial structure of the beach line changes: at a site event a new arc appears, and at a circle event an existing arc drops out. We also know how this relates to the Voronoi diagram under construction: at a site event a new edge starts to grow, and at a circle event two growing edges meet to form a vertex.

On the justification for \(\mathcal{T}\), which changes:

The paradigm involves maintaining the intersection of the Voronoi diagram with the sweep line. Unfortunately this is not so easy, because the part of Vor(P) above depends not only on the sites that lie above \(\ell\) but also on sites below \(\ell\). Stated differently, when the sweep line reaches the topmost vertex of the Voronoi cell \(V(p_i)\) it has not yet encountered the corresponding site \(p_i\). Hence, we do not have all the information needed to compute the vertex. We are forced to apply the plane sweep paradigm in a slightly different fashion: instead of maintaining the intersection of the Voronoi diagram with the sweep line, we maintain information about the part of the Voronoi diagram of the sites above \(\ell\) that cannot be changed by sites below \(\ell\).

Sweep line \(\ell\); the beach line, however:

The locus of points that are closer to any site above \(\ell\) than to \(\ell\) itself is bounded by parabolic arcs. We call this sequence of parabolic arcs the beach line.

The beach line is x-monotone, that is, every vertical line intersects it in exactly one point.

Breakpoints:

Notice that the breakpoints between the different parabolic arcs forming the beach line lie on edges of the Voronoi diagram . . . the breakpoints exactly trace out the Voronoi diagram while the sweep line moves from top to bottom.

So, instead of maintaining the intersection of \(Vor(P)\) with \(\ell\), we maintain the beach line as we move our sweep line \(\ell\). We do not maintain the beach line explicitly, since it changes continuously as \(\ell\) moves.

[The beach line's combinatorial structure changes] when a new parabolic arc appears on it, and when a parabolic arc shrinks to a point and disappears.

On site events:

[A new arc appears on the beach line] when the sweep line \(\ell\) reaches a new site. The parabola defined by this site is at first a degenerate parabola with zero width: a vertical line segment connecting the new site to the beach line. As the sweep line contiues to move downward the new parabola gets wider and wider.

We call the event where a new site is encountered a site event.

At a site event two new breakpoints appear, which start tracing out edges. In fact, the new breakpoints coincide at first, and then move in opposite directions to trace out the same edge. Initially, this edge is not connected to the rest of the Voronoi diagram . . . Later on, the growing edge will run into another edge, and it becomes connected to the rest of the diagram.

Site events and beach lines:

The only way a new arc can appear on the beach line is through a site event.

The beach line consists of at most \(2n - 1\) parabolic arcs: each site encountered gives rise to one new arc and the splitting of at most one existing arc into two.

Circle events:

The second type of event is where an existing arc of the beach line shrinks to a point and disappears. Three arcs \(\alpha\), \(\alpha^\prime\), \(\alpha^{\prime\prime}\) are defined by three sites \(p_i\), \(p_j\), and \(p_k\). At the moment \(a^\prime\) disappears, the parabolas defined by these three sites pass through a common point \(q\). Point \(q\) is equidistant from \(\ell\) and each of the three sites. Hence, there is a circle passing through \(p_i\), \(p_j\), and \(p_k\) with \(q\) as its center and whose lowest point lies on \(\ell\). The point \(q\) is a vertex of the Voronoi diagram.

We call the event where the sweep line reaches the lowest point of a circle through three sites defining consecutive arcs on the beach line a cirle event.

Circle events and arcs:

The onl way in which an existing arc can disappear from the beach line is through a circle event.

At a site event a new arc appears, and at a circle event an existing arc drops out.

At a site event a new edge starts to grow, and at a circle event two growing edges meet to form a vertex.

Data structures:

We need a data structure that stores the part of the Voronoi diagram computed thus far. We also need the two `standard' data structures for any sweep line algorithm: an even queue and a structure that represents the status of the sweep line. Here the latter structure is a representation of the beach line.

We store the Voronoi diagram as a doubly-connected edge list.

The beach line is represented by a balanced binary search tree \(\mathcal{T}\). Its leaves correspond to the arcs of the beach line–which is \(x\)-monotone–in an ordered manner: the leftmost leaf represents the leftmost arc, and so on. Each leaf \(\mu\) stores the site that defines the arc it represents. The internal nodes of \(\mathcal{T}\) represent the breakpoints on the beach line. A breakpoint is stored at an internal node by an ordered tuple of site \(<p_i, p_j>\), where \(p_i\) defines the parabola left of the breakpoint and \(p_j\) defines the parabola to the right. We can find in \(O(\log n)\) the arc of the beach line lying above a new site. At an internal node, we simply compare the \(x\)-coördinate of the new site with the \(x\)-coördinate of the breakpoint, which can be computed from the tuple of sites and the position of the sweep line in constant time.

In \(\mathcal{T}\) we also store pointers to the other two data structures used during the sweep. Each leaf of \(\mathcal{T}\), representing arc \(\alpha\), stores a pointer to a circle event in the event queue in which \(\alpha\) will disappear. This pointer is nil if no circle event exists where \(\alpha\) will disappear, or this circle event hasn't been detected yet. Every internal node \(v\) has a pointer to a half-edge in the doubly-connected edge list of the Voronoi diagram. \(v\) has a pointer to one of the half-edges of the edge being traced out by the breakpoint represented by \(v\).

The event queue \(\mathcal{Q}\) is implemented as a priority queue, where the priority of an event is its \(y\)-coördinate. It stores the upcoming events that are already known. For a site event we simply store the site itself. For a circle event the event point that we store is the lowest point of the circle, with a pointer to the leaf in \(\mathcal{T}\) that represents the arc that will disappear in the event.

Detection of circle events:

All the site events are known in advance, but the circle events are not.

During the sweep the beach line changes its topological structure at every event. This may cause new triples of consecutive arcs to appear on the beach line and it may cause existing triples to disappear. For every three consecutive arcs on the beach line that define a potential circle event, the potential event is stored in the event queue \(\mathcal{Q}\).

There can be consecutive triples whose two breakpoints do not converge. It can also happen that the triple disappears before the event has taken place: \(false alarm\).

At every event, it checks all the new triples of consecutive arcs that appear. At a site event we can get three new triples: one where the new arc is the left arc of the triple, on where it is the middle arc, and one where it is the right arc. When such a new triple has converging breakpoints, the event is inserted into the event queue \(\mathcal{Q}\). In the case of a site event, the triple with the new arc being the middle one can never cause a circle event, because the left and right arc of the triple come from the same parabola and therefore the breakpoints must diverge.

For all disappearing triples it is checked whether they have a corresponding event in \(\mathcal{Q}\). If so, the event is a false alarm, and it is deleted from \(\mathcal{Q}\). This can be done using the pointers we have from the leaves in \(\mathcal{T}\) to the corresponding circle events in \(\mathcal{Q}\).

Voronoi vertices and circle events:

Every Voronoi vertex is detected by means of a circle event.

The corresponding circle event is in \(\mathcal{Q}\) just before the event takes place, and the Voronoi vertex is detected.

The algorithm:

After the event queue \(\mathcal{Q}\) is empty, the beach line hasn't disappeared yet. The breakpoints correspond to the half-infinite edges of the Voronoi diagram. We must add a bounding box to which these edges can be attached.

Javascript Voronoi, by the way;

• TODO Implementation
  

  At a site event two new breakpoints appear, which start tracing out edges. In fact, the new breakpoints coincide at first, and then move in opposite directions to trace out the same edge.

  A breakpoint is stored at an internal node by an ordered tuple of sites pi , p j , where pi defines the parabola left of the breakpoint and p j defines the parabola to the right.

  Computing the breakpoint (from here):

  Between each consecutive pair of sites pi and pj , there is a breakpoint. Although the breakpoint moves as a function of the sweep line, observe that it is possible to compute the exact location of the breakpoint as a function of pi , pj , and the current y-coordinate of the sweep line. In particular, the breakpoint is the center of a circle that passes through pi , pj and is tangent to the sweep line. Thus, as with beach lines, we do not explicitly store breakpoints. Rather, we compute them only when we need them.

  Given a fixed location of the sweep line, determine the arc of the beach line that intersects a given vertical line. This can be done by a binary search on the breakpoints, which are computed “on the fly”. (Think about this.)

  They're talking about consecutive triples on the beach-line, by the way; is this a factor of \(x\)-monotonicity?

  For each consecutive triple pi , pj , pk on the beach line, we compute the circumcircle of these points. (We’ll leave the messy algebraic details as an exercise, but this can be done in O(1) time.) If the lower endpoint of the circle (the minimum y-coordinate on the circle) lies below the sweep line, then we create a vertex event whose y-coordinate is the y-coordinate of the bottom endpoint of the circumcircle. We store this in the priority queue. Each such event in the priority queue has a cross link back to the triple of sites that generated it, and each consecutive triple of sites has a cross link to the event that it generated in the priority queue.

  This is pretty cool:

  Let pi be the current site. We shoot a vertical ray up to determine the arc that lies immediately above this point in the beach line. Let pj be the corresponding site. We split this arc, replacing it with the triple of arcs pj , pi , pj which we insert into the beach line. Also we create new (dangling) edge for the Voronoi diagram which lies on the bisector between pi and pj . Some old triples that involved pj may be deleted and some new triples involving pi will be inserted. For example, suppose that prior to insertion we had the beach-line sequence p1 , p2 , pj , p3 , p4 . The insertion of pi splits the arc pj into two arcs, denoted pj and pj . Although these are separate arcs, they involve the same site, pj . The new sequence is p1 , p2 , pj , pi , pj , p3 , p4 . Any event associated with the old triple p2 , pj , p3 will be deleted. We also consider the creation of new events for the triples p2 , pj , pi and pi , pj , p3 . Note that the new triple pj , pi , pj cannot generate an event because it only involves two distinct sites.

  Also for vertices:

  Let pi , pj , and pk be the three sites that generate this event (from left to right). We delete the arc for pj from the beach line. We create a new vertex in the Voronoi diagram, and tie the edges for the bisectors (pi , pj ), (pj , pk ) to it, and start a new edge for the bisector (pi , pk ) that starts growing down below. Finally, we delete any events that arose from triples involving this arc of pj , and generate new events corresponding to consecutive triples involving pi and pk (there are two of them). For example, suppose that prior to insertion we had the beach-line sequence p1 , pi , pj , pk , p2 . After the event we have the sequence p1 , pi , pk , p2 . We remove any events associated with the triples p1 , pi , pj and pj , pk , p2 . (The event pi , pj , pk has already been removed since we are processing it now.) We also consider the creation of new events for the triples p1 , pi , pk and pi , pk , p2 .

  About the appearance and disappearance of triples (how to find triples?):

  So what the algorithm does is this. At every event, it checks all the new triples of consecutive arcs that appear. For instance, at a site event we can get three new triples: one where the new arc is the left arc of the triple, one where it is the middle arc, and one where it is the right arc.

  Let's table Voronoi for the time being, or at least out-source it to R; even shit as trivial as finding the center of circles between two points and a tangent seems difficult.

  Can't we just hard-code the determinant and solve the equations; how did Fortune do it?

  • TODO Binary search on breakpoints
    See computing-breakpoint.

    Circle from two points and a line; there are two.

    Symbolic solution (given three points):

    This can all be done symbolically, of course, but you'll get some 
    pretty complicated expressions for h and k. The simplest forms of 
    these involve determinants, if you know what they are:
    
             |x1^2+y1^2  y1  1|        |x1  x1^2+y1^2  1|
             |x2^2+y2^2  y2  1|        |x2  x2^2+y2^2  1|
             |x3^2+y3^2  y3  1|        |x3  x3^2+y3^2  1|
         h = ------------------,   k = ------------------
                 |x1  y1  1|               |x1  y1  1|
               2*|x2  y2  1|             2*|x2  y2  1|
                 |x3  y3  1|               |x3  y3  1|
    

• Visualization
  Some screencaps from the Odgaard-Nielsen program.

• TODO Test data
  tripack has an interesting test-case:

  > tritest
  $x
   [1] 0.00 1.00 0.50 0.15 0.85 0.50 0.00 1.00 0.35 0.65 0.65 0.35
  
  $y
   [1] 0.00 0.00 0.15 0.50 0.50 0.85 1.00 1.00 0.35 0.35 0.65 0.65
  

  > voronoi.mosaic(tritest)
  voronoi mosaic:
  nodes: (x,y): neighbours (<0: dummy node)
  1: (0.5,-0.7583333): 7 2 -1
  2: (0.2392857,0.1107143): 8 3 1
  3: (0.1107143,0.2392857): 9 4 2
  4: (-0.7583333,0.5): 10 -2 3
  5: (1.758333,0.5): 11 6 -3
  6: (0.8892857,0.2392857): 12 7 5
  7: (0.7607143,0.1107143): 8 1 6
  8: (0.5,0.30625): 17 2 7
  9: (0.30625,0.5): 18 10 3
  10: (0.1107143,0.7607143): 14 4 9
  11: (0.8892857,0.7607143): 16 12 5
  12: (0.69375,0.5): 17 6 11
  13: (0.5,1.758333): -4 14 16
  14: (0.2392857,0.8892857): 10 15 13
  15: (0.5,0.69375): 18 16 14
  16: (0.7607143,0.8892857): 11 13 15
  17: (0.5,0.5): 12 18 8
  18: (0.5,0.5): 15 9 17
  dummy nodes: (x,y)
  1: (0.5,-3.275)
  2: (-3.275,0.5)
  3: (4.275,0.5)
  4: (0.5,4.275)      
  

  Uh, oh; floating-point difficulties:

  > voronoi.mosaic(c(0, sqrt(1/2), 1), c(1, sqrt(1/2), 0))
  voronoi mosaic:
  nodes: (x,y): neighbours (<0: dummy node)
  1: (2.680315e-16,2.680315e-16): -1 -2 -3 
  dummy nodes: (x,y)
  1: (2.680315e-16,2.680315e-16)
  2: (2.680315e-16,2.680315e-16)
  3: (2.680315e-16,2.680315e-16)
  

  From Steven's implementation:

  λ ~/prg/c/fortune/ master cat | ./voronoi
  0 1
  0.70710678118 0.70710678118
  1 0
  s 1.000000 0.000000
  s 0.707107 0.707107
  l -0.414214 1.000000 -0.000000
  s 0.000000 1.000000
  l -1.000000 1.000000 0.000000
  v -0.000000 -0.000000
  l 1.000000 -0.414214 -0.000000
  e 1 -1 0
  e 2 0 -1
  e 0 0 -1
  

  It appears as though he generates the bisecting-lines upon finding points; keeps track of partial edges on those lines.

  s a b indicates that an input point at coordinates l a b c indicates a line with equation ax + by = c. v a b indicates a vertex at a b. e l v1 v2 indicates a Voronoi segment which is a subsegment of line number l; with endpoints numbered v1 and v2. If v1 or v2 is -1, the line extends to infinity.

• Several implementations and "low-level" pseudo-code
  http://blog.ivank.net/fortunes-algorithm-and-implementation.html

• Fortune's notes
  Here and here; gotten from here.

  Site event:

  Let pi be the current site. We shoot a vertical ray up to determine the arc that lies immediately above this point in the beach line. Let pj be the corresponding site. We split this arc, replacing it with the triple of arcs pj , pi , pj which we insert into the beach line. Also we create new (dangling) edge for the Voronoi diagram which lies on the bisector between pi and pj . Some old triples that involved pj may be deleted and some new triples involving pi will be inserted.

  Vertex event:

  Let pi , pj , and pk be the three sites that generate this event (from left to right). We delete the arc for pj from the beach line. We create a new vertex in the Voronoi diagram, and tie the edges for the bisectors (pi , pj ), (pj , pk ) to it, and start a new edge for the bisector (pi , pk ) that starts growing down below. Finally, we delete any events that arose from triples involving this arc of pj , and generate new events corresponding to consecutive triples involving pi and pk (there are two of them).

• Voronoi toy
  http://nodename.com/blog/2009/05/11/a-voronoi-toy/

  Points to this implementation of Fortune's.

• Good overview
  See here; actually breaks down the change in the tree and double-linked list.

• TODO Calculate convergence of breakpoints
  Good animations; still doesn't elaborate on how to calculate whether the breakpoints converge.

  First of all, there can be consecutive triples whose two breakpoints do not converge, that is, the directions in which they move are such that they will not meet in the future; this happens when the breakpoints move along two bisectors away from the intersection point. In this case the triple does not define a potential circle event.

  Someone answered their own question:

  As long as three sites are not collinear, then the edges that perpendicularly bisect the segments between the sites are also tangent to the circle whose edge contains all three sites. Therefore the breakpoints defined by a triple of Voronoi sites converge if the center of the circle defined by the three sites is in front of the middle site, where "in front" and "behind" depend on the coordinate system and sweepline alignment you have chosen.

• TODO Doubly-connect edge list
  See here:

  DCEL is more than just a doubly linked list of edges. In the general case, a DCEL contains a record for each edge, vertex and face of the subdivision. Each record may contain additional information, for example, a face may contain the name of the area. Each edge usually bounds two faces and it is therefore convenient to regard each edge as half-edge. Each half-edge bounds a single face and thus has a pointer to that face. A half-edge has a pointer to the next half-edge and previous half-edge of the same face. To reach the other face, we can go to the twin of the half-edge and then traverse the other face. Each half-edge also has a pointer to its origin vertex (the destination vertex can be obtained by querying the origin of its twin).

  Each vertex v contains the coordinates of the vertex and also stores a pointer to an arbitrary edge that has v as its origin. Each face stores a pointer to some half-edge of its outer boundary (if the face is unbounded then pointer is null). It also has a list of half-edges, one for each hole that may be incident within the face. If the vertices or faces do not hold any interesting information, there is no need to store them, thus saving space and reducing the data structure complexity.

• TODO \(O(n^2 \log n)\) intersection of all the half-planes
  Bisector between two points: perpendicular; points that are the same distance from \(p\) and \(q\).

  From Tufts:

  A naive approach to construct of a Voronoi diagram is to determine the region for each site, one at a time. Since each region is the intersection of n − 1 half-planes, we can use an O(n log n) half-plane intersection algorithm to determine this region. Repeating for all n points, we have an O(n2 log n) algorithm.

  Finally understand Berg's reference to chapter 4: they employ a sweep-line for intersection.

  Another description:

  For all pairs of sites, find their perpendicular bisector. This calculation takes O(n log n) time and is done once. Next, we take all the open half-planes that contain a site and calculate the intersection of these half-planes to obtain the Voronoi cell for this site. An optimal algorithm for computing the intersection of half-planes is O(n log n) ¹⁷. Repeat for every site. The overall complexity then becomes O(n2 log n).

• Voronoi over Delaunay
  See here:

  This function creates a Voronoi mosaic.

  It creates first a Delaunay triangulation, determines the circumcircle centers of its triangles, and connects these points according to the neighbourhood relations between the triangles.