我发现这个问题很有趣,因为我正在自学 Haskell,所以我决定尝试用这种语言实现一个解决方案。
我考虑了分支定界,但想不出一个很好的方法来约束解决方案,所以我只是通过丢弃违反规则的板来进行一些修剪。
我的算法从“空”板开始工作。它将塔的每种可能颜色放置在第一个空槽中,然后在每种情况下(每种颜色)递归调用自身。递归调用尝试第二个插槽中的每种颜色,再次递归,直到板已满。
在放置每个塔时,我会检查刚刚放置的塔及其所有邻居,以验证它们是否遵守规则,将任何空邻居视为外卡。所以如果一个白塔有四个空的邻居,我认为它是有效的。如果某个展示位置无效,我不会在该展示位置上递归,从而有效地修剪其下的整个可能性树。
代码的编写方式,我生成了所有可能解决方案的列表,然后查看列表以找到最佳解决方案。实际上,由于 Haskell 的惰性求值,列表元素是在搜索功能需要它们时生成的,并且由于它们不再被引用,它们立即可用于垃圾收集,因此即使对于 5x5 板内存使用量也相当小(2 MB)。
性能相当不错。在我的 2.1 GHz 笔记本电脑上,程序的编译版本使用一个内核在约 50 秒内解决了 4x4 的情况。我现在正在运行一个 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 程序。我相信它可以做得更加优雅和简洁。
更新:由于用 5 种颜色制作 5x5 仍然非常耗时(我等了 12 个小时但还没有完成),我又看看如何使用边界修剪更多的搜索树。
我的第一个方法是通过假设每个空单元都被一个白色的塔填充来估计部分填充板的上限。然后我修改了“解决方案”功能以跟踪看到的最佳分数并忽略任何上限低于该最佳分数的棋盘。
这帮助了一些人,将 4x4x5 板从 23 秒减少到 15 秒。为了进一步改进它,我修改了上限函数以假设每个 Empty 都装满了可能的最佳塔,与现有的非空单元格内容一致。这帮助很大,将 4x4x5 时间减少到 2 秒。
在 5x5x5 上运行它需要 2600 秒,得到以下电路板:
G B G R B
R B W Y G
Y G R B R
B W Y G Y
G R B R B
730 分。
我可能会再做一次修改,让它找到所有的最高得分板,而不仅仅是一个。