Multiplication limitless Version #2

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

Multiplication limitless Version #2

Post by lrcvs »

'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

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

'......................................................
'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$
          print x$
          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 = 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 >>> R
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
PRINT "END"
PRINT
PRINT T2 - T1; "SEC"
PRINT
PRINT "SOLUTION IN THE FILE: R.MLT "
SLEEP
END
Richard
Posts: 3096
Joined: Jan 15, 2007 20:44
Location: Australia

Post by Richard »

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
'..................................
CLS
PRINT "WAIT"
T1 = TIMER
'NUMBER OF DIGITS OF MULTIPLY AND MULTIPLIER WITHOUT LIMIT.
NA = 50
NB = 50

'......................................................
'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$
print x$
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 = 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 >>> R
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
PRINT "END"
PRINT
PRINT T2 - T1; "SEC"
PRINT
PRINT "SOLUTION IN THE FILE: R.MLT "
SLEEP
END
 
Aborting due to runtime error 1 (illegal function call) at line 45 GET #1, GG, X$
lrcvs
Posts: 578
Joined: Mar 06, 2008 19:27
Location: Spain

Multiplication limitless Version #2

Post by lrcvs »

OK!

Thanks.

lang = qb

Regards

Atte.: lrcvs
fxm
Moderator
Posts: 12081
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Post by fxm »

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
'..................................
Cls
Print "WAIT"
T1 = Timer
'NUMBER OF DIGITS OF MULTIPLY AND MULTIPLIER WITHOUT LIMIT.
NA = 50
NB = 50

'......................................................
'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$
Print x$
'**************************************************************
x$ = " " ' *********************** previous line : 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
'*******************************************************
PR$ = " " '******************** added line *************
'*******************************************************
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 >>> R
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
PRINT "END"
Print
PRINT T2 - T1; "SEC"
Print
PRINT "SOLUTION IN THE FILE: R.MLT "
Sleep
End
 
lrcvs
Posts: 578
Joined: Mar 06, 2008 19:27
Location: Spain

Post by lrcvs »

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
Moderator
Posts: 12081
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Post by fxm »

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: 578
Joined: Mar 06, 2008 19:27
Location: Spain

Post by lrcvs »

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
Moderator
Posts: 12081
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Post by fxm »

- 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: 578
Joined: Mar 06, 2008 19:27
Location: Spain

Post by lrcvs »

Code: Select all

This program now works well. Ok!

Perfect in Qb 1.1,  QB 4.5 and FreBasic.

Thanks!!!

Here a friend.

Regards
Post Reply