Show Posts

This section allows you to view all posts made by this member. Note that you can only see posts made in areas you currently have access to.


Topics - david_uwi

Pages: [1]
1
QB64 Discussion / Possible error in INTEGER64 calculations
« on: September 25, 2021, 04:19:42 am »
Sorry I've not got the latest version, so if this has been sorted you can delete this.

DIM z AS _INTEGER64
z = 7 ^ 19
PRINT z

The answer should end in ..373143, but the above gives ...373144


2
Programs / multiplication of large numbers - fast method
« on: June 19, 2021, 01:59:27 pm »
Dealing with larger numbers without using strings. This time multiplication using a FFT (fast Fourier transform).
No idea how it works, but it does. Essentially it reduces multiplication to addition (which is much faster).
Here's the program - it squares a number. The key number is the N it specifies number size. Each number in the array is 2 digits ( 0-99 ) and is generated using  "randomize timer". N MUST BE a factor of 2 (that's the way FFTs work). Currently N=256 so it will generate a 512 digit number and square it.
It does not have to be squaring the two numbers can be different and it works just the same (but they have to both be multiples of 2 -you could zero fill to get round this).
Almost forgot to mention - it also uses imaginary numbers (the array AI contain the imaginary part).
Code: QB64: [Select]
  1.  
  2. 'The fourier transform I have translated from Fortran and I got it from IEEE transactions (March 1965).
  3.  
  4. TT = TIMER
  5. DEFSNG A-F, P-Z
  6. DEFINT G-O
  8. REM N is the number of two digit numbers to be loaded
  9. REM so the total number of digits is 2*N
  10. N = 256
  11. DIM AR(N * 4), AI(N * 4)
  12. DIM BR(N * 2 + 1) AS LONG, IC AS LONG
  13. M = INT(LOG(N) / LOG(2) + .5)
  14. PI = 3.141593
  15. FOR I = 1 TO N
  16.     AR(N - I + 1) = INT(RND * 100)
  18. PRINT: PRINT "Number to be squared"
  19. FOR I = N TO 1 STEP -1
  20.     Q$ = "0" + LTRIM$(STR$(AR(I)))
  21.     Q$ = RIGHT$(Q$, 2)
  22.     PRINT Q$;
  24. N = N * 4
  25. M = M + 2
  27. GOSUB CooleyTukey
  28. FOR I = 1 TO N
  29.     AR(I) = AR(I) / N
  30.     AI(I) = AI(I) / N
  31.     AR(I) = AR(I) * AR(I) - AI(I) * AI(I)
  32.     AI(I) = 2 * AR(I) * AI(I)
  34. GOSUB CooleyTukey
  35. FOR J = 1 TO N
  36.     AR(J) = AR(J) * N
  38. BR(1) = AR(1): BR(N / 2 + 1) = AR(N / 2 + 1)
  39. FOR I = 2 TO N / 2
  40.     K = N - I + 2
  41.     BR(I) = AR(I) + AR(K)
  43. IC = 0
  44. FOR I = 1 TO N / 2 + 1
  45.     BR(I) = BR(I) + IC
  46.     IC = BR(I) \ 100
  47.     BR(I) = BR(I) MOD 100
  49. PRINT "OUTPUT...."
  50. FOR I = N / 2 + 1 TO 1 STEP -1
  51.     Q$ = "0" + LTRIM$(STR$(BR(I)))
  52.     Q$ = RIGHT$(Q$, 2)
  53.     PRINT Q$;
  55. PRINT: PRINT "TIME TAKEN = "; TIMER - TT
  57. CooleyTukey:
  58. J = 1
  59. FOR I = 1 TO N - 1
  60.     IF I < J THEN
  61.         SWAP AR(I), AR(J)
  62.         SWAP AI(I), AI(J)
  63.     END IF
  64.     K = N / 2
  65.     WHILE K < J
  66.         J = J - K
  67.         K = K / 2
  68.     WEND
  69.     J = J + K
  71. FOR L = 1 TO M
  72.     LE = 2 ^ L
  73.     LE1 = LE / 2
  74.     UR = 1!: UI = 0!
  75.     ANG = PI / LE1
  76.     WR = COS(ANG): WI = SIN(ANG)
  77.     FOR J = 1 TO LE1
  78.         FOR I = J TO N STEP LE
  79.             IP = I + LE1
  80.             TR = AR(IP) * UR - AI(IP) * UI
  81.             ti = AR(IP) * UI + AI(IP) * UR
  82.             AR(IP) = AR(I) - TR
  83.             AI(IP) = AI(I) - ti
  84.             AR(I) = AR(I) + TR
  85.             AI(I) = AI(I) + ti
  86.         NEXT I
  87.         URT = UR * WR - UI * WI
  88.         UI = UR * WI + UI * WR
  89.         UR = URT
  90.     NEXT J
  93.  

