# Solve a Holy Knight's tour

Solve a Holy Knight's tour
You are encouraged to solve this task according to the task description, using any language you may know.

Chess coaches have been known to inflict a kind of torture on beginners by taking a chess board, placing some pennies on some squares and requiring that a Knight's tour that avoids squares with pennies be constructed.

This kind of knight's tour puzzle is similar to Hidato.

The present task is to produce a solution to such problems. At least demonstrate your program by solving the following:

Example 1
```  0 0 0
0   0 0
0 0 0 0 0 0 0
0 0 0     0   0
0   0     0 0 0
1 0 0 0 0 0 0
0 0   0
0 0 0
```

Extra credit is available for other interesting examples.

## Contents

This solution uses the package Knights_Tour from Knight's Tour#Ada. The board is quadratic, the size of the board is read from the command line and the board itself is read from the standard input. For the board itself, Space and Minus indicate a no-go (i.e., a coin on the board), all other characters represent places the knight must visit. A '1' represents the start point. Ill-formatted input will crash the program.

`with Knights_Tour, Ada.Text_IO, Ada.Command_Line; procedure Holy_Knight is    Size: Positive := Positive'Value(Ada.Command_Line.Argument(1));   package KT is new Knights_Tour(Size => Size);   Board: KT.Tour := (others => (others => Natural'Last));    Start_X, Start_Y: KT.Index:= 1; -- default start place (1,1)   S: String(KT.Index);   I: Positive := KT.Index'First;begin   -- read the board from standard input   while not Ada.Text_IO.End_Of_File and I <= Size loop      S := Ada.Text_IO.Get_Line;       for J in KT.Index loop         if S(J) = ' ' or S(J) = '-' then            Board(I,J) := Natural'Last;         elsif S(J) = '1' then               Start_X := I; Start_Y := J;  Board(I,J) := 1;         else Board(I,J) := 0;         end if;      end loop;      I := I + 1;   end loop;    -- print the board   Ada.Text_IO.Put_Line("Start Configuration (Length:"                           & Natural'Image(KT.Count_Moves(Board)) & "):");   KT.Tour_IO(Board, Width => 1);   Ada.Text_IO.New_Line;    -- search for the tour and print it   Ada.Text_IO.Put_Line("Tour:");   KT.Tour_IO(KT.Warnsdorff_Get_Tour(Start_X, Start_Y, Board));end Holy_Knight;`
Output:
```>holy_knight 8 < standard_problem.txt
Start Configuration (Length: 36):
--000---
--0-00--
-0000000
000--0-0
0-0--000
1000000-
--00-0--
---000--

Tour:
-   -  30  15  20   -   -   -
-   -  21   -  29  16   -   -
-  33  14  31  22  19   6  17
13  36  23   -   -  28   -   8
34   -  32   -   -   7  18   5
1  12  35  24  27   4   9   -
-   -   2  11   -  25   -   -
-   -   -  26   3  10   -   -```

###  Extra Credit

The Holy_Knight program can immediately be used to tackle "more interesting" problems, such as those from New Knight's Tour Puzzles and Graphs. Here is one sample solution:

```>holy_knight 13 < problem10.txt
Start Configuration (Length: 56):
-----1-0-----
-----0-0-----
----00000----
-----000-----
--0--0-0--0--
00000---00000
--00-----00--
00000---00000
--0--0-0--0--
-----000-----
----00000----
-----0-0-----
-----0-0-----

Tour:
-   -   -   -   -   1   -  27   -   -   -   -   -
-   -   -   -   -  56   -   2   -   -   -   -   -
-   -   -   -  24   3  28  55  26   -   -   -   -
-   -   -   -   -  54  25   4   -   -   -   -   -
-   -  50   -   -  23   -  29   -   -   6   -   -
51  20  47  22  53   -   -   -   5  30   9  32   7
-   -  52  49   -   -   -   -   -  33  36   -   -
19  48  21  46  17   -   -   -  37  10  31   8  35
-   -  18   -   -  45   -  11   -   -  34   -   -
-   -   -   -   -  16  41  38   -   -   -   -   -
-   -   -   -  42  39  44  15  12   -   -   -   -
-   -   -   -   -  14   -  40   -   -   -   -   -
-   -   -   -   -  43   -  13   -   -   -   -   -```

## Bracmat

This solution can handle different input formats: the widths of the first and the other columns are computed. The cell were to start from should have a unique value, but this value is not prescribed. Non-empty cells (such as the start cell) should contain a character that is different from '-', '.' or white space. The puzzle solver itself is only a few lines long.

`( ( Holy-Knight  =     begin colWidth crumbs non-empty pairs path parseLine      , display isolateStartCell minDistance numberElementsAndSort      , parseBoard reverseList rightAlign solve strlen    .   "'non-empty' is a pattern that is used several times in bigger patterns."      & ( non-empty        =         =   %@          : ~( "."             | "-"             | " "             | \t             | \r             | \n             )        )      & ( reverseList        =   a L          .   :?L            & whl'(!arg:%?a ?arg&!a !L:?L)            & !L        )      & (strlen=e.@(!arg:? [?e)&!e)      & ( rightAlign        =   string width          .   !arg:(?width,?string)            & !width+-1*strlen\$!string:?width            &   whl              ' ( !width+-1:~<0:?width                & " " !string:?string                )            & str\$!string        )      & ( minDistance        =   board pat1 pat2 minWidth pos1 pos2 pattern          .   !arg:(?board,(=?pat1),(=?pat2))            & -1:?minWidth            & "Construct a pattern using a template.            The pattern finds the smallest distance between any two columns in the input.            Assumption: all columns have the same width and columns are separated by one or            more spaces. The function can also be used to find the width of the first column            by letting pat1 match a new line."            &                     ' ( ?                    (   \$pat1                        [?pos1                        (? " "|`)                        ()\$pat2                        [?pos2                        ?                    &   !pos2+-1*!pos1                      : ( <!minWidth                        | ?&!minWidth:<0                        )                      : ?minWidth                    & ~                    )                  )              : (=?pattern)            & "'pattern', by design, always fails. The interesting part is a side effect:                the column width."            & (@(!board:!pattern)|!minWidth)        )      & ( numberElementsAndSort        =   a sum n          .   0:?sum:?n            & "An evaluated sum is always sorted. The terms are structured so the sorting               order is by row and then by column (both part of 'a')."            &   whl              ' ( !arg:%?a ?arg                & 1+!n:?n                & (!a,!n)+!sum:?sum                )            & "return the sorted list (sum) and also the size of a field that can contain               the highest number."            & (!sum.strlen\$!n+1)        )      & ( parseLine        =     line row columnWidth width col            , bins val A M Z cell validPat          .   !arg:(?line,?row,?width,?columnWidth,?bins)            & 0:?col            & "Find the cells and create a pair [row,col] for each. Put each pair in a bin.               There are as many bins as there are different values in cells."            &   '(? (\$!non-empty:?val) ?)              : (=?validPat)            &   whl              ' ( @(!line:?cell [!width ?line)                & (   @(!cell:!validPat)                    &   (   !bins:?A (!val.?M) ?Z                          & !A (!val.(!row.!col) !M) !Z                        | (!val.!row.!col) !bins                        )                      : ?bins                  |                   )                & !columnWidth:?width                & 1+!col:?col                )            & !bins        )      & ( parseBoard        =   board firstColumnWidth columnWidth,row bins line          .   !arg:?board            &   (   minDistance                  \$ (str\$(\r \n !arg),(=\n),!non-empty)                , minDistance\$(!arg,!non-empty,!non-empty)                )              : (?firstColumnWidth,?columnWidth)            & 0:?row            & :?bins            &   whl              ' ( @(!board:?line \n ?board)                &     parseLine                    \$ (!line,!row,!firstColumnWidth,!columnWidth,!bins)                  : ?bins                & (!bins:|1+!row:?row)                )            &     parseLine                \$ (!board,!row,!firstColumnWidth,!columnWidth,!bins)              : ?bins        )      & "Find the first bin with only one pair. Return this pair and the combined pairs in         all remaining bins."      & ( isolateStartCell        =   A begin Z valuedPairs pairs          .   !arg:?A (?.? [1:?begin) ?Z            & !A !Z:?arg            & :?pairs            &   whl              ' ( !arg:(?.?valuedPairs) ?arg                & !valuedPairs !pairs:?pairs                )            & (!begin.!pairs)        )      & ( display        =   board solution row col x y n colWidth          .   !arg:(?board,?solution,?colWidth)            & out\$!board            & 0:?row            & -1:?col            &   whl              ' ( !solution:((?y.?x),?n)+?solution                &   whl                  ' ( !row:<!y                    & 1+!row:?row                    & -1:?col                    & put\$\n                    )                &   whl                  ' ( 1+!col:?col:<!x                    & put\$(rightAlign\$(!colWidth,))                    )                & put\$(rightAlign\$(!colWidth,!n))                )            & put\$\n        )      & ( solve        =   A Z x y crumbs pairs X Y solution          .   !arg:((?y.?x),?crumbs,?pairs)            & ( !pairs:&(!y.!x) !crumbs              |     !pairs                  :   ?A                      ( (?Y.?X) ?Z                      &   (!x+-1*!X)*(!y+-1*!Y)                        : (2|-2)                      &     solve                          \$ ( (!Y.!X)                            , (!y.!x) !crumbs                            , !A !Z                            )                        : ?solution                      )                & !solution              )        )      & ( isolateStartCell\$(parseBoard\$!arg):(?begin.?pairs)        | out\$"Sorry, I cannot identify a start cell."&~        )      & solve\$(!begin,,!pairs):?crumbs      &   numberElementsAndSort\$(reverseList\$!crumbs)        : (?path.?colWidth)      & display\$(!arg,!path,!colWidth)  )&     "       0 0 0      0   0 0      0 0 0 0 0 0 0    0 0 0     0   0    0   0     0 0 0    1 0 0 0 0 0 0        0 0   0          0 0 0          "      "-----1-0----------0-0---------00000---------000-------0--0-0--0--00000---00000--00-----00--00000---00000--0--0-0--0-------000---------00000---------0-0----------0-0-----"  : ?boards& whl'(!boards:%?board ?boards&Holy-Knight\$!board)& done);`

