Jump to content

Sudoku validator/solver with GUI


Recommended Posts

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:

;
; 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 by hummakavula
Link to comment
Share on other sites

Very nice there humma :whistle: 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:

; 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

I found a problem. If the puzzle you enter has more than one solution, it cannot do it.

Take a look:

Posted Image

Whoops, it is a diagonal sudoku, sorry :whistle:

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 :lmao:

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 by hummakavula
Link to comment
Share on other sites

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 :thumbsup:

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').

;
; 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 by hummakavula
Link to comment
Share on other sites

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 account

Sign in

Already have an account? Sign in here.

Sign In Now
 Share

  • Recently Browsing   0 members

    • No registered users viewing this page.
×
×
  • Create New...