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. |