2014/08/19
R >  数独を解くシミュレーション（3）
一昨日、昨日とは別の解き方。空白セル一つずつについて入力候補をリストアップし、候補が少ないものから埋める。実行環境は 2014/08/13 の実機を参照。昨日の一問目のような簡単なのは一瞬で終わるが、そうでないとまだ遅い。これに、昨日やった行・列・ブロックごとの検討を組み合わせればもう少し速くなりそう。

例として ↓ から一問試した。このパズルサイト自体は二つ目のリンク（NAVER まとめ）で知った。

■ Challenging Sudoku Puzzles 97-100 - Target Time: 18 mins.
http://puzzles.about.com/library/sudoku/blprsudokuh25.htm

■ 知れば知るほど奥が深い。SUDOKU（ナンプレ）の解法まとめ
http://matome.naver.jp/odai/2134764369832089501

↓ 実行の様子。動画のアドレスは https://kenpg.up.seesaa.net/image/20140819_sud_1.flv


入力候補が一つしかないセルはすぐ埋まるが、その後試行錯誤の繰り返しになり50秒近くかかる。ただし実行時間にはグラフィック描画の分が結構あり、動画キャプチャをしなければ全体で40秒未満。解いた結果は https://kenpg.up.seesaa.net/image/20140819_sud_1.gif

↓ 今回のコード。昨日と同様、候補を list に追加していく。list の先頭に挿入する方法が分からず、とりあえず末尾に追加して rev でひっくり返した。もっと賢い方法を検討中。
rm(list=ls())

sud_ini =
  ' 2      8  56    1 6    9 7   4   2    136    3   7   2 4    1 3    84  5      3 '
sud_ini_num = unlist(strsplit(sud_ini, ''))

main = function(){
	f_plt(sud_ini_num)
	readline('ENTER to start')
	time_start = proc.time()
	sud = list(sud_ini_num)
	while(1){
		sud = f_slv(sud)
		if(is.null(sud)) break
	}
	print(proc.time() - time_start)
}

f_res = function(sud, i){
	row = floor((i - 1) / 9) * 9 + 1
	row = row : (row + 8)
	col = (i - 1) %% 9 + 1
	col = col + (0 : 8) * 9
	blk = floor((i - 1) / 27) * 27 + 1
	blk = blk + floor((i - 1) %% 9 / 3) * 3
	blk = blk + rep((0 : 2) * 9, each=3) + (0 : 2)
	exs = sud[c(row, col, blk)]
	res = 1:9
	return(res[which(!is.element(res, exs))]) }

f_plt = function(sud){
	pxs = 400
	lty = c(3,3,1)
	if(length(dev.list()) == 0) windows(height=(pxs-45)/96, width=(pxs-7.5)/96)
	par(plt=rep(0:1, 2))
	plot(c(0.5, 9.5), c(0.5, 9.5), axes=F, type='n', xaxs='i', yaxs='i')
	abline(h=seq(1.5, 8.5, by=1), lty=lty)
	abline(v=seq(1.5, 8.5, by=1), lty=lty)
	f_num(sud, 1) }

f_num = function(sud, col){
	skp = which(sud_ini_num != ' ')
	for(i in 1:81){
		xys = f_xys(i)
		n = sud[i]
		if(is.na(n) | (col != 1 & is.element(i, skp))) next
		points(xys, cex=4, pch=15, col='white')
		text(xys, cex=1.5, col=col, fon=1, lab=n)
	} }

f_xys = function(ord){
	return(list(
		x = (ord - 1) %% 9 + 1, y = 9 - floor((ord - 1) / 9)
	)) }

f_slv = function(sud){
	sd1 = sud[[1]]
	dat = data.frame()
	flg = FALSE
	for(i in grep(' ', sd1)){
		res = f_res(sd1, i)	
		if(length(res) == 0){
			flg = TRUE
			break
		}
		dat = rbind(dat, cbind(ord=i
			, res=paste(collapse='', res), len=length(res)))
	}
	if(!flg){
		dat$ord = as.numeric(as.character(dat$ord))
		trg = dat[order(as.character(dat$len))[1],]
		points(f_xys(trg$ord), cex=4, pch=15, col='pink')
		# Sys.sleep(0.1)
		for(n in unlist(strsplit(as.character(trg$res), ''))){
			sud_new = replace(sd1, trg$ord, n)
			f_num(sud_new, 2)
			sud[[length(sud) + 1]] = sud_new
			if(length(grep(' ', sud_new)) == 0) return()			
		}
	}
	sud[[1]] = NULL
	return(rev(sud)) }

main()
<< ジャグ配列風 list の先頭に挿入し…
数独を解くシミュレーション（2） >>