unit Eratosthenes;
interface
type
TPrimeType = Cardinal;
TEratosthenesSieveLookupTableItem = record
Value: TPrimeType;
Next: Cardinal;
WheelIndex: Cardinal;
Incrementor: TPrimeType;
end;
TEratosthenesSieve = class(TObject)
private
FLookupTable: array of TEratosthenesSieveLookupTableItem;
FLookupTableSize: TPrimeType;
FLookupTableCapacity: TPrimeType;
FLookupTableCapacityStep: TPrimeType;
FWheelIndex: Cardinal;
FLookupTableLast: Cardinal;
FLookupTableFirst: Cardinal;
FCurrent: TPrimeType;
function LookupAppend: Cardinal;
function LookupInsert(from, k: Cardinal): Cardinal;
procedure LookupTableGrow;
procedure StrikeOut;
function CheckNext: boolean;
function Wheel(var WheelIndex: Cardinal): Cardinal;
procedure Spin;
protected
function GetCurrent: TPrimeType;
public
constructor Create;
destructor Destroy; override;
function Next: TPrimeType;
property LookupTableCapacityStep: TPrimeType read FLookupTableCapacityStep
write FLookupTableCapacityStep;
property Current: TPrimeType read GetCurrent;
end;
implementation
{ TEratosthenesSieve }
const
WheelSize = 48;
Wheel2357: array[0..WheelSize-1] of byte = (
2,4,2,4,6,2,6,4,2,4,6,6,2,6,4,2,6,4,6,8,4,2,4,2,4,8,
6,4,6,2,4,6,2,6,6,4,2,4,6,2,6,4,2,4,2,10,2,10
);
function Increment(Incrementor: TPrimeType;
WheelValue: Cardinal): TPrimeType;
asm
test edx, edx
jp @1 // переходим, если 6 или 10
bsf ecx, edx // (2)=1, (4)=2, (8)=3
shl eax, cl
ret
@1: shl eax, 1
cmp edx, 6 // *2
jnz @2
lea eax, [eax+eax*2] // *3
ret
@2: lea eax, [eax+eax*4] // *5
end;
function TEratosthenesSieve.CheckNext: boolean;
begin
Spin; // Находим следующее число для проверки
Result:=FCurrent<FLookupTable[FLookupTableFirst].Value;
if Result then
LookupAppend
else
StrikeOut;
end;
constructor TEratosthenesSieve.Create;
const
PrimeFinderLookupTableCapacityStep = 5000;
begin
FLookupTableCapacityStep:=PrimeFinderLookupTableCapacityStep;
FCurrent:=1;
end;
destructor TEratosthenesSieve.Destroy;
begin
SetLength(FLookupTable, 0);
inherited;
end;
function TEratosthenesSieve.GetCurrent: TPrimeType;
begin
Result:=FCurrent;
end;
function TEratosthenesSieve.LookupInsert(from, k: Cardinal): Cardinal;
var
i: Cardinal;
KValue: TPrimeType;
KIncrementor: TPrimeType;
begin
Result:=k;
with FLookupTable[k] do begin
KValue:=Value;
KIncrementor:=Increment(Incrementor, Wheel2357[WheelIndex]);
end;
while true do begin
if from=High(Cardinal) then
i:=FLookupTableFirst
else
i:=FLookupTable[from].Next;
with FLookupTable do
if (Value>KValue) or ( (Value=KValue) and
(Increment(Incrementor, Wheel2357[WheelIndex])>KIncrementor) ) then begin
FLookupTable[k].Next:=i;
if from=High(Cardinal) then
FLookupTableFirst:=k
else
FLookupTable[from].Next:=k;
break;
end;
from:=i;
end;
end;
function TEratosthenesSieve.LookupAppend: Cardinal;
begin
if FLookupTableSize=FLookupTableCapacity then
LookupTableGrow;
if FLookupTableLast<>High(Cardinal) then
FLookupTable[FLookupTableLast].Next:=FLookupTableSize;
FLookupTableLast:=FLookupTableSize;
Inc(FLookupTableSize);
with FLookupTable[FLookupTableLast] do begin
Value:=FCurrent*FCurrent;
Next:=High(Cardinal);
WheelIndex:=FWheelIndex;
Incrementor:=FCurrent;
end;
Result:=FLookupTableLast;
end;
procedure TEratosthenesSieve.LookupTableGrow;
begin
Inc(FLookupTableCapacity, FLookupTableCapacityStep);
SetLength(FLookupTable, FLookupTableCapacity);
end;
function TEratosthenesSieve.Next: TPrimeType;
begin
case FCurrent of
1: FCurrent:=2;
2: FCurrent:=3;
3: FCurrent:=5;
5: FCurrent:=7;
7:
begin
FCurrent:=11;
FLookupTableFirst:=LookupAppend;
end;
else
repeat until CheckNext; // просеиваем решето, пока не найдем простое ч.
end;
Result:=FCurrent;
end;
procedure TEratosthenesSieve.StrikeOut;
var
k: Cardinal;
from: Cardinal;
begin
from:=High(Cardinal);
repeat
with FLookupTable[FLookupTableFirst] do begin
Inc(Value, Increment(Incrementor, Wheel(WheelIndex)));
k:=FLookupTableFirst;
FLookupTableFirst:=Next;
from:=LookupInsert(from, k);
end;
until FLookupTable[FLookupTableFirst].Value>Current;
end;
function TEratosthenesSieve.Wheel(var WheelIndex: Cardinal): Cardinal;
begin
Result:=Wheel2357[WheelIndex];
Inc(WheelIndex);
if WheelIndex=WheelSize then WheelIndex:=0;
end;
procedure TEratosthenesSieve.Spin;
begin
Inc(FCurrent, Wheel(FWheelIndex));
end;
end.
