Fill grid with squares which are all connected by free space - algorithm

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

Answer 3

I don't know if this solution will maximize your number farms, but you can try to put them in a regular way: allign them horizontally or vertically. You can stick 2 columns (or rows) together for the best density of farms. You should just take care to let 1 space on top/bottom (or left/right).
When you can't put more column (row), just check if you can put some farms near the border of your grid.
Wish it could help you !