|
flyinspace
银牌会员
积分 1206
发帖 517
注册 2007-3-25
状态 离线
|
『楼 主』:
[出题][讨论][数独] 解答三部曲
请了解数独规则的人,直接由红色文字部分开始解答。
1,要求不得使用第三方工具
2,脚本可以是vbs,bat:
3,windows xp 自带的指令都可以使用。
最开始,这个题目是由论坛里的
moniuming
提出:
讨论地址如下:
------------------------------------------------------------------------------------------------
http://www.cn-dos.net/forum/viewthread.php?tid=42108&fpage=3
http://www.cn-dos.net/forum/viewthread.php?tid=42157&fpage=1
------------------------------------------------------------------------------------------------
由于工作时间关系,一直没有时间去研究这个话题。
那么现在抛开讨论区域(讨论区的数据并没有达到要求),开始我们的 数独 三部曲。。
数独规则如下:
********************************************************
1,所有行上的数据都为1-9,不能有重复,也不能有未使用的数字
2,所有列上的数据都为1-9,不能有重复,也不能有未使用的数字。
3,在一个9*9的区域内平均分为9个3*3的小区域,在任何一个3*3 的小区域里的数据都是1-9,且不能有重复,也不能有未使用的数字。
**********************************************************
例如下面:分成了3个3*3的区域
┏━┳━┳━┳━┳━┳━┳━┳━┳━┓
┃4 ┃7 ┃2 ┃3 ┃9 ┃6 ┃5 ┃1 ┃8 ┃
┣━╋━╋━╋━╋━╋━╋━╋━╋━┫
┃6 ┃8 ┃1 ┃5 ┃4 ┃7 ┃9 ┃2 ┃3 ┃
┣━╋━╋━╋━╋━╋━╋━╋━╋━┫
┃3 ┃5 ┃9 ┃2 ┃8 ┃1 ┃7 ┃4 ┃6 ┃
┗━┻━┻━┻━┻━┻━┻━┻━┻━┛
我生成了一个3*9的数字区域,这3*9的数字区域都未有重复的现象。
了解了上面的前提,那么题目出来了。
一,利用数独规则生成9*9的数独区域,要求满足
1,所有行上的数据为1-9不能有重复,也不能有未使用的数字
2,所有3*3上的数据为1-9不能有重复,也不能有未使用的数字
3,对列无要求
能完成此题的人,完成 1项的 +1 分。
完成 2项的 +3 分。
完成 1,2项的的 +5 分
----------------------------------------------------------------------
二,利用数独规则生成9*9的区域,要求满足
1,所有行上的数据为1-9不能有重复,也不能有未使用的数字
2,所有列上的数据为1-9不能有重复,也不能有未使用的数字
3,对3*3区域无要求
能完成此题的人,完成 1 项 + 1分。
完成 2 项 + 2分。
完成 1,2项 +4 分。
-----------------------------------------------------------------------
三,利用数独规则生成9*9的区域,要求满足
1。所有行与列的数据为1-9,不能有重复,也不能有未使用的数字。
2,所有3*3区域的数据为1-9,不能有重复,也不能有未使用的数字。
3,良好的冲突检测环境(也就是计算机运算开销问题)
完成此题的人 , +15分。。。(此时数独列表完成)-------------------------------------------------------------------------
我完成过题目三,只是每次都花费的时间好长,最长的有2个多小时,如果不是有屏幕提示生成的数列,我几乎以为陷于死循环了。
谢谢指正,修正了题目的笔误。。
[ Last edited by flyinspace on 2008-8-21 at 03:17 PM ]
|
知,不觉多。不知,乃求知 |
|
2008-8-20 11:41 |
|
|
flyinspace
银牌会员
积分 1206
发帖 517
注册 2007-3-25
状态 离线
|
『第
2 楼』:
请完成题目的人,注名:完成的第几项目。
代码用[code]格式框起来。方便大家复制。
其实题目三能完成,且10个运行项目都在 2分钟内的,我觉得+多少分都不为过呢。
我现在能把输出时间控制在10分钟内了。(100次的运算最长的一次)
提供一下我的输入代码:
这样调用比较好看。
-----------------------------------------------
for /l %%i in (0,1,8) do call :OutPut_Table_Num %%i
----------------------------------------------
:OutPut_Table_Num _num_
if "%1"=="0" echo ┏━┳━┳━┳━┳━┳━┳━┳━┳━┓
echo ┃!Table_0%1:~0,1! ┃!Table_0%1:~1,1! ┃!Table_0%1:~2,1! ┃!Table_0%1:~3,1! ┃!Table_0%1:~4,1! ┃!Table_0%1:~5,1! ┃!Table_0%1:~6,1! ┃!Table_0%1:~7,1! ┃!Table_0%1:~8,1! ┃
if not "%1"=="8" (
echo ┣━╋━╋━╋━╋━╋━╋━╋━╋━┫
goto :EOF
)
echo ┗━┻━┻━┻━┻━┻━┻━┻━┻━┛
goto :EOF
----------------------------------------------
[ Last edited by flyinspace on 2008-8-21 at 02:41 PM ]
|
知,不觉多。不知,乃求知 |
|
2008-8-20 11:43 |
|
|
slore
铂金会员
积分 5212
发帖 2478
注册 2007-2-8
状态 离线
|
『第
3 楼』:
Dancing Links 算法 貌似是最好搜索算法了。不过再脚本很难实现。。。还是得用最传统的方法。。。
|
S smile 微笑,L love 爱,O optimism 乐观,R relax 放松,E enthusiasm 热情...Slore |
|
2008-8-20 16:46 |
|
|
523066680
银牌会员
SuperCleaner
积分 2362
发帖 1133
注册 2008-2-2
状态 离线
|
|
2008-8-20 16:59 |
|
|
moniuming
银牌会员
永远的菜鸟
积分 1335
发帖 574
注册 2007-11-27 来自 广西
状态 离线
|
『第
5 楼』:
哈哈,给我加分吧...
第三题,尚未做太多测试,目前没发现问题,欢迎大家找茬...
@echo off
Setlocal Enabledelayedexpansion
for /l %%a in (1 1 9) do (set "bat=!bat! %%a")
for /l %%a in (1 1 3) do (set "str%%a=%bat%")
set /a "a=1","ran=9","lie=1","hng=1"
:lp2
if not defined rand set "rand=%ran%"
if "%lie%"=="10" (
for /l %%i in (1 1 3) do (set /p="!va%%i!"<nul)
echo.
for /l %%i in (1 1 9) do (set "%%i=")
set /a "hang+=1","hng+=1","ran-=3","lie=1","b=0","ttl=0","v=0","a=1"
set "rand="
if "!hang!"=="3" (
for /l %%a in (1 1 3) do (set "str%%a=%bat%")
set "ran=9"&set "hang=0"
)
for /l %%i in (1 1 3) do (set "string%%i=!str%%i!")
goto :lp2
)
if "%hng%"=="10" (echo.&pause&goto :eof)
set /a "ttl+=1"
if "%ttl%"=="30" (
for /l %%i in (1 1 3) do (set "str%%i=!string%%i!")
for /l %%i in (1 1 9) do (set "%%i="&set "str!hng!%%i=")
set /a "ran=%rand%","lie=1","ttl=0","a=1","b=0","v=0"
set "var="
goto :lp2
)
set /a "m=%random%%%%ran%+1"
for /f "tokens=%m%" %%a in ("!str%a%!") do (
if defined %%a goto :lp2
for /l %%i in (1 1 9) do (if "%%a"=="!str%%i%lie%!" goto :lp2)
set "%%a=god"&set "str%a%=!str%a%:%%a=!"&set "str!hng!!lie!=%%a"&set "var=!var!%%a "
)
set /a "ran-=1","b+=1","lie+=1","ttl=0"
if %b% lss 3 goto :lp2
set /a "v+=1","a+=1","ran+=3","b=0"
set "va%v%=%var%"&set "var="
goto :lp2
|
|
2008-8-20 23:55 |
|
|
moniuming
银牌会员
永远的菜鸟
积分 1335
发帖 574
注册 2007-11-27 来自 广西
状态 离线
|
『第
6 楼』:
刚刚测试时发现问题了,当出现下面的情况时,会陷入死循环
原因是第六行的前三位只能取1 3 9,但是前三行的第二列已经出现这三个数,==>死循环出现...
8 3 7 4 6 9 5 1 2
5 1 4 2 8 3 7 6 9
6 9 2 7 1 5 3 8 4
4 5 8 3 9 2 6 7 1
7 2 6 1 4 8 9 3 5
|
|
2008-8-21 00:03 |
|
|
moniuming
银牌会员
永远的菜鸟
积分 1335
发帖 574
注册 2007-11-27 来自 广西
状态 离线
|
『第
7 楼』:
这个问题又出现了,要解决这个问题就要全部重置,又要增加好多代码了,唉...
8 3 4 1 9 2 6 5 7
5 2 1 4 7 6 9 3 8
9 7 6 3 8 5 2 1 4
4 6 9 7 3 8 1 2 5
1 5 8 2 4 9 3 7 6
[ Last edited by moniuming on 2008-8-21 at 12:15 AM ]
|
|
2008-8-21 00:11 |
|
|
terse
银牌会员
积分 2404
发帖 946
注册 2005-9-8
状态 离线
|
|
2008-8-21 03:10 |
|
|
523066680
银牌会员
SuperCleaner
积分 2362
发帖 1133
注册 2008-2-2
状态 离线
|
|
2008-8-21 07:12 |
|
|
slore
铂金会员
积分 5212
发帖 2478
注册 2007-2-8
状态 离线
|
『第
10 楼』:
应该是1-9
|
S smile 微笑,L love 爱,O optimism 乐观,R relax 放松,E enthusiasm 热情...Slore |
|
2008-8-21 09:25 |
|
|
moniuming
银牌会员
永远的菜鸟
积分 1335
发帖 574
注册 2007-11-27 来自 广西
状态 离线
|
『第
11 楼』:
修正6楼的代码,不会出现死循环了,呵呵...
@echo off
Setlocal Enabledelayedexpansion
for /l %%a in (1 1 9) do (set "bat=!bat! %%a")
:lp1
for /l %%a in (1 1 3) do (set "str%%a=%bat%")
set /a "a=1","ran=9","lie=1","hng=1"
:lp2
if not defined rand set "rand=%ran%"
if "%hng%"=="10" (
echo.
for /l %%i in (1 1 9) do echo !moniuming%%i!
echo.&pause
set /a "ttl=0","tot=0","b=0","hang=0"
set "rand="&set "var="
for /l %%a in (1 1 9) do (set "%%a="&set "moniuming%%a=")
for /l %%a in (1 1 8) do (
for /l %%b in (1 1 9) do (set str%%a%%b=)
)
goto :lp1
)
if "%lie%"=="10" (
for /l %%i in (1 1 3) do (set "moniuming%hng%=!moniuming%hng%!!va%%i!")
for /l %%i in (1 1 9) do (set "%%i=")
set /a "hang+=1","hng+=1","ran-=3","lie=1","b=0","ttl=0","v=0","a=1","tot=0"
set "rand="
if "!hang!"=="3" (
for /l %%a in (1 1 3) do (set "str%%a=%bat%")
set "ran=9"&set "hang=0"
)
for /l %%i in (1 1 3) do (set "string%%i=!str%%i!")
goto :lp2
)
if "%tot%"=="10" (
set /a "ttl=0","tot=0","b=0","hang=0"
set "rand="&set "var="
for /l %%a in (1 1 9) do (set "%%a="&set "moniuming%%a=")
for /l %%a in (1 1 8) do (
for /l %%b in (1 1 9) do (set str%%a%%b=)
)
goto :lp1
)
set /a "ttl+=1"
if "%ttl%"=="40" (
for /l %%i in (1 1 3) do (set "str%%i=!string%%i!")
for /l %%i in (1 1 9) do (set "%%i="&set "str!hng!%%i=")
set /a "ran=%rand%","lie=1","ttl=0","a=1","b=0","v=0","tot+=1"
set "var="
goto :lp2
)
set /a "m=%random%%%%ran%+1"
for /f "tokens=%m%" %%a in ("!str%a%!") do (
if defined %%a goto :lp2
for /l %%i in (1 1 %hng%) do (if "%%a"=="!str%%i%lie%!" goto :lp2)
set "%%a=god"&set "str%a%=!str%a%:%%a=!"&set "str!hng!!lie!=%%a"&set "var=!var! %%a"
)
set /a "ran-=1","b+=1","lie+=1","ttl=0"
if %b% lss 3 goto :lp2
set /a "v+=1","a+=1","ran+=3","b=0"
set "va%v%=%var%"&set "var="
goto :lp2
|
|
2008-8-21 11:31 |
|
|
flyinspace
银牌会员
积分 1206
发帖 517
注册 2007-3-25
状态 离线
|
『第
12 楼』:
经过如下代码统计
--------------------------
@echo off
set "GetCurTime=00:00:08.17"
set "GetOldTime=23:59:09.19"
for /f "delims=:. tokens=1,2,3,4" %%i in ('echo %GetCurTime%') do (
set "Curhour=%%i"
set "CurMin=%%j"
set "CurSec=%%k"
set "CurBit=%%l"
)
if "%Curhour:~0,1%"=="0" set "Curhour=%Curhour:~1,1%"
if "%CurMin:~0,1%"=="0" set "CurMin=%CurMin:~1,1%"
if "%CurSec:~0,1%"=="0" set "CurSec=%CurSec:~1,1%"
if "%CurBit:~0,1%"=="0" set "CurBit=%CurBit:~1,1%"
for /f "delims=:. tokens=1,2,3,4" %%i in ('echo %GetOldTime%') do (
set "Oldhour=%%i"
set "OldMin=%%j"
set "OldSec=%%k"
set "OldBit=%%l"
)
if "%Oldhour:~0,1%"=="0" set "Oldhour=%Oldhour:~1,1%"
if "%OldMin:~0,1%"=="0" set "OldMin=%OldMin:~1,1%"
if "%OldSec:~0,1%"=="0" set "OldSec=%OldSec:~1,1%"
if "%OldBit:~0,1%"=="0" set "OldBit=%OldBit:~1,1%"
if "%Curhour%" LSS "%Oldhour%" set "Curhour=24"
set /a "TotalTime=(%Curhour%-%Oldhour%)*60*60*100 + (%CurMin%-%OldMin%)*60*100+(%CurSec%-%OldSec%)*100+%CurBit%-%OldBit%"
echo 总计用时:%TotalTime%微秒
pause
--------------------------------------------
9楼的代码
1000次的计算中,最长的一次是 7953微秒
12楼的
1000次的计算中,最长的一次是 10513微秒
如果有疑问,请与flyinspace联系。
我修改了代码程序自动做的统计
|
知,不觉多。不知,乃求知 |
|
2008-8-21 15:08 |
|
|
flyinspace
银牌会员
积分 1206
发帖 517
注册 2007-3-25
状态 离线
|
『第
13 楼』:
9楼的算法从那里弄的呀?好厉害。
我的代码和9楼的代码差不多长的时候统计要好久。
加入了多级判定后,才把运行时间减下来。
|
知,不觉多。不知,乃求知 |
|
2008-8-21 15:12 |
|
|
523066680
银牌会员
SuperCleaner
积分 2362
发帖 1133
注册 2008-2-2
状态 离线
|
『第
14 楼』:
搞不好是原创哦
12楼太让我吃惊了 我连题目都不敢看,有空一定会探索你的代码的!
要记得标上原作者,我收藏咯。
[ Last edited by 523066680 on 2008-8-21 at 03:46 PM ]
|
综合型编程论坛
我的作品索引 |
|
2008-8-21 15:41 |
|
|
slore
铂金会员
积分 5212
发帖 2478
注册 2007-2-8
状态 离线
|
『第
15 楼』:
来个VBS版的,毫秒级的而且……
Quote: | '---------------------------------------------
' Soduko.vbs——数独计算VBScript脚本
'
' 代码将完成同目录下的Soduko.ini中的数独。
' 代码仅供学习,转载请保留本信息。
'
' 2008年08月22日 By Slore
'---------------------------------------------
Const x = 0
Const y = 1
Const ReadInitFile = 1 '改为0为生成模式
Const ForReading = 1
InitFile = "SodukoE.ini"
If ReadInitFile Then InitFile = "Soduko.ini"
Dim SodukoX
Dim SodukoY(8)
Dim SodukoZ(8)
Dim SodukoBoard(9,9)
Dim SolveSequence()
Dim InitialStr,iPanesToSolve
If LCase(Right(WSH.FullName,11)) = "wscript.exe" Then
Set objShell = Wscript.CreateObject("WScript.Shell")
objShell.Run "Cscript //nologo " & WScript.ScriptFullName
Set objShell = Nothing
WSH.Quit
End If
Soduko_Initialize
CreateExecutionPlan
If iPanesToSolve >= 0 Then
bSuccess = SolvePane(0)
Else
bSuccess = True
End If
If bSuccess Then
SolveSuccess
Else
MsgBox "此数独无法完成!", vbExclamation,"结果" 'SolveFailed
End If
Private Sub Soduko_Initialize()
For i = 0 To 8
SodukoY(i) = "000000000"
SodukoZ(i) = "000000000"
Next
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(InitFile,ForReading)
InitialStr = Replace(objFile.ReadAll," ","")
objFile.Close
Set objFile = Nothing
Set objFSO = Nothing
SodukoX = Split(InitialStr,vbCrLf)
InitialStr = Replace(InitialStr,vbCrLf,"")
For i = 1 To 81
iValue = Mid(InitialStr,i,1)
PosX = (i + 8) \ 9
PosY = i + 9 - PosX * 9 '((i+8) mod 9)+1
PosZ = ((PosX - 1) \ 3) * 3 + (PosY - 1) \ 3
SodukoBoard(PosX,PosY) = iValue
SodukoY(PosY - 1) = Left(SodukoY(PosY - 1),PosX - 1) & iValue & Mid(SodukoY(PosY - 1),PosX + 1)
Pos = ((PosX - 1) Mod 3) * 3 + (PosY - 1) Mod 3
SodukoZ(PosZ) = Left(SodukoZ(PosZ),Pos) & iValue & Mid(SodukoZ(PosZ),Pos + 2)
If iValue = 0 Then
ReDim Preserve SolveSequence(1,iCount)
SolveSequence(x,iCount) = PosX
SolveSequence(y,iCount) = PosY
iCount = iCount + 1
End If
Next
iPanesToSolve = iCount - 1
End Sub
Private Sub CreateExecutionPlan()
Do
iPreSolvedCount = 0
For iCount = 0 To iPanesToSolve
PosX = SolveSequence(x,iCount)
PosY = SolveSequence(y,iCount)
If PosX <> - 1 Then
sValues = GetValuesToTest(PosX,PosY)
If Len(sValues) <= 1 Then
If Len(sValues) = 1 Then
Call SetValue(PosX,PosY,sValues)
End If
SolveSequence(x,iCount) = - 1
iPreSolvedCount = iPreSolvedCount + 1
End If
End If
Next
If iPreSolvedCount = 0 Then
Exit Do
Else
bRearrangeExecutionArray = True
End If
Loop
If bRearrangeExecutionArray Then
For iCount = 0 To iPanesToSolve
If SolveSequence(x,iCount) <> - 1 Then
SolveSequence(x,iLastArrayPos) = SolveSequence(x,iCount)
SolveSequence(y,iLastArrayPos) = SolveSequence(y,iCount)
iLastArrayPos = iLastArrayPos + 1
End If
Next
If iLastArrayPos > 0 Then
ReDim Preserve SolveSequence(1,iLastArrayPos - 1)
End If
iPanesToSolve = iLastArrayPos - 1
End If
End Sub
Private Function SolvePane(ByVal iSolveSequence)
PosX = SolveSequence(x,iSolveSequence)
PosY = SolveSequence(y,iSolveSequence)
sValueList = GetValuesToTest(PosX, PosY)
Randomize
l = Len(sValueList)
If l > 0 Then
Do While l
iValuePos = Int(Rnd * l) + 1
iValue = CInt(Mid(sValueList, iValuePos, 1))
sValueList = Left(sValueList, iValuePos - 1) & Mid(sValueList, iValuePos + 1)
Call SetValue(PosX,PosY,iValue)
If iSolveSequence < iPanesToSolve Then
bSuccess = SolvePane(iSolveSequence + 1)
Else
bSuccess = True
End If
If bSuccess Then
Exit Do
End If
l = Len(sValueList)
Loop
Else
bSuccess = False
End If
If bSuccess = False Then
Call SetValue(PosX,PosY,0)
End If
SolvePane = bSuccess
End Function
Private Function GetValuesToTest(PosX,PosY)
PosZ = ((PosX - 1) \ 3) * 3 + (PosY - 1) \ 3
SetedValue = SodukoX(PosX - 1) & SodukoY(PosY - 1) & SodukoZ(PosZ)
For i = 1 To 9
If InStr(1,SetedValue,i) = 0 Then
GetValuesToTest = GetValuesToTest & i
End If
Next
End Function
Private Sub SetValue(PosX,PosY,iValue)
SodukoBoard(PosX,PosY) = iValue
PosZ = ((PosX - 1) \ 3) * 3 + (PosY - 1) \ 3
SodukoX(PosX - 1) = Left(SodukoX(PosX - 1),PosY - 1) & iValue & Mid(SodukoX(PosX - 1),PosY + 1)
SodukoY(PosY - 1) = Left(SodukoY(PosY - 1),PosX - 1) & iValue & Mid(SodukoY(PosY - 1),PosX + 1)
Pos = ((PosX - 1) Mod 3) * 3 + (PosY - 1) Mod 3
SodukoZ(PosZ) = Left(SodukoZ(PosZ),Pos) & iValue & Mid(SodukoZ(PosZ),Pos + 2)
End Sub
Private Sub SolveSuccess()
'For i = 0 To 8
' WSH.Echo SodukoX(i)
'Next
For i = 1 To 9
OutStr = ""
For j = 1 To 9
OutStr = OutStr & SodukoBoard(i,j) & " "
If (j Mod 3) = 0 Then OutStr = OutStr & " "
Next
WSH.Echo OutStr
If (i Mod 3) = 0 Then WSH.Echo
Next
MsgBox "数独填写成功!", vbInformation,"结果"
End Sub |
|
附件:
下载
[ Last edited by slore on 2008-8-22 at 04:27 PM ]
|
S smile 微笑,L love 爱,O optimism 乐观,R relax 放松,E enthusiasm 热情...Slore |
|
2008-8-22 16:21 |
|
|