素数個数関数

 投稿者:しばっち  投稿日:2017年 4月19日(水)20時51分27秒
  Paract BASICによるマルチスレッド化プログラムに成功しました。(※4スレッド)
エラトステネスの篩により素数個数を求めています。
まだよくわからない点もあり、改良の余地はあるか思いますが
とりあえず動きましたのでご参考までに。
サンプルプログラムがまだまだ欲しいところです。

非マルチスレッド/マルチスレッド化との対比率は209.3秒/64.3秒≒3.25倍
となりましたので、マルチスレッド化プログラムの効果は十分大きいと思います。
なお、VC++2017 + OPEN MPによるマルチスレッドdllによる実行(※8スレッド)では29秒でした。

DECLARE STRUCTURE STRUCT1: 2 OF NUMERIC
DECLARE STRUCTURE STRUCT2: 2 OF NUMERIC
DECLARE STRUCTURE STRUCT3: 2 OF NUMERIC
DECLARE STRUCTURE STRUCT4: 1 OF NUMERIC
DECLARE STRUCTURE STRUCT5: 1 OF NUMERIC
DECLARE STRUCTURE STRUCT6: 1 OF NUMERIC

DECLARE SHARED buff1 OF STRUCT1
DECLARE SHARED buff2 OF STRUCT2
DECLARE SHARED buff3 OF STRUCT3
DECLARE SHARED buff4 OF STRUCT4
DECLARE SHARED buff5 OF STRUCT5
DECLARE SHARED buff6 OF STRUCT6

PARACT PART1
OPTION ARITHMETIC NATIVE
DECLARE NUMERIC S,E,ST,I,TOTAL,L1,L2,L3,L4
LET S=1000000001
LET E=2000000000
LET ST=10000000
LET TOTAL=0
DECLARE EXTERNAL FUNCTION ERATOS
FOR I=S TO E STEP ST
   PUT TO BUFF1 FROM I,ST
   START PART2
   PUT TO BUFF2 FROM I,ST
   START PART3
   PUT TO BUFF3 FROM I,ST
   START PART4
   LET L1=ERATOS(I,I+ST/4-1)
   WAIT EVENT ok2
   GET FROM BUFF4 TO L2
   WAIT EVENT ok3
   GET FROM BUFF5 TO L3
   WAIT EVENT ok4
   GET FROM BUFF6 TO L4
   LET TOTAL=TOTAL+L1+L2+L3+L4
   PRINT I;"~";I+ST-1;":";L1+L2+L3+L4;TOTAL
NEXT I
END PARACT

PARACT PART2
OPTION ARITHMETIC NATIVE
DECLARE NUMERIC I,ST
DECLARE NUMERIC L2
DECLARE EXTERNAL FUNCTION ERATOS
GET FROM BUFF1 TO I,ST
LET L2=ERATOS(I+ST/4,I+ST/2-1)
SIGNAL ok2
PUT TO BUFF4 FROM L2
END PARACT

PARACT PART3
OPTION ARITHMETIC NATIVE
DECLARE NUMERIC I,ST
DECLARE NUMERIC L3
DECLARE EXTERNAL FUNCTION ERATOS
GET FROM BUFF2 TO I,ST
LET L3=ERATOS(I+ST/2,I+3*ST/4-1)
SIGNAL ok3
PUT TO BUFF5 FROM L3
END PARACT

PARACT PART4
OPTION ARITHMETIC NATIVE
DECLARE NUMERIC I,ST
DECLARE NUMERIC L4
DECLARE EXTERNAL FUNCTION ERATOS
GET FROM BUFF3 TO I,ST
LET L4=ERATOS(I+3*ST/4,I+ST-1)
SIGNAL ok4
PUT TO BUFF6 FROM L4
END PARACT

EXTERNAL  FUNCTION ERATOS(N,M)
OPTION ARITHMETIC NATIVE
DECLARE NUMERIC I,NN,J,COUNT
DIM X(0 TO M-N+1)
LET COUNT=0
FOR I=3 TO SQR(M) STEP 2
   IF MOD(N,I)=0 THEN
      LET NN=N
   ELSE
      LET NN=INT(N/I+1)*I
   END IF
   IF N<=I THEN
      IF X(NN-N)=0 THEN LET NN=NN+I
   END IF
   FOR J=NN TO M STEP I
      LET X(J-N)=1
   NEXT J
NEXT I
FOR J=N TO M
   IF MOD(J,2)=1 THEN
      IF X(J-N)=0 THEN
         LET COUNT=COUNT+1
      END IF
   END IF
