backtrack tutorial tranlation try

[bluatigro]

fount a tutorail on backtracking in c++
i wil try to translate every example
this is the first in a set
it is not whitout error's
the freebasic version did not freze
any help is welkome
whit this one and the others


'' bluatigro 5 okt 2018
'' backtrack tutorial translation from c++ :
'' https://www.geeksforgeeks.org/backtracking-algorithms/
'' backtracing : 1 knights toor

global n : n = 8
dim q( n - 1 , n - 1 )
dim ax( 7 )
for i = 0 to 7
 read a
 ax( i ) = a
next i
data 2 , 1 , -1 , -2 , -2 , -1 ,  1 ,  2
dim ay( 7 )
for i = 0 to 7
 read a
 ay( i ) = a
next i
data 1 , 2 ,  2 ,  1 , -1 , -2 , -2 , -1
for i = 0 to n - 1
 for j = 0 to n - 1
   q( i , j ) = -1
 next j
next i

q(0,0) = 0
if solve( 0 , 0 , 1 ) = 0 then
 print "[ not to solve ]"
else
 for j = 0 to n - 1
   for i = 0 to n - 1
     print right$( "   " + str$( q( i , j ) ) , 3 ) ;
   next i
   print
 next j
end if


end
function save( x , y )
 uit = 0
 if 0 <= x _
 and x <= n - 1 _
 and 0 <= y _
 and y <= n - 1 then
   if q( x , y ) = -1 then uit = 1
 end if
 save = uit
end function

function solve( x , y , move )
 if move = n * n then
   solve = 1
 end if
 for i = 0 to 7 ''knights move
   nx = x + ax( i )
   ny = y + ay( i )
   if save( nx , ny ) then
     q( nx , ny ) = move
     if solve( nx , ny , move + 1 ) then
       solve = 1
     else
       q( nx , ny ) = -1
     end if
   end if
 next i
 solve = 0
end function



[B+]

What is backtracking and why would anyone want to bother with it? ;-))

bluatigro, if you want to be a teacher you better setup your lectures better.

Also preparing lessons that will work might add to the success of your dreams ambition.

[Rod]

Well it is an optimization technique and the knights tour is one of the tasks it attempts to help solve. It is an interesting problem, but we never get to discuss that, bluatigro always presents a solution. Other less cryptic solutions might be interesting to code. Recursion is in there too.


www.geeksforgeeks.org/the-knights-tour-problem-backtracking-1/

[B+]

OK now that I've warmed up with this, I think I have a plan for a solver.

'Knight Moves.txt for JB v2.0 B+ started 2018-10-06

global boardLow, boardHigh, beenHere, offset, count, stopF
boardLow = 1 : boardHigh = 8 : offset = 0

while offset <= 8
   cls
   Print "Trying new pattern of moves, offset = ";offset
   print
   dim board(boardHigh, boardHigh)
   board(1, 1) = 1
   col = 1 : row = 1 : beenHere = 1 : stopF = 0
   for count = 1 to boardHigh * boardHigh
       call moveKnight col, row
       call update
       call pause 500
       if stopF then exit for
   next
   offset = offset + 1
wend
locate 10, 23
print "Experiment is done."

sub moveKnight byref x, byref y
   'take the first open space avail, if none return 0, 0
   xMove$ = "1 2 -2 -1 -2 -1 1 2"
   yMove$ = "2 1 -1 -2 1 2 -2 -1"
   for m = 1 to 8
       if x + val(word$(xMove$, ((m + offset) mod 8 + 1))) >= boardLow and x + val(word$(xMove$, ((m + offset) mod 8 + 1))) <= boardHigh then
           if y + val(word$(yMove$, ((m + offset) mod 8 + 1))) >= boardLow and y + val(word$(yMove$, ((m + offset) mod 8 + 1))) <= boardHigh then
               if board(x + val(word$(xMove$, ((m + offset) mod 8 + 1))), y + val(word$(yMove$, ((m + offset) mod 8 + 1)))) = 0 then
                   beenHere = beenHere + 1
                   board(x + val(word$(xMove$, ((m + offset) mod 8 + 1))), y + val(word$(yMove$, ((m + offset) mod 8 + 1)))) = beenHere
                   x = x + val(word$(xMove$, ((m + offset) mod 8 + 1))) : y = y + val(word$(yMove$, ((m + offset) mod 8 + 1)))
                   exit sub
               end if
           end if
       end if
   next
   'oh man! if still here, then there is nowhere else to go
   print : print "Yikes! No where else to go from (";x;", ";y;")!"
   print "Count got up to ";count
   stopF = 1
   call pause 3500
