Big multiplication of number integegrs, limitless

Announce and discuss the progress of your various programming-related projects...programs, games, websites, tutorials, libraries...anything!

Moderators: Pete, Mods

Post Reply
lrcvs
Veteran
Posts: 58
Joined: Mon Mar 10, 2008 9:28 am

Big multiplication of number integegrs, limitless

Post by lrcvs » Sun May 04, 2008 5:36 pm

DECLARE SUB a.inicio (a$, b$)
DECLARE SUB b.store (cad$, n$)
DECLARE SUB c.pizarra ()
DECLARE SUB d.encabezados (a$, b$)
DECLARE SUB e.multiplicacion (a$, b$)
DECLARE SUB g.suma ()
DECLARE FUNCTION f.invcad$ (cad$)

'DANGER, READ THIS
'This program only makes a multiplication.
'The length of the result can be maximum of = > 500 digits .
'This result is in a called file " R".
'In order to see it, to use a text visualizer.

CALL a.inicio(a$, b$)
CALL b.store(a$, "a")
CALL b.store(b$, "b")
CALL c.pizarra
CALL d.encabezados(a$, b$)
CALL e.multiplicacion(a$, b$)
CALL g.suma

SUB a.inicio (a$, b$)
CLS
INPUT "Numero de muplicaciones "; s
CLS
a$ = ""
b$ = ""
FOR n = 1 TO s
RANDOMIZE TIMER
a$ = a$ + LTRIM$(STR$(INT(RND * 9)))
NEXT n
FOR n = 1 TO s
RANDOMIZE TIMER
b$ = b$ + LTRIM$(STR$(INT(RND * 9)))
NEXT n

END SUB

SUB b.store (cad$, n$)
'aqui guardamos los datos en un fichero
OPEN "o", #1, n$
FOR m = LEN(cad$) TO 1 STEP -1
WRITE #1, MID$(cad$, m, 1)
NEXT m
CLOSE (1)
END SUB

SUB c.pizarra
'iniciamos la pizzara
OPEN "a", #3, "r"
WRITE #3, ""
CLOSE (3)
KILL "r"
END SUB

SUB d.encabezados (a$, b$)
'aqui escribimos los datos en el fichero final
'variables
'lt :num,longitud total del multiplicando + multiplicador
'l$ :tex, cadena patron
lt = LEN(a$) + LEN(b$) + 1
'escribimos el multiplicando
l$ = STRING$(lt, " ")
OPEN "a", #3, "r"
MID$(l$, lt - LEN(a$) + 1) = a$
WRITE #3, l$
CLOSE (3)
'escribimos el multiplicador
l$ = STRING$(lt, " ")
OPEN "a", #3, "r"
MID$(l$, lt - LEN(b$) - 1) = "x " + b$
WRITE #3, l$
CLOSE (3)
END SUB

SUB e.multiplicacion (a$, b$)
'aqui hacemos la multiplicacion
'variables
'lt : num, longitud total del multiplicando + multiplicador
'rp : num, resultado parcial
'acum : num, acumulador de las multiplicaciones
'ls : tex, cadena patron
'c$ : tex, cadena de texto del resultado parcial
'd$ : tex, valor de las unidades
'e$ : tex, valor de lo que nos llevamos
lt = LEN(a$) + LEN(b$) + 1
l$ = STRING$(lt, " ")
c$ = ""
d$ = ""
e$ = ""
ct1 = 1
acum = 0
OPEN "i", #2, "b"
WHILE EOF(2) <> -1
INPUT #2, b$
OPEN "i", #1, "a"
WHILE EOF(1) <> -1
INPUT #1, a$
rp = (VAL(a$) * VAL(b$)) + acum
c$ = LTRIM$(STR$(rp))
IF EOF(1) <> -1 THEN d$ = d$ + RIGHT$(c$, 1)
IF EOF(1) = -1 THEN d$ = d$ + f.invcad$(c$)
e$ = LEFT$(c$, LEN(c$) - 1)
acum = VAL(e$)
WEND
CLOSE (1)
MID$(l$, lt - ct1 - LEN(d$) + 2) = f.invcad$(d$)
OPEN "a", #3, "r"
WRITE #3, l$
CLOSE (3)
l$ = STRING$(lt, " ")
acum = 0
c$ = ""
d$ = ""
e$ = ""
ct1 = ct1 + 1
WEND
CLOSE (2)
END SUB

FUNCTION f.invcad$ (cad$)
'aqui invertimos una cadena de texto
'variables
'lcad : num, longitud cadena entrante
'cadtem$ : tex, acumulador cadena temporal
lcad = LEN(cad$)
cadtem$ = ""
FOR cad = lcad TO 1 STEP -1
cadtem$ = cadtem$ + MID$(cad$, cad, 1)
NEXT cad
f.invcad$ = cadtem$
END FUNCTION

SUB g.suma
'Aqui sumamos la multiplicacion

'Variables
'cf: num, contador del numero de filas
'an: num, longitud del registro
'st: num, resultado parcial
'acus: num, acumulador de las que nos llevamos
'k: num, contador de filas
'w$: tex, resultado final
'r$: tex, registro

'Aqui calculamos el ancho del registro

cf = 0
OPEN "i", #3, "r"
WHILE EOF(3) <> -1
INPUT #3, r$
cf = cf + 1
an = LEN(r$)
WEND
cf = cf - 2
CLOSE (3)

w$ = ""
st = 0
acus = 0
FOR p = 1 TO an
k = 0
OPEN "i", #3, "r"
WHILE EOF(3) <1> 2 THEN st = st + VAL(MID$(r$, an - p + 1, 1))
IF k > 2 THEN m$ = LTRIM$(STR$(st + acus))
WEND
'COLOR 10: LOCATE cf + 3, an - p + 1: PRINT RIGHT$(m$, 1); : COLOR 7
w$ = w$ + RIGHT$(m$, 1)
acus = VAL(LEFT$(m$, LEN(m$) - 1))
CLOSE (3)
st = 0
NEXT p

'Aqui escribimos el resultado en el fichero
OPEN "a", #3, "r"
WRITE #3, " " + RIGHT$(f.invcad(w$), an - 1)
CLOSE (3)
CLS
PRINT "La solucion a esta multiplicacion se encuentra en un fichero de texto llamado: R"
END SUB
Last edited by lrcvs on Wed May 14, 2008 3:56 pm, edited 2 times in total.

User avatar
BadMrBox
Veteran
Posts: 86
Joined: Tue Feb 28, 2006 12:19 pm

Post by BadMrBox » Tue May 06, 2008 6:17 pm

Please start to use the [ code ] tag when you post your codesnippets.

Post Reply