# Oxygen Basic

## Programming => Example Code => Topic started by: Arnold on August 07, 2019, 10:53:46 PM

Title: Backtracking in Oxygenbasic
Post by: Arnold on August 07, 2019, 10:53:46 PM
Hi Charles,

for a small project I will need backtracking and for experimenting I found the nQueens task in Rosetta Code. This is an interesting problem, because there is no formula to determine the exact number of solutions. I applied recursive backtracking. I also added an option to show only the first and last solution of the task. And here is my question:

I tried in function try() to assign the values of array col_in_row to array indexes (indexes[] = col_in_row[]). This did not work for me and I used the copy function instead (line 49). Is there a better alternative or is there a way to apply indexes[] = col_in_row[] also?

The app works quite nice. Perhaps there are some places in the code where the speed of the app could be increased by using assembler statements? I know that it is impossibe to beat the record of n=27, but it will already take some time for n=16 to find the 14.772.512 solutions.

Roland

Code: [Select]
`\$ filename "nQueens.exe"'uses rtl32'uses rtl64uses console! GetTickCount lib "kernel32.dll"int doprintint solutionint size_of_boarddouble t1, t2string anssys *indexsub printBoard(int col_in_row[], int size_of_board, solution)    int x, row, col    printl "Solution: " + solution    printl "   "        for x = 1 to size_of_board : print chr(x+96) + " " : next x    for row = 1 to size_of_board        if row < 10 then printl row + "  " else printl row + " "         for col = 1 to size_of_board            if col_in_row[col] = row then print "Q " else print "- "        next col    next row    printlend subfunction is_free(int col_in_row[], test_row,  current_row) as int=================================================================  int i  for i = 1 to current_row-1    if col_in_row[i] = test_row      return 0  'beat queen in the vertical    endif    if abs(col_in_row[i]-test_row) = abs(i-current_row)      return 0  'beat queen in the diagonal    endif  next i  return 1end function' place queen in current rowsub try(int col_in_row[], int current_row)    int test_row    if current_row > size_of_board then        solution += 1 : if doprint = 0 then copy &index, &col_in_row[], size_of_board*sizeof(int)        if solution = 1 then printBoard(col_in_row[], size_of_board, solution)        if solution > 1 and doprint then printBoard(col_in_row[], size_of_board, solution)    else        for test_row = 1 to size_of_board            if is_free(col_in_row[], test_row, current_row) then                col_in_row[current_row] = test_row                try(col_in_row[], current_row+1)            end if        next test_row    end ifend subsub main()loop1:    redim int col_in_row(0)    redim int indexes(0)    solution = 0    cls     print "Size of Board (1-16)? " : size_of_board = val(input())    if size_of_board < 1 then size_of_board = 1    if size_of_board > 16 then size_of_board = 16    print  "Your input = " size_of_board    printl "Show all solutions - default is first and last? (Y/N): " : ans=ltrim rtrim(input)    if lcase(ans) = "y" then doprint = 1 else doprint = 0    redim int col_in_row(size_of_board)  'column of queen in row    redim int indexes(size_of_board)    @index = @indexes    t1=GetTickCount    try(col_in_row[], 1)    t2=GetTickCount    if doprint = 0 then printBoard(indexes[], size_of_board, solution)    printl : printl "Found " + solution + " Solutions, " + "used time: " + (t2-t1)/1000 + " seconds"    printl "Another Try? (Y/N) "    ans = ltrim rtrim(input())    if lcase(ans) = "y" then goto loop1end submain()`
Title: Re: Backtracking in Oxygenbasic
Post by: Charles Pegge on August 09, 2019, 01:11:14 AM
Thanks Roland,

copy is an efficient way to transfer data. It is used internally for many tasks.

Minor correction needed in function is_free so that the indexing starts from 1

Code: [Select]
`function is_free(byval int col_in_row[], int test_row, int current_row) as int    int i    for i = 1 to current_row-1        if col_in_row[i-1] = test_row or                                 'beat queen in the vertical            abs(col_in_row[i]-test_row) = abs(i-current_row) then    'beat queen in the diagonal            return 0        end if    next i    return 1end function`
This is a speed optimised version, with de-compunded logic, direct arrays, and bytewise table output:

