Barátságos számok

 

Két természetes számot barátságos szám-párnak nevezünk, ha kölcsönösen igaz rájuk, hogy az egyik szám önmagánál kisebb osztóinak összege egyenlő a másik számmal.

 

Ilyen például a 220 és a 284 szám-pár, mert 220 önmagánál kisebb osztóinak összege: 1 + 2 + 4 + 5 + 10 + 11 + 20 + 22 + 44 + 55 + 110 = 284, míg ugyanez 284 esetén: 1 + 2 + 4 + 71 + 142 = 220, vagyis teljesítik a fenti definíciót. A (220; 248) számpárt, mint a legkisebb barátságos számokat, már az ókori görögök is ismerték.

 

Barátságos számok keresése nagy érdeklődésre tartott számot a történelem folyamán. Igyekeztek minél nagyobb ilyen számokat találni. Míg a középkorban nagy fegyverténynek számított egy-egy újabb számpár felfedezése, a számítógépek megjelenésével a talált szám-párok száma exponenciálisan nőni kezdett. Ma már több mint négymillió barátságos számpárt ismerünk.

 

A most bemutatandó program elvileg alkalmas arra, hogy a használt programnyelv kereteit figyelembe véve, a lehető legnagyobb értékig az összes barátságos számpárt megkeresse. Nem alkalmaz különleges algoritmust, csak a szokásos osztókeresést és összegzést. Beállíthatjuk a keresési intervallumot, majd start után egy listadobozban jeleníti meg a talált szám-párokat, miközben folyamatosan minden megtalált barátságos számot szöveges állományba ment. Lehetőség van arra is, hogy egy megadható számnál nem nagyobb, egyébként legnagyobb barátságos számpárt megkeressük. Ekkor az első megtalált szám-párnál a keresés befejeződik. Hasonlóképp lehetőség van arra is, hogy egy adott számnál nagyobb, de legkisebb barátságos számpárt megkeressük. A kereséseknél a határ mindig a kisebbik barátságos számra vonatkozik.

 

A Delphiben az Int64 típussal tárolhatunk legnagyobb egész számot, melynek értéke: 9.223.372.036.854.775.807. Elvileg ilyen nagyságrendű számok között is kereshetnének személyi számítógépeink barátságos számokat, de sajnos már a 16 jegyű számok környékén egyetlen szám osztóinak összegét is csak másodpercek alatt határozzák meg, így értelmes idő alatt nem tudnak megbirkózni a legnagyobb Int64 körüli intervallumban lévő számok vizsgálatával. A programba egyébként ez a lehetőség is be van építve. Tehát ha akár a gépek, akár az algoritmusok javulnak, értelmes lehet ilyen magasságokban is keresgetni a programmal.

 

Az algoritmus olyan, hogy az intervallumhatár csak a kisebbik számra érvényes, így ha a teljes keresést több intervallum beírásával hajtjuk végre, akkor se marad ki egyetlen barátságos szám sem. A program futási idejének csökkentése érdekében, a képernyőn csak minden tízezredik lépés sorszámát írjuk ki.

 

A programot a következő paraméterekkel futtattam: Kezdőérték = 1, Végérték = 100 millió. A gép egy 2GHz-es kétmagos Pentium, a futási idő 600 perc körüli volt, és ebben az intervallumban 237 számpárt talált. Kíváncsi voltam a 100 milliót követő első szám-párra, így a következő screen-shot-on még ezt is láthatjuk:

 

 

A program listája:

 

unit UBaratSzam;

interface

uses
  Windows, MessagesSysUtilsVariantsClasses,

  GraphicsControlsFormsDialogsStdCtrlsGrids;

