У меня есть сетка с полями x. Эта сетка должна быть заполнена таким же количеством sqaures (позволяет называть их "фермами" ) размером 2x2 (поэтому каждая ферма имеет 4 поля по размеру). Каждая ферма должна быть подключена к определенному полю ( "корень" ) через "дороги".
Я написал своего рода алгоритм грубой силы, который пробует каждую комбинацию ферм и дорог. Каждый раз, когда ферма помещается в сетку, алгоритм проверяет, имеет ли ферму соединение с корнем, используя алгоритм A *. Он работает очень хорошо на небольших сетках, но на больших сетках он слишком трудоемкий.
Синие квадраты - это фермы, красные квадраты - это свободное пространство или "дороги", а заполненный красный квадрат - это корневое поле, которому каждая ферма нуждается в соединении.
Ответ 1
Я думаю, что следующее лучше, чем поиск, но оно основано на поиске, поэтому я опишу это в первую очередь:
поиск
вы можете сделать основной поиск эффективным по-разному.
во-первых, вам необходимо правильно рассчитать возможные механизмы. я думаю, что сделал бы это, сохранив количество сдвигов относительно первой позиции, в которую может быть помещена ферма, начиная со дна (рядом с корнем). поэтому (0) будет одной фермой слева от нижней строки; (1) было бы, что ферма сдвинулась вправо; (0,0) было бы два фермы, сначала как (0), второе - в первой позиции, возможное сканирование вверх (вторая строка, касающаяся первой фермы); (0,1) будет иметь вторую ферму справа; и др.
во-вторых, вам нужно обрезать как можно более эффективно. там это компромисс между умными, но дорогими вещами и немыми, но быстрыми вещами. тупой, но быстрый будет заливать поток от корня, проверяя, могут ли быть достигнуты все фермы. умнее будет разрабатывать, как это сделать постепенно, когда вы добавляете одну ферму - например, вы знаете, что вы можете полагаться на предыдущие потоки, заполняющие ячейки, меньшие, чем наименьшее значение, которое покрывает ферма. даже умнее было бы определить, какие дороги являются критическими (уникальный доступ к другой ферме) и "защищать" их каким-то образом.
в-третьих, могут быть дополнительные настройки, которые вы можете сделать на более высоком уровне. например, лучше было бы решить для симметричной сетки (и использовать симметрию, чтобы избежать повторения одного и того же шаблона по-разному), а затем проверить, какие решения согласуются с сеткой, которую вы на самом деле имеете. другой подход, который может быть полезен, но я не могу понять, как сделать работу, - это сосредоточиться на дороге, а не на фермах.
кэширование
вот секретный соус. поиск, который я описал, "заполняет" фермы в пространстве снизу, слева направо.
Теперь представьте, что вы выполнили поиск до точки, где пространство заполнено, с почти оптимальным распределением. возможно, чтобы улучшить это решение, вам нужно отступить почти до самого начала, чтобы перестроить несколько ферм "около дна". что дорого, потому что тогда вам нужно продолжить поиск, чтобы заполнить пробел выше.
но вам не нужно повторять весь поиск, если "граница" вокруг ферм совпадает с предыдущей компоновкой. потому что вы уже "заполнили" выше этой границы некоторым оптимальным способом. поэтому вы можете кэшировать "лучший результат для данной границы" и просто искать эти решения.
описание границы должно включать в себя форму границы и положения дорог, обеспечивающих доступ к корню. это все.
Ответ 2
Здесь что-то вроде грубой в Haskell, которая, вероятно, могла бы выиграть от оптимизации, memoization и лучшей эвристики...
Идея состоит в том, чтобы начать с сетки, которая является всей фермой и размещать на ней дороги, начиная с корня и расширяясь оттуда. Рекурсия использует базовую эвристику, в которой кандидаты выбираются из всех смежных прямых двухблочных сегментов по всей дороге/с, и только если они удовлетворяют требованию, что добавление сегмента увеличит количество ферм, подключенных к дороге /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 [email protected](r,c) [email protected](fr,fc) =
not (elem r [fr,fr - 1]) || not (elem c [fc, fc + 1])
isOnFarm [email protected](r,c) [email protected](fr,fc) =
elem r [fr,fr - 1] && elem c [fc, fc + 1]
farmOnFarm [email protected](fr,fc) farm' =
or (map (flip isOnFarm farm') [(fr,fc),(fr,fc + 1),(fr - 1,fc),(fr - 1,fc + 1)])
addRoad [email protected](r,c) [email protected](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 [email protected](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' [email protected](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))
Выход, малая сетка:
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 are roads):
X
XXX
XXXXX
XXXOXXX
XXOOOXXXX
XXXXXOOOXXX
XXXXXOXXX
XXXOOXX
XXXO
Выход, большая сетка:
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....
