## Multiplication limitless Version #2

New to FreeBASIC? Post your questions here.
lrcvs
Posts: 576
Joined: Mar 06, 2008 19:27
Location: Spain

### Multiplication limitless Version #2

'This program does not work freebasic.

'Why?

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

'THE PROGRAM IS RIGHT NOW. OK (in Qbasic 4.5) !!!

'Program:

Code: Select all

`'Multiplication limitless Version #2'LRCVS 01.01.2010'(MU) Spain'..................................CLSPRINT "WAIT"T1 = TIMER'NUMBER OF DIGITS OF MULTIPLY AND MULTIPLIER WITHOUT LIMIT.NA = 50NB = 50'......................................................'HERE DELETE FILESOPEN "X" + ".MLT" FOR BINARY AS #1CLOSE (1)KILL "*.MLT"'......................................................'DO MULTIPLY >>> A AND DO MULTIPLIER >>> BFOR N = 1 TO 2IF N = 1 THEN F\$ = "A" + ".MLT": NN = NAIF 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\$          print x\$          x\$ = ""      NEXT N2   SEEK #1, N2   CLOSE (1)NEXT N'.....................................................'HERE DO THE PARTIAL MULTIPLICATIONSFOR K = 0 TO 9XX\$ = "": NUM\$ = "": Z\$ = "": ACU = 0: GG = NAC\$ = 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 >>> DACU = 0LT5 = 1LT6 = LT5'AQUI BUSCAMOS LOS ELEMENTOS DE BOPEN "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 = VAL(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)'HERE WE CREATE THE TRUE SOLUTION >>> RER = 1OPEN "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 PRODUCTSKILL "D.MLT"FOR N = 0 TO 9C\$ = LTRIM\$(STR\$(N))KILL C\$ + ".MLT"NEXT N     T2 = TIMERPRINTPRINT "END"PRINTPRINT T2 - T1; "SEC"PRINTPRINT "SOLUTION IN THE FILE: R.MLT "SLEEPEND`
Richard
Posts: 2999
Joined: Jan 15, 2007 20:44
Location: Australia
Set language with compiler option -lang qb or with #lang “qb”
Use the “code” button to put code in a code box. [/code]

Code: Select all

`#lang "qb"' Multiplication limitless Version #2' LRCVS 01.01.2010' (MU) Spain'..................................CLSPRINT "WAIT"T1 = TIMER'NUMBER OF DIGITS OF MULTIPLY AND MULTIPLIER WITHOUT LIMIT.NA = 50NB = 50'......................................................'HERE DELETE FILESOPEN "X" + ".MLT" FOR BINARY AS #1CLOSE (1)KILL "*.MLT"'......................................................'DO MULTIPLY >>> A AND DO MULTIPLIER >>> BFOR N = 1 TO 2IF N = 1 THEN F\$ = "A" + ".MLT": NN = NAIF N = 2 THEN F\$ = "B" + ".MLT": NN = NBOPEN F\$ FOR BINARY AS #1FOR N2 = 1 TO NNRANDOMIZE TIMERX\$ = LTRIM\$(STR\$(INT(RND * 10)))SEEK #1, N2: PUT #1, N2, X\$print x\$x\$ = ""NEXT N2SEEK #1, N2CLOSE (1)NEXT N'.....................................................'HERE DO THE PARTIAL MULTIPLICATIONSFOR K = 0 TO 9XX\$ = "": NUM\$ = "": Z\$ = "": ACU = 0: GG = NAC\$ = LTRIM\$(STR\$(K))OPEN C\$ + ".MLT" FOR BINARY AS #2OPEN "A" + ".MLT" FOR BINARY AS #1FOR N = 1 TO NASEEK #1, GG: GET #1, GG, X\$NUM\$ = X\$Z\$ = LTRIM\$(STR\$(ACU + (VAL(X\$) * VAL(C\$))))L = LEN(Z\$)ACU = 0IF 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 - 1NEXT NIF 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 >>> DACU = 0LT5 = 1LT6 = LT5'AQUI BUSCAMOS LOS ELEMENTOS DE BOPEN "B" + ".MLT" FOR BINARY AS #1OPEN "D" + ".MLT" FOR BINARY AS #3FOR JB = NB TO 1 STEP -1SEEK #1, JBGET #1, JB, X\$OPEN X\$ + ".MLT" FOR BINARY AS #2: LF = LOF(2): CLOSE (2)OPEN X\$ + ".MLT" FOR BINARY AS #2FOR KB = 1 TO LFSEEK #2, KBGET #2, , NUM\$SEEK #3, LT5GET #3, LT5, PR\$T\$ = ""T\$ = LTRIM\$(STR\$(ACU + VAL(NUM\$) + VAL(PR\$)))PR\$ = RIGHT\$(T\$, 1)ACU = 0IF LEN(T\$) > 1 THEN ACU = VAL(LEFT\$(T\$, LEN(T\$) - 1))SEEK #3, LT5: PUT #3, LT5, PR\$LT5 = LT5 + 1NEXT KBIF ACU <> 0 THEN PR\$ = LTRIM\$(STR\$(ACU)): PUT #3, LT5, PR\$CLOSE (2)LT6 = LT6 + 1LT5 = LT6ACU = 0NEXT JBCLOSE (3)CLOSE (1)OPEN "D" + ".MLT" FOR BINARY AS #3: LD = LOF(3): CLOSE (3)'HERE WE CREATE THE TRUE SOLUTION >>> RER = 1OPEN "D" + ".MLT" FOR BINARY AS #3OPEN "R" + ".MLT" FOR BINARY AS #4FOR N = LD TO 1 STEP -1SEEK #3, N: GET #3, N, PR\$SEEK #4, ER: PUT #4, ER, PR\$ER = ER + 1NEXT NCLOSE (4)CLOSE (3)'HERE ELIMINATE PARTIAL PRODUCTSKILL "D.MLT"FOR N = 0 TO 9C\$ = LTRIM\$(STR\$(N))KILL C\$ + ".MLT"NEXT NT2 = TIMERPRINTPRINT "END"PRINTPRINT T2 - T1; "SEC"PRINTPRINT "SOLUTION IN THE FILE: R.MLT "SLEEPEND `

