解答三部曲 - 中国DOS联盟论坛 - 中国DOS联盟之联合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个数，这点是否确认。

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

第1楼　flyinspace	发表于 2008-08-20 11:41
银牌会员　发帖 517　积分 1,206
[出题][讨论][数独] 解答三部曲请了解数独规则的人，直接由红色文字部分开始解答。 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，在一个99的区域内平均分为9个33的小区域，在任何一个33 的小区域里的数据都是1-9，且不能有重复，也不能有未使用的数字。 ********************************************************* 例如下面：分成了3个33的区域 ┏━┳━┳━┳━┳━┳━┳━┳━┳━┓ ┃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 ┃ ┗━┻━┻━┻━┻━┻━┻━┻━┻━┛ 我生成了一个39的数字区域，这39的数字区域都未有重复的现象。了解了上面的前提，那么题目出来了。一，利用数独规则生成99的数独区域，要求满足 1，所有行上的数据为1-9不能有重复，也不能有未使用的数字 2，所有33上的数据为1-9不能有重复，也不能有未使用的数字 3，对列无要求能完成此题的人，完成 1项的 +1 分。完成 2项的 +3 分。完成 1，2项的的 +5 分 ---------------------------------------------------------------------- 二，利用数独规则生成99的区域，要求满足 1，所有行上的数据为1-9不能有重复，也不能有未使用的数字 2，所有列上的数据为1-9不能有重复，也不能有未使用的数字 3，对33区域无要求能完成此题的人，完成 1 项 + 1分。完成 2 项 + 2分。完成 1，2项 +4 分。 ----------------------------------------------------------------------- 三，利用数独规则生成99的区域，要求满足 1。所有行与列的数据为1-9，不能有重复，也不能有未使用的数字。 2，所有33区域的数据为1-9，不能有重复，也不能有未使用的数字。 3，良好的冲突检测环境（也就是计算机运算开销问题）完成此题的人， +15分。。。（此时数独列表完成）------------------------------------------------------------------------- 我完成过题目三，只是每次都花费的时间好长，最长的有2个多小时，如果不是有屏幕提示生成的数列，我几乎以为陷于死循环了。谢谢指正，修正了题目的笔误。。 [ Last edited by flyinspace on 2008-8-21 at 03:17 PM* ]

第2楼　flyinspace	发表于 2008-08-20 11:43
银牌会员　发帖 517　积分 1,206
请完成题目的人，注名：完成的第几项目。代码用格式框起来。方便大家复制。其实题目三能完成，且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 ]

第3楼　slore	发表于 2008-08-20 16:46
铂金会员　发帖 2,478　积分 5,212
Dancing Links 算法貌似是最好搜索算法了。不过再脚本很难实现。。。还是得用最传统的方法。。。

第4楼　523066680	发表于 2008-08-20 16:59
银牌会员　发帖 1,133　积分 2,362
请求slore加入hat的QQ群（或者我不知道您在群里）群号在hat的签名里

第5楼　moniuming	发表于 2008-08-20 23:55
银牌会员　发帖 574　积分 1,335　来自广西
哈哈,给我加分吧... 第三题,尚未做太多测试,目前没发现问题,欢迎大家找茬... @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

第6楼　moniuming	发表于 2008-08-21 00:03
银牌会员　发帖 574　积分 1,335　来自广西
刚刚测试时发现问题了,当出现下面的情况时,会陷入死循环原因是第六行的前三位只能取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

第7楼　moniuming	发表于 2008-08-21 00:11
银牌会员　发帖 574　积分 1,335　来自广西
这个问题又出现了,要解决这个问题就要全部重置,又要增加好多代码了,唉... 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 ]

第8楼　terse	发表于 2008-08-21 03:10
银牌会员　发帖 946　积分 2,404
第三题 @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=

第9楼　523066680	发表于 2008-08-21 07:12
银牌会员　发帖 1,133　积分 2,362
问，后面题目中说得数字范围是0-9 这里一共是10个数，这点是否确认。

第10楼　slore	发表于 2008-08-21 09:25
铂金会员　发帖 2,478　积分 5,212
应该是1-9

第11楼　moniuming	发表于 2008-08-21 11:31
银牌会员　发帖 574　积分 1,335　来自广西
修正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

第12楼　flyinspace	发表于 2008-08-21 15:08
银牌会员　发帖 517　积分 1,206
经过如下代码统计 -------------------------- @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%)6060100 + (%CurMin%-%OldMin%)60100+(%CurSec%-%OldSec%)100+%CurBit%-%OldBit%" echo 总计用时:%TotalTime%微秒 pause -------------------------------------------- 9楼的代码 1000次的计算中，最长的一次是 7953微秒 12楼的 1000次的计算中，最长的一次是 10513微秒如果有疑问，请与flyinspace联系。我修改了代码程序自动做的统计

第13楼　flyinspace	发表于 2008-08-21 15:12
银牌会员　发帖 517　积分 1,206
9楼的算法从那里弄的呀？好厉害。我的代码和9楼的代码差不多长的时候统计要好久。加入了多级判定后，才把运行时间减下来。

第14楼　523066680	发表于 2008-08-21 15:41
银牌会员　发帖 1,133　积分 2,362
搞不好是原创哦 12楼太让我吃惊了我连题目都不敢看，有空一定会探索你的代码的！要记得标上原作者，我收藏咯。 [ Last edited by 523066680 on 2008-8-21 at 03:46 PM ]

第15楼　slore	发表于 2008-08-22 16:21
铂金会员　发帖 2,478　积分 5,212
来个VBS版的，毫秒级的而且…… '--------------------------------------------- ' 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 ]