逆Nクイーン問題

この記事は ひとりアドベントカレンダーRosettaCodeで楽しむプログラミング Advent Calendar 2025の25日めの記事です。

Nクイーン問題は、N×Nのチェス盤にN個のクイーンを互いに取り合わないように配置する問題。
その逆で、N×Nのチェス盤の全てのマスに効きがあるようにするために必要な最小限のクイーンの個数と、そのような配置を求める問題。

タスク

Nを1から10までについて、逆Nクイーン問題、逆ビショップ問題、逆ナイト問題の解を求めよ。
必要最小限のコマ数を求める他、N=8については配置の例を示せ。

議論

Rosetta Code の Talk ページで、色々議論がされている。
特に、Queen, Bishop, Knight について一緒にするのは、問題の性質が違うので分けた方がいい、という意見があるので、今後改定される可能性がある。

ビショップ問題

ビショップについてはとても鋭い指摘があって、自明な解がある。
中央に縦一列に並べればよい。

. . . B . . . .
. . . B . . . .
. . . B . . . .
. . . B . . . .
. . . B . . . .
. . . B . . . .
. . . B . . . .
. . . B . . . .

これは、4近傍で隣接するビショップは色の違うマスにしか入れないため干渉することがそもそもできないことに注意しつつ、盤を45°回転させて考えると

        .
       . .
      . . .
     . . . B
    . . . B .
   . . . B . .
  . . . B . . .
 . . .|B . . . .
  . .-B-. . . .
   . B|. . . .
    B . . . .
     . . . .
      . . .
       . .
        .

縦と横に効くビショップをこの盤で互いに取り合わないように、かつ全てのマスに効くように置くにはN個をこう置く方法があり、これより減らせないと自明にわかる。

考える

ナイトについては、クイーンとは効きの性質が違う（端まで届くということがない）ことから、問題の性質が違うと考えられる。
ここではクイーンについてだけ考える。

全探索

Nクイーン問題では、クイーンを全ての行に一人ずつ配置する必要があった。同じ行に二人入ることはできず、人数と行の数が同じだからである。このため、全探索した場合の場合の数は $N^N$ である。
逆Nクイーン問題では、行について置かない場合も考えると、$(N+1)^N$ 通りの場合を全探索すれば答えに到達できる。

import Data.Array.Unboxed
import Data.List

type Board = UArray (Int,Int) Bool  -- マスに効きがあるときTrue

nQueenMinimum n = post $ recur fld0 [1 .. n]
  where
    bnds = ((1,1),(n,n))
    fld0 = listArray bnds $ repeat False :: Board     -- 初期盤面は真っ白
-- 盤面fldについて、行のリストisについて順に、置かないor1～Nに置く場合を全探索して、
-- 全面を黒くする配置を全てリストにして返す
    recur fld [] = [[] | and $ elems fld]             -- 成功した場合、その配置を返す
    recur fld (i:is) =
      [ (i,j) : ans
      | j <- [1 .. n], not $ fld ! (i,j)              -- 行i列jに置く場合
      , ans <- recur (queen fld (i,j)) is] ++         -- 再帰して探索
      recur fld is                                    -- 行iには置かない場合
    post ijss = minimum $ zip (map length ijss) ijss  -- 結果の中で最小のものを探す

queen :: Board -> (Int,Int) -> Board                  -- fld の (i,j) にクイーンを置く
queen fld (i,j) = fld // concat [hor,ver,dia]
  where
    bnds@(_,(n,_)) = bounds fld
    hor = [((k,j),True) | k <- [1 .. n]]
    ver = [((i,k),True) | k <- [1 .. n]]
    dia = [((a,b),True) | k <- [1 .. pred n], a <- [i-k,i+k], b <- [j-k,j+k], inRange bnds (a,b)]