3
Programs / More matrix fun
« on: May 19, 2021, 02:35:56 pm »
As we seem to be looking at matrix manipulation...
Here's a program I wrote nearly 30 years ago. It diagonalizes a real symmetric matrix. This gives (in maths-speak) the eigenvalues and eigenvectors. It''s only set up for a 3x3 (which is read from a data file in the order 1,1 2,2 3,3 1,2 1,3 2,3),
but it will do any size (but note the time taken is approx N cubed where N is the size of the matrix). Enjoy...
Code: QB64: [Select]
  1. 5 DEFINT I-N
  2. n2 = 3
  3. DIM e(n2, n2), X(n2, n2)
  4. OPEN "c:\cw1\mymatrix.txt" FOR INPUT AS #1
  5. INPUT #1, e(1, 1), e(2, 2), e(3, 3), e(1, 2), e(1, 3), e(2, 3)
  7. e(2, 1) = e(1, 2): e(3, 2) = e(2, 3): e(3, 1) = e(1, 3)
  8. PRINT "input matrix"
  9. FOR i = 1 TO n2
  10.     FOR J = 1 TO n2
  11.         PRINT USING "####.#####"; e(i, J);
  12.     NEXT J
  13.     PRINT
  16.  
  17. GOSUB 4000
  18. PRINT "EIGENVALUES"
  19. FOR i = 1 TO n2
  20.     FOR J = 1 TO n2
  21.         PRINT USING "####.#####"; e(i, J);
  22.     NEXT J
  23.     PRINT
  26. PRINT "EIGENVECTORS"
  27. FOR i = 1 TO n2
  28.     FOR J = 1 TO n2
  29.         PRINT USING "####.#####"; X(i, J);
  30.     NEXT J
  31.     PRINT
  33.  
  35. GOTO 130
  36. 100 PRINT "*********************"
  37. 110 PRINT "INCORRECT INPUT!!!!!"
  38. 120 PRINT "*********************"
  39. 130 END
  40. 4000 REM DIAGONALISATION USING JACOBI'S METHOD (D.S. 1993)
  41. 4005 M = (n2 * n2 - n2) / 2
  42. 4010 TRA = M * .00001
  43. FOR i = 1 TO n2
  44.     FOR J = 1 TO n2
  45.         X(i, J) = 0!
  46.     NEXT J
  47.     X(i, i) = 1!
  49. 4090 FOR L = 1 TO M * 10
  50.    4100 Q = 0: AM = -1
  51.    4110 FOR J = 1 TO n2 - 1
  52.        4120 FOR i = J + 1 TO n2
  53.            4130 Z = ABS(e(i, J))
  54.            4140 Q = Q + Z
  55.            4150 IF Z < AM GOTO 4170
  56.            4160 AM = Z: IX = i: JX = J
  57.        4170 NEXT i
  58.    4180 NEXT J
  59.    4190 IF Q < TRA THEN RETURN
  60.    4200 A1 = e(IX, IX) - e(JX, JX)
  61.    4210 A5 = e(IX, JX)
  62.    4220 IF ABS(A5) * 50 > ABS(A1) GOTO 4270
  63.    4230 A6 = 2 * A1 * A1 + 3 * A5 * A5
  64.    4240 C = -2 * A1 * A5 / A6
  65.    4250 s = 1 - A5 * A5 / A6
  66.    4260 GOTO 4320
  67.    4270 A2 = SQR(A1 * A1 + 4 * A5 * A5)
  68.    4280 IF A1 > 0 THEN A2 = -A2
  69.    4290 A3 = (A1 + A2) / (2 * A5)
  70.    4300 s = 1 / SQR(A3 * A3 + 1)
  71.    4310 C = A3 * s
  72.    4320 FOR J = 1 TO n2
  73.        4330 TM = e(JX, J) * s + e(IX, J) * C
  74.        4340 e(IX, J) = e(IX, J) * s - e(JX, J) * C
  75.        4350 e(JX, J) = TM
  76.        4360 TM = X(JX, J) * s + X(IX, J) * C
  77.        4370 X(IX, J) = X(IX, J) * s - X(JX, J) * C
  78.        4380 X(JX, J) = TM
  79.    4390 NEXT J
  80.    4400 FOR J = 1 TO n2
  81.        4410 TM = e(J, JX) * s + e(J, IX) * C
  82.        4420 e(J, IX) = e(J, IX) * s - e(J, JX) * C
  83.        4430 e(J, JX) = TM
  84.    4440 NEXT J
  85. 4450 NEXT L
  86. 4460 PRINT "CONVERGENCE FAILURE": CLOSE #1
  87. 4490 END