end sub

sub update
   for row = boardLow to boardHigh
   for col = boardLow to boardHigh
       locate col * 4, row + 2
       if board(col, row) then print right$("    ";board(col, row), 4) else print "    "
   next
   next
end sub

sub pause mil   'tsh version has scan built-in
   t0 = time$("ms")
   while time$("ms") < t0 + mil : scan : wend
end sub



[B+]

Here is an analysis showing that there is no simple repeating pattern of moves made to cover the board from the solution found from Rod' link.

'Knight Moves 2 Analyze Solution.txt for JB v2.0 B+ started 2018-10-06

'in search of a pattern

global boardLow, boardHigh, beenHere
boardLow = 1 : boardHigh = 8
dim board(boardHigh, boardHigh)
call readSolution
print "Solution from Rod's link:"
call update
print:print "Move Number Code, shows no repeating pattern."
lastx = 1 : lasty = 1 : find = 1
while find <= 63
   scan
   found = 0
   for r = boardLow to boardHigh
       for c = boardLow to boardHigh
           if board(c, r) = find then
               dx = c - lastx : dy =r - lasty
               print patternNumber(dx, dy);", ";
               count = count + 1
               if count mod 8 = 0 then print
               lastx = c : lasty = r
               found = 1
               exit for
           end if
       next
       if found then exit for
   next
   find = find + 1
wend
'board(1, 1) = 1
'col = 1 : row = 1 : beenHere = 1
'for count = 1 to boardHigh * boardHigh
'    call moveKnight col, row
'    call update
'    call pause 1
'next

function patternNumber(dx, dy)
   patterns$ = "1,2 2,1 2,-1 -2,-1 -2,1 -1,2 -1,-2 1,-2"
   match$ = str$(dx);",";str$(dy)
   for i = 1 to 8
       if match$ = word$(patterns$, i) then patternNumber = i : exit function
   next
   'else it's 0
end function

sub moveKnight byref x, byref y
   'take the first open space avail, if none return 0, 0
   xMove$ = "1 2 2 -2 -2 -1 -1 1"
   yMove$ = "2 1 -1 -1 1 2 -2 -2"
   for m = 1 to 8
       if x + val(word$(xMove$, m)) >= boardLow and x + val(word$(xMove$, m)) <= boardHigh then
           if y + val(word$(yMove$, m)) >= boardLow and y + val(word$(yMove$, m)) <= boardHigh then
               if board(x + val(word$(xMove$, m)), y + val(word$(yMove$, m))) = 0 then
                   beenHere = beenHere + 1
                   board(x + val(word$(xMove$, m)), y + val(word$(yMove$, m))) = beenHere
                   x = x + val(word$(xMove$, m)) : y = y + val(word$(yMove$, m))
                   exit sub
               end if
           end if
       end if
   next
   'oh man! if still here, then there is nowhere else to go
   print "Yikes! No where else to go from (";x;", ";y;")!"
   end
end sub

sub update
   for row = 1 to 8
   for col = 1 to 8
       locate col * 4, row + 2
       if board(col, row) then print right$("    ";board(col, row), 4) else print "    "
   next
   next
end sub

sub pause mil   'tsh version has scan built-in
   t0 = time$("ms")
   while time$("ms") < t0 + mil : scan : wend
end sub