Output:

```
0 0 0
0   0 0
0 0 0 0 0 0 0
0 0 0     0   0
0   0     0 0 0
1 0 0 0 0 0 0
0 0   0
0 0 0

21 30 19
36    22 29
31 20 35 18 23 28 25
15 34 17       26     8
32    14        9 24 27
1 16 33 10 13  4  7
2  5    11
12  3  6

-----1-0-----
-----0-0-----
----00000----
-----000-----
--0--0-0--0--
00000---00000
--00-----00--
00000---00000
--0--0-0--0--
-----000-----
----00000----
-----0-0-----
-----0-0-----
1    27
26    56
30 55  2 25 28
24 29 54
36       31     3       50
37 34 39 32 23          53  4 47  6 51
22 35                49 52
21 38 33 40 19           9 46  5 48  7
20       41    45        8
18 43 10
42 11 14 17 44
16    12
13    15```

## C++

` #include <vector>#include <sstream>#include <iostream>#include <iterator>#include <stdlib.h>#include <string.h> using namespace std; struct node{    int val;    unsigned char neighbors;}; class nSolver{public:    nSolver()    {	dx[0] = -1; dy[0] = -2; dx[1] = -1; dy[1] =  2;	dx[2] =  1; dy[2] = -2; dx[3] =  1; dy[3] =  2;	dx[4] = -2; dy[4] = -1; dx[5] = -2; dy[5] =  1; 	dx[6] =  2; dy[6] = -1; dx[7] =  2; dy[7] =  1;    }     void solve( vector<string>& puzz, int max_wid )    {	if( puzz.size() < 1 ) return;	wid = max_wid; hei = static_cast<int>( puzz.size() ) / wid;	int len = wid * hei, c = 0; max = len;	arr = new node[len]; memset( arr, 0, len * sizeof( node ) ); 	for( vector<string>::iterator i = puzz.begin(); i != puzz.end(); i++ )	{	    if( ( *i ) == "*" ) { max--; arr[c++].val = -1; continue; }	    arr[c].val = atoi( ( *i ).c_str() );	    c++;	} 	solveIt(); c = 0;	for( vector<string>::iterator i = puzz.begin(); i != puzz.end(); i++ )	{	    if( ( *i ) == "." )	    {		ostringstream o; o << arr[c].val;		( *i ) = o.str();	    }	    c++;	}	delete [] arr;    } private:    bool search( int x, int y, int w )    {	if( w > max ) return true; 	node* n = &arr[x + y * wid];	n->neighbors = getNeighbors( x, y ); 	for( int d = 0; d < 8; d++ )	{	    if( n->neighbors & ( 1 << d ) )	    {		int a = x + dx[d], b = y + dy[d];		if( arr[a + b * wid].val == 0 )		{		    arr[a + b * wid].val = w;		    if( search( a, b, w + 1 ) ) return true;		    arr[a + b * wid].val = 0;		}	    }	}	return false;    }     unsigned char getNeighbors( int x, int y )    {	unsigned char c = 0; int a, b;	for( int xx = 0; xx < 8; xx++ )	{	    a = x + dx[xx], b = y + dy[xx];	    if( a < 0 || b < 0 || a >= wid || b >= hei ) continue;	    if( arr[a + b * wid].val > -1 ) c |= ( 1 << xx );	}	return c;    }     void solveIt()    {	int x, y, z; findStart( x, y, z );	if( z == 99999 ) { cout << "\nCan't find start point!\n"; return; }	search( x, y, z + 1 );    }     void findStart( int& x, int& y, int& z )    {	z = 99999;	for( int b = 0; b < hei; b++ )	    for( int a = 0; a < wid; a++ )		if( arr[a + wid * b].val > 0 && arr[a + wid * b].val < z ) 		{ 		    x = a; y = b;		    z = arr[a + wid * b].val;		}     }     int wid, hei, max, dx[8], dy[8];    node* arr;}; int main( int argc, char* argv[] ){    int wid; string p;    //p = "* . . . * * * * * . * . . * * * * . . . . . . . . . . * * . * . . * . * * . . . 1 . . . . . . * * * . . * . * * * * * . . . * *"; wid = 8;    p = "* * * * * 1 * . * * * * * * * * * * . * . * * * * * * * * * . . . . . * * * * * * * * * . . . * * * * * * * . * * . * . * * . * * . . . . . * * * . . . . . * * . . * * * * * . . * * . . . . . * * * . . . . . * * . * * . * . * * . * * * * * * * . . . * * * * * * * * * . . . . . * * * * * * * * * . * . * * * * * * * * * * . * . * * * * * "; wid = 13;    istringstream iss( p ); vector<string> puzz;    copy( istream_iterator<string>( iss ), istream_iterator<string>(), back_inserter<vector<string> >( puzz ) );    nSolver s; s.solve( puzz, wid );    int c = 0;    for( vector<string>::iterator i = puzz.begin(); i != puzz.end(); i++ )    {	if( ( *i ) != "*" && ( *i ) != "." )	{	    if( atoi( ( *i ).c_str() ) < 10 ) cout << "0";	    cout << ( *i ) << " ";        }	else cout << "   ";	if( ++c >= wid ) { cout << endl; c = 0; }    }    cout << endl << endl;    return system( "pause" );} `
Output:
```   17 14 29
28    18 15
13 16 27 30 19 32 07
25 02 11       06    20
12    26       31 08 33
01 24 03 10 05 34 21
36 23    09
04 35 22

01    05
10    12
02 13 04 09 06
08 11 14
34       03    07       16
7 30 39 28 35          15 56 49 54 51
36 33                17 52
1 38 29 40 27          19 48 55 50 53
32       41    47       18
26 23 20
42 21 44 25 46
24    22
43    45
```

