shortest path BFS

         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. 
Alright, here we go to walk the path!
B.The problem

The Game: Hex

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

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).

C.The idea of program
　

This is probably the most complicated function I have ever written in Scheme.

D.The major functions
　
E.Further improvement
Bugs are inevitable and I will update new versions asap.
　
F.File listing
1. shortestpath.scm
2. board.scm (given by professor)
3. displayboard.scm (by Alejandro)
　
file name: shortestpath.scm
(load "board.scm")
(load "displayboard.scm")
(define n_infinite 1000)
;(define n_currentLength n_infinite)

(define n_row0	(vector 'E 'E 'E 'E 'B 'B 'E 'E 'E 'E 'E))
(define n_row1	(vector 'E 'E 'E 'E 'E 'E 'R '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 'R '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 'R 'E 'E 'E 'E 'E))
(define n_row10	(vector 'E 'E 'E 'E 'E 'E 'E 'E 'E 'E 'E))

(define n_board	(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_myboard (make-vector board-size))

(define n_dodisplayboard
	(lambda (ls)		
		(if (not (null? ls))
			(begin 
				(pp (vector->list (car ls)))
				;(pp "\n")
				(n_dodisplayboard (cdr ls))
			)
		)
	)
)
	

(define n_displayboard
	(lambda (v)
		(n_dodisplayboard (vector->list v))
	)
)

;(define n_vectorset
;	(lambda (vv r c value)
;		(vector-set! (eval 'quote(vector-ref vv r)) c value)
;	)
;)		
	
(define dovectorset
	(lambda (v c value)
		(vector-set! v c value)
		v
	)
)

(define n_doListGet
	(lambda (ls index)
		(if (= index 0)
			(car ls)
			(n_doListGet (cdr ls)(- index 1))
		)
	)
)

(define n_doVectorGet
	(lambda (v index)
		(n_doListGet (vector->list v) index)
	)
)

(define n_vectorget
	(lambda (vv r c)
		(n_doVectorGet (n_doVectorGet  vv r) c)
	)
)

(define n_doListSet
	(lambda (ls index value)
		(if (= index 0)
			(cons value (cdr ls))
			(cons (car ls)(n_doListSet (cdr ls)(- index 1) value))
		)
	)
)

(define n_doVectorSet
	(lambda (v index value)
		(list->vector (n_doListSet (vector->list v) index value))
	)
)


(define n_vectorset
	(lambda (vv r c value)
		(n_doVectorSet vv r (n_doVectorSet (n_doVectorGet vv r) c value))
	)
)

(define n_doVectorCopy
	(lambda (v)
		(list->vector (n_doListCopy (vector->list v)))
	)
)

(define n_doListCopy
	(lambda (ls)
		(if (null? ls)
			'()
			(cons (car ls)(n_doListCopy (cdr ls)))
		)
	)
)

(define n_vectorCopyHelper
	(lambda (ls)
		(if (null? ls)
			'()
			(cons (n_doVectorCopy (car ls)) (n_vectorCopyHelper (cdr ls)))
		)
	)
)

(define n_vectorCopy
	(lambda (vv)
		(list->vector (n_vectorCopyHelper (vector->list vv)))
	)
)	 


;(define n_vectorget
;	(lambda (vv r c)
;		(vector-ref (vector-ref vv r) c)
;	)
;)

;(define n_vectorset
;	(lambda (vv r c value)
;		(vector-set! (vector-ref vv r) c value)
;	)
;)


(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_emptyColor
	(lambda (board color row col)
		(eq? (n_vectorget board row col) 'E)
	)
)

(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)))
				
			)
		)		
	)
)

;(define n_doVectorCopy
;	(lambda (ls)
;		(if (null? ls)
;			'()
;			(cons (car ls)(n_doVectorCopy (cdr ls)))
;		)
;	)
;)


;(define n_vectorCopy
;	(lambda (vv)
;		(list->vector (n_doVectorCopy (vector->list vv)))
;	)
;)

;*****************************ALEX'S EDIT
;(define n_vectorCopy
;	(lambda (vv)
;		(define ls (eval (list 'quote (vector->list vv))))
;		(list->vector m)	
;	)
;)

(define n_inBoard
	(lambda (row col)
		(and (>= row 0)(>= col 0)(< row board-size)(< col board-size))
	)
)

(define n_doPaintPath
	(lambda (path myboard)
		(if (not (null? path))
			(let ((row (car (car path)))(col (cdr (car path))))
				(n_doPaintPath (cdr path) (n_vectorset myboard row col '*))
			)
			myboard
		)
	)
)

(define n_paintPath
	(lambda (path)
		(n_doPaintPath (cdr path) n_board)
	)
)
	
(define n_testElement
	(lambda (x ls)
		(if (null? ls)
			#f
			(if (equal? x (car ls))
				#t
				(n_testElement x (cdr ls))
			)
		)
	)
)

(define n_testList
	(lambda (ls1 ls2)
		(if (null? ls1)
			'()
			(if (n_testElement (car ls1) ls2)
				(cons (car ls1) (n_testList (cdr ls1) ls2))
				(n_testList (cdr ls1) ls2)
			)
		)
	)
)

(define n_unionPath
	(lambda (ls1 ls2)
		(let ((result (n_testList ls1 ls2)))
			(if (null? result)
				(append ls1 ls2)
				result
			)
		)
	)
)	
				
(define n_hasSameColorNeighbour
	(lambda (board color row col)
		(let f ((path (n_allNeighbours row col)))
			(if (null? path)
				#f
				(if (n_sameColor board color (car (car path))(cdr (car path)))
					#t
					(f (cdr path))
				)
			)
		)
	)
)
		


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;       above this line are all general utility functions                                 ;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; first we need to search entire board and pinpoint the group of color
;; then we compare among groups to find the shortest path
;; the following are big board search and comparison
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; this is the entry point
; do while loop for each position on board
; scan all position and generate shortest path for each position
; compare and take the shortest
(define n_ShortestPath
	(lambda (board color)
		(let f ((row 0)(col 0)(length n_infinite)(retList '()))
			(if (= row 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
; two situations:
; if same color, begin searching for shortest, and MUST copy board for parameter
; if other color or empty, just return
(define n_findPath
	(lambda (board color row col length retList)
		(if (n_sameColor board color row col)
			(begin				
				(let ((result (n_doFindPath board color 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
		)
	)
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; the following is detail how to find one shortest path for one particular
;;; starting point, provided it is same color. for one group of nodes, we 
;;; might waste time for repeating, but I don't see any better way
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; it searches in a series of circles which have row col as center and 
;; radius is distance which increases one by each time
;; it returns by calling n_findShortestWrapper which will retrieve information
;; from myboard and generate path list
(define n_doFindPath 
	(lambda (board color row col)
		(set! n_myboard (n_vectorCopy board)) ;(n_vectorCopy board))
		(let f ((distance 0))   ;(myboard n_myboard))			
			(let ((path (n_generateList row col distance)))
				(if (null? path)
					; this is the return which means you need to generate the path from charted board
					(n_findShortestWrapper board color row col n_myboard) ;;debugging
					;n_myboard ;;debugging
					(begin
						(if (= distance 0)
							(set! n_myboard (n_vectorset n_myboard row col 0))
							(n_updateBoard board color path)											
						)
						;(pp (list "n_doFindPath board=" board "myboard=" n_myboard))
						(f (+ distance 1))
					)
				)				
			)
		)	
	)
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; first job is to generate the charted board by searching its neighbour and retrieve the
;; smallest distance, if current node is same color, teleport; if current is empty color,
;; walk by plus one; if current node is other color, ignore
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define n_updateBoard 
	(lambda (board color path)
		(begin ;(pp(list "n_updateBoard board=" board "myboard=" myboard))
		(if (not (null? path))			
			(let ((row (car (car path)))(col (cdr (car path))))	
				(if (n_sameColor board color row col) 
					(set! n_myboard (n_vectorset n_myboard row col (n_shortestNeighbour n_myboard row col )))
				)
				(if (n_emptyColor board color row col)
					(set! n_myboard (n_vectorset n_myboard row col (+ 1 (n_shortestNeighbour n_myboard row col))))
				)		
				(if (not (n_otherColor board color row col))				
					; it is possible you need to update your neighbour
					(n_updateNeighbour board color row col)						
					
				)				
				(n_updateBoard board color (cdr path))
			)
		))
	)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; self-explained: other-color nodes returns infinite
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define n_shortestNeighbour
	(lambda (myboard row col)
		(let f ((path (n_allNeighbours row col))(result n_infinite))
			(if (null? path)
				result
				(begin
					(set! result (min result (n_getNeighbourValue n_myboard (car (car path))(cdr (car path)))))
					(f (cdr path) result)
				)
			)	
		)
	)
)
	
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; the reason for updating neighbour is exactly like Dijkstra algorithms
;; you might need to adjust old value when you discover new value
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define n_updateNeighbour
	(lambda (board color row col)
		(let f ((ls (n_allNeighbours row col))(value (n_vectorget n_myboard row col)))
			(if (not (null? ls))
				(begin
					(let ((r (car (car ls)))(c (cdr (car ls))))
						; the fist case is the same color different value
						(if (and (n_sameColor board color row col)(n_sameColor board color r c)
							(integer? (n_vectorget n_myboard r c))(> (n_vectorget n_myboard r c) value))
								(set! n_myboard (n_vectorset n_myboard r c value))
						)
						; the second case is that no neighbour can be bigger more than 1
						(if (and (not (n_otherColor board color r c)) (integer? (n_vectorget n_myboard r c))
								(> (n_vectorget n_myboard r c)(+ value 1)))
							(set! n_myboard (n_vectorset n_myboard r c (+ value 1)))
						)
						(f (cdr ls) value)
					)
				)
			)
		)
	)
)
				

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; this is the second big job, that is, after you created the charted board, how do you
;; generate shortest path from this board? 
;; first you find the sets of smallest distance at both borders (up-down for red, left-right
;; for blue) , then you backtrack path starting from these nodes.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; n_findshortest only retrieves set of positions of smallest distance
; at border, it passes this list as starting point for n_doFindShortest
(define n_findShortestWrapper
	(lambda (board color row col myboard)
		(let ((path (n_findShortest board color row col myboard)))
			(let f ((ls (cdr path))(length (car path))(result '()))
				(if (null? ls)
					(cons length result)
					(begin
						(set! result (n_doFindShortest board color myboard result (car (car ls))(cdr (car ls)) ) )
						(f (cdr ls) length result)
					)
				)
			)
		)
	)
)



; collect all smallest length from border
; this is a function to retrieve shortest path from charted board----myboard
; which has been full of distance from started "row col".
; it searches all TWO borders to find the "set" of positions of smallest distances
; 			
(define n_findShortest 
	(lambda (board color row col myboard)
		(let f ((firstrow 0)(firstcol 0)(secondrow (- board-size 1))(secondcol (- board-size 1))
				(firstresult '())(secondresult '())(firstlength n_infinite)(secondlength n_infinite))
			(if (or (and color (= firstcol board-size)) (and (not color)(= firstrow board-size)))
				(cons (+ firstlength secondlength)(n_mergePath firstresult secondresult))
				;;else 
				(begin ;(pp (list "n_findShortest firstrow=" firstrow "firstcol=" firstcol "firstlength=" firstlength))
				(let ((result0 (n_getNeighbourValue myboard firstrow firstcol))
						(result1 (n_getNeighbourValue myboard secondrow secondcol)))
					(if (< result0 firstlength)
						(begin
							(set! firstresult (list (cons firstrow firstcol)))
							(set! firstlength result0)
						)
						(if (= result0 firstlength)
							(set! firstresult (n_addPath firstrow firstcol firstresult))
						)
					)
					(if (< result1 secondlength)
						(begin
							(set! secondresult (list (cons secondrow secondcol)))
							(set! secondlength result1)
						)
						(if (= result1 secondlength)
							(set! secondresult (n_addPath secondrow secondcol secondresult))
						)
					)
					(if color
						(f firstrow (+ firstcol 1) secondrow (- secondcol 1) firstresult secondresult firstlength secondlength)
						(f (+ firstrow 1) firstcol (- secondrow 1) secondcol firstresult secondresult firstlength secondlength)
					)
				))
			)
		
		)
	)
)

;; recursively add neighbour nodes into path by either of two conditions:
;; 1. neighbour with same distance
;; 2. neighbour with distance of exact less one provided either neighbour or the node itself is
;;		the color it is searching for
;;  and it returns the path
(define n_doFindShortest
	(lambda (board color myboard oldPath row col)	
		(begin ;(pp(list "n_doFindShortest oldpath=" oldPath ))
		(let f ((ls (n_allNeighbours row col))(path (n_addPath row col oldPath)))
			(if (not (null? ls))
				(let ((r (car (car ls)))(c (cdr (car ls))))
					(if (and (not (n_inPath r c path)) (integer? (n_vectorget myboard r c))
							(or (and (or (n_sameColor board color r c)(n_sameColor board color row col))
								(= (n_vectorget myboard row col)(n_vectorget myboard r c)))
							(= (- (n_vectorget myboard row col) 1)(n_vectorget myboard r c))))
						(set! path (n_doFindShortest board color myboard path r c))						
					)
					(f (cdr ls) path)
				)
				; if no more neighbour can be generated
				path
			)
		))					
	)
) 


;;clockwise counting
(define n_checkAndAddPath 
	(lambda (row col distance count result)
		(if (n_inBoard (+ row distance) (- col count))
			(set! result (n_addPath (+ row distance) (- col count) result))
		)
		(if (n_inBoard (- row distance)(+ col count))
			(set! result (n_addPath (- row distance)(+ col count) result))
		)
		(if (n_inBoard (- (+ row distance) count)(- col distance))
			(set! result (n_addPath (- (+ row distance) count) (- col distance) result))
		)
		(if (n_inBoard (+ (- row distance) count) (+ col distance))
			(set! result (n_addPath (+ (- row distance) count) (+ col distance) result))
		)
		(if (n_inBoard (+ row count) (- (+ col distance) count))
			(set! result (n_addPath (+ row count) (- (+ col distance) count) result))
		)
		(if (n_inBoard (- row count) (+ (- col distance) count))
			(set! result (n_addPath (- row count) (+ (- col distance) count) result))
		)
		result
	)
)


(define n_generateList
	(lambda (row col distance)
		(if (= distance 0)
			(list (cons row col))
			(let f ((count 0)(result '()))
				(if (= count distance)
					result
					(begin
						(set! result (n_checkAndAddPath row col distance count result))
						(f (+ count 1) result)
					)
				)
			)
		)
	)
)

(define n_getNeighbourValue
	(lambda (myboard row col)
		(if (n_inBoard row col)
			(let ((result (n_vectorget myboard row col)))
				(if (integer? result)
					result
					n_infinite
				)
			)
			n_infinite
		)
	)
)

(define n_allNeighbours
	(lambda (row col)
		(n_generateList row col 1)
	)
)

;(define n_allNeighbours
;	(lambda (row col)
;		(let ((result '()))
;			(if (n_inBoard row (+ col 1))
;				(set! result (n_addPath row (+ col 1) result))
;			)
;			(if (n_inBoard row (- col 1))
;				(set! result (n_addPath row (- col 1) result))
;			)
;			(if (n_inBoard (+ row 1) col)
;				(set! result (n_addPath (+ row 1) col result))
;			)
;			(if (n_inBoard (- row 1) col)
;				(set! result (n_addPath (- row 1) col result))
;			)
;
;			(if (n_inBoard (- row 1) (+ col 1))
;				(set! result (n_addPath (- row 1) (+ col 1) result))
;			)
;
;			(if (n_inBoard (+ row 1) (- col 1))
;				(set! result (n_addPath (+ row 1) (- col 1) result))
;			)
;			result
;		)
;	)
;)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; The following is another major function of how to choose branching factors
;; after union of shortest path from both color, we give priority to those points of
;; overlapped ones. And after that, we choose those who can connect the same color points
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define n_doChooseBranching
	(lambda (board color ls)
		(if (null? ls)
			'()
			(let ((row (car (car ls)))(col (cdr (car ls))))
				(if (n_hasSameColorNeighbour board color row col)
					(cons (car ls)(n_doChooseBranching board color (cdr ls)))
					(n_doChooseBranching board color (cdr ls))
				)
			)
		)
	)
)

(define n_ChooseBranching
	(lambda (board color)
		(n_doChooseBranching board color (n_unionPath (cdr (n_ShortestPath board #t))(cdr (n_ShortestPath board #f))))
	)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;  This is the major function of Heuristic
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define n_Heuristic
	(lambda (board)
		(- (car (n_ShortestPath board #f)) (car (n_ShortestPath board #t)))
	)
)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; function to decide if there is a winner
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define n_Judge
	(lambda (board color)
		(= (car (n_ShortestPath board color)) 0)
	)
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; legacy of codes, maybe it is useful in distant future
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(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
			
	

;Author: Alejandro Endo
;Date: 22 November 2005
;Parameters:
;<brd> board
;<row> It has to be 0
;It may not work with certain fonts since the arrangement depends on that. It looks fine in Dr Scheme and in my version of SSH which i use to telnet to concordia
(load "board.scm")

(define (a_BoardDisplay brd) 
  (display "  /")
  (a_displayBoard brd 0)
  (display #\newline)
  ) ;just a wrapper

(define (a_displayBoard brd row)
  (if (>= row (vector-length brd)) (a_displayTop (vector-ref brd 0) 1 0) ;last
      (begin
	;(a_addSpaces row)
        (a_displayTop (vector-ref brd row) row 0)
        (display #\newline)
        
        (a_addSpaces (+ (+ row row) 1))
        
        (a_displayMiddle (vector-ref brd row) row 0)
        (display #\newline)
        (a_addSpaces (+ (+ row row) 1))
        ;(display " ")
        
        (a_displayBoard brd (+ row 1))
        )
      )
  )


(define (a_displayTop vec row pos)
  ;(if (and (eq? (vector-length vec) pos) (eq? (modulo row 2) 0)) (display"/"))

        (if (eq? (vector-length vec) pos) (display" \\"))
  (if (and (eq? row 0) (eq? pos 0)) (set! pos 1))
  (if (< pos (vector-length vec))
            (begin 
              ;(if (and (eq? (modulo row 2) 1) (eq? pos 0)) (display " \\"))
              
              (display " \\ /")
              (a_displayTop vec row (+ pos 1))
              
              )
            
            )
        
      
  )


(define (a_displayMiddle vec row pos)
  (if (eq? (vector-length vec) pos) (display "|"))
  (if (< pos (vector-length vec)) 
      (begin 
        ;(if (eq? (modulo row 2) 1) (display " "))
        (display "| ")
        (display (vector-ref vec pos))
        (display " ")
        (a_displayMiddle vec 0 (+ pos 1))
        )
      )
  )
(define (a_addSpaces num)
  (if (> num 0) 
      (begin
        (display " ")
        (a_addSpaces (- num 1))
        )
      )
  )



				

		








The result is like following :



Gambit Version 4.0 beta 9

> (load "shortestpath.scm")
"D:\\Program Files\\gambit\\Gambit-C\\bin\\shortestpath.scm"
> (n_ShortestPath n_board #t)
(8
 (0 . 6)
 (0 . 7)
 (10 . 5)
 (2 . 5)
 (3 . 5)
 (4 . 5)
 (5 . 5)
 (2 . 6)
 (3 . 6)
 (4 . 6)
 (5 . 6)
 (7 . 5)
 (8 . 5)
 (10 . 4))
> (a_BoardDisplay n_myboard)
  / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \
 | 13 | 12 | 11 | 10 | B | B | 7 | 7 | 8 | 8 | 8 |
  \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \
   | 12 | 11 | 10 | 9 | 8 | 7 | 6 | 7 | 7 | 7 | 7 |
    \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \
     | 11 | 10 | 9 | 8 | 7 | 6 | 6 | 6 | 6 | 6 | 7 |
      \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \
       | 10 | 9 | 8 | 7 | 6 | 5 | 5 | 5 | 5 | 6 | 6 |
        \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \
         | 9 | 8 | 7 | 6 | 5 | 4 | 4 | 4 | 5 | 5 | 5 |
          \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \
           | 8 | 7 | 6 | 5 | 4 | 3 | 3 | 4 | 4 | 4 | 5 |
            \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \
             | 7 | 6 | 5 | 4 | 3 | 2 | 3 | 3 | 3 | 4 | 5 |
              \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \
               | 7 | 6 | 5 | 4 | 3 | 2 | 2 | 2 | 3 | 4 | 5 |
                \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \
                 | 6 | 5 | 4 | 3 | 2 | 1 | 1 | 2 | 3 | 4 | 5 |
                  \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \
                   | 5 | 4 | 3 | 2 | 1 | 0 | 1 | 2 | 3 | 4 | 5 |
                    \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \
                     | 5 | 4 | 3 | 2 | 1 | 1 | 2 | 3 | 4 | 5 | 6 |
                      \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \
> (a_BoardDisplay n_board)
  / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \
 | E | E | E | E | B | B | E | E | E | E | E |
  \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \
   | E | E | E | E | E | E | R | E | E | E | E |
    \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \
     | E | E | E | E | E | E | E | E | E | E | E |
      \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \
       | E | E | E | E | E | E | E | E | E | E | E |
        \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \
         | E | E | E | E | E | E | E | E | E | E | E |
          \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \
           | E | E | E | E | E | E | E | E | E | E | E |
            \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \
             | E | E | E | E | E | R | E | E | E | E | E |
              \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \
               | E | E | E | E | E | E | E | E | E | E | E |
                \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \
                 | E | E | E | E | E | E | E | E | E | E | E |
                  \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \
                   | E | E | E | E | E | R | E | E | E | E | E |
                    \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \
                     | E | E | E | E | E | E | E | E | E | E | E |
                      \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \
> (a_BoardDisplay (n_paintPath (n_ShortestPath n_board #t)))
  / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \
 | E | E | E | E | B | B | * | * | E | E | E |
  \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \
   | E | E | E | E | E | E | R | E | E | E | E |
    \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \
     | E | E | E | E | E | * | * | E | E | E | E |
      \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \
       | E | E | E | E | E | * | * | E | E | E | E |
        \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \
         | E | E | E | E | E | * | * | E | E | E | E |
          \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \
           | E | E | E | E | E | * | * | E | E | E | E |
            \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \
             | E | E | E | E | E | R | E | E | E | E | E |
              \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \
               | E | E | E | E | E | * | E | E | E | E | E |
                \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \
                 | E | E | E | E | E | * | E | E | E | E | E |
                  \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \
                   | E | E | E | E | E | R | E | E | E | E | E |
                    \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \
                     | E | E | E | E | * | * | E | E | E | E | E |
                      \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \ / \
>



　



			



				 back.gif (341 bytes)       up.gif (335 bytes)         next.gif (337 bytes)