Liberty BASIC Community Forum
« backtraking tutorial »

Welcome Guest. Please Login or Register.
Feb 18th, 2018, 3:46pm


Rules|Home|Help|Search|Recent Posts|Notification


« Previous Topic | Next Topic »
Pages: 1 2  Notify Send Topic Print
 hotthread  Author  Topic: backtraking tutorial  (Read 307 times)
bluatigro
Guru
ImageImageImageImageImage


member is offline

Avatar

cxiu diversas el tio respondas cxiu samvaloras [ thats esperanto for : we are al different therefore we are al equal ]


PM

Gender: Male
Posts: 961
xx backtraking tutorial
« Thread started on: Jan 18th, 2018, 06:38am »

i m trying to learn this myself to
so it has error's

see for c++ :
https://www.geeksforgeeks.org/backtracking-algorithms/


Code:
'' bluatigro 18 jan 2018
'' bactracing 1
'' knights tour
'' see for c++ code :
'' https://www.geeksforgeeks.org/backtracking-algorithms/

global size,false,true
true = not( false )
size = 7
dim p(size,size),x(7),y(7)

for i = 0 to size
  for j = 0 to size
    p(i,j) = -1
  next j
next i
for i = 0 to 7
  read a
  x(i) = a
next i
data -2,-1,1,2,2,1,-1,-2
for i = 0 to 7
  read b
  y(i) = b
next i
data -1,-2,-2,-1,1,2,2,1

call backtraking

end
sub backtraking
  p(0,0) = 0
  '' Start from 0,0 and explore all tours
  if solve( 0 , 0 , 1 ) then
    for i = 0 to size
      for j = 0 to size
        print right$( "    " ; p(i,j) , 4 ) ;
      next j
      print
    next i
  else
    print "Solution does not exist"
  end if
end sub
function solve( x , y , i )
  if i = size * size then solveb = 1
  for k = 0 to 7
    nx = x + x(k)
    ny = y + y(k)
    if issafe(nx,ny) then
      p(nx,ny) = i
      if solve(nx,ny,i+1) then
        solveb = true
      else
        p(nx,ny) = -1
      end if
    end if
  next k
  solveb = false
end function
function issafe( x , y )
  uit = true
  if x < 0 then uit = false
  if x > size then uit = false
  if y < 0 then uit = false
  if y > size then uit = false
  if p(x,y)<>-1 then uit = false
  issafe = uit
end function



 
User IP Logged

basic's : C64 Simons C128 Amiga Amos quick4.5 Visual5 Visual6 Visual2005 Visual2008 just and last but not least liberty
bluatigro
Guru
ImageImageImageImageImage


member is offline

Avatar

cxiu diversas el tio respondas cxiu samvaloras [ thats esperanto for : we are al different therefore we are al equal ]


PM

Gender: Male
Posts: 961
xx Re: backtraking tutorial
« Reply #1 on: Jan 22nd, 2018, 03:58am »

try at maze solving whit backtracking

Code:
'' bluatigro 22 jan 2017
'' backtracking 2
'' maze solving
'' see for c++ :
'' https://www.geeksforgeeks.org/backtracking-algorithms/


global size
size = 3
dim maze(3,3),sol(3,3)
for y = 0 to size
  for x = 0 to size
    read a
    maze(x,y) = a
    sol(x,y) = 0
  next x
next y
''   maze
data 0,1,1,1
data 0,0,0,0
data 1,0,1,1
data 0,0,0,0
print "[ maze ]"
for y = 0 to size
  for x = 0 to size
    print maze(x,y) ;
  next x
  print
next y
if solve(0,0) = 0 then
  print "[ no solution ]"
else
  print "[ solution ]"
  for y = 0 to size
    for x = 0 to size
      print sol(x,y) ;
    next x
    print
  next y
end if
end
function solve( x , y )
  if x = size and y = size then
    sol(x,y) = 1
    solve = 1
  end if
  if safe( x , y ) then
    sol(x,y) = 1
    if solve( x + 1 , y ) then
      sovle = 1
    end if
    if solve( x - 1 , y ) then
      solve = 1
    end if
    if solve( x , y + 1 ) then
      solve = 1
    end if
    if solve( x , y - 1 ) then
      solve = 1
    end if
    solve = 0
  end if
  solve = 0
end function
function safe( x , y )
  uit = 1
  if x < 0 then uit = 0
  if x > size then uit = 0
  if y < 0 then uit = 0
  if y > size then uit = 0
  if maze(x,y) = 1 then uit = 0
  if sol(x,y) = 1 then uit = 0
  safe = uit
end function

 
User IP Logged

basic's : C64 Simons C128 Amiga Amos quick4.5 Visual5 Visual6 Visual2005 Visual2008 just and last but not least liberty
bluatigro
Guru
ImageImageImageImageImage


member is offline

Avatar

