elhacker.net cabecera Bienvenido(a), Visitante. Por favor Ingresar o Registrarse
¿Perdiste tu email de activación?.

 

 


Tema destacado: Recuerda que debes registrarte en el foro para poder participar (preguntar y responder)


+  Foro de elhacker.net
|-+  Programación
| |-+  Programación General
| | |-+  .NET (C#, VB.NET, ASP)
| | | |-+  Programación Visual Basic (Moderadores: LeandroA, seba123neo)
| | | | |-+  [Código] Mostrando los Candidatos de un Sudoku
0 Usuarios y 1 Visitante están viendo este tema.
Páginas: [1] Ir Abajo Respuesta Imprimir
Autor Tema: [Código] Mostrando los Candidatos de un Sudoku  (Leído 2,118 veces)
yovaninu


Desconectado Desconectado

Mensajes: 349



Ver Perfil
[Código] Mostrando los Candidatos de un Sudoku
« 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:
Código:
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)


El sudoku propuesto con todos sus candidatos: (Boton Encontrar Candidatos)


« Última modificación: 4 Noviembre 2011, 03:54 am por raul338 » En línea

BlackZeroX
Wiki

Desconectado Desconectado

Mensajes: 3.158


I'Love...!¡.


Ver Perfil WWW
Re: [Código] Mostrando los Candidatos de un Sudoku
« Respuesta #1 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

Dulces Lunas!¡.


En línea

The Dark Shadow is my passion.
Páginas: [1] Ir Arriba Respuesta Imprimir 

Ir a:  

Mensajes similares
Asunto Iniciado por Respuestas Vistas Último mensaje
Datagrid mostrando datos de excel
.NET (C#, VB.NET, ASP)
Urpem 0 4,553 Último mensaje 8 Mayo 2009, 19:45 pm
por Urpem
Los candidatos lanzan la campaña en Facebook pero no asumen la interactividad
Noticias
wolfbcn 0 1,404 Último mensaje 12 Octubre 2010, 02:21 am
por wolfbcn
WikiLeaks e Internet, candidatos al Nobel de la Paz
Noticias
wolfbcn 1 1,999 Último mensaje 2 Marzo 2011, 21:12 pm
por raul338
Mostrando AVFucker y Hex (By 2Fac3R)
Análisis y Diseño de Malware
2Fac3R 0 2,865 Último mensaje 16 Septiembre 2011, 20:36 pm
por 2Fac3R
Candidatos e Internet: más de lo mismo
Noticias
wolfbcn 0 1,347 Último mensaje 7 Noviembre 2011, 02:29 am
por wolfbcn
WAP2 - Aviso Legal - Powered by SMF 1.1.21 | SMF © 2006-2008, Simple Machines