type
  TfmBaratSzam = class(TForm)
    lbBaratSzamTLabel;
    lbKezdoTLabel;
    edKezdoTEdit;
    lbVegertekTLabel;
    edVegertekTEdit;
    btKilepesTButton;
    btStartTButton;
    ldTalaltTListBox;
    lbVegeTLabel;
    btTorlesTButton;
    lbSzampSzamTLabel;
    edSzampSzamTEdit;
    ldSzamokTListBox;
    lbStartTLabel;
    lbStopTLabel;
    edStartTEdit;
    edStopTEdit;
    btMax64: TButton;
    edSzamTEdit;
    edMaxTEdit;
    btKisebbTButton;
    btNagyobbTButton;
    procedure btKilepesClick(SenderTObject);
    procedure FormCreate(SenderTObject);
    procedure btStartClick(SenderTObject);
    procedure edKezdoChange(SenderTObject);
    procedure edVegertekChange(SenderTObject);
    procedure btTorlesClick(SenderTObject);
    procedure btMax64Click(SenderTObject);
    procedure btKisebbClick(SenderTObject);
    procedure btNagyobbClick(SenderTObject);
  private
    Private declarations }
  public
    Public declarations }
  end;

var
  fmBaratSzamTfmBaratSzam;
  Kezd, Vege, Max64: Int64;
  DNevString;
  FTextText;

implementation

{$R *.dfm}

procedure TfmBaratSzam.btKilepesClick(SenderTObject);
begin
  Close;
end;

Function Hatvany(P: Word): Int64;
Begin
  If P=0 Then Hatvany:= 1 Else Hatvany:= 2*Hatvany(P-1);
End;

procedure TfmBaratSzam.FormCreate(SenderTObject);
begin
  Kezd:= StrToInt(edKezdo.Text);
  Vege:= StrToInt(edVegertek.Text);
  lbVege.Visible:= False;
  Max64:= Hatvany(63)-1;
  DNev:= 'barat.txt';
end;

procedure TfmBaratSzam.edKezdoChange(SenderTObject);
Var Kod: Integer;
begin
  With edKezdo Do Val(Text,Kezd,Kod);
end;

procedure TfmBaratSzam.edVegertekChange(SenderTObject);
Var Kod: Integer;
begin
  With edVegertek Do Val(Text,Vege,Kod);
end;

procedure TfmBaratSzam.btMax64Click(SenderTObject);
begin
  edVegertek.Text:= IntToStr(Max64);
end;

procedure TfmBaratSzam.btTorlesClick(SenderTObject);
begin
  ldTalalt.Clear;
  ldSzamok.Clear;
  edSzampSzam.Text:= '';
  edStart.Text:= '';
  edStop.Text:= '';
  Repaint;
end;

procedure TfmBaratSzam.btStartClick(SenderTObject);
Var I, J, S1, S2: Int64;
    V: Comp;
    WsString;
begin
  edStart.Text:= TimeToStr(GetTime);
  edStop.Text:= '';
  lbVege.Visible:= FalseRepaint;
  I:= Kezd;
  While I<=Vege Do
  Begin

    If I Mod 10000=0 Then With edSzam Do Begin Text:= IntToStr(I); RePaint End;
    If ldSzamok.Items.IndexOf(IntToStr(I))=-1 Then
    Begin
      S1:= 1; J:= 2; V:= I;
      While J<Sqrt(V) Do
      Begin If I Mod J=0 Then Inc(S1,J+(I Div J)); Inc(J) End;
      If (J=Sqrt(V)) And (I Mod J=0) Then S1:= S1+J;
      If S1>I Then
      Begin
        S2:= 1; J:= 2; V:= S1;
        While J<Sqrt(V) Do
        Begin If S1 Mod J=0 Then Inc(S2,J+(S1 Div J)); Inc(J) End;
        If (J=Sqrt(V)) And (S1 Mod J=0) Then S2:= S2+J;
        If I=S2 Then
        Begin
          With ldSzamok.Items Do Begin Add(IntToStr(I)); Add(IntToStr(S1)) End;
          With ldTalalt Do
          Begin Items.Add(IntToStr(I)+' - '+IntToStr(S1)); RePaint End;
          AssignFile(FText,DNev); Append(FText);
            WriteLn(FText,I,' - ',S1);
          CloseFile(FText);
        End;
      End;
    End;
    Inc(I);
  End;
  lbVege.Visible:= True;
  ldTalalt.Clear;
  AssignFile(FText,DNev); Reset(FText);
    While Not (EOF(FText)) Do
    Begin
      ReadLn(FText,Ws);
      ldTalalt.Items.Add(Ws);
    End;
  CloseFile(FText);

  edSzampSzam.Text:= IntToStr(ldTalalt.Items.Count);
  edStop.Text:= TimeToStr(GetTime);
