Primeros pasos en Qbasic, aplicado al 1X2

Programas, sistemas, condiciones, filtros...
Avatar de Usuario
juanknito
11
11
Mensajes: 584
Registrado: Dom 20 Mar, 2016 12:16 pm
Ubicación: Tenerife

Re: Primeros pasos en Qbasic, aplicado al 1X2

Mensaje por juanknito »

Aqui he comparado los premios que tienen 2 columnas simetricas, la CUATRO X y DOS 2 con la DOS X y CUATRO 2:

Recordamos que una sola columna, ademas de 1 posible 14, podría tener:
28 treces.
364 doces.
2912 onces y
16016 dieces.

aquí se desglosan por figuras (X+2) de las figuras "11111111 XXXX 22" y la "111111 22 XXXX"




Imagen

el Karma Instantáneo existe, REPARTE con los que COMPARTEN.
Avatar de Usuario
anubal
14
14
Mensajes: 8474
Registrado: Mar 27 Mar, 2007 1:49 am

Re: Primeros pasos en Qbasic, aplicado al 1X2

Mensaje por anubal »

juanknito escribió:

Recordamos que una sola columna, ademas de 1 posible 14, podría tener:
28 treces.
364 doces.
2912 onces y
16016 dieces.

Esos datos son los aparentes a simple vista, Juan. Ya que aquí en el foro ya quedó claro, hace bastantes años, que los 28 treces posibles quedaron muy atrás y para algunos quinielistas se convirtieron en 84 treces posibles en sus archivos personales, usando el "sencillo" truco del comodín en el pleno al quince... :secretito:

Y, la gran ventaja es que, usando ese sencillo truco, se multiplican todas las categorías de premios de la combinación en la que se emplee, ¡¡¡Pero la categoría de premios que más se multiplica es la que todo el mundo busca!!!... ¿Sabes cual es?... ¿Sabes por cuanto se multiplica? :;):


Nota: No quiero saber nada más del tema, que demasiados miles de mensajes me ha costado ya en el foro, cuando trabajaba, tenía dos trabajos y tenía tiempo libre... (Que maravilla entonces :D :D :D ) Porque ahora ya no trabajo, estoy jubilado y tengo menos tiempo libre que entonces... Exactamente no tengo nada de tiempo libre :enfado: :enfado: :enfado:


:;): :) :saludo:
6 plenos cobrados ya, si. Y 4 de ellos conseguidos con menos de 300 € *

* Y ojo, que 3 de esos 4 plenos...¡¡¡CAZADOS CON ARCHIVOS DE MENOS DE 75 €!!!...

¡¡¡4 ETAPAS YA, Y TODAS CON PLENOS Y BENEFICIOS!!!

https://www.eduardolosilla.es/quiniela/ ... ocero?el=1 ...
Acceso a la peña
Avatar de Usuario
juanknito
11
11
Mensajes: 584
Registrado: Dom 20 Mar, 2016 12:16 pm
Ubicación: Tenerife

Re: Primeros pasos en Qbasic, aplicado al 1X2

Mensaje por juanknito »

Saludos Anubal,

Me alegro de ese pleno, y de liderar el n° de ellos en el DNP,

sin duda es la mejor muestra de que el sistema de figuras, de ser de las condiciones "menores" !? sería de estas, de las más importantes.

Entiendo también, que después de tantos años, estés un poco cansado, y es que la quiniela es muy desagradecida, los exitos nunca son proporcionales al esfuerzo y tiempo empleados para intentar cazarlos..

Yo seguiré con el análisis de éste filtro menor !?, porque creo que solapando figuras y tapando huecos, es una forma de reducción nada desdeñable, juego poco, en peñas casi siempre, pero siempre consciente que no solo jugamos nosotros con la quiniela, ella también juega con nosotros y de paso, haciendo honor al título del hilo, si podemos compartir pequeños conocimientos de BASIC, pues genial !!

Suerte Anubal

el Karma Instantáneo existe, REPARTE con los que COMPARTEN.
Avatar de Usuario
juanknito
11
11
Mensajes: 584
Registrado: Dom 20 Mar, 2016 12:16 pm
Ubicación: Tenerife

Re: Primeros pasos en Qbasic, aplicado al 1X2

Mensaje por juanknito »

el pequeño código que genera las 120 FIGURAS* en los 14 triples, su nº de apuestas, su % respecto al 100% de los 14 triples y una columna ejemplo.

* FIGURA: es la combinación de UNOS, EQUIS Y DOCES, en cualquier posición de los 14 triples. (o en otro nº de triples que deseemos).

El siguiente código nos crea un archivo, con toda la información generada:120 FIGURAS EN 14 SIGNOS.TXT
se puede ver en el hilo: viewtopic.php?f=32&t=98197&p=2684095#p2684095

captura de los datos que vuelca el programilla:
Imagen


y el código Qbasic:

OPEN "120 FIGURAS EN 14 SIGNOS.TXT" FOR OUTPUT AS 1:
rem SE ABRE FICHERO TXT PARA GUARDAR LOS DATOS.
PRINT
PRINT "LAS 120 FIGURAS POSIBLES (1+X+2) EN LOS 14 TRIPLES"
PRINT
PRINT "N.Caso 1 X 2 Apuestas % 14 Trip. Columna / figura "
PRINT "====== == == == ======== ========== ================"

PRINT #1,
PRINT #1, "LAS 120 FIGURAS POSIBLES (1+X+2) EN LOS 14 TRIPLES"
PRINT #1,
PRINT #1, "N.Caso 1 X 2 Apuestas % 14 Trip. Columna / figura "
PRINT #1, "====== == == == ======== ========== =================="


FOR u = 14 TO 0 STEP -1
FOR e = 0 TO 14
FOR d = 0 TO 14

IF u + e + d <> 14 THEN GOTO 300 ELSE cas = cas + 1:
IF cas / 19 = INT(cas / 19) THEN LOCATE 25, 1: INPUT " Pulsa ENTER para seguir "; jj: CLS