## D

Translation of: C++

From the refactored C++ version with more precise typing, and some optimizations. The HolyKnightPuzzle struct is created at compile-time, so its pre-conditions can catch most malformed puzzles at compile-time.

`import std.stdio, std.conv, std.string, std.range, std.algorithm,       std.typecons, std.typetuple;  struct HolyKnightPuzzle {    private alias InputCellBaseType = char;    private enum InputCell : InputCellBaseType { available = '#', unavailable = '.', start='1' }    private alias Cell = uint;    private enum : Cell { unknownCell = 0, unavailableCell = Cell.max, startCell=1 } // Special Cell values.     // Neighbors, [shift row, shift column].    static struct P { int x, y; }    alias shifts = TypeTuple!(P(-2, -1), P(2, -1), P(-2, 1), P(2, 1),                              P(-1, -2), P(1, -2), P(-1, 2), P(1, 2));     immutable size_t gridWidth, gridHeight;    private immutable Cell nAvailableCells;    private /*immutable*/ const InputCell[] flatPuzzle;    private Cell[] grid; // Flattened mutable game grid.     @disable this();      this(in string[] rawPuzzle) pure @safe    in {        assert(!rawPuzzle.empty);        assert(!rawPuzzle[0].empty);        assert(rawPuzzle.all!(row => row.length == rawPuzzle[0].length)); // Is rectangular.        assert(rawPuzzle.join.count(InputCell.start) == 1); // Exactly one start point.    } body {        //immutable puzzle = rawPuzzle.to!(InputCell[][]);        immutable puzzle = rawPuzzle.map!representation.array.to!(InputCell[][]);         gridWidth = puzzle[0].length;        gridHeight = puzzle.length;        flatPuzzle = puzzle.join;         // This counts the start cell too.        nAvailableCells = flatPuzzle.representation.count!(ic => ic != InputCell.unavailable);         grid = flatPuzzle               .map!(ic => ic.predSwitch(InputCell.available,   unknownCell,                                         InputCell.unavailable, unavailableCell,                                         InputCell.start,       startCell))               .array;    }      Nullable!(string[][]) solve(size_t width)() pure /*nothrow*/ @safe    out(result) {        if (!result.isNull)            assert(!grid.canFind(unknownCell));    } body {        assert(width == gridWidth);         // Find start position.        foreach (immutable r; 0 ..  gridHeight)            foreach (immutable c; 0 .. width)                if (grid[r * width + c] == startCell &&                    search!width(r, c, startCell + 1)) {                    auto result = zip(flatPuzzle, grid) // Not nothrow.                                  //.map!({p, c} => ...                                  .map!(pc => (pc[0] == InputCell.available) ?                                              pc[1].text :                                              InputCellBaseType(pc[0]).text)                                  .array                                  .chunks(width)                                  .array;                    return typeof(return)(result);                }         return typeof(return)();    }      private bool search(size_t width)(in size_t r, in size_t c, in Cell cell) pure nothrow @safe @nogc {        if (cell > nAvailableCells)            return true; // One solution found.         // This doesn't use the Warnsdorff rule.        foreach (immutable sh; shifts) {            immutable r2 = r + sh.x,                      c2 = c + sh.y,                      pos = r2 * width + c2;            // No need to test for >= 0 because uint wraps around.            if (c2 < width && r2 < gridHeight && grid[pos] == unknownCell) {                grid[pos] = cell;        // Try.                if (search!width(r2, c2, cell + 1))                    return true;                grid[pos] = unknownCell; // Restore.            }        }         return false;    }}  void main() @safe {    // Enum HolyKnightPuzzle to catch malformed puzzles at compile-time.    enum puzzle1 = ".###....                    .#.##...                    .#######                    ###..#.#                    #.#..###                    1######.                    ..##.#..                    ...###..".split.HolyKnightPuzzle;     enum puzzle2 = ".....1.#.....                    .....#.#.....                    ....#####....                    .....###.....                    ..#..#.#..#..                    #####...#####                    ..##.....##..                    #####...#####                    ..#..#.#..#..                    .....###.....                    ....#####....                    .....#.#.....                    .....#.#.....".split.HolyKnightPuzzle;     foreach (/*enum*/ puzzle; TypeTuple!(puzzle1, puzzle2)) {        //immutable solution = puzzle.solve!(puzzle.gridWidth);        enum width = puzzle.gridWidth;        immutable solution = puzzle.solve!width; // Solved at run-time.        if (solution.isNull)            writeln("No solution found for puzzle.\n");        else            writefln("One solution:\n%(%-(%2s %)\n%)\n", solution);    }}`
Output:
```One solution:
. 17 14 29  .  .  .  .
. 28  . 18 15  .  .  .
. 13 16 27 30 19 32  7
25  2 11  .  .  6  . 20
12  . 26  .  . 31  8 33
1 24  3 10  5 34 21  .
.  . 36 23  .  9  .  .
.  .  .  4 35 22  .  .

One solution:
.  .  .  .  .  1  .  5  .  .  .  .  .
.  .  .  .  . 10  . 12  .  .  .  .  .
.  .  .  .  2 13  4  9  6  .  .  .  .
.  .  .  .  .  8 11 14  .  .  .  .  .
.  . 34  .  .  3  .  7  .  . 16  .  .
37 30 39 28 35  .  .  . 15 56 49 54 51
.  . 36 33  .  .  .  .  . 17 52  .  .
31 38 29 40 27  .  .  . 19 48 55 50 53
.  . 32  .  . 41  . 47  .  . 18  .  .
.  .  .  .  . 26 23 20  .  .  .  .  .
.  .  .  . 42 21 44 25 46  .  .  .  .
.  .  .  .  . 24  . 22  .  .  .  .  .
.  .  .  .  . 43  . 45  .  .  .  .  .```

