Código de Basic - Resolver Sudokus

Imágen de perfil
Val: 545
Oro
Ha mantenido su posición en Basic (en relación al último mes)
Gráfica de Basic

Resolver Sudokusgráfica de visualizaciones


Basic

Actualizado el 25 de Septiembre del 2017 por Adelino (24 códigos) (Publicado el 12 de Septiembre del 2016)
6.819 visualizaciones desde el 12 de Septiembre del 2016
Resuelve Sudokus por fuerza bruta método "backtrack".
Se maneja con las teclas de dirección.

Dificil

Requerimientos

QBasic64 en Windows x64.
Qbasic4.5 x86.

SDKQB64
estrellaestrellaestrellaestrellaestrella(4)

Publicado el 12 de Septiembre del 2016gráfica de visualizaciones de la versión: SDKQB64
871 visualizaciones desde el 12 de Septiembre del 2016

1.2

Actualizado el 17 de Septiembre del 2017 (Publicado el 12 de Septiembre del 2016)gráfica de visualizaciones de la versión: 1.2
1.321 visualizaciones desde el 12 de Septiembre del 2016

1.3

Actualizado el 6 de Octubre del 2016 (Publicado el 26 de Septiembre del 2016)gráfica de visualizaciones de la versión: 1.3
1.361 visualizaciones desde el 26 de Septiembre del 2016

1.4

Publicado el 16 de Septiembre del 2017gráfica de visualizaciones de la versión: 1.4
537 visualizaciones desde el 16 de Septiembre del 2017

1.5
estrellaestrellaestrellaestrellaestrella(1)

Actualizado el 5 de Junio del 2019 (Publicado el 17 de Septiembre del 2017)gráfica de visualizaciones de la versión: 1.5
695 visualizaciones desde el 17 de Septiembre del 2017
estrellaestrellaestrellaestrellaestrella
estrellaestrellaestrellaestrella
estrellaestrellaestrella
estrellaestrella
estrella

Modo grafico.
Pantalla completa= "ALT+Intro".
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
DEFINT A-Z 'Declara enteras las variables
SCREEN 1 'Pantalla grafica
DIM a(80), b(81) 'Casillas y fijos
DIM y1(80), y2(80), y3(80) 'Agrupando casillas
DIM x1(8, 9), x2(8, 9), x3(8, 9) 'Control de ocupacion
DIM X(80), Y(80), c$(9) 'Posicion en pantalla y caracter
 
CLS 'Limpiar pantalla
LINE (89, 25)-(237, 173), 3, B 'Cuadricula
LINE (89, 25)-(236, 172), 3, B
FOR v = 0 TO 2 'Inicio agrupamiento
    FOR w = 0 TO 2
        FOR x = 0 TO 2
            FOR y = 0 TO 2
                'READ a(n): REM Activar para cargar sudoku
                y1(n) = 3 * v + w 'Fila de casilla (0,8)
                y2(n) = 3 * x + y 'Columna de casilla (0,8)
                y3(n) = 3 * v + x 'Zona de casilla (0,8)
 
                X(n) = 13 + 2 * (n MOD 9)
                Y(n) = 5 + 2 * (n \ 9)
                IF n < 10 THEN c$(n) = CHR$(48 + n)
                LINE (8 * X(n) - 13, 8 * Y(n) - 13)-(8 * X(n) + 3, 8 * Y(n) + 3), 3, B
                IF w + y = 0 THEN LINE (8 * X(n) - 14, 8 * Y(n) - 14)-(8 * X(n) + 35, 8 * Y(n) + 35), 3, B
                n = n + 1 ' Siguiente casilla
NEXT y, x, w, v 'Fin agrupamiento
c$(0) = " "
n = 0 'Casilla inicial
 
WHILE a$ <> CHR$(13)
    LOCATE Y(n), X(n) 'Valor en pantalla
    PRINT c$(a(n))
    PAINT (8 * X(n) - 10, 8 * Y(n) - 10), 2, 3 'Cursor
 
    IF a OR a$ = " " OR a$ = "0" THEN
        a$ = "M" 'Si el ultimo valor fue valido avanzar una casilla
    ELSE GOSUB Teclado
    END IF
 
    PAINT (8 * X(n) - 10, 8 * Y(n) - 10), 0, 3
    a$ = RIGHT$(a$, 1) 'Caracter derecho, las teclas de direccion devuelven dos caracteres)
    a = VAL(a$) 'Valor de tecla pulsada
    IF a$ = "M" AND n < 80 THEN n = n + 1 'Flecha derecha
    IF a$ = "K" AND n > 0 THEN n = n - 1 ' Flecha izquierda
    IF a$ = "P" AND n < 72 THEN n = n + 9 'Flecha abajo
    IF a$ = "H" AND n > 8 THEN n = n - 9 ' Flecha arriba
    IF a OR a$ = " " OR a$ = "0" THEN a(n) = a 'Asignar valor pulsado
