1億～1兆までの素数の個数を数える計算時間　14分21.37秒

 投稿者：たろさ  投稿日：2021年11月 8日(月)10時54分52秒
  !30n+k篩  8スレッド     2021/07/10
!
!#4360
!
!Paract BASIC 30n+k篩 Ver.12  500兆  5/9  (1E8) step
!
DECLARE STRUCTURE struct1: 1 OF NUMERIC
DECLARE STRUCTURE struct2: 1 OF NUMERIC(1536277)
DECLARE STRUCTURE struct4: 3 OF NUMERIC
DECLARE SHARED sha OF struct2
DECLARE MESSAGE mes2 OF struct4
DECLARE MESSAGE mes3 OF struct4
DECLARE MESSAGE mes4 OF struct4
DECLARE MESSAGE mes5 OF struct4
DECLARE MESSAGE mes6 OF struct4
DECLARE MESSAGE mes7 OF struct4
DECLARE MESSAGE mes8 OF struct4
DECLARE MESSAGE met2 OF struct1
DECLARE MESSAGE met3 OF struct1
DECLARE MESSAGE met4 OF struct1
DECLARE MESSAGE met5 OF struct1
DECLARE MESSAGE met6 OF struct1
DECLARE MESSAGE met7 OF struct1
DECLARE MESSAGE met8 OF struct1
PARACT PART1
OPTION ARITHMETIC NATIVE
LET t1=TIME
LET k=24494963
LET k3=1536277
DECLARE EXTERNAL SUB prime
CALL prime(k)
WAIT EVENT Ok5
LET S=1E8  !110E11  !pi(1E12),37607912018
LET E=1E10 !111E11  !pi(1E11),4118054813    (1E10)455052511
LET ST=1E8

START Part2
START PART3
START PART4
START PART5
START PART6
START PART7
START PART8
SEND TO mes2 FROM S,E,ST
SEND TO mes3 FROM S,E,ST
SEND TO mes4 FROM S,E,ST
SEND TO mes5 FROM S,E,ST
SEND TO mes6 FROM S,E,ST
SEND TO mes7 FROM S,E,ST
SEND TO mes8 FROM S,E,ST
LET TOTAL=5761455
DECLARE EXTERNAL FUNCTION cprime
!DECLARE NUMERIC X,Y,Z

FOR I=S TO E-ST STEP ST
   LET t0=TIME
   LET L=cprime(I,I+ST/8)
   RECEIVE FROM met2 TO X
   RECEIVE FROM met3 TO Y
   RECEIVE FROM met4 TO Z
   RECEIVE FROM met5 TO X1
   RECEIVE FROM met6 TO Y1
   RECEIVE FROM met7 TO Z1
   RECEIVE FROM met8 TO X2
   LET L=L+X+Y+Z+X1+Y1+Z1+X2
   LET TOTAL=TOTAL+L
   !IF MOD(I+ST,1E9)=0 THEN PRINT (I+ST)/1E9;TOTAL
   !PRINT TOTAL
   PRINT (I+ST)/1E8;TOTAL;L;
   LET TM=TIME-t0
   PRINT USING"###.###":TM;
   PRINT "秒"
NEXT I
LET TM=TIME-t1
PRINT USING"#####.##":TM;
PRINT "秒"
END PARACT

PARACT PART2
OPTION ARITHMETIC NATIVE
RECEIVE FROM mes2 TO S,E,ST
DECLARE EXTERNAL FUNCTION cprime
DECLARE NUMERIC L
FOR I=S TO E-ST STEP ST
   LET L=cprime(I+ST/8,I+ST/4)
   SEND TO met2 FROM L
NEXT I
END PARACT

PARACT PART3
OPTION ARITHMETIC NATIVE
RECEIVE FROM mes3 TO S,E,ST
DECLARE EXTERNAL FUNCTION cprime
DECLARE NUMERIC L
FOR I=S TO E-ST STEP ST
   LET L=cprime(I+ST/4,I+3*ST/8)
   SEND TO met3 FROM L
NEXT I
END PARACT

PARACT PART4
OPTION ARITHMETIC NATIVE
RECEIVE FROM mes4 TO S,E,ST
DECLARE EXTERNAL FUNCTION cprime
DECLARE NUMERIC L
FOR I=S TO E-ST STEP ST
   LET L=cprime(I+3*ST/8,I+ST/2)
   SEND TO met4 FROM L
