UWSC辞典

//////////////////////////////////////////////////
// 【引数】
//   path : 解きたい問題を記述したCSVファイル 
// 【戻値】
//   
//////////////////////////////////////////////////
MODULE Sudoku
	PROCEDURE Sudoku()
		PUBLIC data[9][9]
		SETCLEAR(data, 0)
		PUBLIC candidate[9][9]
		SETCLEAR(candidate, 511)	
		PUBLIC Excel
		Excel = ExcelBoot()
		Excel.Range("A:I").Columns.ColumnWidth = 10
		Excel.Application.DisplayAlerts = FALSE
	FEND
	// 罫線を描く
	PROCEDURE drawBorder(vertical, horizontal = vertical)
		CONST xlContinuous = 1
		CONST xlMedium = -4138
		WITH Excel
			.Range(.Cells(1, 1), .Cells(vertical, horizontal)).Borders.LineStyle = xlContinuous
			v = SQRT(vertical)
			h = SQRT(horizontal)
			FOR r = 1 TO v
				FOR c = 1 TO h
					.Range(.Cells(r * v - (v - 1), c * h - (h - 1)), .Cells(r * v, c * h)).BorderAround(xlContinuous, xlMedium)
				NEXT
			NEXT
		ENDWITH
	FEND
	// 解く
	PROCEDURE Solved(path)//, Var data[][], Var candidate[][])
		drawBorder(9)
		Sudoku.readQuestion(path, data, candidate)
		REPEAT
			DIM sum = CALCARRAY(data, CALC_ADD)
			Sudoku.FullHouse(data, candidate)
			Sudoku.Single(data, candidate)
		UNTIL CALCARRAY(data, CALC_ADD) = sum
	FEND
	// 問題を取得
	PROCEDURE readQuestion(path, Var data[][], Var candidate[][])
		DIM FID = FOPEN(path)
		FOR row = 0 TO 8
			FOR col = 0 TO 8
				FUKIDASI(row + ", " + col)
				DIM str = FGET(FID, row + 1, col + 1)
				num = POWER(2, VAL(str) - 1)
				IFB num >= 1 THEN
					data[row][col] = num
					IFB data[row][col] <> 0 THEN
						Excel.Cells(row+1, col+1).Font.Bold = TRUE
						setValue(data[row][col], row, col, data, candidate)
					ENDIF
				ENDIF
			NEXT
		NEXT
		FCLOSE(FID)
	FEND
	PROCEDURE FullHouse(Var data[][], Var candidate[][])
	FEND
	PROCEDURE Single(Var data[][], Var candidate[][])
		// 行
		FOR col = 0 TO 8
			FOR n = 1 TO 9
				rCnt = 0
				targetRow = 0
				FOR row = 0 TO 8
					IFB data[row][col] = 0 THEN
						IFB candidate[row][col] AND POWER(2, n - 1)
							targetRow = row
							rCnt = rCnt + 1
						ENDIF
					ENDIF
				NEXT
				IFB rCnt = 1 THEN
					setValue(POWER(2, n - 1), targetRow, col, data, candidate)
				ENDIF
			NEXT
		NEXT
		// 列
		FOR row = 0 TO 8
			FOR n = 1 TO 9
				cCnt = 0
				targetCol = 0
				FOR col = 0 TO 8
					IFB data[row][col] = 0 THEN
						IFB candidate[row][col] AND POWER(2, n - 1) THEN
							targetCol = col
							cCnt = cCnt + 1
						ENDIF
					ENDIF
				NEXT
				IFB cCnt = 1 THEN
					setValue(POWER(2, n - 1), row, targetCol, data, candidate)
				ENDIF
			NEXT
		NEXT
	FEND
	PROCEDURE setValue(num, row, col, Var data[], Var candidate[])
		IFB num <> 0 THEN
			data[row][col] = LOGN(2, num) + 1
			Excel.Cells(row+1, col+1) = data[row][col]
			candidate[row][col] = num
			Excel.Cells(row+11, col+1) = "'" + bit(candidate[row][col], 9)
			setRow(num, row, col, candidate)
			setColumn(num, row, col, candidate)
			setBlock(num, row, col, candidate)
		ENDIF
	FEND
	PROCEDURE setRow(num, row, col, Var array[][])
		FOR r = 0 TO 8
			IFB r <> row THEN
				DIM a = array[r][col]
				DIM b = NOT(num, 9)
				array[r][col] = a AND b
				Excel.Cells(r+11, col+1) = "'" + bit(array[r][col], 9)
			ENDIF
		NEXT
	FEND
	PROCEDURE setColumn(num, row, col, Var array[][])
		FOR c = 0 TO 8
			IFB c <> col THEN
				DIM a = array[row][c]
				DIM b = NOT(num, 9)
				array[row][c] = a AND b
				Excel.Cells(row+11, c+1) = "'" + bit(array[row][c], 9)
			ENDIF
		NEXT
	FEND
	PROCEDURE setBlock(num, row, col, Var array[][])
		DIM ofsRow = INT(row / 3) * 3
		DIM ofsCol = INT(col / 3) * 3
		FOR r = ofsRow TO ofsRow + 2
			FOR c = ofsCol TO ofsCol + 2
				IF r = row AND c = col THEN CONTINUE
				array[r][c] = array[r][c] AND NOT(num, 9)
			Excel.Cells(r+11, c+1) = "'" + bit(array[r][c], 9)
			NEXT
		NEXT
	FEND
ENDMODULE

//////////////////////////////////////////////////
// 【引数】
//   path : 開くファイルのパス名 
// 【戻値】
//   Excelオブジェクト 
//////////////////////////////////////////////////
FUNCTION ExcelBoot(path = "")
	DIM Excel = CREATEOLEOBJ("Excel.Application")
	Excel.Visible = TRUE
	IFB path = "" THEN
		Excel.Workbooks.Add
	ELSE
		DIM FSO = CREATEOLEOBJ("Scripting.FileSystemObject")
		IFB FSO.GetParentFolderName(path) = "" THEN
			path = GET_CUR_DIR + "\" + path
		ENDIF
		Excel.Workbooks.Open(path)
	ENDIF
	RESULT = Excel
FEND