4
Programs / Codeword solver
« on: July 06, 2020, 07:18:43 am »
Code word is a type of puzzle that has appeared recently (maybe?).
It is like a crossword but there are no clues, instead the grid has numbers which correspond to letters of the alphabet (1 to 26 - not in order obviously).
You have to try to fit in words that will work in the grid and have one letter per number.
It is often difficult to get a start so I have written this program that will search a word list.
There are comment line at the beginning that explain the input.
As a hint longer words are often best as there are much fewer words with 10 letters than there are with 5 also the pattern of repeated and unique letters is larger. There is also a function to eliminate known letters, but this has not been tested.

Code: QB64: [Select]
  1. OPEN "c:\cw1\dictionary_english.dic" FOR INPUT AS #1
  2. DIM word$(320000)
  4. DIM q1 AS STRING * 1, q2 AS STRING * 1 'there are problems if these are not dimensioned
  5. DIM wdot(25) AS STRING * 1, wndot(25) AS STRING * 1, wndot1(25) AS STRING * 1
  6. DIM w2(7) AS STRING * 1, w3(7) AS STRING * 1, w4(7) AS STRING * 1, w5(7) AS STRING * 1
  7. DIM ex1 AS STRING * 1
  8. DIM r1$(20)
  9. SCREEN _NEWIMAGE(1000, 500, 2)
  10.  
  11. 'font1& = _LOADFONT("c:\windows\fonts\courbd.ttf", 20, "bold")  'courier bold
  12. 'font1& = _LOADFONT("c:\windows\fonts\times.ttf", 20, "bold") 'times bold
  13. font1& = _LOADFONT("c:\windows\fonts\cour.ttf", 20, "bold") 'courier regular
  14. _FONT font1& 'lets have a monospaced font - lines up better
  15.  
  16. 'either put in the numbers in the puzzle separated by "," OR
  17. 'put in "." for unknowns and the numbers 2,3,4,5 for duplicates
  18. '.2334.4N52.54 will work as will 13,8,21,21,4,16,4,N,3,8,10,3,4 [the N was a given letter]
  19. 'both will give differentiate
  20.  
  21. 'when letters are given (or known) they can be excluded by loading an exclusion list
  22. 'input ! followed by the letters, this can be added to by ! [more letters] and reset by just putting in !
  23.  
  24. ' **************************all duplicates MUST be put in**********************
  25. 'for crosswords this will not work!!!
  26. PRINT "loading word list....please wait"
  27. FOR i = 1 TO 319378
  28.     INPUT #1, word$(i) 'load list into RAM it is much faster
  33.    200 PRINT "input word  ";
  34.     LINE INPUT a$
  35.     f$ = a$
  36.     IF INSTR(a$, ",") <> 0 THEN GOSUB longform
  37.     IF LEFT$(a$, 1) = "!" THEN
  38.         IF LEN(a$) = 1 THEN ex$ = ""
  39.         IF LEN(a$) > 1 THEN ex$ = RIGHT$(a$, LEN(a$) - 1) + ex$
  40.         lex1 = LEN(ex$)
  41.         IF lex1 > 0 THEN PRINT "exclusion list  "; ex$
  42.         IF lex1 = 0 THEN PRINT "exclusion list reset"
  43.         GOTO 200
  44.     END IF
  45.     x1 = LEN(a$)
  46.     z$ = a$
  47.     'z$ original input string
  48.     'a$ input string with 2,3,..replaced by dots
  49.     'b$ test string from word list
  50.     FOR i = 1 TO x1
  51.         IF ASC(MID$(a$, i, 1)) < 56 THEN MID$(a$, i, 1) = "."
  52.     NEXT i
  53.     exq$ = ""
  54.     FOR i = 1 TO x1
  55.         IF MID$(a$, i, 1) <> "." THEN exq$ = exq$ + MID$(a$, i, 1)
  56.     NEXT i
  57.     IF a$ = "end" THEN EXIT DO
  58.     FOR ii = 1 TO 319378
  59.         b$ = word$(ii)
  60.         IF LEN(b$) = x1 THEN
  61.             FOR i = 1 TO x1
  62.                 q1 = MID$(a$, i, 1)
  63.                 IF q1 <> "." THEN
  64.                     q2 = MID$(b$, i, 1)
  65.                     IF q1 <> q2 THEN 20
  66.                 END IF
  67.             NEXT i
  68.             k2 = 0
  69.             FOR i = 1 TO x1
  70.                 q1 = MID$(z$, i, 1)
  71.                 IF q1 = "2" THEN
  72.                     k2 = k2 + 1
  73.                     w2(k2) = MID$(b$, i, 1)
  74.                 END IF
  75.             NEXT i
  76.             k3 = 0
  77.             FOR i = 1 TO x1
  78.                 q1 = MID$(z$, i, 1)
  79.                 IF q1 = "3" THEN
  80.                     k3 = k3 + 1
  81.                     w3(k3) = MID$(b$, i, 1)
  82.                 END IF
  83.             NEXT i
  84.             k4 = 0
  85.             FOR i = 1 TO x1
  86.                 q1 = MID$(z$, i, 1)
  87.                 IF q1 = "4" THEN
  88.                     k4 = k4 + 1
  89.                     w4(k4) = MID$(b$, i, 1)
  90.                 END IF
  91.             NEXT i
  92.             k5 = 0
  93.             FOR i = 1 TO x1
  94.                 q1 = MID$(z$, i, 1)
  95.                 IF q1 = "5" THEN
  96.                     k5 = k5 + 1
  97.                     w5(k5) = MID$(b$, i, 1)
  98.                 END IF
  99.             NEXT i
  100.  
  101.             kdot = 0
  102.             FOR i = 1 TO x1
  103.                 q1 = MID$(z$, i, 1)
  104.                 IF q1 = "." THEN
  105.                     kdot = kdot + 1
  106.                     wdot(kdot) = MID$(b$, i, 1)
  107.                 END IF
  108.             NEXT i
  109.             kndot = 0
  110.             FOR i = 1 TO x1
  111.                 q1 = MID$(z$, i, 1)
  112.                 IF q1 <> "." THEN
  113.                     kndot = kndot + 1
  114.                     wndot(kndot) = MID$(b$, i, 1)
  115.                 END IF
  116.             NEXT i
  117.             kndot1 = 0
  118.             FOR i = 1 TO x1
  119.                 q1 = MID$(a$, i, 1)
  120.                 IF q1 <> "." THEN
  121.                     kndot1 = kndot1 + 1
  122.                     wndot1(kndot1) = MID$(a$, i, 1)
  123.                 END IF
  124.             NEXT i
  125.  
  126.             'PRINT k2; k3; w2$(1): INPUT sa$
  127.             'make sure all dots are different
  128.             IF k2 <> 0 THEN
  129.                 FOR i = 1 TO k2 - 1
  130.                     IF w2(i) <> w2(i + 1) THEN 20
  131.                 NEXT i
  132.             END IF
  133.  
  134.             IF k3 <> 0 THEN
  135.                 FOR i = 1 TO k3 - 1
  136.                     IF w3(i) <> w3(i + 1) THEN 20
  137.                 NEXT i
  138.             END IF
  139.             IF k4 <> 0 THEN
  140.                 FOR i = 1 TO k4 - 1
  141.                     IF w4(i) <> w4(i + 1) THEN 20
  142.                 NEXT i
  143.             END IF
  144.             IF k5 <> 0 THEN
  145.                 FOR i = 1 TO k5 - 1
  146.                     IF w5(i) <> w5(i + 1) THEN 20
  147.                 NEXT i
  148.             END IF
  149.  
  150.             'now checking if any of the dots are the same as inputted letters
  151.             IF kdot <> 0 THEN
  152.                 FOR i = 1 TO kdot - 1
  153.                     FOR j = i + 1 TO kdot
  154.  
  155.                         IF wdot(i) = wdot(j) THEN 20
  156.                     NEXT j
  157.                 NEXT i
  158.             END IF
  159.             FOR i = 1 TO kdot
  160.                 FOR j = 1 TO kndot
  161.  
  162.                     IF wdot(i) = wndot(j) THEN 20
  163.                 NEXT j
  164.             NEXT i
  165.             'now checking for duplicates in repeated letters
  166.             x2 = INSTR(z$, "2")
  167.             x3 = INSTR(z$, "3")
  168.             x4 = INSTR(z$, "4")
  169.             x5 = INSTR(z$, "5")
  170.             IF x3 <> 0 THEN
  171.                 IF MID$(b$, x2, 1) = MID$(b$, x3, 1) THEN 20
  172.             END IF
  173.             IF x4 <> 0 THEN
  174.                 IF MID$(b$, x2, 1) = MID$(b$, x4, 1) THEN 20
  175.                 IF MID$(b$, x3, 1) = MID$(b$, x4, 1) THEN 20
  176.             END IF
  177.             IF k5 <> 0 THEN
  178.                 IF MID$(b$, x2, 1) = MID$(b$, x5, 1) THEN 20
  179.                 IF MID$(b$, x3, 1) = MID$(b$, x5, 1) THEN 20
  180.                 IF MID$(b$, x4, 1) = MID$(b$, x5, 1) THEN 20
  181.  
  182.             END IF
  183.             'now check if any of the given letters are the same as multiples
  184.             IF x2 <> 0 THEN
  185.                 FOR j = 1 TO kndot1
  186.                     IF MID$(b$, x2, 1) = wndot1(j) THEN 20
  187.                 NEXT j
  188.             END IF
  189.             IF x3 <> 0 THEN
  190.                 FOR j = 1 TO kndot1
  191.                     IF MID$(b$, x3, 1) = wndot1(j) THEN 20
  192.                 NEXT j
  193.             END IF
  194.             IF x4 <> 0 THEN
  195.                 FOR j = 1 TO kndot1
  196.                     IF MID$(b$, x4, 1) = wndot1(j) THEN 20
  197.                 NEXT j
  198.             END IF
  199.             IF x5 <> 0 THEN
  200.                 FOR j = 1 TO kndot1
  201.                     IF MID$(b$, x5, 1) = wndot1(j) THEN 20
  202.                 NEXT j
  203.             END IF
  204.  
  205.  
  206.  
  207.             'use exclusion list if loaded
  208.             IF lex1 > 0 THEN
  209.                 FOR ie = 1 TO lex1
  210.                     ex1 = MID$(ex$, ie, 1)
  211.                     IF INSTR(exq$, ex1) = 0 THEN 'lets not remove known letters
  212.                         IF INSTR(b$, ex1) > 0 THEN 20
  213.                     END IF
  214.                 NEXT ie
  215.             END IF
  216.             PRINT b$,
  217.         END IF
  218.    20 NEXT ii
  219.  
  220.     PRINT ""
  223. longform:
  224. p0 = 1: kk = 0
  225. r1$ = ""
  226. r2$ = ""
  228.     kk = kk + 1
  229.     p1 = INSTR(p0, a$, ",")
  230.     IF p1 = 0 THEN
  231.         r1$(kk) = MID$(f$, p0, LEN(f$) - p0 + 1)
  232.         EXIT DO
  233.     END IF
  234.     r1$(kk) = MID$(f$, p0, p1 - p0)
  235.     p0 = p1 + 1
  237. FOR nn = 1 TO kk
  238.     'PRINT r1$(nn); ASC(r1$(nn))
  239. NEXT nn
  240. u1 = 0
  241. FOR ii = 1 TO kk
  242.     IF r1$(ii) = "." THEN 100
  243.     IF LEN(r1$(ii)) = 3 THEN 100
  244.     IF ASC(r1$(ii)) < 58 THEN
  245.         FOR jj = ii + 1 TO kk
  246.             IF r1$(jj) = "." THEN 120
  247.             IF LEN(r1$(jj)) = 3 THEN 120
  248.             IF ASC(r1$(jj)) < 58 THEN
  249.                 'PRINT r1$(ii); r1$(jj), ii; jj; LEN(r1$(jj)): INPUT sa$
  250.                 IF r1$(ii) = r1$(jj) THEN r1$(jj) = CHR$(50 + u1) + CHR$(50 + u1) + CHR$(50 + u1): u2 = 99
  251.             END IF
  252.  
  253.         120 NEXT jj
  254.         IF u2 = 0 THEN r1$(ii) = "."
  255.         IF u2 = 99 THEN
  256.             u2 = 0
  257.             r1$(ii) = CHR$(50 + u1) + CHR$(50 + u1) + CHR$(50 + u1)
  258.             u1 = u1 + 1
  259.         END IF
  260.     END IF
  261. 100 NEXT ii
  262. f$ = ""
  263. FOR ii = 1 TO kk
  264.     IF LEN(r1$(ii)) = 3 THEN r1$(ii) = LEFT$(r1$(ii), 1)
  265.  
  266.     f$ = f$ + r1$(ii)
  267. NEXT ii
  268. a$ = f$
  269. 'PRINT a$, LEN(a$)
  270.  
  272.  
  273. 'why does this get slower after several searches???
  274. 'changing q1$ to string*1 seems to solve it!