NEXT J
LET ERATOS=COUNT
END FUNCTION
 

Re: 素数個数関数

 投稿者:しばっち  投稿日:2017年 4月29日(土)09時26分34秒
  > No.4313[元記事へ]

WAIT EVENTとSIGNAL文を外すと何故か動きました。
私もエラトステネスの篩を素数リストで篩ってみました。
VC++2017 + OPEN MPより速くなってしまいました。驚きです。

DECLARE STRUCTURE STRUCT1: 1 OF NUMERIC
DECLARE STRUCTURE STRUCT2: NUMERIC(10000)
DECLARE SHARED SHA OF STRUCT2
DECLARE MESSAGE MES2 OF STRUCT1
DECLARE MESSAGE MES3 OF STRUCT1
DECLARE MESSAGE MES4 OF STRUCT1
DECLARE MESSAGE MES5 OF STRUCT1
DECLARE MESSAGE MES6 OF STRUCT1
DECLARE MESSAGE MES7 OF STRUCT1
DECLARE MESSAGE MES8 OF STRUCT1

PARACT PART1
OPTION ARITHMETIC NATIVE
DECLARE EXTERNAL SUB PRIME
DECLARE EXTERNAL FUNCTION ERATOS
DECLARE NUMERIC L,X1,X2,X3,X4,X5,X6,X7
DECLARE NUMERIC A(10000)
LET S=1E9+1
LET E=2E9
LET ST=1E7
LET TOTAL=0
LET T=TIME
CALL PRIME(INT(SQR(E)),A)
PUT TO SHA FROM A
START PART2
PUT TO SHA FROM A
START PART3
PUT TO SHA FROM A
START PART4
PUT TO SHA FROM A
START PART5
PUT TO SHA FROM A
START PART6
PUT TO SHA FROM A
START PART7
PUT TO SHA FROM A
START PART8
FOR I=S TO E STEP ST
   LET L=ERATOS(I,I+ST/8-1,A)
   !   WAIT EVENT READY2
   RECEIVE FROM MES2 TO X1
   !   WAIT EVENT READY3
   RECEIVE FROM MES3 TO X2
   !   WAIT EVENT READY4
   RECEIVE FROM MES4 TO X3
   !   WAIT EVENT READY5
   RECEIVE FROM MES5 TO X4
   !   WAIT EVENT READY6
   RECEIVE FROM MES6 TO X5
   !   WAIT EVENT READY7
   RECEIVE FROM MES7 TO X6
   !   WAIT EVENT READY8
   RECEIVE FROM MES8 TO X7
   !   SIGNAL Ok2
   !   SIGNAL Ok3
   !   SIGNAL Ok4
   !   SIGNAL Ok5
   !   SIGNAL Ok6
   !   SIGNAL Ok7
   !   SIGNAL Ok8
   LET L=L+X1+X2+X3+X4+X5+X6+X7
   LET TOTAL=TOTAL+L
   PRINT I;"~";I+ST-1;L;TOTAL
NEXT I
PRINT TIME-T
END PARACT

PARACT PART2
OPTION ARITHMETIC NATIVE
DECLARE EXTERNAL FUNCTION ERATOS
DECLARE NUMERIC L
DECLARE NUMERIC A(10000)
LET S=1E9+1
LET E=2E9
LET ST=1E7
GET FROM SHA TO A
FOR I=S TO E STEP ST
   LET L=ERATOS(I+ST/8,I+ST/4-1,A)
   SEND TO MES2 FROM L
   !   WAIT EVENT Ok2
   !   SIGNAL READY2
NEXT I
END PARACT

PARACT PART3
OPTION ARITHMETIC NATIVE
DECLARE EXTERNAL FUNCTION ERATOS
DECLARE NUMERIC L
DECLARE NUMERIC A(10000)
LET S=1E9+1
LET E=2E9
LET ST=1E7
GET FROM SHA TO A
FOR I=S TO E STEP ST
   LET L=ERATOS(I+ST/4,I+3*ST/8-1,A)
   SEND TO MES3 FROM L
   !   WAIT EVENT Ok3
   !   SIGNAL ready3
NEXT I
END PARACT

PARACT PART4
OPTION ARITHMETIC NATIVE
DECLARE EXTERNAL FUNCTION ERATOS
DECLARE NUMERIC L
DECLARE NUMERIC A(10000)
LET S=1E9+1
LET E=2E9
LET ST=1E7
GET FROM SHA TO A
FOR I=S TO E STEP ST
   LET L=ERATOS(I+3*ST/8,I+ST/2-1,A)
   SEND TO MES4 FROM L
   !   WAIT EVENT Ok4
   !   SIGNAL ready4
