Question

我有一个带x字段的网格。该网格应尽可能多地填充大小为2x2的sqaures（称之为“farm”）（因此每个场的大小为4个字段）。每个农场必须通过“道路”连接到某个区域（“根”）。

我写了一种蛮力算法，它尝试了农场和道路的每一个组合。每次将场置于网格上时，算法都会检查Farm是否使用A *算法与根连接。它适用于小网格，但在大网格上，它太耗时了。

这是一个已经解决的小网格

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

蓝色方块是农场，红色方块是自由空间或“道路”，填充的红色方块是根区域，每个农场都需要连接。

我需要解决这个网格：

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

我可以使用快速标准算法吗？

Answer 1

我认为以下内容比搜索更好，但它基于搜索，所以我先说明一下：

搜索

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

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

第二，你需要尽可能有效地修剪。在那里做一些聪明但昂贵的事情和愚蠢而快速的事情之间的权衡。愚蠢但快速的是从根部充满洪水，检查是否可以到达所有农场。当你添加一个服务器场时，更聪明的是会以增量的方式解决这个问题 - 例如，你知道你可以依赖以前的洪水填充单元格小于农场覆盖的最小值。更聪明的是确定哪条道路是关键的（对另一个农场的独特访问）并以某种方式“保护”它们。

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

<强>缓存

这是秘密酱。我所描述的搜索从底部，从左到右扫描“填满”农场进入空间。

现在想象一下，您已将搜索运行到空间已满的点，并具有近乎最佳的分布。可能是为了改进这个解决方案，你必须回溯到几乎开始重新安排一些“靠近底部”的农场。这是昂贵的，因为那时你必须继续搜索重新填充上面的空间。

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

边界描述必须包括边界的形状和提供对根的访问的道路的位置。就是这样。

Answer 2

这是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，farm））

*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，farm））

*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....

Answer 3

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

如果您无法添加更多列（行），只需检查是否可以将某些服务器场放置在网格的边框附近。

希望它可以帮到你！

用正方形填充网格，所有正方形均由自由空间连接

3 个答案: