Попытка создать алгоритм для оптимального размещения башни в игре

Мне этот вопрос показался интригующим, и, поскольку я учу себя Haskell, я решил попробовать свои силы в реализации решения на этом языке.

Я подумал о ветвях и привязках. , но не смог придумать хороший способ связать решения, поэтому я просто немного обрезал, отбросив доски, нарушающие правила.

Мой алгоритм работает, начиная с «пустой» доски. Он помещает каждый возможный цвет башни в первый пустой слот и в каждом случае (каждый цвет) затем рекурсивно вызывает себя. Рекурсивные вызовы проверяют каждый цвет во втором слоте, повторяя снова, пока доска не заполнится.

По мере размещения каждой башни я проверяю только что установленную башню и всех ее соседей, чтобы убедиться, что они подчиняются правилам , рассматривая любых пустых соседей как дикие карты. Так что если у белой башни четыре пустых соседа, я считаю это правильным. Если размещение недопустимо, я не рекурсивно использую это размещение, эффективно обрезаю все дерево возможностей под ним.

Как написан код, я генерирую список всех возможных решений, а затем просматриваю список, чтобы найти Лучший. На самом деле, благодаря ленивому вычислению Haskell, элементы списка генерируются по мере того, как они нужны функции поиска, и, поскольку к ним больше не обращаются, они сразу становятся доступными для сборки мусора, так что даже для платы 5x5 использование памяти довольно невелико. (2 МБ)

Производительность неплохая. На моем ноутбуке с частотой 2,1 ГГц скомпилированная версия программы решает случай 4x4 за ~ 50 секунд, используя одно ядро. Я использую пример 5x5 прямо сейчас, чтобы посмотреть, сколько времени это займет. Поскольку функциональный код довольно легко распараллелить, я также собираюсь поэкспериментировать с параллельной обработкой. Есть распараллеленный компилятор Haskell, который не только распределяет работу по нескольким ядрам, но и по нескольким машинам, и это очень распараллеливаемая проблема.

Вот мой код. Я понимаю, что вы указали Java или PHP, а Haskell - совсем другое дело. Если вы хотите поиграть с этим, вы можете изменить определение переменной «bnd» чуть выше нижней части, чтобы установить размер платы. Просто установите его в ((1,1), (x, y)), где x и y - количество столбцов и строк, соответственно.

import Array
import Data.List

-- Enumeration of Tower types.  "Empty" isn't really a tower color,
-- but it allows boards to have empty cells
data Tower = Empty | Blue | Red | Green | Yellow | White
             deriving(Eq, Ord, Enum, Show)

type Location = (Int, Int)
type Board = Array Location Tower

-- towerScore omputes the score of a single tower
towerScore :: Tower -> Int
towerScore White = 100
towerScore t     = (fromEnum t) * 10

-- towerUpper computes the upper bound for a single tower
towerUpper :: Tower -> Int
towerUpper Empty = 100
towerUpper t = towerScore t

-- boardScore computes the score of a board
boardScore :: Board -> Int
boardScore b = sum [ towerScore (b!loc) | loc <- range (bounds b) ]

-- boardUpper computes the upper bound of the score of a board
boardUpper :: Board -> Int
boardUpper b = sum [ bestScore loc | loc <- range (bounds b) ]
    where
      bestScore l | tower == Empty = 
                      towerScore (head [ t | t <- colors, canPlace b l t ])
                  | otherwise = towerScore tower
                  where 
                    tower = b!l
                    colors = reverse (enumFromTo Empty White)

-- Compute the neighbor locations of the specified location
neighborLoc :: ((Int,Int),(Int,Int)) -> (Int,Int) -> [(Int,Int)]
neighborLoc bounds (col, row) = filter valid neighborLoc'
    where
      valid loc = inRange bounds loc
      neighborLoc' = [(col-1,row),(col+1,row),(col,row-1),(col,row+1)]

-- Array to store all of the neighbors of each location, so we don't
-- have to recalculate them repeatedly.
neighborArr = array bnd [(loc, neighborLoc bnd loc) | loc <- range bnd]

-- Get the contents of neighboring cells
neighborTowers :: Board -> Location -> [Tower]
neighborTowers board loc = [ board!l | l <- (neighborArr!loc) ]

-- The tower placement rule.  Yields a list of tower colors that must
-- be adjacent to a tower of the specified color.
requiredTowers :: Tower -> [Tower]
requiredTowers Empty  = []
requiredTowers Blue   = []
requiredTowers Red    = [Blue]
requiredTowers Green  = [Red, Blue]
requiredTowers Yellow = [Green, Red, Blue]
requiredTowers White  = [Yellow, Green, Red, Blue]

-- cellValid determines if a cell satisfies the rule.
cellValid :: Board -> Location -> Bool
cellValid board loc = null required ||
                      null needed   ||
                      (length needed <= length empties)
    where
      neighbors = neighborTowers board loc
      required  = requiredTowers (board!loc)
      needed    = required \\ neighbors
      empties   = filter (==Empty) neighbors

-- canPlace determines if 'tower' can be placed in 'cell' without
-- violating the rule.
canPlace :: Board -> Location -> Tower -> Bool
canPlace board loc tower =
    let b' = board // [(loc,tower)]
    in cellValid b' loc && and [ cellValid b' l | l <- neighborArr!loc ]

-- Generate a board full of empty cells       
cleanBoard :: Array Location Tower
cleanBoard = listArray bnd (replicate 80 Empty)

-- The heart of the algorithm, this function takes a partial board
-- (and a list of empty locations, just to avoid having to search for
-- them) and a score and returns the best board obtainable by filling
-- in the partial board
solutions :: Board -> [Location] -> Int -> Board
solutions b empties best | null empties = b
solutions b empties best = 
    fst (foldl' f (cleanBoard, best) [ b // [(l,t)] | t <- colors, canPlace b l t ])
    where
      f :: (Board, Int) -> Board -> (Board, Int)
      f (b1, best) b2  | boardUpper b2 <= best = (b1, best)
                       | otherwise = if newScore > lstScore
                                     then (new, max newScore best)
                                     else (b1, best)
                       where
                         lstScore = boardScore b1
                         new      = solutions b2 e' best
                         newScore = boardScore new
      l = head empties
      e' = tail empties

colors = reverse (enumFromTo Blue White)

-- showBoard converts a board to a printable string representation
showBoard :: Board -> String
showBoard board = unlines [ printRow row | row <- [minrow..maxrow] ]
    where
      ((mincol, minrow), (maxcol, maxrow)) = bounds board
      printRow row = unwords [ printCell col row | col <- [mincol..maxcol] ]
      printCell col row = take 1 (show (board!(col,row)))

-- Set 'bnd' to the size of the desired board.                          
bnd = ((1,1),(4,4))

-- Main function generates the solutions, finds the best and prints
-- it out, along with its score
main = do putStrLn (showBoard best); putStrLn (show (boardScore best))
       where
         s = solutions cleanBoard (range (bounds cleanBoard)) 0
         best = s

Кроме того, помните, что это моя первая нетривиальная программа на Haskell. Я уверен, что это можно сделать гораздо элегантнее и лаконичнее.

Обновление : Так как создание 5x5 с 5 цветами по-прежнему занимало очень много времени (я ждал 12 часов, а он так и не закончился), я еще раз посмотрел, как использовать ограничение, чтобы обрезать большую часть дерева поиска.

Мой первый подход заключался в оценке верхней границы частично заполненной доски, предполагая, что каждая пустая ячейка заполнена белой башней. Затем я изменил функцию «решения», чтобы отслеживать лучший результат и игнорировать любую доску, верхняя граница которой меньше этой лучшей оценки.

Это помогло некоторым, уменьшив доску 4x4x5 с 23 до 15. Чтобы улучшить его, я изменил функцию верхней границы, чтобы она предполагала, что каждый пустой заполнен наилучшей возможной башней, совместимой с существующим непустым содержимым ячейки. Это очень помогло, уменьшив время 4x4x5 до 2 с.

Запуск его на 5x5x5 занял 2600 с, давая следующую доску: