Big factorial 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 factorial limitless

Post by lrcvs »

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

'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 d.encabezados(a$, b$)
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)
'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
'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

FUNCTION f.invcad$ (cad$)
'aqui invertimos una cadena de texto
'Reversing a string
'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
'do the addition
'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
Post Reply