cxiu diversas el tio respondas cxiu samvaloras [ thats esperanto for : we are al different therefore we are al equal ]


PM

Gender: Male
Posts: 961
xx Re: backtraking tutorial
« Reply #2 on: Jan 22nd, 2018, 04:57am »

sudoku solver try
Code:
'' bluatigro 22 jan 2017
'' backtracking 3
'' sudoku solver
'' see for c++ :
'' https://www.geeksforgeeks.org/backtracking-algorithms/

dim p(8,8)
global empty
for y = 0 to 8
  for x = 0 to 8
    read a
    p(x,y) = a
  next x
next y
data 3, 0, 6, 5, 0, 8, 4, 0, 0
data 5, 2, 0, 0, 0, 0, 0, 0, 0
data 0, 8, 7, 0, 0, 0, 0, 3, 1
data 0, 0, 3, 0, 1, 0, 0, 8, 0
data 9, 0, 0, 8, 6, 3, 0, 0, 5
data 0, 5, 0, 0, 9, 0, 6, 0, 0
data 1, 3, 0, 0, 0, 0, 2, 5, 0
data 0, 0, 0, 0, 0, 0, 0, 7, 4
data 0, 0, 5, 2, 0, 6, 3, 0, 0
print "[ sudoku puzel ]"
for x = 0 to 8
  for y = 0 to 8
    print p(y,x) ;
  next y
  print
next x
if solve() then
  print "[ solution ]"
  for x = 0 to 8
    for y = 0 to 8
      print p(y,x) ;
    next y
    print
  next x
else
  print "[ no solution ]"
end if
end
function findempty()
  uit = 0
  for i = 0 to 8
    for j = 0 to 8
      if p(i,j)=empty then uit = 1
    next j
  next i
  findempty = uit
end function
function inrow( row , mun )
  uit = 0
  for i = 0 to 8
    if p(i,row) = num then uit = 1
  next i
  inrow = uit
end function
function incol( col , num )
  uit = 0
  for i = 0 to 8
    if p(col,i) = num then uit = 1
  next i
  incol = uit
end function
function inbox( x , y , num )
  uit = 0
  for i = x to x + 2
    for j = y to y + 2
      if p(i,j) = mun then uit = 1
    next j
  next i
  inbox = uit
end function
function safe( x , y , num )
  uit = 1
  if inrow( x , num ) then uit = 0
  if incol( y , num ) then uit = 0
  if inbox( x - x mod 3 , y - y mod 3 , num ) then uit = 0
  safe = uit
end function
function solve()
  if not( findempty() ) then solve = 1
  for num = 1 to 9
    if safe( x , y , num ) then
      p(x,y) = mun
      if solve() then solve = 1
      p(x,y) = 0
    end if
  next num
  solve = 0
end function
 
User IP Logged

basic's : C64 Simons C128 Amiga Amos quick4.5 Visual5 Visual6 Visual2005 Visual2008 just and last but not least liberty
tsh73
Board Moderator

member is online

Avatar

Anatoly (real name)


PM

Gender: Male
Posts: 1745
xx Re: backtraking tutorial
« Reply #3 on: Jan 22nd, 2018, 06:57am »

at maze solving :
1) it errors with out-of-bounds.
You can fix "safe" function as
Code:
function safe( x , y )
  uit = 1
  if x < 0 then uit = 0
  if x > size then uit = 0
  if y < 0 then uit = 0
  if y > size then uit = 0
  if uit = 0 then safe = uit: exit function  'cut if out of array
  if maze(x,y) = 1 then uit = 0
  if sol(x,y) = 1 then uit = 0
  safe = uit
end function
 

2) where is exactly "backtracking"?
Linked example (example#2, rat in a mase) says
Code:
   d) If none of the above solutions work then unmark this cell as 0 
       (BACKTRACK) and return false. 

So does your code has UNMARK stage?
User IP Logged

damned Dog in the Manger
tsh73
Board Moderator

member is online

Avatar

Anatoly (real name)


PM

Gender: Male
Posts: 1745
xx Re: backtraking tutorial
« Reply #4 on: Jan 22nd, 2018, 11:43am »

I tweaked it until it runs on this small example.
I might be wrong.
Code:
'' bluatigro 22 jan 2017
'' backtracking 2
'' maze solving
'' see for c++ :
'' https://www.geeksforgeeks.org/backtracking-algorithms/
global n
n = 0


global size
size = 3
dim maze(3,3),sol(3,3)
for y = 0 to size
  for x = 0 to size
    read a
    maze(x,y) = a
    sol(x,y) = 0
  next x
next y
''   maze
data 0,1,1,1
data 0,0,0,0
data 1,0,1,1
data 0,0,0,0
print "[ maze ]"
for y = 0 to size
  for x = 0 to size
    print maze(x,y) ;
  next x
  print
