fb:porticula NoPaste
Primzahlentest Nr. 3
Uploader: | gast |
Datum/Zeit: | 28.08.2005 10:06:12 |
'Autor: Tomtitom
'Etwas abgewandeltes Programm, zum ermitteln von Primzahlen von Rich Geldreich, der es wiederum aus einen Buch geklaut hat
'grob geht der Algorithmus so, dass es ein System in den Lücken zwischen den Primzahlen gibt, welches ausgenutzt wird
'Seltsamerweise läuft es in QB super schnell und in FB super lahm
'Priority queue
DIM HeapQ(1000) AS LONG
DIM HeapQ1(1000) AS LONG
DIM HeapQ2(1000) AS LONG
DIM prim(16000) AS LONG
prim(0)=3
prim(1)=5
DIM SHARED n AS LONG,anz AS INTEGER
DIM t AS LONG, i AS INTEGER, j AS INTEGER
DIM Q AS LONG, Q1 AS LONG, Q2 AS LONG
DIM TQ AS LONG, TQ1 AS LONG
DIM u AS LONG
bisdahin = 175000 'bis dahin sollen die Primzahlen gesucht werden
anz = 2
n = 5
d = 2
r = 1
t = 25
HeapQ(1) = 25
HeapQ1(1) = 10
HeapQ2(1) = 30
tt#=TIMER
DO
DO
Q = HeapQ(1)
Q1 = HeapQ1(1)
Q2 = HeapQ2(1)
TQ = Q + Q1
TQ1 = Q2 - Q1
'***Insert Heap(1) into priority queue
i = 1
DO
j = i * 2
IF j <= r THEN
IF j < r THEN
IF HeapQ(j) > HeapQ(j + 1) THEN j = j + 1
END IF
IF TQ > HeapQ(j) THEN
HeapQ(i) = HeapQ(j)
HeapQ1(i) = HeapQ1(j)
HeapQ2(i) = HeapQ2(j)
i = j
ELSE
EXIT DO
END IF
ELSE
EXIT DO
END IF
LOOP
HeapQ(i) = TQ
HeapQ1(i) = TQ1
HeapQ2(i) = Q2
'***
LOOP UNTIL n <= Q
DO WHILE n < Q
prim(anz) = n
'locate 1,1: print "letzte Primzahl: "; prim(anz),anz
'sleep
anz = anz + 1
n = n + d
d = 6 - d
LOOP
LOCATE 1,1: PRINT "letzte Primzahl: "; prim(anz-1)
IF n = t THEN
u = prim(r+2)
t = u * u
'***Find location for new entry
j = r + 1
DO
i = j \ 2
IF i = 0 THEN EXIT DO
IF HeapQ(i) <= t THEN EXIT DO
HeapQ(j) = HeapQ(i)
HeapQ1(j) = HeapQ1(i)
HeapQ2(j) = HeapQ2(i)
j = i
LOOP
'***
HeapQ(j) = t
IF (u MOD 3) = 2 THEN
HeapQ1(j) = 2 * u
ELSE
HeapQ1(j) = 4 * u
END IF
HeapQ2(j) = 6 * u
r = r + 1
END IF
n = n + d
d = 6 - d
LOOP UNTIL inkey$=chr$(27) OR n > bisdahin
PRINT TIMER -tt#
SLEEP