中国DOS联盟

Please have those who understand Sudoku rules start solving directly from the red text part.

1. Requirement: No third-party tools are allowed to be used
2. The script can be vbs, bat:
3. All commands built into Windows XP can be used.

Initially, this topic was proposed by
moniuming
in the forum:
Discussion addresses are as follows:
------------------------------------------------------------------------------------------------
http://www.cn-dos.net/forum/viewthread.php?tid=42108&fpage=3
http://www.cn-dos.net/forum/viewthread.php?tid=42157&fpage=1
------------------------------------------------------------------------------------------------
Due to work time constraints, I have not had time to study this topic.

Now, putting aside the discussion area (the data in the discussion area does not meet the requirements), let's start our Sudoku trilogy.

Sudoku rules are as follows:
********************************************************
1. All data in each row is 1-9, no duplicates, and no unused numbers
2. All data in each column is 1-9, no duplicates, and no unused numbers.
3. In a 9*9 area, it is evenly divided into 9 3*3 small areas. In any 3*3 small area, the data is 1-9, no duplicates, and no unused numbers.
**********************************************************
For example, the following is divided into 3 3*3 areas
┏━┳━┳━┳━┳━┳━┳━┳━┳━┓
┃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 ┃
┗━┻━┻━┻━┻━┻━┻━┻━┻━┛
I generated a 3*9 digital area, and there are no duplicate phenomena in this 3*9 digital area.

After understanding the above prerequisites, the problem comes out.

First, use the Sudoku rules to generate a 9*9 Sudoku area, and the requirements are
1. The data in all rows is 1-9, no duplicates, and no unused numbers

2. The data in all 3*3 areas is 1-9, no duplicates, and no unused numbers

3. No requirements for columns
Those who can complete this question, +1 point for completing item 1.
+3 points for completing item 2.
+5 points for completing both items 1 and 2
----------------------------------------------------------------------
Second, use the Sudoku rules to generate a 9*9 area, and the requirements are
1. The data in all rows is 1-9, no duplicates, and no unused numbers
2. The data in all columns is 1-9, no duplicates, and no unused numbers
3. No requirements for 3*3 areas
Those who can complete this question, +1 point for completing item 1.
+2 points for completing item 2.
+4 points for completing both items 1 and 2.
-----------------------------------------------------------------------
Third, use the Sudoku rules to generate a 9*9 area, and the requirements are
1. The data in all rows and columns is 1-9, no duplicates, and no unused numbers.
2. The data in all 3*3 areas is 1-9, no duplicates, and no unused numbers.
3. A good conflict detection environment (that is, the problem of computer operation overhead)
Those who complete this question, +15 points... (At this time, the Sudoku list is completed)-------------------------------------------------------------------------

I have completed question three, but each time it takes a long time, the longest is more than 2 hours. If there were no screen prompts to generate the number sequence, I almost thought I was in an infinite loop.

Thank you for correction, and the typo in the question has been corrected.

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 ]

People who complete the questions, please note: which project number it is. The code is enclosed in

 format boxes for easy copying.



Actually, if question three can be completed and all 10 running projects are within 2 minutes, I think any bonus points are well-deserved.



I can now control the output time within 10 minutes. (The longest time for 100 operations)



Provide my input code:





This call is more beautiful.

-----------------------------------------------

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 ]

The Dancing Links algorithm seems to be the best search algorithm. But it's really hard to implement in scripts... Still have to use the most traditional methods...

Request slore to join the QQ group of hat (or I don't know if you are in the group). The group number is in hat's signature

@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

Question 3, not much testing has been done yet, no problems found so far, everyone is welcome to find faults...

@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

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

Just now, when testing, a problem was found. When the following situation occurs, it will fall into an infinite loop. The reason is that the first three digits of the sixth line can only take 1, 3, 9, but these three numbers have already appeared in the second column of the first three lines, ==> The infinite loop occurs...

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

This problem has occurred again. To solve this problem, we need to reset everything completely, and a lot of code will have to be added. Alas...

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=

### Problem 3

@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=

Ask, the number range mentioned in the subsequent question is 0-9. There are a total of 10 numbers here. Is this confirmed?

@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

Correct the code on floor 6, no more infinite loops, heh...

@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

Statistics through the following code
--------------------------
@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 Total time used: %TotalTime% microseconds
pause
--------------------------------------------
Code on floor 9
In 1000 calculations, the longest one is 7953 microseconds
On floor 12
In 1000 calculations, the longest one is 10513 microseconds

If you have any questions, contact flyinspace.

I modified the code program to do the statistics automatically

Where did you get the algorithm from floor 9? It's amazing.
When my code is almost as long as the code from floor 9, the statistics take a long time.
After adding multi - level judgments, the running time is reduced.

Maybe it's original.

Floor 12 really surprised me. I didn't even dare to look at the title. I will definitely explore your code when I have time!
Remember to mark the original author, I'm saving it.

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

'---------------------------------------------
' Soduko.vbs - Sudoku calculation VBScript script
'
' The code will solve the Sudoku in Soduko.ini in the same directory.
' The code is for learning only, please retain this information when reprinting.
'
' August 22, 2008 By Slore
'---------------------------------------------
Const x = 0
Const y = 1

Const ReadInitFile = 1 'Change to 0 for generation mode

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 "This Sudoku cannot be completed!", vbExclamation,"Result" '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 "Sudoku filled successfully!", vbInformation,"Result"

End Sub

Attachment:
Download

Last edited by slore on 2008-8-22 at 04:27 PM ]