0

Haskellで数独ソルバーを書きました。リストを調べ、「0」（空のセル）が見つかると、適合する数を取得して試してみます。

import Data.List (group, (\\), sort)
import Data.Maybe (fromMaybe)

row :: Int -> [Int] -> [Int]
row y grid = foldl (\acc x -> (grid !! x):acc) [] [y*9 .. y*9+8]
    where y' = y*9
column :: Int -> [Int] -> [Int]
column x grid = foldl (\acc n -> (grid !! n):acc) [] [x,x+9..80]
box :: Int -> Int -> [Int] -> [Int]
box x y grid = foldl (\acc n -> (grid !! n):acc) [] [x+y*9*3+y' | y' <- [0,9,18], x <- [x'..x'+2]]
    where x' = x*3

isValid :: [Int] -> Bool
isValid grid = and [isValidRow, isValidCol, isValidBox]
    where isValidRow = isValidDiv row
          isValidCol = isValidDiv column
          isValidBox = and $ foldl (\acc (x,y) -> isValidList (box x y grid):acc) [] [(x,y) | x <- [0..2], y <- [0..2]]
          isValidDiv f = and $ foldl (\acc x -> isValidList (f x grid):acc) [] [0..8]
          isValidList = all (\x -> length x <= 1) . tail . group . sort -- tail removes entries that are '0'

isComplete :: [Int] -> Bool        
isComplete grid = length (filter (== 0) grid) == 0

solve :: Maybe [Int] -> Maybe [Int]
solve grid' = foldl f Nothing [0..80]
    where grid = fromMaybe [] grid' 
          f acc x
            | isValid grid = if isComplete grid then grid' else f' acc x
            | otherwise    = acc
          f' acc x 
            | (grid !! x) == 0 = case guess x grid of 
                Nothing -> acc
                Just x -> Just x
            | otherwise        = acc

guess :: Int -> [Int] -> Maybe [Int]
guess x grid
    | length valid /= 0 = foldl f Nothing valid
    | otherwise         = Nothing
    where valid = [1..9] \\ (row rowN grid ++ column colN grid ++ box (fst boxN) (snd boxN) grid) -- remove numbers already used in row/collumn/box
          rowN = x `div` 9 -- e.g. 0/9=0 75/9=8
          colN = x - (rowN * 9) -- e.g. 0-0=0 75-72=3
          boxN = (colN `div` 3, rowN `div` 3)
          before x = take x grid
          after x = drop (x+1) grid
          f acc y = case solve $ Just $ before x ++ [y] ++ after x of
            Nothing -> acc
            Just x -> Just x

いくつかのパズルでは、これは機能します。たとえば、これは次のとおりです。

sudoku :: [Int]
sudoku = [5,3,0,6,7,8,0,1,2,
          6,7,0,0,0,0,3,4,8,
          0,0,8,0,0,0,5,0,7,
          8,0,0,0,0,1,0,0,3,
          4,2,6,0,0,3,7,9,0,
          7,0,0,9,0,0,0,5,0,
          9,0,0,5,0,7,0,0,0,
          2,8,7,4,1,9,6,0,5,
          3,0,0,2,8,0,1,0,0]

1秒もかかりませんでしたが、これは次のとおりです。

sudoku :: [Int]
sudoku = [5,3,0,0,7,0,0,1,2,
          6,7,0,0,0,0,3,4,8,
          0,0,0,0,0,0,5,0,7,
          8,0,0,0,0,1,0,0,3,
          4,2,6,0,0,3,7,9,0,
          7,0,0,9,0,0,0,5,0,
          9,0,0,5,0,7,0,0,0,
          2,8,7,4,1,9,6,0,5,
          3,0,0,2,8,0,1,0,0]

仕上がりは見ていません。正しい結果が返されるので、これはメソッドの問題ではないと思います。

プロファイリングは、ほとんどの時間が「isValid」関数に費やされたことを示しました。その機能について明らかに非効率的/遅いものはありますか？

4

2 に答える 2

6

実装はもちろん改善可能ですが、それは問題ではありません。問題は、2 番目のグリッドの場合、単純な推測とチェックのアルゴリズムでは多くのバックトラッキングが必要になることです。各関数を 1000 倍高速化したとしても、(グリッドが一意でない場合は最初に) ソリューションを見つけるために宇宙の年齢の数倍を必要とするグリッドが存在します。

それを避けるには、より良いアルゴリズムが必要です。このようなケースを回避するためのかなり効率的な方法は、最初に可能な数が最も少ない正方形を推測することです。これはすべての悪いケースを回避するわけではありませんが、それらを大幅に減らします。

length thing == 0また、チェックを に置き換える必要がありますnull thing。ここでは比較的短いリストが発生しているため、効果は限定的ですが、一般的には劇的なものになる可能性があります (また、一般的には を使用せずlength list <= 1、null $ drop 1 list代わりに使用する必要があります)。

于 2012-02-20T16:04:42.290 に答える
1 
isValidList = all (\x -> length x <= 1) . tail . group . sort -- tail removes entries that are '0'

元のリストに 0 が含まれていない場合は、tail他の何か (おそらく 2 つの 1 のリスト) が削除されます。に置き換えtail . group. sortますgroup . sort . filter (/= 0)。

理由がわかりません。 asisValidBoxをisValidDiv使用するのが適切なようです。私は何かを見逃していませんか / 彼らは何か非常に賢いことをしていますか?foldlmap

于 2012-02-20T15:55:05.157 に答える