QB64.org Forum

Active Forums => Programs => Topic started by: AndyA on April 13, 2021, 10:56:55 pm

Title: Knight's Tour (Rosetta Code task)
Post by: AndyA on April 13, 2021, 10:56:55 pm

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

Title: Re: Knight's Tour (Rosetta Code task)
Post by: bplus 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.

Text Only | Text with Attachments