Multiplication limitless Version #2

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

Multiplication limitless Version #2

Postby lrcvs » Dec 25, 2009 21:30

'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: 2955
Joined: Jan 15, 2007 20:44
Location: Australia

Postby Richard » Dec 26, 2009 0:18

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

Multiplication limitless Version #2

Postby lrcvs » Dec 26, 2009 5:25

OK!

Thanks.

lang = qb

Regards

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

Postby fxm » Dec 26, 2009 10:10

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

Postby lrcvs » Dec 26, 2009 11:08

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

Postby fxm » Dec 26, 2009 13:03

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

Postby lrcvs » Dec 26, 2009 18:25

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

Postby fxm » Dec 26, 2009 19:36

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

Postby lrcvs » Dec 26, 2009 20:06

Code: Select all

This program now works well. Ok!

Perfect in Qb 1.1,  QB 4.5 and FreBasic.

Thanks!!!

Here a friend.

Regards

Return to “Beginners”

Who is online

Users browsing this forum: MSN [Bot] and 25 guests