NEXT I
END PARACT

PARACT PART5
OPTION ARITHMETIC NATIVE
DECLARE EXTERNAL FUNCTION ERATOS
DECLARE NUMERIC L
DECLARE NUMERIC A(10000)
LET S=1E9+1
LET E=2E9
LET ST=1E7
GET FROM SHA TO A
FOR I=S TO E STEP ST
   LET L=ERATOS(I+ST/2,I+5*ST/8-1,A)
   SEND TO MES5 FROM L
   !   WAIT EVENT Ok5
   !   SIGNAL READY5
NEXT I
END PARACT

PARACT PART6
OPTION ARITHMETIC NATIVE
DECLARE EXTERNAL FUNCTION ERATOS
DECLARE NUMERIC L
DECLARE NUMERIC A(10000)
LET S=1E9+1
LET E=2E9
LET ST=1E7
GET FROM SHA TO A
FOR I=S TO E STEP ST
   LET L=ERATOS(I+5*ST/8,I+3*ST/4-1,A)
   SEND TO MES6 FROM L
   !   WAIT EVENT Ok6
   !   SIGNAL ready6
NEXT I
END PARACT

PARACT PART7
OPTION ARITHMETIC NATIVE
DECLARE EXTERNAL FUNCTION ERATOS
DECLARE NUMERIC L
DECLARE NUMERIC A(10000)
LET S=1E9+1
LET E=2E9
LET ST=1E7
GET FROM SHA TO A
FOR I=S TO E STEP ST
   LET L=ERATOS(I+3*ST/4,I+7*ST/8-1,A)
   SEND TO MES7 FROM L
   !   WAIT EVENT Ok7
   !   SIGNAL ready7
NEXT I
END PARACT

PARACT PART8
OPTION ARITHMETIC NATIVE
DECLARE EXTERNAL FUNCTION ERATOS
DECLARE NUMERIC L
DECLARE NUMERIC A(10000)
LET S=1E9+1
LET E=2E9
LET ST=1E7
GET FROM SHA TO A
FOR I=S TO E STEP ST
   LET L=ERATOS(I+7*ST/8,I+ST-1,A)
   SEND TO MES8 FROM L
   !   WAIT EVENT Ok8
   !   SIGNAL ready8
NEXT I
END PARACT

EXTERNAL FUNCTION ERATOS(N,M,A())
OPTION ARITHMETIC NATIVE
DIM X(0 TO M-N+1)
LET COUNT=0
LET I=1
DO
   LET I=I+1
   LET P=A(I)
   IF P*P>=M OR P=-1 THEN EXIT DO
   IF MOD(N,P)=0 THEN
      LET NN=N
   ELSE
      LET NN=INT(N/P+1)*P
   END IF
   FOR J=NN TO M STEP P
      LET X(J-N)=1
   NEXT J
LOOP
IF MOD(N,2)=0 THEN LET N=N+1
LET MODE=0
SELECT CASE MODE
CASE 0
   FOR J=N TO M STEP 2
      IF X(J-N)=0 THEN
         LET COUNT=COUNT+1
      END IF
   NEXT J
CASE 1
   FOR J=N TO M-2 STEP 2
      IF X(J-N)=0 AND X(J-N+2)=0 THEN !'双子素数
         LET COUNT=COUNT+1
      END IF
   NEXT J
CASE 2
   FOR J=N TO M-4 STEP 2
      IF X(J-N)=0 AND X(J-N+4)=0 THEN !'いとこ素数
         LET COUNT=COUNT+1
      END IF
   NEXT J
CASE 3
   FOR J=N TO M-6 STEP 2
      IF X(J-N)=0 AND X(J-N+6)=0 THEN !'セクシー素数
         LET COUNT=COUNT+1
      END IF
   NEXT J
CASE 4
   FOR J=N TO M-6 STEP 2
      IF X(J-N)=0 AND X(J-N+2)=0 AND X(J-N+6)=0 OR X(J-N)=0 AND X(J-N+4)=0 AND X(J-N+6)=0 THEN !'三つ子素数
         LET COUNT=COUNT+1
      END IF
   NEXT J
