2014/08/18
R >  数独を解くシミュレーション（2）
昨日の続きで、解き方を改良した。行・列・ブロックのうち埋め易そうな所から候補を列挙してリストに格納し、順に試しながら進む。実行環境は 2014/08/13 の実機を参照。

下が実行風景。最初に昨日と同じ問題を、続いてもう一問解く。どちらも「数独無料ゲーム」 http://www.sudokugame.org/ から拝借しました。
（動画のアドレス https://kenpg.up.seesaa.net/image/20140818_sud_1.flv）



↓ 二問目。上の動画では、中盤まで多少時間がかかる一方、最後は一気に多数のセルを埋める。解いた結果は https://kenpg.up.seesaa.net/image/20140818_sud_2.gif


今回のコードでは順列の生成が必要で、R の標準には関数がないが ↓ を見て e1071 パッケージの permutations が使えると知った。

■ Colorless Green Ideas : Rで階乗・順列・組み合わせを計算する
http://blog.livedoor.jp/green_idea/archives/1532165.html

↓ コード。昨日と同様、問題データの記法は y-kawaz さんの日記（SQLで数独を解く）と同じ。
rm(list=ls())
library(e1071)

sud_ini =
'   9  4   327  5  8      32 6187 2 52  591 83 8  6491764  2    719  5324328149756'
sud_ini_num = unlist(strsplit(sud_ini, ''))

main = function(){
	sud = list(sud_ini_num)
	f_plt(sud[[1]])
 	readline('ENTER to start')
	time_start = proc.time()
	while(1){
		sud = f_slv(sud)
		if(length(sud) == 0){
			message('Failed')
			break
		} else if(length(grep(' ', sud[[1]])) == 0){
			message('Completed')
			break
		}
	}
	print(proc.time() - time_start) }

f_plt = function(sud){
	pxs = 400
	lty = c(3,3,1)
	if(length(dev.list()) == 0) windows(height=(pxs-45)/96, width=(pxs-8)/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]]
	vec = grep(' ', f_cnv(sd1), val=T)
	can = rev(sort(sapply(vec, function(x){ nchar(gsub(' ', '', x)) })))[1]
	lab = names(can)
	tmp = as.integer(unlist(strsplit(vec[lab], '')))
	v1 = which(is.na(tmp))
	v2 = which(!is.element(1:9, tmp))
	prm = permutations(length(v1))
	for(i in 1:nrow(prm)){
		ord = f_pos(lab, v1)
		points(f_xys(ord[1]), cex=4, pch=15, col='pink')
		sud_new = replace(sd1, ord, v2[prm[i,]])
		if(f_chk(sud_new) == 0){
			f_num(sud_new, 2)
			sud[[length(sud) + 1]] = sud_new
		}
	}
	# Sys.sleep(0.1)
	sud[[1]] = NULL
	return(sud) }

f_pos = function(rcb, pos){
	p = substr(rcb, 1, 3)
	q = as.integer(substr(rcb, 4, 4))
	if(p == 'row'){
		ord = (q - 1) * 9 + pos
	} else if(p == 'col'){
		ord = (pos - 1) * 9 + q
	} else if(p == 'blk'){
		ord = floor((q - 1) / 3) * 27 + (q - 1) %% 3 * 3
		ord = ord + floor((pos - 1) / 3) * 9 + (pos - 1) %% 3 + 1
	}
	return(ord) }

f_cnv = function(sud){
	mat = matrix(sud, 9, 9, byrow=T)
	lis = list(
		row = apply(mat, 1, function(x){ paste(collapse='', x) })
		, col = apply(mat, 2, function(x){ paste(collapse='', x) })
		, blk = sapply(1:9, function(x){
			z = floor((x - 1) / 3) * 27 + (x - 1) %% 3 * 3 + 1
			z = z + 0:2
			z = c(z, z + 9, z + 18)
			paste(collapse='', sud[z]) }))
	return(unlist(lis)) }

f_chk = function(sud){
	vec = gsub(' ', '', f_cnv(sud))
	chk = sapply(strsplit(vec, ''), function(x){ length(x) - length(unique(x)) })
	return(length(which(chk > 0))) }

main()

長いコードの割にまだまだ不十分。例えば数独無料ゲームの難しい問題は、いくら待ってもほとんど進まず R が異常終了する（自分の環境では）。リストに入れる解の候補が多すぎるのか、またはグラフィックウィンドウに数字を重ね描きしすぎるのかもしれない。
<< 数独を解くシミュレーション（3）
数独を解くシミュレーション（1） >>