next y
if solve(0,0) = 0 then
  print "[ no solution ]"
end if
'else
  print "[ solution ]"
  for y = 0 to size
    for x = 0 to size
      print using(" ##",sol(x,y)) ;
    next x
    print
  next y
'end if
end

function solve( x , y )
  n=n+1
  if x = size and y = size then
    sol(x,y) = n
    solve = 1
    exit function
  end if
  if safe( x , y ) then
    sol(x,y) = n
    if solve( x + 1 , y ) then
      solve = 1
      exit function
    end if
    if solve( x - 1 , y ) then
      solve = 1
      exit function
    end if
    if solve( x , y + 1 ) then
      solve = 1
      exit function
    end if
    if solve( x , y - 1 ) then
      solve = 1
      exit function
    end if
    'solve = 0
  end if
  solve = 0
  n=n-1
end function
function safe( x , y )
  uit = 1
  if x < 0 then uit = 0
  if x > size then uit = 0
  if y < 0 then uit = 0
  if y > size then uit = 0
 if uit = 0 then safe = uit: exit function  'cut if out of array
  if maze(x,y) = 1 then uit = 0
  if sol(x,y) > 1 then uit = 0
  safe = uit
end function
 
User IP Logged

damned Dog in the Manger
tsh73
Board Moderator

member is online

Avatar

Anatoly (real name)


PM

Gender: Male
Posts: 1745
xx Re: backtraking tutorial
« Reply #5 on: Jan 22nd, 2018, 11:55am »

better version, with real (??) backtracking
Code:
'' bluatigro 22 jan 2017
'' backtracking 2
'' maze solving
'' see for c++ :
'' https://www.geeksforgeeks.org/backtracking-algorithms/
global n
n = 0


global size
size = 3
dim maze(3,3),sol(3,3)
for y = 0 to size
  for x = 0 to size
    read a
    maze(x,y) = a
    sol(x,y) = 0
  next x
next y
''   maze
data 0,1,1,1
data 0,0,0,0
data 1,0,1,1
data 0,0,0,0
print "[ maze ]"
for y = 0 to size
  for x = 0 to size
    print maze(x,y) ;
  next x
  print
next y
if solve(0,0) = 0 then
  print "[ no solution ]"
end if
'else
  print "[ solution ]"
  for y = 0 to size
    for x = 0 to size
      print using(" ##",sol(x,y)) ;
    next x
    print
  next y
'end if
end

function solve( x , y )
  if x = size and y = size then 'destination reached
    n=n+1
    sol(x,y) = n
    solve = 1
    exit function
  end if
  if not(safe( x , y )) then exit function  'out of array

  n=n+1
  if free( x , y ) then 'free to move
    sol(x,y) = n
    if solve( x + 1 , y ) then
      solve = 1
      exit function
    end if
    if solve( x - 1 , y ) then
      solve = 1
      exit function
    end if
    if solve( x , y + 1 ) then
      solve = 1
      exit function
    end if
    if solve( x , y - 1 ) then
      solve = 1
      exit function
    end if
    'if no go - backtrack (it removes false thread)
    sol(x,y) = 0
  end if
  solve = 0
  n=n-1
end function
'---------------------
function safe( x , y )
  uit = 1
  if x < 0 then uit = 0
  if x > size then uit = 0
  if y < 0 then uit = 0
  if y > size then uit = 0
  safe = uit
end function

function free( x , y )
  uit = 1
  if maze(x,y) = 1 then uit = 0
  if sol(x,y) > 1 then uit = 0
  free = uit
end function
 
User IP Logged

damned Dog in the Manger
bluatigro
Guru
ImageImageImageImageImage


member is offline

Avatar

cxiu diversas el tio respondas cxiu samvaloras [ thats esperanto for : we are al different therefore we are al equal ]


PM

Gender: Male
Posts: 961
xx Re: backtraking tutorial
« Reply #6 on: Jan 29th, 2018, 03:45am »

@ tsh73 :
used your idea's . thanks

it shoot be working on every perfect maze now
Code:

'' bluatigro 22 jan 2017
'' backtracking 2
'' maze solving
'' see for c++ :
'' https://www.geeksforgeeks.org/backtracking-algorithms/
global n
n = 0


global size
size = 3
dim maze(3,3),sol(3,3)
for y = 0 to size
  for x = 0 to size
    read a
    maze(x,y) = a
    sol(x,y) = 0
  next x
next y
''   maze
data 0,1,1,1
data 0,0,0,0
data 1,0,1,1
data 0,0,0,0
print "[ maze ]"
for y = 0 to size
  for x = 0 to size
    if maze( x , y ) then
      print "#" ;
    else
      print "." ;
    end if
  next x
  print
next y
if solve( 0 , 0 ) = 0 then
  print "[ no solution ]"
