私はこの質問に興味をそそられ、Haskell を独学で学んでいるので、Haskell でソリューションを実装しようと決心しました。
枝縛りも考えたのですが、解を束ねる良い方法が思いつかなかったので、ルールに違反している板を捨てるなどの剪定を行いました。
私のアルゴリズムは、「空の」ボードから始めることで機能します。タワーの可能な各色を最初の空のスロットに配置し、それぞれの場合 (各色) で再帰的に自分自身を呼び出します。再帰呼び出しは、2 番目のスロットで各色を試行し、ボードがいっぱいになるまで再帰します。
各タワーが配置されると、配置されたばかりのタワーとそのすべての隣人をチェックして、ルールに従っていることを確認し、空の隣人をワイルド カードとして扱います。したがって、白い塔に空の隣人が 4 人いる場合、それは有効であると考えます。配置が無効な場合、その配置を再帰的に実行せず、その下にある可能性のツリー全体を効果的に刈り込みます。
コードの書き方では、考えられるすべてのソリューションのリストを生成し、リストを調べて最適なソリューションを見つけます。実際には、Haskell の遅延評価のおかげで、リスト要素は検索機能が必要とするときに生成され、再度参照されることはないため、すぐにガベージ コレクションに使用できるようになるため、5x5 ボードでもメモリ使用量はかなり少なくなります。 （2MB）。
パフォーマンスはかなり良いです。私の 2.1 GHz ラップトップでは、プログラムのコンパイル済みバージョンは、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 プログラムであることを覚えておいてください。もっとエレガントで簡潔にできると確信しています。
更新: 5 色で 5x5 を実行するのは依然として非常に時間がかかるため (12 時間待っても完了していませんでした)、バウンディングを使用して検索ツリーをさらに剪定する方法をもう一度調べました。
私の最初のアプローチは、すべての空のセルが白い塔で満たされていると仮定して、部分的に満たされたボードの上限を推定することでした。次に、'solution' 関数を変更して、見られる最高のスコアを追跡し、上限がその最高のスコアよりも小さいボードを無視するようにしました。
これにより、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 です。
別の変更を加えて、1 つだけではなく、スコアが最大のボードをすべて検出するようにすることもできます。