(*-------------------------------------------------------------------
SIEVE.PAS
エラトステネスの篩で素数を求める Pascal
のプログラムソース。
1230個の素数のテーブルを篩として用意する。このときテーブルの最大の
素数は10007なので、1億までの数値を篩にかけることができる。
探索範囲に配列を設定して、これを篩にかけて素数を抽出する。この探索範
囲を順にずらせていく。
なるべく処理系に依存しないようにするため、出力は標準出力のみとした。
動作を確認したPascal処理系は以下の5種類。
HAPPy v0.3
浅野比富美さんによる、MS-DOS汎用の標準Pascalコンパイラ。
ISO規格に忠実に従った標準Pascalコンパイラ。フリーソフト。
http://www.vector.co.jp/soft/dos/prog/se011503.html
HelloPascal v2.2
菊池鉄太郎氏による、WINDOWS95用のPascalコンパイラ。
Win95上での統合環境が使いやすく、ちょっとPascal言語を使っ
てみたいという人には、とっつきやすい。フリーソフト。
http://www.vector.co.jp/soft/win95/prog/se084406.html
Turbo Pascal v6.0a
Borland(現Inprise)のMS-DOS用Pascalコンパイラ。
MS-DOS用のPascalコンパイラのデファクトスタンダード。
コンパイルの高速さはWindows用の開発環境であるDelphiに
も受け継がれている。
THINK Pascal v4.0
SymantecのMacintosh用Pascalコンパイラ。
Free Pascal v0.99.10
Turbo Pascalと互換性の高いフリーのPascalコンパイラ。
32ビットネイティブコンパイラで、実用的なプログラムの開発が可能。
各種のOS用のものが用意されている（DOS,Win32,OS/2,Linux,Amiga）。
http://www.brain.uni-freiburg.de/~klaus/fpc/
処理系によってinteger型の範囲や、確保できる配列サイズに違いがあるので、
処理系に応じた変更を加えた方がよい場合もある。たとえば、Turbo
Pascal や
Free Pascalでは、integer を longint に変更し、PTabSize =
5000;
LimitSize = 2147000000; と変更することで、21億までの素数の出力が可能に
なる。
---------------------------------------------------------------------*)
program sieve(input,output);
const
PTabSize = 1230;
(* 篩に使う素数テーブルのサイズ *)
TabSize = 10000;
(* 探索範囲に設定する配列のサイズ *)
LimitSize = 100000000;
(* 探索可能な素数の最大値
*)
type
TPArray = array[1..PTabSize] of integer; (*
篩の素数テーブル *)
TTable = array[1..TabSize] of boolean;
(* 探索範囲に設定する配列 *)
var
Max : integer;
(* 求める素数の最大値 *)
P : ^TPArray;
(* 篩の配列へのポインタ *)
Tab : ^TTable;
(* 探索用配列へのポインタ *)
(*--------------------------------------------------------------------
求める素数の最大値を受け取り、TabSizeの倍数になるよう設定し直す
----------------------------------------------------------------------*)
procedure GetRange;
begin
repeat
Write('Input maximum number = '); readln(Max);
if (Max > LimitSize) or (Max < 1) then
Writeln('Illegal value.');
until (Max > 0) and (Max <= LimitSize);
Max := TabSize * ((Max-1) div TabSize + 1);
Writeln('Search primes up to ', Max:1);
end;
(*---------------------------------------------------------------
篩として使う素数テーブルの作成。篩として必要な素数の最大値は
Maxの平方根なので、そこまで作ったら処理を打ち切る。
----------------------------------------------------------------*)
procedure MakeSieve;
var
i, j,
(* ループカウンタ *)
Count : integer; (*
素数の個数のカウンタ *)
begin
New(P);
(* 篩の配列のメモリを確保 *)
P^[1] := 2;
Count := 1;
i := 3;
while Sqr(P^[Count]) < Max do begin
j := 1;
while (Sqr(P^[j]) <= i) and (i mod P^[j]
<> 0) do j := j+1;
if Sqr(P^[j]) > i then begin
Count := Count + 1;
P^[Count] := i;
end;
i := i + 2;
end;
Writeln('Sieve constructed.');
end;
(*---------------------------------------------------------------
合成数を篩でふるい落として、素数を求める処理
----------------------------------------------------------------*)
procedure SearchPrime;
var
Times,
(* 配列を当てはめた回数のカウンタ 0〜
*)
Repeats,
(* 配列を当てはめる回数
*)
OffSet,
(*
配列の添字と素数値を対応させるためのオフセット
*)
i, j,
(* ループカウンタ
*)
Counter : integer; (*
出力した素数の数を数えるカウンタ
*)
begin
New(tab);
(* 配列のメモリを確保 *)
Counter := 0;
(* カウンタの初期化 *)
Repeats := (Max-1) div TabSize;
for Times := 0 to Repeats do begin
OffSet := Times * TabSize;
for i := 1 to TabSize do (*
奇数はtrue,偶数はfalseにセット *)
Tab^[i] := Odd(i);
if Times = 0 then begin
(* 最初だけは別処理 *)
Tab^[1] := false;
Tab^[2] := true;
end;
(*
合成数のふるい落とし。素数の倍数は false
をセット*)
i := 2;
while (Sqr(P^[i]) <= OffSet + TabSize) do
begin
if P^[i] = 0 then
writeln(Sqr(P^[i-1]));
j := (OffSet div P^[i] + 1) *
P^[i];
if not Odd(j) then j := j + P^[i];
if Times = 0 then j := Sqr(P^[i]);
while j <= OffSet + TabSize do
begin
Tab^[j - OffSet] :=
false;
j := j + P^[i] * 2;
end;
i := i + 1;
end;
(* 素数を標準出力に出力する。10個毎に改行する
*)
for i := 1 to TabSize do
if Tab^[i] then begin
(* Tab^[i]がtureのとき OffSet+i は素数 *)
Counter := Counter +
1;
Write(' ', OffSet + i
:1);
if Counter mod 10 = 0
then Writeln;
end;
end;
Writeln;
(* 出力した素数の個数を出力する *)
Writeln(Counter : 1, ' primes found.');
end;
(* メインブロックには全体の処理の流れを書く
*)
begin
GetRange;
(* 探索範囲を受け取る
*)
MakeSieve;
(* 篩を作る
*)
SearchPrime; (*
篩を使って素数を探索・出力する *)
end.