else
  print "[ solution ]"
  for y = 0 to size
    for x = 0 to size
      if sol( x , y ) then
        print "x" ;
      else
        if maze( x , y ) then
          print "#" ;
        else
          print "." ;
        end if
      end if
    next x
    print
  next y
end if
end
function solve( x , y )
  uit = 0
  if x = size and y = size then
    sol( x , y ) = 1
    uit = 1
  end if
  if safe( x , y ) then
    if free( x , y ) then
      sol( x , y ) = 1
      if solve( x + 1 , y ) then
        uit = 1
      end if
      if solve( x - 1 , y ) then
        uit = 1
      end if
      if solve( x , y + 1 ) then
        uit = 1
      end if
      if solve( x , y - 1 ) then
        uit = 1
      end if
      if not( uit ) then sol(x,y)=0
    end if
  end if

  solve = uit
end function
function safe( x , y )
  uit = 1
  if x < 0 then uit = 0
  if x > size then uit = 0
  if y < 0 then uit = 0
  if y > size then uit = 0
  safe = uit
end function
function free( x , y )
  uit = 1
  if maze(x,y) then uit = 0
  if sol(x,y) then uit = 0
  free = uit
end function
 
User IP Logged

basic's : C64 Simons C128 Amiga Amos quick4.5 Visual5 Visual6 Visual2005 Visual2008 just and last but not least liberty
bluatigro
Guru
ImageImageImageImageImage


member is offline

Avatar

cxiu diversas el tio respondas cxiu samvaloras [ thats esperanto for : we are al different therefore we are al equal ]


PM

Gender: Male
Posts: 961
xx Re: backtraking tutorial
« Reply #7 on: Jan 30th, 2018, 07:36am »

we need a random maze
so i looked on www.rosetacode.org
and translated another basic example

if this works i ad graphics window + menu

error :
my pc freezes

Code:
global w , h
w = 6
h = 6
dim maze( w , h )
for i = 0 to w
  for j = 0 to h
    maze( i , j ) = 1
  next j
next i
while cx and 1 = 0
  cx = int( rnd(0) * w )
wend
while cy and 1 = 0
  cy = int( rnd(0) * h )
wend
maze( cx , cy ) = 0
while not( done )
  FOR i = 0 TO 99
    oldx = cx
    oldy = cy

    '' move in random direction
    SELECT CASE INT(RND(0) * 4)
      CASE 0
        IF cx + 2 < w THEN cx = cx + 2
      CASE 1
        IF cy + 2 < h THEN cy = cy + 2
      CASE 2
        IF cx - 2 > 0 THEN cx = cx - 2
      CASE 3
        IF cy - 2 > 0 THEN cy = cy - 2
    END SELECT

    '' if cell is unvisited then connect it
    IF maze( cx , cy ) THEN
      maze( cx , cy ) = 0
      maze( INT( cx + oldx ) / 2 _
          , int( cy + oldy ) / 2 ) = 0
    END IF
  NEXT i

  '' check if all cells are visited
  done = 1
  FOR x = 1 TO w - 1 STEP 2
    FOR y = 1 TO h - 1 STEP 2
      IF maze( x , y ) THEN done = 0
    NEXT y
  NEXT x
wend
for y = 0 to h
  for x = 0 to w
    if maze( x , y ) then
      print "#" ;
    else
      print "." ;
    end if
  next x
next y
print "[ game over ]"
 
User IP Logged

basic's : C64 Simons C128 Amiga Amos quick4.5 Visual5 Visual6 Visual2005 Visual2008 just and last but not least liberty
bluatigro
Guru
ImageImageImageImageImage


member is offline

Avatar

cxiu diversas el tio respondas cxiu samvaloras [ thats esperanto for : we are al different therefore we are al equal ]


PM

Gender: Male
Posts: 961
xx Re: backtraking tutorial
« Reply #8 on: Jan 30th, 2018, 08:13am »

the rosetacode example don't replace the pen
if it is not moved
i fixed that

error :
my pc freezes

Code:
global w , h
w = 6
h = 6
dim maze( w , h )
'' set al maze on wal
for i = 0 to w
  for j = 0 to h
    maze( i , j ) = 1
  next j
next i
'' set pen on random place in maze
while cx and 1 = 0
  cx = int( rnd(0) * w )
wend
while cy and 1 = 0
  cy = int( rnd(0) * h )