Aborting due to runtime error 1 (illegal function call) at line 45 GET #1, GG, X\$
lrcvs
Posts: 576
Joined: Mar 06, 2008 19:27
Location: Spain

### Multiplication limitless Version #2

OK!

Thanks.

lang = qb

Regards

Atte.: lrcvs
fxm
Posts: 9560
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE
I have not tried to understand the program, but I think that the error is due to the call of "GET #..." with an empty string data buffer.
Consequently, I modified two lines, and I obtain a program which does not hang.
But is it working well?

Modified lines : 32 and 79

Code: Select all

`#lang "qb"' Multiplication limitless Version #2' LRCVS 01.01.2010' (MU) Spain'..................................ClsPrint "WAIT"T1 = Timer'NUMBER OF DIGITS OF MULTIPLY AND MULTIPLIER WITHOUT LIMIT.NA = 50NB = 50'......................................................'HERE DELETE FILESOpen "X" + ".MLT" For Binary As #1Close (1)Kill "*.MLT"'......................................................'DO MULTIPLY >>> A AND DO MULTIPLIER >>> BFor N = 1 To 2If N = 1 Then F\$ = "A" + ".MLT": NN = NAIf N = 2 Then F\$ = "B" + ".MLT": NN = NBOpen F\$ For Binary As #1For N2 = 1 To NNRandomize TimerX\$ = Ltrim\$(Str\$(Int(Rnd * 10)))Seek #1, N2: Put #1, N2, X\$Print x\$'**************************************************************x\$ = " " ' *********************** previous line : x\$ = "" ****'*************************************************************Next N2Seek #1, N2Close (1)Next N'.....................................................'HERE DO THE PARTIAL MULTIPLICATIONSFor K = 0 To 9XX\$ = "": NUM\$ = "": Z\$ = "": ACU = 0: GG = NAC\$ = Ltrim\$(Str\$(K))Open C\$ + ".MLT" For Binary As #2Open "A" + ".MLT" For Binary As #1For N = 1 To NASeek #1, GG: Get #1, GG, X\$NUM\$ = X\$Z\$ = Ltrim\$(Str\$(ACU + (Val(X\$) * Val(C\$))))L = Len(Z\$)ACU = 0If 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 - 1Next NIf 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 >>> DACU = 0LT5 = 1LT6 = LT5'AQUI BUSCAMOS LOS ELEMENTOS DE BOpen "B" + ".MLT" For Binary As #1Open "D" + ".MLT" For Binary As #3For JB = NB To 1 Step -1Seek #1, JBGet #1, JB, X\$Open X\$ + ".MLT" For Binary As #2: LF = Lof(2): Close (2)Open X\$ + ".MLT" For Binary As #2'*******************************************************PR\$ = " " '******************** added line *************'*******************************************************For KB = 1 To LFSeek #2, KBGet #2, , NUM\$Seek #3, LT5Get #3, LT5, PR\$T\$ = ""T\$ = Ltrim\$(Str\$(ACU + Val(NUM\$) + Val(PR\$)))PR\$ = Right\$(T\$, 1)ACU = 0If Len(T\$) > 1 Then ACU = Val(Left\$(T\$, Len(T\$) - 1))Seek #3, LT5: Put #3, LT5, PR\$LT5 = LT5 + 1Next KBIf ACU <> 0 Then PR\$ = Ltrim\$(Str\$(ACU)): Put #3, LT5, PR\$Close (2)LT6 = LT6 + 1LT5 = LT6ACU = 0Next JBClose (3)Close (1)Open "D" + ".MLT" For Binary As #3: LD = Lof(3): Close (3)'HERE WE CREATE THE TRUE SOLUTION >>> RER = 1Open "D" + ".MLT" For Binary As #3Open "R" + ".MLT" For Binary As #4For N = LD To 1 Step -1Seek #3, N: Get #3, N, PR\$Seek #4, ER: Put #4, ER, PR\$ER = ER + 1Next NClose (4)Close (3)'HERE ELIMINATE PARTIAL PRODUCTSKill "D.MLT"For N = 0 To 9C\$ = Ltrim\$(Str\$(N))Kill C\$ + ".MLT"Next NT2 = TimerPrintPRINT "END"PrintPRINT T2 - T1; "SEC"PrintPRINT "SOLUTION IN THE FILE: R.MLT "SleepEnd `
lrcvs
Posts: 576
Joined: Mar 06, 2008 19:27
Location: Spain
In Qbasic 4.5 works well, perfect, without mistakes.
But binary files freebasic not work well.

