17

I have a grid with x fields. This grid should be filled with as much sqaures (lets call them "farms") of the size 2x2 (so each farm is 4 fields in size) as possible. Each farm has to be connected to a certain field ("root") through "roads".

I have written a kind of brute force algorithm which tries every combination of farms and roads. Everytime a farm is placed on the grid, the algorithm checks, if the Farm has a connection to the root using the A* algorithm. It works very well on small grids, but on large grids, it's too time consuming.

Here is a small already solved grid

http://www.tmk-stgeorgen.at/algo/small.png

Blue squares are the farms, red squares are free space or "roads" and the filled red square is the root field, to which every farm needs a connection.

I need to solve this grid:

http://www.tmk-stgeorgen.at/algo/grid.png

Is there any fast standard algorithm, which I can use?

4

3 回答 3

1

我认为以下内容比搜索要好，但它是基于搜索的，所以我先描述一下：

搜索

您可以通过各种方式使基本搜索高效。

首先，您需要有效地列举可能的安排。我想我会通过存储相对于农场可以放置的第一个位置的班次数来做到这一点，从底部（靠近根部）开始。所以 (0) 将是底线左侧的单个农场；(1) 是农场右移一位；(0,0) 将是两个农场，第一个为 (0)，第二个位于可能向上扫描的第一个位置（第二行，接触第一个农场）；(0,1) 将有第二个农场在右边；等等

其次，您需要尽可能高效地进行修剪。在做聪明但昂贵的事情和愚蠢但快速的事情之间需要权衡取舍。愚蠢但快速将是从根部填充洪水，检查是否可以到达所有农场。当您添加一个农场时，更聪明的人会以增量方式研究如何做到这一点 - 例如，您知道您可以依赖先前的洪水填充单元格小于农场覆盖的最小值。更聪明的是确定哪些道路是关键的（通往另一个农场的唯一通道）并以某种方式“保护”它们。

第三，您可以在更高级别上进行额外的调整。例如，解决对称网格可能会更好（并使用对称性来避免以不同方式重复相同的模式），然后检查哪些解决方案与您实际拥有的网格一致。另一种可能有用但我不知道如何工作的方法是专注于道路而不是农场。

缓存

这是秘方。我描述的搜索从底部从左到右扫描“填充”农场进入空间。

现在想象一下，您已经将搜索运行到空间已满且分布接近最佳的位置。可能是为了改进该解决方案，您必须几乎从一开始就重新安排一些“接近底部”的农场。这很昂贵，因为您必须继续搜索以重新填充上面的空间。

但如果农场周围的“边界”与之前的安排相同，则无需重复整个搜索。因为您已经以某种最佳方式“填充”了该边界之上。因此您可以通过“给定边界的最佳结果”缓存并简单地查找这些解决方案。

边界描述必须包括边界的形状和通往根部的道路的位置。就这些。

于 2013-06-25T23:57:25.560 回答
1

这是 Haskell 中的一些粗略的东西，它可能会受益于优化、记忆和更好的启发式算法......

这个想法是从一个全是农场的网格开始，并在上面放置道路，从根开始并从那里扩展。递归使用基本启发式方法，其中候选者是从沿道路的所有相邻直两块路段中选择的，并且仅当它们满足添加路段将增加连接到道路的农场数量的要求时/ s（重叠段只是作为一个块而不是两个块添加）。

import qualified Data.Map as M
import Data.List (nubBy)

-- (row,(rowLength,offset))
grid' = M.fromList [(9,[6])
                  ,(8,[5..7])
                  ,(7,[4..8])
                  ,(6,[3..9])
                  ,(5,[2..10])
                  ,(4,[1..11])
                  ,(3,[2..10])
                  ,(2,[3..9])
                  ,(1,[4..7])]

grid = M.fromList [(19,[10])
                   ,(18,[9..11])
                   ,(17,[8..12])
                   ,(16,[7..13])
                   ,(15,[6..14])
                   ,(14,[5..15])
                   ,(13,[4..16])
                   ,(12,[3..17])
                   ,(11,[2..18])
                   ,(10,[1..19])
                   ,(9,[1..20])
                   ,(8,[1..19])
                   ,(7,[2..18])
                   ,(6,[3..17])
                   ,(5,[4..16])
                   ,(4,[5..15])
                   ,(3,[6..14])
                   ,(2,[7..13])
                   ,(1,[8..11])]

root' = (1,7) --(row,column)
root = (1,11) --(row,column)

isOnGrid (row,col) =
  case M.lookup row grid of
    Nothing -> False
    Just a  -> elem col a

isFarm (topLeftRow,topLeftCol) =
  and (map isOnGrid [(topLeftRow,topLeftCol),(topLeftRow,topLeftCol + 1)
                    ,(topLeftRow - 1,topLeftCol),(topLeftRow - 1,topLeftCol + 1)])

isNotOnFarm tile@(r,c) farm@(fr,fc) =
  not (elem r [fr,fr - 1]) || not (elem c [fc, fc + 1])