NEXT I
END PARACT

PARACT PART5
OPTION ARITHMETIC NATIVE
RECEIVE FROM mes5 TO S,E,ST
DECLARE EXTERNAL FUNCTION cprime
DECLARE NUMERIC L
FOR I=S TO E-ST STEP ST
   LET L=cprime(I+ST/2,I+5*ST/8)
   SEND TO met5 FROM L
NEXT I
END PARACT

PARACT PART6
OPTION ARITHMETIC NATIVE
RECEIVE FROM mes6 TO S,E,ST
DECLARE EXTERNAL FUNCTION cprime
DECLARE NUMERIC L
FOR I=S TO E-ST STEP ST
   LET L=cprime(I+5*ST/8,I+3*ST/4)
   SEND TO met6 FROM L
NEXT I
END PARACT

PARACT PART7
OPTION ARITHMETIC NATIVE
RECEIVE FROM mes7 TO S,E,ST
DECLARE EXTERNAL FUNCTION cprime
DECLARE NUMERIC L
FOR I=S TO E-ST STEP ST
   LET L=cprime(I+3*ST/4,I+7*ST/8)
   SEND TO met7 FROM L
NEXT I
END PARACT

PARACT PART8
OPTION ARITHMETIC NATIVE
RECEIVE FROM mes8 TO S,E,ST
DECLARE EXTERNAL FUNCTION cprime
DECLARE NUMERIC L
FOR I=S TO E-ST STEP ST
   LET L=cprime(I+7*ST/8,I+ST)
   SEND TO met8 FROM L
NEXT I
END PARACT

EXTERNAL FUNCTION cprime(k4,k6)
OPTION ARITHMETIC NATIVE
DECLARE NUMERIC G(1536277) !素数
GET FROM sha TO G

DIM B(8)
DATA 1,7,11,13,17,19,23,29
MAT READ B
LET Q=30
LET U=IP(k6/Q)
LET W=IP(k4/Q)
LET kd=IP(U/7+7)
LET kp=IP(SQR(k6))

DIM D(0 TO U-W)

LET COUNT=0
FOR r=1 TO 8
   LET rr=B(r)
   MAT D = ZER
   LET MD=0
   LET t=4

   DO
      LET cca=0
      LET x=G(t)
      IF x^2>k6 THEN EXIT DO
      LET G1=INT(W/x)
      IF MOD(x-rr,Q)=0 THEN
         LET y=(x-rr)/Q
         GOTO 800
      ELSE

         FOR i=1 TO 7
            LET rv=B(i)
            IF MOD(x*rv+rr,Q)=0 THEN
               LET y=-(x*rv+rr)/Q
               GOTO 800
               EXIT FOR
            END IF
         NEXT i
      END IF

800       IF x*G1+y < W THEN
             DO
                LET G1=G1+1
                IF x*G1+y => W THEN EXIT DO
             LOOP
          END IF

          FOR f=G1 TO kd
             IF x*f+y < W THEN  GOTO 900
             IF x*f+y>U THEN GOTO 1000
             LET D(x*f+y-W)=1