PRINT USING " ### "; cas;: PRINT USING "###"; u; e; d,:
PRINT #1, USING " ###"; cas; u; e; d,
IF fac_14 = 0 THEN GOSUB fac_14:
GOSUB fac_0:
Ap = fac_14 / (Fu * Fe * Fd): PRINT USING " ##,###,### "; Ap;: TAp = TAp + Ap
PRINT #1, USING " ##,###,### "; Ap;
PRINT USING " ###.#### % "; (Ap * 100) / 4782969;
PRINT #1, USING " ###.#### % "; (Ap * 100) / 4782969;


GOSUB FIG: PRINT " "; F$: PRINT #1, " "; F$
F$ = ""
300
NEXT d, e, u

PRINT: PRINT "Total Apuestas:"; TAp
PRINT #1,: PRINT #1, "Total Apuestas:"; TAp

CLOSE #1
LOCATE 25, 1: INPUT " Pulsa ENTER para FIN "; jj: STOP
400 GOTO 400
FIG:
FOR u2 = 1 TO u: F$ = F$ + "1": NEXT u2
FOR e2 = 1 TO e: F$ = F$ + "X": NEXT e2
FOR d2 = 1 TO d: F$ = F$ + "2": NEXT d2
RETURN

fac_0:
n = u: GOSUB fac_n1: Fu = fac_n
n = e: GOSUB fac_n1: Fe = fac_n
n = d: GOSUB fac_n1: Fd = fac_n
RETURN

fac_n1:
fac_n = 1
FOR i = 1 TO n
fac_n = fac_n * i
NEXT i

RETURN

fac_14:
fac_14 = 1
FOR i = 1 TO 14
fac_14 = fac_14 * i
NEXT i
RETURN

el Karma Instantáneo existe, REPARTE con los que COMPARTEN.
Avatar de Usuario
juanknito
11
11
Mensajes: 584
Registrado: Dom 20 Mar, 2016 12:16 pm
Ubicación: Tenerife

Re: Primeros pasos en Qbasic, aplicado al 1X2

Mensaje por juanknito »

El escrutinio, para aquellos programas que lo necesitan, se acelera sin necesidad de escrutar los 14 signos de cada columna, lo solucionamos con una instrucción if- then..

If Nescrutados-az>=5 then descartamos


Donde Nescrutados, es el n° de signos de la columna ya escrutados, y az, sería los aciertos hasta ese momento..si superan los 4 fallos, la descartamos y escrutados la siguiente columna.

el Karma Instantáneo existe, REPARTE con los que COMPARTEN.
Avatar de Usuario
juanknito
11
11
Mensajes: 584
Registrado: Dom 20 Mar, 2016 12:16 pm
Ubicación: Tenerife

Re: Primeros pasos en Qbasic, aplicado al 1X2

Mensaje por juanknito »

saludos,
(se adjunta link actualización v.1.2)

en estos días de confinamiento, he estado dándole vueltas a una utilidad que analiza una combinación que deseemos (llamada combinacion.txt), desde el punto de vista de las figuras (casos de variantes X y 2), aislando en ficheros, cada una con sus columnas correspondientes,

en ésta primera parte, admite hasta 7 variantes, se ampliará en la siguiente versión de la aplicación.

en siguiente versión, podrá acumular los % de signos por casilla, para ver que peso tienen en los % totales de la combinación madre, así como aislar un nº determinado de figuras, para ver de forma conjunta, su importancia en los % de todas las figuras que forman la combinación.

par los que no puedan o sepan compilar el código, lo pongo seguidamente, en un archivo compartido como: Qfiguras.exe

link de Google Drive: Qfiguras v.1.2. (ahora pide introducir nombre fichero a analizar, para extracción de ficheros por figuras)





CODIGO QBASIC version de Qfiguras (V.1.0):

DIM TotX2(16, 16)
fch2$ = "combinacion.txt"
fch5$ = fch2$ + "+" + " Fig.txt"

OPEN fch5$ FOR OUTPUT AS #5

OPEN fch2$ FOR INPUT AS #2
WHILE NOT EOF(2): INPUT #2, col2$: lee2 = lee2 + 1

FOR w = 1 TO 14

IF MID$(col2$, w, 1) = "x" THEN MID$(col2$, w, 1) = "X" ' pasa x a X
figuras:
IF MID$(col2$, w, 1) = "2" THEN T2 = T2 + 1 ELSE IF MID$(col2$, w, 1) = "1" THEN T1 = T1 + 1

NEXT w

TX = 14 - (T1 + T2)
TotX2(TX, T2) = TotX2(TX, T2) + 1

cas = cas + 1: loct = loct + 1: LOCATE (loct + 1), 2
IF cas / 1 = INT(cas / 1) THEN loct = 1: LOCATE 2, 2
PRINT USING " ######## "; cas;: PRINT col2$, TX; T2, TotX2(TX, T2)
PRINT #5, col2$, TX; T2, TotX2(TX, T2)


GOSUB almacena '

T1 = 0: TX = 0: T2 = 0

WEND

99 LOCATE 25, 1: INPUT " Pulsa ENTER par seguir."; ll: CLS
GOSUB resumenTot

CLOSE #1, #5, #(nF)
100 LOCATE 25, 1: INPUT " Pulsa ENTER par Fin."; ll: STOP

resumenTot: ' generando parejas de figuras de X y 2
FOR s2 = 0 TO 14
FOR w2 = 0 TO 14
IF TotX2(s2, w2) = 0 THEN GOTO 699
PRINT USING " ##"; s2; w2,: PRINT USING " #######"; TotX2(s2, w2);
PRINT USING " ###.##"; TotX2(s2, w2) * 100 / 38172;: PRINT " %"
699:
NEXT w2
NEXT s2

RETURN

almacena: ' se archivan totales por figuras, se crea nombre fichero desde: TX mas T2 mas .txt (linea 59)

IF STR$(TX) <> fch1$ THEN fch1$ = STR$(TX): new = 1
IF STR$(T2) <> fch2$ THEN fch2$ = STR$(T2): new = 1

IF new <> 1 THEN GOTO 701: ' new = 0 ' repite figura

400: CLOSE #nF: fch_fig$ = fch1$ + fch2$ + ".txt": GOTO 700 ' no repite figura / close #7