wend
maze( cx , cy ) = 0
while not( done )
  i = 0
  fl = 1
  while fl  and i < 99
    i = i + 1
    oldx = cx
    oldy = cy

    '' move pen in random direction
    SELECT CASE INT(RND(0) * 4)
      CASE 0
        IF cx + 2 < w THEN cx = cx + 2
        fl = 0
      CASE 1
        IF cy + 2 < h THEN cy = cy + 2
        fl = 0
      CASE 2
        IF cx - 2 > 0 THEN cx = cx - 2
        fl = 0
      CASE 3
        IF cy - 2 > 0 THEN cy = cy - 2
        fl = 0
    END SELECT

    '' if cell is unvisited then connect it
    IF maze( cx , cy ) THEN
      maze( cx , cy ) = 0
      maze( INT( cx + oldx ) / 2 _
          , int( cy + oldy ) / 2 ) = 0
    END IF
  wend

  '' if no move is fount place pen randomly
  if fl then
    while maze( cx , cy ) = 0
      while cx and 1 = 0
        cx = int( rnd(0) * w )
      wend
      while cy and 1 = 0
        cy = int( rnd(0) * h )
      wend
    wend
  end if

  '' check if all cells are visited
  done = 1
  FOR x = 1 TO w - 1 STEP 2
    FOR y = 1 TO h - 1 STEP 2
      IF maze( x , y ) THEN done = 0
    NEXT y
  NEXT x
wend
print "[ maze ]"
for y = 0 to h
  for x = 0 to w
    if maze( x , y ) then
      print "#" ;
    else
      print "." ;
    end if
  next x
next y
print "[ game over ]"
 
User IP Logged

basic's : C64 Simons C128 Amiga Amos quick4.5 Visual5 Visual6 Visual2005 Visual2008 just and last but not least liberty
tsh73
Board Moderator

member is online

Avatar

Anatoly (real name)


PM

Gender: Male
Posts: 1745
xx Re: backtraking tutorial
« Reply #9 on: Jan 30th, 2018, 12:30pm »

I wonder what code you used as a base
I happen to find a probkem - it was

Code:
while cx and 1 = 0 

condition in "'' set pen on random place in maze" part.
As stated it always returns cx, cy as 0.

To work right, it needs brackets:
Code:
while (cx and 1) = 0
  cx = int( rnd(0) * w )
wend
while (cy and 1) = 0
  cy = int( rnd(0) * h )
wend
 


EDIT
I saw same code at "'' if no move is fount place pen randomly" part. Probably should be fixed too (though worked OK without it for me)
« Last Edit: Jan 30th, 2018, 12:32pm by tsh73 » User IP Logged

damned Dog in the Manger
tsh73
Board Moderator

member is online

Avatar

Anatoly (real name)


PM

Gender: Male
Posts: 1745
xx Re: backtraking tutorial
« Reply #10 on: Jan 30th, 2018, 12:43pm »

Rosetta code BASIC example adapted to LB (% removed, first two lines removed, RND changed to RND(1), last 2 lines changed to END)
Code:
'OPTION BASE 0
'RANDOMIZE TIMER

REM must be even
width = 40
height = 20

REM make array and fill
DIM maze$(width, height)
FOR x = 0 TO width
    FOR y = 0 TO height
        maze$(x, y) = "#"
    NEXT y
NEXT x

REM initial start location
currentx = INT(RND * (width - 1))
currenty = INT(RND * (height - 1))
REM value must be odd
IF currentx MOD 2 = 0 THEN currentx = currentx + 1
IF currenty MOD 2 = 0 THEN currenty = currenty + 1
maze$(currentx, currenty) = " "

REM generate maze
done = 0
DO WHILE done = 0
    FOR i = 0 TO 99
        oldx = currentx
        oldy = currenty

        REM move in random direction
        SELECT CASE INT(RND(1) * 4)
            CASE 0
                IF currentx + 2 < width THEN currentx = currentx + 2
            CASE 1
                IF currenty + 2 < height THEN currenty = currenty + 2
            CASE 2
                IF currentx - 2 > 0 THEN currentx = currentx - 2
            CASE 3
                IF currenty - 2 > 0 THEN currenty = currenty - 2
        END SELECT

        REM if cell is unvisited then connect it
        IF maze$(currentx, currenty) = "#" THEN
            maze$(currentx, currenty) = " "
            maze$(INT((currentx + oldx) / 2), ((currenty + oldy) / 2)) = " "
        END IF
    NEXT i

    REM check if all cells are visited
    done = 1
    FOR x = 1 TO width - 1 STEP 2
        FOR y = 1 TO height - 1 STEP 2
            IF maze$(x, y) = "#" THEN done = 0
        NEXT y
    NEXT x
    '--------------
'FOR y = 0 TO height
'    FOR x = 0 TO width
'        PRINT maze$(x, y);
'    NEXT x
'    PRINT
'NEXT y
'print
    '--------------
LOOP

REM draw maze
FOR y = 0 TO height
    FOR x = 0 TO width
        PRINT maze$(x, y);
    NEXT x
    PRINT
NEXT y

REM wait
end
 
User IP Logged

damned Dog in the Manger
bluatigro
Guru
ImageImageImageImageImage


member is offline

Avatar

cxiu diversas el tio respondas cxiu samvaloras [ thats esperanto for : we are al different therefore we are al equal ]


PM

