📜 ⬆️ ⬇️

Haskel - knight's move II

image

In the second article I would like to continue the started topic and consider the task of finding a cyclic route when filling in NxN squares with a knight's move. But in the comments to the first article suggested an interesting heuristics, for which many thanks to the commentators, and this hint is certainly worth considering in more detail. The idea is known as the Varnsdorf rule and requires from the list of possible moves, first of all, choose a move with the least number of continuations. This allows not even at times, but by orders of magnitude to reduce the waiting time for the first decision. In this case, an additional test for connectivity becomes redundant, its quadratic complexity only hinders and slows down the process.

The basic recursion described in the previous article is easy to change to meet this rule, it is enough to sort the list of possible moves according to the required criterion.

knightsTo x [] = [[x]] knightsTo x xs = [x:ks | k <- ksort xs $ neighbours xs x, ks <- knightsTo k $ delete k xs] 

Finding free neighbors should be put into a separate function.
')
 neighbours xs x = filter (near x) xs where near (x1,y1) (x2,y2) = abs ((x2-x1)*(y2-y1)) == 2 

Things are easy , it remains to paint the sort function ksort , which orders the list of neighbors by the number of "neighbors of these neighbors." Alternatively, it can be done so

 ksort xs ns = map snd $ sort $ zip (map (length . neighbours xs) ns) ns 

For each neighbor in the ns list, we find a list of its possible moves and calculate its length. We arrange the lengths in pairs with the coordinates of the neighbors. The regular sort sorts by the first element, i.e. in length, after which we discard the first elements of the pairs, leaving only the second ones.

Somewhat ornate, but most importantly - the result. What is there 10x10 - 50x50 in less than a minute! And even 90x90, if you just wait. Here is the result of 100x100 did not wait.

By experimenting with intermediate sizes of squares, you can find out that the algorithm starts to stumble even earlier. The first problematic square turns out to be 49x49, the second 60x60, then there are squares with sides 64, 76, 87, 89 and 98. But if you go around the square not from the lower left corner, but, say, from the opposite, then for squares with sides 49, 60 and 64 solutions are now found, but problems for other squares are emerging, starting from the size of 23x23. The upper left corner allows you to find a route in the 76x76 square (and, by the way, 100x100), but problems are found in a square with a side of 32.

Such selective fastidiousness is a little surprising and it seems illogical, but even this rule may have uncertainties when choosing a move. Neighbors with the same minimum number of outcomes are also desirable to somehow streamline, perhaps these situations are critical. But here, really, the more we find the answers, the more questions arise. On this topic with arbitrary routes, I think you can close and go to closed routes.

This task is considered more complex, and, indeed, the requirement to return to the initial cell seems to be difficult. After all, when building a closed route, we must always leave a loophole for returning. In other words, the starting cell must remain accessible from the current position at each step of construction. But here it is worth remembering again about the connectivity check and the dropped function of connected . Since the same requirement of connectedness now extends to the initial cell, as well as to unoccupied cells, you just need to add it to the general list with each call of the check function. And the initial cell itself can be passed into recursion as another parameter.

 knFromTo x _ [] = [[x]] knFromTo xs xs = [x:ks | connected [x] (s:xs), k <- ksort xs $ neighbours xs x, ks <- knFromTo ks $ delete k xs] 

In an amicable way, to guarantee the result, in the base of the recursion it was also worth adding a check that the last occupied cell is connected to the initial move of the knight. But, since any route is definitely completed in two moves to the end, for an even number of cells this check is not necessary, but for an odd number of closed routes it still does not exist, and for this variant the algorithm will try to close the path until the last move, and in the absence of the checkout simply fills the remaining cell.

Slightly correct interface

 knight n = head . knFromTo (1,1) (1,1) $ tail [(x,y) | x <- [1..n], y <- [1..n]] 

And we are experimenting a little ...
 *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)] 


For even-sized squares (and odd ones are not interesting), the results are up to the size of 50x50, but the quadratic complexity of the additional check affects and the last result has to wait 40 minutes.

By the way, it can be noted that it is not necessary to indicate the initial cell as the final goal. You can specify any other one, and when building a route, the algorithm will diligently strive towards it. To strive in the sense that after filling the entire area in the specified cell, you can move on to the next move. This can be used when building chains, as already described in the previous article. Only now, thanks to such a targeted search, the solution will be much faster. It is only necessary to take into account the peculiarity of the knight's move and remember that for an even number of cells, the target position must have the same color of the chess coloring as the initial color, in other words, the parity of the sum of coordinates must match. And for an odd number of cells, color and, accordingly, parity must alternate.

Some code and experiments ...
As in the previous article, we describe the function of filling with squares, this time of arbitrary size

 knightN n ((m,l), st, fin) = head . knFromTo st fin $ delete st [(x,y) | x <- [m..m+n-1], y <- [l..l+n-1]] 

And apply it to the specified parameters

 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))] 


The 10x10 square by splitting into four 5x5 squares is now instantly filled. For the problematic 52x52 square, filling a closed chain of four 26x26 squares fits into 5 minutes of waiting (and in the 50x50 square, as already mentioned, the cycle was searched for 40 minutes). The splitting into 16 squares of 13x13 is cyclically filled at all in a half dozen seconds. So for large sizes this method of filling with small areas may still be useful.

But god with them, with big squares. Finally, I would like to touch on another interesting problem and try to calculate the number of closed paths (or, what's too embarrassing, Hamiltonian cycles) in a particular graph figure. At least, now it is possible to calculate the number of directed cycles, for which the interface function simply removes the call to head , after which the function will search not only the first but also all possible routes, and add a call to length to count their number. Well, be patient.

 kNCircles :: Int -> Int -> Int kNCircles mn = length . knFromTo (1,1) (1,1) $ delete (1,1) [(x,y) | x <- [1..m], y <- [1..n]] 

For an odd number of cells, as we have said, such cycles do not exist. For rectangles with the length of one side in 4 cells, they also cannot be built, which is proved, for example, in the book by E. Gick “Mathematics on a chessboard”. The sizes 5x6 and 3x10 are the smallest among the permissible rectangles, and for each of them the program in a few minutes finds 16 and 32 variants, respectively. The 3x12 rectangle contains 352 cyclic routes, 3x14 - 3 072, and for the 6x6 square of such cycles there are already 19,724 (with the directional unclosed routes, 524,486 are found from only one corner, who would have thought!), But the time to count is half a day already. Exhibitor in all its glory. Large areas and computations will require orders of magnitude more.

In principle, to reduce brute force, you can also add a check for the absence of deadlocks to the main function. All free cells, except perhaps the current and the final, must have at least two neighbors. It is also possible to reduce the connectivity check to linear complexity, if the neighbors are found in constant time. To do this, however, it is necessary to complicate the data structure, and, for example, go to the honest presentation of graphs in the form of a list of connections. But, firstly, I would not want to get into the wilds, and, secondly, if you believe the estimate from Wikipedia , there still is not enough to count the number of cycles in the 8x8 square of these optimizations. Alas, the 13 trillion variants are not calculated by brute force.

And for those who want to experiment the latest developments can be combined into one module.

knights.hs
 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)] 

PS Well, a much more productive option in the graph representation

 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) 

Start
Conclusion

Source: https://habr.com/ru/post/357702/


All Articles