5
Programs / Joining the points of regular polygons
« on: February 04, 2020, 07:01:11 pm »
What is the minimum length of lines required to join the points of a regular polygon?
3 (triangle) is fairly easy, but what about a square (or a pentagon)?
As I was going through my old programs I found this (below) to do a triangle (iteratively).
The puzzle is normally phrased as a road building exercise - what is the minimum length of road needed to join four towns which happen to be at the vertices of a square.
So as a challenge can you do the same for 4 towns as I have done for 3. If that is too easy try 5.

Code: QB64: [Select]
  2. nn = 3
  3. rsummin = 10000: m = 1: n = 200
  5. WHILE m < 1000
  6.     x1 = (RND * 360)
  7.     y1 = (RND * 300)
  8.     IF m > 2 THEN
  9.         x1 = xa - n / m + RND * 2 * n / m
  10.         y1 = ya - n / m + RND * 2 * n / m
  11.     END IF
  12.     m = m + .1
  13.     x(1) = 60: y(1) = 300
  14.     x(2) = 360: y(2) = 300
  15.     x(3) = 210: y(3) = 40
  16.     FOR i = 1 TO nn
  17.         r(i) = SQR((x1 - x(i)) ^ 2 + (y1 - y(i)) ^ 2)
  18.     NEXT i
  19.     rsum = r(1) + r(2) + r(3)
  20.     IF rsum < rsummin THEN
  21.         rsummin = rsum
  22.         xa = x1: xb = x2: ya = y1: yb = y2
  23.         m = m + 1
  24.         CLS
  25.         FOR i = 1 TO nn
  26.             CIRCLE (x(i), y(i)), 10
  27.             LINE (x1, y1)-(x(i), y(i))
  28.         NEXT i
  29.         CIRCLE (x1, y1), 5
  30.         LOCATE 1, 1
  31.         q1 = SQR((x(1) - x(3)) ^ 2 + (y(1) - y(3)) ^ 2)
  32.         q2 = SQR((x(2) - x(3)) ^ 2 + (y(2) - y(3)) ^ 2)
  33.         PRINT rsummin * 20 / (q1 + q2)
  34.         tt = TIMER
  35.         WHILE TIMER - tt < .2: WEND
  36.     END IF
  38. LOCATE 3, 1
  39. PRINT "Finished"
  40. xx$ = INPUT$(1)
  41.  