ghci> nQueenMinimum 1
(1,[(1,1)])
(0.01 secs, 91,512 bytes)
ghci> nQueenMinimum 2
(1,[(1,1)])
(0.01 secs, 125,472 bytes)
ghci> nQueenMinimum 3
(1,[(2,2)])
(0.01 secs, 313,072 bytes)
ghci> nQueenMinimum 4
(3,[(1,1),(2,3),(4,2)])
(0.01 secs, 1,551,360 bytes)
ghci> nQueenMinimum 5
(3,[(1,1),(2,4),(4,3)])
(0.02 secs, 9,501,160 bytes)
ghci> nQueenMinimum 6
(4,[(1,1),(2,3),(3,6),(6,2)])
(0.15 secs, 64,749,320 bytes)
ghci> nQueenMinimum 7
(4,[(1,2),(2,6),(4,1),(5,5)])
(1.05 secs, 479,067,784 bytes)
ghci> nQueenMinimum 8
(5,[(1,1),(2,3),(3,5),(4,2),(5,4)])
(7.81 secs, 3,835,145,832 bytes)
ghci> nQueenMinimum 9
(5,[(1,1),(2,3),(3,7),(6,2),(7,6)])
(71.02 secs, 32,960,551,704 bytes)

N=10についてはghciでは待ちきれなかったがコンパイルしたら秒で結果が出た。

(5,[(1,3),(3,9),(5,5),(7,1),(9,7)])

C++解のところに示されている例と同じ配置を見つけた。

A*探索

全探索の recur は深さ優先探索を実行していた。
これを幅優先探索に変えることで、最小解を発見次第プログラムを終了できるようになるが、局面の数が膨大なので空間計算量が間に合わなくなりそう。

幅優先探索は、局面について探索を一段進めた結果をFIFOキューに投入することで順次探索を深めていく。
ダイクストラ法は、開始局面からの距離に基づいた優先度付きキューにより、局面の調査の優先度を調整する。
A*探索は、開始局面からの距離に加えて、局面から推測するゴールまでの推定距離（ヒューリスティックと呼ぶ）を優先度として用いる。

クイーンひとつにつき、効きを及ぼせるマスの個数は、コマが置かれた1マス、縦$N-1$マス、横$N-1$マス、斜めは最大で$N-1$マスと逆の斜め$N-1$マスの合計 $4N-3$ マスが上限になる。
ここから、ある局面にまた利きがないマスが $x$ 個あるとき、その局面から全てを覆ったゴール局面に到達するには、少なくとも$\left \lceil \frac{x}{4N-3} \right \rceil$ 個のクイーンがさらに必要であることがわかる。

これをA* 探索に必要なヒューリスティック関数として利用する。
その配置からゴールに至る距離の下限であることは明らかなので、A* 探索で一つの解を発見したとき、まだキューの中にくすぶっていて調べていない局面が、今発見した解よりもよい答えをもたらすことがないと保証できる。
A* 探索は一般に最小解を見つける保証がないが、このヒューリスティックを使うこの問題では、最小解が得られる。

実装

局面は、全探索のときの Board 型の代わりに、配置したクイーンの座標リストで表現することにする。
比較を高速化したいのでメモリの連続領域に詰め込むため [(Int,Int)] でなく Data.Vector.Unboxed.Vector (Word8,Word8) で表すことにする。

ここで、クイーンは辞書順にしか使えないことにする。
最後に置いたクイーンより大きな位置にしか置けない。この制約により一意性を確保する。
また、最初の一つは、$H = \lceil H/2 \rceil$ として $1 \leq i \leq H, i \leq j \leq H$ の範囲だけを考えれば、対称な配置を調べることなく全てを計算できる。

import Data.Word
import qualified Data.Vector.Unboxed as UV

type State = UV.Vector (Word8,Word8)

ヒューリスティックを計算したり、利きのないマスを探したりするのに、盤面を二次元に展開する計算は必要だろう。

import Data.Array.Unboxed

type Field = UArray (Int,Int) Bool -- 盤面

nQueenMinimum :: Int -> (Int, State)
nQueenMinimum n = ...
  where
    bnds = ((1,1),(n,n))
    fld0 = listArray bnds $ repeat False :: UArray (Int,Int) Bool -- 真っ白

    makeField :: State -> Field
    makeField = UV.foldl' queen fld0

    queen :: Field -> (Word8,Word8) -> Field
    queen fld (ii,jj) = fld // concat [hor,ver,dia]
      where
        i = fromIntegral ii
        j = fromIntegral jj
        hor = [((k,j),True) | k <- [1 .. n]]
        ver = [((i,k),True) | k <- [1 .. n]]
        dia = [((a,b),True) | k <- [1 .. pred n], a <- [i-k,i+k], b <- [j-k,j+k], inRange bnds (a,b)]

