SHARE
TWEET

Untitled

a guest Dec 11th, 2019 80 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. program Project2;
  2.  
  3. {$APPTYPE CONSOLE}
  4.  
  5. uses
  6.   SysUtils;
  7.  
  8. type
  9.   TMass = array of Integer;
  10.  
  11. procedure ReadFromFile(var Arr: TMass; var n: Integer);
  12. var
  13.    FileName: String;
  14.    IsCorrect: Boolean;
  15.    InFile: Text;
  16.    i: Integer;
  17. begin
  18.    repeat
  19.       Writeln('Введите имя файла, из которого хотите считать информацию: ');
  20.       Readln(FileName);
  21.       FileName := FileName + '.txt';
  22.       IsCorrect := True;
  23.       Assign(InFile, FileName);
  24.       {$I-}
  25.       Reset(InFile);
  26.       {$I+}
  27.       if IOResult <> 0 then
  28.       begin
  29.          Writeln('Файл не существует!');
  30.          IsCorrect := False;
  31.       end
  32.       else
  33.          begin
  34.             Readln(InFile, n);
  35.          if (n <= 0) then
  36.          begin
  37.             Writeln('Некорректный размер массива');
  38.             IsCorrect := False;
  39.          end
  40.          else
  41.          begin
  42.             SetLength(Arr, n);
  43.             IsCorrect := True;
  44.             for i := 0 to High(Arr) do
  45.             begin
  46.                Read(InFile, Arr[i]);
  47.             end;
  48.          end;
  49.       end;
  50.    until IsCorrect;
  51.    Close(InFile);
  52. end;
  53.  
  54. procedure Input(var Arr: TMass; var n: Integer);
  55. var
  56.    IsCorrect: Boolean;
  57.    i: Integer;
  58. begin
  59.    repeat
  60.       Write('Размер массива: ');
  61.       Readln(n);
  62.       if (n > 0) then
  63.       begin
  64.          IsCorrect := True;
  65.          SetLength(Arr, n);
  66.          Writeln('Введите ', n, ' элементов массива');
  67.          for i := 0 to High(Arr) do
  68.          begin
  69.             Read(Arr[i]);
  70.          end;
  71.          Readln;
  72.       end
  73.       else
  74.       begin
  75.          Writeln('Некорректный размер массива');
  76.          IsCorrect := False;
  77.       end;
  78.    until IsCorrect;
  79. end;
  80.  
  81. procedure Merge(var Arr: TMass; First, Last: Integer);
  82. var
  83.    Middle, StartOfLeftPart, StartOfRightPart, j: Integer;
  84.    NewArr: TMass;
  85. begin
  86.    Middle := (First + Last) div 2;
  87.    StartOfLeftPart := First;
  88.    StartOfRightPart := Middle + 1;
  89.    SetLength(NewArr, First + Last);
  90.    for j := First to Last do
  91.       if (StartOfLeftPart <= Middle) and ((StartOfRightPart >
  92.       last) or (Arr[StartOfLeftPart] < Arr[StartOfRightPart])) then
  93.       begin
  94.          NewArr[j] := Arr[StartOfLeftPart];
  95.          Inc(StartOfLeftPart);
  96.       end
  97.       else
  98.       begin
  99.          NewArr[j] := Arr[StartOfRightPart];
  100.          Inc(StartOfRightPart);
  101.       end;
  102.    for j := First to Last do
  103.       Arr[j] := NewArr[j];
  104.    SetLength(NewArr, 0);
  105. end;
  106.  
  107. procedure MergeSort(var Arr: TMass; First, Last: Integer);
  108. begin
  109.    if First < Last then
  110.    begin
  111.       MergeSort(Arr, First, (First + Last) div 2);
  112.       MergeSort(Arr, (First + Last) div 2 + 1, Last);
  113.       Merge(Arr, First, Last);
  114.    end;
  115. end;
  116.  
  117. procedure Output(Arr: TMass; n: Integer);
  118. var
  119.    i: Integer;
  120. begin
  121.    if n = 0 then
  122.       Writeln('Массив пуст!')
  123.    else
  124.    begin
  125.       Writeln('Полученный массив');
  126.       for i := 0 to High(Arr) do
  127.          Write(Arr[i], ' ');
  128.    end;
  129. end;
  130.  
  131. procedure OutInFile(Arr: TMass; n: Integer);
  132. var
  133.    FileName: String;
  134.    OutFile: Text;
  135.    i: Integer;
  136. begin
  137.    Writeln;
  138.    Writeln('Введите имя файла для записи: ');
  139.    Readln(FileName);
  140.    FileName := FileName + '.txt';
  141.    Assign(OutFile, FileName);
  142.    Rewrite(OutFile);
  143.    if n = 0 then
  144.       Writeln(OutFile, 'Массив пуст!')
  145.    else
  146.    begin
  147.       Writeln(Outfile, 'Полученный массив');
  148.       for i := 0 to High(Arr) do
  149.          Write(Outfile, Arr[i], ' ');
  150.    end;
  151.    Close(OutFile);
  152. end;
  153.  
  154. procedure Main();
  155. var
  156.    n: Integer;
  157.    Arr: TMass;
  158.    Choose: Char;
  159.    IsCorrect: Boolean;
  160. begin
  161.    Writeln('Тема: Отсортировать массив методом двухпутевого слияния.');
  162.    Writeln('Если хотите считать массив из файла, введите "y" или "n":');
  163.    repeat
  164.       Readln(Choose);
  165.       if (Choose <> 'y') and (Choose <> 'n') then
  166.       begin
  167.          Writeln('Неверный ввод');
  168.          IsCorrect := False;
  169.       end
  170.       else
  171.          IsCorrect := True;
  172.    until IsCorrect;
  173.    case Choose of
  174.       'y': ReadFromFile(Arr, n);
  175.       'n': Input(Arr, n);
  176.    end;
  177.    MergeSort(Arr, 0, n - 1);
  178.    Output(Arr, n);
  179.    OutInFile(Arr, n);
  180.    Readln;
  181. end;
  182.  
  183. begin
  184.    Main();
  185. 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
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!
 
Top