knightsTo x [] = [[x]] knightsTo x xs = [x:ks | k <- ksort xs $ neighbours xs x, ks <- knightsTo k $ delete k xs]
neighbours xs x = filter (near x) xs where near (x1,y1) (x2,y2) = abs ((x2-x1)*(y2-y1)) == 2
ksort xs ns = map snd $ sort $ zip (map (length . neighbours xs) ns) ns
knFromTo x _ [] = [[x]] knFromTo xs xs = [x:ks | connected [x] (s:xs), k <- ksort xs $ neighbours xs x, ks <- knFromTo ks $ delete k xs]
knight n = head . knFromTo (1,1) (1,1) $ tail [(x,y) | x <- [1..n], y <- [1..n]]
*Main> knightC 6 [(1,1),(2,3),(1,5),(3,6),(5,5),(6,3),(5,1),(4,3),(3,1),(1,2),(2,4),(1,6),(3,5),(5,6),(6,4),(5,2),(4,4),(6,5),(4,6),(2,5),(1,3),(2,1),(3,3),(1,4),(2,2),(4,1),(6,2),(5,4),(6,6),(4,5),(2,6),(3,4),(4,2),(6,1),(5,3),(3,2)]
*Main> knightC 7 [(1,1),(2,3),(1,5),(2,7),(4,6),(6,7),(7,5),(5,6),(7,7),(6,5),(5,7),(7,6),(6,4),(7,2),(5,1),(6,3),(7,1),(5,2),(3,1),(1,2),(2,4),(1,6),(3,7),(2,5),(1,7),(3,6),(5,5),(4,3),(2,2),(1,4),(3,5),(4,7),(2,6),(3,4),(1,3),(2,1),(4,2),(6,1),(7,3),(5,4),(3,3),(4,1),(6,2),(7,4),(6,6),(4,5),(5,3),(3,2),(4,4)]
*Main> knightC 8 [(1,1),(2,3),(1,5),(2,7),(4,8),(6,7),(8,8),(7,6),(6,8),(8,7),(7,5),(8,3),(7,1),(5,2),(3,1),(1,2),(2,4),(1,6),(2,8),(3,6),(1,7),(3,8),(5,7),(7,8),(8,6),(7,4),(8,2),(6,1),(4,2),(2,1),(1,3),(2,5),(3,3),(1,4),(2,2),(4,1),(6,2),(8,1),(7,3),(5,4),(3,5),(4,3),(5,1),(6,3),(5,5),(4,7),(2,6),(1,8),(3,7),(4,5),(6,6),(5,8),(4,6),(3,4),(5,3),(7,2),(8,4),(6,5),(7,7),(8,5),(6,4),(5,6),(4,4),(3,2)]
knightN n ((m,l), st, fin) = head . knFromTo st fin $ delete st [(x,y) | x <- [m..m+n-1], y <- [l..l+n-1]]
knights10 = concatMap (knightN 5) [((1,1),(5,5),(5,6)), ((1,6),(5,6),(6,6)), ((6,6),(6,6),(6,5)), ((6,1),(6,5),(5,5))] knights4x26 = concatMap (knightN 26) [((1 , 1),(26,26),(1 ,27)), ((1 ,27),(1 ,27),(27,27)), ((27,27),(27,27),(52,26)), ((27, 1),(52,26),(26,26))] knights16x13 = concatMap (knightN 13) [((27,27),(27,27),(27,26)), ((27,14),(27,26),(27,13)), ((27, 1),(27,13),(40,13)), ((40, 1),(40,13),(40,14)), ((40,14),(40,14),(40,27)), ((40,27),(40,27),(40,40)), ((40,40),(40,40),(39,40)), ((27,40),(39,40),(26,40)), ((14,40),(26,40),(13,40)), ((1 ,40),(13,40),(13,39)), ((1 ,27),(13,39),(13,26)), ((1 ,14),(13,26),(13,13)), ((1 , 1),(13,13),(14,13)), ((14, 1),(14,13),(14,14)), ((14,14),(14,14),(14,27)), ((14,27),(14,27),(27,27))]
kNCircles :: Int -> Int -> Int kNCircles mn = length . knFromTo (1,1) (1,1) $ delete (1,1) [(x,y) | x <- [1..m], y <- [1..n]]
import Data.List(delete, (\\), sort) type Cell = (Int, Int) type Pool = [Cell] type Track = [Cell] near :: Cell -> Cell -> Bool near (x1,y1) (x2,y2) = abs ((x2-x1)*(y2-y1)) == 2 neighbours :: Pool -> Cell -> Track neighbours xs x = filter (near x) xs connected :: Track -> Pool -> Bool connected _ [] = True connected [] _ = False connected (x:xs) ws = let ns = neighbours ws x in connected (xs++ns) (ws\\ns) deadlocks :: Pool -> Track deadlocks xs = map snd . filter ((<2) . fst) $ zip (map (length . neighbours xs) xs) xs ksort :: Pool -> Track -> Track ksort xs ks = map snd . sort $ zip (map (length . neighbours xs) ks) ks knFromTo :: Cell -> Cell -> Pool -> [Track] knFromTo x _ [] = [[x]] knFromTo xs xs = [x:ks | connected [x] $ s:xs, deadlocks (x:s:xs) \\ [x,s] == [], k <- ksort xs $ neighbours xs x, ks <- knFromTo ks $ delete k xs] knightC :: Int -> Track knightC n = head . knFromTo (1,1) (1,1) $ tail [(x,y) | x <- [1..n], y <- [1..n]] kNCircles :: Int -> Int -> Int kNCircles mn = length . knFromTo (1,1) (3,2) $ [(x,y) | x <- [1..m], y <- [1..n]] \\ [(1,1),(3,2)]
import Data.List(delete, sortOn) import qualified Data.Map.Lazy as M import System.Environment (getArgs) type Cell = (Int, Int) type Pool = M.Map Cell [Cell] kDel :: Cell -> Pool -> Pool kDel x xs = M.delete x $ foldr (M.adjust (delete x)) xs (xs M.! x) connected :: [Cell] -> Pool -> Bool connected [] ws = null ws connected (x:xs) ws | M.member x ws = connected (ws M.! x ++ xs) (M.delete x ws) | otherwise = connected xs ws knFromTo :: [Cell] -> Cell -> Pool -> [[Cell]] knFromTo nx s xs | M.size xs == 1 = [[s]] | otherwise = [k:ks | k <- sortOn (length . (xs M.!)) nx, k /= s, connected [k] xs, ks <- knFromTo (xs M.! k) s (kDel k xs)] knightC :: Int -> [Cell] knightC n = head $ knFromTo [(1,1)] (3,2) $ prepare $ (,) <$> [1..n] <*> [1..n] where prepare xs = M.fromList [(x, filter (near x) xs) | x <- xs] near (x1,y1) (x2,y2) = abs ((x2 - x1) * (y2 - y1)) == 2 main = do [n] <- getArgs print $ knightC (read n)
Source: https://habr.com/ru/post/357702/
All Articles