探索を1ステップすするループを考える。
調査済みの局面集合は Data.Set.Set State で、調査予定の局面キューは Data.Heap.Heap を使って、ヒューリスティック値をキー、State を値とする優先度付きキューにより表す。

import qualified Data.Set as S
import qualified Data.Heap as H

type Queue = H.Heap (H.Entry Int State)

    loop :: S.Set State  -- 調査済みの局面集合
         -> Queue        -- 調査予定局面のヒューリスティック順の優先度付きキュー
         -> (Int, State) -- 答え
    loop s0 pq0
      | isGoal          = (UV.length ijs, ijs)      -- 完成状態ならこれが最小解（のひとつ）
      | otherwise       = loop s1 pq2               -- 探索続行
      where
        Just (H.Entry _ ijs, pq1) = H.uncons pq0    -- 先頭を取り出す
        fld = makeField ijs                         -- 局面の盤面
-- 完成か
        isGoal = and $ elems fld                    -- 真っ黒なら完了
-- 探索実行
        s1 = S.insert ijs s0                        -- 今回の局面を探索済みに入れる
        ijZ = UV.last ijs                           -- 直前の着手
        pq2 = H.union pq1 $ H.fromList
          [ H.Entry (heuristic kls) kls               -- キューに投入
          | ((k,l), False) <- assocs fld              -- 白いマス (k,l) で
          , let kl = (fromIntegral k, fromIntegral l)
          , ijZ < kl                                  -- ijZより大きいもの
          , let kls = UV.snoc ijs kl                  -- 末尾に追加し
          , S.notMember kls s1 ]                      -- それが未探索なら

    heuristic :: State -> Int                         -- ヒューリスティック関数
    heuristic kls = UV.length kls + div (pred occup + length (filter not $ elems $ makeField kls)) occup
    occup = n * 4 - 3       -- 一つのQueenで占領できるマス数の最大値

初手の制約を満たすものだけ入れたキューを初期のキューとして loop を起動する。

nQueenMinimum n = loop S.empty pqinit
  where
    h = fromIntegral $ div (succ n) 2
    initials = [UV.fromList [(i,j)] | i <- [1 .. h], j <- [i .. h]] -- 初手
    pqinit = H.fromList [H.Entry (heuristic ijs) ijs | ijs <- initials]    -- からなる初期キュー

ghci> nQueenMinimum 1
(1,[(1,1)])
(0.01 secs, 95,040 bytes)
ghci> nQueenMinimum 2
(1,[(1,1)])
(0.01 secs, 97,368 bytes)
ghci> nQueenMinimum 3
(1,[(2,2)])
(0.01 secs, 138,576 bytes)
ghci> nQueenMinimum 4
(3,[(1,2),(2,4),(4,1)])
(0.00 secs, 992,328 bytes)
ghci> nQueenMinimum 5
(3,[(2,2),(3,4),(5,1)])
(0.01 secs, 2,945,728 bytes)
ghci> nQueenMinimum 6
(4,[(1,3),(2,1),(4,2),(5,6)])
(0.10 secs, 39,188,768 bytes)
ghci> nQueenMinimum 7
(4,[(3,3),(4,7),(6,2),(7,6)])
(0.59 secs, 242,577,232 bytes)
ghci> nQueenMinimum 8
(5,[(1,2),(5,7),(6,1),(7,6),(8,8)])
(6.37 secs, 2,467,005,496 bytes)
ghci> nQueenMinimum 9
(5,[(2,5),(3,1),(5,7),(7,2),(9,9)])
(31.44 secs, 10,558,933,992 bytes)
ghci> nQueenMinimum 10
(5,[(1,4),(3,10),(5,6),(7,2),(9,8)])
(156.81 secs, 58,265,063,624 bytes)

ghciでもN=10の答えを（少し待つが）計算できた。

他の結果

H.Fernauの方法

Rosetta Code からリンクされている Minimum dominating set of queens: A trivial programming exercise?
https://www.sciencedirect.com/science/article/pii/S0166218X09003722
Discrete Applied Mathematics
Volume 158, Issue 4, 28 February 2010, Pages 308-318