Run-time about 0.58 seconds with ldc2 compiler (using a switch statement if you don't have the predSwitch yet in Phobos), about 23 times faster than the Haskell entry.

`import qualified Data.Array as Arrimport qualified Data.Foldable as Foldimport qualified Data.List as Listimport Data.Maybe type Position = (Int, Int)type KnightBoard = Arr.Array Position (Maybe Int) toSlot :: Char -> Maybe InttoSlot '0' = Just 0toSlot '1' = Just 1toSlot _   = Nothing toString :: Maybe Int -> StringtoString Nothing  = replicate 3 ' 'toString (Just n) = replicate (3 - length nn) ' ' ++ nn  where    nn = show n chunksOf :: Int -> [a] -> [[a]]chunksOf _ [] = []chunksOf n xs = take n xs : (chunksOf n \$ drop n xs) showBoard :: KnightBoard -> StringshowBoard board =  List.intercalate "\n" . map concat . List.transpose  . chunksOf (height + 1) . map toString \$ Arr.elems board  where    (_, (_, height)) = Arr.bounds board toBoard :: [String] -> KnightBoardtoBoard strs = board  where    height = length strs    width  = minimum \$ map length strs    board  = Arr.listArray ((0, 0), (width - 1, height - 1))             . map toSlot . concat . List.transpose \$ map (take width) strs  add :: Num a => (a, a) -> (a, a) -> (a, a)add (a, b) (x, y) = (a + x, b + y) within :: Ord a => ((a, a), (a, a)) -> (a, a) -> Boolwithin ((a, b), (c, d)) (x, y) =  a <= x && x <= c &&  b <= y && y <= d -- Enumerate valid moves given a board and a knight's position.validMoves :: KnightBoard -> Position -> [Position]validMoves board position = filter isValid plausible  where    bound       = Arr.bounds board    plausible   = map (add position) [(1, 2), (2, 1), (2, -1), (-1, 2),                                      (-2, 1), (1, -2), (-1, -2), (-2, -1)]    isValid pos = within bound pos && maybe False (== 0) (board Arr.! pos) isSolved :: KnightBoard -> BoolisSolved = Fold.all (maybe True (/= 0)) -- Solve the knight's tour with a simple Depth First Search.solveKnightTour :: KnightBoard -> Maybe KnightBoardsolveKnightTour board = solve board 1 initPosition  where    initPosition = fst \$ head \$ filter ((== (Just 1)) . snd) \$ Arr.assocs board    solve boardA depth position =      let boardB = boardA Arr.// [(position, Just depth)]      in if isSolved boardB        then Just boardB        else listToMaybe \$ mapMaybe (solve boardB \$ depth + 1)             \$ validMoves boardB position tourExA :: [String]tourExA =  [" 000    "  ," 0 00   "  ," 0000000"  ,"000  0 0"  ,"0 0  000"  ,"1000000 "  ,"  00 0  "  ,"   000  "] tourExB :: [String]tourExB =  ["-----1-0-----"  ,"-----0-0-----"  ,"----00000----"  ,"-----000-----"  ,"--0--0-0--0--"  ,"00000---00000"  ,"--00-----00--"  ,"00000---00000"  ,"--0--0-0--0--"  ,"-----000-----"  ,"----00000----"  ,"-----0-0-----"  ,"-----0-0-----"] main :: IO ()main =  flip mapM_ [tourExA, tourExB]  (\board ->    case solveKnightTour \$ toBoard board of    Nothing       -> putStrLn "No solution.\n"    Just solution -> putStrLn \$ showBoard solution ++ "\n")`
Output:
```    19 26 17
36    20 25
31 18 27 16 21  6 23
35 28 15       24     8
30    32        7 22  5
1 34 29 14 11  4  9
2 33    13
12  3 10

1    31
32    28
56 27  2 33 30
34 29 26
48       55     3       24
47 52 45 54 35          25  4 11  6 23
36 49                 9 22
51 46 53 44 37          21 12  5 10  7
50       43    13        8
38 41 20
42 19 16 39 14
40    18
17    15               ```

As requested, in an attempt to make this solution faster, the following is a version that replaces the Array with an STUArray (unboxed and mutable), and yields a speedup of 4.2. No speedups were gained until move validation was inlined with the logic in `solve'. This seems to point to the list consing as the overhead for time and allocation, although profiling did show that about 25% of the time in the immutable version was spent creating arrays. Perhaps a more experienced Haskeller could provide insight on how to further optimize this or what optimizations were frivolous (barring a different algorithm or search heuristic, and jumping into C, unless those are the only way).

`import Control.Monad.STimport qualified Data.Array.Base as ABimport qualified Data.Array.ST as ASTimport qualified Data.Array.Unboxed as AUimport qualified Data.List as List type Position = (Int, Int)type KnightBoard = AU.UArray Position Int toSlot :: Char -> InttoSlot '0' = 0toSlot '1' = 1toSlot _   = -1 toString :: Int -> StringtoString (-1) = replicate 3 ' 'toString n    = replicate (3 - length nn) ' ' ++ nn  where    nn = show n chunksOf :: Int -> [a] -> [[a]]chunksOf _ [] = []chunksOf n xs = take n xs : (chunksOf n \$ drop n xs) showBoard :: KnightBoard -> StringshowBoard board =  List.intercalate "\n" . map concat . List.transpose  . chunksOf (height + 1) . map toString \$ AU.elems board  where    (_, (_, height)) = AU.bounds board toBoard :: [String] -> KnightBoardtoBoard strs = board  where    height = length strs    width  = minimum \$ map length strs    board  = AU.listArray ((0, 0), (width - 1, height - 1))             . map toSlot . concat . List.transpose \$ map (take width) strs add :: Num a => (a, a) -> (a, a) -> (a, a)add (a, b) (x, y) = (a + x, b + y) within :: Ord a => ((a, a), (a, a)) -> (a, a) -> Boolwithin ((a, b), (c, d)) (x, y) =  a <= x && x <= c &&  b <= y && y <= d -- Solve the knight's tour with a simple Depth First Search.solveKnightTour :: KnightBoard -> Maybe KnightBoardsolveKnightTour board =  runST \$ do    let      assocs = AU.assocs board      bounds = AU.bounds board     array <- (AST.newListArray bounds (AU.elems board))             :: ST s (AST.STUArray s Position Int)     let      initPosition = fst \$ head \$ filter ((== 1) . snd) assocs      maxDepth     = fromIntegral \$ 1 + (length \$ filter ((== 0) . snd) assocs)      offsets      =          [(1, 2), (2, 1), (2, -1), (-1, 2),           (-2, 1), (1, -2), (-1, -2), (-2, -1)]       solve depth position = do        if within bounds position        then do          oldValue <- AST.readArray array position          if oldValue == 0          then do            AST.writeArray array position depth            if depth == maxDepth            then return True            else do              -- This mapM-any combo can be reduced to a string of ||'s              -- with the goal of removing the allocation overhead due to consing              -- which the compiler may not be able to optimize out.              results <- mapM ((solve \$ depth + 1) . add position) offsets              if any (== True) results              then return True              else do                AST.writeArray array position oldValue                return False          else return False        else return False     AST.writeArray array initPosition 0    result <- solve 1 initPosition    farray <- AB.unsafeFreeze array    return \$ if result      then Just farray      else Nothing tourExA :: [String]tourExA =  [" 000    "  ," 0 00   "  ," 0000000"  ,"000  0 0"  ,"0 0  000"  ,"1000000 "  ,"  00 0  "  ,"   000  "] tourExB :: [String]tourExB =  ["-----1-0-----"  ,"-----0-0-----"  ,"----00000----"  ,"-----000-----"  ,"--0--0-0--0--"  ,"00000---00000"  ,"--00-----00--"  ,"00000---00000"  ,"--0--0-0--0--"  ,"-----000-----"  ,"----00000----"  ,"-----0-0-----"  ,"-----0-0-----"] main :: IO ()main =  flip mapM_ [tourExA, tourExB]  (\board ->    case solveKnightTour \$ toBoard board of    Nothing       -> putStrLn "No solution.\n"    Just solution -> putStrLn \$ showBoard solution ++ "\n")`

## Icon and Unicon

This is a Unicon-specific solution:

`global nCells, cMap, bestrecord Pos(r,c) procedure main(A)    puzzle := showPuzzle("Input",readPuzzle())    QMouse(puzzle,findStart(puzzle),&null,0)    showPuzzle("Output", solvePuzzle(puzzle)) | write("No solution!")end procedure readPuzzle()    # Start with a reduced puzzle space    p := [[-1],[-1]]    nCells := maxCols := 0    every line := !&input do {        put(p,[: -1 | -1 | gencells(line) | -1 | -1 :])        maxCols <:= *p[-1]        }    every put(p, [-1]|[-1])    # Now normalize all rows to the same length    every i := 1 to *p do p[i] := [: !p[i] | (|-1\(maxCols - *p[i])) :]    return pend procedure gencells(s)    static WS, NWS    initial {        NWS := ~(WS := " \t")        cMap := table()     # Map to/from internal model        cMap["#"] := -1;  cMap["_"] :=  0        cMap[-1]  := " "; cMap[0]   := "_"        }     s ? while not pos(0) do {            w := (tab(many(WS))|"", tab(many(NWS))) | break            w := numeric(\cMap[w]|w)            if -1 ~= w then nCells +:= 1            suspend w            }end procedure showPuzzle(label, p)    write(label," with ",nCells," cells:")    every r := !p do {        every c := !r do writes(right((\cMap[c]|c),*nCells+1))        write()        }    return pend procedure findStart(p)    if \p[r := !*p][c := !*p[r]] = 1 then return Pos(r,c)end procedure solvePuzzle(puzzle)    if path := \best then {        repeat {            loc := path.getLoc()            puzzle[loc.r][loc.c] := path.getVal()            path := \path.getParent() | break            }        return puzzle        }end class QMouse(puzzle, loc, parent, val)     method getVal(); return val; end    method getLoc(); return loc; end    method getParent(); return parent; end    method atEnd(); return nCells = val; end     method visit(r,c)        if /best & validPos(r,c) then return Pos(r,c)    end     method validPos(r,c)        v := val+1        xv := (0 <= puzzle[r][c]) | fail        if xv = (v|0) then {  # make sure this path hasn't already gone there            ancestor := self            while xl := (ancestor := \ancestor.getParent()).getLoc() do                if (xl.r = r) & (xl.c = c) then fail            return            }    end initially    val := val+1    if atEnd() then return best := self    QMouse(puzzle, visit(loc.r-2,loc.c-1), self, val)    QMouse(puzzle, visit(loc.r-2,loc.c+1), self, val)    QMouse(puzzle, visit(loc.r-1,loc.c+2), self, val)    QMouse(puzzle, visit(loc.r+1,loc.c+2), self, val)    QMouse(puzzle, visit(loc.r+2,loc.c+1), self, val)    QMouse(puzzle, visit(loc.r+2,loc.c-1), self, val)    QMouse(puzzle, visit(loc.r+1,loc.c-2), self, val)    QMouse(puzzle, visit(loc.r-1,loc.c-2), self, val)end`

Sample run:

```->hkt <hkt.in
Input with 36 cells:

_  _  _
_     _  _
_  _  _  _  _  _  _
_  _  _        _     _
_     _        _  _  _
1  _  _  _  _  _  _
_  _     _
_  _  _

Output with 36 cells:

19  4 13
12    18  5
25 20  3 14 17  6 31
21  2 11       32    16
26    24       15 30  7
1 22 27 10 35  8 33
36 23    29
28  9 34

->
```

## Perl 6

Using the Warnsdorff algorithm from Solve_a_Hidato_puzzle.

`my @adjacent =               [ -2, -1],  [ -2, 1],      [-1,-2],                       [-1,+2],      [+1,-2],                       [+1,+2],               [ +2, -1],  [ +2, 1]; solveboard q:to/END/;    . 0 0 0    . 0 . 0 0    . 0 0 0 0 0 0 0    0 0 0 . . 0 . 0    0 . 0 . . 0 0 0    1 0 0 0 0 0 0    . . 0 0 . 0    . . . 0 0 0    END`
Output:
```   25 14 27
36    24 15
31 26 13 28 23  6 17
35 12 29       16    22
30    32        7 18  5
1 34 11  8 19  4 21
2 33     9
10  3 20
84 tries```

## J

The simplest J implementation here uses a breadth first search - but that can be memory inefficient so it's worth representing the boards as characters (several orders of magnitude space improvement) and it's worth capping how much memory we allow J to use (2^34 is 16GB):

`9!:21]2^34 unpack=:verb define  mask=. +./' '~:y  board=. (255 0 1{a.) {~ {.@:>:@:"."0 mask#"1 y) ex1=:unpack ];._2]0 :0  0 0 0   0   0 0   0 0 0 0 0 0 00 0 0     0   00   0     0 0 01 0 0 0 0 0 0    0 0   0      0 0 0) solve=:verb define  board=.,:y  for_move.1+i.+/({.a.)=,y do.    board=. ;move <@knight"2 board  end.) kmoves=: ,/(2 1,:1 2)*"1/_1^#:i.4 knight=:dyad define  pos=. (\$y)#:(,y)i.x{a.  moves=. <"1(#~ 0&<: */"1@:* (\$y)&>"1)pos+"1 kmoves  moves=. (#~ (0{a.)={&y) moves  moves y adverb def (':';'y x} m')"0 (x+1){a.)`

Letting that cook:

`   \$~.sol48422 8 8`

That's 48422 solutions. Here's one of them:

`   (a.i.{.sol){(i.255),____ 11 28 13 __ __ __ ____ 22 __ 10 29 __ __ ____ 27 12 21 14  9 16 3123  2 25 __ __ 30 __  826 __ 20 __ __ 15 32 17 1 24  3 34  5 18  7 ____ __ 36 19 __ 33 __ ____ __ __  4 35  6 __ __`

and here's a couple more:

`   (a.i.{:sol){(i.255),____  5  8 31 __ __ __ ____ 32 __  6  9 __ __ ____  7  4 33 30 23 10 21 3 34 29 __ __ 20 __ 2436 __  2 __ __ 11 22 19 1 28 35 12 15 18 25 ____ __ 16 27 __ 13 __ ____ __ __ 14 17 26 __ __   (a.i.24211{sol){(i.255),____ 11 14 33 __ __ __ ____ 34 __ 10 13 __ __ ____ 19 12 15 32  9  6 2535 16 31 __ __ 24 __  818 __ 20 __ __  7 26  5 1 36 17 30 27  4 23 ____ __  2 21 __ 29 __ ____ __ __ 28  3 22 __ __`

This is something of a problem, however, because finding all those solutions is slow. And even having to be concerned about a 16GB memory limit for this small of a problem is troubling (and using 64 bit integers, instead of 8 bit characters, to represent board squares, would exceed that limit). Also, you'd get bored, inspecting 48422 boards.

So, let's just find one solution:

`unpack=:verb define  mask=. +./' '~:y  board=. __ 0 1 {~ {.@:>:@:"."0 mask#"1 y) ex1=:unpack ];._2]0 :0  0 0 0   0   0 0   0 0 0 0 0 0 00 0 0     0   00   0     0 0 01 0 0 0 0 0 0    0 0   0      0 0 0) solve1=:verb define (1,+/0=,y) solve1 ,:y:  for_block._10 <\ y do.    board=. ;({.x) <@knight"2 ;block    if. #board do.      if. =/x do.        {.board return.      else.        board=. (1 0+x) solve1 board        if. #board do.          board return.        end.      end.    end.  end.  i.0 0) kmoves=: ,/(2 1,:1 2)*"1/_1^#:i.4 knight=:dyad define  pos=. (\$y)#:(,y)i.x  moves=. <"1(#~ 0&<: */"1@:* (\$y)&>"1)pos+"1 kmoves  moves=. (#~ 0={&y) moves  moves y adverb def (':';'y x} m')"0 x+1)`

Here, we break our problem space up into blocks of no more than 10 boards each, and use recursion to investigate each batch of boards. When we find a solution, we stop there (for each iteration at each level of recursion):

`   solve1 ex1__ 11 28 13 __ __ __ ____ 22 __ 10 29 __ __ ____ 27 12 21 14  9 16 3123  2 25 __ __ 30 __  826 __ 20 __ __ 15 32 17 1 24  3 34  5 18  7 ____ __ 36 19 __ 33 __ ____ __ __  4 35  6 __ __`

[Why ten boards and not just one board? Because 10 is a nice compromise between amortizing the overhead of each attempt and not trying too much at one time. Most individual attempts will fail, but by splitting up the workload after exceeding 10 possibilities, instead of investigating each possibility individually, we increase the chances that we are investigating something useful. Also, J implementations penalize the performance of algorithms which are overly serial in structure.]

With this tool in hand, we can now attempt bigger problems:

`ex2=:unpack ];._2]0 :0           1   0                     0   0                   0 0 0 0 0                   0 0 0               0     0   0     0     0 0 0 0 0       0 0 0 0 0     0 0           0 0     0 0 0 0 0       0 0 0 0 0     0     0   0     0               0 0 0                   0 0 0 0 0                   0   0                     0   0          )`

Finding a solution for this looks like:

`   solve1 ex2__ __ __ __ __  1 __  5 __ __ __ __ ____ __ __ __ __  6 __ 46 __ __ __ __ ____ __ __ __ 48 45  2  7  4 __ __ __ ____ __ __ __ __  8 47 44 __ __ __ __ ____ __ 56 __ __ 49 __  3 __ __ 42 __ __13 52 11 50  9 __ __ __ 43 38 31 36 33__ __ 14 55 __ __ __ __ __ 41 34 __ __53 12 51 10 15 __ __ __ 39 30 37 32 35__ __ 54 __ __ 23 __ 29 __ __ 40 __ ____ __ __ __ __ 16 19 22 __ __ __ __ ____ __ __ __ 24 21 26 17 28 __ __ __ ____ __ __ __ __ 18 __ 20 __ __ __ __ ____ __ __ __ __ 25 __ 27 __ __ __ __ __`

## Phix

Tweaked the knights tour algorithm (to use a limit variable rather than size*size). Bit slow on the second one...

`sequence board, warnsdorffs integer size, limit, ncharsstring fmt, blank constant ROW = 1, COL = 2constant moves = {{-1,-2},{-2,-1},{-2,1},{-1,2},{1,2},{2,1},{2,-1},{1,-2}} function onboard(integer row, integer col)    return row>=1 and row<=size and col>=nchars and col<=nchars*sizeend function procedure init_warnsdorffs()integer nrow,ncol    for row=1 to size do        for col=nchars to nchars*size by nchars do            for move=1 to length(moves) do                nrow = row+moves[move][ROW]                ncol = col+moves[move][COL]*nchars                if onboard(nrow,ncol) then                    -- (either of these would work)                    warnsdorffs[row][col] += 1--                  warnsdorffs[nrow][ncol] += 1                end if            end for        end for    end forend procedure atom t0 = time()integer tries = 0, backtracks = 0atom t1 = time()+1function solve(integer row, integer col, integer n)integer nrow, ncol    if time()>t1 then        ?{row,floor(col/nchars),n,tries}        puts(1,join(board,"\n"))        t1 = time()+1--      if wait_key()='!' then ?9/0 end if    end if    tries+= 1    if n>limit then return 1 end if    sequence wmoves = {}    for move=1 to length(moves) do        nrow = row+moves[move][ROW]        ncol = col+moves[move][COL]*nchars        if onboard(nrow,ncol)        and board[nrow][ncol]=' ' then            wmoves = append(wmoves,{warnsdorffs[nrow][ncol],nrow,ncol})        end if    end for    wmoves = sort(wmoves)    -- avoid creating orphans    if length(wmoves)<2 or wmoves[2][1]>1 then        for m=1 to length(wmoves) do            {?,nrow,ncol} = wmoves[m]            warnsdorffs[nrow][ncol] -= 1        end for        for m=1 to length(wmoves) do            {?,nrow,ncol} = wmoves[m]            board[nrow][ncol-nchars+1..ncol] = sprintf(fmt,n)            if solve(nrow,ncol,n+1) then return 1 end if            backtracks += 1            board[nrow][ncol-nchars+1..ncol] = blank        end for        for m=1 to length(wmoves) do            {?,nrow,ncol} = wmoves[m]            warnsdorffs[nrow][ncol] += 1        end for    end if    return 0end function procedure holyknight(sequence s)integer y, ch, sx, sy    s = split(s,'\n')    size = length(s)    nchars = length(sprintf(" %d",size*size))       fmt = sprintf(" %%%dd",nchars-1)    blank = repeat(' ',nchars)    board = repeat(repeat(' ',size*nchars),size)    limit = 1    for x=1 to size do        y = nchars        for j=1 to size do            if j>length(s[x]) then                ch = '-'            else                ch = s[x][j]            end if            if ch=' ' then                ch = '-'            elsif ch='0' then                ch = ' '                limit += 1            elsif ch='1' then                sx = x                sy = y            end if            board[x][y] = ch            y += nchars        end for    end for    warnsdorffs = repeat(repeat(0,size*nchars),size)    init_warnsdorffs()    t0 = time()    tries = 0    backtracks = 0    t1 = time()+1    if solve(sx,sy,2) then        puts(1,join(board,"\n"))        printf(1,"\nsolution found in %d tries, %d backtracks (%3.2fs)\n",{tries,backtracks,time()-t0})    else        puts(1,"no solutions found\n")    end ifend procedure constant board1 = """ 000 0 00 0000000000  0 00 0  0001000000  00 0   000""" holyknight(board1) constant board2 = """-----1-0----------0-0---------00000---------000-------0--0-0--0--00000---00000--00-----00--00000---00000--0--0-0--0-------000---------00000---------0-0----------0-0-----""" holyknight(board2) {} = wait_key()`
Output:
```  - 21  4 19  -  -  -  -
- 18  - 22  5  -  -  -
- 15 20  3 32 23  6  9
17  2 33  -  -  8  - 24
14  - 16  -  - 31 10  7
1 34 13 30 27 36 25  -
-  - 28 35  - 11  -  -
-  -  - 12 29 26  -  -
solution found in 31718 tries, 31682 backtracks (0.11s)

-   -   -   -   -   1   -  55   -   -   -   -   -
-   -   -   -   -   8   -   2   -   -   -   -   -
-   -   -   -   6   3  54   9  56   -   -   -   -
-   -   -   -   -  10   7   4   -   -   -   -   -
-   -  12   -   -   5   -  53   -   -  46   -   -
13  16  23  18  11   -   -   -  45  52  43  50  41
-   -  14  21   -   -   -   -   -  47  40   -   -
15  22  17  24  19   -   -   -  39  44  51  42  49
-   -  20   -   -  25   -  33   -   -  48   -   -
-   -   -   -   -  32  35  38   -   -   -   -   -
-   -   -   -  26  37  28  31  34   -   -   -   -
-   -   -   -   -  30   -  36   -   -   -   -   -
-   -   -   -   -  27   -  29   -   -   -   -   -
solution found in 61341542 tries, 61341486 backtracks (180.56s)
```

## Racket

This solution uses the module "hidato-family-solver.rkt" from Solve a Numbrix puzzle#Racket. The difference between the two is essentially the neighbourhood function.

It solves the tasked problem, as well as the "extra credit" from #Ada.

`#lang racket(require "hidato-family-solver.rkt") (define knights-neighbour-offsets  '((+1 +2) (-1 +2) (+1 -2) (-1 -2) (+2 +1) (-2 +1) (+2 -1) (-2 -1))) (define solve-a-knights-tour (solve-hidato-family knights-neighbour-offsets)) (displayln (puzzle->string  (solve-a-knights-tour   #(#(_ 0 0 0 _ _ _ _)     #(_ 0 _ 0 0 _ _ _)     #(_ 0 0 0 0 0 0 0)     #(0 0 0 _ _ 0 _ 0)     #(0 _ 0 _ _ 0 0 0)     #(1 0 0 0 0 0 0 _)     #(_ _ 0 0 _ 0 _ _)     #(_ _ _ 0 0 0 _ _))))) (newline) (displayln (puzzle->string  (solve-a-knights-tour   #(#(- - - - - 1 - 0 - - - - -)     #(- - - - - 0 - 0 - - - - -)     #(- - - - 0 0 0 0 0 - - - -)     #(- - - - - 0 0 0 - - - - -)     #(- - 0 - - 0 - 0 - - 0 - -)     #(0 0 0 0 0 - - - 0 0 0 0 0)     #(- - 0 0 - - - - - 0 0 - -)     #(0 0 0 0 0 - - - 0 0 0 0 0)     #(- - 0 - - 0 - 0 - - 0 - -)     #(- - - - - 0 0 0 - - - - -)     #(- - - - 0 0 0 0 0 - - - -)     #(- - - - - 0 - 0 - - - - -)     #(- - - - - 0 - 0 - - - - -)))))`
Output:
``` _ 13 30 23  _  _  _  _
_ 24  _ 14 31  _  _  _
_ 29 12 25 22 15 32  7
11 26 21  _  _  6  _ 16
28  _ 10  _  _ 33  8  5
1 20 27 34  9  4 17  _
_  _  2 19  _ 35  _  _
_  _  _ 36  3 18  _  _

_   _   _   _   _   1   _  51   _   _   _   _   _
_   _   _   _   _  50   _   2   _   _   _   _   _
_   _   _   _  56   3  52  49  54   _   _   _   _
_   _   _   _   _  48  55   4   _   _   _   _   _
_   _  46   _   _   5   _  53   _   _  24   _   _
45   8  11   6  47   _   _   _  23  30  19  28  21
_   _  44   9   _   _   _   _   _  25  22   _   _
43  10   7  12  41   _   _   _  31  18  29  20  27
_   _  42   _   _  13   _  17   _   _  26   _   _
_   _   _   _   _  40  37  32   _   _   _   _   _
_   _   _   _  36  33  14  39  16   _   _   _   _
_   _   _   _   _  38   _  34   _   _   _   _   _
_   _   _   _   _  35   _  15   _   _   _   _   _```

## REXX

This REXX program is essentially a modified   knight's tour   REXX program with support to place pennies on the chessboard.
Also supported is the specification of the size of the chessboard and the placement of the knight (initial position).

`/*REXX pgm solves the holy knight's tour problem for a  NxN  chessboard.*/blank=pos('//',space(arg(1),0))\==0    /*see if pennies are to be shown.*/parse arg ops '/' cent                 /*obtain the options and pennies.*/parse var ops N sRank sFile .          /*boardsize, starting pos, pennys*/if     N=='' |     N==',' then     N=8 /*Boardsize specified?  Default. */if sRank=='' | sRank==',' then sRank=N /*starting rank given?  Default. */if sFile=='' | sFile==',' then sFile=1 /*    "    file   "        "     */NN=N**2;  NxN='a ' N"x"N ' chessboard' /*[↓ ↓]      r f = Rank and File.*/@.=;    do r=1  for N;  do f=1  for N;   @.r.f=.;   end /*f*/;   end /*r*/                                       /*[↑]  blank the  NxN chessboard.*/cent=space(translate(cent,,','))       /*allow use of comma (,) for sep.*/cents=0                                /*number of pennies on chessboard*/       do  while  cent\=''             /* [↓]  possibly place pennies.  */       parse var cent cr cf x '/' cent /*extract where to place pennies.*/       if x=''   then x=1              /*if # not specified, use 1 penny*/       if cr=''  then iterate          /*support the "blanking" option. */         do cf=cf  for x               /*now, place  X  pennies on board*/         @.cr.cf='¢'                   /*mark board position with penny.*/         end   /*cf*/                  /* [↑]  places X pennies on board*/       end     /*while cent¬='' */     /* [↑]  allows of placing  X  ¢s.*/                                       /* [↓]  traipse through the board*/  do r=1  for N;  do f=1  for N;   cents=cents+(@.r.f=='¢');   end;   end                                       /* [↑]  count number of pennies. */if cents\==0  then say cents 'pennies placed on chessboard.'target=NN-cents                        /*use this as the number of moves*/                                       /*[↑]  create the NxN chessboard.*/          Kr = '2 1 -1 -2 -2 -1  1  2' /*legal "rank" move for a knight.*/          Kf = '1 2  2  1 -1 -2 -2 -1' /*  "   "file"   "   "  "    "   */parse var Kr  Kr.1 Kr.2 Kr.3 Kr.4 Kr.5 Kr.6 Kr.7 Kr.8   /*parse by hand.*/parse var Kf  Kf.1 Kf.2 Kf.3 Kf.4 Kf.5 Kf.6 Kf.7 Kf.8   /*  "    "   "  */if @.sRank.sFile==.   then @.sRank.sFile=1      /*knight's starting pos.*/if @.sRank.sFile\==1  then do   sRank=1  for N  /*find a starting rank.*/                             do sFile=1  for N  /*  "  "    "     file.*/                             if @.sRank.sFile\==.  then iterate                             @.sRank.sFile=1                             leave sRank        /*got a spot, so leave. */                             end   /*sRank*/                           end     /*sFile*/if \move(2,sRank,sFile) &  \(N==1),               then say "No holy knight's tour solution for"        NxN'.'               else say "A solution for the holy knight's tour on"  NxN':'                                       /*show chessboard with moves & ¢.*/!=left('', 9*(n<18))                   /*used for indentation of board. */_=substr(copies("┼───",N),2);   say;   say  ! translate('┌'_"┐", '┬', "┼")     do   r=N  for N  by -1;           if r\==N  then say ! '├'_"┤";  L=@.       do f=1  for N;     L=L'│'centre(@.r.f,3)   /*preserve squareness.*/       end      /*f*/     if blank then L=translate(L,,'¢') /*blank out the pennies ?        */     say !  translate(L'│', , .)       /*show a  rank of the chessboard.*/     end        /*r*/                  /*80 cols can view 19x19 chessbrd*/say  !  translate('└'_"┘", '┴', "┼")   /*show the last rank of the board*/exit                                   /*stick a fork in it, we're done.*//*──────────────────────────────────MOVE subroutine─────────────────────*/move: procedure expose @. Kr. Kf. target;       parse arg #,rank,file         do t=1  for 8;      nr=rank+Kr.t;      nf=file+Kf.t         if @.nr.nf==.  then do;                @.nr.nf=#     /*Kn move.*/                             if #==target       then return 1 /*last mv?*/                             if move(#+1,nr,nf) then return 1                             @.nr.nf=.          /*undo the above move.  */                             end                /*try different move.   */         end   /*t*/return 0                                        /*the tour not possible.*/`

output when the following is used for input:
, 3 1 /1,1 3 /1,7 2 /2,1 2 /2,5 /2,7 2 /3,8 /4,2 /4,4 2 /5,4 2 /5,7 /6,1 /7,1 /7,3 /7,6 3 /8,1 /8,5 4

```28 pennies placed on chessboard.
A solution for the holy knight's tour on a  8x8  chessboard:

┌───┬───┬───┬───┬───┬───┬───┬───┐
│ ¢ │25 │12 │27 │ ¢ │ ¢ │ ¢ │ ¢ │
├───┼───┼───┼───┼───┼───┼───┼───┤
│ ¢ │36 │ ¢ │24 │13 │ ¢ │ ¢ │ ¢ │
├───┼───┼───┼───┼───┼───┼───┼───┤
│ ¢ │11 │26 │ 3 │28 │23 │14 │ 5 │
├───┼───┼───┼───┼───┼───┼───┼───┤
│35 │ 2 │31 │ ¢ │ ¢ │ 4 │ ¢ │22 │
├───┼───┼───┼───┼───┼───┼───┼───┤
│10 │ ¢ │34 │ ¢ │ ¢ │29 │ 6 │15 │
├───┼───┼───┼───┼───┼───┼───┼───┤
│ 1 │32 │ 9 │30 │19 │16 │21 │ ¢ │
├───┼───┼───┼───┼───┼───┼───┼───┤
│ ¢ │ ¢ │18 │33 │ ¢ │ 7 │ ¢ │ ¢ │
├───┼───┼───┼───┼───┼───┼───┼───┤
│ ¢ │ ¢ │ ¢ │ 8 │17 │20 │ ¢ │ ¢ │
└───┴───┴───┴───┴───┴───┴───┴───┘
```

output when the following is used for input:
, 3 1 /1,1 3 /1,7 2 /2,1 2 /2,5 /2,7 2 /3,8 /4,2 /4,4 2 /5,4 2 /5,7 /6,1 /7,1 /7,3 /7,6 3 /8,1 /8,5 4 //

```28 pennies placed on chessboard.
A solution for the holy knight's tour on a  8x8  chessboard:

┌───┬───┬───┬───┬───┬───┬───┬───┐
│   │25 │12 │27 │   │   │   │   │
├───┼───┼───┼───┼───┼───┼───┼───┤
│   │36 │   │24 │13 │   │   │   │
├───┼───┼───┼───┼───┼───┼───┼───┤
│   │11 │26 │ 3 │28 │23 │14 │ 5 │
├───┼───┼───┼───┼───┼───┼───┼───┤
│35 │ 2 │31 │   │   │ 4 │   │22 │
├───┼───┼───┼───┼───┼───┼───┼───┤
│10 │   │34 │   │   │29 │ 6 │15 │
├───┼───┼───┼───┼───┼───┼───┼───┤
│ 1 │32 │ 9 │30 │19 │16 │21 │   │
├───┼───┼───┼───┼───┼───┼───┼───┤
│   │   │18 │33 │   │ 7 │   │   │
├───┼───┼───┼───┼───┼───┼───┼───┤
│   │   │   │ 8 │17 │20 │   │   │
└───┴───┴───┴───┴───┴───┴───┴───┘
```

## Ruby

This solution uses HLPsolver from here

`require 'HLPsolver' ADJACENT = [[-1,-2],[-2,-1],[-2,1],[-1,2],[1,2],[2,1],[2,-1],[1,-2]] boardy = <<EOS. . 0 0 0. . 0 . 0 0. 0 0 0 0 0 0 00 0 0 . . 0 . 00 . 0 . . 0 0 01 0 0 0 0 0 0. . 0 0 . 0. . . 0 0 0EOSt0 = Time.nowHLPsolver.new(boardy).solveputs " #{Time.now - t0} sec"`

Which produces:

```Problem:
0  0  0
0     0  0
0  0  0  0  0  0  0
0  0  0        0     0
0     0        0  0  0
1  0  0  0  0  0  0
0  0     0
0  0  0

Solution:
8 33 14
13     7 32
9 34 31 22 15  6 29
35 12 21       30    16
10    36       23 28  5
1 20 11 24 27  4 17
2 19    25
26  3 18

0.005 sec
```

## Tcl

Works with: Tcl version 8.6
`package require Tcl 8.6 oo::class create HKTSolver {    variable grid start limit    constructor {puzzle} {	set grid \$puzzle	for {set y 0} {\$y < [llength \$grid]} {incr y} {	    for {set x 0} {\$x < [llength [lindex \$grid \$y]]} {incr x} {		if {[set cell [lindex \$grid \$y \$x]] == 1} {		    set start [list \$y \$x]		}		incr limit [expr {\$cell>=0}]	    }	}	if {![info exist start]} {	    return -code error "no starting position found"	}    }    method moves {} {	return {	        -1 -2   1 -2	    -2 -1          2 -1	    -2  1          2 1	        -1 2    1 2	}    }    method Moves {g r c} {	set valid {}	foreach {dr dc} [my moves] {	    set R [expr {\$r + \$dr}]	    set C [expr {\$c + \$dc}]	    if {[lindex \$g \$R \$C] == 0} {		lappend valid \$R \$C	    }	}	return \$valid    }     method Solve {g r c v} {	lset g \$r \$c [incr v]	if {\$v >= \$limit} {return \$g}	foreach {r c} [my Moves \$g \$r \$c] {	    return [my Solve \$g \$r \$c \$v]	}	return -code continue    }     method solve {} {	while {[incr i]==1} {	    set grid [my Solve \$grid {*}\$start 0]	    return	}	return -code error "solution not possible"    }    method solution {} {return \$grid}} proc parsePuzzle {str} {    foreach line [split \$str "\n"] {	if {[string trim \$line] eq ""} continue	lappend rows [lmap {- c} [regexp -all -inline {(.)\s?} \$line] {	    string map {" " -1} \$c	}]    }    set len [tcl::mathfunc::max {*}[lmap r \$rows {llength \$r}]]    for {set i 0} {\$i < [llength \$rows]} {incr i} {	while {[llength [lindex \$rows \$i]] < \$len} {	    lset rows \$i end+1 -1	}    }    return \$rows}proc showPuzzle {grid name} {    foreach row \$grid {foreach cell \$row {incr c [expr {\$cell>=0}]}}    set len [string length \$c]    set u [string repeat "_" \$len]    puts "\$name with \$c cells"    foreach row \$grid {	puts [format "  %s" [join [lmap c \$row {	    format "%*s" \$len [if {\$c==-1} list elseif {\$c==0} {set u} {set c}]	}]]]    }} set puzzle [parsePuzzle {  0 0 0   0   0 0   0 0 0 0 0 0 00 0 0     0   00   0     0 0 01 0 0 0 0 0 0    0 0   0      0 0 0}]showPuzzle \$puzzle "Input"HKTSolver create hkt \$puzzlehkt solveshowPuzzle [hkt solution] "Output"`
Output:
```Input with 36 cells
__ __ __
__    __ __
__ __ __ __ __ __ __
__ __ __       __    __
__    __       __ __ __
1 __ __ __ __ __ __
__ __    __
__ __ __
Output with 36 cells
13  6 15
8    12 31
5 14  7 16 27 32 29
9  2 11       30    26
4    22       17 28 33
1 10  3 18 21 34 25
36 23    19
20 35 24
```