Liberty BASIC Community Forum
« backtraking tutorial »

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


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


« Previous Topic | Next Topic »
Pages: 1 2  Notify Send Topic Print
 hotthread  Author  Topic: backtraking tutorial  (Read 306 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 Re: backtraking tutorial
« Reply #15 on: Feb 2nd, 2018, 04:30am »

update :
maze on torus

error :
out of maze$()

i use mod this shoot not happen

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

'OPTION BASE 0
'RANDOMIZE TIMER

'' must be even
global width , height
width = 80
height = 26

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

'' bluatigro 2 feb 2018
'' backtracking
'' 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 + 3 )
      fy = winy / ( height + 3 )
      #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;" ";fy
        #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
               currentx = ( currentx + 2 ) mod width
            CASE 1
               currenty = ( currenty + 2 ) mod height
            CASE 2
               currentx = ( currentx - 2 ) mod width
            CASE 3
               currenty = ( currenty - 2 ) mod height
        END SELECT

        '' if cell is unvisited then connect it
        IF maze$(currentx, currenty) = "#" THEN
            maze$(currentx, currenty) = "."
            fl = 1
            if oldx = 1 and currentx = width - 1 then
              maze$( 0 , currenty ) = " "
              maze$( width , currenty ) = " "
              fl = 0
            end if
            if oldy = 1 and currenty = height - 1 then
              maze$( currentx , 0 ) = " "
              maze$( currentx , height ) = " "
              fl = 0
            end if
            if oldx = width - 1 and currentx = 1 then
              maze$( 0 , oldy ) = " "
              maze$( width , oldy ) = " "
              fl = 0
            end if
            if oldy = height - 1 and currenty = 1 then
              maze$( oldx , 0 ) = " "
              maze$( oldx , height ) = " "
              fl = 0
            end if
            if fl then
              maze$( INT( ( currentx + oldx ) / 2 ) _
                   , int( ( currenty + oldy ) / 2 ) ) = " "
            end if
        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
  x = x mod width
  y = y mod height
  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 #16 on: Feb 2nd, 2018, 06:08am »

Liberty's MOD function returns the remainder after division, this can be negative. So if you want it to be like other MODULO operators in other languages that return positive use ABS()

Code:
 '' move in random direction
        SELECT CASE INT( RND(0) * 4)
            CASE 0
               currentx = abs(( currentx + 2 ) mod width)
            CASE 1
               currenty = abs(( currenty + 2 ) mod height)
            CASE 2
               currentx = abs(( currentx - 2 ) mod width)
            CASE 3
               currenty = abs(( currenty - 2 ) mod height)
        END SELECT

 
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 #17 on: Feb 5th, 2018, 04:06am »

@ rod :
if currentx = -1 it shoot be width - 1 not 1
so your code won't do what i want

update :
i tryed something
Code:
WindowWidth = DisplayWidth
WindowHeight = DisplayHeight
global winx , winy
winx = WindowWidth
winy = WindowHeight

'OPTION BASE 0
'RANDOMIZE TIMER

'' must be even
global width , height
width = 80
height = 26

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

'' bluatigro 5 feb 2018
'' backtracking
'' torus 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 + 3 )
      fy = winy / ( height + 3 )
      #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;" ";fy
        #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
               currentx = ( currentx + 2 ) mod width
               if currentx = -1 then currentx = width - 1
            CASE 1
               currenty = ( currenty + 2 ) mod height
               if currenty = -1 then currenty = height - 1
            CASE 2
               currentx = ( currentx - 2 ) mod width
               if currentx = -1 then currentx = width - 1
            CASE 3
               currenty = ( currenty - 2 ) mod height
               if currendy = -1 then currenty = height - 1
        END SELECT

        '' if cell is unvisited then connect it
        IF maze$(currentx, currenty) = "#" THEN
            maze$(currentx, currenty) = "."
            fl = 1
            if oldx = 1 and currentx = width - 1 then
              maze$( 0 , currenty ) = " "
              maze$( width , currenty ) = " "
              fl = 0
            end if
            if oldy = 1 and currenty = height - 1 then
              maze$( currentx , 0 ) = " "
              maze$( currentx , height ) = " "
              fl = 0
            end if
            if oldx = width - 1 and currentx = 1 then
              maze$( 0 , oldy ) = " "
              maze$( width , oldy ) = " "
              fl = 0
            end if
            if oldy = height - 1 and currenty = 1 then
              maze$( oldx , 0 ) = " "
              maze$( oldx , height ) = " "
              fl = 0
            end if
            if fl then
              maze$( INT( ( currentx + oldx ) / 2 ) _
                   , int( ( currenty + oldy ) / 2 ) ) = " "
            end if
        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
  x = x mod width
  y = y mod height
  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