Basic - Multiplicacion ilimitada Ver 2

'PROGRAMA: MULTIPLICACION ILIMITADA >>> VERSION #2

'LRCVS 01.01.2010 SPAIN

'THIS PROGRAMM IS FREE

'QBASIC 4.5

'LO INTERESANTE DE ESTA VERSION, ES LA FORMA DE HACER LA MULTIPLICACION.
'HE REDUCIDO EL CODIGO DEL PROGRAMA, ETAPAS Y ES MAS RAPIDA.
'TAMBIEN EVITAMOS HACER MULTIPLICACIONES PARCIALES.
'REDUCIENDO EL PROGRAMA A SIMPLEMENTE SUMAS.
'LOS VALORES DEL MULTIPLICANDO Y EL MULTIPLICADOR ESTAN LIMITADOS SOLAMENTE POR EL DISCO DURO.
'ES VERDADERAMENTE "ILIMITADA"
'ESTA MULTIPLICACION ES MAS RAPIDA QUE LA VERSION ANTERIOR.
'AQUI SOLAMENTE VEMOS EL RESULTADO FINAL, NO HAY PRODUCTOS PARCIALES.
'EL MULTIPLICANDO ESTA EN "A.MLT"
'EL MULTIPLICADOR ESTA EN "B.MLT"
'EL RESULTADO / SOLUCION FINAL ESTA EN "R.MLT"
'PARA VERLO UTILIZAR UN EDITOR DE TEXTO.
'TENER PACIENCIA PARA GRANDES VALORES.
'......................................................................................

CLS
PRINT "ESPERA..."
PRINT
T1 = TIMER

NA = 1000 'NUMERO DE DIGITOS DEL MULTIPLICANDO, SIN LIMITE.
NB = 1000 'NUMERO DE DIGITOS DEL MULTIPLICADOR, SIN LIMITE.
PRINT "HACIENDO / MAKING = "; NA * NB; "MULTIPLICACIONES / MULTIPLICATIONS"
PRINT
'......................................................
'AQUI LIMPIAMOS FICHEROS
OPEN "X" + ".MLT" FOR BINARY AS #1: CLOSE (1): KILL "*.MLT"

'......................................................
'HACEMOS EL MULTIPLICANDO >>> A
'HACEMOS EL MULTIPLICADOR >>> B
FOR R1 = 1 TO 2
IF R1 = 1 THEN F$ = "A" + ".MLT": NN = NA: PRINT "CREADO / CREATE >>> A.MLT"; NA; " DIG"
IF R1 = 2 THEN F$ = "B" + ".MLT": NN = NB: PRINT "CREADO / CREATE >>> B.MLT"; NB; " DIG"
OPEN F$ FOR BINARY AS #1
FOR S1 = 1 TO NN
RANDOMIZE TIMER
X$ = LTRIM$(STR$(INT(RND * 10)))
SEEK #1, S1: PUT #1, S1, X$
NEXT S1
CLOSE (1)
NEXT R1

'.....................................................
'AQUI BUSCAMOS LOS ELEMENTOS NO REPETIDOS (DIGITOS)
U$ = STRING$(10, " ")
OPEN "B" + ".MLT" FOR BINARY AS #2
FOR R2 = 1 TO NB
SEEK #2, R2: GET #2, , X$: MID$(U$, VAL(X$) + 1) = "1"
Z1 = 0: Y1 = 0
FOR S2 = 0 TO 9
Z1 = Z1 + VAL(MID$(U$, S2 + 1, 1))
IF Z1 = 10 THEN Y1 = 1: EXIT FOR
NEXT S2
IF Y1 = 1 THEN EXIT FOR
NEXT R2
CLOSE (2)

'ESTOS SON LOS NUMEROS QUE TENEMOS QUE MULTIPLICAR
FOR R3 = 0 TO 9
IF MID$(U$, R3 + 1, 1) = "1" THEN W$ = W$ + LTRIM$(STR$(R3))
NEXT R3