600:
700:
REM Figuras admitidas, en esta version de Qfiguras (V.1.0)
IF fch_fig$ = " 0 5.txt" THEN nF = 7: GOTO 7000
IF fch_fig$ = " 0 6.txt" THEN nF = 8: GOTO 7000
IF fch_fig$ = " 1 3.txt" THEN nF = 9: GOTO 7000
IF fch_fig$ = " 1 4.txt" THEN nF = 10: GOTO 7000
IF fch_fig$ = " 1 5.txt" THEN nF = 11: GOTO 7000
IF fch_fig$ = " 1 6.txt" THEN nF = 12: GOTO 7000
IF fch_fig$ = " 2 3.txt" THEN nF = 13: GOTO 7000
IF fch_fig$ = " 2 4.txt" THEN nF = 14: GOTO 7000
IF fch_fig$ = " 2 5.txt" THEN nF = 15: GOTO 7000
IF fch_fig$ = " 3 2.txt" THEN nF = 16: GOTO 7000
IF fch_fig$ = " 3 3.txt" THEN nF = 17: GOTO 7000
IF fch_fig$ = " 3 4.txt" THEN nF = 18: GOTO 7000
IF fch_fig$ = " 4 1.txt" THEN nF = 19: GOTO 7000
IF fch_fig$ = " 4 2.txt" THEN nF = 20: GOTO 7000
IF fch_fig$ = " 4 3.txt" THEN nF = 21: GOTO 7000
IF fch_fig$ = " 5 0.txt" THEN nF = 22: GOTO 7000
IF fch_fig$ = " 5 1.txt" THEN nF = 23: GOTO 7000
IF fch_fig$ = " 5 2.txt" THEN nF = 24: GOTO 7000
IF fch_fig$ = " 6 0.txt" THEN nF = 25: GOTO 7000
IF fch_fig$ = " 6 1.txt" THEN nF = 26: GOTO 7000


7000:
OPEN fch_fig$ FOR APPEND AS #nF: new = 0: GOTO 701 '<<<<< hoy LOCATE 25, 1: INPUT " Pulsa ENTER para seguir2."; ll: CLS

701: PRINT #nF, col2$, TX; T2, TotX2(TX, T2)
702
800: RETURN
Última edición por juanknito el Mar 12 May, 2020 1:08 pm, editado 2 veces en total.

el Karma Instantáneo existe, REPARTE con los que COMPARTEN.
Avatar de Usuario
juanknito
11
11
Mensajes: 584
Registrado: Dom 20 Mar, 2016 12:16 pm
Ubicación: Tenerife

Re: Primeros pasos en Qbasic, aplicado al 1X2

Mensaje por juanknito »

Se actualiza CODIGO, el anterior no abría fichero, ahora pide nombre para su apertura.

link descarga en post anterior (Qfiguras v.1.2):
viewtopic.php?p=2830192#p2830192

