# Project Euler 解答

## Project Euler Problem 096

Project Euler Problem 096

```import Data.List
import Data.Char
import Data.Ord
import System.IO.Unsafe

chunk :: Int -> [[Char]] -> [[Int]]
chunk n = unfoldr g where
g [] = Nothing
g l = Just (map digitToInt \$ concat \$ drop 2 \$ take n l,drop n l)
d2n :: Num a => [a] -> a
d2n n = foldl ((+).(*10)) 0 n

-- box番号。左上,上,右上,中左,...に0..8を対応付ける
box :: Integral a => a -> a
box n = (3*(i`quot`3)+(j`quot`3)) where (i,j)=indexr n
index :: Num a => a -> a -> a
index i j = i*9+j
indexr :: Integral t => t -> (t, t)
indexr n = (raw n,col n)
raw :: Integral a => a -> a
raw n = n`quot`9
col :: Integral a => a -> a
col n = n`rem`9

boxs :: Int -> [t] -> [t]
boxs n b= [access i j b| i<-[l..(l+2)],j<-[r..(r+2)]] where (l,r)=(3*(n`quot`3),3*(n`rem`3))
raws :: Int -> [t] -> [t]
raws n b= [access (raw n) j b| j<-[0..8]]
cols :: Int -> [t] -> [t]
cols n b= [access i (col n) b| i<-[0..8]]
possible :: Int -> [Int] -> [Int]
possible n brd= n9 \\ (a++b++c) where (a,b,c)=(boxs (box n) brd,raws n brd,cols n brd)

next :: [Int] -> [Int]
next = findIndices (==0)
access :: Int -> Int -> [a] -> a
access i j b= b!!(index i j)
put :: Int -> a -> [a] -> [a]
put n v b= take n b ++ [v] ++ drop (n+1) b
n9 :: [Int]
n9 = [1..9]

-- 全解を求めるsolver
solve :: [Int] -> [[Int]]
solve board = imp [board]
where
imp b | all (/=0) (head b) = b
| otherwise = imp [put p c bb|
bb<-b,
let ps = next bb,
let possibles = map (\x -> possible x bb) ps,
-- ここは1要素だけのとこは全部置くように改良してもいい
let list = filter ((/=[]).fst) \$ zip possibles ps,
list /= [],
-- このminimumBy1個だけで十分早くなる
let (cs,p) = minimumBy (comparing (length . fst)) list,
c<-cs]

-- 解く
filedata :: String
filedata = unsafePerformIO \$ readFile "096sudoku.txt"
probs :: [[Int]]
probs = (chunk 11 . words) filedata
ans1 :: Int
ans1 = sum \$ map (d2n . take 3 . head . solve) probs
-- 24702
main :: IO ()
main = print ans1

-- おまけ：2010年フィンランドの数学者による世界一難しいらしい数独
-- http://www.mirror.co.uk/news/weird-news/worlds-hardest-sudoku-can-you-242294
prob :: [Int]
prob = [
0, 0, 5, 3, 0, 0, 0, 0, 0,
8, 0, 0, 0, 0, 0, 0, 2, 0,
0, 7, 0, 0, 1, 0, 5, 0, 0,
4, 0, 0, 0, 0, 5, 3, 0, 0,
0, 1, 0, 0, 7, 0, 0, 0, 6,
0, 0, 3, 2, 0, 0, 0, 8, 0,
0, 6, 0, 5, 0, 0, 0, 0, 9,
0, 0, 4, 0, 0, 0, 0, 3, 0,
0, 0, 0, 0, 0, 9, 7, 0, 0]

-- 別解
-- 最初の解と全解の処理を型アノテーションで切り分けられるソルバ
type Board = [Int]
solve' :: Board -> Maybe Board -- 一つ解が出ればいい場合はこちら
--solve' :: Board -> [Board] -- 全解を出す場合はこちら
--solve' :: MonadPlus m => Board -> m Board -- 一般的な型
solve' board = imp board
where
imp :: MonadPlus m => Board -> m Board
imp b | all (/=0) b = return b
| otherwise = msum [imp (put p c b)|
let ps = next b,
let possibles = map (\x -> possible x b) ps,
-- ここは1要素だけのとこは全部置くように改良してもいい
let list = filter ((/=[]).fst) \$ zip possibles ps,
list /= [],
-- このminimumBy1個だけで十分早くなる
let (cs,p) = minimumBy (comparing (length . fst)) list,
c<-cs]
```
• はじめに
• プロジェクトオイラー問題
• リンク等