Code: [Select]
`\$ filename "nQueens.exe"'uses rtl32'uses rtl64uses console! GetTickCount lib "kernel32.dll"int doprintint solutionint size_of_boarddouble t1, t2string ansint *indexsub printBoard(int col_in_row[], size_of_board, solution)=========================================================  int x, row, col  printl "Solution: " + solution + cr'/*  int m,k  string pr  pr = space( (size_of_board+1) * (size_of_board*2+3+2) +2 )  byte *b   @b = strptr(pr)+3  k = 97  for x = 1 to size_of_board    b=k : k+=1 : @b+=2 'a b c d e etc  ...    next  for row = 1 to size_of_board    b=13 : @b++ 'cr    b=10 : @b++ 'lf    m=32    if row < 10      b=row+48  : @b+=3 'units digit    else      m=row\10      k=row-(m*10)      b=m+48 : @b++  'tens digit      b=k+48 : @b+=2 'units digit    endif    for col = 1 to size_of_board      if col_in_row[col] = row        b=0x51 'Q      else        b=45 '-      endif      @b += 2    next col  next row  b=13 : @b++  b=10 : @b++  print pr'*//*  print "   "  for x = 1 to size_of_board    print chr(x+96) + " "  next x  for row = 1 to size_of_board    if row < 10      printl row + "  "    else      printl row + " "    endif    for col = 1 to size_of_board      if col_in_row[col] = row        print "Q "      else        print "- "      endif    next col  next row  printl*/end subfunction is_free(int col_in_row[], test_row,  current_row) as int=================================================================  int i  for i = 1 to current_row-1    if col_in_row[i] = test_row      return 0  'beat queen in the vertical    endif    if abs(col_in_row[i]-test_row) = abs(i-current_row)      return 0  'beat queen in the diagonal    endif  next i  return 1end function' place queen in current rowsub try(int col_in_row[], current_row)======================================  int test_row  if current_row > size_of_board    solution += 1    if doprint = 0      copy &index, &col_in_row[], size_of_board*sizeof(int)    endif    if solution = 1      printBoard(col_in_row[], size_of_board, solution)    endif    if solution > 1 and doprint      printBoard(col_in_row[], size_of_board, solution)    endif     else    for test_row = 1 to size_of_board      if is_free(col_in_row[], test_row, current_row)        col_in_row[current_row] = test_row        try(col_in_row[], current_row+1)      endif    next test_row  endifend subsub main()==========  '  loop1:  '  'redim int col_in_row(0)  'redim int indexes(0)  dim int col_in_row(20)  dim int indexes(20)  solution = 0  '  cls  print "Size of Board (1-16)? " : size_of_board = val(input())  '  if size_of_board < 1    size_of_board = 1  endif  if size_of_board > 16    size_of_board = 16  endif  '  print  "Your input = " size_of_board  printl "Show all solutions - default is first and last? (Y/N): " : ans=ltrim rtrim(input)  '  if lcase(ans) = "y"    doprint = 1  else    doprint = 0  endif  'redim int col_in_row(size_of_board)  'column of queen in row  'redim int indexes(size_of_board)  @index = @indexes  '  t1=GetTickCount  try(col_in_row[], 1)  t2=GetTickCount  '  if doprint = 0    printBoard(indexes[], size_of_board, solution)  endif  printl : printl "Found " + solution + " Solutions, " + "used time: " + (t2-t1)/1000 + " seconds"  '  printl "Another Try? (Y/N) "  ans = ltrim rtrim(input())  if lcase(ans) = "y"    goto loop1  endifend submain()`
Title: Re: Backtracking in Oxygenbasic
Post by: Arnold on August 09, 2019, 06:55:32 AM
Hi Charles,

thank you for the fix. I had to change also this line to:

Code: [Select]
`           if col_in_row[i] = test_row or `
Your code runs about 33% faster than mine. I noticed that you separated the statements for the conditions in function is_free and applied your solution in my code. To my surprise I get similar results now for n=16 (475 seconds instead of 700 seconds). I simply did not expect such a gain of time saving by only adjusting some statements. That was an educational experience for me again.

I replaced the code of my first message in case somebody would like to try the puzzle. And I found much information here:

