Fill grid with squares which are all connected by free space

Question

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?

Answer 1

i think the following is better than a search, but it's based on a search, so i'll describe that first:

search

you can make a basic search efficient in various ways.

first, you need to enumerate the possible arrangements efficiently. i think i would do this by storing the number of shifts relative to the first position a farm can be placed, starting from the bottom (near the root). so (0) would be a single farm on the left of the bottom line; (1) would be that farm shifted one right; (0,0) would be two farms, first as (0), second at the first position possible scanning upwards (second line, touching first farm); (0,1) would have the second farm one to the right; etc.

second, you need to prune as efficiently as possible. there it's a trade-off between doing smart but expensive things, and dumb but fast things. dumb but fast would be a flood fill from the root, checking whether all farms can be reached. smarter would be working out how to do that in an incremental fashion when you add one farm - for example, you know that you can rely on previous flood fills cells smaller than the smallest value the farm covers. even smarter would be identifying which roads are critical (unique access to another farm) and "protecting" them in some way.

third, there may be extra tweaks you can do at a higher level. for example, it might be better to solve for a symmetric grid (and use symmetry to avoid repeating the same pattern in different ways) and then check which solutions are consistent with the grid you actually have. another approach that might be useful, but that i can't see how to make work, is to focus on the road rather than the farms.

caching

here's the secret sauce. the search i have described "fills up" farms into the space from the bottom, left to right scanning.

now imagine that you have run the search to the point where the space is full, with a nearly-optimal distribution. it may be that to improve that solution you have to backtrack almost to the start to rearrange a few farms "near the bottom". which is expensive because then you have to continue the search to re-fill the space above.

but you don't need to repeat the entire search if the "boundary" around the farms is the same as an earlier arrangement. because you've already "filled in" above that boundary in some optimal way. so you can cache by "best result for a given boundary" and simply look-up those solutions.

the boundary description must include the shape of the boundary and the positions of roads that provide access to the root. that is all.

Answer 2

Here's something kind of crude in Haskell, which could probably benefit from optimization, memoization, and better heuristics...

The idea is to start with a grid that is all farm and place roads on it, starting with the root and expanding from there. The recursion uses a basic heuristic, where the candidates are chosen from all adjacent straight-two-block segments all along the road/s, and only if they satisfy the requirement that adding the segment will increase the number of farms connected to the road/s (overlapping segments are just added as one block rather than two).

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

Output, small grid:
format: (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

Output, large grid:
format: (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....