1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
| unit Kette;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TGesell = class(TForm)
ButtonRechne: TButton;
Ausgabe: TMemo;
LabelRZ: TLabel;
LabelZeit: TLabel;
LabelVon: TLabel;
LabelBis: TLabel;
EditVon: TEdit;
EditBis: TEdit;
LabelKL: TLabel;
EditKL: TEdit;
AusgabeF: TMemo;
AusgabeV: TMemo;
LabelK: TLabel;
LabelF: TLabel;
LabelV: TLabel;
procedure ButtonRechneClick(Sender: TObject);
private
PrimListe:array of Int64;
Sieb:array of Cardinal;
procedure Sieben;
procedure TeilerSumme(N:Int64;var Summe:Int64);
function TestBit(Zahl:Cardinal;BitNr:Byte):Boolean;
function SetBit(Zahl:Cardinal;BitNr:Byte):Cardinal;
function ClrBit(Zahl:Cardinal;BitNr:Byte):Cardinal;
function TimeSekunden:Extended;
public
end;
var
Gesell: TGesell;
implementation
{$R *.dfm}
{$R-,Q-}
function TGesell.TimeSekunden:Extended;
var H, M, S, MS : Word;
begin
DecodeTime(Now,H,M,S,MS);
TimeSekunden:=3600.0*H+60.0*M+S+MS/1000
end;
function TGesell.TestBit(Zahl:Cardinal;BitNr:Byte):Boolean;
begin TestBit:=(((Zahl shr BitNr) and 1)=1) end;
function TGesell.SetBit(Zahl:Cardinal;BitNr:Byte):Cardinal;
begin SetBit:=Zahl or (1 shl BitNr) end;
function TGesell.ClrBit(Zahl:Cardinal;BitNr:Byte):Cardinal;
begin ClrBit:=Zahl and not(1 shl BitNr) end;
procedure TGesell.Sieben;
var an,Bis,k,z,Anzahl,i,Wurzel,Index,SiebMax:Cardinal;
begin
Bis:=Round(sqrt(50.0*(StrToInt64(EditBis.Text))));
SetLength(Primliste,Trunc(Bis/(ln(Bis*1.0)-1.08366))+200);
an:=(Bis-1) div 2;
SiebMax:=an div 32+1;
SetLength(Sieb,SiebMax+1);
for i:=1 to SiebMax do Sieb[i]:=$FFFFFFFF;
Wurzel:=trunc(sqrt(an/2+0.25)-0.5); for i:=1 to Wurzel do
begin
index:=(i-1)div 32+1;
if TestBit(sieb[index],i mod 32) then
begin
z:=2*i+1;k:=i*(1+z);
while k<=an do
begin
index:=(k-1)div 32+1;
sieb[index]:=ClrBit(sieb[index],k mod 32);
inc(k,z)
end
end
end;
Anzahl:=1;
PrimListe[Anzahl]:=2;
for i:=1 to an do
begin
index:=(i-1)div 32+1;
if TestBit(sieb[index],i mod 32) then
begin
inc(Anzahl);
PrimListe[Anzahl]:=2*i+1;
end;
end;
SetLength(PrimListe,Anzahl+1);
end;
procedure TGesell.TeilerSumme(N:Int64;var Summe:Int64);
var Quotient,Dividend,PrimPotSum,PrimPot,S,Primzahl:Int64;
Nr:Cardinal;
begin
Dividend:=N;S:=1;Nr:=1;
Primzahl:=PrimListe[Nr];
repeat
PrimPotSum:=1;
PrimPot:=Primzahl;
Quotient:=Dividend div Primzahl;
if Dividend=Quotient*Primzahl then
begin
repeat
Dividend:=Quotient;
Quotient:=Quotient div Primzahl;
PrimPotSum:=PrimPotSum+PrimPot;
PrimPot:=PrimPot*Primzahl;
until Dividend<>Quotient*Primzahl;
S:=S*PrimPotSum;
if Dividend=1 then
begin
Summe:=S-N;
exit
end;
end;
inc(Nr);
Primzahl:=PrimListe[Nr];
if Primzahl*Primzahl>Dividend then
begin
S:=S*(Dividend+1);
Summe:=S-N;
exit
end;
until Dividend=1;
Summe:=S-N
end;
procedure TGesell.ButtonRechneClick(Sender: TObject);
var Start,Summe,von,bis,K:Int64;
Nr,L,KLaenge:Cardinal;
TSek:Extended;
Kette:Array of Int64;
begin
if EditVon.Text='1' then EditVon.Text:='2';
if EditVon.Text='' then EditVon.Text:='2';
if EditBis.Text='' then EditBis.Text:='10000000';
von:=StrToInt64(EditVon.Text);
bis:=StrToInt64(EditBis.Text);
KLaenge:=StrToInt(EditKL.Text);
SetLength(Kette,KLaenge+1);
LabelZeit.Caption:='';
Ausgabe.Clear;AusgabeF.Clear;AusgabeV.Clear;
Screen.Cursor:=crHourGlass;
Sieben;
TSek:=TimeSekunden;
K:=von;
while K<=bis do
begin
Start:=K;
Nr:=0;
repeat
TeilerSumme(Start,Summe);
Start:=Summe;
inc(Nr);
Kette[Nr]:=Summe;
until (Start<=K) or (Start=1) or (Start>50.0*K) or (Nr=KLaenge);
if Start=K then
begin
if Nr=1 then AusgabeV.Lines.Add(IntToStr(K))
else if Nr=2 then AusgabeF.Lines.Add(IntToStr(Kette[2])+' - '+IntToStr(Kette[1]))
else
begin
Ausgabe.Lines.Add('Kettenlänge='+IntToStr(Nr)+' für '+IntToStr(K));
for L:=1 to Nr do Ausgabe.Lines.Add(IntToStr(Kette[L]));
end
end;
inc(K)
end;
TSek:=TimeSekunden-TSek;
Screen.Cursor:=crDefault;
LabelZeit.Caption:=Format('%0.2f',[TSek])+' sek.';
end;
end. |
Lelf