|
投稿者：しばっち
投稿日：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
|
|
|
|
投稿者：しばっち
投稿日：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
|
|
|
|
投稿者：たろさ
投稿日：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
|
|
|
戻る