SHARE
TWEET

Untitled

Eugene0091 Oct 21st, 2019 66 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. program Laba2_2;
  2.  
  3. {$APPTYPE CONSOLE}
  4.  
  5. uses
  6.   SysUtils;
  7.  
  8. type
  9.    TArr = array of Integer;
  10.  
  11. const
  12.    OutputFileName = 'output.txt';
  13.    INputFileName= 'input.txt';
  14.  
  15. var
  16.    Range: Integer;
  17.  
  18. function IsCorrectInput(var Number: Integer; const Min, Max: Integer): Integer;
  19. var
  20.    IsCorrect: boolean;
  21. begin
  22.    IsCorrect := False;
  23.    repeat
  24.       try
  25.          Readln(Number);
  26.          if (Number < Min) or (Max < Number) then
  27.             Writeln('The number must be between ', Min, ' and ', Max, '!')
  28.          else
  29.             IsCorrect:= True;
  30.       except
  31.          Write('Error! Enter a number: ');
  32.       end;
  33.    until IsCorrect;
  34.    Result := Number;
  35. end;
  36.  
  37. procedure FindFriendshipNumbers(var Range: integer; var Numbers: TArr);
  38. var
  39.    del:array of integer;
  40.    i, j, k, p: integer;
  41. begin
  42.    SetLength(del, Range);
  43.    for k := 2 to Range do
  44.       del[k] := 1 + k;
  45.     for k := 2 to Range div 2 do
  46.     begin
  47.        p := k + k;
  48.        while p < Range + 1 do
  49.        begin
  50.           del[p] := del[p] + k;
  51.           p:= p + k;
  52.        end;
  53.     end;
  54.      for i := 2 to Range - 1 do
  55.         for j := i + 1 to Range do
  56.             if (del[i] = i + j) and (del[j] = i + j)then
  57.             begin
  58.                SetLength(Numbers, Length(Numbers) + 2);
  59.                Numbers[High(Numbers) - 1] := i;
  60.                Numbers[High(Numbers)] := j;
  61.             end;
  62. end;
  63.  
  64. procedure OutputConsole(const Numbers: TArr);
  65. var
  66.    i: Integer;
  67. begin
  68.    i := 0;
  69.    while i < Length(Numbers) do
  70.    begin
  71.       Writeln(Numbers[i],' | ', Numbers[i + 1]);
  72.       Inc(i, 2);
  73.    end;
  74. end;
  75.  
  76. procedure OutputFile(const Numbers: TArr);
  77. var
  78.    UserFile: TextFile;
  79.    i: Integer;
  80. begin
  81.    AssignFile(UserFile, OutputFileName);
  82.    Rewrite(UserFile);
  83.    i := 0;
  84.    while i < Length(NUmbers) do
  85.    begin
  86.       Writeln(UserFile, Numbers[i], ' | ', Numbers[i + 1]);
  87.       Inc(i, 2);
  88.    end;
  89.    CloseFile(UserFile);
  90. end;
  91.  
  92. procedure InputFile(var Range: Integer);
  93. var
  94.    UserFile: TextFile;
  95. begin
  96.    AssignFile(UserFile, InputFileName);
  97.    Reset(UserFile);
  98.    Read(UserFile, Range);
  99.    CloseFile(UserFile);
  100. end;
  101.  
  102. function GetUserChoice: Char;
  103. var
  104.    Choice: Char;
  105. begin
  106.    Writeln('Do you want to read from file?[Y/N]');
  107.    Readln(Choice);
  108.    GetUserChoice := Choice;
  109. end;
  110.  
  111. procedure Main();
  112. var
  113.    Numbers: TArr;
  114.    Answer: Char;
  115. begin
  116.    Writeln('This program finds pairs of friendly numbers.');
  117.    Answer := getUserChoice;
  118.    if Answer = 'Y' then
  119.    begin
  120.       InputFile(Range);
  121.       Write('Range: ');
  122.       Writeln(Range);
  123.       Writeln('Pairs Friendship Numbers: ');
  124.    end
  125.    else
  126.    begin
  127.       Writeln('Enter the upper limit of the friendly number search range.');
  128.       Writeln('The number must be up to 10.000 !');
  129.       IsCorrectInput(Range, 2, 10000);
  130.    end;
  131.    FindFriendshipNumbers(Range, Numbers);
  132.    OutputConsole(Numbers);
  133.    OutputFile(Numbers);
  134.    Readln;
  135. end;
  136.  
  137. begin
  138.    Main
  139. end.
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top