CASE 5
   LET N1=INT((N-11)/30+1)*30+11
   FOR J=N1 TO M-8 STEP 30
      IF X(J-N)=0 AND X(J-N+2)=0 AND X(J-N+6)=0 AND X(J-N+8)=0 THEN !'四つ子素数
         LET COUNT=COUNT+1
      END IF
   NEXT J
END SELECT
LET ERATOS=COUNT
END FUNCTION

EXTERNAL SUB PRIME(K,A())
OPTION ARITHMETIC NATIVE
DIM P(K)
LET H1=1
LET A(H1)=2
FOR I=3 TO SQR(K) STEP 2
   IF P(I)=0 THEN
      FOR J=I*I TO K STEP I
         LET P(J)=1
      NEXT J
   END IF
NEXT I
FOR I=3 TO K STEP 2
   IF P(I)=0 THEN
      LET H1=H1+1
      LET A(H1)=I
   END IF
NEXT I
LET H1=H1+1
LET A(H1)=-1
END SUB
 

Re: 素数個数関数

 投稿者:たろさ  投稿日:2017年 4月29日(土)18時32分35秒
  > No.4326[元記事へ]

しばっちさんへのお返事です。

> WAIT EVENTとSIGNAL文を外すと何故か動きました。
> 私もエラトステネスの篩を素数リストで篩ってみました。
> VC++2017 + OPEN MPより速くなってしまいました。驚きです。

素晴らしいプログラムを有難うございます。毎度参考にしています。

実は、エラトステネスの篩を素数リストで篩って成功したのは、初めてです。

昨年から失敗続きでした。素数カウントの精度については未確認です。

下記のプログラムで1~1000億まで確認です。1~1兆は、何故か? 誤差が出ます。なお計算時間は5時間です。

最小値の設定です。
LET S=1
LET E=1E11
LET TOTAL=0 2は排除されますが、1をカウントしてます。

------------------------------------
LET S=99E10+1 !pi(1E12),37607912018
LET E=1E12
これは、うまくいく。

なので、まだ暫定版です。私のPARACT PART1~4 実験では、10兆間を計算するのは難してです。

EXTERNAL  SUB sqprime ですが、1億step用に作成しましたので、

LET B(c)=i+1

1~1E15 までは確認しました。

並列プログラムについては、
DECLARE STRUCTURE struct3: 1 OF NUMERIC(1 TO 100001)

ここの配列をPARACT PART1 から設定できると、6n+k篩と同じにできるのですが、残念です。

VC++2017 + OPEN MP 500兆までまもなく計算完了します。スレッド自動割り当ては便利です。

8コアCPUが無いので、8スレッドのプログラムを4コアCPUで、これから試してみます。15.17秒

確かに、驚きます。

失礼しました。

Intel 4790K Devil's Canyon S-spec SR219 CPU Overclocking Report


ここ見ると、#of Threads 8


! Sieve of Eratosthenes 1兆  4/28
DECLARE STRUCTURE struct1: 1 OF NUMERIC
DECLARE STRUCTURE struct2: 1 OF NUMERIC(78505)
DECLARE STRUCTURE struct3: 1 OF NUMERIC(1 TO 100001)
DECLARE STRUCTURE struct4: 4 OF NUMERIC
DECLARE SHARED sha OF struct2
DECLARE SHARED shb OF struct3
DECLARE MESSAGE mes2 OF struct1
DECLARE MESSAGE mes3 OF struct1
DECLARE MESSAGE mes4 OF struct1
DECLARE MESSAGE mes5 OF struct4
DECLARE MESSAGE mes6 OF struct4
DECLARE MESSAGE mes7 OF struct4

PARACT PART1
OPTION ARITHMETIC NATIVE
LET k=1000117
LET k3=78505
DECLARE EXTERNAL SUB prime
CALL prime(k,k3)
WAIT EVENT Ok5
LET S=99E10+1 !pi(1E12),37607912018
LET E=1E12    !pi(1E11),4118054813
LET ST=1E7
LET cc=(S-1)/ST+1
DECLARE EXTERNAL SUB sqprime
CALL sqprime(1,100001,k3)
DECLARE NUMERIC B(1 TO 100001)
WAIT EVENT Ok6
GET FROM shb TO B
START Part2
START PART3
START PART4
SEND TO mes5 FROM S,E,ST,CC
SEND TO mes6 FROM S,E,ST,CC
SEND TO mes7 FROM S,E,ST,CC
LET TOTAL=37245934597!1e7=664579,1e9=50847534
DECLARE EXTERNAL FUNCTION ERATOS
!DECLARE NUMERIC X,Y,Z
FOR I=S TO E STEP ST
   LET k2=B(cc)
   LET L=ERATOS(I,I+ST/4-1,k2)
   RECEIVE FROM mes2 TO X
   RECEIVE FROM mes3 TO Y
   RECEIVE FROM mes4 TO Z
   LET L=L+X+Y+Z
   LET TOTAL=TOTAL+L
   PRINT I-1;I+ST-1;TOTAL;L
   !PRINT TOTAL
   LET cc=cc+1
