Shortest Path Finder
A. Second Edition
In <The Matrix>, Morpheus said to Neo that there was a big difference between knowing the path and walking through the path.
It seems fitting this scenario. To test a solution is always much easier than finding the solution. Let me tell you something
I figure out from this puzzle which I spent a lot time on it before. This is a permutation problem which means you are supposed
to find one sequence from all the permutation of a set. Usually this is not the hardest one. In my opinion, the partition and
combination problem is more difficult because it may spent more time to generate the combination and partition pattern. (I am
not very sure about it.)
Alright, here we go to walk the path!
Hex is a two player strategy game played on a NxN rhombus of hexagons. Players alternately mark hexes. The goal of the first player (red) is to form a unbroken chain of his hexes that connects the top to the bottom, while the second player (blue) attempts to form an unbroken chain of her hexes connecting the left side and the right.
You can (and should) test your program on small board sizes, however, it must be able to play on an 11x11 board, not using more than approximately 30 seconds to compute a move.Work on this project is done by the groups already formed.
The Scheme programming language will be used for programming. Specifically, the Gambit-C programming system version 3.0. Scheme is a simple and powerful variant of the Lisp programming language. Although Gambit-C provides many extensions to the Scheme programming language, you should restrict your code to the R5RS Scheme standard for this homework (see http://www.schemers.org/Documents/Standards/R5RS/).
We provide you with a file board.scm that contains some functions and definitions for a Hex game board. You should load it within your own program like this:
------------------------------------------------------------------------------- ; Hex game playing program ; ; Authors: Milly Cow and Maud Vachon ; <=== your names ; This program always wins ; <=== other useful comments (load "board") (define ...) ; <=== other definitions you need ; implement the following function to make a "move" for a player: (define (move board color) ; board: see "board.scm", ... ; color: #t=red, #f=blue, ) ; <return> #t: win, #f: no win (continue) --------------------------------------------------------------------------------
To test your code, you can use the provided play function that calls the move function until one side wins (note that in this game, there is no draw --- one side always wins).
The reason I post this failure is that I only realize its impossibility after I have gone such a long way! It is a total
waste with a very high price. For a while I even regarded it as the most complicated function I have ever written in
Scheme. However, there is better way to do it. And I have found it.
E.Further improvement
Bugs are inevitable and I will update new versions asap.
F.File listing
1. shortestpath.txt
2. board.scm
3. displayboard.scm
file name: shortestpath.txt
(load "board.scm")
(load "displayboard.scm")
(define n_infinite 1000)
(define n_currentLength n_infinite)
(define n_row0 (vector 'E 'E 'E 'R 'B 'B 'R 'R 'E 'E 'E))
(define n_row1 (vector 'E 'E 'E 'E 'E 'E 'E 'E 'E 'E 'E))
(define n_row2 (vector 'E 'E 'E 'E 'E 'E 'E 'E 'E 'E 'E))
(define n_row3 (vector 'E 'E 'E 'E 'E 'E 'E 'E 'E 'E 'E))
(define n_row4 (vector 'E 'E 'E 'E 'E 'E 'E 'E 'E 'E 'E))
(define n_row5 (vector 'E 'E 'E 'E 'E 'E 'E 'E 'E 'E 'E))
(define n_row6 (vector 'E 'E 'E 'E 'E 'E 'E 'E 'E 'E 'E))
(define n_row7 (vector 'E 'E 'E 'E 'E 'E 'E 'E 'E 'E 'E))
(define n_row8 (vector 'E 'E 'E 'E 'E 'E 'E 'E 'E 'E 'E))
(define n_row9 (vector 'E 'E 'E 'E 'E 'E 'E 'E 'E 'E 'E))
(define n_row10 (vector 'E 'E 'E 'E 'E 'E 'E 'E 'E 'E 'E))
(define n_myboard (vector n_row0 n_row1 n_row2 n_row3 n_row4 n_row5 n_row6 n_row7 n_row8 n_row9 n_row10))
(define n_vectorGet
(lambda (vv r c)
(vector-ref (vector-ref vv r) c)
)
)
(define n_sameColor
(lambda (board color row col)
(or (and color (eq? (n_vectorGet board row col) 'R))
(and (not color)(eq? (n_vectorGet board row col) 'B))
)
)
)
(define n_otherColor
(lambda (board color row col)
(or (and color (eq? (n_vectorGet board row col) 'B))
(and (not color)(eq? (n_vectorGet board row col) 'R))
)
)
)
(define n_addPath
(lambda (row col path)
(cons (cons row col) path)
)
)
(define n_inPath
(lambda (row col path)
(if (null? path)
#f
(if (and (= row (car (car path)))(= col (cdr (car path))))
#t
(n_inPath row col (cdr path))
)
)
)
)
(define n_addUnique
(lambda (x ls)
(if (null? ls)
(list x)
(if (equal? x (car ls))
ls
(cons (car ls)(n_addUnique x (cdr ls)))
)
)
)
)
(define n_mergePath
(lambda (ls1 ls2)
(if (null? ls1)
ls2
(n_mergePath (cdr ls1) (n_addUnique (car ls1) ls2))
)
)
)
(define n_findMin
(lambda (temp ls)
(begin (pp(list "n_findmin temp=" temp "ls=" ls))
(if (null? ls)
temp
(if (< (car (car ls))(car temp))
(n_findMin (car ls)(cdr ls))
(if (= (car temp)(car (car ls)))
(n_findMin (cons (car temp) (n_mergePath (cdr temp)(cdr (car ls)))) (cdr ls))
(n_findMin temp (cdr ls))
)
)
))
)
)
(define n_filterList
(lambda (board color ls)
(if (null? ls)
'()
(if (n_sameColor board color (car (car ls)) (cdr (car ls)))
(n_filterList board color (cdr ls))
(cons (car ls)(n_filterList board color (cdr ls)))
)
)
)
)
; do while loop for each position on board
(define n_shortestPath
(lambda (board color)
(let f ((row 0)(col 0)(length n_infinite)(retList '()))
(if (and (= row board-size)(= col board-size))
(cons length (n_filterList board color retList))
(let ((newList (n_findPath board color row col length retList)))
(if (< col (- board-size 1))
(f row (+ col 1) (car newList)(cdr newList))
(f (+ row 1) 0 (car newList)(cdr newList))
)
)
)
)
)
)
; first search if it starts with a matching color
(define n_findPath
(lambda (board color row col length retList)
(if (n_sameColor board color row col)
(begin
(set! n_currentLength n_infinite) ; initialize
(let ((result (n_doFindPathWrapper board color row col 0 (n_addPath row col '()))))
(if (< (car result) length)
(begin
(set! n_currentLength (car result))
result ;return new
)
(if (= (car result) length)
(cons length (n_mergePath (cdr result) retList)) ; add new
(cons length retList) ; return old
)
)
)
)
(cons length retList);simply return as no matching
)
)
)
(define n_doFindPathWrapper
(lambda (board color row col length path)
(set! n_currentLength n_infinite)
(let ((result1 (n_doFindPath board color row col length path #t))); is upleft
(begin
(set! n_currentLength n_infinite)
(let ((result2 (n_doFindPath board color row col length path #f))); is downright
(cons (+ (car result1)(car result2)) (n_mergePath (cdr result1)(cdr result2)))
)
)
)
)
)
(define n_doFindPath
(lambda (board color row col length path isUpLeft)
(case (n_checkCondition board color row col length path isUpLeft)
((-1) (cons n_infinite '())) ; dead end
((-2) (cons n_infinite '())) ; it is out of board, remove last one
((0) (n_propogate board color row col (+ length 1) (n_addPath row col path) isUpLeft)) ; walk
((1) (cons length (n_addPath row col path))) ; find
((2) (n_propogate board color row col length (n_addPath row col path) isUpLeft)); teleport
)
)
)
(define n_propogate
(lambda (board color row col length path isUpLeft)
(let (
(result0 (n_doFindPath board color row (+ col 1) length path isUpLeft))
(result1 (n_doFindPath board color row (- col 1) length path isUpLeft))
(result2 (n_doFindPath board color (+ row 1) col length path isUpLeft))
(result3 (n_doFindPath board color (- row 1) col length path isUpLeft))
(result4 (n_doFindPath board color (- row 1) (- col 1) length path isUpLeft))
(result5 (n_doFindPath board color (+ row 1) (+ col 1) length path isUpLeft))
(temp (list n_infinite))
)
(n_findMin temp (list result0 result1 result2 result3 result4 result5))
)
)
)
; there are four situations:
; 2 : the same color, which means you can teleport to it without cost
; 1 : found it , the correct border reached
; 0 : not yet, but can go on which means the node is empty
; -1 : dead end, either it is visited before or even longer route than other route
; -2: or out of board
(define n_checkCondition
(lambda (board color row col length path isUpLeft)
(cond
((and color isUpLeft (= row 0)) 1)
((and color (not isUpLeft)(= row (- board-size 1))) 1)
((and (not color) isUpLeft (= col 0)) 1)
((and (not color)(not isUpLeft)(= col (- board-size 1))) 1)
((or (< row 0)(< col 0)(= row board-size)(= col board-size)) -2)
((> length n_currentLength) -1) ; already longer than previous
((n_inPath row col path) -1)
((n_otherColor board color row col) -1)
((n_sameColor board color row col) 2)
(else 0) ; empty
)
)
)
file name: board.scm
; Hex board game definitions & functions
; COMP 472/6721 - Introduction to AI
; Project 2
;
; a hex board is of size NxN
(define board-size 11)
; each hexagon on the board is either empty, marked red, or marked blue
; we represent these as Scheme symbols 'R, 'B, and 'E
(define blue 'B)
(define red 'R)
(define empty 'E)
; a board is a vector of size N of vectors of size N,
; each element in the NxN matrix is initialized to "empty"
; board[0] gives you the top row, and board[0][0] its leftmost column
(define board (do ((board (make-vector board-size))
(i 0 (+ i 1)))
((= i board-size) board)
(vector-set! board i (make-vector board-size empty))))
; play a game until one side wins
(define (play board)
(let loop ((player #t)) ; red starts
(begin (pp (list "loop begins player=" player))
(if (not (move board player))
(loop (not player))))
)
)
;------------------------------------------------
; make a move - implement this in a file hex.scm!
;
; "board" is of size NxN as define above,
; changed by this function to add a move
;
; "player" is boolean, #t for red and #f for blue
;
; <return> value of this function is a boolean,
; #t for win (current player wins),
; #f for no win (game continues)
;
;(define (move board player)
; ...
;)
;------------------------------------------------
file name: displayboard.scm
(load "board.scm") (define dodisplayboard (lambda (ls) (if (not (null? ls)) (begin (pp (vector->list (car ls))) ;(pp "\n") (dodisplayboard (cdr ls)) ) ) ) ) (define displayboard (lambda (v) (dodisplayboard (vector->list v)) ) ) (define judge (lambda (v) (if (or (checkred v) (checkblue v)) #t #f ) ) ) ;(define test1 (vector 'E 'R 'B 'B 'E 'E 'E 'E 'R 'B 'B )) ;(define docheckred ; (lambda (ls countlist) ; ( (define constructfirstrow (lambda (v) (do ( (i 0 (+ i 1)) (ls '() (if (eq? (vector-ref v i) 'R) (cons i ls))) ) (= i board-size) ls ) ) ) (define addnum (lambda (n) (do ( (i 0 (+ i 1)) (result 0 (if (> result (* 2 n)) (set! result 100) (set! result (+ result i)) ) ) ) ((= i n) result) ) ) ) (define checkred (lambda (v) (let ((ls (constructfirstrow (vector-ref v 0)))) (if (null? ls) #f (docheckred (cdr (vector->list v)) ls) ) ) ) ) (define mytest (displayboard board) ) (define redrow 0) (define redcol 0) (define bluerow 1) (define bluecol 0) (define dovectorset (lambda (v c value) (vector-set! v c value) v ) ) (define vectorset (lambda (vv r c value) (vector-set! vv r (dovectorset (vector-ref vv r) c value)) vv ) ) (define vectorget (lambda (vv r c) (vector-ref (vector-ref vv r) c) ) ) (define move (lambda (board player) (begin ;(pp (list "move board player=" player "board=" board)) (if (or (= redcol board-size)(= bluerow board-size)) #t (begin (if player (begin (vectorset board redrow redcol 'B) (set! redcol (+ redcol 1)) ) (begin (vectorset board bluerow bluecol 'R) (set! bluerow (+ bluerow 1)) ) ) (displayboard board) #f ) )) ) )
The result is like following :