6
QB64 Discussion / Slow string handling
« on: July 15, 2019, 03:29:30 pm »
I've just had a problem with the following program- here is the relevent subroutine.
Code: QB64: [Select]
  1. addr = 32768
  3.     k = k + 1
  4.     IF k > addr THEN EXIT DO
  5.     FOR i = 1 TO 32 STEP 2
  6.         xi = ASC(MID$(x(k), i, 1)) + ASC(MID$(x(k), i + 1, 1)) * 256
  7.         PRINT xi;
  8.     NEXT i
  9.     PRINT k
  11.  

The problem is it takes just over 10 minutes to run on version 1.2 of QB64
On version 0.954 it takes 23 seconds.
That is it is 26x slower on the newer version!
I would have put this in "bugs" but it does not seem I can post there.

7
Programs / Which planet is closest to earth?
« on: March 25, 2019, 10:41:24 am »
https://physicstoday.scitation.org/do/10.1063/PT.6.3.20190312a/full/

I came across this article which claims that on average mercury is actually closest to the earth.
If you analyse the geometry it is actually fairly obvious.
Anyway they made quite a big deal about their calculation so I thought why not try it in QBasic.

Code: QB64: [Select]
  1. pi = 3.141593
  2. rmer = 57
  3. rven = 108 'average distance
  4. re = 150 'from the sun 1000 km
  5. rmar = 228
  6. FOR th = 1 TO 360000 'angle in degrees (1000 years)
  7.     thr = th * (pi / 180)
  8.     a1 = (re - rven * COS(thr)) ^ 2
  9.     a2 = (-rven * SIN(thr)) ^ 2
  10.     d = SQR(a1 + a2)
  11.     dcum = dcum + d
  12.     j = j + 1
  13.     thr1 = thr * 5.044 'synodic period adjustment
  14.     a1 = (re - rmer * COS(thr1)) ^ 2
  15.     a2 = (-rmer * SIN(thr1)) ^ 2
  16.     d1 = SQR(a1 + a2)
  17.     dcum1 = dcum1 + d1
  18.     thr2 = thr * .749 'synodic period adjustment
  19.     a1 = (re - rmar * COS(thr2)) ^ 2
  20.     a2 = (-rmar * SIN(thr2)) ^ 2
  21.     d2 = SQR(a1 + a2)
  22.     dcum2 = dcum2 + d2
  23.     IF d < d1 AND d < d2 THEN v = v + 1
  24.     IF d1 < d AND d1 < d2 THEN m = m + 1
  25.     IF d2 < d1 AND d2 < d THEN mar = mar + 1
  26.  
  27. NEXT th
  28. PRINT "average distances (au)  mercury    venus    mars"
  29. PRINT SPACE$(22); dcum1 / j / re; dcum / j / re; dcum2 / j / re
  30. tot = (m + v + mar) / 100
  31. PRINT "percent of time closest  mercury    venus    mars"
  32. PRINT SPACE$(25); m / tot; v / tot; mar / tot

8
QB64 Discussion / QB64 is getting slower?
« on: August 30, 2018, 12:56:22 pm »
I am transfering data using a serial COM port and the newer versions of qb64 are slow (and cause the data to get corrupted). The new version was downloaded 12 FEB 2018.
My older version QB64 ver0.954 from 2012 is much faster and the data transfer is good (I am working at 9600 baud, but changing this seems to make no difference).

Pages: [1]