Author Topic: Knight's Tour (Rosetta Code task)  (Read 3015 times)

0 Members and 1 Guest are viewing this topic.

Offline AndyA

  • Newbie
  • Posts: 73
    • View Profile
Knight's Tour (Rosetta Code task)
« on: April 13, 2021, 10:56:55 pm »
https://rosettacode.org/wiki/Knight%27s_tour

'==================================================
Task
Problem: you have a standard 8x8 chessboard, empty but for a single knight on some square. Your task is to emit a series of legal knight moves that result in the knight visiting every square on the chessboard exactly once. Note that it is not a requirement that the tour be "closed"; that is, the knight need not end within a single move of its start position.

Input and output may be textual or graphical, according to the conventions of the programming environment. If textual, squares should be indicated in algebraic notation. The output should indicate the order in which the knight visits the squares, starting with the initial position. The form of the output may be a diagram of the board with the squares numbered according to visitation sequence, or a textual list of algebraic coordinates in order, or even an actual animation of the knight moving around the chessboard.

Input: starting square

Output: move sequence
'==================================================

Code: QB64: [Select]
  1. _Title "Knight's Tour"
  2.  
  3. Dim Shared As Integer sw, sh, size, xc, yc, nm
  4. Dim As Integer f, qm, nmov, n, x, y
  5. n = 0
  6. Dim As String startPos
  7. sw = 640: sh = 480
  8.  
  9. Input "Table Size (5-9):  ", size 'can be larger, but move numbers will over lap badly
  10. Input "Start Square (column/row eg. d5):  ", startPos
  11.  
  12. x = Asc(UCase$(Mid$(startPos, 1, 1))) - 64
  13. y = (size + 1) - Val(Mid$(startPos, 2, 1))
  14.  
  15.  
  16. Dim Shared As Integer board(size, size), dx(8), dy(8)
  17.  
  18.  
  19. For f = 1 To 8
  20.     Read dx(f), dy(f)
  21. Data 2,1,1,2,-1,2,-2,1,-2,-1,-1,-2,1,-2,2,-1
  22.  
  23.  
  24. Color 15, 1 'Draw the board
  25. For f = 1 To size
  26.     Locate 15 - size, 3 * f
  27.     Print "  "; Chr$(64 + f); " ";
  28.     Locate 17 - f, 3 * (size + 1) + 1
  29.     Print Using "##"; (size - f) + 1;
  30.  
  31.     n = n + 1
  32.     If n And 1 Then Color 0, 15 Else Color 15, 1
  33.     board(x, y) = n
  34.     Locate 17 - y, 3 * x: Print Using "###"; n;
  35.     If n = size * size Then Exit Do
  36.     nmov = 100
  37.     For f = 1 To 8
  38.         xc = x + dx(f)
  39.         yc = y + dy(f)
  40.         Call FindMoves
  41.         If nm < nmov Then nmov = nm: qm = f
  42.     Next f
  43.     x = x + dx(qm)
  44.     y = y + dy(qm)
  45.     _Limit 8 '<---- draw speed (higher is faster)
  46. Color 14, 0: Locate CsrLin + size, 1
  47. Print " Press any key to exit..."
  48.  
  49. Sub FindMoves
  50.     Dim As Integer i, xt, yt
  51.     If xc < 1 Or yc < 1 Or xc > size Or yc > size Then nm = 1000: Exit Sub
  52.     If board(xc, yc) Then nm = 2000: Exit Sub
  53.     nm = 0
  54.     For i = 1 To 8
  55.         xt = xc + dx(i)
  56.         yt = yc + dy(i)
  57.         If xt < 1 Or yt < 1 Or xt > size Or yt > size Then 'Skip this move
  58.         ElseIf board(xt, yt) Then 'Skip this move
  59.         Else
  60.             nm = nm + 1
  61.         End If
  62.     Next
  63.  
  64.  
  65. 'Output:
  66. 'QB64 - Knights Tour
  67. '
  68. 'Board Size:  8
  69. 'Start Position: c6
  70. '
  71. '
  72. '  A  B  C  D  E  F  G  H
  73. '
  74. ' 24 11 22 19 26  9 38 47  1
  75. ' 21 18 25 10 39 48 27  8  2
  76. ' 12 23 20 53 28 37 46 49  3
  77. ' 17 52 29 40 59 50  7 36  4
  78. ' 30 13 58 51 54 41 62 45  5
  79. ' 57 16  1 42 63 60 35  6  6
  80. '  2 31 14 55  4 33 44 61  7
  81. ' 15 56  3 32 43 64  5 34  8


Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Knight's Tour (Rosetta Code task)
« Reply #1 on: April 14, 2021, 01:33:07 pm »
This one looks good! very fast and looks elegant compared to my effort. Plus start from any square? nice.