Primeros pasos en Qbasic, aplicado al 1X2

[juanknito]

Siguiendo con pequeños códigos de programas en Qbasic, .. nunca es tarde para aprender
y desarrollar ese programa que tenemos en mente,...


es un entorno ideal para los que comienzan a programar, se lleva bien con Windows y es sencillo sabiendo un inglés muy básico,.. nos permite hacer programas que funcionan en Windows, creando un ejecutable (exe) con el compilador integrado en el entorno (en mi caso el Qbasic 64, ver link al final), de QB64, gratuito.

seguidamente; código para generar columna de 1x2 en QBasic (programa no original):

Vamos a realizar una quiniela. Suponemos que tenemos un dado con sus seis caras (1,2,3,4,5,6). Lo lanzamos.
Si sale la cara 1, 2 o 3 (o sea, CASO que SEA menos de 4) ponemos un "1".
Si sale la cara 6 ponemos un "2" (o sea, CASO sea 6) .
Si sale la cara 4 o 5 ponemos una "X" (o sea, en OTRO CASO).

es decir:
3 casos 50% para el 1 (sale en el dado 1,2 ó 3)
2 casos 30% para la x (sale 4 ó 5)
1 caso 20% para el 2 (sale 6)





CLS
RANDOMIZE TIMER
FOR n = 1 TO 15
g = INT(RND * 6) + 1

SELECT CASE g

CASE IS < 4
PRINT "1"

CASE 6
PRINT "2"

CASE ELSE
PRINT "X"

END SELECT

NEXT n

existe un editor-compilador moderno de qbasic aquí en windows:
http://www.qb64.net/

seguimos practicando con futuros programas sencillos en Qbasic

y como no? animar a aquellos que comenzaron en el foro free1x2 ha utilizarlo, hablo de gente que alguno conoce,.. a poner trozos de código sencillo para integrarlo (implementarlos en informática) en otros programas.

[juanknito]

una versión del anterior. es generar las n. columnas aleatorias de 7 partidos que deseemos,..

en una próxima entrega, veremos como generar un fichero TXT con las columnas generadas, que puede ser leído por el editor de windows (documento de texto txt), y por programas que lean columnas de texto como el Free1X2. (no Megaquin).

CLS
INPUT "introduce numero de columnas de 7 signos a generar "; nn
RANDOMIZE TIMER
FOR col = 1 TO nn
FOR n = 1 TO 7
'FOR g = 1 TO 3
g = INT(RND * 3) + 1

SELECT CASE g

CASE IS = 1
PRINT "1";

CASE IS = 2
PRINT "X";

CASE IS = 3
PRINT "2";

END SELECT
'NEXT n
'PRINT
NEXT n
PRINT
NEXT col

[juanknito]

y ejemplos de programas de iniciación en QBasic,

de aquí he sacado el generador de columna semi-aleatoria ( con % al 50, 30 y 20 al 1 X ó 2), que luego he trasformado (segundo programa), para hacer las N columnas que le solicitemos, de 7 signos TOTALMENTE ALEATORIOS.

es decir, los ejemplos los podemos transformar a nuestro antojo, con muy poco trabajo y recordar;

"el mejor estimulo para progresar, es la necesidad,.."

http://www.iesromerovargas.com/recursos ... l/vb/1.htm

[juanknito]

En ésta entrega, veremos como grabar nuestras apuestas en un archivo txt, al ejecutar una aplicación de QBASIC:

se realiza abriendo el fichero para escritura: OPEN "fichero.txt" FOR OUTPUT AS #1

en éste caso, el nombre es fichero.txt y le decimos que se abre para GRABAR (output), asignándole el canal #1, para simplificar en caso de abrir más ficheros y querer escribir en ellos, usaríamos #2, #3,... etc.

