{- |
Description: Knight's tour
Copyright: Copyright (C) 2023 Yoo Chung
License: GPL-3.0-or-later
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 = forall (m :: * -> *) a. Monad m => a -> m a
return ()
printKnightsTour (Just [(Int, Int)]
path) = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
line) [Int
1..Int
n]
  where order :: Map (Int, Int) Int
order = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [(Int, Int)]
path [Int
1..(Int
nforall a. Num a => a -> a -> a
*Int
n)]
        line :: Int -> String
line Int
y = [String] -> String
unwords forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall {a}. Show a => a -> String
showInt forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\Int
x -> Map (Int, Int) Int
order 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 = forall a. Int -> a -> [a]
replicate (Int
width forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall {a}. Show a => a -> String
show a
k)) Char
' ' forall a. [a] -> [a] -> [a]
++ forall {a}. Show a => a -> String
show a
k
        width :: Int
width = forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall {a}. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Int
nforall a. Num a => a -> a -> a
*Int
n)
        l :: Int
l = forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Int, Int)]
path
        n :: Int
n = forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\Int
k -> Int
kforall a. Num a => a -> a -> a
*Int
k forall a. Eq a => a -> a -> Bool
== Int
l) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
dropWhile (\Int
k -> Int
kforall a. Num a => a -> a -> a
*Int
k forall a. Ord a => a -> a -> Bool
< Int
l) [Int
1..]