## Big factorial limitless

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

Moderators: Pete, Mods

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

### Big factorial limitless

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 ()

'This program, calculates the factorial of a number
'without limit, with results accurate.
'If the number is greater than 100 will slow.
'The result is displayed.

CLS
INPUT "Factorial = "; v
CLS
b\$ = LTRIM\$(STR\$(1))
FOR n = 1 TO v
LOCATE 1, 1: PRINT n - 1
a\$ = LTRIM\$(STR\$(n))
CALL b.store(a\$, "a")
CALL b.store(b\$, "b")
CALL c.pizarra
CALL e.multiplicacion(a\$, b\$)
CALL g.suma
OPEN "i", #3, "r"
10 :
IF EOF(3) THEN GOTO 20
INPUT #3, r\$
GOTO 10
20 :
CLOSE (3)

'Aqui limpiamos el resultado
'we clean the result
b\$ = ""
lr = LEN(r\$)
gg = 0
FOR qq = 1 TO lr
ss\$ = MID\$(r\$, qq, 1)
IF VAL(ss\$) > 0 THEN gg = 1
IF gg = 1 THEN b\$ = b\$ + MID\$(r\$, qq, 1)
NEXT qq
CLS
NEXT n
PRINT "Factorial de "; n - 1; " = "; b\$
end

SUB b.store (cad\$, n\$)
'aqui guardamos los datos en un fichero
'Here we keep the data in a file
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
'init the blackboard
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
'write data in the end file
'variables
'lt :num,longitud total del multiplicando + multiplicador
'l\$ :tex, cadena patron
lt = 0
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)
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
'do the multiplication
'variables
'lt : num, longitud total del multiplicando + multiplicador
'rp : num, resultado parcial
'acum\$ : tex, 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 = 0
lt = LEN(a\$) + LEN(b\$) + 1
l\$ = STRING\$(lt, " ")
c\$ = ""
d\$ = ""
e\$ = ""
ct1 = 1
acum\$ = ""
OPEN "i", #2, "b"
WHILE EOF(2) <> -1
INPUT #2, b\$
OPEN "i", #1, "a"
WHILE EOF(1) <> -1
INPUT #1, a\$
c\$ = LTRIM\$(STR\$((VAL(a\$) * VAL(b\$)) + VAL(acum\$)))
IF EOF(1) <> -1 THEN d\$ = d\$ + RIGHT\$(c\$, 1)
IF EOF(1) = -1 THEN d\$ = d\$ + f.invcad\$(c\$)
acum\$ = LTRIM\$(STR\$(VAL(LEFT\$(c\$, LEN(c\$) - 1))))
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\$ = ""
c\$ = ""
d\$ = ""
e\$ = ""
ct1 = ct1 + 1
WEND
CLOSE (2)
END SUB

'aqui invertimos una cadena de texto
'Reversing a string
'variables
FOR cad = lcad TO 1 STEP -1
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\$: tex, acumulador de las que nos llevamos
'k: num, contador de filas
'w\$: tex, resultado final
'r\$: tex, registro

'Aqui calculamos el ancho del registro
'we estimate the width of record
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\$ = ""
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 + VAL(acus\$)))
WEND
w\$ = w\$ + RIGHT\$(m\$, 1)
acus\$ = LTRIM\$(STR\$(VAL(LEFT\$(m\$, LEN(m\$) - 1))))
CLOSE (3)
st = 0
NEXT p

'Aqui escribimos el resultado en el fichero
'we write the result in the end file
OPEN "a", #3, "r"
WRITE #3, " " + RIGHT\$(f.invcad(w\$), an - 1)
CLOSE (3)
END SUB