900       NEXT f
1000       LET t=t+1

        LOOP

        FOR n=0 TO U-W
           LET ST=n+W
           IF D(n)=0 THEN
              IF Q*ST+rr>k4 AND Q*ST+rr<k6 THEN LET COUNT=COUNT+1
           END IF
        NEXT n
        LET L=L+6
     NEXT r
     LET cprime=COUNT
  END FUNCTION

  EXTERNAL SUB prime(k)
     OPTION ARITHMETIC NATIVE
     DECLARE NUMERIC G(1536277) !素数
     !エラトステネスの篩
     LET Fu=5633
     LET Fm=739
     DIM P(Fu)
     DIM A(Fm)
     MAT P=ZER
     MAT A=ZER
     LET A(1)=2
     LET H1=1
     FOR I=3 TO SQR(Fu) STEP 2
        IF P(I)=0 THEN
           FOR J=I*I TO Fu STEP I
              LET P(J)=1
           NEXT J
        END IF
     NEXT I
     FOR I=3 TO Fu STEP 2
        IF P(I)=0 THEN
           LET H1=H1+1
           LET A(H1)=I
        END IF
     NEXT I

     LET Q=6
     LET k7=k          !篩の計算範囲
     LET k5=IP(k7/Q)+1
     DIM Au(k5),Av(k5)

     MAT Au = ZER     !(6*n-1)
     MAT Av = ZER     !(6*n+1)

     FOR n=3 TO Fm
        LET Pu=A(n)
        IF Pu^2>=k THEN EXIT FOR
        IF MOD(Pu+1,Q)=0 THEN !(6*n-1)
           LET ru=(Pu+1)/Q
           FOR i=1 TO k5
              IF Pu*i+ru>k5 THEN EXIT FOR
              LET Au(Pu*i+ru)=1
           NEXT i
        END IF

        IF MOD(Pu-1,Q)=0 THEN
           LET ru=(Pu-1)/Q
           FOR i=1 TO k5
              IF Pu*i-ru>k5 THEN EXIT FOR
              LET Au(Pu*i-ru)=1
           NEXT i
        END IF

        IF MOD(Pu+1,Q)=0 THEN !(6*n+1)
           LET ru=(Pu+1)/Q
           FOR i=1 TO k5
              IF Pu*i-ru>k5 THEN EXIT FOR
              LET Av(Pu*i-ru)=1
           NEXT i
        END IF

        IF MOD(Pu-1,Q)=0 THEN
           LET ru=(Pu-1)/Q
           FOR i=1 TO k5
              IF Pu*i+ru>k5 THEN EXIT FOR
              LET Av(Pu*i+ru)=1
           NEXT i
        END IF
     NEXT n

     LET G(1)=2
     LET G(2)=3
     LET cz=2
     FOR n=1 TO k5
        IF 6*n-1>k7 THEN GOTO 100
        IF Au(n)=0 THEN
           LET cz=cz+1
           LET G(cz)=6*n-1
        END IF
100    IF 6*n+1>k7 THEN EXIT FOR
       IF Av(n)=0  THEN
          LET cz=cz+1
          LET G(cz)=6*n+1
       END IF
    NEXT n
    PUT TO sha FROM G
    SIGNAL Ok5
END SUB


初期設定は　LET E=1E10 !    (1E10)455052511

計算結果

2  11078937  5317482    .156秒
3  16252325  5173388    .141秒
4  21336326  5084001    .152秒
5  26355867  5019541    .142秒
6  31324703  4968836    .168秒
7  36252931  4928228    .145秒
8  41146179  4893248    .163秒
9  46009215  4863036    .164秒
10  50847534  4838319    .165秒

途中省略

90  411523195  4363605    .167秒
91  415885628  4362433    .162秒
92  420243162  4357534    .170秒
93  424603409  4360247    .170秒
94  428958595  4355186    .162秒
95  433311792  4353197    .163秒
96  437663672  4351880    .179秒
97  442014876  4351204    .168秒
98  446362736  4347860    .170秒
99  450708777  4346041    .160秒
100  455052511  4343734    .175秒
   16.48秒     Lazarus fpc-3.2.2-win32

----------------------------------------

2  11078937  5317482    .082秒
3  16252325  5173388    .050秒
4  21336326  5084001    .067秒
5  26355867  5019541    .061秒
6  31324703  4968836    .070秒
7  36252931  4928228    .072秒
8  41146179  4893248    .083秒
9  46009215  4863036    .052秒
10  50847534  4838319    .071秒

途中省略

90  411523195  4363605    .079秒
91  415885628  4362433    .062秒
92  420243162  4357534    .088秒
93  424603409  4360247    .054秒
94  428958595  4355186    .082秒
95  433311792  4353197    .085秒
96  437663672  4351880    .076秒
97  442014876  4351204    .055秒
98  446362736  4347860    .086秒
99  450708777  4346041    .086秒
100  455052511  4343734    .065秒
    7.25秒     Lazarus fpc-3.2.2-win64

動作環境

Intel Core i9 -11900K　自作パソコン

Windows Version
Microsoft Windows 10 (10.0) Professional 64-bit

Paract BASIC Ver. 2.1.2.4 Rev.2   (2021.06.19)

Lazarus fpc-3.2.2-win64
lazarus-2.2.0RC1-fpc-3.2.2-win64.exe               2021-07-08 199.7 MB
lazarus-2.2.0RC1-fpc-3.2.2-cross-i386-win32-win64.exe 2021-07-08  55.1 MB
 

戻る