;;;; -*- mode:Scheme -*- ;;;;

;;; 8-Puzzle for 6.034 (by TLP@mit.edu).

(declare (usual-integrations))

;;; Accessors and contructor for POS (we use lists so that equal? works).
(define make-pos list)
(define pos-x first)
(define pos-y second)

;;; All the positions in a board
(define *ALL-POSITIONS* 
  (map (lambda (x-y) (apply make-pos x-y))
       '((0 0) (0 1) (0 2) (1 0) (1 1) (1 2) (2 0) (2 1) (2 2))))

;;; BOARD
;;; A board is a list of 3 lists, each with 3 entries
;;;   ((b00 b01 b02) (b10 b11 b12) (b20 b21 b22))
;;; Entries are numbers, except for the empty tile = #f

;;; Example board...
(define *GOAL-BOARD* '((7 8 1) (6 #f 2) (5 4 3)))

;;; Returns new board, with x,y entry set to value.
(define (SET-BOARD-VALUE board pos value)
  (let ((x (pos-x pos))
	(y (pos-y pos)))
    (define (set-board-y col)
      (map (lambda (entry j)
	     ;; replace the yth entry with value, 
	     ;; otherwise return entry
	     (if (= y j) value entry))
	   col
	   '(0 1 2)))
    (map (lambda (col i)
	   ;; replace the xth col with modified col
	   (if (= i x)
	       (set-board-y col)
	       col))
	 board
	 '(0 1 2))))

(define (BOARD-VALUE board pos)
  (list-ref (list-ref board (pos-x pos)) (pos-y pos)))

;;; Are two positions adjacent (horizontal or vertical)
(define (ADJACENT? pos1 pos2)
  (let ((dx (abs (- (pos-x pos1) (pos-x pos2))))
	(dy (abs (- (pos-y pos1) (pos-y pos2)))))
    (= 1 (+ dx dy))))

;;; MOVES

;;; A list of pos (where the empty tile can move)
(define (VALID-MOVES board from)
  (filter (lambda (to) (valid-move? board from to))
	  *all-positions*))

;;; Returns boolean
(define (VALID-MOVE? board from to)
  (and (adjacent? from to)
       (let ((content-to (board-value board to))
	     (content-from (board-value board from)))
	 (and content-to (not content-from))
	 )))

;;; Returns new board
(define (MAKE-MOVE board from to)
  (if (valid-move? board from to)
      (let ((content-to (board-value board to)))
	(set-board-value (set-board-value board to #f)
			 from content-to))
      (error "Invalid move" move board)))

;;; STATE
;;; A state of the game is a list: (board empty-pos)
;;; We use a list because we require that states be compared using equal?, so 
;;; that we can hash them using equal?.  If we used structures, the same
;;; state (same board) would not be equal?

(define MAKE-STATE list)
(define STATE-BOARD first)
(define STATE-EMPTY-POS second)
(define STATE-NAME state-board)		; used for indexing and display

;;; Making a state from a board
(define (BOARD->STATE board)
  (make-state board (find-tile board #f)))

(define *GOAL-STATE* (board->state *goal-board*))

;;; Returns a list of (neighbor cost=1)...
(define (STATE-NEIGHBORS state)
  (map (lambda (pos)
	 ;; (state cost)
	 (list (make-state (make-move (state-board state) (state-empty-pos state) pos)
			   pos)
	       1))
       (valid-moves (state-board state) (state-empty-pos state))))

(define (NEIGHBOR-STATE n) (and n (first n)))
(define (NEIGHBOR-COST n) (and n (second n)))

;;; Simulates an inconsistent (but admissible) heuristic.
(define (STATE-HEURISTIC-VALUE state goal)
  ;; (radom N) returns numbers in the range [0 .. N-1]
  (random (1+
	   (sum-manhattan-distance (state-board state) (state-board goal)))))

;;; Uses the weaker heuristic
(define (STATE-HEURISTIC-VALUE state goal)
  (count-misplaced-tiles  (state-board state) (state-board goal)))

;;; Uses the stronger heuristic
(define (STATE-HEURISTIC-VALUE state goal)
  (sum-manhattan-distance  (state-board state) (state-board goal)))

;;; Some utilities for heuristics

;;; Returns a pos where value occurs on board.
(define (FIND-TILE board value)
  (define (loop pos-list)
    (if (null? pos-list)
	(error "Could not find the tile" board value)
	(let ((pos (first pos-list)))
	  (if (equal? value (board-value board pos))
	      pos
	      (loop (cdr pos-list))))))
  (loop *all-positions*))

;;; Count the tiles not at their goal position.
(define (COUNT-MISPLACED-TILES board goal)
  (define (loop pos-list i)
    (if (null? pos-list)
	i
	(let* ((pos (first pos-list))
	       (value (board-value board pos)))
	  (if (or (not value)		; don't count empty tile
		  (equal? value (board-value goal pos)))
	      (loop (cdr pos-list) i)
	      (loop (cdr pos-list) (+ i 1))))))
  (loop *all-positions* 0))

;;; Distance walking along the horiz and vert segments of a grid.
(define (MANHATTAN-DISTANCE pos1 pos2)
  (+ (abs (- (pos-x pos1) (pos-x pos2)))
     (abs (- (pos-y pos1) (pos-y pos2)))))

;;; Sum of the Mamhattan distance to their targets of all misplaced tiles.
;;; Note that this is just like COUNT-MISPLACE-TILES except we increment 
;;; by dist instead of by 1.
(define (SUM-MANHATTAN-DISTANCE board goal)
  (define (loop pos-list dist)
    (if (null? pos-list)
	dist
	(let* ((pos (first pos-list))
	       (value (board-value board pos)))
	  (if (or (not value)		; don't count empty tile
		  (equal? value (board-value goal pos)))
	      (loop (cdr pos-list) dist)
	      (loop (cdr pos-list)
		    (+ dist (manhattan-distance pos (find-tile goal value))))))))
  (loop *all-positions* 0))

;;; Some testing values
(define *HARD-START-STATE* (board->state '((7 1 8) (6 2 #f) (5 4 3))))
(define *EASY-START-STATE* (board->state '((#f 8 1) (7 2 3) (6 5 4))))

;;; The example in Figure 9.2 of Nilsson's AI: A New Synthesis.
(define *NILSSON-START-STATE* (board->state '((2 8 3) (1 6 4) (7 #f 5))))
(define *NILSSON-GOAL-STATE* (board->state '((1 2 3) (8 #f 4) (7 6 5))))