hummakavula Posted July 21, 2007 Share Posted July 21, 2007 This program is a quick attempt at a basic validator/solver for sudoku puzzles.It implements a GUI.I'm not much of a sudoku-enthousiast though, so there should be enough oppertinities to improve on this solver-algorithm.Download: Easydoku.rarI hope you like it. Link to comment Share on other sites More sharing options...
hummakavula Posted July 21, 2007 Author Share Posted July 21, 2007 Here's a Screenshot Link to comment Share on other sites More sharing options...
poisonkiller Posted July 21, 2007 Share Posted July 21, 2007 Could you upload it to rapidshare or somewhere else, because I can't download from AutoIt forum for some strange reason. Link to comment Share on other sites More sharing options...
hummakavula Posted July 22, 2007 Author Share Posted July 22, 2007 (edited) Could you upload it to rapidshare or somewhere else, because I can't download from AutoIt forum for some strange reason.I'm not familiar with rapidshare, but try this: expandcollapse popup; ; Easydoku v0.1-70716 ; ; Description: ; This program is a quick attempt at a ; basic validator/solver for sudoku puzzles. ; I'm not much of a sudoku-enthousiast, ; so there should be enough oppertinities to ; improve on this solver-algorithm. ; ; --- LIBRARIES ----------------------------------------------------- #compiler_icon = chicken.ico #include <GUIConstants.au3> #include <Misc.au3> ; --- CONSTANTS ----------------------------------------------------- Const $APP_NAME = "Easydoku" ; program information Const $APP_VERSION = "0.1" Const $INOUT_SQUARE = 9 ; properties of puzzle Const $INOUT_GROUP = 3 Const $INOUT_WIDTH = 40 Const $INOUT_HEIGHT = 40 Const $INOUT_FONT_SIZE = 24 ; big friendly letters Const $INOUT_FONT_WEIGHT = 400 Const $INOUT_FONT_ATTR = 0 Const $INOUT_FONT_NAME = "Tahoma" Const $INOUT_MARK = 0xFFFFFF ; colors for marking conflicts Const $INOUT_MARK_CONFLICT_GROUP = 0xFF0000 Const $INOUT_MARK_CONFLICT_AXIS = 0xFF6000 Const $BUTTON_HEIGHT = 32 ; height of buttons ; --- VARIABLES ---------------------------------------------------- Dim $me Dim $win_w, $win_h ; --- IMPLEMENTATION ------------------------------------------------ ; SyncMatrix ; - synchronize <matrix[x][y][0]> and <inout[x][y]>, ; - <inout[x][y]> is acts as an interface between validator/solver and human input ; - value of <isoutput> determines direction ; Func SyncMatrix( ByRef $matrix, ByRef $inout, $isoutput ) Dim $x, $y, $tmp For $x = 0 To $INOUT_SQUARE - 1 For $y = 0 To $INOUT_SQUARE - 1 If $isoutput Then $tmp = $matrix[$x][$y][0] If ( $tmp > 0 ) Then GUICtrlSetData( $inout[$x][$y], $tmp ) Else $tmp = GUICtrlRead( $inout[$x][$y] ) $matrix[$x][$y][0] = _Iif( StringIsInt( $tmp ), $tmp, 0 ) For $z = 1 To UBound( $matrix, 3 ) - 1 $matrix[$x][$y][$z] = 1 Next EndIf Next Next EndFunc ; EliminateRange ; - <matrix[x][y][0]> holds 'known values' ; - <matrix[x][y][1 .. 9]> hold 'possible values' and are used by the eliminiation routine ; Func EliminateRange( ByRef $matrix, $x_min, $y_min, $x_max, $y_max ) Dim $eliminate[$INOUT_SQUARE + 1] Dim $x, $y, $z, $tmp ; from specified range collect known values $x = $x_min While ( $x < $x_max ) And ( $x < $INOUT_SQUARE ) $y = $y_min While ( $y < $y_max ) And ( $y < $INOUT_SQUARE ) $eliminate[$matrix[$x][$y][0]] = 1 $y += 1 Wend $x += 1 WEnd ; eliminate known values For $z = 1 To UBound( $eliminate ) - 1 $x = $x_min While ( $x < $x_max ) And ( $x < $INOUT_SQUARE ) $y = $y_min While ( $y < $y_max ) And ( $y < $INOUT_SQUARE ) If ( $eliminate[$z] = 1 ) Then $matrix[$x][$y][$z] = 0 $y += 1 Wend $x += 1 WEnd Next EndFunc ; MarkRange ; - <inout[x][y]> can be marked to indicate conflicting values ; Func MarkRange( ByRef $inout, $color, $x_min, $y_min, $x_max, $y_max ) $x = $x_min While ( $x < $x_max ) And ( $x < $INOUT_SQUARE ) $y = $y_min While ( $y < $y_max ) And ( $y < $INOUT_SQUARE ) GUICtrlSetBkColor( $inout[$x][$y], $color ) $y += 1 Wend $x += 1 WEnd EndFunc ; ValidateRange ; - verify whether all 'known values' within the speficied range are unique ; - returns <conflict> which is the number of conflicting values ; Func ValidateRange( ByRef $inout, $x_min, $y_min, $x_max, $y_max ) Dim $count[$INOUT_SQUARE + 1] Dim $x, $y, $tmp Dim $conflict $conflict = 0 $x = $x_min While ( $x < $x_max ) And ( $x < $INOUT_SQUARE ) $y = $y_min While ( $y < $y_max ) And ( $y < $INOUT_SQUARE ) $tmp = GUICtrlRead( $inout[$x][$y] ) If ( $tmp > 0 ) Then $count[$tmp] += 1 If ( $count[$tmp] > 1 ) Then $conflict += 1 EndIf $y += 1 Wend $x += 1 WEnd If ( $conflict > 0 ) Then MarkRange( $inout, _IIf( ( $x_max - $x_min > 1 ) And ( $y_max - $y_min > 1 ), $INOUT_MARK_CONFLICT_GROUP, $INOUT_MARK_CONFLICT_AXIS ), $x_min, $y_min, $x_max, $y_max ) Return $conflict EndFunc ; SolveIteration ; - solves one iteration of the elimination-process ; Func SolveIteration( ByRef $matrix ) Dim $x, $y For $x = 0 To $INOUT_SQUARE - 1 EliminateRange( $matrix, $x, 0, $x + 1, $INOUT_SQUARE ) ; Eliminate Rows EliminateRange( $matrix, 0, $x, $INOUT_SQUARE, $x + 1 ) ; Eliminate Columns Next For $x = 0 To $INOUT_GROUP - 1 For $y = 0 To $INOUT_GROUP - 1 ; Validate Group EliminateRange( $matrix, $x * ( $INOUT_SQUARE / $INOUT_GROUP ), $y * ( $INOUT_SQUARE / $INOUT_GROUP ), ( $x + 1 ) * ( $INOUT_SQUARE / $INOUT_GROUP ), ( $y + 1 ) * ( $INOUT_SQUARE / $INOUT_GROUP ) ) Next Next For $x = 0 To $INOUT_SQUARE - 1 For $y = 0 To $INOUT_SQUARE - 1 If $matrix[$x][$y][0] = 0 Then $tmp = 0 For $z = 1 To UBound( $matrix, 3 ) - 1 If ( $matrix[$x][$y][$z] = 1 ) Then $matrix[$x][$y][0] = _Iif( $tmp = 0, $z, 0 ) $tmp += 1 EndIf If ( $tmp > 1 ) Then ExitLoop Next EndIf Next Next EndFunc ; Solve (function not implemented!) ; - loop SolveIteration untill the puzzle is solved ; Func Solve( ByRef $matrix, ByRef $inout ) SolveIteration( $matrix ) SyncMatrix( $matrix, $inout, True ) EndFunc ; Validate ; - loop ValidateRange untill entire puzzle is validated ; Func Validate( ByRef $inout ) Dim $x, $y Dim $conflict $conflict = 0 For $x = 0 To $INOUT_SQUARE - 1 $conflict += ValidateRange( $inout, $x, 0, $x + 1, $INOUT_SQUARE ) ; Validate Rows $conflict += ValidateRange( $inout, 0, $x, $INOUT_SQUARE, $x + 1 ) ; Validate Columns Next For $x = 0 To $INOUT_GROUP - 1 For $y = 0 To $INOUT_GROUP - 1 ; Validate Group $conflict += ValidateRange( $inout, $x * ( $INOUT_SQUARE / $INOUT_GROUP ), $y * ( $INOUT_SQUARE / $INOUT_GROUP ), ( $x + 1 ) * ( $INOUT_SQUARE / $INOUT_GROUP ), ( $y + 1 ) * ( $INOUT_SQUARE / $INOUT_GROUP ) ) Next Next Return $conflict EndFunc ; --- GUI EVENTS ---------------------------------------------------- Func ButtonclickSolve( Byref $inout ) ScreenUpdating( False ) MarkRange( $inout, $INOUT_MARK, 0, 0, $INOUT_SQUARE, $INOUT_SQUARE ) Dim $matrix[$INOUT_SQUARE][$INOUT_SQUARE][$INOUT_SQUARE + 1] Dim $conflict $conflict = Validate( $inout ) If ( $conflict = 0 ) Then SyncMatrix( $matrix, $inout, False ) Solve( $matrix, $inout ) ScreenUpdating( True ) EndIf ScreenUpdating( True ) If ( $conflict > 0 ) Then MsgBox( 0x30, "Error", "This puzzle contains atleast " & $conflict & " conflict" & _Iif( $conflict = 1, "", "s" ) & "!" & @CRLF & "Please resolve and try again..." ) EndIf EndFunc Func ButtonclickClear( ByRef $inout ) ScreenUpdating( False ) For $x = 0 To UBound( $inout ) - 1 For $y = 0 To UBound( $inout, 2 ) - 1 GUICtrlSetData( $inout[$x][$y], "" ) Next Next MarkRange( $inout, $INOUT_MARK, 0, 0, $INOUT_SQUARE, $INOUT_SQUARE ) ScreenUpdating( True ) EndFunc ; --- GUI SETUP ----------------------------------------------------- Func LoadExample( ByRef $inout ) For $y = 0 To UBound( $inout, 2 ) - 1 Select Case $y = 0 GUICtrlSetData( $inout[0][$y], "4" ) GUICtrlSetData( $inout[1][$y], "7" ) ; GUICtrlSetData( $inout[2][$y], "9" ) ; GUICtrlSetData( $inout[3][$y], "6" ) ; GUICtrlSetData( $inout[4][$y], "8" ) ; GUICtrlSetData( $inout[5][$y], "3" ) ; GUICtrlSetData( $inout[6][$y], "1" ) ; GUICtrlSetData( $inout[7][$y], "2" ) ; GUICtrlSetData( $inout[8][$y], "5" ) Case $y = 1 ; GUICtrlSetData( $inout[0][$y], "1" ) GUICtrlSetData( $inout[1][$y], "6" ) ; GUICtrlSetData( $inout[2][$y], "5" ) GUICtrlSetData( $inout[3][$y], "7" ) ; GUICtrlSetData( $inout[4][$y], "2" ) ; GUICtrlSetData( $inout[5][$y], "9" ) ; GUICtrlSetData( $inout[6][$y], "3" ) GUICtrlSetData( $inout[7][$y], "8" ) GUICtrlSetData( $inout[8][$y], "4" ) Case $y = 2 ; GUICtrlSetData( $inout[0][$y], "2" ) GUICtrlSetData( $inout[1][$y], "3" ) GUICtrlSetData( $inout[2][$y], "8" ) GUICtrlSetData( $inout[3][$y], "5" ) ; GUICtrlSetData( $inout[4][$y], "4" ) ; GUICtrlSetData( $inout[5][$y], "1" ) GUICtrlSetData( $inout[6][$y], "9" ) GUICtrlSetData( $inout[7][$y], "7" ) GUICtrlSetData( $inout[8][$y], "6" ) Case $y = 3 GUICtrlSetData( $inout[0][$y], "5" ) ; GUICtrlSetData( $inout[1][$y], "9" ) GUICtrlSetData( $inout[2][$y], "3" ) ; GUICtrlSetData( $inout[3][$y], "4" ) GUICtrlSetData( $inout[4][$y], "6" ) ; GUICtrlSetData( $inout[5][$y], "2" ) GUICtrlSetData( $inout[6][$y], "7" ) ; GUICtrlSetData( $inout[7][$y], "1" ) ; GUICtrlSetData( $inout[8][$y], "8" ) Case $y = 4 GUICtrlSetData( $inout[0][$y], "7" ) ; GUICtrlSetData( $inout[1][$y], "2" ) GUICtrlSetData( $inout[2][$y], "6" ) ; GUICtrlSetData( $inout[3][$y], "8" ) ; GUICtrlSetData( $inout[4][$y], "1" ) ; GUICtrlSetData( $inout[5][$y], "5" ) GUICtrlSetData( $inout[6][$y], "4" ) ; GUICtrlSetData( $inout[7][$y], "3" ) GUICtrlSetData( $inout[8][$y], "9" ) Case $y = 5 ; GUICtrlSetData( $inout[0][$y], "8" ) ; GUICtrlSetData( $inout[1][$y], "4" ) ; GUICtrlSetData( $inout[2][$y], "1" ) ; GUICtrlSetData( $inout[3][$y], "3" ) GUICtrlSetData( $inout[4][$y], "9" ) ; GUICtrlSetData( $inout[5][$y], "7" ) GUICtrlSetData( $inout[6][$y], "5" ) ; GUICtrlSetData( $inout[7][$y], "6" ) GUICtrlSetData( $inout[8][$y], "2" ) Case $y = 6 GUICtrlSetData( $inout[0][$y], "6" ) ; GUICtrlSetData( $inout[1][$y], "5" ) GUICtrlSetData( $inout[2][$y], "4" ) ; GUICtrlSetData( $inout[3][$y], "1" ) GUICtrlSetData( $inout[4][$y], "3" ) GUICtrlSetData( $inout[5][$y], "8" ) GUICtrlSetData( $inout[6][$y], "2" ) GUICtrlSetData( $inout[7][$y], "9" ) ; GUICtrlSetData( $inout[8][$y], "7" ) Case $y = 7 GUICtrlSetData( $inout[0][$y], "3" ) GUICtrlSetData( $inout[1][$y], "8" ) ; GUICtrlSetData( $inout[2][$y], "2" ) ; GUICtrlSetData( $inout[3][$y], "9" ) ; GUICtrlSetData( $inout[4][$y], "7" ) GUICtrlSetData( $inout[5][$y], "4" ) ; GUICtrlSetData( $inout[6][$y], "6" ) GUICtrlSetData( $inout[7][$y], "5" ) ; GUICtrlSetData( $inout[8][$y], "1" ) Case $y = 8 ; GUICtrlSetData( $inout[0][$y], "9" ) ; GUICtrlSetData( $inout[1][$y], "1" ) ; GUICtrlSetData( $inout[2][$y], "7" ) ; GUICtrlSetData( $inout[3][$y], "2" ) ; GUICtrlSetData( $inout[4][$y], "5" ) ; GUICtrlSetData( $inout[5][$y], "6" ) ; GUICtrlSetData( $inout[6][$y], "8" ) GUICtrlSetData( $inout[7][$y], "4" ) GUICtrlSetData( $inout[8][$y], "3" ) EndSelect Next EndFunc Func ScreenUpdating( $enabled ) GUISetState( _Iif( $enabled, @SW_UNLOCK, @SW_LOCK ) ) EndFunc Func CreateInout() Dim $inout[$INOUT_SQUARE][$INOUT_SQUARE] ; Tab-order: left-to-right and top-to-bottom, both within groups and from group to group For $y_group = 0 To $INOUT_GROUP - 1 $y = $y_group * ( $INOUT_SQUARE / $INOUT_GROUP ) For $x_group = 0 To $INOUT_GROUP - 1 For $y = $y_group * ( $INOUT_SQUARE / $INOUT_GROUP ) To ( $y_group + 1 ) * ( $INOUT_SQUARE / $INOUT_GROUP ) - 1 For $x = $x_group * ( $INOUT_SQUARE / $INOUT_GROUP ) To ( $x_group + 1 ) * ( $INOUT_SQUARE / $INOUT_GROUP ) - 1 $inout[$x][$y] = GUICtrlCreateInput( "", $x + ( $x * $INOUT_WIDTH ) + Floor( $x / $INOUT_GROUP ), $y + ( $y * $INOUT_HEIGHT ) + Floor( $y / $INOUT_GROUP ), $INOUT_WIDTH, $INOUT_HEIGHT, $ES_CENTER + $ES_NUMBER, 0 ) GUICtrlSetFont( $inout[$x][$y], $INOUT_FONT_SIZE, $INOUT_FONT_WEIGHT, $INOUT_FONT_ATTR, $INOUT_FONT_NAME ) GUICtrlSetLimit( $inout[$x][$y], 1 ) Next Next Next Next Return $inout EndFunc ; --- MAIN ---------------------------------------------------------- Func Main() $win_w = $INOUT_SQUARE - $INOUT_GROUP + ( $INOUT_SQUARE * $INOUT_WIDTH ) + ( $INOUT_SQUARE / $INOUT_GROUP ) $win_h = $INOUT_SQUARE - $INOUT_GROUP + ( $INOUT_SQUARE * $INOUT_HEIGHT ) + ( $INOUT_SQUARE / $INOUT_GROUP ) + $BUTTON_HEIGHT $me = GUICreate( $APP_NAME & " v" & $APP_VERSION, $win_w, $win_h ) GUICtrlCreateGraphic( 0, 0, $win_w, $win_h - $BUTTON_HEIGHT, $SS_BLACKRECT ) Dim $ButtonSolve, $ButtonClear, $InputInout $ButtonSolve = GUICtrlCreateButton( "&Solve...", 0, $win_h - $BUTTON_HEIGHT, $win_w / 2, $BUTTON_HEIGHT ) $ButtonClear = GUICtrlCreateButton( "&Clear", $win_w / 2, $win_h - $BUTTON_HEIGHT, $win_w / 2, $BUTTON_HEIGHT ) $InputInout = CreateInout() LoadExample( $InputInout ) ; Preload a puzzle GUISetState( @SW_SHOW ) Dim $msg While 1 $msg = GUIGetMsg() Select Case $msg = $GUI_EVENT_CLOSE ExitLoop Case $msg = $ButtonSolve ButtonclickSolve( $InputInout ) Case $msg = $ButtonClear ButtonclickClear( $InputInout ) EndSelect WEnd EndFunc Main() Edited July 22, 2007 by hummakavula Link to comment Share on other sites More sharing options...
James Posted July 22, 2007 Share Posted July 22, 2007 Very nice there humma Try make it solve in realtime, so you dont need to keep pressing solve! Blog - Seriously epic web hosting - Twitter - GitHub - Cachet HQ Link to comment Share on other sites More sharing options...
hummakavula Posted July 22, 2007 Author Share Posted July 22, 2007 Very nice there humma Try make it solve in realtime, so you dont need to keep pressing solve!Well, okay... I was meaning to do it anyway... I've marked all lines with new/changed code: expandcollapse popup; SolveIteration ; - solves one iteration of the elimination-process ; Func SolveIteration( ByRef $matrix ) Dim $x, $y For $x = 0 To $INOUT_SQUARE - 1 EliminateRange( $matrix, $x, 0, $x + 1, $INOUT_SQUARE ) ; Eliminate Rows EliminateRange( $matrix, 0, $x, $INOUT_SQUARE, $x + 1 ) ; Eliminate Columns Next For $x = 0 To $INOUT_GROUP - 1 For $y = 0 To $INOUT_GROUP - 1 ; Validate Group EliminateRange( $matrix, $x * ( $INOUT_SQUARE / $INOUT_GROUP ), $y * ( $INOUT_SQUARE / $INOUT_GROUP ), ( $x + 1 ) * ( $INOUT_SQUARE / $INOUT_GROUP ), ( $y + 1 ) * ( $INOUT_SQUARE / $INOUT_GROUP ) ) Next Next Dim $known ; ---(01) $known = 0 ; ---(02) For $x = 0 To $INOUT_SQUARE - 1 For $y = 0 To $INOUT_SQUARE - 1 If $matrix[$x][$y][0] = 0 Then $tmp = 0 For $z = 1 To UBound( $matrix, 3 ) - 1 If ( $matrix[$x][$y][$z] = 1 ) Then $matrix[$x][$y][0] = _Iif( $tmp = 0, $z, 0 ) $tmp += 1 EndIf If ( $tmp > 1 ) Then ExitLoop Next EndIf If $matrix[$x][$y][0] > 0 Then $known += 1 ; ---(03) Next Next Return $known ; ---(04) EndFunc ; Solve ; - loop SolveIteration untill the puzzle is solved or algorithm falls short ; Func Solve( ByRef $matrix, ByRef $inout ) Dim $known, $lastknown ; ---(05) $known = 0 ; ---(06) $lastknown = -1 ; ---(07) While ( $known < $INOUT_SQUARE * $INOUT_SQUARE ) And ( $known > $lastknown ) ; ---(08) $lastknown = $known ; ---(09) $known = SolveIteration( $matrix ) ; ---(10) WEnd ; ---(11) SyncMatrix( $matrix, $inout, True ) EndFunc Link to comment Share on other sites More sharing options...
James Posted July 22, 2007 Share Posted July 22, 2007 (edited) I found a problem. If the puzzle you enter has more than one solution, it cannot do it.Take a look:Whoops, it is a diagonal sudoku, sorry Edited July 22, 2007 by NeoTroniX Blog - Seriously epic web hosting - Twitter - GitHub - Cachet HQ Link to comment Share on other sites More sharing options...
hummakavula Posted July 22, 2007 Author Share Posted July 22, 2007 (edited) I found a problem. If the puzzle you enter has more than one solution, it cannot do it.Take a look:Whoops, it is a diagonal sudoku, sorry LOL, I know for a fact that there are puzzles my script cannot solve...Since I'm not much a sudoku enthousiast my own 'sudoku-skills' are virtually non-existent.It was a little project I did for fun You're welcome to improve on it though.The validate/solve algorithm is separated into different levels -- hopefully -- corresponding to different levens of tackling the problem.These 'levels' range from a 'macroscopic view' (Validate, Solve, etc.) to a 'microscopic view' (EliminateRange, etc.).Also I designed the script to be somewhat multi functional.For example, both 'EliminateRange' and 'ValidateRange' handle rows, columns and groups (or quadrants).So it shouldn't be much of a problem to trick the program into handling more advanced puzzles.I think it'll be fairly easy to optimize or improve key steps like 'SolveIteration'. Edited July 22, 2007 by hummakavula Link to comment Share on other sites More sharing options...
hummakavula Posted July 22, 2007 Author Share Posted July 22, 2007 (edited) Update:I just discovered that the algorithm can produce invalid results if valid yet 'erroneous' input is entered.If you, for example, in case of the default puzzle (Screenshot), replace the "4" in the most upper-left cell with an "1" the generated solution will be invalid!Instead of improving the algorithm itself, I've added error-handling allowing for intervention by the user... the program will prompt the user with a warning, enabling him to opt-out of the solver screwing up the puzzle Also I've improved the versatility of 'SyncMatrix' -- now it always copies from left to right and it can handle both $matrix to $inout, $inout to $matrix, $inout to $inout and $matrix to $matrix (the latter options allow for easy implementation of 'history-functionality').expandcollapse popup; ; Easydoku v0.3-70722 ; ; Description: ; This program is a quick attempt at a ; basic validator/solver for sudoku puzzles. ; I'm not much of a sudoku-enthousiast, ; so there should be enough oppertinities to ; improve on this solver-algorithm. ; ; Change history: ; 0.1 ; - Initial release; ; 0.2 ; - 'Solve' now continues untill puzzle is ; solved or algorithm falls short; ; 0.3 ; - 'Solve' now validates puzzle both ; before and *after* the solving-algorithm has ; finshed because valid yet 'erroneous' ; input can result in invalid output; ; - Interface is locked until program has ; finished its task. ; ; --- LIBRARIES ----------------------------------------------------- #compiler_icon = chicken.ico #include <GUIConstants.au3> #include <Misc.au3> ; --- CONSTANTS ----------------------------------------------------- Const $APP_NAME = "Easydoku" ; program information Const $APP_VERSION = "0.3" Const $INOUT_SQUARE = 9 ; properties of puzzle Const $INOUT_GROUP = 3 Const $INOUT_WIDTH = 40 Const $INOUT_HEIGHT = 40 Const $INOUT_FONT_SIZE = 24 ; big friendly letters Const $INOUT_FONT_WEIGHT = 400 Const $INOUT_FONT_ATTR = 0 Const $INOUT_FONT_NAME = "Tahoma" Const $INOUT_MARK = 0xFFFFFF ; colors for marking conflicts Const $INOUT_MARK_CONFLICT_GROUP = 0xFF0000 Const $INOUT_MARK_CONFLICT_AXIS = 0xFF6000 Const $BUTTON_HEIGHT = 32 ; height of buttons ; --- VARIABLES ---------------------------------------------------- Dim $me Dim $ButtonSolve, $ButtonClear, $InputInout Dim $win_w, $win_h ; --- IMPLEMENTATION ------------------------------------------------ ; GetMatrix ; - return value at <x,y> in <matrix> ; - <matrix> can be either interface (2d) or matrix (3d) ; Func GetMatrix( $matrix, $x, $y ) If ( UBound( $matrix, 0 ) = 2 ) Then Dim $tmp $tmp = GUICtrlRead( $matrix[$x][$y] ) Return _Iif( StringIsInt( $tmp ), $tmp, 0 ) Else Return $matrix[$x][$y][0] EndIf EndFunc ; SetMatrix ; - write <value> to <x,y> in <matrix> ; - <matrix> can be either interface (2d) or matrix (3d) ; Func SetMatrix( ByRef $matrix, $x, $y, $value ) If ( UBound( $matrix, 0 ) = 2 ) Then GUICtrlSetData( $matrix[$x][$y], _Iif( $value = 0, "", $value ) ) Else $matrix[$x][$y][0] = $value EndIf EndFunc ; SyncMatrix ; - synchronize two matrices, both of which can be 2 or 3-dimensional, ; - 2-dimensional matrix acts as an interface between validator/solver and human input ; - 3-dimensional matrix is used internally by the validator/solver ; Func SyncMatrix( ByRef $matrix_in, ByRef $matrix_out ) Dim $x, $y, $tmp For $x = 0 To $INOUT_SQUARE - 1 For $y = 0 To $INOUT_SQUARE - 1 $tmp = GetMatrix( $matrix_in, $x, $y ) SetMatrix( $matrix_out, $x, $y, $tmp ) If ( UBound( $matrix_in, 0 ) = 2 ) And ( UBound( $matrix_out, 0 ) = 3 ) And ( $tmp = 0 ) Then For $z = 1 To UBound( $matrix_out, 3 ) - 1 $matrix_out[$x][$y][$z] = 1 Next EndIf Next Next EndFunc ; EliminateRange ; - <matrix[x][y][0]> holds 'known values' ; - <matrix[x][y][1 .. 9]> hold 'possible values' and are used by the eliminiation routine ; Func EliminateRange( ByRef $matrix, $x_min, $y_min, $x_max, $y_max ) Dim $eliminate[$INOUT_SQUARE + 1] Dim $x, $y, $z, $tmp ; from specified range collect known values $x = $x_min While ( $x < $x_max ) And ( $x < $INOUT_SQUARE ) $y = $y_min While ( $y < $y_max ) And ( $y < $INOUT_SQUARE ) $eliminate[$matrix[$x][$y][0]] = 1 $y += 1 Wend $x += 1 WEnd ; eliminate known values For $z = 1 To UBound( $eliminate ) - 1 $x = $x_min While ( $x < $x_max ) And ( $x < $INOUT_SQUARE ) $y = $y_min While ( $y < $y_max ) And ( $y < $INOUT_SQUARE ) If ( $eliminate[$z] = 1 ) Then $matrix[$x][$y][$z] = 0 $y += 1 Wend $x += 1 WEnd Next EndFunc ; MarkRange ; - <inout[x][y]> can be marked to indicate conflicting values ; Func MarkRange( ByRef $inout, $color, $x_min, $y_min, $x_max, $y_max ) $x = $x_min While ( $x < $x_max ) And ( $x < $INOUT_SQUARE ) $y = $y_min While ( $y < $y_max ) And ( $y < $INOUT_SQUARE ) GUICtrlSetBkColor( $inout[$x][$y], $color ) $y += 1 Wend $x += 1 WEnd EndFunc ; ValidateRange ; - verify whether all 'known values' within the speficied range are unique ; - marks conflicting entries if <matrix> is determined to be <inout> ; - returns <conflict> which is the number of conflicting values ; Func ValidateRange( ByRef $matrix, $x_min, $y_min, $x_max, $y_max ) Dim $count[$INOUT_SQUARE + 1] Dim $x, $y, $tmp Dim $is3d Dim $conflict $conflict = 0 $is3d = ( UBound( $matrix, 0 ) = 3 ) $x = $x_min While ( $x < $x_max ) And ( $x < $INOUT_SQUARE ) $y = $y_min While ( $y < $y_max ) And ( $y < $INOUT_SQUARE ) If ( $is3d ) Then $tmp = $matrix[$x][$y][0] Else $tmp = GUICtrlRead( $matrix[$x][$y] ) EndIf If ( $tmp > 0 ) Then $count[$tmp] += 1 If ( $count[$tmp] > 1 ) Then $conflict += 1 EndIf $y += 1 Wend $x += 1 WEnd If ( $conflict > 0 ) And Not ( $is3d ) Then MarkRange( $matrix, _IIf( ( $x_max - $x_min > 1 ) And ( $y_max - $y_min > 1 ), $INOUT_MARK_CONFLICT_GROUP, $INOUT_MARK_CONFLICT_AXIS ), $x_min, $y_min, $x_max, $y_max ) EndIf Return $conflict EndFunc ; SolveIteration ; - solves one iteration of the elimination-process ; Func SolveIteration( ByRef $matrix ) Dim $x, $y For $x = 0 To $INOUT_SQUARE - 1 EliminateRange( $matrix, $x, 0, $x + 1, $INOUT_SQUARE ) ; Eliminate Rows EliminateRange( $matrix, 0, $x, $INOUT_SQUARE, $x + 1 ) ; Eliminate Columns Next For $x = 0 To $INOUT_GROUP - 1 For $y = 0 To $INOUT_GROUP - 1 ; Validate Group EliminateRange( $matrix, $x * ( $INOUT_SQUARE / $INOUT_GROUP ), $y * ( $INOUT_SQUARE / $INOUT_GROUP ), ( $x + 1 ) * ( $INOUT_SQUARE / $INOUT_GROUP ), ( $y + 1 ) * ( $INOUT_SQUARE / $INOUT_GROUP ) ) Next Next Dim $known $known = 0 For $x = 0 To $INOUT_SQUARE - 1 For $y = 0 To $INOUT_SQUARE - 1 If ( $matrix[$x][$y][0] = 0 ) Then $tmp = 0 For $z = 1 To UBound( $matrix, 3 ) - 1 If ( $matrix[$x][$y][$z] = 1 ) Then $matrix[$x][$y][0] = _Iif( $tmp = 0, $z, 0 ) $tmp += 1 EndIf If ( $tmp > 1 ) Then ExitLoop Next EndIf If ( $matrix[$x][$y][0] > 0 ) Then $known += 1 Next Next Return $known EndFunc ; Solve ; - loop SolveIteration untill the puzzle is solved or algorithm falls short ; Func Solve( ByRef $matrix ) Dim $known, $lastknown $known = 0 $lastknown = -1 While ( $known < $INOUT_SQUARE * $INOUT_SQUARE ) And ( $known > $lastknown ) $lastknown = $known $known = SolveIteration( $matrix ) WEnd Return $known EndFunc ; Validate ; - loop ValidateRange untill entire puzzle is validated ; Func Validate( ByRef $matrix ) Dim $x, $y Dim $conflict $conflict = 0 For $x = 0 To $INOUT_SQUARE - 1 $conflict += ValidateRange( $matrix, $x, 0, $x + 1, $INOUT_SQUARE ) ; Validate Rows $conflict += ValidateRange( $matrix, 0, $x, $INOUT_SQUARE, $x + 1 ) ; Validate Columns Next For $x = 0 To $INOUT_GROUP - 1 For $y = 0 To $INOUT_GROUP - 1 ; Validate Group $conflict += ValidateRange( $matrix, $x * ( $INOUT_SQUARE / $INOUT_GROUP ), $y * ( $INOUT_SQUARE / $INOUT_GROUP ), ( $x + 1 ) * ( $INOUT_SQUARE / $INOUT_GROUP ), ( $y + 1 ) * ( $INOUT_SQUARE / $INOUT_GROUP ) ) Next Next Return $conflict EndFunc ; --- GUI EVENTS ---------------------------------------------------- Func ButtonclickSolve( Byref $inout ) EnableButtons( False ) ScreenUpdating( False ) MarkRange( $inout, $INOUT_MARK, 0, 0, $INOUT_SQUARE, $INOUT_SQUARE ) Dim $matrix[$INOUT_SQUARE][$INOUT_SQUARE][$INOUT_SQUARE + 1] Dim $conflict $conflict = Validate( $inout ) If ( $conflict = 0 ) Then SyncMatrix( $inout, $matrix ) Solve( $matrix ) $conflict = Validate( $matrix ) If ( $conflict > 0 ) Then If ( MsgBox( 0x2034, "Warning", "Solution is invalid! Discard?" ) = 7 ) Then $conflict = 0 EndIf If ( $conflict = 0 ) Then SyncMatrix( $matrix, $inout ) $conflict = Validate( $inout ) EndIf ScreenUpdating( True ) If ( $conflict > 0 ) Then MsgBox( 0x2030, "Error", "This puzzle contains atleast " & $conflict & " conflict" & _Iif( $conflict = 1, "", "s" ) & "!" & @CRLF & "Please resolve and try again..." ) EndIf EnableButtons( True ) EndFunc Func ButtonclickClear( ByRef $inout ) EnableButtons( False ) ScreenUpdating( False ) For $x = 0 To UBound( $inout ) - 1 For $y = 0 To UBound( $inout, 2 ) - 1 GUICtrlSetData( $inout[$x][$y], "" ) Next Next MarkRange( $inout, $INOUT_MARK, 0, 0, $INOUT_SQUARE, $INOUT_SQUARE ) ScreenUpdating( True ) EnableButtons( True ) EndFunc ; --- GUI SETUP ----------------------------------------------------- Func LoadExample( ByRef $inout ) For $y = 0 To UBound( $inout, 2 ) - 1 Select Case $y = 0 GUICtrlSetData( $inout[0][$y], "4" ) GUICtrlSetData( $inout[1][$y], "7" ) ; GUICtrlSetData( $inout[2][$y], "9" ) ; GUICtrlSetData( $inout[3][$y], "6" ) ; GUICtrlSetData( $inout[4][$y], "8" ) ; GUICtrlSetData( $inout[5][$y], "3" ) ; GUICtrlSetData( $inout[6][$y], "1" ) ; GUICtrlSetData( $inout[7][$y], "2" ) ; GUICtrlSetData( $inout[8][$y], "5" ) Case $y = 1 ; GUICtrlSetData( $inout[0][$y], "1" ) GUICtrlSetData( $inout[1][$y], "6" ) ; GUICtrlSetData( $inout[2][$y], "5" ) GUICtrlSetData( $inout[3][$y], "7" ) ; GUICtrlSetData( $inout[4][$y], "2" ) ; GUICtrlSetData( $inout[5][$y], "9" ) ; GUICtrlSetData( $inout[6][$y], "3" ) GUICtrlSetData( $inout[7][$y], "8" ) GUICtrlSetData( $inout[8][$y], "4" ) Case $y = 2 ; GUICtrlSetData( $inout[0][$y], "2" ) GUICtrlSetData( $inout[1][$y], "3" ) GUICtrlSetData( $inout[2][$y], "8" ) GUICtrlSetData( $inout[3][$y], "5" ) ; GUICtrlSetData( $inout[4][$y], "4" ) ; GUICtrlSetData( $inout[5][$y], "1" ) GUICtrlSetData( $inout[6][$y], "9" ) GUICtrlSetData( $inout[7][$y], "7" ) GUICtrlSetData( $inout[8][$y], "6" ) Case $y = 3 GUICtrlSetData( $inout[0][$y], "5" ) ; GUICtrlSetData( $inout[1][$y], "9" ) GUICtrlSetData( $inout[2][$y], "3" ) ; GUICtrlSetData( $inout[3][$y], "4" ) GUICtrlSetData( $inout[4][$y], "6" ) ; GUICtrlSetData( $inout[5][$y], "2" ) GUICtrlSetData( $inout[6][$y], "7" ) ; GUICtrlSetData( $inout[7][$y], "1" ) ; GUICtrlSetData( $inout[8][$y], "8" ) Case $y = 4 GUICtrlSetData( $inout[0][$y], "7" ) ; GUICtrlSetData( $inout[1][$y], "2" ) GUICtrlSetData( $inout[2][$y], "6" ) ; GUICtrlSetData( $inout[3][$y], "8" ) ; GUICtrlSetData( $inout[4][$y], "1" ) ; GUICtrlSetData( $inout[5][$y], "5" ) GUICtrlSetData( $inout[6][$y], "4" ) ; GUICtrlSetData( $inout[7][$y], "3" ) GUICtrlSetData( $inout[8][$y], "9" ) Case $y = 5 ; GUICtrlSetData( $inout[0][$y], "8" ) ; GUICtrlSetData( $inout[1][$y], "4" ) ; GUICtrlSetData( $inout[2][$y], "1" ) ; GUICtrlSetData( $inout[3][$y], "3" ) GUICtrlSetData( $inout[4][$y], "9" ) ; GUICtrlSetData( $inout[5][$y], "7" ) GUICtrlSetData( $inout[6][$y], "5" ) ; GUICtrlSetData( $inout[7][$y], "6" ) GUICtrlSetData( $inout[8][$y], "2" ) Case $y = 6 GUICtrlSetData( $inout[0][$y], "6" ) ; GUICtrlSetData( $inout[1][$y], "5" ) GUICtrlSetData( $inout[2][$y], "4" ) ; GUICtrlSetData( $inout[3][$y], "1" ) GUICtrlSetData( $inout[4][$y], "3" ) GUICtrlSetData( $inout[5][$y], "8" ) GUICtrlSetData( $inout[6][$y], "2" ) GUICtrlSetData( $inout[7][$y], "9" ) ; GUICtrlSetData( $inout[8][$y], "7" ) Case $y = 7 GUICtrlSetData( $inout[0][$y], "3" ) GUICtrlSetData( $inout[1][$y], "8" ) ; GUICtrlSetData( $inout[2][$y], "2" ) ; GUICtrlSetData( $inout[3][$y], "9" ) ; GUICtrlSetData( $inout[4][$y], "7" ) GUICtrlSetData( $inout[5][$y], "4" ) ; GUICtrlSetData( $inout[6][$y], "6" ) GUICtrlSetData( $inout[7][$y], "5" ) ; GUICtrlSetData( $inout[8][$y], "1" ) Case $y = 8 ; GUICtrlSetData( $inout[0][$y], "9" ) ; GUICtrlSetData( $inout[1][$y], "1" ) ; GUICtrlSetData( $inout[2][$y], "7" ) ; GUICtrlSetData( $inout[3][$y], "2" ) ; GUICtrlSetData( $inout[4][$y], "5" ) ; GUICtrlSetData( $inout[5][$y], "6" ) ; GUICtrlSetData( $inout[6][$y], "8" ) GUICtrlSetData( $inout[7][$y], "4" ) GUICtrlSetData( $inout[8][$y], "3" ) EndSelect Next EndFunc Func EnableButtons( $enabled ) Dim $state $state = _Iif( $enabled, $GUI_ENABLE, $GUI_DISABLE ) GUICtrlSetState( $ButtonSolve, $state ) GUICtrlSetState( $ButtonClear, $state ) EndFunc Func ScreenUpdating( $enabled ) GUISetState( _Iif( $enabled, @SW_UNLOCK, @SW_LOCK ) ) EndFunc Func CreateInout() Dim $inout[$INOUT_SQUARE][$INOUT_SQUARE] ; Tab-order: left-to-right and top-to-bottom, both within groups and from group to group For $y_group = 0 To $INOUT_GROUP - 1 $y = $y_group * ( $INOUT_SQUARE / $INOUT_GROUP ) For $x_group = 0 To $INOUT_GROUP - 1 For $y = $y_group * ( $INOUT_SQUARE / $INOUT_GROUP ) To ( $y_group + 1 ) * ( $INOUT_SQUARE / $INOUT_GROUP ) - 1 For $x = $x_group * ( $INOUT_SQUARE / $INOUT_GROUP ) To ( $x_group + 1 ) * ( $INOUT_SQUARE / $INOUT_GROUP ) - 1 $inout[$x][$y] = GUICtrlCreateInput( "", $x + ( $x * $INOUT_WIDTH ) + Floor( $x / $INOUT_GROUP ), $y + ( $y * $INOUT_HEIGHT ) + Floor( $y / $INOUT_GROUP ), $INOUT_WIDTH, $INOUT_HEIGHT, $ES_CENTER + $ES_NUMBER, 0 ) GUICtrlSetFont( $inout[$x][$y], $INOUT_FONT_SIZE, $INOUT_FONT_WEIGHT, $INOUT_FONT_ATTR, $INOUT_FONT_NAME ) GUICtrlSetLimit( $inout[$x][$y], 1 ) Next Next Next Next Return $inout EndFunc ; --- MAIN ---------------------------------------------------------- Func Main() $win_w = $INOUT_SQUARE - $INOUT_GROUP + ( $INOUT_SQUARE * $INOUT_WIDTH ) + ( $INOUT_SQUARE / $INOUT_GROUP ) $win_h = $INOUT_SQUARE - $INOUT_GROUP + ( $INOUT_SQUARE * $INOUT_HEIGHT ) + ( $INOUT_SQUARE / $INOUT_GROUP ) + $BUTTON_HEIGHT $me = GUICreate( $APP_NAME & " v" & $APP_VERSION, $win_w, $win_h ) GUICtrlCreateGraphic( 0, 0, $win_w, $win_h - $BUTTON_HEIGHT, $SS_BLACKRECT ) $ButtonSolve = GUICtrlCreateButton( "&Solve...", 0, $win_h - $BUTTON_HEIGHT, $win_w / 2, $BUTTON_HEIGHT ) $ButtonClear = GUICtrlCreateButton( "&Clear", $win_w / 2, $win_h - $BUTTON_HEIGHT, $win_w / 2, $BUTTON_HEIGHT ) $InputInout = CreateInout() LoadExample( $InputInout ) ; Preload a puzzle GUISetState( @SW_SHOW ) Dim $msg While 1 $msg = GUIGetMsg() Select Case $msg = $GUI_EVENT_CLOSE ExitLoop Case $msg = $ButtonSolve ButtonclickSolve( $InputInout ) Case $msg = $ButtonClear ButtonclickClear( $InputInout ) EndSelect WEnd EndFunc Main() Edited July 22, 2007 by hummakavula Link to comment Share on other sites More sharing options...
Recommended Posts
Create an account or sign in to comment
You need to be a member in order to leave a comment
Create an account
Sign up for a new account in our community. It's easy!
Register a new accountSign in
Already have an account? Sign in here.
Sign In Now