sub readSolution
   'from Rod's link
   data 0, 59, 38, 33, 30, 17, 8, 63
   data 37, 34, 31, 60, 9, 62, 29, 16
   data 58, 1, 36, 39, 32, 27, 18, 7
   data 35, 48, 41, 26, 61, 10, 15, 28
   data 42, 57, 2, 49, 40, 23, 6, 19
   data 47, 50, 45, 54, 25, 20, 11, 14
   data 56, 43, 52, 3, 22, 13, 24, 5
   data 51, 46, 55, 44, 53, 4, 21, 12

   for r = boardLow to boardHigh
       for c = boardLow to boardHigh
           read d
       '   print r, c, d
           'input "OK enter...";t$
           board(c, r) = d
       next
       'print
   next
end sub




[bluatigro]

@ b+ :
i like to learn as mutch as posible
teachting is 1 of those things
backtarcing also
by traslatying the examples i hoping to learn that
so i can use it to solve pulzes whit my pc
by doing it here i hope to get both under my knee

writing explanation's is sertenly somthing i wil look into

[B+]

Now I am ready to learn what improvements backtracking might off to this:


'Knight Moves 3 Recurring.txt for JB v2.0 B+ started 2018-10-07

'OK try some recusion
global counter
data 2, 1, -1, -2, -2, -1,  1,  2
data 1, 2,  2,  1, -1, -2, -2, -1
for i = 1 to 8
   read d
   dy(i) = d
next
for i = 1 to 8
   read d
   dx(i) = d
next

for i = 1 to 64
   board$ = board$ + chr$(98) 'using chr$(98) for not visited yet signal
next
startx = 1 : starty = 1 : beenHere = 0
call MoveKnight startx, starty, board$, beenHere

sub MoveKnight x, y, board$, beenHere
   'recursive procedure: from this x, y position
   'first check if position is OK to move into, if so
   '    record the position in the board
   '    then see if the board is complete, show soultion if so
   '    else find new positions to move to by recursive calls
   'else dead end exit
   scan
   'convert x, y to a position in a string 64 characters long
   position = (y - 1) * 8 + x
   if mid$(board$, position, 1) = chr$(98) then 'OK to move here

       'add position to board string
       beenHere = beenHere + 1
       board$ = ModSource$(board$, position, chr$(beenHere))

       'check board finished ha!
       if instr(board$, chr$(98)) > 0 then 'not done

           'progress report
           counter = counter + 1
           if counter mod 100000 = 0 then
               call ShowBoard board$
               'call Pause 200 'really will bog down processing!
           end if

           for m = 1 to 8
               scan
               'check now that the recursive call is in bounds
               if x + dx(m) >= 1 and x + dx(m) <= 8 then
                   if y + dy(m) >= 1 and y + dy(m) <= 8 then
                       call MoveKnight x + dx(m), y + dy(m), board$, beenHere
                   end if
               end if
           next
       else 'we are done and have a solution to show!
           call ShowBoard board$
           print
           print "    That's All Folks!"
           end
       end if
   'else dead end!
   end if
end sub

'modify a string by substitution at a single character place a new string
function ModSource$(source$, place, newString$)
   if place > 1 then head$ = mid$(source$, 1, place - 1) else head$ = ""
   if place < len(source$) then tail$ = mid$(source$, place + 1) else tail$ = ""
   ModSource$ = head$;newString$;tail$
end function

sub ShowBoard b$
   cls
   print counter
   for row = 0 to 7
       for col = 1 to 8
           scan
           locate col * 4, row + 3
           visit = asc(mid$(b$, row * 8 + col, 1))
           if visit = 98 then print "    " else print right$("    ";str$(visit), 4)
       next
   next
end sub

sub Pause mil   'tsh version has scan built-in
   t0 = time$("ms")
   while time$("ms") < t0 + mil : scan : wend
end sub


[B+]

Oops! Sorry bluatigro, I missed the link you had posted in the heading of your code that Rod reposted to give background.

Well now that I have a solver of my own, I can study your code with background understanding. Already I see, your version does NOT carry around a current copy of the board. That has got to save tons of time (if that is not the cause of the freeze).

[B+]