NEXT I
END PARACT

PARACT PART2
OPTION ARITHMETIC NATIVE
DECLARE NUMERIC B(1 TO 100001)
GET FROM shb TO B
RECEIVE FROM mes5 TO X,Y,Z,G
LET S=X
LET E=Y
LET ST=Z
DECLARE EXTERNAL FUNCTION ERATOS
DECLARE NUMERIC L
LET cc=G
FOR I=S TO E STEP ST
   LET k2=B(cc)
   LET cc=cc+1
   LET L=ERATOS(I+ST/4,I+ST/2-1,k2)
   SEND TO mes2 FROM L
NEXT I
END PARACT

PARACT PART3
OPTION ARITHMETIC NATIVE
DECLARE NUMERIC B(1 TO 100001)
GET FROM shb TO B
RECEIVE FROM mes6 TO X,Y,Z,G
LET S=X
LET E=Y
LET ST=Z
DECLARE EXTERNAL FUNCTION ERATOS
DECLARE NUMERIC L
LET cc=G
FOR I=S TO E STEP ST
   LET k2=B(cc)
   LET cc=cc+1
   LET L=ERATOS(I+ST/2,I+3*ST/4-1,k2)
   SEND TO mes3 FROM L
NEXT I
END PARACT

PARACT PART4
OPTION ARITHMETIC NATIVE
DECLARE NUMERIC B(1 TO 100001)
GET FROM shb TO B
RECEIVE FROM mes7 TO X,Y,Z,G
LET S=X
LET E=Y
LET ST=Z
DECLARE EXTERNAL FUNCTION ERATOS
DECLARE NUMERIC L
LET cc=G
FOR I=S TO E STEP ST
   LET k2=B(cc)
   LET cc=cc+1
   LET L=ERATOS(I+3*ST/4,I+ST-1,k2)
   SEND TO mes4 FROM L
NEXT I
END PARACT

EXTERNAL FUNCTION ERATOS(N,M,k2)
OPTION ARITHMETIC NATIVE
DECLARE NUMERIC G(78505) !素数
GET FROM sha TO G
DIM X(0 TO M-N+1)
LET COUNT=0
FOR I=2 TO k2 STEP 1
   LET P=G(I)
   IF MOD(N,P)=0 THEN
      LET NN=N
   ELSE
      LET NN=INT(N/P+1)*P
   END IF
   IF N<=I THEN LET NN=NN+P
   FOR J=NN TO M STEP P
      LET X(J-N)=1
      !PRINT i;p;j;n;j-n
   NEXT J
NEXT I
FOR J=N TO M STEP 2
   IF X(J-N)=0 THEN
      LET COUNT=COUNT+1
   END IF
NEXT J
LET ERATOS=COUNT
SIGNAL Ok7
END FUNCTION

EXTERNAL SUB prime(k,k2)
OPTION ARITHMETIC NATIVE
DECLARE NUMERIC G(78505) !素数
!エラトステネスの篩
LET Fu=1013 !5633
LET Fm=170  !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 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

  EXTERNAL  SUB sqprime(SA,SB,k2)
    OPTION ARITHMETIC NATIVE
    DECLARE NUMERIC G(78505) !素数
    GET FROM sha TO G
    DECLARE NUMERIC B(1 TO 100001)
    LET x=1E7
    LET x1=x
    FOR i=1 TO k2-1
       LET v=G(i)^2
       LET vi=G(i+1)^2
       LET vv=vi-v
       IF x =< v THEN
          CALL sqrp(1)
          IF vv>=x1 THEN
             LET vt=INT(vv/x1)
             CALL sqrp(vt)
          END IF
       END IF
    NEXT i

    SUB sqrp(vo)
       FOR ns=1 TO vo
          LET C=C+1
          LET X=X+x1
          IF C>=SA AND SB>=C THEN
             LET B(c)=i+1
          END IF
       NEXT ns
    END SUB
    PUT TO shb FROM B
    SIGNAL Ok6
END SUB

http://blogs.yahoo.co.jp/donald_stinger

 

戻る