Advertisement
Guest User

Untitled

a guest
Nov 19th, 2018
84
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 4.48 KB | None | 0 0
  1. program Lab3_3;
  2.  
  3. {$APPTYPE CONSOLE}
  4.  
  5. uses
  6.   SysUtils;
  7.  
  8. type
  9.     TIntArray = array of Integer;
  10. const
  11.    MinNumber = 1;
  12.    MaxNumber = 9999;
  13.  
  14. procedure CountingSort(var Arr : TIntArray; Num, Min, Max: Integer);
  15. var
  16.    Count: array of Integer;
  17.    i, j, Index: Integer;
  18. begin
  19.    SetLength(Count, Max - Min);
  20.    for i := 0 to (Max - Min - 1) do
  21.       Count[i] := 0;
  22.    for i := 0 to (Num - 1) do
  23.       Count[Arr[i] - Min] := Count[Arr[i] - Min] + 1;
  24.    Index := 0;
  25.    for i := Min to Max do
  26.       for j := 0 to (Count[i - Min] - 1) do
  27.       begin
  28.            Arr[Index] := i;
  29.            Index := Index + 1;
  30.       end;
  31. end;
  32.  
  33. procedure OutputToFile(ArrayValue: TIntArray; var OutFile: TextFile; LenArr: Integer; MinElement,
  34. MaxElement: Integer);
  35. var
  36.    OutFileName: string;
  37.    i: Integer;
  38. begin
  39.    Write('Please, Enter the Name of Output File in Format name.txt: ');
  40.    ReadLn(OutFileName);
  41.    AssignFile(OutFile, OutFileName);
  42.    ReWrite(OutFile);
  43.    CountingSort(ArrayValue, LenArr, MinElement, MaxElement);
  44.    WriteLn(OutFile, 'Sorted Array: ');
  45.    for i := 0 to LenArr - 1 do
  46.        WriteLn(OutFile, ArrayValue[i]);
  47.    CloseFile(OutFile);
  48. end;
  49.  
  50.  
  51. function GetArrFromFile(ArrayValue: TIntArray; TheWay: string; var LenArr: Integer; var IsCorrect:
  52. Boolean; var MinElement, MaxElement: Integer): TIntArray;
  53. var
  54.     ListInputFile: TextFile;
  55.     i, j: Integer;
  56.     Temp: string;
  57. begin
  58.     Assign(ListInputFile, TheWay);
  59.     Reset(ListInputFile);
  60.     j := 0;
  61.     while (not Eof(ListInputFile)) do
  62.     begin
  63.        Readln(ListInputFile, Temp);
  64.        Inc(j);
  65.     end;
  66.     LenArr := j;
  67.     SetLength(ArrayValue, LenArr);
  68.     Reset(ListInputFile);
  69.     for i := 0 to LenArr - 1 do
  70.        Read(ListInputFile, ArrayValue[i]);
  71.     Reset(ListInputFile);
  72.     MaxElement := ArrayValue[0];
  73.     MinElement := MaxElement;
  74.     for i := 0 to length(ArrayValue) - 1 do
  75.        if ArrayValue[i] > MaxElement then
  76.           MaxElement := ArrayValue[i]
  77.        else
  78.           if ArrayValue[i] < MinElement then
  79.              MinElement := ArrayValue[i];
  80.      CloseFile(ListInputFile);
  81.      GetArrFromFile := ArrayValue;
  82. end;
  83.  
  84. function IsValidElement(var UserFile: TextFile; ArrayValue: TIntArray; LenArr: Integer): Boolean;
  85. var
  86.    i: Integer;
  87.    Error: String;
  88.    IsValid: Boolean;
  89. begin
  90.    Reset(UserFile);
  91.    IsValid := True;
  92.    Error := ' ';
  93.    SetLength (ArrayValue, LenArr);
  94.    for i := 0 to LenArr - 1 do
  95.    begin
  96.          try
  97.             Read(UserFile, ArrayValue[i]);
  98.             if (ArrayValue[i] > MaxNumber) or (ArrayValue[i] < MinNumber) then
  99.             begin
  100.                Error := Error + '[' + IntToStr(i + 1) + '] ';
  101.                IsValid := False;
  102.             end;
  103.          except
  104.             Error := Error + '[' + IntToStr(i + 1) + '] ';
  105.             IsValid := False;
  106.          end;
  107.       ReadLn(UserFile);
  108.    end;
  109.    if not IsValid then
  110.    begin
  111.       Write('Element Must Be In the Range from ', MinNumber, ' to ', MaxNumber, '.' + #13#10 +
  112.          'Wrong Elements Are:');
  113.       Writeln(Error);
  114.    end;
  115.    IsValidElement := IsValid;
  116.    CloseFile(UserFile);
  117. end;
  118.  
  119. function CheckInputFile(var UserFile: TextFile; var FileName: string): string;
  120. var
  121.    IsCorrect: Boolean;
  122. begin
  123.    IsCorrect := False;
  124.    repeat
  125.       try
  126.          Write('Please, Enter the Name of File with Input Data in Format name.txt: ');
  127.          ReadLn(FileName);
  128.          AssignFile(UserFile, FileName);
  129.          Reset(UserFile);
  130.          if Eof(UserFile) then
  131.             WriteLn('This File Is Empty. So That:');
  132.          CheckInputFile := FileName;
  133.          IsCorrect := True;
  134.       except
  135.          on E:EInOutError do
  136.          begin
  137.             IsCorrect := False;
  138.             WriteLn('This File with Such Name Does Not Exist. Please, Try Again.');
  139.          end;
  140.       end;
  141.    until IsCorrect;
  142.    CloseFile(UserFile);
  143. end;
  144.  
  145. procedure Main();
  146. var
  147.    UserFile: TextFile;
  148.    OutFile: TextFile;
  149.    FileName: string;
  150.    LenArr: Integer;
  151.    IsCorrect: Boolean;
  152.    ArrayValue: TIntArray;
  153.    MinElement, MaxElement: Integer;
  154. begin
  155.    IsCorrect := False;
  156.    SetLength(ArrayValue, LenArr);
  157.    repeat
  158.       FileName := CheckInputFile(UserFile, FileName);
  159.       ArrayValue := GetArrFromFile(ArrayValue, FileName, LenArr, IsCorrect, MinElement, MaxElement);
  160.       IsCorrect := IsValidElement(UserFile, ArrayValue, LenArr);
  161.    until IsCorrect;
  162.    OutputToFile(ArrayValue, OutFile, LenArr, MinElement, MaxElement);
  163.    ReadLn;
  164. end;
  165.  
  166.  
  167. begin
  168.    Main();
  169. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement