[RETO] Sudoku

Iniciado por Psyke1, 21 Septiembre 2011, 20:50 PM

0 Miembros y 1 Visitante están viendo este tema.

Sanlegas

@Raul100 : No se supone que se deben rellenar los 0's ?

x64core

HAHAHAHA  :laugh: :xD
no puede ser... :xD parece que entendi mal el reto :P
yo hice el programa de sudoku :xD

ya decia yo que me tome toda la paciencia del mundo para hacer y no habia visto ningun codigo :xD eso es mas dificil creo bueno al menos ya tengo un parte y ahi queda el sources :xD

madpitbull_99

Las reglas del Sudoku:

Regla 1: hay que completar las casillas vacías con un solo número del 1 al 9.

Regla 2: en una misma fila no puede haber números repetidos.

Regla 3: en una misma columna no puede haber números repetidos.

Regla 4: en una misma región no puede haber números repetidos.

Regla 5: la solución de un sudoku es única.


Reglas explicadas con imágenes.

Ésto tendrá que confirmarlo el autor del reto, si se respetan las reglas o no.



«Si quieres la paz prepárate para la guerra» Flavius Vegetius


[Taller]Instalación/Configuración y Teoría de Servicios en Red

BlackZeroX

#13
ya que me estoy desvelando lo hize... como ven uso el metodo Recursivo para implementar el BackTracking.

* me falta optimizar algunos aspectos... no les dire donde para que no me roben xP.

Código (Vb) [Seleccionar]


Option Explicit

Private Sub Form_Load()
Dim bSudoku(8, 8)   As Byte '   //  (nFilas, nColumnas)
    bSudoku(0, 0) = 5
    bSudoku(0, 1) = 3
    bSudoku(0, 4) = 7
   
    bSudoku(1, 0) = 6
    bSudoku(1, 3) = 1
    bSudoku(1, 4) = 9
    bSudoku(1, 5) = 5
   
    bSudoku(2, 1) = 9
    bSudoku(2, 2) = 6
    bSudoku(2, 7) = 1
   
    bSudoku(3, 0) = 8
    bSudoku(3, 4) = 6
    bSudoku(3, 8) = 3
   
    bSudoku(4, 0) = 4
    bSudoku(4, 3) = 8
    bSudoku(4, 5) = 3
    bSudoku(4, 8) = 1
   
    bSudoku(5, 0) = 7
    bSudoku(5, 4) = 2
    bSudoku(5, 8) = 6
   
    bSudoku(6, 1) = 6
    bSudoku(6, 6) = 2
    bSudoku(6, 7) = 8
   
    bSudoku(7, 3) = 4
    bSudoku(7, 4) = 1
    bSudoku(7, 5) = 9
    bSudoku(7, 8) = 5
   
    bSudoku(8, 4) = 8
    bSudoku(8, 7) = 7
    bSudoku(8, 8) = 9
   
    Debug.Print "Inicial"
    showSudoku bSudoku
   
    MsgBox solveSudoku(bSudoku, 0, 0)  '   //  Por BackTracking
   
    Debug.Print "Resuelto"
    showSudoku bSudoku
   
End Sub

Public Sub showSudoku(ByRef bArray() As Byte)
Dim i As Integer
Dim j As Integer
    For i = 0 To UBound(bArray, 1)
        For j = 0 To UBound(bArray, 2)
            Debug.Print bArray(i, j);
        Next
        Debug.Print
    Next
    Debug.Print
    Debug.Print
End Sub

Public Function solveSudoku(ByRef bArray() As Byte, ByVal iRow As Long, ByVal iCol As Long) As Boolean
'   //  Me falta optimizar el proceso... Version 1.0.
Dim lVal        As Long
Dim i           As Long
    If (iRow >= 9) Then
        solveSudoku = True
        Exit Function
    End If
    Do While Not (bArray(iRow, iCol) = &H0)    '   //  Nos posicionamos en la 1ra celda de iRow vacia (con valor 0).
        iCol = (iCol + &H1)
        If (iCol = 9) Then
            iCol = &H0
            iRow = (iRow + &H1)
            If (iRow >= &H9) Then
                solveSudoku = True
                Exit Function
            End If
        End If
    Loop
    For lVal = 1 To 9                           '   //  Buscamos un valor valido para la celda...
        For i = 0 To 8                          '   //  Verificamos cada celda de la columna iCol.
            If (bArray(i, iCol) = lVal) Then
                i = (-1)
                Exit For
            End If
        Next
        If Not (i = (-1)) Then
            For i = 0 To 8                      '   //  Verificamos cada celda de la Fila iRow.
                If (bArray(iRow, i) = lVal) Then
                    i = (-1)
                    Exit For
                End If
            Next
            If Not (i = (-1)) Then
                bArray(iRow, iCol) = lVal       '   //  Seteamos su valor.
                If (iCol < 8) Then              '   //  Avazamos a la siguiente celda a resolver.
                    solveSudoku = solveSudoku(bArray, iRow, iCol + 1)
                    If Not solveSudoku Then
                        bArray(iRow, iCol) = 0  '   //  Error entonces volvemos atras.
                    End If
                Else
                    solveSudoku = solveSudoku(bArray, iRow + 1, 0)
                    If Not solveSudoku(bArray, iRow + 1, 0) Then
                        bArray(iRow, iCol) = 0  '   //  Error entonces volvemos atras.
                    End If
                End If
            End If
        End If
    Next
       