'.......................................................
'AQUI HACEMOS LAS MULTIPLICACIONES PARCIALES
OPEN "A" + ".MLT" FOR BINARY AS #1
FOR R4 = 1 TO LEN(W$)
C$ = MID$(W$, R4, 1)
XP = 1: PC = NA
OPEN C$ + ".MLT" FOR BINARY AS #2
ACU = 0: NUM$ = ""
FOR S4 = PC TO 1 STEP -1
SEEK #1, S4: GET #1, S4, X$
Z$ = LTRIM$(STR$(ACU + (VAL(X$) * VAL(C$))))
ACU = 0: L = LEN(Z$)
SEEK #2, XP
IF L = 1 THEN NUM$ = Z$: PUT #2, XP, NUM$
IF L > 1 THEN ACU = VAL(LEFT$(Z$, LEN(Z$) - 1)): NUM$ = RIGHT$(Z$, 1): PUT #2, XP, NUM$
NUM$ = "": XP = XP + 1
NEXT S4
IF ACU <> 0 THEN NUM$ = LTRIM$(STR$(ACU)): PUT #2, XP, NUM$: NN2$ = NN2$ + NUM$
CLOSE (2)
NEXT R4
CLOSE (1)

'......................................................
'AQUI CREAMOS EL RESULTADO FINAL DE LA MULTIPLICACION EN: D
ACU = 0: L5 = 1: L6 = L5

OPEN "B" + ".MLT" FOR BINARY AS #1
OPEN "D" + ".MLT" FOR BINARY AS #3
FOR R5 = NB TO 1 STEP -1
SEEK #1, R5: GET #1, R5, X$
OPEN X$ + ".MLT" FOR BINARY AS #2
FOR S5 = 1 TO LOF(2)
SEEK #2, S5: GET #2, S5, NUM$
SEEK #3, L5: GET #3, L5, PR$
T$ = "": T$ = LTRIM$(STR$(ACU + VAL(NUM$) + VAL(PR$)))
PR$ = RIGHT$(T$, 1): ACU = 0
IF LEN(T$) > 1 THEN ACU = VAL(LEFT$(T$, LEN(T$) - 1))
SEEK #3, L5: PUT #3, L5, PR$
L5 = L5 + 1
NEXT S5
CLOSE (2)
L6 = L6 + 1: L5 = L6: ACU = 0
NEXT R5
CLOSE (3)
CLOSE (1)

OPEN "D" + ".MLT" FOR BINARY AS #3: LD = LOF(3): CLOSE (3)

ER = 1
OPEN "D" + ".MLT" FOR BINARY AS #3
OPEN "R" + ".MLT" FOR BINARY AS #4
FOR R6 = LD TO 1 STEP -1
SEEK #3, R6: GET #3, R6, PR$
SEEK #4, ER: PUT #4, ER, PR$
ER = ER + 1
NEXT R6
CLOSE (4)
CLOSE (3)

KILL "D.MLT"
FOR R7 = 1 TO LEN(W$)
C$ = MID$(W$, R7, 1)
KILL C$ + ".MLT"
NEXT R7

T2 = TIMER

PRINT
PRINT "TIME : "; T2 - T1; " SEG"
PRINT
PRINT "LA SOLUCION EN: >>> R.MLT "
PRINT
PRINT "VERLO CON UN EDITOR DE TEXTO"
PRINT
PRINT "ESTE PROGRAMA ES LIBRE / THIS PROGRAM IS FREE"
PRINT
PRINT "LRCVS 01.01.2010 SPAIN"

THE PROGRAM IS RIGHT NOW. OK!!!

Program:

Multiplication limitless Version #2

LRCVS 01.01.2010

Spain

'..................................

CLS
PRINT "WAIT"
T1 = TIMER
'NUMBER OF DIGITS OF MULTIPLY AND MULTIPLIER WITHOUT LIMIT.
NA = 10
NB = 10

'......................................................
'HERE DELETE FILES
OPEN "X" + ".MLT" FOR BINARY AS #1
CLOSE (1)
KILL "*.MLT"

