n-女王問題
以前Haskellで書いたn-女王問題の解法
--------------------------------------------------------
-- queen.hs
-- n-女王問題 2007.04.25
--------------------------------------------------------
-- n-queen問題の回答を表示形式で列挙する。
printAns k = printP (map toPic (queenPuzzle k))
-- n-queen問題の回答を配列形式で出力する。
queenPuzzle k = removeDup (queen k)
-- n-queen問題の回答(重複を含む)を配列形式で出力する。
queen k = filter (checkQueen k) (makeElem k)
--------------------------------------------------------
-- 可能な配列を出力する。
-- 可能な配列とは、縦、横に重なりのない配列を意味する。
-- 斜めの重なりチェックはここでは行っていない。
-- 出力したい次数を指定すれば、任意の次元の可能な配列
-- の集合が得られる。
-- 重複はないが、回転による重複までは除去していない。
--------------------------------------------------------
makeElem k = map reverse (nextDim k 0 [[]])
nextDim :: Int -> Int -> [[Int]] -> [[Int]]
nextDim m k xs
| m == k = xs
| otherwise = nextDim m (k+1) (concat [addDim m x | x <- xs])
addDim :: Int -> [Int] -> [[Int]]
addDim m xs = [x:xs| x <- [1 .. m], notElem x xs]
--------------------------------------------------------
-- 斜めの重なりをチェックする。
-- 与えられた配列に斜めの重なりが存在すれば False 、
-- 存在しなければ True を返す。
-- この関数はFilterに渡される。
--------------------------------------------------------
checkQueen :: Int -> [Int] -> Bool
checkQueen _ [] = True
checkQueen m (x:xs) = (checkSlant m (x+1) inc xs) &&
(checkSlant m (x-1) dec xs) &&
(checkQueen m xs)
inc :: Int -> Int
inc x = x+1
dec :: Int -> Int
dec x = x-1
checkSlant :: Int -> Int -> (Int -> Int) -> [Int] -> Bool
checkSlant m _ f [] = True
checkSlant m k f (x:xs)
| k == x = False
| k == 0 = True
| k > m = True
| otherwise = checkSlant m (f k) f xs
--------------------------------------------------------
-- 配列のリストから重複するものを取り除く。
-- リストの先頭要素と残りの要素の一致判定を行う。
-- この時、残りの要素は回転、反転を行い可能な重複パターンを全て確認する。
-- 確認の結果、全てのパターンで一致しない場合のみ重複でないと判定する。
-- 重複でないと判定された場合はリストに残す。
--------------------------------------------------------
removeDup :: [[Int]] -> [[Int]]
removeDup [] = []
removeDup (x:xs)
| checkDupList x xs = x:removeDup xs
| otherwise = removeDup xs
checkDupList :: [Int] -> [[Int]] -> Bool
checkDupList x [] = True
checkDupList x xs = (checkDup x (head xs)) && (checkDupList x (tail xs))
--------------------------------------------------------
-- ２つの配列の一致判定を行う。
-- 可能な重複パターンを全てチェックする。
-- 一致していなければ True、一致していれば False
--------------------------------------------------------
checkDup :: [Int] -> [Int] -> Bool
checkDup x y = not ((same x (pattern0 y)) ||
(same x (pattern1 y)) ||
(same x (pattern2 y)) ||
(same x (pattern3 y)) ||
(same x (pattern4 y)) ||
(same x (pattern5 y)) ||
(same x (pattern6 y)) ||
(same x (pattern7 y)))
pattern0 x = x
pattern1 x = toElem (reverse (toPic x))
pattern2 x = toElem (map reverse (toPic x))
pattern3 x = toElem (reverse (map reverse (toPic x)))
pattern4 x = toElem (rotate (toPic x))
pattern5 x = toElem (reverse (rotate (toPic x)))
pattern6 x = toElem (map reverse (rotate (toPic x)))
pattern7 x = toElem (reverse (map reverse (rotate (toPic x))))
--------------------------------------------------------
-- ２つの配列が同一かどうか調べる。
-- 同一であれば True、異なっていれば False
--------------------------------------------------------
same :: [Int] -> [Int] -> Bool
same [] [] = True
same (x:xs) (y:ys)
| x /= y = False
| otherwise = same xs ys
--------------------------------------------------------
-- 配列を表示形式に変換する。
--------------------------------------------------------
toPic xs = map reverse (convert xs)
convert :: [Int] -> [[Int]]
convert xs = map (convertPic (length xs) 1 []) xs
convertPic :: Int -> Int -> [Int] -> Int -> [Int]
convertPic m n xs k
| m < n = xs
| n == k = convertPic m (n+1) (1:xs) k
| otherwise = convertPic m (n+1) (0:xs) k
--------------------------------------------------------
-- 表示形式を配列に変換する。
--------------------------------------------------------
toElem pic = map (index 1) pic
index :: Int -> [Int] -> Int
index _ [] = 0
index k (x:xs)
| x == 1 = k
| otherwise = index (k+1) xs
--------------------------------------------------------
-- 表示形式を90度回転させる。
--------------------------------------------------------
rotate :: [[Int]] -> [[Int]]
rotate x = rotate_nth 0 (length x) x
rotate_nth :: Int -> Int -> [[Int]] -> [[Int]]
rotate_nth n max x
| n == max = []
| otherwise = (take_nth n x) : (rotate_nth (n+1) max x)
take_nth :: Int -> [[Int]] -> [Int]
take_nth n x = map (nth_element n) x
nth_element :: Int -> [Int] -> Int
nth_element n x = x!!n
--------------------------------------------------------
-- 出力関数
--------------------------------------------------------
-- １つの表示形式を出力する。
printPicture :: [[Int]] -> IO ()
printPicture pic
= do putStr (show (head pic))
putStr "\n"
if (tail pic) == [] then putStr "\n" else printPicture (tail pic)
-- 表示形式のリストを出力する。
printP :: [[[Int]]] -> IO ()
printP pp = do printPicture (head pp)
-- putStr "\n"
if (tail pp) == [] then putStr "\n" else printP (tail pp)
これで解いたn=8の結果
[0,0,0,0,0,1,0,0]
[0,0,1,0,0,0,0,0]
[0,0,0,0,0,0,1,0]
[0,0,0,1,0,0,0,0]
[1,0,0,0,0,0,0,0]
[0,0,0,0,0,0,0,1]
[0,1,0,0,0,0,0,0]
[0,0,0,0,1,0,0,0]
[0,0,0,0,0,1,0,0]
[0,0,0,1,0,0,0,0]
[1,0,0,0,0,0,0,0]
[0,0,0,0,1,0,0,0]
[0,0,0,0,0,0,0,1]
[0,1,0,0,0,0,0,0]
[0,0,0,0,0,0,1,0]
[0,0,1,0,0,0,0,0]
[0,0,0,0,0,1,0,0]
[0,0,0,1,0,0,0,0]
[0,0,0,0,0,0,1,0]
[1,0,0,0,0,0,0,0]
[0,0,0,0,0,0,0,1]
[0,1,0,0,0,0,0,0]
[0,0,0,0,1,0,0,0]
[0,0,1,0,0,0,0,0]
[0,0,0,0,0,0,1,0]
[0,1,0,0,0,0,0,0]
[0,0,0,1,0,0,0,0]
[1,0,0,0,0,0,0,0]
[0,0,0,0,0,0,0,1]
[0,0,0,0,1,0,0,0]
[0,0,1,0,0,0,0,0]
[0,0,0,0,0,1,0,0]
[0,0,0,0,0,0,1,0]
[0,1,0,0,0,0,0,0]
[0,0,0,0,0,1,0,0]
[0,0,1,0,0,0,0,0]
[1,0,0,0,0,0,0,0]
[0,0,0,1,0,0,0,0]
[0,0,0,0,0,0,0,1]
[0,0,0,0,1,0,0,0]
[0,0,0,0,0,0,1,0]
[0,0,1,0,0,0,0,0]
[1,0,0,0,0,0,0,0]
[0,0,0,0,0,1,0,0]
[0,0,0,0,0,0,0,1]
[0,0,0,0,1,0,0,0]
[0,1,0,0,0,0,0,0]
[0,0,0,1,0,0,0,0]
[0,0,0,0,0,0,1,0]
[0,0,1,0,0,0,0,0]
[0,0,0,0,0,0,0,1]
[0,1,0,0,0,0,0,0]
[0,0,0,0,1,0,0,0]
[1,0,0,0,0,0,0,0]
[0,0,0,0,0,1,0,0]
[0,0,0,1,0,0,0,0]
[0,0,0,0,0,0,1,0]
[0,0,0,1,0,0,0,0]
[0,1,0,0,0,0,0,0]
[0,0,0,0,1,0,0,0]
[0,0,0,0,0,0,0,1]
[1,0,0,0,0,0,0,0]
[0,0,1,0,0,0,0,0]
[0,0,0,0,0,1,0,0]
[0,0,0,0,0,0,1,0]
[0,0,0,1,0,0,0,0]
[0,1,0,0,0,0,0,0]
[0,0,0,0,0,0,0,1]
[0,0,0,0,0,1,0,0]
[1,0,0,0,0,0,0,0]
[0,0,1,0,0,0,0,0]
[0,0,0,0,1,0,0,0]
[0,0,0,0,0,0,1,0]
[0,0,0,0,1,0,0,0]
[0,0,1,0,0,0,0,0]
[1,0,0,0,0,0,0,0]
[0,0,0,0,0,1,0,0]
[0,0,0,0,0,0,0,1]
[0,1,0,0,0,0,0,0]
[0,0,0,1,0,0,0,0]
[0,0,0,0,0,0,0,1]
[0,0,1,0,0,0,0,0]
[1,0,0,0,0,0,0,0]
[0,0,0,0,0,1,0,0]
[0,1,0,0,0,0,0,0]
[0,0,0,0,1,0,0,0]
[0,0,0,0,0,0,1,0]
[0,0,0,1,0,0,0,0]
[0,0,0,0,0,0,0,1]
[0,0,0,1,0,0,0,0]
[1,0,0,0,0,0,0,0]
[0,0,1,0,0,0,0,0]
[0,0,0,0,0,1,0,0]
[0,1,0,0,0,0,0,0]
[0,0,0,0,0,0,1,0]
[0,0,0,0,1,0,0,0]
