Haskell: Knight tour never finish if I try more than 55 steps?

Question

This is my code:

maxX=8; maxY=8; 
maxSteps=60 -- If I change maxSteps=55 I get an answer
move :: [(Int, Int)] -> [( Int, Int)]
move list 
   | lastX>maxX || lastY>maxY || lastX<=0 || lastY<=0 = []
   | lastMove `elem` (init list) = []
   | length list == maxSteps = list
   | length m1 == maxSteps = m1
   | length m2 == maxSteps = m2
   | length m3 == maxSteps = m3
   | length m4 == maxSteps = m4
   | length m5 == maxSteps = m5
   | length m6 == maxSteps = m6
   | length m7 == maxSteps = m7
   | length m8 == maxSteps = m8
   | otherwise = []
   where lastMove = last list
         lastX = fst lastMove
         lastY = snd lastMove
         m1 = move (list ++ [(lastX+1,lastY+2)])
         m2 = move (list ++ [(lastX+2,lastY+1)])
         m3 = move (list ++ [(lastX-1,lastY+2)])
         m4 = move (list ++ [(lastX-2,lastY+1)])
         m5 = move (list ++ [(lastX+1,lastY-2)])
         m6 = move (list ++ [(lastX+2,lastY-1)])
         m7 = move (list ++ [(lastX-1,lastY+2)])
         m8 = move (list ++ [(lastX-2,lastY-1)])
y = move [(1,1)]
main = print $ y

Do you know why it never finish (Maybe I can wait more...)? Do you have other solution to implement same brute-force algorithm but will work faster?

Answer 1

It does terminate (it runs for about 1 minute on my computer) and produces a correct answer.

One simple way to speed it up is to add a new move to the front of the list (and reverse the result before printing it). Adding the first element takes constant time, while append an element to the back of the list is linear in its size.

There is also a bug in your code: m3 and m7 are the same. After fixing this bug and adding the new move to the front of the list, the code runs in under once second:

maxX = 8
maxY = 8
maxSteps = 60

move :: [(Int, Int)] -> [( Int, Int)]
move list 
   | lastX > maxX || lastY > maxY || lastX <= 0 || lastY <= 0 = []
   | lastMove `elem` (tail list) = []
   | length list == maxSteps = list
   | length m1 == maxSteps = m1
   | length m2 == maxSteps = m2
   | length m3 == maxSteps = m3
   | length m4 == maxSteps = m4
   | length m5 == maxSteps = m5
   | length m6 == maxSteps = m6
   | length m7 == maxSteps = m7
   | length m8 == maxSteps = m8
   | otherwise = []
   where lastMove = head list
         lastX = fst lastMove
         lastY = snd lastMove
         m1 = move ((lastX + 1, lastY + 2) : list)
         m2 = move ((lastX + 2, lastY + 1) : list)
         m3 = move ((lastX - 1, lastY + 2) : list)
         m4 = move ((lastX - 2, lastY + 1) : list)
         m5 = move ((lastX + 1, lastY - 2) : list)
         m6 = move ((lastX + 2, lastY - 1) : list)
         m7 = move ((lastX - 1, lastY - 2) : list)
         m8 = move ((lastX - 2, lastY - 1) : list)
y = move [(1, 1)]
main = print $ reverse y    

I have a made a few more changes. First of all, I got rid of "manually" adding 8 possible moves at each step. We can use a list to do that. This approach helps to avoid bugs like this. It also turns out that the execution time depends on the order in which new moves are examined. This version finds an open tour in about a minute (and, in my opinion, it's more readable than the original code):

maxX = 8
maxY = 8
maxSteps = 64
shifts = [-1, 1, -2, 2]

move :: [(Int, Int)] -> [(Int, Int)]
move path
   | lastX > maxX || lastY > maxY || lastX <= 0 || lastY <= 0 = []
   | lastMove `elem` tail path = []
   | length path == maxSteps = path
   | not (null validNewPaths) = head validNewPaths
   | otherwise = []
   where lastMove@(lastX, lastY) = head path
         newPaths = [(lastX + x, lastY + y) : path | x <- shifts, y <- shifts, abs x /= abs y]
         validNewPaths = filter (\xs -> length xs == maxSteps) (map move newPaths) 

main = print $ reverse (move [(1, 1)])