Update Jan 10, 2016 Modified the code in three routines as suggested by Roland Chastain.
Update Jan 8, 2016 Slight re-write to allow automatic re-run after 7 seconds, for those who enjoy seeing the recursive backtracker in action repeatedly. Also small alterations in rates of change.
Update: Jan 5, 2016 I added a recursive backtracker maze-solver to the program.
I don't know if you have had the same feeling I've had about recursion -- that it's a bit weird, even un-nerving, to watch a computer process nose around like a living thing -- and one that does not make a mistake either! Of course not all recursive processes have this effect, for example, the standard example of recursion that does factorials is not very thrilling.
But one example illustrates the foray into the strange: the recursive backtracker which many have seen in solving the 8 Queens problem.
The code I'm posting shows another example of the recursive backtracker in action -- it generates mazes by moving forward carving openings (shown by a green dot), then backtracking when it has to (shown with a red dot), then forward again, and so on, until the maze is complete. Have a look.
--Quark
Code: Select all
'=======================================================================
'Maze_Generator04_1.bas by Quark - 2016.01.10
'FreeBASIC Compiler - Ver 1.04.0 (10-01-2015), built for linux-x86_64 (64bit)
'Purpose: Recursive Backtracker maze-generating algorithm
'Added recursive backtracking solver/verifier
'Added automatic re-run and other (small) changes.
'Added improved code suggested by Roland Chastain
'==============================================================================
#LANG "fb"
#INCLUDE "fbgfx.bi"
USING fb
ENUM compass
NORTH = 1
WEST = 2
EAST = 4
SOUTH = 8
VISITED=16
END ENUM
DECLARE SUB RemoveWall(row AS INTEGER, col AS INTEGER, d AS compass)
DECLARE FUNCTION RndRange(lo AS INTEGER,hi AS INTEGER) AS INTEGER
DECLARE SUB DrawGrid(rows AS INTEGER, cols AS INTEGER, clr AS UINTEGER)
DECLARE SUB RecursiveBacktrack(row AS INTEGER, col AS INTEGER)
DECLARE SUB RBSolver(row AS INTEGER, col AS INTEGER)
DECLARE SUB LocateCell(row AS INTEGER, col AS INTEGER, BYREF x AS INTEGER, BYREF y AS INTEGER)
DECLARE SUB Blink(row AS INTEGER, col AS INTEGER, clr AS UINTEGER, switch AS INTEGER = 0)
DECLARE FUNCTION NewCells(row AS INTEGER, col AS INTEGER) AS STRING
DECLARE FUNCTION OpenCells(row AS INTEGER, col AS INTEGER) AS STRING
DECLARE FUNCTION InRowBounds(row AS INTEGER) AS INTEGER
DECLARE FUNCTION InColBounds(row AS INTEGER) AS INTEGER
'=============================================================================
'set up screen
SCREENRES 640,480,32
'==============================================================================
'DEFINES
CONST AS UINTEGER BLACK = RGB(&H00,&H00,&H00), WHITE = RGB(&HFF,&HFF,&HFF)
CONST AS UINTEGER GREEN = RGB(&H60,&HFF,&H60), RED = RGB(&HFF0,&H60,&H60)
CONST AS UINTEGER YELLOW = RGB(&HD0,&HD0,&H00), BLUE = RGB(&H70,&H70,&HF0)
CONST w = 640, h = 480, centx = w\2, centy = h\2, cellsize = 16
CONST numcols = 37, numrows = 27 '999 cells
'CONST numcols = 15, numrows = 11 '165 cells
'CONST numcols = 45, numrows = 31 '1395 cells
DIM SHARED AS INTEGER solved
DIM SHARED AS UBYTE c(1 TO numrows,1 TO numcols)
RANDOMIZE TIMER
COLOR WHITE, BLACK
DO
CLS
ERASE(c)
solved = 0
DrawGrid(numrows,numcols, WHITE)
'RECURSIVE BACKTRACKER MAZE-GENERATING ALGORITHM
'1) Choose a random cell as a starting point.
'2) Choose an adjacent non-visited cell and carve a path to it. This is now
' the current cell.
'3) If all adjacent cells have been visited, return back to the previous cell
' and check for non-visited cells.
'4) Once you are back at your starting cell, the algorithm terminates.
c(1,1) = 1
RemoveWall(1,1,NORTH)
RecursiveBacktrack(1,1) 'start at cell 1,1
PRINT "Maze done!" :SLEEP 2000
LOCATE 1,1 : PRINT "Solving..."
Blink(1,1,BLUE,1)
LOCATE 1,1
RBSolver(1,1) 'start at cell 1,1
SLEEP 7000
LOOP
'==============================================================================
SUB RecursiveBacktrack(row AS INTEGER ,col AS INTEGER)
IF row = numrows AND col = numcols THEN RemoveWall(row,col,SOUTH)
DIM AS STRING curdirect, directions
SLEEP 5
DO
IF LEN(INKEY) THEN END
directions = NewCells(row,col)
IF directions = "" THEN Blink(row, col,RED) : RETURN
curdirect = MID(directions,RndRange(1,LEN(directions)),1)
IF curdirect = "N" THEN
RemoveWall(row,col,NORTH)
c(row,col) OR= NORTH
c(row-1,col) OR= SOUTH
Blink(row-1,col,GREEN)
RecursiveBacktrack(row-1,col)
END IF
IF curdirect = "W" THEN
RemoveWall(row,col,WEST)
c(row,col) OR= WEST
c(row,col-1) OR= EAST
Blink(row,col-1,GREEN)
RecursiveBacktrack(row,col-1)
END IF
IF curdirect = "E" THEN
RemoveWall(row,col,EAST)
c(row,col) OR= EAST
c(row,col+1) OR= WEST
Blink(row,col+1,GREEN)
RecursiveBacktrack(row,col+1)
END IF
IF curdirect = "S" THEN
RemoveWall(row,col,SOUTH)
c(row,col) OR= SOUTH
c(row+1,col) OR= NORTH
Blink(row+1,col,GREEN)
RecursiveBacktrack(row+1,col)
END IF
LOOP
RETURN
END SUB
'==============================================================================
SUB RBSolver(row AS INTEGER, col AS INTEGER)
IF row = numrows AND col = numcols THEN
PRINT "Maze solved"
Blink(row,col,BLUE,1)
Blink(1,1,BLUE,1)
solved = -1
END IF
IF solved THEN RETURN
DIM AS STRING curdirect, directions
SLEEP 15
DO
IF LEN(INKEY) THEN END
directions = OpenCells(row,col)
IF directions = "" THEN Blink(row,col,BLACK,1) : SLEEP 30 : RETURN
curdirect = MID(directions,RndRange(1,LEN(directions)),1)
IF curdirect = "N" THEN
c(row-1,col) OR= VISITED
Blink(row-1,col,BLUE,1)
RBSolver(row-1,col)
END IF
IF solved THEN RETURN
IF curdirect = "W" THEN
c(row,col-1) OR= VISITED
Blink(row,col-1,BLUE,1)
RBSolver(row,col-1)
END IF
IF solved THEN RETURN
IF curdirect = "E" THEN
c(row,col+1) OR= VISITED
Blink(row,col+1,BLUE,1)
RBSolver(row,col+1)
END IF
IF solved THEN RETURN
IF curdirect = "S" THEN
c(row+1,col) OR= VISITED
Blink(row+1,col,BLUE,1)
RBSolver(row+1,col)
END IF
IF solved THEN RETURN
LOOP
RETURN
END SUB
'==============================================================================
FUNCTION NewCells(row AS INTEGER, col AS INTEGER) AS STRING
DIM AS STRING s
IF InRowbounds(row-1) ANDALSO c(row-1,col) = 0 THEN s &= "N"
IF InRowbounds(row+1) ANDALSO c(row+1,col) = 0 THEN s &= "S"
IF InColBounds(col-1) ANDALSO c(row,col-1) = 0 THEN s &= "W"
IF InColBounds(col+1) ANDALSO c(row,col+1) = 0 THEN s &= "E"
RETURN s
END FUNCTION
'==============================================================================
FUNCTION OpenCells(row AS INTEGER, col AS INTEGER) AS STRING
DIM AS INTEGER m0,m1,m2
DIM AS STRING s
IF InRowbounds(row+1) THEN
m0 = c(row+1,col) AND VISITED
IF m0 <> VISITED THEN
m1 = c(row,col) AND SOUTH : m2 = c(row+1,col) AND NORTH
IF m1 = SOUTH AND m2 = NORTH THEN s &= "S"
END IF
END IF
IF InColBounds(col-1) THEN
m0 = c(row,col-1) AND VISITED
IF m0 <> VISITED THEN
m1 = c(row,col) AND WEST : m2 = c(row,col-1) AND EAST
IF m1 = WEST AND m2 = EAST THEN s &= "W"
END IF
END IF
IF InRowbounds(row-1) THEN
m0 = c(row-1,col) AND VISITED
IF m0 <> VISITED THEN
m1 = c(row,col) AND NORTH : m2 = c(row-1,col) AND SOUTH
IF m1 = NORTH AND m2 = SOUTH THEN s &= "N"
END IF
END IF
IF InColBounds(col+1) THEN
m0 = c(row,col+1) AND VISITED
IF m0 <> VISITED THEN
m1 = c(row,col) AND EAST : m2 = c(row,col+1) AND WEST
IF m1 = EAST AND m2 = WEST THEN s &= "E"
END IF
END IF
RETURN s
END FUNCTION
'==============================================================================
SUB LocateCell(row AS INTEGER, col AS INTEGER, BYREF x AS INTEGER, BYREF y AS INTEGER)
DIM AS INTEGER offx = (w-(cellsize*numcols))\2, offy = (h-(cellsize*numrows))\2
x = offx + cellsize * (col-1)
y = offy + cellsize * (row-1)
END SUB
'==============================================================================
SUB RemoveWall(row AS INTEGER, col AS INTEGER, d AS compass)
DIM AS INTEGER x,y
LocateCell(row,col,x,y)
IF d = NORTH THEN
LINE(x,y)-(x+cellsize-1,y),BLACK
ELSEIF d = SOUTH THEN
LINE(x,y+cellsize)-(x+cellsize,y+cellsize),BLACK
ELSEIF d = WEST THEN
LINE(x,y+1)-(x,y+cellsize-1),BLACK
ELSEIF d = EAST THEN
LINE(x+cellsize,y+1)-(x+cellsize,y+cellsize-1),BLACK
END IF
END SUB
'==============================================================================
SUB Blink(row AS INTEGER, col AS INTEGER, clr AS UINTEGER, switch AS INTEGER = 0)
DIM AS INTEGER x, y
LocateCell(row,col,x,y)
x += cellsize\2 : y += cellsize\2
CIRCLE(x,y),3,clr,,,,F
IF switch = 0 THEN
SLEEP 25
CIRCLE(x,y),3,BLACK,,,,F
END IF
END SUB
'==============================================================================
FUNCTION InRowBounds(row AS INTEGER) AS INTEGER
IF row >= 1 AND row <= numrows THEN RETURN -1
RETURN 0
END FUNCTION
'==============================================================================
FUNCTION InColBounds(col AS INTEGER) AS INTEGER
RETURN col >= 1 AND col <= numcols
END FUNCTION
'==============================================================================
SUB DrawGrid(rows AS INTEGER, cols AS INTEGER, clr AS UINTEGER)
DIM AS INTEGER offx = (w-(cellsize*numcols))\2, offy = (h-(cellsize*numrows))\2
FOR row AS INTEGER = 1 TO rows + 1
LINE(offx,offy + cellsize*(row-1))-(offx + cellsize*cols,offy + cellsize*(row-1)),GREEN
NEXT
FOR col AS INTEGER = 1 TO cols + 1
LINE(offx + cellsize*(col-1),offy)-(offx + cellsize*(col-1),offy + cellsize*rows),GREEN
NEXT
END SUB
'==============================================================================
FUNCTION RndRange(lo AS INTEGER,hi AS INTEGER) AS INTEGER
'E.g. lo of 5, hi of 10 returns a num in range: 5, 6, 7, 8, 9, 10
RETURN INT(RND * (hi-lo+1) +lo)
END FUNCTION
'==============================================================================