end;

procedure TfmBaratSzam.btKisebbClick(SenderTObject);
Var I, J, S1, S2: Int64;
    V: Comp;
    Van: Boolean;
begin
  edStart.Text:= TimeToStr(GetTime);
  edStop.Text:= '';
  lbVege.Visible:= FalseRepaint;
  Van:= False;
  I:= StrToInt(edMax.Text);
  While Not Van Do
  Begin
    If I Mod 10000=0 Then With edSzam Do Begin Text:= IntToStr(I); RePaint End;
    If ldSzamok.Items.IndexOf(IntToStr(I))=-1 Then
    Begin
      S1:= 1; J:= 2; V:= I;
      While J<Sqrt(V) Do
      Begin If I Mod J=0 Then Inc(S1,J+(I Div J)); Inc(J) End;
      If (J=Sqrt(V)) And (I Mod J=0) Then S1:= S1+J;
      If S1>I Then
      Begin
        S2:= 1; J:= 2; V:= S1;
        While J<Sqrt(V) Do
        Begin If S1 Mod J=0 Then Inc(S2,J+(S1 Div J)); Inc(J) End;
        If (J=Sqrt(V)) And (S1 Mod J=0) Then S2:= S2+J;
        If I=S2 Then
        Begin
          ldTalalt.Items.Add(IntToStr(I)+' - '+IntToStr(S1));
          Van:= True;
        End;
      End;
    End;
    Dec(I);
  End;
  lbVege.Visible:= True;
  edSzampSzam.Text:= IntToStr(ldTalalt.Items.Count);
  edStop.Text:= TimeToStr(GetTime);
end;

procedure TfmBaratSzam.btNagyobbClick(SenderTObject);
Var I, J, S1, S2: Int64;
    V: Comp;
    Van: Boolean;
begin
  edStart.Text:= TimeToStr(GetTime);
  edStop.Text:= '';
  lbVege.Visible:= FalseRepaint;
  Van:= False;
  I:= StrToInt(edMax.Text);
  While Not Van Do
  Begin
    If I Mod 10000=0 Then With edSzam Do Begin Text:= IntToStr(I); RePaint End;
    If ldSzamok.Items.IndexOf(IntToStr(I))=-1 Then
    Begin
      S1:= 1; J:= 2; V:= I;
      While J<Sqrt(V) Do
      Begin If I Mod J=0 Then Inc(S1,J+(I Div J)); Inc(J) End;
      If (J=Sqrt(V)) And (I Mod J=0) Then S1:= S1+J;
      If S1>I Then
      Begin
        S2:= 1; J:= 2; V:= S1;
        While J<Sqrt(V) Do
        Begin If S1 Mod J=0 Then Inc(S2,J+(S1 Div J)); Inc(J) End;
        If (J=Sqrt(V)) And (S1 Mod J=0) Then S2:= S2+J;
        If I=S2 Then
        Begin
          ldTalalt.Items.Add(IntToStr(I)+' - '+IntToStr(S1));
          AssignFile(FText,DNev); Append(FText);
            WriteLn(FText,I,' - ',S1);
          CloseFile(FText);
          Van:= True;
        End;
      End;
    End;
    Inc(I);
  End;
  lbVege.Visible:= True;
  edSzampSzam.Text:= IntToStr(ldTalalt.Items.Count);
  edStop.Text:= TimeToStr(GetTime);
end;

end.