Título: [Código] Mostrando los Candidatos de un Sudoku
Publicado por: yovaninu en 4 Noviembre 2011, 03:19 am
Siempre que me he puesto a resolver algun sudoku mi primer problema era obtener los candidatos para cada celda vacia, luego de un largo quebradero de cabeza los hallaba pero cabia la posibilidad de caer en errores, algunos sudoku on-line te permitian ver todos los candidatos de una celda pero para sus propios sudokus, en mi caso mis sudokus son de mi telefono movil y alli no tengo tal opcion, de manera que me puse a codear en VB y he aqui este pequeño código que obtiene los candidatos para las celdas de un sudoku correctamente propuesto. Lo he hecho en el control MSHFlexGrid por lo que se debe agregar en los componentes para que el programa pueda ejecutar correctamente. Es evidente que el programa NO RESUELVE un sudoku, lo cual me parece bien, pues para resolverlo, cada uno debe poder hacerlo y asi ejercitarse, ademas que terminarlo es bastante gratificante, aunque debe serlo tambien realizar un code que haga que el propio ordenador lo haga por nosotros. En fin gusto de cada uno, en mi caso prefiero resolverlo manualmente. Bueno, sin mas, aquí el código para quien le sirva: Option Explicit '9 filas x 9 columnas Dim Sud(1 To 9, 1 To 9) As Byte
Private Sub CMDLLenar_Click()
Dim f As Byte Dim c As Byte
'cargamos el SUDOKU con sus valores originales FIJOS Sud(1, 2) = 9 Sud(1, 4) = 6 Sud(1, 6) = 5
Sud(2, 7) = 8 Sud(2, 9) = 1
Sud(3, 1) = 2 Sud(3, 5) = 3 Sud(3, 8) = 6
Sud(4, 1) = 3 Sud(4, 2) = 8 Sud(4, 5) = 9
Sud(6, 5) = 1 Sud(6, 8) = 2 Sud(6, 9) = 7
Sud(7, 2) = 1 Sud(7, 5) = 8 Sud(7, 9) = 9
Sud(8, 1) = 6 Sud(8, 3) = 4
Sud(9, 4) = 2 Sud(9, 6) = 7 Sud(9, 8) = 5
'visualizamos el array en el Hierarchical For c = 1 To 9 For f = 1 To 9 If Sud(f, c) <> 0 Then Colocar f, c, Sud(f, c) End If Next Next
'coloreamos de rojo los numeros fijos para diferenciarlos de los candidatos Dim fila1 As Integer Dim columna1 As Integer With H1 ' Recorre las filas For fila1 = 0 To 8 For columna1 = 0 To 8 .Row = fila1 .Col = columna1 If Val(.Text) > 0 Then .CellForeColor = &HFF& 'rojooo End If Next Next 'coloreamos algunas regiones para diferenciar For fila1 = 0 To 2 For columna1 = 0 To 2 .Row = fila1 .Col = columna1 .CellBackColor = RGB(127, 220, 98) Next Next
For fila1 = 3 To 5 For columna1 = 3 To 5 .Row = fila1 .Col = columna1 .CellBackColor = RGB(127, 123, 208) Next Next
For fila1 = 6 To 8 For columna1 = 6 To 8 .Row = fila1 .Col = columna1 .CellBackColor = RGB(247, 123, 198) Next Next
For fila1 = 0 To 2 For columna1 = 6 To 8 .Row = fila1 .Col = columna1 .CellBackColor = RGB(247, 220, 198) Next Next
For fila1 = 6 To 8 For columna1 = 0 To 2 .Row = fila1 .Col = columna1 .CellBackColor = RGB(47, 220, 198) Next Next
End With
End Sub
Private Sub Command1_Click()
'///////////// Iniciamos a visualizar los candidatos ///////////
Dim Candidatos As Byte
Dim Casas As Byte '9 regiones o casas
For Casas = 1 To 9 'buscaremos los candidatos en las 9 casas o regiones For Candidatos = 1 To 9 BuscarCandidatos Casas, Candidatos 'buscamos los candidatos posibles en las 9 casas Next Next
End Sub 'Funcion que busca un valor en la fila indicada Private Function BuscarFila(Fila As Byte, ValorBuscado As Byte) Dim c As Byte For c = 1 To 9 If Sud(Fila, c) = ValorBuscado Then BuscarFila = True Exit Function Else BuscarFila = False End If Next End Function 'Funcion que busca un valor en la columna indicada Private Function BuscarColumna(Columna As Byte, ValorBuscado As Byte) Dim f As Byte For f = 1 To 9 If Sud(f, Columna) = ValorBuscado Then BuscarColumna = True Exit Function Else BuscarColumna = False End If Next
End Function
'Funcion que nos dice si un valor indicado existe o no en una region o casa indicada Function Encontrar(Casa As Byte, Valor As Byte) As Boolean Dim f As Byte, c As Byte If Casa = 1 Then 'quiere decir que se va a buscar en la casa 1 For f = 1 To 3 'busqueda por filas For c = 1 To 3 If Sud(f, c) = Valor Then Encontrar = True Exit Function End If Next Next End If If Casa = 2 Then 'quiere decir que se va a buscar en la casa 2 For f = 1 To 3 'busqueda por filas For c = 4 To 6 If Sud(f, c) = Valor Then Encontrar = True Exit Function End If Next Next End If
If Casa = 3 Then 'quiere decir que se va a buscar en la casa 3 For f = 1 To 3 'busqueda por filas For c = 7 To 9 If Sud(f, c) = Valor Then Encontrar = True Exit Function End If Next Next End If
If Casa = 4 Then For f = 4 To 6 'busqueda por filas For c = 1 To 3 If Sud(f, c) = Valor Then Encontrar = True Exit Function End If Next Next End If
If Casa = 5 Then For f = 4 To 6 'busqueda por filas For c = 4 To 6 If Sud(f, c) = Valor Then Encontrar = True Exit Function End If Next Next End If
If Casa = 6 Then For f = 4 To 6 'busqueda por filas For c = 7 To 9 If Sud(f, c) = Valor Then Encontrar = True Exit Function End If Next Next End If
If Casa = 7 Then For f = 7 To 9 'busqueda por filas For c = 1 To 3 If Sud(f, c) = Valor Then Encontrar = True Exit Function End If Next Next End If
If Casa = 8 Then For f = 7 To 9 'busqueda por filas For c = 4 To 6 If Sud(f, c) = Valor Then Encontrar = True Exit Function End If Next Next End If
If Casa = 9 Then For f = 7 To 9 'busqueda por filas For c = 7 To 9 If Sud(f, c) = Valor Then Encontrar = True Exit Function End If Next Next End If
End Function
'procedimiento que simplemente coloca un valor en el Flex Grid Private Sub Colocar(Fila As Byte, Columna As Byte, Valor As Byte) Dim a As Byte, b As Byte Dim fila1 As Integer With H1 .TextMatrix(Fila - 1, Columna - 1) = .TextMatrix(Fila - 1, Columna - 1) & Valor End With End Sub
'iniciamos la busqueda de candidatos Private Sub BuscarCandidatos(Casa As Byte, ValorBuscadoEnLaCasa As Byte) Dim f1 As Byte Dim f2 As Byte Dim c1 As Byte Dim c2 As Byte
'establemos las coordenadas para cada region o casa Select Case Casa Case 1: f1 = 1 f2 = 3 c1 = 1 c2 = 3 Case 2: f1 = 1 f2 = 3 c1 = 4 c2 = 6 Case 3: f1 = 1 f2 = 3 c1 = 7 c2 = 9 Case 4: f1 = 4 f2 = 6 c1 = 1 c2 = 3 Case 5: f1 = 4 f2 = 6 c1 = 4 c2 = 6 Case 6: f1 = 4 f2 = 6 c1 = 7 c2 = 9 Case 7: f1 = 7 f2 = 9 c1 = 1 c2 = 3 Case 8: f1 = 7 f2 = 9 c1 = 4 c2 = 6 Case 9: f1 = 7 f2 = 9 c1 = 7 c2 = 9 End Select
Dim f As Byte Dim c As Byte
If Encontrar(Casa, ValorBuscadoEnLaCasa) = False Then 'si el valor buscado no es un numero FIJO For f = f1 To f2 'busqueda por filas For c = c1 To c2 If Sud(f, c) = 0 Then 'si esta vacio entonces alli debemos poner un candidato 'para que sea candidato, no debe estar ni en la fila ni en la columna (mucho menos en la region o casa) If BuscarFila(f, ValorBuscadoEnLaCasa) = False And BuscarColumna(c, ValorBuscadoEnLaCasa) = False Then Colocar f, c, ValorBuscadoEnLaCasa 'de ser asi entonces se considera como candidato End If End If Next Next End If End Sub
Private Sub Form_Load() Dim f As Byte, c As Byte For f = 0 To 8 H1.RowHeight(f) = 700 Next For f = 0 To 8 H1.ColWidth(f) = 700 Next End Sub
El sudoku propuesto: (Boton Iniciar Sudoku) (http://www.tecnosantalucia.edu.pe/imgyov/sudoku1.JPG) El sudoku propuesto con todos sus candidatos: (Boton Encontrar Candidatos) (http://www.tecnosantalucia.edu.pe/imgyov/sudoku2.JPG)
Título: Re: [Código] Mostrando los Candidatos de un Sudoku
Publicado por: BlackZeroX en 4 Noviembre 2011, 03:34 am
. Quisas te interese mi codigo... (tiene un error que no he corregido, al rato lo corregire) [Reto] Sudoku (http://foro.elhacker.net/programacion_visual_basic/reto_sudoku-t339671.0.html;msg1666771#msg1666771)
Dulces Lunas!¡.
|