WEND
 
FOR n = 0 TO 80 'Inicio control de casillas ocupadas
    a = a(n) 'Obtener valor de casilla
    IF a THEN
        IF x1(y1(n), a) + x2(y2(n), a) + x3(y3(n), a) THEN 'Valor no valido
            a(n) = 0
            LOCATE Y(n), X(n)
            PRINT " " 'Borrado
 
        ELSE b(n) = 1 'Establecer casilla ocupada
            x1(y1(n), a) = 1 'Establecer valor en uso para fila
            x2(y2(n), a) = 1
            x3(y3(n), a) = 1
            PAINT (8 * X(n) - 10, 8 * Y(n) - 10), 2, 3
        END IF
    END IF
NEXT 'Fin control de ocupacion
n = 0 'Inicio rutina de resolucion
 
Inicio:
IF b(n) THEN n = n + 1: GOTO Inicio 'El valor es fijo
IF n < 81 THEN
    a = a(n) 'Valor de casilla (0,9)
    x1(y1(n), a) = 0 'Liberar valor de casilla en fila
    x2(y2(n), a) = 0
    x3(y3(n), a) = 0
 
    Siguiente:
    IF a < 9 THEN
        a = a + 1 'Siguiente valor en casilla
        IF x1(y1(n), a) GOTO Siguiente 'Valor en uso para fila
        IF x2(y2(n), a) GOTO Siguiente
        IF x3(y3(n), a) GOTO Siguiente
 
        x1(y1(n), a) = 1 'Establecer valor en uso para fila
        x2(y2(n), a) = 1
        x3(y3(n), a) = 1
 
        a(n) = a 'Asignar nuevo valor a casilla
        LOCATE Y(n), X(n) 'Valor en pantalla
        PRINT c$(a)
        n = n + 1 'Casilla siguiente
        GOTO Inicio
    END IF
 
    a(n) = 0 'Asignar "0" por rebase
    LOCATE Y(n), X(n) 'Borrar
    PRINT " "
 
    Anterior:
    n = n - 1 'Casilla anterior
    IF n < 0 THEN GOSUB Teclado: RUN 'No hay mas soluciones reiniciar
    IF b(n) GOTO Anterior 'Es fijo
    GOTO Inicio
END IF
 
e = e + 1 'Solucion en pantalla
LOCATE 2, 18
PRINT "**"; e; "**";
LOCATE 24, 15
PRINT " Pulse INTRO ";
GOSUB Teclado
GOTO Anterior 'Si no se pulsa ESCAPE, busca mas soluciones
 
Teclado:
IF INKEY$ <> "" GOTO Teclado 'Limpia pulsaciones
a$ = ""
WHILE a$ = ""
    a$ = INKEY$
WEND
IF a$ = CHR$(27) THEN SYSTEM
RETURN
'Sudoku dificil
DATA 5,0,2,0,0,0,0,0,0
DATA 0,0,0,0,6,0,9,0,0
DATA 0,0,0,0,0,0,0,0,0
DATA 0,4,1,0,0,7,0,0,0
DATA 0,0,0,5,0,0,0,6,0
DATA 0,0,5,0,0,2,0,0,0
DATA 0,9,7,0,8,5,0,0,0
DATA 0,0,0,0,0,0,0,3,5
DATA 0,5,4,0,0,0,0,9,6



Comentarios sobre la versión: 1.5 (1)

Imágen de perfil
17 de Septiembre del 2017
estrellaestrellaestrellaestrellaestrella
excelente codigo
Responder

Comentar la versión: 1.5

Nombre
Correo (no se visualiza en la web)
Valoración
Comentarios...
CerrarCerrar
CerrarCerrar
Cerrar

Tienes que ser un usuario registrado para poder insertar imágenes, archivos y/o videos.

Puedes registrarte o validarte desde aquí.

Codigo
Negrita
Subrayado
Tachado
Cursiva
Insertar enlace
Imagen externa
Emoticon
Tabular
Centrar
Titulo
Linea
Disminuir
Aumentar
Vista preliminar
sonreir
dientes
lengua
guiño
enfadado
confundido
llorar
avergonzado
sorprendido
triste
sol
estrella
jarra
camara
taza de cafe
email
beso
bombilla
amor
mal
bien
Es necesario revisar y aceptar las políticas de privacidad

1.6

Publicado el 25 de Septiembre del 2017gráfica de visualizaciones de la versión: 1.6
2.037 visualizaciones desde el 25 de Septiembre del 2017
http://lwp-l.com/s3664