REM CODIGO DE UTILIDAD EXTRACTORA DE FIGURAS (COLUMNAS CON IGUAL No. DE X Y 2 A FICHERO. V.1.2

DIM TotX2(16, 16)

CLS
LOCATE 3, 1: PRINT " Utilidad: Qfiguras V.1.2 "
LOCATE 5, 1: PRINT " Se extraen FIGURAS (columnas con mismas variantes X y 2), a ficheros. "
LOCATE 25, 1: INPUT " Nombre de fichero a extraer figuras y pulsar ENTER."; fch2$: CLS
'fch2$ = "combinacion.txt"
fch5$ = fch2$ + "+" + " Fig.txt"



OPEN fch5$ FOR OUTPUT AS #5

OPEN fch2$ FOR INPUT AS #2
WHILE NOT EOF(2): INPUT #2, col2$: lee2 = lee2 + 1

FOR w = 1 TO 14

IF MID$(col2$, w, 1) = "x" THEN MID$(col2$, w, 1) = "X" ' pasa x a X
figuras:
IF MID$(col2$, w, 1) = "2" THEN T2 = T2 + 1 ELSE IF MID$(col2$, w, 1) = "1" THEN T1 = T1 + 1

NEXT w

TX = 14 - (T1 + T2)
TotX2(TX, T2) = TotX2(TX, T2) + 1

cas = cas + 1: loct = loct + 1: LOCATE (loct + 1), 2
IF cas / 1 = INT(cas / 1) THEN loct = 1: LOCATE 2, 2
PRINT USING " ######## "; cas;: PRINT col2$, TX; T2, TotX2(TX, T2)
PRINT #5, col2$, TX; T2, TotX2(TX, T2)


GOSUB almacena '

T1 = 0: TX = 0: T2 = 0

WEND

99 LOCATE 25, 1: INPUT " Pulsa ENTER par seguir."; ll: CLS
GOSUB resumenTot

CLOSE #1, #5, #(nF)
100 LOCATE 25, 1: INPUT " Pulsa ENTER par Fin."; ll: STOP

resumenTot: ' generando parejas de figuras de X y 2
CLS: LOCATE 1, 1: PRINT " Figuras X+2 y columnas archivadas:"
FOR s2 = 0 TO 14
FOR w2 = 0 TO 14
IF TotX2(s2, w2) = 0 THEN GOTO 699
PRINT USING " ##"; s2; w2,: PRINT USING " #######"; TotX2(s2, w2);
PRINT USING " ###.##"; TotX2(s2, w2) * 100 / 38172;: PRINT " %"
699:
NEXT w2
NEXT s2

RETURN

almacena: ' se archivan totales por figuras, se crea nombre fichero desde: TX mas T2 mas .txt (linea 59)

IF STR$(TX) <> fch1$ THEN fch1$ = STR$(TX): new = 1
IF STR$(T2) <> fch2$ THEN fch2$ = STR$(T2): new = 1

IF new <> 1 THEN GOTO 701: ' new = 0 ' repite figura

400: CLOSE #nF: fch_fig$ = fch1$ + fch2$ + ".txt": GOTO 700 ' no repite figura / close #7

600:
700:

IF fch_fig$ = " 0 5.txt" THEN nF = 6: GOTO 7000
IF fch_fig$ = " 0 6.txt" THEN nF = 7: GOTO 7000
IF fch_fig$ = " 0 7.txt" THEN nF = 8: GOTO 7000
IF fch_fig$ = " 0 8.txt" THEN nF = 9: GOTO 7000
IF fch_fig$ = " 1 3.txt" THEN nF = 10: GOTO 7000
IF fch_fig$ = " 1 4.txt" THEN nF = 11: GOTO 7000
IF fch_fig$ = " 1 5.txt" THEN nF = 12: GOTO 7000
IF fch_fig$ = " 1 6.txt" THEN nF = 13: GOTO 7000
IF fch_fig$ = " 2 3.txt" THEN nF = 14: GOTO 7000
IF fch_fig$ = " 2 4.txt" THEN nF = 15: GOTO 7000
IF fch_fig$ = " 2 5.txt" THEN nF = 16: GOTO 7000
IF fch_fig$ = " 2 6.txt" THEN nF = 17: GOTO 7000
IF fch_fig$ = " 3 2.txt" THEN nF = 18: GOTO 7000
IF fch_fig$ = " 3 3.txt" THEN nF = 19: GOTO 7000
IF fch_fig$ = " 3 4.txt" THEN nF = 20: GOTO 7000
IF fch_fig$ = " 3 5.txt" THEN nF = 21: GOTO 7000
IF fch_fig$ = " 3 6.txt" THEN nF = 22: GOTO 7000
IF fch_fig$ = " 4 5.txt" THEN nF = 23: GOTO 7000
IF fch_fig$ = " 4 1.txt" THEN nF = 24: GOTO 7000
IF fch_fig$ = " 4 2.txt" THEN nF = 25: GOTO 7000
IF fch_fig$ = " 4 3.txt" THEN nF = 26: GOTO 7000
IF fch_fig$ = " 4 5.txt" THEN nF = 27: GOTO 7000
IF fch_fig$ = " 5 0.txt" THEN nF = 28: GOTO 7000
IF fch_fig$ = " 5 1.txt" THEN nF = 29: GOTO 7000
IF fch_fig$ = " 5 2.txt" THEN nF = 30: GOTO 7000
IF fch_fig$ = " 5 3.txt" THEN nF = 31: GOTO 7000
IF fch_fig$ = " 5 4.txt" THEN nF = 32: GOTO 7000
IF fch_fig$ = " 6 0.txt" THEN nF = 33: GOTO 7000
IF fch_fig$ = " 6 1.txt" THEN nF = 34: GOTO 7000
IF fch_fig$ = " 6 2.txt" THEN nF = 35: GOTO 7000
IF fch_fig$ = " 6 3.txt" THEN nF = 36: GOTO 7000


7000:
OPEN fch_fig$ FOR APPEND AS #nF: new = 0: GOTO 701

701: PRINT #nF, col2$, TX; T2, TotX2(TX, T2)
702
800: RETURN

el Karma Instantáneo existe, REPARTE con los que COMPARTEN.
Avatar de Usuario
juanknito
11
11
Mensajes: 584
Registrado: Dom 20 Mar, 2016 12:16 pm
Ubicación: Tenerife

Re: Primeros pasos en Qbasic, aplicado al 1X2

Mensaje por juanknito »

mejoramos un poco el código, la versión con más mejoras, en un link para descargar, la comparto a última hora de hoy

codigo: v. 1.3

REM CODIGO DE UTILIDAD EXTRACTORA DE FIGURAS (COLUMNAS CON IGUAL No. DE X Y 2 A FICHERO. V.1.3
COLOR 2, 0
DIM TotX2(16, 16), T_nF(30, 14, 3), TT_nF(14, 3)

CLS
LOCATE 3, 1: PRINT " Utilidad: Qfiguras V.1.3 "
LOCATE 5, 1: PRINT " Se extraen FIGURAS (columnas con mismas variantes X y 2), a ficheros. "

LOCATE 23, 1: PRINT " Introduce nombre fichero a extraer figuras y pulsar ENTER."; fch2$
LOCATE 24, 1: PRINT " o ENTER para fichero: combinacion.txt ";: INPUT fch2$: CLS
IF fch2$ = "" THEN fch2$ = "combinacion.txt"
'fch2$ = "combinacion.txt"
fch5$ = fch2$ + "+" + " Fig.txt"



LOCATE 7, 1: PRINT " Desea grabar detalle de figuras (X y 2)? s/n";: INPUT SN$: IF SN$ = "n" THEN SN$ = "N"
LOCATE 11, 1: PRINT " Se acumula % signos totales y % de cada figura al final de fichero resumen."
LOCATE 13, 1: PRINT " Se suman % signos combinando 2 figuras al final del fichero resumen."
LOCATE 15, 1: PRINT " Nombre fichero resumen: "; fch5$


'LOCATE 25, 1: INPUT " Nombre de fichero a extraer figuras y pulsar ENTER."; fch2$: CLS
'fch2$ = "combinacion.txt"
'fch5$ = fch2$ + "+" + " Fig.txt"



OPEN fch5$ FOR OUTPUT AS #5

OPEN fch2$ FOR INPUT AS #2
WHILE NOT EOF(2): INPUT #2, col2$: lee2 = lee2 + 1

FOR w = 1 TO 14

IF MID$(col2$, w, 1) = "x" THEN MID$(col2$, w, 1) = "X" ' pasa x a X
figuras:
IF MID$(col2$, w, 1) = "2" THEN T2 = T2 + 1 ELSE IF MID$(col2$, w, 1) = "1" THEN T1 = T1 + 1

NEXT w

TX = 14 - (T1 + T2)
TotX2(TX, T2) = TotX2(TX, T2) + 1

cas = cas + 1: loct = loct + 1: LOCATE (loct + 1), 2
IF cas / 1 = INT(cas / 1) THEN loct = 1: LOCATE 2, 2
PRINT USING " ######## "; cas;: PRINT col2$, TX; T2, TotX2(TX, T2)

'TotX2(16, 16), T_nF(30, 14, 3), TT_nF(14, 3)
'TotX2(TX, T2) = TotX2(TX, T2) + 1

IF SN$ <> "N" THEN PRINT #5, col2$, TX; T2, TotX2(TX, T2): GOTO 38
PRINT #5, TotX2(TX, T2); col2$ ' impresion fichero #5 solo columnas y no.


38: GOSUB almacena '

T1 = 0: TX = 0: T2 = 0

WEND

99 LOCATE 25, 1: INPUT " Pulsa ENTER par seguir."; ll: CLS
GOSUB resumenTot

CLOSE #1, #5, #(nF)
100 LOCATE 25, 1: INPUT " Pulsa ENTER par Fin."; ll: STOP

resumenTot: ' generando parejas de figuras de X y 2
CLS: LOCATE 1, 1: PRINT " Fig. Col. Archivadas:"
FOR s2 = 0 TO 14
FOR w2 = 0 TO 14
IF TotX2(s2, w2) = 0 THEN GOTO 699
PRINT USING " ##"; s2; w2,: PRINT USING " #######"; TotX2(s2, w2);
PRINT USING " ###.##"; TotX2(s2, w2) * 100 / 38172;: PRINT " %"
699:
NEXT w2
NEXT s2

RETURN

almacena: ' se archivan totales por figuras, se crea nombre fichero desde: TX mas T2 mas .txt

IF STR$(TX) <> fch1$ THEN fch1$ = STR$(TX): new = 1
IF STR$(T2) <> fch2$ THEN fch2$ = STR$(T2): new = 1

IF new <> 1 THEN GOTO 701: ' si new = 0 repite figura

400: CLOSE #nF: fch_fig$ = fch1$ + fch2$ + ".txt": GOTO 700 ' no repite figura / close #7

600:
700:

IF fch_fig$ = " 0 5.txt" THEN nF = 6
IF fch_fig$ = " 0 6.txt" THEN nF = 7
IF fch_fig$ = " 0 7.txt" THEN nF = 8
IF fch_fig$ = " 0 8.txt" THEN nF = 9
IF fch_fig$ = " 1 3.txt" THEN nF = 10
IF fch_fig$ = " 1 4.txt" THEN nF = 11
IF fch_fig$ = " 1 5.txt" THEN nF = 12
IF fch_fig$ = " 1 6.txt" THEN nF = 13
IF fch_fig$ = " 2 3.txt" THEN nF = 14
IF fch_fig$ = " 2 4.txt" THEN nF = 15
IF fch_fig$ = " 2 5.txt" THEN nF = 16
IF fch_fig$ = " 2 6.txt" THEN nF = 17
IF fch_fig$ = " 3 2.txt" THEN nF = 18
IF fch_fig$ = " 3 3.txt" THEN nF = 19
IF fch_fig$ = " 3 4.txt" THEN nF = 20
IF fch_fig$ = " 3 5.txt" THEN nF = 21
IF fch_fig$ = " 3 6.txt" THEN nF = 22
IF fch_fig$ = " 4 5.txt" THEN nF = 23
IF fch_fig$ = " 4 1.txt" THEN nF = 24
IF fch_fig$ = " 4 2.txt" THEN nF = 25
IF fch_fig$ = " 4 3.txt" THEN nF = 26
IF fch_fig$ = " 4 4.txt" THEN nF = 27
IF fch_fig$ = " 5 0.txt" THEN nF = 28
IF fch_fig$ = " 5 1.txt" THEN nF = 29
IF fch_fig$ = " 5 2.txt" THEN nF = 30
IF fch_fig$ = " 5 3.txt" THEN nF = 31
IF fch_fig$ = " 5 4.txt" THEN nF = 32
IF fch_fig$ = " 6 0.txt" THEN nF = 33
IF fch_fig$ = " 6 1.txt" THEN nF = 34
IF fch_fig$ = " 6 2.txt" THEN nF = 35
IF fch_fig$ = " 6 3.txt" THEN nF = 36

'T_nF(30, 14, 3)


7000:
OPEN fch_fig$ FOR APPEND AS #nF: new = 0: GOTO 701

701: PRINT #nF, col2$, TX; T2, TotX2(TX, T2)
702
800: RETURN

el Karma Instantáneo existe, REPARTE con los que COMPARTEN.
Avatar de Usuario
juanknito
11
11
Mensajes: 584
Registrado: Dom 20 Mar, 2016 12:16 pm
Ubicación: Tenerife

Re: Primeros pasos en Qbasic, aplicado al 1X2

Mensaje por juanknito »

Pequeña actualización del Discriminador de figuras (X+2); "Qfiguras"

ahora admite figuras de 5 a 9 variantes, versión de evaluación

Ya, en la actualización anterior, podíamos introducir un fichero a extraer figuras ó pulsar ENTER, para, por defecto, abrir uno que llamemos combinación.txt que tendremos en el mismo directorio donde tengamos nuestra utilidad Q figuras.exe


Al final tengo que reconducir la idea inicial, pues trabajar con los % inicialmente propuestos, precisan de doble lectura de muchos ficheros, lo que ralentizaría el programa, hasta ver como lo soluciono, adjunto ésta pequeña actualización: 1.3.2

La opción que sería más razonable es ponerlo como opción en el menú de inicio


Ésta versión no la compilo hasta tener todos los % funcionando ok, es por lo tanto una versión de EVALUACIÓN:

'codigo: v. 1.3.2 web

REM CODIGO DE UTILIDAD EXTRACTORA DE FIGURAS (COLUMNAS CON IGUAL No. DE X Y 2 A FICHERO. V.1.3
COLOR 2, 0
DIM TotX2(16, 16), T_nF(30, 14, 3), TT_nF(14, 3)
DIM Por(14, 3)

CLS
LOCATE 3, 1: PRINT " Utilidad: Qfiguras V.1.3 "
LOCATE 5, 1: PRINT " Se extraen FIGURAS (columnas con mismas variantes X y 2), a ficheros. "

LOCATE 23, 1: PRINT " Introduce nombre fichero a extraer figuras y pulsar ENTER."; fch2$
LOCATE 24, 1: PRINT " o ENTER para fichero = combinacion.txt ";: INPUT fch2$: CLS
IF fch2$ = "" THEN fch2$ = "combinacion.txt"
'fch2$ = "combinacion.txt"
fch5$ = fch2$ + "+" + " Fig.txt"



LOCATE 7, 1: PRINT " Desea grabar detalle de figuras (X y 2)? s/n";: INPUT SN$: IF SN$ = "n" THEN SN$ = "N"
'LOCATE 11, 1: PRINT " Se acumula % signos totales y % de cada figura al final de fichero resumen."
'LOCATE 13, 1: PRINT " Se suman % signos combinando 2 figuras al final del fichero resumen."
LOCATE 15, 1: PRINT " Nombre fichero resumen: "; fch5$


'LOCATE 25, 1: INPUT " Nombre de fichero a extraer figuras y pulsar ENTER."; fch2$: CLS
'fch2$ = "combinacion.txt"
'fch5$ = fch2$ + "+" + " Fig.txt"



OPEN fch5$ FOR OUTPUT AS #5

OPEN fch2$ FOR INPUT AS #2
WHILE NOT EOF(2): INPUT #2, col2$: lee2 = lee2 + 1

FOR w = 1 TO 14

IF MID$(col2$, w, 1) = "x" THEN MID$(col2$, w, 1) = "X" ' pasa x a X

figuras:

IF MID$(col2$, w, 1) = "1" THEN T1 = T1 + 1: Por(w, 1) = Por(w, 1) + 1: GOTO 111
IF MID$(col2$, w, 1) = "X" THEN TX = TX + 1: Por(w, 2) = Por(w, 2) + 1: GOTO 111
IF MID$(col2$, w, 1) = "2" THEN T2 = T2 + 1: Por(w, 3) = Por(w, 3) + 1
' Por(14, 3)

111
NEXT w

TX = 14 - (T1 + T2)
TotX2(TX, T2) = TotX2(TX, T2) + 1

cas = cas + 1: loct = loct + 1: LOCATE (loct + 1), 2
IF cas / 1 = INT(cas / 1) THEN loct = 1: LOCATE 2, 2
PRINT USING " ######## "; cas;: PRINT col2$, TX; T2, TotX2(TX, T2)


IF SN$ <> "N" THEN PRINT #5, col2$, TX; T2, TotX2(TX, T2): GOTO 38
PRINT #5, TotX2(TX, T2); col2$ ' impresion fichero #5 solo columnas y no.


38: GOSUB almacena '

T1 = 0: TX = 0: T2 = 0

WEND

99 LOCATE 25, 1: INPUT " Pulsa ENTER par seguir."; ll: CLS
GOSUB resumenTot

CLOSE #1, #5, #(nF)
100 LOCATE 25, 1: INPUT " Pulsa ENTER par seguir."; ll: 'STOP

CLS: PRINT " Porcentajes de la Combinacion: " ' ; fch2$ ' << I >>
FOR w = 1 TO 14
FOR p = 1 TO 3
PRINT USING " ###.##"; (Por(w, p) * 100 / 38172); ' A AVERIGUAR N. COL <<<<<<<<<<<<<<<<<<<<<<<
NEXT p: PRINT
NEXT w

101 LOCATE 25, 1: INPUT " Pulsa ENTER par Fin."; ll: STOP


resumenTot: ' generando parejas de figuras de X y 2

CLS
LOCATE 1, 1: PRINT " Fig. No.Col. % Fichero"
LOCATE 2, 1: PRINT " vX v2 ------- ---------"

FOR s2 = 0 TO 14
FOR w2 = 0 TO 14
IF TotX2(s2, w2) = 0 THEN GOTO 699
PRINT USING " ##"; s2; w2,: PRINT USING " #######"; TotX2(s2, w2);
PRINT USING " ###.##"; TotX2(s2, w2) * 100 / 38172;: PRINT " %"
699:
NEXT w2
NEXT s2

RETURN

almacena: ' se archivan totales por figuras, se crea nombre fichero desde: TX mas T2 mas .txt

IF STR$(TX) <> fch1$ THEN fch1$ = STR$(TX): new = 1
IF STR$(T2) <> fch2$ THEN fch2$ = STR$(T2): new = 1

IF new <> 1 THEN GOTO 701: ' si new = 0 repite figura

400: CLOSE #nF: fch_fig$ = fch1$ + fch2$ + ".txt": GOTO 700 ' no repite figura / close #7

600:
700: ' nF= numero de canal # de escritura en fichero de cada figura (X/2)

IF fch_fig$ = " 0 5.txt" THEN nF = 6
IF fch_fig$ = " 0 6.txt" THEN nF = 7
IF fch_fig$ = " 0 7.txt" THEN nF = 8
IF fch_fig$ = " 0 8.txt" THEN nF = 9
IF fch_fig$ = " 0 9.txt" THEN nF = 10

IF fch_fig$ = " 1 4.txt" THEN nF = 11
IF fch_fig$ = " 1 5.txt" THEN nF = 12
IF fch_fig$ = " 1 6.txt" THEN nF = 13
IF fch_fig$ = " 1 7.txt" THEN nF = 14
IF fch_fig$ = " 1 8.txt" THEN nF = 15

IF fch_fig$ = " 2 3.txt" THEN nF = 16
IF fch_fig$ = " 2 4.txt" THEN nF = 17
IF fch_fig$ = " 2 5.txt" THEN nF = 18
IF fch_fig$ = " 2 6.txt" THEN nF = 19
IF fch_fig$ = " 2 7.txt" THEN nF = 20

IF fch_fig$ = " 3 2.txt" THEN nF = 21
IF fch_fig$ = " 3 3.txt" THEN nF = 22
IF fch_fig$ = " 3 4.txt" THEN nF = 23
IF fch_fig$ = " 3 5.txt" THEN nF = 24
IF fch_fig$ = " 3 6.txt" THEN nF = 25

IF fch_fig$ = " 4 1.txt" THEN nF = 26
IF fch_fig$ = " 4 2.txt" THEN nF = 27
IF fch_fig$ = " 4 3.txt" THEN nF = 28
IF fch_fig$ = " 4 4.txt" THEN nF = 29
IF fch_fig$ = " 4 5.txt" THEN nF = 30

IF fch_fig$ = " 5 0.txt" THEN nF = 31
IF fch_fig$ = " 5 1.txt" THEN nF = 32
IF fch_fig$ = " 5 2.txt" THEN nF = 33
IF fch_fig$ = " 5 3.txt" THEN nF = 34
IF fch_fig$ = " 5 4.txt" THEN nF = 35

IF fch_fig$ = " 6 0.txt" THEN nF = 36
IF fch_fig$ = " 6 1.txt" THEN nF = 37
IF fch_fig$ = " 6 2.txt" THEN nF = 38
IF fch_fig$ = " 6 3.txt" THEN nF = 39

IF fch_fig$ = " 7 0.txt" THEN nF = 40
IF fch_fig$ = " 7 1.txt" THEN nF = 41
IF fch_fig$ = " 7 2.txt" THEN nF = 42

IF fch_fig$ = " 8 0.txt" THEN nF = 43
IF fch_fig$ = " 8 1.txt" THEN nF = 44

IF fch_fig$ = " 9 0.txt" THEN nF = 45


'T_nF(30, 14, 3)


7000:
OPEN fch_fig$ FOR APPEND AS #nF: new = 0: 'GOTO 701

701: PRINT #nF, col2$, TX; T2, TotX2(TX, T2)
702
800: RETURN

9000 '<<<<<<<<<<<<<<<<<
'lector de numero de apuestas:
OPEN "comb1.txt" FOR INPUT AS #2


WHILE NOT EOF(2): INPUT #2, col$: Ncol = Ncol + 1
LOCATE 5, 5: PRINT USING " Leidas: ###,###,###"; Ncol
WEND
LOCATE 25, 1: INPUT " Pulsa para FIN "; kk: CLS: STOP

el Karma Instantáneo existe, REPARTE con los que COMPARTEN.
Avatar de Usuario
juanknito
11
11
Mensajes: 584
Registrado: Dom 20 Mar, 2016 12:16 pm
Ubicación: Tenerife

Re: Primeros pasos en Qbasic, aplicado al 1X2

Mensaje por juanknito »

Saludos,
Hasta compilar y publicar las nuevas mejoras, de la pequeña utilidad Qfiguras, indicar que es necesario borrar los archivos generados en ejecuciones anteriores del programa, ya que sobre escribe ficheros, dando datos redundantes.

Los ficheros serían por ejemplo:
0 5.txt
0 6.txt
0 7.txt
0 8.txt
.....
4 2.txt
4 3.txt..... etc.

Recordar que esos archivos contenían las apuestas con igual número de variantes, por ejemplo: 4 3. txt y que lo componen todas las columnas con SOLO esas variantes (llamada figura 4 3), presentes en la combinación introducida al inicio de la aplicación Qfiguras.exe

el Karma Instantáneo existe, REPARTE con los que COMPARTEN.
Avatar de Usuario
Wandering
12
12
Mensajes: 1494
Registrado: Jue 26 Abr, 2018 8:50 pm

Re: Primeros pasos en Qbasic, aplicado al 1X2

Mensaje por Wandering »

Interesante utilidad Juaniko.
Me alegra ver que vas ampliando tu proyecto. :ok:
No seria mejor trabajarla por lexicografico. Lo digo mas que nada por la velocidad.
Es solo una opinion.
Una cosa mas a lo mejor ves algo que no pensabas o si, eso no lo se. Te hablo de una nueva forma de seleccinar las combianciones a jugar.
Quizas te diga una tonteria, o algo que ya conoces y lo empleas.
A tu disposición.
:beer2: :money:
Avatar de Usuario
juanknito
11
11
Mensajes: 584
Registrado: Dom 20 Mar, 2016 12:16 pm
Ubicación: Tenerife

Re: Primeros pasos en Qbasic, aplicado al 1X2

Mensaje por juanknito »

Saludos Wandering, no sé lo que es el texto lexicográfico, apenas aprendí algo de BASIC,...

adjunto el código que permite buscar y archivr todos los casos de premio de una única columna introducida, los archiva en cuatro ficheros con los casos de premio de cada uno, es decir la columna de 14 y cuatro ficheros con los premios de 13,12,11 y 10.

Además crea un archivo resumen de que variantes tienen todas las columnas premiadas, respecto a esa columna inicial.

Código QBASIC:

1: CLEAR: ' UTILIDAD QUE BUSCA Y ARCHIVA TODOS LOS PREMIOS DE UNA COLUMNA

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)

LOCATE 25, 1: INPUT " Introduce 14 signos (1,X,2): "; b$: C$ = UCASE$(b$): A$ = C$: CLS


FOR s = 1 TO 14
IF MID$(C$, s, 1) = "2" THEN MID$(A$, s, 1) = "3": fch2 = fch2 + 1
IF MID$(C$, s, 1) = "X" THEN MID$(A$, s, 1) = "2": fchX = fchX + 1
NEXT s
fch1 = 14 - (fch2 + fchX): PRINT fch1; fchX; fch2


nombFCH$ = "Casos_Premio " + STR$(fch1) + "UNOS" + STR$(fchX) + " EQUIS" + STR$(fch2) + " DOCES Resumen .txt"

OPEN nombFCH$ FOR OUTPUT AS #1
nombFCH_P$ = "Casos_premio " + STR$(fch1) + " UNOS" + STR$(fchX) + " EQUIS" + STR$(fch2) + " DOCES "

OPEN nombFCH_P$ + "de 14 .txt" FOR OUTPUT AS #4
OPEN nombFCH_P$ + "de 13 .txt" FOR OUTPUT AS #3
OPEN nombFCH_P$ + "de 12 .txt" FOR OUTPUT AS #2
OPEN nombFCH_P$ + "de 11 .txt" FOR OUTPUT AS #5
OPEN nombFCH_P$ + "de 10 .txt" FOR OUTPUT AS #6



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 az < 1 THEN az = 0: GOTO 500
IF f = VAL(MID$(A$, 6, 1)) THEN az = az + 1
IF g = VAL(MID$(A$, 7, 1)) THEN az = az + 1
IF az < 3 THEN az = 0: GOTO 500
IF h = VAL(MID$(A$, 8, 1)) THEN az = az + 1
IF i = VAL(MID$(A$, 9, 1)) THEN az = az + 1
IF az < 5 THEN az = 0: GOTO 500
IF j = VAL(MID$(A$, 10, 1)) THEN az = az + 1
IF k = VAL(MID$(A$, 11, 1)) THEN az = az + 1
IF az < 7 THEN az = 0: GOTO 500
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 12, 5
PRINT USING " ###,### "; acep;

PRINT A; b; C; d; e; f; g; h; i; j; k; l; m; n; "-"; az
GOSUB grabaPREM
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 "Columna introducida: "; C$
PRINT "Total columnas buscadas :";: PRINT USING " #######"; cas
PRINT "Total columnas premiadas :";: PRINT USING " #######"; 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, " Columna introducida: "; C$
PRINT #1, "Total columnas buscadas :";: PRINT #1, USING " #######"; cas
PRINT #1, "Total columnas premiadas:";: PRINT #1, USING " #######"; 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_14(n, r); 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_14(n, r); tX2_13(n, r); tX2_12(n, r);
PRINT #1, USING " #####"; tX2_11(n, r); tX2_10(n, r)

ttX2_14 = ttX2_14 + tX2_14(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_14; ttX2_13; ttX2_12; ttX2_11; ttX2_10;

RP = RP + 1: IF RP >= 2 THEN GOTO 3333
PRINT #1, " ----- ----- ----- ----- -----"
PRINT #1, " Total. premios 13/12/11/10: ";
3333
PRINT #1, USING " #####"; ttX2_14; ttX2_13; ttX2_12; ttX2_11; ttX2_10;



CLOSE #1
CLOSE #4, #3, #2, #5, #6
LOCATE 25, 1: INPUT " Pulsa <Ù para FIN o 99 Repetir "; HH: CLS: IF HH = 99 THEN GOTO 1 ELSE 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) ' Dif entre n.unos, n.equis y 14 signos.

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

IF az = 14 THEN tX2_14(tEQ, tDO) = tX2_14(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 1, 1: PRINT " N.caso (X) (2) Premios: 14 13 12 11 10"
LOCATE 2, 1: PRINT " ------ --- --- -------- ---- ---- ---- ---- ----"
LOCATE 3, 1

RP = RP + 1: IF RP >= 2 THEN GOTO 4444 ' No imprime lineas al inicio de pagina al ser #1 un fichero

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

RETURN

grabaPREM: 'PRINT A; b; C; d; e; f; g; h; i; j; k; l; m; n; "-"; az

colP$ = ""

IF A = 1 THEN s$ = "1" ELSE IF A = 2 THEN s$ = "X" ELSE s$ = "2"
GOSUB 81818
IF b = 1 THEN s$ = "1" ELSE IF b = 2 THEN s$ = "X" ELSE s$ = "2"
GOSUB 81818
IF C = 1 THEN s$ = "1" ELSE IF C = 2 THEN s$ = "X" ELSE s$ = "2"
GOSUB 81818
IF d = 1 THEN s$ = "1" ELSE IF d = 2 THEN s$ = "X" ELSE s$ = "2"
GOSUB 81818
IF e = 1 THEN s$ = "1" ELSE IF e = 2 THEN s$ = "X" ELSE s$ = "2"
GOSUB 81818
IF f = 1 THEN s$ = "1" ELSE IF f = 2 THEN s$ = "X" ELSE s$ = "2"
GOSUB 81818
IF g = 1 THEN s$ = "1" ELSE IF g = 2 THEN s$ = "X" ELSE s$ = "2"
GOSUB 81818

IF h = 1 THEN s$ = "1" ELSE IF h = 2 THEN s$ = "X" ELSE s$ = "2"
GOSUB 81818
IF i = 1 THEN s$ = "1" ELSE IF i = 2 THEN s$ = "X" ELSE s$ = "2"
GOSUB 81818
IF j = 1 THEN s$ = "1" ELSE IF j = 2 THEN s$ = "X" ELSE s$ = "2"
GOSUB 81818
IF k = 1 THEN s$ = "1" ELSE IF k = 2 THEN s$ = "X" ELSE s$ = "2"
GOSUB 81818
IF l = 1 THEN s$ = "1" ELSE IF l = 2 THEN s$ = "X" ELSE s$ = "2"
GOSUB 81818
IF m = 1 THEN s$ = "1" ELSE IF m = 2 THEN s$ = "X" ELSE s$ = "2"
GOSUB 81818
IF n = 1 THEN s$ = "1" ELSE IF n = 2 THEN s$ = "X" ELSE s$ = "2"
GOSUB 81818
IF az = 14 THEN PRINT #4, colP$, az
IF az = 13 THEN PRINT #3, colP$, az
IF az = 12 THEN PRINT #2, colP$, az
IF az = 11 THEN PRINT #5, colP$, az
IF az = 10 THEN PRINT #6, colP$, az
colP$ = ""
RETURN

81818
colP$ = colP$ + s$
RETURN

el Karma Instantáneo existe, REPARTE con los que COMPARTEN.
Avatar de Usuario
juanknito
11
11
Mensajes: 584
Registrado: Dom 20 Mar, 2016 12:16 pm
Ubicación: Tenerife

Re: Primeros pasos en Qbasic, aplicado al 1X2

Mensaje por juanknito »

link de descarga: Todos los premios de una columna,

ACTUALIZADO:

Ahora admite buscar los premios de columnas de menos de 14 signos, usando COMODINES.

para introducirlos, basta pulsar la BARRA ESPACIADORA, en los lugares donde no queremos introducir signos 1, X , 2.

la búsqueda de premios resta a los aciertos, el numero de comodines,

por ejemplo:

IMAGINEMOS QUE TENEMOS 4 TRIPLES, Y SOLO QUEREMOS ENCONTRAR LOS PREMIOS DE LOS 10 SIGNOS RESTANTES, PUES EL PLENO
SERÁ, 14-4 COMODINES=10, EL 13 SERÁ 13-4=9, Y ASÍ CON EL RESTO DE CATEGORIAS DE ACIERTO. LOS ACIERTOS DE CADA COLUMNA SE
COLOCAN A CONTINUACIÓN DE CADA UNA DE ELLAS, EN CADA UNO DE LOS 5 FICHEROS QUE SE GENERAN AUTOMÁTICAMENTE.
HAY UN SEXTO FICHERO RESUMEN, DONDE SE DETALLAN TODAS LAS COLUMNAS CON NIVEL DE FALLOS =<4, CON DETALLE DE SUS VARIANTES X-2

ESPERO LES SEA DE INTERÉS.

LINK DE DROPBOX:
https://www.dropbox.com/s/cuarghbo99hqu ... 0.exe?dl=0

el mismo archivo V1.2 en uppit:
http://uppit.com/9g0thq24khh5

el Karma Instantáneo existe, REPARTE con los que COMPARTEN.
Responder