I have to find the difference between QBasic and freebasic to work well.

Thank you very much for your interest.
fxm
Posts: 9560
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE
I am very surprised because I just tested your original program in QB45 (and also in QB71 and VisualBasic DOS 1.0), and it always stops on the instruction :
Open X\$ + ".MLT" For Binary As #2
with a "bad file name" abort message.

This instruction being just after :
Get #1, JB, X\$
lrcvs
Posts: 576
Joined: Mar 06, 2008 19:27
Location: Spain
Now correct in freebasic, OK !!!

CLS
PRINT "Wait"
t1 = TIMER

na = 10 'number of digits of "A", limitless
nb = 10 'number of digits of "B", limitless

PRINT "A = "; na; " digits"
PRINT "B = "; nb; " digits"
PRINT "Multiplications = "; na * nb
PRINT "Number of digitos = "; na + nb
PRINT "Hour initial = "; TIME\$
'......................................................
'here delete files *.mlt
OPEN "X" + ".MLT" FOR BINARY AS #1
CLOSE (1)
KILL "*.MLT"
'......................................................
'generate >>> A
'generate >>> 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 val(right\$(ltrim\$(str\$(timer)),1))
x\$ = LTRIM\$(STR\$(INT(RND * 10)))
SEEK #1, N2: PUT #1, N2, x\$
NEXT N2
SEEK #1, N2
CLOSE (1)
NEXT n

'.....................................................
'here make the partial multiplications
FOR k = 0 TO 9
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\$
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

'......................................................
'hera CREAte the solution
acu = 0
lt5 = 1
LT6 = lt5

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 = VAL(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 "Hour end = "; TIME\$
PRINT "Diference = "; T2 - t1; "Sec"
PRINT "SOLUTION in the file: R.MLT "
sleep
end
fxm
Posts: 9560
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE
- Put your program code between '[code]' and '[/code]' (uncheck 'Disable BBCode in this post')
- Use the command button <Preview> to visualize your message before <Submit>

- I have always an error at the line 78 'GET #3, lt5, pr\$' :
'Aborting due to runtime error 1 (illegal function call) at line 78'
- Because (from my point of view) in the 'FOR KB = 1 TO Lf ... NEXT KB' for looping, the first time when KB=1, the string pr\$ is not initialized (pr\$="").
-Adding 'pr\$ = " "' (pr\$=space) just before this for looping, the program runs up to end.
lrcvs
Posts: 576
Joined: Mar 06, 2008 19:27
Location: Spain

Code: Select all

`This program now works well. Ok!Perfect in Qb 1.1,  QB 4.5 and FreBasic.Thanks!!!Here a friend.Regards`