para escribir datos en el fichero abierto (#1), pondremos: PRINT #1, cas, s1; s2; s3; s4; s5; s6; s7; s8
es igual que imprimir en pantalla: PRINT cas, s1; s2; s3; s4; s5; s6; s7; s8

solo que no indicamos anal de escritura en disco (#1)

una vez finalizado el programa, cerraremos el fichero con: CLOSE #1, en nuestro caso (hemos usado un solo fichero).

[juanknito]

Ejemplo de código para abrir FICHERO, grabar datos y cerrar FICHERO TXT:

Aquí el código del programa generado para encontrar las 92 soluciones del problema de las 8 reinas (no pueden ocupar la misma fila, columna ó diagonal, en un tablero de ajedrez de 8x8 casillas), que graba las soluciones en un archivo: se describe con más detalles el hilo Matemáticas:
viewtopic.php?p=2435053#p2435053

código QBASIC:

' PROGRAMA EN QBASIC PARA ENCONTRAR LAS 92 SOLUCIONES LA PROBLEMA DE LAS 8 REINAS
DIM s(8)
OPEN "CAS_REIN.TXT" FOR OUTPUT AS #1

FOR s1 = 1 TO 8
FOR s2 = 1 TO 8: IF s2 - s1 = 1 OR s1 - s2 = 1 THEN GOTO noo
FOR s3 = 1 TO 8: IF s3 - s2 = 1 OR s2 - s3 = 1 THEN GOTO noo
FOR s4 = 1 TO 8: IF s3 - s4 = 1 OR s4 - s3 = 1 THEN GOTO noo
FOR s5 = 1 TO 8: IF s4 - s5 = 1 OR s5 - s4 = 1 THEN GOTO noo
FOR s6 = 1 TO 8: IF s5 - s6 = 1 OR s6 - s5 = 1 THEN GOTO noo
FOR s7 = 1 TO 8: IF s6 - s7 = 1 OR s7 - s6 = 1 THEN GOTO noo
FOR s8 = 1 TO 8: IF s7 - s8 = 1 OR s8 - s7 = 1 THEN GOTO noo


IF s1 = s2 OR s1 = s3 OR s1 = s4 OR s1 = s5 OR s1 = s6 OR s1 = s7 OR s1 = s8 THEN GOTO noo

IF s2 = s3 OR s2 = s4 OR s2 = s5 OR s2 = s6 OR s2 = s7 OR s2 = s8 THEN GOTO noo

IF s3 = s4 OR s3 = s5 OR s3 = s6 OR s3 = s7 OR s3 = s8 THEN GOTO noo

IF s4 = s5 OR s4 = s6 OR s4 = s7 OR s4 = s8 THEN GOTO noo

IF s5 = s6 OR s5 = s7 OR s5 = s8 THEN GOTO noo

IF s6 = s7 OR s6 = s8 THEN GOTO noo

IF s7 = s8 THEN GOTO noo

caza_diagonales:
IF s1 = s2 + 1 OR s1 = s3 + 2 OR s1 = s4 + 3 OR s1 = s5 + 4 OR s1 = s6 + 5 OR s1 = s7 + 6 OR s1 = s8 + 7 THEN GOTO noo
IF s2 = s3 + 1 OR s2 = s4 + 2 OR s2 = s5 + 3 OR s2 = s6 + 4 OR s2 = s7 + 5 OR s2 = s8 + 6 THEN GOTO noo
IF s3 = s4 + 1 OR s3 = s5 + 2 OR s3 = s6 + 3 OR s3 = s7 + 4 OR s3 = s8 + 5 THEN GOTO noo
IF s4 = s5 + 1 OR s4 = s6 + 2 OR s4 = s7 + 3 OR s4 = s8 + 4 THEN GOTO noo
IF s5 = s6 + 1 OR s5 = s7 + 2 OR s5 = s8 + 3 THEN GOTO noo
IF s6 = s7 + 1 OR s6 = s8 + 2 THEN GOTO noo
IF s7 = s8 + 1 THEN GOTO noo

IF s1 = s2 - 1 OR s1 = s3 - 2 OR s1 = s4 - 3 OR s1 = s5 - 4 OR s1 = s6 - 5 OR s1 = s7 - 6 OR s1 = s8 - 7 THEN GOTO noo
IF s2 = s3 - 1 OR s2 = s4 - 2 OR s2 = s5 - 3 OR s2 = s6 - 4 OR s2 = s7 - 5 OR s2 = s8 - 6 THEN GOTO noo ' se eliminan los casos que incumplen filtros de: fila, columna o diagonal ----------

IF s3 = s4 - 1 OR s3 = s5 - 2 OR s3 = s6 - 3 OR s3 = s7 - 4 OR s3 = s8 - 5 THEN GOTO noo
IF s4 = s5 - 1 OR s4 = s6 - 2 OR s4 = s7 - 3 OR s4 = s8 - 4 THEN GOTO noo
IF s5 = s6 - 1 OR s5 = s7 - 2 OR s5 = s8 - 3 THEN GOTO noo
IF s6 = s7 - 1 OR s6 = s8 - 2 THEN GOTO noo
IF s7 = s8 - 1 THEN GOTO noo

cas = cas + 1: PRINT cas,: PRINT s1; s2; s3; s4; s5; s6; s7; s8
PRINT #1, cas, s1; s2; s3; s4; s5; s6; s7; s8
noo: ' se eliminan los casos que incumplen filtros ----------

NEXT s8, s7, s6, s5, s4, s3, s2, s1
CLOSE #1
PRINT "fin"

Y las 92 soluciones encontradas que el programa guarda en un fichero TXT, éstas:

1 - 1 5 8 6 3 7 2 4
2 - 1 6 8 3 7 4 2 5
3 - 1 7 4 6 8 2 5 3
4 - 1 7 5 8 2 4 6 3
5 - 2 4 6 8 3 1 7 5
6 - 2 5 7 1 3 8 6 4
7 - 2 5 7 4 1 8 6 3
8 - 2 6 1 7 4 8 3 5
9 - 2 6 8 3 1 4 7 5
10 - 2 7 3 6 8 5 1 4
11 - 2 7 5 8 1 4 6 3
12 - 2 8 6 1 3 5 7 4
13 - 3 1 7 5 8 2 4 6
14 - 3 5 2 8 1 7 4 6
15 - 3 5 2 8 6 4 7 1
16 - 3 5 7 1 4 2 8 6
17 - 3 5 8 4 1 7 2 6
18 - 3 6 2 5 8 1 7 4
19 - 3 6 2 7 1 4 8 5
20 - 3 6 2 7 5 1 8 4
21 - 3 6 4 1 8 5 7 2
22 - 3 6 4 2 8 5 7 1
23 - 3 6 8 1 4 7 5 2
24 - 3 6 8 1 5 7 2 4
25 - 3 6 8 2 4 1 7 5
26 - 3 7 2 8 5 1 4 6
27 - 3 7 2 8 6 4 1 5
28 - 3 8 4 7 1 6 2 5
29 - 4 1 5 8 2 7 3 6
30 - 4 1 5 8 6 3 7 2
31 - 4 2 5 8 6 1 3 7
32 - 4 2 7 3 6 8 1 5
33 - 4 2 7 3 6 8 5 1
34 - 4 2 7 5 1 8 6 3
35 - 4 2 8 5 7 1 3 6
36 - 4 2 8 6 1 3 5 7
37 - 4 6 1 5 2 8 3 7
38 - 4 6 8 2 7 1 3 5
39 - 4 6 8 3 1 7 5 2
40 - 4 7 1 8 5 2 6 3
41 - 4 7 3 8 2 5 1 6
42 - 4 7 5 2 6 1 3 8
43 - 4 7 5 3 1 6 8 2
44 - 4 8 1 3 6 2 7 5
45 - 4 8 1 5 7 2 6 3
46 - 4 8 5 3 1 7 2 6
47 - 5 1 4 6 8 2 7 3
48 - 5 1 8 4 2 7 3 6
49 - 5 1 8 6 3 7 2 4
50 - 5 2 4 6 8 3 1 7
51 - 5 2 4 7 3 8 6 1
52 - 5 2 6 1 7 4 8 3
53 - 5 2 8 1 4 7 3 6
54 - 5 3 1 6 8 2 4 7
55 - 5 3 1 7 2 8 6 4
56 - 5 3 8 4 7 1 6 2
57 - 5 7 1 3 8 6 4 2
58 - 5 7 1 4 2 8 6 3
59 - 5 7 2 4 8 1 3 6
60 - 5 7 2 6 3 1 4 8
61 - 5 7 2 6 3 1 8 4
62 - 5 7 4 1 3 8 6 2
63 - 5 8 4 1 3 6 2 7
64 - 5 8 4 1 7 2 6 3
65 - 6 1 5 2 8 3 7 4
66 - 6 2 7 1 3 5 8 4
67 - 6 2 7 1 4 8 5 3
68 - 6 3 1 7 5 8 2 4
69 - 6 3 1 8 4 2 7 5
70 - 6 3 1 8 5 2 4 7
71 - 6 3 5 7 1 4 2 8
72 - 6 3 5 8 1 4 2 7
73 - 6 3 7 2 4 8 1 5
74 - 6 3 7 2 8 5 1 4
75 - 6 3 7 4 1 8 2 5
76 - 6 4 1 5 8 2 7 3
77 - 6 4 2 8 5 7 1 3
78 - 6 4 7 1 3 5 2 8
79 - 6 4 7 1 8 2 5 3
80 - 6 8 2 4 1 7 5 3
81 - 7 1 3 8 6 4 2 5
82 - 7 2 4 1 8 5 3 6
83 - 7 2 6 3 1 4 8 5
84 - 7 3 1 6 8 5 2 4
85 - 7 3 8 2 5 1 6 4
86 - 7 4 2 5 8 1 3 6
87 - 7 4 2 8 6 1 3 5
88 - 7 5 3 1 6 8 2 4
89 - 8 2 4 1 7 5 3 6
90 - 8 2 5 3 1 7 4 6
91 - 8 3 1 6 2 5 7 4
92 - 8 4 1 3 6 2 7 5

[juanknito]

Para facilita el uso del editor del QBasic64 (gratuito), adjunto una pantalla y las 3 principales funciones a
conocer, y en serio, el QBasic no se come a nadie ¡¡

Pantalla del Editor (nos permite hacer pruebas con el código introducido, podemos guardar como .BAS (còdigo), o .EXE ejecutable en cualquier Windows.



PD:
en la próxima entrega, en éste mismo hilo, como generar los 7 triples 100% (todas las columnas), y 7 triples con % para cada signo del partido.

posteriormente, podemos cruzar 2 ficheros de 7 triples (2.187 columnas cada fichero, como máximo) y obtendremos 14 triples, que se puede hacer con el free1x2 (en menú: Operaciones, Multiplicador)

si escogemos solo los signos más probables en cada fichero de 7 partidos, obtendremos un cruce con un gran ahorro de columnas en los 14 partidos.

todo ésto lo podemos hacer con el free1x2, pero a veces, nos interesa usar nuestros ficheros con determinadas columnas, ya preparadas con ciertas condiciones optimizadas por nosotros.

[PacoHH]

Me has recordado viejos tiempos y buscando en el archivo difunto he encontrado esto....

http://ge.tt/8putYTn2





Lo hice hace más de 20 años y tardé varios años en hacerlo, mal programado y lleno de "GO TO"... pero todavía funciona y hace "buenas combinaciones" con DISTANCIAS, algo que entonces nadie usaba y por eso me lo programé.

[juanknito]

Hola PacoHH,

pues me alegro que también usaras éste lenguaje,.. heredado de los que traían los primeros computadoras personales, de principios de los 80, hablo del ZX Spectrun, Commodore, New Brain, etc., que tiempos,... no tenian pantalla, se conectaban a una TV ¡¡

el Basic es un lenguaje que hace lo que pide sin florituras y sin grandes alardes en pantalla, eso lo mató
:crash:
pero para utilidades personales, va de perlas.

ese programa que hiciste tiene buena pinta, en plan didáctico estaría genial, pero esas reliquias tienen un valor mas que nada sentimental, un incunable casi ¡?

seguimos aprendiendo...

[PacoHH]

Primero aprendí a programar en FORTRAN en los años 70, el BASIC vino después....

[juanknito]

Muchas gracias por tu programa PacoHH

se ve que hay mucho trabajo ahí, dos años lo dice todo,...


aprovecho para poner el código de una rutina en BASIC, para averiguar que figuras entran en un determinado nº de triples a elegir (de 2 a 14) y las apuestas que conllevan aparejadas.

hace esto, (para caso de elegir 14 triples, 120 casos de figuras distintas):
nos dará por pantalla y en un archivo TXT, que se llama por defecto: casos_figuras.txt









a lo largo de hoy, pondré el programa exe, que se podrá descargar.


el código de la utilidad: apuestas y figuras en N triples:


' PROGRAMA QUE CALCULA LAS APUESTAS DE CADA FIGURA (CONJUNTO DE COLUMNAS CON MISMO ' N.DE SIGNOS 1,X y 2 en cualquier posicion "
' Al inicio hay que introducir el N. de Triples donde se repartiran los signos de cada figura"
'
' Se crea un fichero TXT con el resumen de casos posibles y sus apuestas y precio en Eur. (100% y 66%)
'
' le fichero se denomina: casos_figuras.txt



10 INPUT " introduce no. de Triples para calcular el 100% de casos y sus Columnas"; nTrip1
IF nTrip1 < 2 OR nTrip1 > 14 THEN BEEP: GOTO 10
NN = nTrip1: GOSUB Fac: Fac_14 = fact

OPEN "casos_figuras.txt" FOR OUTPUT AS #1

GOSUB cabecera


FOR e = 0 TO nTrip1
FOR u = 0 TO nTrip1
FOR d = 0 TO nTrip1
IF u + e + d <> nTrip1 THEN GOTO 999

NN = u: GOSUB Fac: Fac_u = fact
NN = e: GOSUB Fac: Fac_e = fact
NN = d: GOSUB Fac: Fac_d = fact

cas = cas + 1:
PRINT USING "### "; cas,: PRINT USING "## "; u; e; d;: PRINT " - ";
PRINT #1, USING "### "; cas,: PRINT #1, USING "## "; u; e; d;: PRINT #1, " - ";
ap = Fac_14 / (Fac_u * Fac_e * Fac_d):


PRINT USING "#,###,###"; ap;: PRINT USING "#,###,###.##"; ap * .75;: PRINT " "; ' <<<<<<<<<<<<<<<<<<<<<<<<<
PRINT USING " ##,###,###"; INT(ap * 0.66);: PRINT USING " #,###,###.##"; INT(ap * 0.66) * .75


PRINT #1, USING "#,###,###"; ap; ap * .75;: PRINT #1, " ";
PRINT #1, USING " ##,###,###"; INT(ap * 0.66);: PRINT #1, USING "#,###,###.##"; INT(ap * 0.66) * .75


IF cas / 20 = INT(cas / 17) THEN LOCATE 25, 1: INPUT " pulsa <Ù para continuar listado "; jj: CLS: GOSUB cabecera

999
NEXT d, u, e

LOCATE 25, 1: BEEP: INPUT " pulsa <Ù FIn r <Ù repite "; ff$: CLS: IF ff$ = "r" OR ff$ = "R" THEN GOTO 10
CLOSE #1
STOP '------------------------------------------------ FIN ------------------------------------------------------

Fac: ' haya Factorial de NN
fact = 1
IF NN = 0 THEN NN = 1
FOR i = 1 TO NN
fact = fact * i
NEXT i

RETURN

cabecera: ' escribe cabecera cada 20 registros en pantalla y ficehro (#1)
LOCATE 2, 1
PRINT "Fig. 1 X 2 100% Ap 100% Eur 66% Ap 66% Eur"
PRINT "=== == == == ======== ========= ========= ============"

PRINT #1, "Fig. 1 X 2 100% Ap 100% Eur 66% Ap 66% Eur"
PRINT #1, "=== == == == ======== ========= ========= ==========="


'IF cabfich = 0 THEN cabfich = 1 ELSE GOTO 888



' PRINT "12345678901112233445566778899000111222333444555666777888"
888
RETURN


Para ejecutarlo, podemos descargar QB64 aquí:
http://www.qb64.net/

después de instalarlo, copiar el código arriba indicado, pegar en la ventana azul de QBASIC64 y ejecutar (tecla F5).

[juanknito]

Se añade la posibilidad de escoger el % de apuestas de las figuras a listar (en columnas 3 y 4), en todos los casos de triples escogidos, ademas del 100% (columnas 1 y 2):

' PROGRAMA QUE CALCULA LAS APUESTAS DE CADA FIGURA (CONJUNTO DE COLUMNAS CON MISMO N.DE SIGNOS 1,X y 2 en cualquier posicion "
' Al inicio hay que introducir el N. de Triples donde se repartiran los signos de cada figura (de 2 a 14)"
' Y el % de apuestas que queremos listar en columnas 3 y 4 ( entre 100% y 2%)
'
' Se crea un fichero TXT con el resumen de casos posibles y sus apuestas y precio en Eur. (100% y % escogido)
'
' el fichero se denomina: casos_figuras.txt



10 INPUT " introduce no. de Triples para calcular el 100% de casos y sus Columnas"; nTrip1
IF nTrip1 < 2 OR nTrip1 > 14 THEN BEEP: GOTO 10
PRINT
20: INPUT " introduce % de cada figura a listar (de 99% a 1%) y <Ù "; porc
IF porc > 99 OR porc < 1 THEN BEEP: GOTO 20

NN = nTrip1: GOSUB Fac: Fac_14 = fact

OPEN "casos_figuras.txt" FOR OUTPUT AS #1

GOSUB cabecera


FOR e = 0 TO nTrip1
FOR u = 0 TO nTrip1
FOR d = 0 TO nTrip1
IF u + e + d <> nTrip1 THEN GOTO 999

NN = u: GOSUB Fac: Fac_u = fact
NN = e: GOSUB Fac: Fac_e = fact
NN = d: GOSUB Fac: Fac_d = fact

cas = cas + 1:
PRINT USING "### "; cas,: PRINT USING "## "; u; e; d;: PRINT " - ";
PRINT #1, USING "### "; cas,: PRINT #1, USING "## "; u; e; d;: PRINT #1, " - ";
ap = Fac_14 / (Fac_u * Fac_e * Fac_d):


PRINT USING "#,###,###"; ap;: PRINT USING "#,###,###.##"; ap * .75;: PRINT " "; ' <<<<<<<<<<<<<<<<<<<<<<<<<
PRINT USING " ##,###,###"; INT(ap * (porc / 100));: PRINT USING " #,###,###.##"; INT(ap * (porc / 100)) * .75


PRINT #1, USING "#,###,###"; ap;: PRINT #1, USING "###,###.##"; ap * .75;: PRINT #1, " ";
PRINT #1, USING " ##,###,###"; INT(ap * (porc / 100));: PRINT #1, USING "#,###,###.##"; INT(ap * (porc / 100)) * .75


IF cas / 20 = INT(cas / 17) THEN LOCATE 25, 1: INPUT " pulsa <Ù para continuar listado "; jj: CLS: GOSUB cabecera

999
NEXT d, u, e

LOCATE 25, 1: BEEP: INPUT " pulsa <Ù FIn r <Ù repite "; ff$: CLS: IF ff$ = "r" OR ff$ = "R" THEN GOTO 10
CLOSE #1
STOP '------------------------------------------------ FIN ------------------------------------------------------

Fac: ' haya Factorial de NN
fact = 1
IF NN = 0 THEN NN = 1
FOR i = 1 TO NN
fact = fact * i
NEXT i

RETURN

cabecera: ' escribe cabecera cada 20 registros en pantalla y ficehro (#1)
LOCATE 2, 1


PRINT "Fig. 1 X 2 100% Ap 100% Eur "; porc; "% Ap "; porc; "% Eur"
PRINT "=== == == == ======== ========= ========= ============"

PRINT #1,
PRINT #1, "Fig. 1 X 2 100% Ap 100% Eur "; porc; "% Ap "; porc; "% Eur"
PRINT #1, "=== == == == ======== ========= ========= ==========="


888
RETURN

[juanknito]

se documenta el código para ver que hace cada parte importante del programa y se corrige algún bug (error), que se generaba al elegir la opción reiniciar otro calculo al final de cada ejecución.

recordar que el presente hilo, es una ayuda para los que se inician en el BASIC, y no es un ejemplo "ideal" de como hacerlo (el autor es autodidacta), pero nos permite crear pequeñas utilidades a nuestro gusto y necesidad.

link descarga de 3 archivos:
-el codigo BASIC, que corre en QB64 (copiar y pegar una ves instalado QB64):apuestas_figuras_triples.bas

-programa ejecutable en windows: apuestas_figuras_triples.exe

-fichero resumen tras la ejecución: txt para 14 triples (120 casos posibles): casos_figuras.txt
http://ge.tt/5ukfEpp2


el código corregido y documentado:

' PROGRAMA QUE CALCULA LAS APUESTAS DE CADA FIGURA (CONJUNTO DE COLUMNAS CON MISMO N.DE SIGNOS 1,X y 2 en cualquier posicion "
'
' Al inicio hay que introducir el N. de Triples donde se repartiran los signos de cada figura (de 2 a 14)"
' Y el % de apuestas que queremos listar en columnas 3 y 4 ( entre 100% y 2%)
'
' Se creara un fichero TXT con el resumen de casos posibles y sus apuestas y precio en Eur. (100% y % escogido)
'
' el fichero se denomina: casos_figuras.txt

' NOTA; el presente programa es un ejemplo del codigo BASIC (Lenguaje de los 90), para crear utilidades de
' aplicacion con Quinielas de futbol.
' El autor es autodidacta, por lo que no es un ejemplo ideal de programacion, pero se comparte con
' el unico animo de mostrar que se pueden programar pequeñas utilidades que solucionen nuestras
' necesidades de forma mas o menos sencilla, (se explica que hace cada linea de codigo importante).
'
'

10 CLEAR ' SE PONEN TODAS LAS VARIANTES A 0, POR SI SE ELIGE AL FINAL, REPETIR LA EJECUCION DEL PROGRAMA CON NUEVOS TRIPLES.
' RECORDAR QUE EN ESE CASO, SE SOBRE ESCRIBE EL FICHERO RESUMEN DE TOTAL DE CASOS, CREADO CON ANTERIORIDAD.

INPUT " introduce no. de Triples para calcular el 100% de casos y sus Columnas"; nTrip1 ' ENTRADA DE DATOS (N. DE TRIPLES)
IF nTrip1 < 2 OR nTrip1 > 14 THEN BEEP: GOTO 10

PRINT
20: INPUT " introduce % de cada figura a listar (de 99% a 1%) y <Ù "; porc ' INTRODUCCION DE % A LISTAR JUNTO AL 100%
IF porc > 99 OR porc < 1 THEN BEEP: GOTO 20

CLS: 'LIMPIAMOS PANTALLA

NN = nTrip1: GOSUB Fac: Fac_14 = fact ' SE MANDA A SUBRUTINA: FAC, PARA CALCULAR FACTORIAL DEL VALOR QUE LLAMEMOS NN

OPEN "casos_figuras.txt" FOR OUTPUT AS #1 ' ABRE FICHERO PARA ESCRITURA, SE SELECCIONA COMO CANAL 1 (#1), PARA ESCRIBIR, POR EJEMP.
GOSUB cabecera ' CABECERA DE CADA PAGINA DE 20 REGISTROS (PANTALLA Y FICEHRO .TXT CREADO)

'SE GENERAN u(1), e(X) y d(2) unos, equis y doces
FOR e = 0 TO nTrip1
FOR u = 0 TO nTrip1
FOR d = nTrip1 TO 0 STEP -1
IF u + e + d <> nTrip1 THEN GOTO 999 ' SE DESCARTAN SIGNOS GENERADOS, SI NO SUMAN EL No. de TRIPLES ELEGIDO (nTrip1).

NN = u: GOSUB Fac: Fac_u = fact ' SE MANDAN A LA SUBRUITNA: FAC (HALLAR FACTORIAL), previamente se renombra NN
NN = e: GOSUB Fac: Fac_e = fact
NN = d: GOSUB Fac: Fac_d = fact

cas = cas + 1: ' se acumulan CASOS VALIDOS
PRINT USING "### "; cas,: PRINT USING "## "; u; e; d;: PRINT " - ";
PRINT #1, USING "### "; cas,: PRINT #1, USING "## "; u; e; d;: PRINT #1, " - ";
ap = Fac_14 / (Fac_u * Fac_e * Fac_d): ' SE HALLA LAS APUESTAS, VER FORMULA EN LINEA 500


PRINT USING "#,###,###"; ap;: PRINT USING "#,###,###.##"; ap * .75;: PRINT " "; ' IMPRESION EN PANTALLA
PRINT USING " ##,###,###"; INT(ap * (porc / 100));: PRINT USING " #,###,###.##"; INT(ap * (porc / 100)) * .75


PRINT #1, USING "#,###,###"; ap;: PRINT #1, USING "###,###.##"; ap * .75;: PRINT #1, " "; ' IMPRESION FICHERO (#1)
PRINT #1, USING " ##,###,###"; INT(ap * (porc / 100));: PRINT #1, USING "#,###,###.##"; INT(ap * (porc / 100)) * .75


IF cas / 20 = INT(cas / 17) THEN LOCATE 25, 1: INPUT " pulsa <Ù para continuar listado "; jj: CLS: GOSUB cabecera
' SE LISTANA 20 VALORES, BORRA PANTALLA (CLS), SE PONE CABECERA Y SE LLENA CON 20 NUEVOS REGISTROS (PANTALLA Y FICHERO)

999
NEXT d, u, e ' SE GENERAN NUEVOS CASOS DE UNOS, EQUIS Y DOCES (d, u, e)
CLOSE #1 ' se cierra fichero creado.
LOCATE 25, 1: BEEP: INPUT " pulsa <Ù FIn r <Ù repite "; ff$: CLS: IF ff$ = "r" OR ff$ = "R" THEN GOTO 10
' reinicio de calculos, si introducimos r (o R)


STOP '------------------------------------------------ FIN ------------------------------------------------------


500
Fac: ' Surutina haya Factorial de NN (cualquier valor que llamemeos previamente: NN genera un factorial de NN)

' LA FORMULA PARA HALLAR EL No. TOTAL APUESTAS DE UNA FIGURA, EN NN TRIPLES ES:
' TOTAL DE APUESTAS DE UNA FIGURA = FACTORIAL(NN)/FACTORIAL DE UNOS*FACTORIAL DE EQUIS*FACTORIAL DE DOCES
'
' RECORDAR QUE FACTORIAL DE UN No. llamado NN, ES IGUAL AL PRODUTO DE ESE No. por NN-1 (HASTA QUE NN-1 VALGA 2)
'
' EJEMPLO 1:
' FACTORIAL DE 7 = 7*6*5*4*3*2 QUE ES IGUAL A: 5040
'
' EJEMPLO 2: HALLAR TOTAL APUESTAS DE 7 TRIPLES CON ESTA FIGURA 4(1), 2(X) Y 1(2)
'
' TOTAL APUESTAS FIGURA 4 2 1 = FACTORIAL DE 7/ FACTORIAL DE 4*FACTORIAL DE 2*FACTORIAL DE 1 (QUE ES 1)
'
' 5040/4*3*2 * 2*1 = 5040/48=105 TOTAL: 105 APUESTAS.
'
fact = 1
IF NN = 0 THEN NN = 1 ' igualamos factorial de NN a 1, como minimo para que ningun caso de 0 apuestas, al multiplicar por 0.
FOR i = 1 TO NN
fact = fact * i
NEXT i

RETURN ' RETORNA LA EJECUCION A LA LINEA QUE ENVIO A ESTA SURUTINA


cabecera: ' escribe cabecera cada 20 registros en pantalla y fichero (#1)
LOCATE 2, 1


PRINT "Fig. 1 X 2 100% Ap 100% Eur "; porc; "% Ap "; porc; "% Eur"
PRINT "=== == == == ======== ========= ========= ============"

PRINT #1,
PRINT #1, "Fig. 1 X 2 100% Ap 100% Eur "; porc; "% Ap "; porc; "% Eur"
PRINT #1, "=== == == == ======== ========= ========= ==========="






' esta linea se usa solo para ubicar datos en pantalla, no se ve en el programa porque esta con el signo: ' equivale a REM
' PRINT "12345678901112233445566778899000111222333444555666777888"

888
RETURN ' RETORNA EJECUCION A LA LINEA DE CODIGO QUE LLAMO A LA SUBRUTINA: cabecera

[JoseVicente]

Ahí va el código de cierto programilla mío. Seguro que no es un buen ejemplo de programación pero funciona y hace lo que yo quiero. Está hecho en CLIPPER, un lenguaje pensado para en manejo de bases de datos (DBASE IV qué cosa más viejuna) pero que yo he usado para la quiniela.


cls
sele 8
use DATOS_RE
go top
numintentos=INT_COL
reiniciar:="N"
aestudiar=COMBIS_EST
margen=MARGENM
semilla=SEMI
@12,25 say "Modificar datos (S/N):" get reiniciar valid reiniciar $ "NnSs"
@14,25 say "Intentos por columna:" get numintentos
@16,25 say "Combinaciones a estudiar:" get aestudiar
@18,25 say "Distancia semilla:" get semilla valid semilla<10
@20,25 say "Margen de trabajo:" get margen
read
cls
coljug:=0
totaldis:=0
intentos:=0
tabdisrecord:={coljug,0,0,0,0,0,0,0,0,0}
auxj1:=" "; auxj2:=" "; auxj3:=" ";auxj4:=" "; auxj5:=" "; auxj6:=" ";auxj7:=" "; auxj8:=" "; auxj9:=" ";auxj10:=" "; auxj11:=" "; auxj12:=" ";auxj13:=" "; auxj14:=" "
sele 4
use distanci
sele 3
use signos
if reiniciar $ "Nn"
coljug:=N1+Nx+n2
sele 4
go top
totaldis:=TOTAL
for j:=1 to 10
tabdisrecord[j]:=columnas
skip
next j
volcar_record()
mostrar_distri()
else
@2,5 say "Columnas:" get coljug
read
tabdisrecord[1]:=coljug
intro_distri()
endif
validas=0
estudiadas=0
record=0

@2,5 say "Combinaciones a estudiar:" +str(aestudiar,7)
tabdis:={0,0,0,0,0,0,0,0,0,0}


sele 2
use jug
zap

if reiniciar $ "Nn"
@ 4,20 say "Record de distancias no mejorado todavia."
endif

while estudiadas < aestudiar
cargar_qsignos()
*crear_columnas()
if calcular_distancias()
acturecord()
endif
@ 2,45 say "Estudiadas: "+str(++estudiadas,7)
enddo

close all
despedida()
cls

return

***** PROCEDIMIENTOS Y FUNCIONES ***********


procedure acturecord()
for q:=1 to 10
tabdisrecord[q]:= tabdis[q]
next q
volcar_buenas()
volcar_record()
@ 4,17 say "Record de distancias superado en el intento "+str(++estudiadas,8)
return

procedure despedida()
@ 23,2 say "Programa finalizado. Suerte con tus columnas. Recuerda que estan en col.txt"
@ 24,20 say " Pulsa cualquier tecla para salir. "
inkey(0)
return

procedure intro_distri()
@ 7,2 say "DISTRIBUCION DE SIGNOS.("+str(coljug,4)+" columnas)"
@ 8,12 say " 1 "
@ 8,17 say " X "
@ 8,22 say " 2 "
sele 4
go top
replace total with 0
sele 3
for q:=1 to 14
@ 8+q,2 say "Par."+str(q,2)+"->"
next j

for q:=1 to 14
aux1=0
auxx=0
aux2=0
@8+q,11 get aux1 picture "9999" valid aux1<=coljug
@8+q,16 get auxx picture "9999" valid aux1+auxx<=coljug
@8+q,21 get aux2 picture "9999" valid aux1+auxx+aux2=coljug
read
replace n1 with aux1, nx with auxx, n2 with aux2
skip
next j
mostrar_distri()
return

procedure mostrar_distri()
sele 3
go top
@ 7,2 say "DISTRIBUCION DE SIGNOS.("+str(coljug,4)+" columnas)"
@ 8,13 say " 1 "
@ 8,18 say " X "
@ 8,23 say " 2 "
for q:=1 to 14
@ 8+q,2 say "Par."+str(q,2)+"->"
next j

for q:=1 to 14
@8+q,11 say str(n1,4)
@8+q,16 say str(nx,4)
@8+q,21 say str(n2,4)
skip
next j
return

procedure volcar_record()
@ 7,50 say "RECORD DE DISTANCIAS"
for kkk:=1 to 10
@ 10+kkk,45 say " Distancia "+str(kkk-1,1)+" -> "+str(tabdisrecord[kkk],3)+" columnas."
next kkk
shado=0
sele 4
go top
replace TOTAL with totaldis
for j:=1 to 10
replace columnas with tabdisrecord[j]
shado=shado+(distancia*columnas)
skip
next j
@ 9,45 say "Distancias: "+str(shado,5)+ " Media:" +str(shado/(coljug-margen),5,2)
return

procedure volcar_buenas()

sele 8
*use DATOS_RE
zap
APPEND BLANK
replace INT_COL with numintentos, COMBIS_EST with aestudiar, SEMI with semilla, MARGENM with margen

sele 2
go top

copy to jugbuena.dbf
copy to col.txt SDF

return


function calcular_distancias()
sele 4
go top
recorddis=TOTAL
sele 2
zap
validas=0
auxposible:="S"
while validas < coljug-margen //.and. auxposible="S"
intentos=0
mejor=0
while intentos<numintentos
intentos++
crear_columnas()
auxdis=9
tabjug:={auxj1,auxj2,auxj3,auxj4,auxj5,auxj6,auxj7,auxj8,auxj9,auxj10,auxj11,auxj12,auxj13,auxj14}
sele 2
go top
while !eof()
wdis=0
tabtot:={j1,j2,j3,j4,j5,j6,j7,j8,j9,j10,j11,j12,j13,j14}
for j:=1 to 14
if tabtot[j]<>tabjug[j]
wdis++
endif
next j
if wdis>9
wdis=9
endif
if wdis<auxdis
auxdis=wdis
endif
skip
enddo
*@23,20 say "auxdis-> "+ str(auxdis,1) +" Mejor-> " +str(mejor,1)
*inkey(0)
if validas=0 .or. auxdis>mejor
mejor=auxdis
if mejor>=semilla
intentos=numintentos
endif
wauxj1=auxj1;wauxj2=auxj2;wauxj3=auxj3;wauxj4=auxj4;wauxj5=auxj5;wauxj6=auxj6;wauxj7=auxj7;wauxj8=auxj8;wauxj9=auxj9;wauxj10=auxj10;wauxj11=auxj11;wauxj12=auxj12;wauxj13=auxj13;wauxj14=auxj14
endif
enddo
auxj1=wauxj1;auxj2=wauxj2;auxj3=wauxj3;auxj4=wauxj4;auxj5=wauxj5;auxj6=wauxj6;auxj7=wauxj7;auxj8=wauxj8;auxj9=wauxj9;auxj10=wauxj10;auxj11=wauxj11;auxj12=wauxj12;auxj13=wauxj13;auxj14=wauxj14
grabar_nueva()
validas++
enddo
recontar_distancias()
@24,20 say "Intento actual -> "+ str(totaldis,4) +" Record -> " +str(recorddis,4)
if totaldis>recorddis
xxx:=.t.
else
xxx:=.f.
endif
return xxx

procedure recontar_distancias()
sele 2
go top
actual=1
while actual<=coljug
auxdis=9
go actual
tabjug:={j1,j2,j3,j4,j5,j6,j7,j8,j9,j10,j11,j12,j13,j14}
go top
while !eof()
wdis=0
if actual=recno() .and. !eof()
skip
endif
tabtot:={j1,j2,j3,j4,j5,j6,j7,j8,j9,j10,j11,j12,j13,j14}
for j:=1 to 14
if tabtot[j]<>tabjug[j]
wdis++
endif
next j
if wdis>9
wdis=9
endif
if wdis<auxdis
auxdis=wdis
endif
*if wdis<P15
* replace P15 with auxdis
*endif
skip
enddo
go actual
replace P15 with auxdis
actual++
enddo
totaldis:=0
tabdis:={0,0,0,0,0,0,0,0,0,0}
go top
while !eof()
totaldis=totaldis+P15
tabdis[P15+1]:=tabdis[P15+1]+1
skip
enddo
return

function mejora_record()

posible="en estudio"
kk=1
while kk<=10 .and. posible ="en estudio"
if tabdis[kk]>tabdisrecord[kk]
posible="fuera"
elseif tabdis[kk]<tabdisrecord[kk]
posible="dentro"
endif
kk++
enddo
if posible="dentro"
xxx:=.t.
else
xxx:=.f.
endif
return xxx


procedure crear_columnas()

sele 3
go top
quedan_signos=Q1+QX+Q2
auxsigno=azar(quedan_signos,intentos)
if auxsigno <= Q1
* replace Q1 with Q1-1
auxj1='1'
elseif auxsigno <= Q1+QX
* replace QX with QX-1
auxj1='X'
else
* replace Q2 with Q2-1
auxj1='2'
endif
skip

auxsigno=azar(quedan_signos,intentos)
if auxsigno <= Q1
* replace Q1 with Q1-1
auxj2='1'
elseif auxsigno <= q1+QX
* replace QX with QX-1
auxj2='X'
else
* replace Q2 with Q2-1
auxj2='2'
endif
skip

auxsigno=azar(quedan_signos,intentos)
if auxsigno <= Q1
* replace Q1 with Q1-1
auxj3='1'
elseif auxsigno <= Q1+QX
* replace QX with QX-1
auxj3='X'
else
* replace Q2 with Q2-1
auxj3='2'
endif
skip

auxsigno=azar(quedan_signos,intentos)
if auxsigno <= Q1
* replace Q1 with Q1-1
auxj4='1'
elseif auxsigno <= Q1+QX
* replace QX with QX-1
auxj4='X'
else
* replace Q2 with Q2-1
auxj4='2'
endif
skip

auxsigno=azar(quedan_signos,intentos)
if auxsigno <= Q1
* replace Q1 with Q1-1
auxj5='1'
elseif auxsigno <= Q1+QX
* replace QX with QX-1
auxj5='X'
else
* replace Q2 with Q2-1
auxj5='2'
endif
skip

auxsigno=azar(quedan_signos,intentos)
if auxsigno <= Q1
* replace Q1 with Q1-1
auxj6='1'
elseif auxsigno <= Q1+QX
* replace QX with QX-1
auxj6='X'
else
* replace Q2 with Q2-1
auxj6='2'
endif
skip

auxsigno=azar(quedan_signos,intentos)
if auxsigno <= Q1
* replace Q1 with Q1-1
auxj7='1'
elseif auxsigno <= Q1+QX
* replace QX with QX-1
auxj7='X'
else
* replace Q2 with Q2-1
auxj7='2'
endif
skip

auxsigno=azar(quedan_signos,intentos)
if auxsigno <= Q1
* replace Q1 with Q1-1
auxj8='1'
elseif auxsigno <= Q1+QX
* replace QX with QX-1
auxj8='X'
else
* replace Q2 with Q2-1
auxj8='2'
endif
skip

auxsigno=azar(quedan_signos,intentos)
if auxsigno <= Q1
* replace Q1 with Q1-1
auxj9='1'
elseif auxsigno <= Q1+QX
* replace QX with QX-1
auxj9='X'
else
* replace Q2 with Q2-1
auxj9='2'
endif
skip

auxsigno=azar(quedan_signos,intentos)
if auxsigno <= Q1
* replace Q1 with Q1-1
auxj10='1'
elseif auxsigno <= Q1+QX
* replace QX with QX-1
auxj10='X'
else
* replace Q2 with Q2-1
auxj10='2'
endif
skip

auxsigno=azar(quedan_signos,intentos)
if auxsigno <= Q1
* replace Q1 with Q1-1
auxj11='1'
elseif auxsigno <= Q1+QX
* replace QX with QX-1
auxj11='X'
else
* replace Q2 with Q2-1
auxj11='2'
endif
skip

auxsigno=azar(quedan_signos,intentos)
if auxsigno <= Q1
* replace Q1 with Q1-1
auxj12='1'
elseif auxsigno <= Q1+QX
* replace QX with QX-1
auxj12='X'
else
* replace Q2 with Q2-1
auxj12='2'
endif
skip

auxsigno=azar(quedan_signos,intentos)
if auxsigno <= Q1
* replace Q1 with Q1-1
auxj13='1'
elseif auxsigno <= Q1+QX
* replace QX with QX-1
auxj13='X'
else
* replace Q2 with Q2-1
auxj13='2'
endif
skip

auxsigno=azar(quedan_signos,intentos)
if auxsigno <= Q1
* replace Q1 with Q1-1
auxj14='1'
elseif auxsigno <= Q1+QX
* replace QX with QX-1
auxj14='X'
else
* replace Q2 with Q2-1
auxj14='2'
endif
sele 2
* APPEND BLANK
* replace J1 with auxj1, J2 with auxj2, J3 with auxj3, J4 with auxj4, J5 with auxj5, J6 with auxj6, J7 with auxj7,;
* J8 with auxj8, J9 with auxJ9, J10 with auxJ10, J11 with auxj11, J12 with auxj12, J13 with auxj13, J14 with auxj14
return

procedure grabar_nueva()
sele 2
APPEND BLANK
replace J1 with auxj1, J2 with auxj2, J3 with auxj3, J4 with auxj4, J5 with auxj5, J6 with auxj6, J7 with auxj7,;
J8 with auxj8, J9 with auxJ9, J10 with auxJ10, J11 with auxj11, J12 with auxj12, J13 with auxj13, J14 with auxj14

sele 3
go top
if auxj1='1'
replace Q1 with Q1-1
elseif auxj1='X'
replace QX with QX-1
else
replace Q2 with Q2-1
endif
skip
if auxj2='1'
replace Q1 with Q1-1
elseif auxj2='X'
replace QX with QX-1
else
replace Q2 with Q2-1
endif
skip
if auxj3='1'
replace Q1 with Q1-1
elseif auxj3='X'
replace QX with QX-1
else
replace Q2 with Q2-1
endif
skip
if auxj4='1'
replace Q1 with Q1-1
elseif auxj4='X'
replace QX with QX-1
else
replace Q2 with Q2-1
endif
skip
if auxj5='1'
replace Q1 with Q1-1
elseif auxj5='X'
replace QX with QX-1
else
replace Q2 with Q2-1
endif
skip
if auxj6='1'
replace Q1 with Q1-1
elseif auxj6='X'
replace QX with QX-1
else
replace Q2 with Q2-1
endif
skip
if auxj7='1'
replace Q1 with Q1-1
elseif auxj7='X'
replace QX with QX-1
else
replace Q2 with Q2-1
endif
skip
if auxj8='1'
replace Q1 with Q1-1
elseif auxj8='X'
replace QX with QX-1
else
replace Q2 with Q2-1
endif
skip
if auxj9='1'
replace Q1 with Q1-1
elseif auxj9='X'
replace QX with QX-1
else
replace Q2 with Q2-1
endif
skip
if auxj10='1'
replace Q1 with Q1-1
elseif auxj10='X'
replace QX with QX-1
else
replace Q2 with Q2-1
endif
skip
if auxj11='1'
replace Q1 with Q1-1
elseif auxj11='X'
replace QX with QX-1
else
replace Q2 with Q2-1
endif
skip
if auxj12='1'
replace Q1 with Q1-1
elseif auxj12='X'
replace QX with QX-1
else
replace Q2 with Q2-1
endif
skip
if auxj13='1'
replace Q1 with Q1-1
elseif auxj13='X'
replace QX with QX-1
else
replace Q2 with Q2-1
endif
skip
if auxj14='1'
replace Q1 with Q1-1
elseif auxj14='X'
replace QX with QX-1
else
replace Q2 with Q2-1
endif

return

procedure cargar_qsignos()
sele 3
go top
while !eof()
replace Q1 with N1, QX with NX, Q2 with N2
skip
enddo
return

function azar (rango,cambio)

static xrndseed := .123456789
if xrndseed = .123456789
xrndseed += val(substr(time(), 7, 2)) / 100
endif
xrndseed := ((xrndseed*cambio) * 31415821 + 1) / 1000000
return int( (xrndseed -= int(xrndseed)) * rango)+1

[juanknito]

Nuevo programa para generar columnas aleatorias en QuikBasic:

viewtopic.php?f=34&t=92109&p=2528641#p2528641

[juanknito]

.

[juanknito]

Hola JoseVicente,

pues veo ahora con detenimiento tu anterior post, y la verdad es que aunque usé el Dbase III, años ha, reconozco que no pasé de generar
y listar bases de datos y poco mas,..
no me había detenido a verlo, al estar liado con asuntos de carácter personal y por lo que he desaparecido del foro durante meses,..

aprovecho para colgar el código que busca todos los premios de una columna, trabaja con numeros 1,2,3 en lugar de signos 1,X,2, nada
que no se pueda solucionar en unos minutos retocando el código.

lo que hace la subrutina:
A partir de una columna suministrada, busca todos sus premios y los clasifica por nº de aciertos y figuras (numero de signos fijos en cualquier posición)
listando y guardando en un fichero, en nuestro caso, para la columna 11111111223333 equivalente a la 11111111XX2222, y lo guarda en el fichero: dosXcuatro2.txt
que es la columna de la cual buscamos sus 19320 (falta la propia columna de 14, la 11111111223333 equivalente a la 11111111XX2222).

Espero sea de utilidad.


DIM tUN(15), tEQ(15), tDO(15), tX2(15, 15)
DIM tX2_13(28, 28), tX2_12(28, 28), tX2_11(28, 28), tX2_10(28, 28)

A$ = "11111111223333" ' ésta es la columna a buscar sus 19320 columnas premiadas.
OPEN "dosXcuatro2.txt" FOR OUTPUT AS #1


FOR s1 = 1 TO 3
a = s1
FOR s2 = 1 TO 3
b = s2
FOR s3 = 1 TO 3
c = s3
FOR s4 = 1 TO 3
d = s4
FOR s5 = 1 TO 3:
e = s5
FOR s6 = 1 TO 3:
f = s6
FOR s7 = 1 TO 3:
g = s7

FOR s8 = 1 TO 3:
h = s8
FOR s9 = 1 TO 3:
i = s9
FOR d0 = 1 TO 3:
j = d0
FOR d1 = 1 TO 3:
k = d1
FOR d2 = 1 TO 3:
l = d2
FOR d3 = 1 TO 3:
m = d3
FOR d4 = 1 TO 3:
n = d4

IF a = VAL(MID$(A$, 1, 1)) THEN az = az + 1
IF b = VAL(MID$(A$, 2, 1)) THEN az = az + 1
IF c = VAL(MID$(A$, 3, 1)) THEN az = az + 1
IF d = VAL(MID$(A$, 4, 1)) THEN az = az + 1
IF e = VAL(MID$(A$, 5, 1)) THEN az = az + 1
IF f = VAL(MID$(A$, 6, 1)) THEN az = az + 1
IF g = VAL(MID$(A$, 7, 1)) THEN az = az + 1

IF h = VAL(MID$(A$, 8, 1)) THEN az = az + 1
IF i = VAL(MID$(A$, 9, 1)) THEN az = az + 1
IF j = VAL(MID$(A$, 10, 1)) THEN az = az + 1
IF k = VAL(MID$(A$, 11, 1)) THEN az = az + 1
IF l = VAL(MID$(A$, 12, 1)) THEN az = az + 1
IF m = VAL(MID$(A$, 13, 1)) THEN az = az + 1
IF n = VAL(MID$(A$, 14, 1)) THEN az = az + 1
' im = im + 1: IF im / 20 = INT(im / 20) THEN LOCATE 25, 1: INPUT " Pulsa <Ù para continuar "; ff: im = 0: CLS
IF az < 10 THEN az = 0: casNP = casNP + 1: GOTO 500
IF az = 10 THEN az10 = az10 + 1: GOTO 400
IF az = 11 THEN az11 = az11 + 1: GOTO 400
IF az = 12 THEN az12 = az12 + 1: GOTO 400
IF az = 13 THEN az13 = az13 + 1: GOTO 400
IF az = 14 THEN az14 = az14 + 1

400 casP = casP + 1
acep = acep + 1: LOCATE 15, 5
PRINT USING " ###,### "; acep;

PRINT a; b; c; d; e; f; g; h; i; j; k; l; m; n; "-"; az
GOSUB cuentasignos: az = 0
500: cas = cas + 1

NEXT d4, d3, d2, d1, d0, s9, s8, s7, s6, s5, s4, s3, s2, s1

PRINT
PRINT "Total columnas escrutadas: "; cas
PRINT "Total columnas premiadas: "; casP
PRINT

PRINT "Total 14: "; az14
PRINT "Total 13: "; az13
PRINT "Total 12: "; az12
PRINT "Total 11: "; az11
PRINT "Total 10: "; az10

PRINT #1,
PRINT #1, "Total columnas escrutadas: "; cas
PRINT #1, "Total columnas premiadas: "; casP
PRINT #1,

PRINT #1, "Total 14: "; az14
PRINT #1, "Total 13: "; az13
PRINT #1, "Total 12: "; az12
PRINT #1, "Total 11: "; az11
PRINT #1, "Total 10: "; az10
PRINT #1,


LOCATE 25, 1: INPUT " Pulsa <Ù para continuar "; ff: CLS

'despliegue resultado premios por figuras
GOSUB CABECERA2


FOR n = 0 TO 14
FOR r = 0 TO 14


IF tX2(n, r) = 0 THEN GOTO 700

im2 = im2 + 1
IF im2 / 20 = INT(im2 / 20) THEN LOCATE 25, 1: INPUT " Pulsa <Ù continua "; ff: CLS: GOSUB CABECERA2: im2 = 0
cas2 = cas2 + 1: PRINT USING " ###"; cas2;
PRINT USING " ###### "; n; r, tX2(n, r);
PRINT USING " #####"; tX2_13(n, r); tX2_12(n, r);
PRINT USING " #####"; tX2_11(n, r); tX2_10(n, r)

PRINT #1, USING " ###"; cas2;
PRINT #1, USING " ###### "; n; r, tX2(n, r);
PRINT #1, USING " #####"; tX2_13(n, r); tX2_12(n, r);
PRINT #1, USING " #####"; tX2_11(n, r); tX2_10(n, r)

ttX2_13 = ttX2_13 + tX2_13(n, r)
ttX2_12 = ttX2_12 + tX2_12(n, r)
ttX2_11 = ttX2_11 + tX2_11(n, r)
ttX2_10 = ttX2_10 + tX2_10(n, r)
'tX2_13(tEQ, tDO)
700
NEXT r, n
PRINT " ----- ----- ----- -----"
PRINT " Total. premios 13/12/11/10: ";
PRINT USING " #####"; ttX2_13; ttX2_12; ttX2_11; ttX2_10;

PRINT #1, " ----- ----- ----- -----"
PRINT #1, " Total. premios 13/12/11/10: ";
PRINT #1, USING " #####"; ttX2_13; ttX2_12; ttX2_11; ttX2_10;



CLOSE #1
LOCATE 25, 1: INPUT " Pulsa <Ù para FIN"; HH: CLS: END

cuentasignos:
tDO = 0: tUN = 0: tEQ = 0
IF s1 = 1 THEN tUN = tUN + 1 ELSE IF s1 = 2 THEN tEQ = tEQ + 1
IF s2 = 1 THEN tUN = tUN + 1 ELSE IF s2 = 2 THEN tEQ = tEQ + 1
IF s3 = 1 THEN tUN = tUN + 1 ELSE IF s3 = 2 THEN tEQ = tEQ + 1
IF s4 = 1 THEN tUN = tUN + 1 ELSE IF s4 = 2 THEN tEQ = tEQ + 1
IF s5 = 1 THEN tUN = tUN + 1 ELSE IF s5 = 2 THEN tEQ = tEQ + 1
IF s6 = 1 THEN tUN = tUN + 1 ELSE IF s6 = 2 THEN tEQ = tEQ + 1
IF s7 = 1 THEN tUN = tUN + 1 ELSE IF s7 = 2 THEN tEQ = tEQ + 1

IF s8 = 1 THEN tUN = tUN + 1 ELSE IF s8 = 2 THEN tEQ = tEQ + 1
IF s9 = 1 THEN tUN = tUN + 1 ELSE IF s9 = 2 THEN tEQ = tEQ + 1
IF d0 = 1 THEN tUN = tUN + 1 ELSE IF d0 = 2 THEN tEQ = tEQ + 1
IF d1 = 1 THEN tUN = tUN + 1 ELSE IF d1 = 2 THEN tEQ = tEQ + 1
IF d2 = 1 THEN tUN = tUN + 1 ELSE IF d2 = 2 THEN tEQ = tEQ + 1
IF d3 = 1 THEN tUN = tUN + 1 ELSE IF d3 = 2 THEN tEQ = tEQ + 1
IF d4 = 1 THEN tUN = tUN + 1 ELSE IF d4 = 2 THEN tEQ = tEQ + 1
tDO = 14 - (tUN + tEQ)

tX2(tEQ, tDO) = tX2(tEQ, tDO) + 1

IF az = 13 THEN tX2_13(tEQ, tDO) = tX2_13(tEQ, tDO) + 1
IF az = 12 THEN tX2_12(tEQ, tDO) = tX2_12(tEQ, tDO) + 1
IF az = 11 THEN tX2_11(tEQ, tDO) = tX2_11(tEQ, tDO) + 1
IF az = 10 THEN tX2_10(tEQ, tDO) = tX2_10(tEQ, tDO) + 1
RETURN

CABECERA2:
LOCATE 2, 1: PRINT " N.caso (X) (2) Premios: 13 12 11 10"
LOCATE 3, 1: PRINT " ------ --- --- -------- ---- ---- ---- ----"

PRINT #1,
LOCATE 2, 1: PRINT #1, " N.caso (X) (2) Premios: 13 12 11 10"
LOCATE 3, 1: PRINT #1, " ------ --- --- -------- ---- ---- ---- ----"

RETURN

[juanknito]

El volcado a fichero que hace el programa es el siguiente:

Total columnas escrutadas: 4782969
Total columnas premiadas: 19321

Total 14: 1
Total 13: 28
Total 12: 364
Total 11: 2912
Total 10: 16016


N.caso (X) (2) Premios: 13 12 11 10
------ --- --- -------- ---- ---- ---- ----
1 0 2 6 0 0 0 6
2 0 3 16 0 0 4 12
3 0 4 47 0 1 8 38
4 0 5 78 0 2 12 64
5 0 6 77 0 1 16 60
6 0 7 64 0 0 8 56
7 0 8 28 0 0 0 28
8 1 1 8 0 0 0 8
9 1 2 32 0 0 12 20
10 1 3 176 0 8 16 152
11 1 4 294 2 8 80 204
12 1 5 478 2 16 84 376
13 1 6 448 0 16 64 368
14 1 7 224 0 0 56 168
15 1 8 112 0 0 0 112
16 2 0 1 0 0 0 1
17 2 1 28 0 0 4 24
18 2 2 188 0 6 24 158
19 2 3 480 4 8 136 332

N.caso (X) (2) Premios: 13 12 11 10
------ --- --- -------- ---- ---- ---- ----
20 2 4 1091 0 56 128 906
21 2 5 1072 8 16 288 760
22 2 6 952 0 28 112 812
23 2 7 392 0 0 56 336
24 2 8 70 0 0 0 70
25 3 0 4 0 0 0 4
26 3 1 68 0 0 12 56
27 3 2 384 0 12 60 312
28 3 3 1056 4 32 172 848
29 3 4 1488 8 32 344 1104
30 3 5 1680 0 56 168 1456
31 3 6 728 0 0 168 560
32 3 7 280 0 0 0 280
33 4 0 6 0 0 0 6
34 4 1 116 0 0 12 104
35 4 2 470 0 6 96 368
36 4 3 1184 0 32 160 992
37 4 4 1428 0 28 224 1176
38 4 5 952 0 0 168 784
39 4 6 420 0 0 0 420

N.caso (X) (2) Premio: 13 12 11 10
------ --- --- -------- ---- ---- ---- ----
40 5 0 4 0 0 0 4
41 5 1 100 0 0 4 96
42 5 2 416 0 0 48 368
43 5 3 672 0 0 112 560
44 5 4 728 0 0 56 672
45 5 5 280 0 0 0 280
46 6 0 1 0 0 0 1
47 6 1 32 0 0 0 32
48 6 2 168 0 0 0 168
49 6 3 224 0 0 0 224
50 6 4 70 0 0 0 70
----- ----- ----- -------
Total. prem. 13/12/11/10: 28 364 2912 16016

[juanknito]

a ver si se ve mejor así

para la columna 11111111 22 333 equivalente a: 11111111 XX 2222, y los 50 casos de figura distintas y sus premios, con detalles de figuras* que lo contienen

*figura: numero fijo de variantes, que se dan en una combinación, en cualquier posición posible.







y el resumen al final del listado:


para terminar, como ejemplo, para interpretar éstos datos:

significa que en el caso 12 de 50, hay 478 columnas de UNA X y CINCO 2, que dan éstos premios:
2 columnas con 13 aciertos
16 columnas con 12 aciertos
84 columnas con 11 aciertos y
376 columnas con 376 aciertos.

[laguineu]

Hola Juanknito ,

Creo que no es necesario generar las 3^14 combinaciones e ir contando los aciertos ya que solo te interesa los mayores a 10

Diria yo que se puede simplificar el algoritmo e ir solamente a por estas 19.321 apuestas usando la combinatoria

Si para los de 13 son las apuestas que distan en un solo signo frente a la apuesta base , osea ir combinando los otros 2 signos restantes en cada una de las 14 posiciones
Para los de 12 son las apuestas que distan en 2 signos frente a esta apuesta base , osea ir combinando 2 signos en cada 2 posiciones (2*2 = 2^2 = 4) con todas las posibilidades de Combinatoria de 14 en 2
Para los de 11 son las apuestas que distan en 3 signos frente a esta apuesta base , osea combinar 2 signos en 3 posiciones (2*2*2 = 2^3 = con todas las posibilidades de la combinatoria de 14 en 3
Etc etc

0 Fallos ............. 2^0 * C(14 , 0) = 1 * 14!/(0!*14!) = 1 * 1
1 Fallo ............... 2^1 * C(14 , 1) = 2 * 14!/(1! * 13!) = 2 * 14 = 28
2 Fallos .............. 2^2 * C(14 , 2) = 4 * 14!/(2! * 12!) = 4 * (13*14)/2 = 4 * (13*7) = 4 * 91 = 364
3 Fallos ............... 2^3 * C(14 , 3) = 8 * 14!/(3! * 11!) = 8 * (12*13*14)/(2*3) = 8 * (2*13*14) = 8 * 364 = 2.912
4 Fallos ............... 2^4 * C(14 , 4) = 16 * 14!/(4! * 10!) = 16 * (11*12*13*14)/(2*3*4) = 16 * (11*13*7) = 16 * 1001 = 16.016
------------------------------------------------------------------ ------------------------------------------------ -------------------------------
0,1,2,3,4 Fallos ................................ ................................................ ................................................................. = 19.321

No se me ocurre ahora mismo como armar este algoritmo , pero el camino mas sencillo debe ser esto

[juanknito]

buen apunte languineu,
tu usas el ahorro de recursos, yo lo intenté bastante tiempo, sin éxito.

pero es que por fuerza bruta, (calculando todas, las 4782969), solo
tarda unos segundos, en un i7, exactamente: 12'' segundos,.. no haberlo sabido hace 3 años.