📜 ⬆️ ⬇️

Haskell - knight's move 3. Conclusion

image

At the end of the second article, I tried to solve another problem related to the knight's move and calculate the number of closed routes in the rectangle mxn , but did not progress further than the 6x6 square. After a series of optimizations, the calculations were accelerated by six orders of magnitude, i.e. about a million times and come close to the square of 8x8, calculating the number of cycles in a rectangle of 7x8.

Let the 8x8 square still seem inaccessible to a rough search, but such acceleration indicates a good potential of both the language and the task as a whole. And, in fact, I would like to share the experience of the disclosure of these potentials with the readers.
')
In the same place, at the end of the previous article I mentioned two ideas. The first and, perhaps, the main one is to check for the absence of dead-end branches. At each step of construction in the remaining graph there should not be isolated and intermediate suspended vertices. In other words, each free cell, except perhaps the current and final, must have at least two free (in terms of the knight's move) neighbors.

This one check allows reducing the calculations by more than two orders of magnitude. And this is despite the fact that in the list version it looks quite tricky and, like the test for connectivity, it has quadratic complexity. And this complexity is due to the fact that for each cell, over and over again, the same list of neighbors is almost always searched.

We proceed to the second idea - for all cells to calculate the connectivity lists ahead of time once, and then only change as needed. You can store key-value pairs in different ways, even in the same lists, but the lists of search and delete operations have complexity O (n) . There are more optimal data structures, for example, balanced binary trees, and in the Haskell language, such a structure has long been implemented in the Data.Map module. All basic operations with this structure have a complexity of no more than O (log n) , and, most importantly, the search function for isolated and dangling vertices now takes an elegant form

deadlocks = keys . filter ((<2).length) 

And its complexity improves to O (n) .

The interface function due to the volume of preparatory actions is quite strongly transformed.

 kNCircles mn = kNFromTo [(2,3)] (3,2) $ prepare $ tail [(x,y) | x <- [1..m], y <- [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 

As for the main recursion, since the routes themselves are now uninteresting, we are only interested in their number, from building up chains you can proceed to a simple calculation of the number of successes. And with the new data structure, the function takes the following form

 kNFromTo ks s xs | size xs == 1 = 1 | otherwise = sum [kNFromTo (xs ! k) s (kDel k xs) | k <- filter (/= s) ks, null $ deadlocks xs \\ [k,s]] 

At the entrance she has a list of possible moves, the final cell and the graph of unoccupied vertices.
Well, since when deleting a vertex from a graph, it is also necessary to remove its mention in the neighbor connectivity lists, the removal function will have to be written separately

 kDel x xs = delete x $ foldr (adjust (delete x)) xs (xs ! x) 

It looks fancy, but the total complexity remains O (log n) , albeit with a sufficiently large coefficient

By the way, I forgot to say that the connectivity check used in the last article now becomes superfluous. If you require the absence of other pendant vertices, except the current and final, the algorithm in no other cell can finish the calculation and cannot. Yes, this does not exclude the occurrence of isolated cycles along the way, which are not immediately eliminated. The connectivity check in this case could be useful, but in practice such situations are rare and this time additional complexity is not interrupted by added merits.

Further, if we analyze the process of the occurrence of pendant vertices, it can be noted that the degree of the vertex in the graph decreases only when the neighbor is removed. Therefore, the filtration of degrees can be carried out not over the entire graph, but only according to the list of adjacent vertices.

 deadlocks xs = filter ((<2).length.(xs !)) 

And thus, the complexity of the test is improved to O (log n) .

All weak spots left, you can only slightly twist what is. More precisely, theoretically, one could still accelerate a couple of times, moving to arrays. Actually arrays for rectangles are generally the most obvious data structure. And the search for an element requires O (1) time, and this is the most requested operation. But in Haskell, to preserve cleanliness, when elements are changed, a new copy of the array is created, and this is O (n). As a result, instead of acceleration, it is one and a half times slower.

But! So far, we have been digging the problem deep into, but you can go and, so to speak, "in breadth". All calculations in the Haskell language are performed single-threaded by default, on a single core. And there are several cores, even if at times virtual ones. And since the struggle for productivity has gone, I would like to load them all, this will allow us to speed up the calculations by an order of magnitude (plus or minus).

While searching for material on parallelization of computations, I came across an interesting article , which says that pure Haskell computations are not easy to parallelize, but very simple. And for this we have almost everything. It is enough to load the Control.Parallel.Strategies module and add the magic line `using` parList rdeepseq in the recursion after the list constructor.

Below I have a listing of the final version. The program must be compiled with the -threaded key and, when running, specify the + RTS -N keys in the parameters other than the size of the rectangle, for example knc 7 6 + RTS -N .

knc.hs
 import Data.List(delete, (\\)) import qualified Data.Map.Lazy as M import Control.Parallel.Strategies import System.Environment 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) deadlocks :: Pool -> [Cell] -> [Cell] deadlocks xs = filter ((<2).length.(xs M.!)) kNFromTo :: [Cell] -> Cell -> Pool -> Int kNFromTo ks s xs | M.size xs == 1 = 1 | otherwise = sum ( [kNFromTo (xs M.! k) s (kDel k xs) | k <- ks, k /= s, null $ deadlocks xs ks \\ [k,s]] `using` parList rdeepseq ) kNCircles :: Int -> Int -> Int kNCircles mn = kNFromTo [(2,3)] (3,2) $ prepare $ tail [(x,y) | x <- [1..m], y <- [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 [m,n] <- getArgs print $ kNCircles (read m) (read n) 


The simplicity of the implementation of concurrency and its result are, of course, impressive. Theoretically, the program is able to parallelize on the number of threads equal to the number of branches, i.e. total number of closed routes. Unfortunately, there are no such number of cores, but the available 8 (tried and 24) are loaded at 100% with multiple acceleration. And this final acceleration allowed for a week of calculations to split the rectangle 7x8, having found 34,524,432,316 cycles in it. This turned out to be even more than expected, and now the estimate from Wikipedia for the 8x8 square seems quite real.

Summing up, I would like to say that the task of the knight's move turned out to be unexpectedly versatile and served as a good practice in learning the language. Well, along the way, it turned out to create several new numerical sequences corresponding to the number of closed undirected routes by running the knight in the rectangles:

3x2n:
 0, 0, 0, 0, 16, 176, 1536, 15424, 147728, 1448416, 14060048, 136947616, 1332257856, 12965578752, … 

5x2n:
 0, 0, 8, 44202, 13311268, 4557702762, … 

6xn:
 0, 0, 0, 0, 8, 9862, 1067638, 55488142, 3374967940, 239187240144, … 

7x2n:
 0, 0, 1067638, 34524432316, … 

And although I wrote the word “conclusion” in the title, it’s too early to put a full stop in the task itself.

PS The task did not immediately let go ...
... periodically came ideas for further optimization of calculations. Of course, not everything worked, but fine tuning was able to accelerate three times more. Not very much, busting an 8x8 square on one machine now requires three years of work, but on a farm of two dozen knots, the result was achieved in a little over two months. And this result completely coincided with Wikipedia, the 8x8 square contains 13,267,364,410,532 closed routes. The sensation did not happen, was five years late, but now, I hope, I will let it go)

 import Data.List (delete) import qualified Data.Map.Lazy as M import Control.Parallel.Strategies import System.Environment (getArgs) type Cell = 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) kNC :: [Cell] -> Pool -> Integer kNC ks xs | M.size xs == 4 = 1 | otherwise = let ds = filter (null.tail.(xs M.!)) ks in if null ds then sum ( [ kNC (xs M.! k) (kDel k xs) | k <- ks, k /= 1 ] `using` parList rseq ) else let k = head ds in if null (tail ds) && k /= 1 then kNC (xs M.! k) (kDel k xs) else 0 kNCircles :: Int -> Int -> Integer kNCircles mn = kNC [m] $ prepare $ tail [(x,y) | x <- [1..m], y <- [1..n]] where prepare xs = M.adjust (++[1]) 1 $ M.fromList [(enc x, enc <$> filter (near x) xs) | x <- xs] near (x1,y1) (x2,y2) = abs ((x2 - x1) * (y2 - y1)) == 2 enc (x,y) = (y - 2) * m + x - 2 main = do [m,n] <- getArgs print $ kNCircles (read m) (read n) 



→ Part One
→ Part Two

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


All Articles