いわゆる"数独"(ナンプレとも呼ばれるアレ)を50問解けという問題(数独 - Wikipedia)．
最初40分くらいかかったけどどうにか40秒まで縮められた．1分切ったしもういいや．
数独をコンピュータで解く場合バックトラック法という方法を使うのが一般的らしい．とにかく入れられる数字を入れていって，矛盾したら戻ってやり直し，最後までいけたらそれでOK，というやり方．そしてバックトラックを使えば数独の問題は確実に解ける(c.f. 数独(ナンバープレイス))．
他の言語だと再帰を使って実装するらしいので真似してみたけど案の定スタックが不足．Rで再帰を使うのは難しい．よく分からないけど完全な関数型言語だったら末尾再帰最適化されてこんなことにはならないのかな．
forやrepeatで再帰使わずに書けば一応解けるけど数独の初期配置によっては非常に時間がかかる．平均で1分/問くらいかかるので話にならない．Rで繰り返し処理使うのは難しい．やはりRでProject Eulerとかやるものではｎ(ry
そこでまずはそれほど計算量を必要としない方法で穴を埋める事にした．たとえば1を入れる場所を探すとして
- 1を含む行，列，ブロックを除外する
- 残ったマスを含む行，列，ブロックのいずれかを見て，そのマスが唯一の残りになるのであればそのマスに1を入れる
という具合に穴埋めしてく．これならそんな大した計算量にはならない．
でもこれ簡単な問題なら全部穴埋まるんだけど，ちょっと難しい問題だと埋まらない場合があるらしい(c.f. Sudoku Solver)．今まで簡単な問題しかやったことなかったので知らなかった．というか数独ってNP完全なのだそうだ．なのだそうだ，とか言ってNP完全が何なのかヤバイくらい理解してないのだが，僕のいい加減な理解から推察するに適当なところで切り上げてバックトラック使った方が良いよってことでしょう．
よって最初に簡単な方法で埋めた後にバックトラック法を使うようにした．穴が少なければバックトラック法の時間はそれほど掛からない．
## 基本テクで解ければおｋ sudoku.solver.std <- function(puzzle){ num <- 1 # 調べる番号を初期化 for(count in 1:81){ # 81回で駄目ならあきらめる if(length(intersect(puzzle, 0))==0) break # 埋まったら終了 ## num の入らない場所を決定 chk.mat <- puzzle == 0 # チェック用matrix 数字の無い場所がT repeat{ if(sum(puzzle == num)==9){ ifelse(num == 9, num <- 1, num <- num + 1) break } for(i in 1:9){ if(length(intersect(puzzle[i, ], num)) != 0) chk.mat[i, ] <- FALSE if(length(intersect(puzzle[, i], num)) != 0) chk.mat[, i] <- FALSE if(length(intersect(puzzle[field==i], num)) != 0) chk.mat[field==i] <- FALSE } # 入れられない場所を決める fl <- FALSE # 数字入れられたかチェック chk.nums <- (1:81)[chk.mat] # 調べる数字 col.nums <- ifelse(chk.nums %% 9 == 0, 9, chk.nums %% 9) # 現在行 row.nums <- ceiling(chk.nums/9) # 現在列 for(j in 1:length(chk.nums)){ if(sum(chk.mat[col.nums[j], ]) == 1 || sum(chk.mat[, row.nums[j]]) == 1 || sum(chk.mat[field==field[chk.nums[j]]]) == 1){ puzzle[chk.nums[j]] <- num fl <- TRUE } } if(!fl){ ifelse(num == 9, num <- 1, num <- num + 1) break } } } return(puzzle) } ## 駄目なときはバックトラック法で残りを埋める sudoku.solver.bct <- function(puzzle){ init <- puzzle==0 # 調査すべきマスをTRUEでチェック n <- 1 # 調べる位置 repeat{ repeat{ # 調べるべきマスまで進む if(n > 81) return(puzzle) # 全て調べたら終了 if(init[n]){ break } n <- n + 1 } check <- FALSE # 試しの数字が入っているかどうかのフラグ col.n <- ifelse( n %% 9 == 0, 9, n %% 9) # 現在行 row.n <- ceiling(n/9) # 現在列 for(i in (min(c(puzzle[n] + 1, 9))):9){ # 現在の数値+1から9まで調べる if(length(intersect(i, puzzle[col.n, -row.n])) < 1 && # 行で重複しない length(intersect(i, puzzle[-col.n, row.n])) < 1 && # 列で重複しない length(intersect(i, puzzle[field==field[n]])) < 1 ) # ブロック内で重複しない { puzzle[n] <- i # 試しに入れて check <- TRUE # 数字入れたフラグONにして n <- n + 1 # 次の場所に動いて break # forループ抜ける } } if(check) next # 数字入ってたら次へ進む ## 一つも入らなかったら puzzle[n] <- 0 # 0に戻して repeat{ n <- n - 1 # 一つもどる if(init[n]) break # 調べるべきマスだったら抜ける．そうでなければ繰り返し． } } } ## データ読み込み puzzles <- readLines("sudoku.txt", n=500) temp <- logical(500) temp[seq(1, 500, 10)] <- TRUE puzzles <- as.numeric(unlist(strsplit(puzzles[!temp], ""))) ## 答えを計算 ans <- 0 for(i in 0:49){ ## 問題作成 puzzle <- matrix(puzzles[seq(i*81+1, l=81)], ncol=9, byrow=T) ## 答えが出ていればバックトラック法の計算時間はかからない ans <- ans + sum(sudoku.solver.bct(sudoku.solver.std(puzzle))[1, 1:3] * c(100, 10, 1)) } ans