End Function



output:



Inicial
5  3  0  0  7  0  0  0  0
6  0  0  1  9  5  0  0  0
0  9  6  0  0  0  0  1  0
8  0  0  0  6  0  0  0  3
4  0  0  8  0  3  0  0  1
7  0  0  0  2  0  0  0  6
0  6  0  0  0  0  2  8  0
0  0  0  4  1  9  0  0  5
0  0  0  0  8  0  0  7  9


Resuelto
5  3  1  2  7  6  4  9  8
6  2  4  1  9  5  8  3  7
3  9  6  5  4  8  7  1  2
8  5  2  9  6  7  1  4  3
4  7  9  8  5  3  6  2  1
7  1  8  3  2  4  9  5  6
9  6  5  7  3  1  2  8  4
2  8  7  4  1  9  3  6  5
1  4  3  6  8  2  5  7  9



Temibles Lunas!¡.
The Dark Shadow is my passion.

raul338

La quinta regla de MadPitbull no siempre se cumple, ya que depende de la matriz de entrada :)

Psyke1

Cita de: madpitbull_99 en 23 Septiembre 2011, 09:27 AM
Las reglas del Sudoku:

Regla 1: hay que completar las casillas vacías con un solo número del 1 al 9.

Regla 2: en una misma fila no puede haber números repetidos.

Regla 3: en una misma columna no puede haber números repetidos.

Regla 4: en una misma región no puede haber números repetidos.

Regla 5: la solución de un sudoku es única.


Reglas explicadas con imágenes.

Ésto tendrá que confirmarlo el autor del reto, si se respetan las reglas o no.
Éso es madpitbull_99, pero como dice raul a veces hay más de una solución válida, a mí me a pasado.
http://es.answers.yahoo.com/question/index?qid=20110327233520AA7q9QG

@BlackZero: Precioso el código, voy a analizarlo. :D

DoEvents! :P

x64core

#16
a mi me da otra respuesta :p osea que tiene varias formas de resolverse el sudoku :P

PD por cierto BlackZeroX felicidades ;D
e visto mas o menos algunos otros codigos y al parecer el tuyo es el mas "pequeño"

Sanlegas

habra que pensarlo bien  :silbar:

@BlackZeroX▓▓▒▒░░
en tu ejemplo de salida hay numeros que se repiten en la misma region...


Salu2

x64core

Cita de: Tenient101 en 24 Septiembre 2011, 05:06 AM
habra que pensarlo bien  :silbar:

@BlackZeroX▓▓▒▒░░
en tu ejemplo de salida hay numeros que se repiten en la misma region...


Salu2

no entiendo a que te refieres :P en el ejemplo este:

Citar
Inicial
5  3  0  0  7  0  0  0  0
6  0  0  1  9  5  0  0  0
0  9  6  0  0  0  0  1  0
8  0  0  0  6  0  0  0  3
4  0  0  8  0  3  0  0  1
7  0  0  0  2  0  0  0  6
0  6  0  0  0  0  2  8  0
0  0  0  4  1  9  0  0  5
0  0  0  0  8  0  0  7  9


Resuelto
5  3  1  2  7  6  4  9  8
6  2  4  1  9  5  8  3  7
3  9  6  5  4  8  7  1  2
8  5  2  9  6  7  1  4  3
4  7  9  8  5  3  6  2  1
7  1  8  3  2  4  9  5  6
9  6  5  7  3  1  2  8  4
2  8  7  4  1  9  3  6  5
1  4  3  6  8  2  5  7  9


ese ejemplo esta resuelto correctamente no veo adonde esta el error, use el buscador de palabras del navegador

raul338

En el primer cuadrante :P

5  3  1
6  2  4
3  9  6

En el cuadrante superior derecho se repiten los 8 :P