isOnFarm tile@(r,c) farm@(fr,fc) =
  elem r [fr,fr - 1] && elem c [fc, fc + 1]

farmOnFarm farm@(fr,fc) farm' =
  or (map (flip isOnFarm farm') [(fr,fc),(fr,fc + 1),(fr - 1,fc),(fr - 1,fc + 1)])                 

addRoad tile@(r,c) result@(road,(numFarms,farms))
  | not (isOnGrid tile) || elem tile road = result
  | otherwise = (tile:road,(length $ nubBy (\a b -> farmOnFarm a b) farms',farms'))
    where
      newFarms' = filter (isNotOnFarm tile) farms
      newFarms = foldr comb newFarms' adjacentFarms
      farms' = newFarms ++ adjacentFarms
      comb adjFarm newFarms'' =
        foldr (\a b -> if farmOnFarm a adjFarm || a == adjFarm then b else a:b) [] newFarms''
      adjacentFarms = filter (\x -> isFarm x && and (map (flip isNotOnFarm x) road)) 
                        [(r - 1,c - 1),(r - 1,c),(r,c - 2),(r + 1,c - 2)
                        ,(r + 2,c - 1),(r + 2,c),(r + 1,c + 1),(r,c + 1)]

candidates result@(road,(numFarms,farms)) = 
  filter ((>numFarms) . fst . snd) 
  $ map (\roads -> foldr (\a b -> addRoad a b) result roads) 
  $ concatMap (\(r,c) -> [[(r + 1,c),(r + 1,c - 1)],[(r + 1,c),(r + 1,c + 1)]
                         ,[(r,c - 1),(r + 1,c - 1)],[(r,c - 1),(r - 1,c - 1)]
                         ,[(r,c + 1),(r + 1,c + 1)],[(r,c + 1),(r - 1,c + 1)]
                         ,[(r - 1,c),(r - 1,c - 1)],[(r - 1,c),(r - 1,c + 1)]
                         ,[(r + 1,c),(r + 2,c)],[(r,c - 1),(r,c - 2)]
                         ,[(r,c + 1),(r,c + 2)],[(r - 1,c),(r - 2, c)]]) road

solve = solve' (addRoad root ([],(0,[]))) where
  solve' result@(road,(numFarms,farms)) =
    if null candidates'
       then [result]
       else do candidate <- candidates'
               solve' candidate
   where candidates' = candidates result

b n = let (road,(numFarms,farms)) = head $ filter ((>=n) . fst . snd) solve
      in (road,(numFarms,nubBy (\a b -> farmOnFarm a b) farms))

输出，小网格：
格式：(road/s,(numFarms,farms))

*Main> b 8
([(5,5),(5,4),(6,6),(4,6),(5,6),(4,8),(3,7),(4,7),(2,7),(2,6),(1,7)]
,(8,[(2,4),(3,8),(5,9),(8,6),(6,7),(5,2),(4,4),(7,4)]))
(0.62 secs, 45052432 bytes)

Diagram (O's are roads):

     X
    XXX
   XXXXX
  XXXOXXX
 XXOOOXXXX
XXXXXOOOXXX
 XXXXXOXXX
  XXXOOXX
   XXXO

输出，大网格：
格式：(road/s,(numFarms,farms))

*Main> b 30
([(9,16),(9,17),(13,8),(13,7),(16,10),(7,6),(6,6),(9,3),(8,4),(9,4),(8,5)
 ,(8,7),(8,6),(9,7),(10,8),(10,7),(11,8),(12,9),(12,8),(14,9),(13,9),(14,10)
 ,(15,10),(14,11),(13,12),(14,12),(13,14),(13,13),(12,14),(11,15),(11,14)
 ,(10,15),(8,15),(9,15),(8,14),(8,13),(7,14),(7,15),(5,14),(6,14),(5,12)
 ,(5,13),(4,12),(3,11),(4,11),(2,11),(2,10),(1,11)]
,(30,[(2,8),(4,9),(6,10),(4,13),(6,15),(7,12),(9,11),(10,13),(13,15),(15,13)
     ,(12,12),(13,10),(11,9),(9,8),(10,5),(8,2),(10,1),(11,3),(5,5),(7,4),(7,7)
     ,(17,8),(18,10),(16,11),(12,6),(14,5),(15,7),(10,18),(8,16),(11,16)]))
(60.32 secs, 5475243384 bytes)

*Main> b 31
still waiting....
于 2013-06-26T23:26:51.493 回答
0

我不知道这个解决方案是否会最大化您的农场数量，但您可以尝试以常规方式放置它们：水平或垂直排列它们。您可以将 2 列（或行）粘在一起以获得最佳的农场密度。您应该注意在顶部/底部（或左/右）留出 1 个空间。

当您无法放置更多列（行）时，只需检查是否可以在网格边界附近放置一些农场。

希望它可以帮助你！

于 2013-06-25T13:01:31.787 回答