{- |
Description: Knight's tour
Maintainer: dev@chungyc.org

Part of Ninety-Nine Haskell "Problems".  Some solutions are in "Solutions.P91".
-}
module Problems.P91 (knightsTour, closedKnightsTour, printKnightsTour) where

import qualified Data.Map.Strict as Map
import qualified Solutions.P91   as Solution

-- | Another famous problem is this one:
-- How can a knight jump on an $$N \times N$$ chessboard in such a way that it visits every square exactly once?
--
-- Write a function which returns a knight's tour ending at a particular square.
-- Represent the squares by their coordinates with
-- the tuple $$(x,y)$$, where $$1 \leq x \leq N$$ and $$1 \leq y \leq N$$.
-- A tour will be a list of these tuples of length $$N \times N$$.
--
-- === Examples
--
-- >>> printKnightsTour $knightsTour 6 (3,5) -- 24 7 32 17 22 5 -- 33 16 23 6 31 18 -- 8 25 10 19 4 21 -- 15 34 1 28 11 30 -- 26 9 36 13 20 3 -- 35 14 27 2 29 12 -- -- === __Hint__ -- -- A straightforward backtracking algorithm can be very slow even for -- moderately sized boards such as $$8 \times 8$$. -- Consider using [Warnsdorff's rule](https://en.wikipedia.org/wiki/Knight%27s_tour#Warnsdorff's_rule). -- Alternatively, consider using a divide-and conquer algorithm which -- finds knight's tours for smaller boards and patching them together. knightsTour :: Int -> (Int,Int) -> Maybe [(Int,Int)] knightsTour :: Int -> (Int, Int) -> Maybe [(Int, Int)] knightsTour = Int -> (Int, Int) -> Maybe [(Int, Int)] Solution.knightsTour -- | The same as 'knightsTour', except return a circular tour. -- I.e., the knight must be able to jump from the last position in the tour to the first position in the tour. -- Start the tour from $$(1,1)$$. -- -- === Examples -- -- >>> printKnightsTour$ closedKnightsTour 6
--  1 14 31 20  3  8
-- 32 21  2  7 30 19
-- 13 36 15  4  9  6
-- 22 33 24 27 18 29
-- 25 12 35 16  5 10
-- 34 23 26 11 28 17
closedKnightsTour :: Int -> Maybe [(Int,Int)]
closedKnightsTour :: Int -> Maybe [(Int, Int)]
closedKnightsTour = Int -> Maybe [(Int, Int)]
Solution.closedKnightsTour

-- | Print order of knight's tour on an $$N \times N$$ board.
printKnightsTour :: Maybe [(Int,Int)] -> IO ()
printKnightsTour :: Maybe [(Int, Int)] -> IO ()
printKnightsTour Maybe [(Int, Int)]
Nothing = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
printKnightsTour (Just [(Int, Int)]
path) = (Int -> IO ()) -> [Int] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(a -> m b) -> t a -> m ()
mapM_ (String -> IO ()
putStrLn (String -> IO ()) -> (Int -> String) -> Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
line) [Int
1..Int
n]
where order :: Map (Int, Int) Int
order = [((Int, Int), Int)] -> Map (Int, Int) Int
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([((Int, Int), Int)] -> Map (Int, Int) Int)
-> [((Int, Int), Int)] -> Map (Int, Int) Int
forall a b. (a -> b) -> a -> b
$[(Int, Int)] -> [Int] -> [((Int, Int), Int)] forall a b. [a] -> [b] -> [(a, b)] zip [(Int, Int)] path [Int 1..(Int nInt -> Int -> Int forall a. Num a => a -> a -> a *Int n)] line :: Int -> String line Int y = [String] -> String unwords ([String] -> String) -> [String] -> String forall a b. (a -> b) -> a -> b$ (Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> String
forall {a}. Show a => a -> String
showInt (Int -> String) -> (Int -> Int) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Int
x -> Map (Int, Int) Int
order Map (Int, Int) Int -> (Int, Int) -> Int
forall k a. Ord k => Map k a -> k -> a
Map.! (Int
x,Int
y))) [Int
1..Int
n]
showInt :: a -> String
showInt a
k = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (a -> String
forall {a}. Show a => a -> String
show a
k)) Char
' ' String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall {a}. Show a => a -> String
show a
k
width :: Int
width = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Int -> String
forall {a}. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
\$ Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
n)
l :: Int
l = [(Int, Int)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, Int)]
path
n :: Int
n = (Int -> Bool) -> (Int -> Int) -> Int -> Int
forall a. (a -> Bool) -> (a -> a) -> a -> a
until (\Int
k -> Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
l) (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int
1