Gender: Male
Posts: 961
xx Re: backtraking tutorial
« Reply #11 on: Jan 31st, 2018, 03:42am »

@ tsh73 :
that code i used to

update :
added rosetacode + mycode

it works now

i wil ad graphics + menu

first this
Code:

'OPTION BASE 0
'RANDOMIZE TIMER

'' must be even
global width , height
width = 40
height = 16

'' make array and fill
DIM maze$( width , height ) , sol( width , height )
FOR x = 0 TO width
    FOR y = 0 TO height
        maze$( x , y ) = "#"
    NEXT y
NEXT x

'' initial start location
currentx = INT( RND(0) * ( width - 1 ) )
currenty = INT( RND(0) * ( height - 1 ) )
'' value must be odd
IF currentx MOD 2 = 0 THEN currentx = currentx + 1
IF currenty MOD 2 = 0 THEN currenty = currenty + 1
maze$( currentx , currenty ) = "."

'' generate maze
done = 0
DO WHILE done = 0
    FOR i = 0 TO 99
        oldx = currentx
        oldy = currenty

        '' move in random direction
        SELECT CASE INT( RND(0) * 4)
            CASE 0
                IF currentx + 2 < width THEN currentx = currentx + 2
            CASE 1
                IF currenty + 2 < height THEN currenty = currenty + 2
            CASE 2
                IF currentx - 2 > 0 THEN currentx = currentx - 2
            CASE 3
                IF currenty - 2 > 0 THEN currenty = currenty - 2
        END SELECT

        '' if cell is unvisited then connect it
        IF maze$(currentx, currenty) = "#" THEN
            maze$(currentx, currenty) = " "
            maze$(INT((currentx + oldx) / 2), ((currenty + oldy) / 2)) = " "
        END IF
    NEXT i

    '' check if all cells are visited
    done = 1
    FOR x = 1 TO width - 1 STEP 2
        FOR y = 1 TO height - 1 STEP 2
            IF maze$( x , y ) = "#" THEN done = 0
        NEXT y
    NEXT x
LOOP

'' bluatigro 31 jan 2017
'' backtracking 2
'' maze solving
'' see for c++ :
'' https://www.geeksforgeeks.org/backtracking-algorithms/

for y = 0 to height
  for x = 0 to width
    sol( x , y ) = 0
  next x
next y
print "[ maze ]"
for y = 0 to height
  for x = 0 to width
    print maze$( x , y ) ;
  next x
  print
next y
input "[ push return to solve maze . ]" ; in$
if solve( 1 , 1 ) = 0 then
  print "[ no solution ]"
else
  print "[ solution ]"
  for y = 0 to height
    for x = 0 to width
      if sol( x , y ) then
        print "x" ;
      else
        print maze$( x , y ) ;
      end if
    next x
    print
  next y
end if
print "[ game over !! ]"
end
function solve( x , y )
  uit = 0
  if x = width - 1 and y = height - 1 then
    sol( x , y ) = 1
    uit = 1
  end if
  if safe( x , y ) then
    if free( x , y ) then
      sol( x , y ) = 1
      if solve( x + 1 , y ) then
        uit = 1
      end if
      if solve( x - 1 , y ) then
        uit = 1
      end if
      if solve( x , y + 1 ) then
        uit = 1
      end if
      if solve( x , y - 1 ) then
        uit = 1
      end if
      if uit = 0 then sol( x , y ) = 0
    end if
  end if

  solve = uit
end function
function safe( x , y )
  uit = 1
  if x < 0 then uit = 0
  if x > width then uit = 0
  if y < 0 then uit = 0
  if y > height then uit = 0
  safe = uit
end function
function free( x , y )
  uit = 1
  if maze$( x , y ) = "#" then uit = 0
  if sol( x , y ) then uit = 0
  free = uit
end function
 
« Last Edit: Jan 31st, 2018, 03:43am by bluatigro » User IP Logged

basic's : C64 Simons C128 Amiga Amos quick4.5 Visual5 Visual6 Visual2005 Visual2008 just and last but not least liberty
bluatigro
Guru
ImageImageImageImageImage


member is offline

Avatar

cxiu diversas el tio respondas cxiu samvaloras [ thats esperanto for : we are al different therefore we are al equal ]


PM

Gender: Male
Posts: 961
xx Re: backtraking tutorial
« Reply #12 on: Jan 31st, 2018, 04:17am »

UPDATE :
now whit graphics and menu


error :
i don't see the maze been drawn

how do i random size maze's in this code ?
and 3D maze's ?

Code:
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy
winx = WindowWidth
winy = WindowHeight

'OPTION BASE 0
'RANDOMIZE TIMER

'' must be even
global width , height
width = 40
height = 16

DIM maze$( width , height ) , sol( width , height )