'......................................................
'DO MULTIPLY >>> A AND DO MULTIPLIER >>> B
FOR N = 1 TO 2
IF N = 1 THEN F$ = "A" + ".MLT": NN = NA
IF N = 2 THEN F$ = "B" + ".MLT": NN = NB
OPEN F$ FOR BINARY AS #1
FOR N2 = 1 TO NN
RANDOMIZE TIMER
X$ = LTRIM$(STR$(INT(RND * 10)))
SEEK #1, N2: PUT #1, N2, X$
NEXT N2
SEEK #1, N2
CLOSE (1)
NEXT N

'.....................................................
'HERE DO THE PARTIAL MULTIPLICATIONS
FOR K = 0 TO 9
XX$ = "": NUM$ = "": Z$ = "": ACU = 0: GG = NA
C$ = LTRIM$(STR$(K))
OPEN C$ + ".MLT" FOR BINARY AS #2
OPEN "A" + ".MLT" FOR BINARY AS #1
FOR N = 1 TO NA
SEEK #1, GG: GET #1, GG, X$
NUM$ = X$
Z$ = LTRIM$(STR$(ACU + (VAL(X$) * VAL(C$))))
L = LEN(Z$)
ACU = 0
IF L = 1 THEN NUM$ = Z$: PUT #2, N, NUM$
IF L > 1 THEN ACU = VAL(LEFT$(Z$, LEN(Z$) - 1)): NUM$ = RIGHT$(Z$, 1): PUT #2, N, NUM$
SEEK #2, N: PUT #2, N, NUM$
XX$ = XX$ + NUM$
GG = GG - 1
NEXT N
IF L > 1 THEN ACU = VAL(LEFT$(Z$, LEN(Z$) - 1)): NUM$ = LTRIM$(STR$(ACU)): XX$ = XX$ + NUM$: PUT #2, N, NUM$
CLOSE (1)
CLOSE (2)
NEXT K

'......................................................
'HERE WE CREATE THE PARTIAL SOLUTION >>> D
ACU = 0
LT5 = 1
LT6 = LT5
'AQUI BUSCAMOS LOS ELEMENTOS DE B
OPEN "B" + ".MLT" FOR BINARY AS #1
OPEN "D" + ".MLT" FOR BINARY AS #3
FOR JB = NB TO 1 STEP -1
SEEK #1, JB
GET #1, JB, X$

OPEN X$ + ".MLT" FOR BINARY AS #2: LF = LOF(2): CLOSE (2)

OPEN X$ + ".MLT" FOR BINARY AS #2
FOR KB = 1 TO LF
SEEK #2, KB
GET #2, , NUM$
SEEK #3, LT5
GET #3, LT5, PR$
T$ = ""
T$ = LTRIM$(STR$(ACU + VAL(NUM$) + VAL(PR$)))
PR$ = RIGHT$(T$, 1)
ACU = 0
IF LEN(T$) > 1 THEN ACU = LEFT$(T$, LEN(T$) - 1)
SEEK #3, LT5: PUT #3, LT5, PR$
LT5 = LT5 + 1
NEXT KB
IF ACU <> 0 THEN PR$ = LTRIM$(STR$(ACU)): PUT #3, LT5, PR$
CLOSE (2)
LT6 = LT6 + 1
LT5 = LT6
ACU = 0
NEXT JB
CLOSE (3)
CLOSE (1)

OPEN "D" + ".MLT" FOR BINARY AS #3: LD = LOF(3): CLOSE (3)
ER = 1
OPEN "D" + ".MLT" FOR BINARY AS #3
OPEN "R" + ".MLT" FOR BINARY AS #4
FOR N = LD TO 1 STEP -1
SEEK #3, N: GET #3, N, PR$
SEEK #4, ER: PUT #4, ER, PR$
ER = ER + 1
NEXT N
CLOSE (4)
CLOSE (3)

'HERE ELIMINATE PARTIAL PRODUCTS
KILL "D.MLT"
FOR N = 0 TO 9
C$ = LTRIM$(STR$(N))
KILL C$ + ".MLT"
NEXT N
T2 = TIMER
PRINT "END"
PRINT
PRINT T2 - T1; "SEG"
PRINT "SOLUTION IN THE FILE: R.MLT "