中国DOS联盟

请了解数独规则的人，直接由红色文字部分开始解答。

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 ]

请完成题目的人，注名：完成的第几项目。
代码用

格式框起来。方便大家复制。



其实题目三能完成，且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 ]

Dancing Links 算法 貌似是最好搜索算法了。不过再脚本很难实现。。。还是得用最传统的方法。。。

请求slore加入hat的QQ群 （或者我不知道您在群里） 群号在hat的签名里

第三题,尚未做太多测试,目前没发现问题,欢迎大家找茬...

@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

刚刚测试时发现问题了,当出现下面的情况时,会陷入死循环
原因是第六行的前三位只能取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

这个问题又出现了,要解决这个问题就要全部重置,又要增加好多代码了,唉...

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 ]

第三题

@echo off&setlocal enabledelayedexpansion

:st

for /l %%i in (1 1 9) do call:lp %%i

pause&exit

:lp

    for /l %%i in (1 1 9) do set .!random!!random!!random!=%%i

    for /f "tokens=1,2 delims==" %%i in ('set .') do set str=%%j !str!&set %%i=

    for /l %%i in (1 1 9) do set %1%%i=

    set var=%str%&set/a n=1,v=%1-1,y=1,z=3,x=1,a=%1%%3

    if %1 geq 4 if %1 leq 6 (set/a x=4) else set/a x=7

:lp0

    if %n% geq 4 if %n% leq 6 (set/a y=4,z=6) else set/a y=7,z=9

    for %%a in (!var!) do (

    if defined .%%a set var=!var:%%a=!&goto lp0

    for /l %%i in (1 1 %1) do if %%a equ !%%i%n%! set var=!var:%%a=!&goto lp0

    if %a% neq 1 (for /l %%j in (%x% 1 %v%) do (

    for /l %%k in (%y% 1 %z%) do if %%a equ !%%j%%k! set var=!var:%%a=!&goto lp0

    ))

    set %1!n!=%%a&set .%%a=a

    if !n! lss 9 set/a n+=1&set var=!str:%%a=!&goto lp0

    )

    set str=&set n=

    for /l %%i in (1 1 9) do set .%%i=

    if "!%19!"=="" set/a mn+=1&if !mn! gtr 50 (set mn=&cls&goto st)else goto lp

    for /l %%i in (1 1 9) do set .%%i=&set/p=!%1%%i! <nul

    echo.&set mn=

问，后面题目中说得数字范围是0-9 这里一共是10个数，这点是否确认。

应该是1-9

修正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

经过如下代码统计
--------------------------
@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联系。

我修改了代码程序自动做的统计

9楼的算法从那里弄的呀？好厉害。
我的代码和9楼的代码差不多长的时候统计要好久。

加入了多级判定后，才把运行时间减下来。

搞不好是原创哦

12楼太让我吃惊了 我连题目都不敢看，有空一定会探索你的代码的！
要记得标上原作者，我收藏咯。

[ Last edited by 523066680 on 2008-8-21 at 03:46 PM ]

'---------------------------------------------
' 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 ]