'' bluatigro 31 jan 2017
'' backtracking 2
'' maze solving
'' see for c++ :
'' https://www.geeksforgeeks.org/backtracking-algorithms/
menu #m , "MAZE" _
        , "NEW" , [new.maze] _
        , "SOLVE" , [solve.maze]
nomainwin
open "aMAZEing 1.0" for graphics as #m
  #m "trapclose [quit]"
wait
[quit]
  close #m
end
sub draw.maze
  for x = 0 to width
    for y = 0 to height
      if maze$( x , y ) = "#" then
        #m "backcolor blue"
      else
        #m "backcolor cyan"
      end if
      fx = winx / width
      #m "goto ";x*fx;" ";y*fy
      #m "down"
      #m "boxfilled ";x*fx+fx;" ";y*fy+fy
      #m "up"
      if sol( x , y ) then
        #m "backcolor yellow"
        #m "goto ";x*fx+fx/2;" ";y*fy+fy/2
        #m "down"
        #m "ellipsefilled ";fx/2;" ";fy/2
        #m "up"
      end if
    next y
  next x
end sub
[new.maze]
FOR x = 0 TO width
    FOR y = 0 TO height
        maze$( x , y ) = "#"
    NEXT y
NEXT x

'' initial start location
currentx = INT( RND(0) * ( width - 1 ) )
currenty = INT( RND(0) * ( height - 1 ) )
'' value must be odd
IF currentx MOD 2 = 0 THEN currentx = currentx + 1
IF currenty MOD 2 = 0 THEN currenty = currenty + 1
maze$( currentx , currenty ) = "."

'' generate maze
done = 0
DO WHILE done = 0
    FOR i = 0 TO 99
        oldx = currentx
        oldy = currenty

        '' move in random direction
        SELECT CASE INT( RND(0) * 4)
            CASE 0
                IF currentx + 2 < width THEN currentx = currentx + 2
            CASE 1
                IF currenty + 2 < height THEN currenty = currenty + 2
            CASE 2
                IF currentx - 2 > 0 THEN currentx = currentx - 2
            CASE 3
                IF currenty - 2 > 0 THEN currenty = currenty - 2
        END SELECT

        '' if cell is unvisited then connect it
        IF maze$(currentx, currenty) = "#" THEN
            maze$(currentx, currenty) = "."
            maze$(INT((currentx + oldx) / 2), ((currenty + oldy) / 2)) = " "
        END IF
    NEXT i

    '' check if all cells are visited
    done = 1
    FOR x = 1 TO width - 1 STEP 2
        FOR y = 1 TO height - 1 STEP 2
            IF maze$( x , y ) = "#" THEN done = 0
        NEXT y
    NEXT x
LOOP
call draw.maze
wait
[solve.maze]
for y = 0 to height
  for x = 0 to width
    sol( x , y ) = 0
  next x
next y
  if not( solve( 1 , 1 ) ) then
    notice "ERROR !!" + chr$( 13 ) _
    + "Maze has no solution !!"
  end if
  call draw.maze
wait
function solve( x , y )
  uit = 0
  if x = width - 1 and y = height - 1 then
    sol( x , y ) = 1
    uit = 1
  end if
  if safe( x , y ) then
    if free( x , y ) then
      sol( x , y ) = 1
      if solve( x + 1 , y ) then
        uit = 1
      end if
      if solve( x - 1 , y ) then
        uit = 1
      end if
      if solve( x , y + 1 ) then
        uit = 1
      end if
      if solve( x , y - 1 ) then
        uit = 1
      end if
      if uit = 0 then sol( x , y ) = 0
    end if
  end if

  solve = uit
end function
function safe( x , y )
  uit = 1
  if x < 0 then uit = 0
  if x > width then uit = 0
  if y < 0 then uit = 0
  if y > height then uit = 0
  safe = uit
end function
function free( x , y )
  uit = 1
  if maze$( x , y ) = "#" then uit = 0
  if sol( x , y ) then uit = 0
  free = uit
end function
 
User IP Logged

basic's : C64 Simons C128 Amiga Amos quick4.5 Visual5 Visual6 Visual2005 Visual2008 just and last but not least liberty
Rod
Global Moderator
ImageImageImageImageImage


member is offline

Avatar

Graphics = goosebumps!


PM

Gender: Male
Posts: 5655
xx Re: backtraking tutorial
« Reply #13 on: Jan 31st, 2018, 05:25am »

You are missing fy = winy / height

in the maze drawing sub.
User IP Logged

bluatigro
Guru
ImageImageImageImageImage


member is offline

Avatar

cxiu diversas el tio respondas cxiu samvaloras [ thats esperanto for : we are al different therefore we are al equal ]


PM

Gender: Male
Posts: 961
xx Re: backtraking tutorial
« Reply #14 on: Jan 31st, 2018, 06:40am »

@ rod :
i forgot that . thanks