AHA! It works with a couple EXIT FUNCTION's added, BUT it took the same amount of calls to the recursive function as my code to the recursive sub.

Still the code is sweeter because it is not carrying a copy of the board in the parameters call!

Here is bluatigro's code fixed and commented and generally improved by B+



'' bluatigro 5 okt 2018 <<<<<<<<<<<<<< mods marked with <<<< adds or >>>> comments by B+ 2018-10-07
'' backtrack tutorial translation from c++ :
'' https://www.geeksforgeeks.org/backtracking-algorithms/
'' backtracing : 1 knights toor

global n, counter  '<<<<<<<<< added counter
n = 8
dim q( n - 1 , n - 1 )  '>>> this is the chess board q()

dim ax( 7 ) '>>> coordinate ax() with ay() for (change of x, change of y) knight moves
for i = 0 to 7
 read a
 ax( i ) = a
next i
data 2 , 1 , -1 , -2 , -2 , -1 ,  1 ,  2

dim ay( 7 ) '>>> do same for y as for x when x moves 1, y moves 2 and vice versa
for i = 0 to 7
 read a
 ay( i ) = a
next i
data 1 , 2 ,  2 ,  1 , -1 , -2 , -2 , -1

'>>>>>>>>>>>>>>>>>>>>>>> load board with code # for allowing moves
for i = 0 to n - 1
   for j = 0 to n - 1
       q( i , j ) = -1 '>>> -1 is code for "free to move here space"
   next j
next i

' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> Here is the entire MAIN CODE!!!!
q(0,0) = 0  'first move is putting the knight in top left square of board
if solve( 0 , 0 , 1 ) = 0 then
   print : print "[ Not able to solve ;(   ]" '<<<< changed message a bit
else
   call Update
   print : print "  Solved!"
end if
end '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>   end of MAIN CODE!!!

'>>> a function to check a move, is x, y on the board and has it been visited yet?
function save( x , y )  '>>>>  poor name choice, OK to move knight to x, y ?
   uit = 0
   if 0 <= x and x <= n - 1 and 0 <= y and y <= n - 1 then
       if q( x , y ) = -1 then uit = 1
   end if
   save = uit
end function

'>>> here is main recursive routine, in function form returns 1 when solved
function solve( x , y , move )

   scan  '<<<<<<<<<< bluatigro, if code don't work plug in some scan lines!!!

   counter = counter + 1 '<<<<<<<< let's see just how fast this sucker works
   if move = n * n then
       solve = 1
       exit function  '<<<<<<<<<<<<<<<<<<<<<<<<<<<<< added, stop here now!
   end if

   '<<<<<<<< progress report: added by B+ to see what is happening to array
   if counter mod 100000 = 0 then
       call Update
       'call Pause 1000 '<<<< don't need for longer periods of calculations
   end if
   '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< Progress report brought to you by B+

   for i = 0 to 7 ''knights move
       nx = x + ax( i )
       ny = y + ay( i )
       if save( nx , ny ) then
           q( nx , ny ) = move
           if solve( nx , ny , move + 1 ) then
               solve = 1
               exit function  '<<<<<<<<<<<<<<<<<<<<<<<<<<< added, stop here now!
           else
               q( nx , ny ) = -1  '>> set back to empty, hmm... is this that back track?
           end if
       end if
   next i
   solve = 0
end function

'<<<  for showing and checking progress, moved from showing solution at end to this sub PLUS...
sub Update
   cls           '<<< added
   print counter '<<< added
   print         '<<< added

   '>>> bluatigro's display method
   for j = 0 to n - 1
       for i = 0 to n - 1
           print right$( "   " + str$( q( i , j ) ) , 3 ) ;
       next i
       print
   next j
end sub

'<<< here is one of the handiest subs in all JB!!! brought to you by B+ tsh73
sub Pause mil   '<<< tsh version has scan built-in
   t0 = time$("ms")
   while time$("ms") < t0 + mil : scan : wend
end sub


And a snap of the solution:


Same amount of calls and took about the same amount of time (hard to tell because I was using browser while it was processing so it seemed way longer).