https://en.wikipedia.org/wiki/Eight_queens_puzzle

Roland

Title: Re: Backtracking in Oxygenbasic
Post by: Charles Pegge on August 09, 2019, 10:36:34 AM
You can squeeze a little more performance by in-lining the is_free procedure, within try.
Title: Re: Backtracking in Oxygenbasic
Post by: Charles Pegge on August 10, 2019, 12:40:48 AM
After inlining is_free, it can be converted into Assembler. This further improves the speed, so a 14*14 originally taking 24 seconds, now takes about 9 seconds.

Code: [Select]
`    for test_row = 1 to size_of_board      '      'is_free      'int i,k      'for i = 1 to current_row-1        'k=col_in_row[i]        'if k = test_row        '  jmp fwd nxt_test_row  'beat queen in the vertical        'endif        'if abs(k-test_row) = abs(i-current_row)        '  jmp fwd nxt_test_row  'beat queen in the diagonal        'endif      'next i      int i      mov ecx,current_row      addr rdi,col_in_row      mov dword i,1      (        dec ecx        jle fwd exit        mov eax,[rdi] 'k col_in_row        cmp eax,test_row        jz fwd nxt_test_row        sub eax,test_row        (         jge exit         neg eax        )        mov edx,i        sub edx,current_row        (         jge exit         neg edx        )        cmp eax,edx        jz fwd nxt_test_row        add rdi,4        inc dword i        repeat      )      '      col_in_row[current_row] = test_row      try(col_in_row[], current_row+1)      '      nxt_test_row:            '    next test_row`
complete code
Code: [Select]
`\$ filename "nQueens.exe"'uses rtl32'uses rtl64uses console! GetTickCount lib "kernel32.dll"int doprintint solutionint size_of_boarddouble t1, t2string ansint *indexsub printBoard(int col_in_row[], size_of_board, solution)=========================================================  int x, row, col  printl "Solution: " + solution + cr'/*  int m,k  string pr  pr = space( (size_of_board+1) * (size_of_board*2+3+2) +2 )  byte *b   @b = strptr(pr)+3  k = 97  for x = 1 to size_of_board    b=k : k+=1 : @b+=2 'a b c d e etc  ...    next  for row = 1 to size_of_board    b=13 : @b++ 'cr    b=10 : @b++ 'lf    m=32    if row < 10      b=row+48  : @b+=3 'units digit    else      m=row\10      k=row-(m*10)      b=m+48 : @b++  'tens digit      b=k+48 : @b+=2 'units digit    endif    for col = 1 to size_of_board      if col_in_row[col] = row        b=0x51 'Q      else        b=45 '-      endif      @b += 2    next col  next row  b=13 : @b++  b=10 : @b++  print pr'*//*  print "   "  for x = 1 to size_of_board    print chr(x+96) + " "  next x  for row = 1 to size_of_board    if row < 10      printl row + "  "    else      printl row + " "    endif    for col = 1 to size_of_board      if col_in_row[col] = row        print "Q "      else        print "- "      endif    next col  next row  printl*/end sub' place queen in current rowsub try(int col_in_row[], current_row)======================================  int test_row  if current_row > size_of_board    solution += 1    if doprint = 0      copy &index, &col_in_row[], size_of_board*sizeof(int)    endif    if solution = 1      printBoard(col_in_row[], size_of_board, solution)    endif    if solution > 1 and doprint      printBoard(col_in_row[], size_of_board, solution)    endif     else    for test_row = 1 to size_of_board      '      'is_free      'int i,k      'for i = 1 to current_row-1        'k=col_in_row[i]        'if k = test_row        '  jmp fwd nxt_test_row  'beat queen in the vertical        'endif        'if abs(k-test_row) = abs(i-current_row)        '  jmp fwd nxt_test_row  'beat queen in the diagonal        'endif      'next i      int i      mov ecx,current_row      addr rdi,col_in_row      mov dword i,1      (        dec ecx        jle fwd exit        mov eax,[rdi] 'k col_in_row        cmp eax,test_row        jz fwd nxt_test_row        sub eax,test_row        (         jge exit         neg eax        )        mov edx,i        sub edx,current_row        (         jge exit         neg edx        )        cmp eax,edx        jz fwd nxt_test_row        add rdi,4        inc dword i        repeat      )      '      col_in_row[current_row] = test_row      try(col_in_row[], current_row+1)      '      nxt_test_row:            '    next test_row  endifend subsub main()==========  '  loop1:  '  'redim int col_in_row(0)  'redim int indexes(0)  dim int col_in_row(20)  dim int indexes(20)  solution = 0  '  cls  print "Size of Board (1-16)? " : size_of_board = val(input())  '  if size_of_board < 1    size_of_board = 1  endif  if size_of_board > 16    size_of_board = 16  endif  '  print  "Your input = " size_of_board  printl "Show all solutions - default is first and last? (Y/N): " : ans=ltrim rtrim(input)  '  if lcase(ans) = "y"    doprint = 1  else    doprint = 0  endif  'redim int col_in_row(size_of_board)  'column of queen in row  'redim int indexes(size_of_board)  @index = @indexes  '  t1=GetTickCount  try(col_in_row[], 1)  t2=GetTickCount  '  if doprint = 0    printBoard(indexes[], size_of_board, solution)  endif  printl : printl "Found " + solution + " Solutions, " + "used time: " + (t2-t1)/1000 + " seconds"  '  printl "Another Try? (Y/N) "  ans = ltrim rtrim(input())  if lcase(ans) = "y"    goto loop1  endifend submain()`
Title: Re: Backtracking in Oxygenbasic
Post by: Arnold on August 10, 2019, 10:48:35 PM
Hi Charles,