Code:
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy
winx = WindowWidth
winy = WindowHeight

'OPTION BASE 0
'RANDOMIZE TIMER

'' must be even
global width , height
width = 40
height = 16

DIM maze$( width , height ) , sol( width , height )

'' bluatigro 31 jan 2017
'' backtracking 2
'' maze solving
'' see for c++ :
'' https://www.geeksforgeeks.org/backtracking-algorithms/
menu #m , "MAZE" _
        , "NEW" , [new.maze] _
        , "SOLVE" , [solve.maze]
nomainwin
open "aMAZEing 1.0" for graphics as #m
  #m "trapclose [quit]"
wait
[quit]
  close #m
end
sub draw.maze
  for x = 0 to width
    for y = 0 to height
      if maze$( x , y ) = "#" then
        #m "backcolor cyan"
      else
        #m "backcolor blue"
      end if
      fx = winx / ( width + 2 )
      fy = winy / ( height + 2 )
      #m "goto ";x*fx;" ";y*fy
      #m "down"
      #m "boxfilled ";x*fx+fx;" ";y*fy+fy
      #m "up"
      if sol( x , y ) then
        #m "backcolor yellow"
        #m "goto ";x*fx+fx/2;" ";y*fy+fy/2
        #m "down"
        #m "ellipsefilled ";fx/2;" ";fy/2
        #m "up"
      end if
    next y
  next x
end sub
[new.maze]
FOR x = 0 TO width
    FOR y = 0 TO height
        maze$( x , y ) = "#"
        sol( x , y ) = 0
    NEXT y
NEXT x

'' initial start location
currentx = INT( RND(0) * ( width - 1 ) )
currenty = INT( RND(0) * ( height - 1 ) )
'' value must be odd
IF currentx MOD 2 = 0 THEN currentx = currentx + 1
IF currenty MOD 2 = 0 THEN currenty = currenty + 1
maze$( currentx , currenty ) = "."

'' generate maze
done = 0
DO WHILE done = 0
    FOR i = 0 TO 99
        oldx = currentx
        oldy = currenty

        '' move in random direction
        SELECT CASE INT( RND(0) * 4)
            CASE 0
                IF currentx + 2 < width THEN currentx = currentx + 2
            CASE 1
                IF currenty + 2 < height THEN currenty = currenty + 2
            CASE 2
                IF currentx - 2 > 0 THEN currentx = currentx - 2
            CASE 3
                IF currenty - 2 > 0 THEN currenty = currenty - 2
        END SELECT

        '' if cell is unvisited then connect it
        IF maze$(currentx, currenty) = "#" THEN
            maze$(currentx, currenty) = "."
            maze$(INT((currentx + oldx) / 2), ((currenty + oldy) / 2)) = " "
        END IF
    NEXT i

    '' check if all cells are visited
    done = 1
    FOR x = 1 TO width - 1 STEP 2
        FOR y = 1 TO height - 1 STEP 2
            IF maze$( x , y ) = "#" THEN done = 0
        NEXT y
    NEXT x
LOOP
call draw.maze
wait
[solve.maze]
for y = 0 to height
  for x = 0 to width
    sol( x , y ) = 0
  next x
next y
  if not( solve( 1 , 1 ) ) then
    notice "ERROR !!" + chr$( 13 ) _
    + "Maze has no solution !!"
  end if
  call draw.maze
wait
function solve( x , y )
  uit = 0
  if x = width - 1 and y = height - 1 then
    sol( x , y ) = 1
    uit = 1
  end if
  if safe( x , y ) then
    if free( x , y ) then
      sol( x , y ) = 1
      if solve( x + 1 , y ) then
        uit = 1
      end if
      if solve( x - 1 , y ) then
        uit = 1
      end if
      if solve( x , y + 1 ) then
        uit = 1
      end if
      if solve( x , y - 1 ) then
        uit = 1
      end if
      if uit = 0 then sol( x , y ) = 0
    end if
  end if

  solve = uit
end function
function safe( x , y )
  uit = 1
  if x < 0 then uit = 0
  if x > width then uit = 0
  if y < 0 then uit = 0
  if y > height then uit = 0
  safe = uit
end function
function free( x , y )
  uit = 1
  if maze$( x , y ) = "#" then uit = 0
  if sol( x , y ) then uit = 0
  free = uit
end function
 
User IP Logged

basic's : C64 Simons C128 Amiga Amos quick4.5 Visual5 Visual6 Visual2005 Visual2008 just and last but not least liberty
Pages: 1 2  Notify Send Topic Print
« Previous Topic | Next Topic »

Rules|Home|Help|Search|Recent Posts|Notification

Donate $6.99 for 50,000 Ad-Free Pageviews!

| |

This forum powered for FREE by Conforums ©
Sign up for your own Free Message Board today!
Terms of Service | Privacy Policy | Conforums Support | Parental Controls