は、この記事の全探索を、盤面の状態をキーにメモ化したようなDPアルゴリズムを示している。しかしこれは、全ての盤面をメモリ上に展開する必要があるため、強烈に空間計算量がかかる、多少残念なアルゴリズムだった。

高速化のため、盤面の状態を一次元のビット配列としての Integer で、同じくクイーンの配置もそれで表現している。
盤面の状態 a を作る既知の最小のクイーンの配置 b を Map で記録する。
盤上のマスについて順に調べ、最小値を更新していくと、最終的にマップにはゴール状態の最適解が残されている、という流れ。

import qualified Data.Map as M
import Data.Bits
import Data.Ix
import Data.List

algorithm2o :: Int -> [(Int,Int)]
algorithm2o n = post $ mNN M.! all1
  where
    n1 = pred n
    bnds = ((0,0),(n1,n1))
    m0 = M.singleton 0 0 :: M.Map Integer Integer
    mNN = foldl' step m0 $ range bnds
    all1 = pred $ bit (n * n) :: Integer
    post hand = [ij | ij <- range bnds, testBit hand $ index bnds ij]
    step :: M.Map Integer Integer -> (Int,Int) -> M.Map Integer Integer
    step m s = M.unionWith minhand m m1
      where
        sbit = bit $ index bnds s
        m1 :: M.Map Integer Integer
        m1 = M.fromListWith minhand
            [(queen fld s, hand .|. sbit) | (fld,hand) <- M.assocs m, fld .&. sbit == 0]

    minhand a b = x
      where
        (_, x) = min (popCount a, a) (popCount b, b)

    queen fld (i,j) = foldl' (\acc ij -> setBit acc $ index bnds ij) fld $
      [(k,j) | k <- [0 .. n1]] ++ [(i,k) | k <- [0 .. n1]] ++
      [(a,b) | k <- [1 .. pred n], a <- [i-k,i+k], b <- [j-k,j+k], inRange bnds (a,b)]

ghci> algorithm2o 1
[(0,0)]
(0.03 secs, 81,448 bytes)
ghci> algorithm2o 2
[(0,0)]
(0.01 secs, 109,040 bytes)
ghci> algorithm2o 3
[(1,1)]
(0.01 secs, 254,184 bytes)
ghci> algorithm2o 4
[(0,0),(1,3),(2,1)]
(0.01 secs, 1,142,296 bytes)
ghci> algorithm2o 5
[(0,0),(2,3),(3,1)]
(0.06 secs, 7,153,184 bytes)
ghci> algorithm2o 6
[(0,3),(1,5),(3,2),(4,0)]
(0.37 secs, 47,353,696 bytes)
ghci> algorithm2o 7
[(0,5),(1,1),(3,6),(4,2)]
(2.31 secs, 347,253,360 bytes)
ghci> algorithm2o 8
[(0,0),(1,3),(2,1),(3,4),(4,2)]
(14.74 secs, 2,809,289,888 bytes)
ghci> algorithm2o 9
[(0,0),(1,5),(2,1),(5,6),(6,2)]
(93.13 secs, 24,700,411,592 bytes)
ghci> algorithm2o 10
[(0,6),(2,0),(4,4),(6,8),(8,2)]
(886.39 secs, 224,097,825,248 bytes)

A* 法より時間もかかるしメモリ消費がすごい。

OEISから

3本の文献とJuliaプログラムがリンクされている。

William Herbert Bird, Computational methods for domination problems, University of Victoria, 2017. はリンク切れだが、このタイトルでググると移動先のPDFが見つかる。

Matthew D. Kearse and Peter B. Gibbons, Computational Methods and New Results for Chessboard Problems, Australasian Journal of Combinatorics 23 (2001), 253-284. のPDF 9 ページめに、かなり高速に計算できた結果が表に示されている。

3本めの文献とJuliaプログラムは著者が同じで、Juliaを使って31までの答えを計算できるとある。

簡単な問題かと思ったら、今でもホットなガチのテーマのようだ。
大変な泥沼を覗いてしまった。
このタスクをRosetta Codeに立てた人は、まさに A trivial programming exercise? と言いたかったのだろう。

おわりに

以上、ひとりアドベントカレンダー RosettaCodeで楽しむプログラミング Advent Calendar 2025 完走となります。
ここまでお楽しみ頂けていたら幸いです。
それではメリークリスマス＆良いお年を！