I get a similar time saving. With me n=14 now takes about 6 seconds. n=16 will take about 285 seconds instead of 700 seconds. And I could not resist and tried n=17. This takes about 2250 seconds, which is about 38 minutes. Your assembly routines in function try() to integrate is_free() function are very instructive and maybe can be used in similar situations.

For me it is amazing what can be done with the (simple?) computers nowadays: play a game of chess or drMario and calculate a problem additionally. In 1969 using punch cards and Fortran, they were happy to find out the solution for n=12. Nevertheless, they flew to the moon. If things continue this way, maybe someday some people will indeed land on Mars.

Roland
Title: Re: Backtracking in Oxygenbasic
Post by: Aurel on August 11, 2019, 05:54:55 AM
input 8
95 solutions
take 0.25 sec

is that ok for my old dual core pentium  ;D
( i must say that i don't like those console progs.. )  ::)

also i am able to compile old AsciEdit with this new version.
So i must try my latest AurelEdit with awinh037..i hope that should work.

Charles
Is this new version selfcompiled version of o2?
or is still compiled with FreeBasic?

all best
Aurel
Title: Re: Backtracking in Oxygenbasic
Post by: Charles Pegge on August 13, 2019, 03:06:33 AM
Hi Aurel,

The o2 releases are self-compiled. FB-based o2 is no longer maintained.
Title: Re: Backtracking in Oxygenbasic
Post by: Aurel on August 13, 2019, 11:58:01 AM
Thank you Charles !
good to know
currently i don't have time to testing some things but i will  :D
Title: Re: Backtracking example (Sudoku)
Post by: Arnold on August 15, 2019, 02:52:13 AM
Hello,

here is a solver for Sudoku puzzles (9x9 grid). The app uses simple brute force recursive backtracking (many for/next loops) without any special optimization methods. The only action I took was to check if rotating the grid could be approprate. The app will load a puzzle as text file. It checks the puzzle for correct entries. If more solutions should be possible, only the first solution will be shown.

Brute force is not the best method to solve Sudoku puzzles, nevertheless the app will solve a lot of puzzles very fast. In the attached zip file I included the code of the program and 20 puzzles, which I find interesting. s4.txt and s5.txt are very difficult, they take about 20 seconds on my system. s15.txt is almost impossible to solve manually, it takes about 3 minutes on my system to solve it. The puzzles s9.txt, s17.txt and s19.txt cannot be solved, although there are no duplicate numbers horicontally, vertically or in a box. So the app can also be used to check if a Sudoku puzzle is valid.

Roland

Code: (o2) [Select]
`  \$ filename "sudoku.exe"  'uses rtl32  'uses rtl64  uses corewin  uses console  type CONSOLE_CURSOR_INFO ' cci    dword dwSize    bool  bVisible  end type  sub setcolor(int fg, bg)    SetConsoleTextAttribute (ConsOut, fg+bg*16)  end sub  sub locate(int row,int col, optional int cursor_visible=0,int shape=12)    CONSOLE_CURSOR_INFO cci    SetPos(col-1,row-1)    cci.bVisible = cursor_visible    cci.dwSize   = shape    SetConsoleCursorInfo(ConsOut, cci)  end sub  sub display(int col, row, string txt, optional int cursor_visible=0,int shape=12)    locate(row, col, cursor_visible, shape)    print txt  end sub  function replace(string t,w,r) as string    'parseutil.inc  ========================================    '    sys a,b,lw,lr    string s=t    '    lw=len(w)    lr=len(r)    a=1    do      a=instr(a,s,w)      if a=0 then exit do      s=left(s,a-1)+r+mid(s,a+lw)      a+=lr    end do    return s  end function  redim int sudoku(9*9)  ' use sudoku as 2d array with index 1  macro array2d_sudoku(x,y) sudoku(((y)-1)*9+(x))  redim int tmpArray(9*9)  double t1, t2  int maxval  int CheckNotify  int count  function loadSudoku()    string fname, s    string lf=chr(10)    int x    cls    print "Solving Sudoku (9x9) using Recursive Backtracking"    printl "Filename to load? " : fname = input()    fname = rtrim ltrim fname    getfile(fname, s)    if len(s)=0 then print "Error: does not exist or cannot read file: " + fname : return 0    'simple check for /* comment at the beginning    int pos=instr(s,"*/")    if pos then s=mid(s,pos+2)    s=replace(s,cr, "") : s=replace(s,lf,"") : s=replace(s,tab,"")    s=replace(s,chr(32), "") : s=replace(s,",","") : s=replace(s,".","")    for x=1 to 81 : sudoku[x]=mid(s,x,1) : next x    print "Sudoku loaded"    return 1  end sub  sub checkForRotate()    string z1,z2,z3,z4    int ix,n    ' No change?    for ix = 1 to 9 : z1 += sudoku[ix]: next ix : maxval = 1    ' Rotate Grid 180?    for ix = 81 to 73 step -1 : z2 += sudoku[ix]: next ix : if val(z2) > val(z1) then maxval = 2  end sub  sub rotate()    int ix, n, r,c    if maxval > 1 then      printl : printl "Rotate grid 180 degrees"      n = 81      for ix = 1 to 81 : tmpArray[ix] = sudoku[n] : n -= 1 : next ix      for ix = 1 to 81 : sudoku[ix] = tmpArray[ix] : next ix    end if  end sub  sub printSudoku(int sudoku[], int x, y)    int row, col, x1    string index = "    1 2 3  4 5 6  7 8 9"    string underline = "  ----------------------"    string vertLine = "|"    display(x,y, index)    y += 1    display(x,y, underline)    for row = 1 to 9      display(x, y+row, row ) : display(x+2, y+row, vertline)      x1 = x + 2      for col = 1 to 9        if sudoku[(row-1 )*9 + col] = 0 then          display(x1+col, y+row, "  ")        else          display(x1+col, y+row, " " + sudoku[(row-1)*9 + col])        end if        if col = 3 or col = 6 or col = 9 then x1 = x1 + 2 : display(x1+col, y+row, "!" ) : x1 -= 1        x1 = x1 + 1      next col      if row = 3 or row = 6 or row = 9 then y += 1 : display(x, y+row, underline)    next row  end sub  function testSudoku() as int    ' test columns vertically    int col, row, testrow    for col = 1 to 9      for row = 1 to 9        'if array2d_sudoku(col, row) != 0 then        if sudoku((row-1)*9 + col) != 0 then          for testrow = row+1 to 9            'if array2d_sudoku(col, row) = array2d_sudoku(col, testrow) then            if sudoku((row-1)*9 + col) = sudoku((testrow-1)*9 + col)              if CheckNotify = true then                printl "Error: Col " + col + ", Row "+ row" = " + array2d_sudoku(col, row) +                       " and Col " + col  + ", Row " + testrow" = " + array2d_sudoku(col, testrow) + cr                CheckNotify = false              end if              return 0            end if          next testrow        end if      next row    next next col    ' test columns in row    int testcol    for row = 1 to 9      for col = 1 to 9        'if array2d_sudoku(col, row) != 0 then        if sudoku((row-1)*9 + col) != 0 then          for testcol = col+1 to 9            'if array2d_sudoku(col, row) = array2d_sudoku(testcol, row) then            if sudoku((row-1)*9 + col) = sudoku((row-1)*9 + testcol)              if CheckNotify = true then                printl "Error: Row " + row + ", Col " + col + " = " + array2d_sudoku(col, row) +                       " and Row " + row + ", Col " + testcol + " = " + array2d_sudoku(testcol, row) + cr                CheckNotify = false              end if              return 0            end if          next testcol        end if      next col    next row    ' test boxes    int BoxX, BoxY, Col_inBox, Row_inBox, TestCol_inBox, TestRow_inBox    int expr1, expr2    for BoxX = 1 to 3      for BoxY = 1 to 3        for Col_inBox = 1 to 3          for Row_inBox = 1 to 3            'expr1 = array2d_sudoku(3*(BoxX-1) + Col_inBox, 3*(BoxY-1) + Row_inBox)            expr1 = sudoku(((3*(BoxY-1) + Row_inBox)-1)*9 + 3*(BoxX-1) + Col_inBox)            if expr1 != 0 then              for TestCol_inBox = 1 to 3                for TestRow_inBox = 1 to 3                  'expr2 = array2d_sudoku(3*(BoxX-1) + TestCol_inBox, 3*(BoxY-1) + TestRow_inBox)                  expr2 = sudoku(((3*(BoxY-1) + TestRow_inBox)-1)*9 + 3*(BoxX-1) + TestCol_inBox)                  if expr1 = expr2 and (Col_inBox != TestCol_inBox or Row_inBox != TestRow_inBox) then                    if CheckNotify = true then                      printl "Error: Box h,v: " + BoxX + ", " + BoxY + " -- Col:Row " + Col_inBox + ":" + Row_inBox +                             " = Col:Row " + TestCol_inBox + ":" + TestRow_inBox + " (" + expr1 + ")" + cr                      CheckNotify = false                    end if                    return 0                  end if                next TestRow_inBox              next TestCol_inBox            end if          next Row_inBox        next Col_inBox      next BoxY    next BoxX    return 1  end function  function solve() as int    ' recursive brute-force method    ' check if Sudoku is correct    count += 1    if testSudoku() = 0 then return 0    'test next free position    int col, row, testnum    for col = 1 to 9      for row = 1 to 9        'if array2d_sudoku(col, row) = 0 then        if sudoku((row-1)*9 + col) = 0 then          for testnum = 1 to 9            'array2d_sudoku(col, row) = testnum            sudoku((row-1)*9 + col) = testnum            if solve() = true then return true          next testnum          'does not fit          'array2d_sudoku(col,row) = 0          sudoku((row-1)*9 + col) = 0          return false        end if      next row    next col    return true  end function  sub main()    string ansloop1:    setcolor(7, 0)    if not loadSudoku() then goto loop2    printSudoku(sudoku[], 5,5)    CheckNotify = true    if testSudoku() then      printl : printl "Solving ..."      count = 0      if CheckNotify = true then CheckNotify = false      t1 = GetTickCount      checkForRotate()      rotate()      setcolor(11, 0)      if maxval > 1 then printSudoku(sudoku[], 40,5)      if solve() = false then printl : printl "Solution not possible" : goto loop2      setcolor(7, 0)      rotate()      t2 = GetTickCount      printSudoku(sudoku[], 40,5)      printl : printl  "Elapsed time: " + (t2-t1)/1000 + " seconds"      printl "Recursive calls: " + count + "   "    end ifloop2:    printl "Load another file? (Y/N) " : ans = ltrim rtrim(input())    if lcase(ans) = "y" then goto loop1  end sub  main()`
Title: Re: Backtracking in Oxygenbasic
Post by: Charles Pegge on August 15, 2019, 06:09:18 AM
Many thanks, Roland,

I'll include this in version 0.2.7 in projectsB\Console\