Un reto dificilillo...
Function SolveSudoku_raul338(s() As Byte) As Byte()
Se introduce una matriz bidimensional de 9x9. Los huecos serán "0"
Info
http://es.wikipedia.org/wiki/Sudoku
Vale todo, el más rápido gana.
DoEvents! :P
Sin datos de entrada?, es decir que puedo rellenarlo de cualquier forma (respetando las reglas del sudoku) ? Salu2 !
@Tenient101
Desgraciadamente si...
Por otro lado se me ocurre usar el metodo BackTracking para esto ya que trae de por medio incertidumbre este reto.
Dulces Lunas!¡.
No, claro que hay datos de entrada.
Entra una matriz así:
(http://upload.wikimedia.org/wikipedia/commons/thumb/1/13/Sudoku-by-L2G-20050714.gif/300px-Sudoku-by-L2G-20050714.gif)
Los huecos serán 0 en la matriz de entrada.
Y deberá retornar la matriz que corresponda a la solución.
@BlackZero
¿BackTracking? ¿Puedes explicar qué es? :huh:
DoEvents! :P
:http://es.wikipedia.org/wiki/Vuelta_Atr%C3%A1s#Backtracking_para_la_enumeraci.C3.B3n
Jeje para mi que Black, nos enseñas a mi y a psyke backtracking, q aca en el foro nadie me pudo enseñar hasta ahora xD
@Shell
Ok, gracias, ya entendí.
Un ej:
http://sudoku.friko.net/es/
DoEvents! :P
Hay que comprobar que los datos suministrados sean correctos? Es decir... que el sudoku sea resoluble?
@Karcrack
Me parece obvio que si.
Por mi parte tomando esto ultimo que dijo karcrack me parece que el prototipo deberia retornar un dato booleano... o algo que nos indique que el proceso se a completado correctamente ya que puedo meter numeros es las coordenadas respectivas sin respetar las reglas del sudoku.
Edito...
P.D.: Psyke1 desde cuando te tengo en el FaceBook!¡... hace mucho que no entro y apenas me di cuenta xD. madre me acabo de dar cuenta que tambien tengo a Raul338 O.o, yo ni me entero xP.
Dulces Lunas!¡.
yo termine mi sudoku ;D
me tarde mas en hacer lo grafico del programa que el algoritmo :P
lo e probado dos veces y me ah funcionado aunque tengo una espinita por ahi :P noce prueben y avisen ;D
(http://img535.imageshack.us/img535/2280/sudoe.png)
dejo las funciones con lo que estaba probando y como lo hice ;D
download sudoku:
http://www.mediafire.com/?n5zw3k7vp1smglq
@Raul100 : No se supone que se deben rellenar los 0's ?
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
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 (http://www.sudoku.name/rules/es).
Ésto tendrá que confirmarlo el autor del reto, si se respetan las reglas o no.
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.
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!¡.
La quinta regla de MadPitbull no siempre se cumple, ya que depende de la matriz de entrada :)
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 (http://www.sudoku.name/rules/es).
É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
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"
habra que pensarlo bien :silbar:
@BlackZeroX▓▓▒▒░░
en tu ejemplo de salida hay numeros que se repiten en la misma region...
Salu2
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
En el primer cuadrante :P
5 3 1
6 2 4
3 9 6
En el cuadrante superior derecho se repiten los 8 :P
:-\ aun no e encontrado adonde esta el error si existe ya me estoy quedando ciego :P lo que si me di cuenta es
que BlackZeroX escribio mal el sudoku :P
5 3 1
6 2 4
3 9 6
el 6 es en la imagen 8 quiza eso debe ser la razon porque quiza algunos de nosotros lo resolvimos y no nos dio el mismo resultado :P
EDIT:
lo e comprobado el resultado de BlackZeroX con el programa que publique :xD
y me salio correcto ;D ( o mi programa tambien esta malo :xD )
me di cuenta tambien que hay otro valor mal escrito:
(inicial, esquina superior derecha):
0 0 0
0 0 0
0 1 0
el resultado al parecer es correcto lo que paso es que BlackZeroX escribio mal los valores osea que ese
es otro resultado de otro juego de sudoku :P
quien corrobora? :P
el metio los valores así
bSudoku(2, 2) = 6
bSudoku(2, 7) = 1
Y aunque fuera de otro sudoku las reglas se aplican...
Salu2!
:rolleyes:
si pero eso que quiere decir? lo que veo yo es que escribio otro problema de sudoku no que el codigo da un resultado incorrecto :P
bueno ya no desviare el tema :P creo que esta claro :P
JAJAJA pense que nadie lo hiba a notar xP... ya lo corrijo.
Dulces Lunas!¡.
.
Optimise varias cosas...
[opcional]
El siguiente codigo requiere de un form con varios textbox llamados txtCell (matrix de controles) y un boton llamado cmdSolve, pongo en descarga el archivo para bajar.
[/opcional]
'
' /////////////////////////////////////////////////////////////
' // Autor: BlackZeroX ( Ortega Avila Miguel Angel ) //
' // //
' // Web: http://InfrAngeluX.Sytes.Net/ //
' // //
' // |-> Pueden Distribuir Este codigo siempre y cuando //
' // no se eliminen los creditos originales de este codigo //
' // No importando que sea modificado/editado o engrandecido //
' // o achicado, si es en base a este codigo //
' /////////////////////////////////////////////////////////////
Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Dim bSudoku(8, 8) As Byte ' // (nColumnas, nFilas)
'Private Sub cmdSolve_Click()
' fillSudoku bSudoku
' Caption = solveSudoku(bSudoku, 0, 0) ' // Por BackTracking
' showSudoku bSudoku
'End Sub
Private Sub Form_Load()
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 "Matrix inicial."
showSudoku bSudoku
If solveSudoku(bSudoku, 0, 0) Then
Debug.Print "Sudoku Resuelto"
showSudoku bSudoku
Else
Debug.Print "No se puede resolver, revisa la matrix."
End If
End Sub
Public Sub showSudoku(ByRef bArray() As Byte)
Dim i As Integer
Dim j As Integer
Show
For i = 0 To UBound(bArray, 1) ' // Fila
For j = 0 To UBound(bArray, 2) ' // Columa
'txtCell((i * 9) + j).Text = bArray(j, i)
If (((j + &H1) Mod &H3) = &H0) Then
Debug.Print bArray(j, i); "|";
Else
Debug.Print bArray(j, i);
End If
Next
Debug.Print
If (((i + &H1) Mod &H3) = &H0) Then Debug.Print String(32, "-")
Next
End Sub
'Public Sub fillSudoku(ByRef bArray() As Byte)
'Dim i As Integer
'Dim j As Integer
' Show
' For i = 0 To UBound(bArray, 1) ' // Fila
' For j = 0 To UBound(bArray, 2) ' // Columa
' bArray(j, i) = txtCell((i * 9) + j).Text
' Next
' Next
'End Sub
Public Function chkRow(ByRef bArray() As Byte, ByVal lIndex As Long, ByVal lVal As Long) As Boolean
' // Revisa la existencia de lVal en una Fila (lIndex).
Dim i As Long
Do While (i < 8) And (chkRow = False)
If (bArray(i, lIndex) = lVal) Then chkRow = True
i = (i + &H1)
Loop
End Function
Public Function chkCol(ByRef bArray() As Byte, ByVal lIndex As Long, ByVal lVal As Long) As Boolean
' // Revisa la existencia de lVal en una Columna (lIndex).
Dim i As Long
Do While (i < 8) And (chkCol = False)
If (bArray(lIndex, i) = lVal) Then chkCol = True
i = (i + &H1)
Loop
End Function
Public Function chkRect(ByRef bArray() As Byte, ByVal lCol As Long, ByVal lRow As Long, ByVal lVal As Long) As Boolean
' // Revisa la existencia de lVal en el cuadrante desde la celda superior izquierda respectiva dados por (lCol, lRow).
Dim i As Long
Dim j As Long
' // Obtenemos los indices de la celda superior izquierda del cuadrante inicial respectivo.
lRow = ((lRow \ 3) * 3)
lCol = ((lCol \ 3) * 3)
Do ' // Filas
j = &H0
Do ' // Columnas
If (bArray(lCol + j, lRow + i) = lVal) Then chkRect = True
j = (j + &H1)
Loop While (j < &H3) And (chkRect = False)
i = (i + &H1)
Loop While (i < &H3) And (chkRect = False)
End Function
Public Function solveSudoku(ByRef bArray() As Byte, ByVal lCol As Long, ByVal lRow As Long) As Boolean
' // Resuelve una Matrix de Sudoku de 9x9 celdas.
' // Si se retorna true, entonces la matrix ya esta Completa y/o Resuelta.
Dim lVal As Long
Dim i As Long
' // Termino de filas.
If (lRow >= 9) Then solveSudoku = True: Exit Function
' // Nos posicionamos en la 1ra celda de lRow vacia (con valor 0).
Do While Not (bArray(lCol, lRow) = &H0) And (solveSudoku = False)
lCol = (lCol + &H1)
If (lCol = &H9) Then
lCol = &H0
lRow = (lRow + &H1)
If (lRow >= &H8) Then solveSudoku = True
End If
Loop
' // Recorremos TODOS LOS VALORES desde 1 a 9 para la celda (lCol, lRow).
For lVal = 1 To 9
If Not chkRect(bArray, lCol, lRow, lVal) Then ' // Cuadro de 3x3.
If Not (chkRow(bArray, lRow, lVal)) Then ' // Fila.
If Not (chkCol(bArray, lCol, lVal)) Then ' // Columnas.
bArray(lCol, lRow) = lVal
If (lCol < 8) Then ' // Aun no llegamos al final de la fila?
solveSudoku = solveSudoku(bArray, (lCol + 1), lRow)
Else ' // Iniciamos otra llamada si mismo pero en la siguiente fila
solveSudoku = solveSudoku(bArray, 0, (lRow + 1))
End If
If Not solveSudoku Then bArray(lCol, lRow) = 0 ' // Seteamos la celda a 0 para realizar el BackTracking.
End If
End If
End If
Next
End Function
output:
Matrix inicial.
5 6 0 | 8 4 7 | 0 0 0 |
3 0 9 | 0 0 0 | 6 0 0 |
0 0 6 | 0 0 0 | 0 0 0 |
--------------------------------
0 1 0 | 0 8 0 | 0 4 0 |
7 9 0 | 6 0 2 | 0 1 8 |
0 5 0 | 0 3 0 | 0 9 0 |
--------------------------------
0 0 0 | 0 0 0 | 2 0 0 |
0 0 1 | 0 0 0 | 8 0 7 |
0 0 0 | 3 1 6 | 0 5 9 |
--------------------------------
No se puede resolver, revisa la matrix.
con la matrix:
bSudoku(5, 0) = 5
bSudoku(6, 0) = 2
bSudoku(1, 1) = 6
bSudoku(2, 1) = 5
bSudoku(4, 1) = 3
bSudoku(0, 2) = 9
bSudoku(1, 2) = 3
bSudoku(5, 2) = 1
bSudoku(1, 3) = 9
bSudoku(3, 3) = 4
bSudoku(4, 3) = 6
bSudoku(5, 3) = 3
bSudoku(8, 4) = 8
bSudoku(1, 5) = 7
bSudoku(3, 5) = 8
bSudoku(6, 5) = 6
bSudoku(1, 6) = 8
bSudoku(3, 6) = 1
bSudoku(7, 6) = 3
bSudoku(8, 6) = 2
bSudoku(4, 7) = 8
bSudoku(8, 7) = 4
bSudoku(0, 8) = 5
bSudoku(4, 8) = 9
Output:
Matrix inicial.
0 0 0 | 0 0 5 | 2 0 0 |
0 6 5 | 0 3 0 | 0 0 0 |
9 3 0 | 0 0 1 | 0 0 0 |
--------------------------------
0 9 0 | 4 6 3 | 0 0 0 |
0 0 0 | 0 0 0 | 0 0 8 |
0 7 0 | 8 0 0 | 6 0 0 |
--------------------------------
0 8 0 | 1 0 0 | 0 3 2 |
0 0 0 | 0 8 0 | 0 0 4 |
5 0 0 | 0 9 0 | 0 0 0 |
--------------------------------
Sudoku Resuelto
1 4 8 | 6 7 5 | 2 9 3 |
2 6 5 | 9 3 8 | 4 1 7 |
9 3 7 | 2 4 1 | 8 5 6 |
--------------------------------
8 9 2 | 4 6 3 | 1 7 5 |
4 5 6 | 7 1 9 | 3 2 8 |
3 7 1 | 8 5 2 | 6 4 9 |
--------------------------------
6 8 9 | 1 2 7 | 5 3 2 |
7 1 3 | 5 8 4 | 9 6 4 |
5 2 4 | 3 9 6 | 7 8 1 |
--------------------------------
Temibles Lunas!¡.
Matrix inicial.
0 0 0 | 0 0 5 | 2 0 0 |
0 6 5 | 0 3 0 | 0 0 0 |
9 3 0 | 0 0 1 | 0 0 0 |
--------------------------------
0 9 0 | 4 6 3 | 0 0 0 |
0 0 0 | 0 0 0 | 0 0 8 |
0 7 0 | 8 0 0 | 6 0 0 |
--------------------------------
0 8 0 | 1 0 0 | 0 3 2 |
0 0 0 | 0 8 0 | 0 0 4 |
5 0 0 | 0 9 0 | 0 0 0 |
--------------------------------
Sudoku Resuelto
1 4 8 | 6 7 5 | 2 9 3 |
2 6 5 | 9 3 8 | 4 1 7 |
9 3 7 | 2 4 1 | 8 5 6 |
--------------------------------
8 9 2 | 4 6 3 | 1 7 5 |
4 5 6 | 7 1 9 | 3 2 8 |
3 7 1 | 8 5 2 | 6 4 9 |
--------------------------------
6 8 9 | 1 2 7 | 5 3 2 |
7 1 3 | 5 8 4 | 9 6 4 |
5 2 4 | 3 9 6 | 7 8 1 |
--------------------------------
saludos.