MadCortez

Untitled

Nov 14th, 2020
155
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 7.83 KB | None | 0 0
  1. program laba3_3;
  2.  
  3. Uses
  4.    System.SysUtils;
  5.  
  6. Type
  7.    TArray = array of Integer;
  8.    TTArray = array of array of Integer;
  9.  
  10. procedure PrintTask; forward;
  11. function InputValue(Min, Max: Integer): Integer; forward;
  12. function UserInputFromConsole(): Integer; forward;
  13. function UserInputArrayFromConsole(Num: Integer): TArray; forward;
  14. function UserInputFromFile(Path: String): TArray; forward;
  15. function CheckPath(Path: String): Boolean; forward;
  16. function UserOutputPath(): String; forward;
  17. procedure PrintInConsole(Steps: TTArray); forward;
  18. procedure PrintInFile(Steps: TTArray; Path: string); forward;
  19. function CheckFile(Path: String): Boolean; forward;
  20. function UserInputPath(): String; forward;
  21. function InputMethod: Word; forward;
  22. function OutputMethod(): Word; forward;
  23. function Sort(Arr: TArray): TTArray; forward;
  24. function UserInput(): TArray; forward;
  25. procedure ResultPrint(Steps: TTArray); forward;
  26.  
  27. function InputValue(Min, Max: Integer): Integer;
  28. var
  29.    CurrentValue: Integer;
  30.    IsValid: Boolean;
  31. begin
  32.    repeat
  33.    IsValid := True;
  34.    try
  35.       Read(CurrentValue);
  36.    except
  37.       begin
  38.          IsValid := False;
  39.          Writeln('Введено нецелое число');
  40.       end;
  41.    end;
  42.    if IsValid then
  43.       if (CurrentValue < Min) or (CurrentValue > Max) then
  44.       begin
  45.          IsValid := False;
  46.          Writeln('Введите число в заданном диапазоне');
  47.       end;
  48.    until IsValid;
  49.    InputValue := CurrentValue;
  50. end;
  51.  
  52. function UserInputFromConsole(): Integer;
  53. var
  54.    Num: Integer;
  55.    const MIN_SIZE = 2;
  56.    const MAX_SIZE = 10000;
  57. begin
  58.    Write('Введите кол-во элементов массива в диапазоне ', MIN_SIZE, '..', MAX_SIZE, ': ');
  59.    Num := InputValue(MIN_SIZE, MAX_SIZE);
  60.    Readln;
  61.    UserInputFromConsole := Num;
  62. end;
  63.  
  64. function UserInputArrayFromConsole(Num: Integer): TArray;
  65. var
  66.    Arr: TArray;
  67.    i: Integer;
  68.    const MIN_VALUE = -10000;
  69.    const MAX_VALUE = 10000;
  70. begin
  71.    Writeln('Введите элементы массива в диапазоне ', MIN_VALUE, '..', MAX_VALUE, ': ');
  72.    SetLength(Arr, Num);
  73.    for i := 0 to Num - 1 do
  74.       Arr[i] := InputValue(MIN_VALUE, MAX_VALUE);
  75.    UserInputArrayFromConsole := Arr;
  76. end;
  77.  
  78. function UserInputFromFile(Path: String): TArray;
  79. var
  80.    Num, i: Integer;
  81.    MyFile: TextFile;
  82.    Arr: TArray;
  83. begin
  84.    AssignFile(MyFile, Path);
  85.    reset(MyFile);
  86.    Readln(MyFile, Num);
  87.    SetLength(Arr, Num);
  88.    for i := 0 to Num - 1 do
  89.       Read(MyFile, Arr[i]);
  90.    closefile(MyFile);
  91.    UserInputFromFile := Arr;
  92. end;
  93.  
  94. function CheckPath(Path: String): Boolean;
  95. begin
  96.    if FileExists(Path) then
  97.    begin
  98.       Writeln(Path, ' существует');
  99.       CheckPath := True;
  100.    end
  101.    else
  102.    begin
  103.       Writeln(Path, ' не существует');
  104.       Writeln('Введите корректный путь к файлу');
  105.    end;
  106. end;
  107.  
  108. function UserOutputPath(): String;
  109. var
  110.    Path: String;
  111. begin
  112.    Writeln('Введите абсолютный путь к файлу для вывода результата');
  113.    Readln(Path);
  114.    UserOutputPath := Path;
  115. end;
  116.  
  117. procedure PrintInConsole(Steps: TTArray);
  118. var
  119.    i, j: Integer;
  120. begin
  121.    for i := 0 to High(Steps) do
  122.    begin
  123.       for j := 0 to High(Steps[i]) do
  124.          Write(Steps[i, j], ' ');
  125.       Writeln;
  126.    end;
  127. end;
  128.  
  129. procedure PrintInFile(Steps: TTArray; Path: string);
  130. var
  131.    i, j: Integer;
  132.    MyFile: TextFile;
  133. begin
  134.    AssignFile(MyFile, Path);
  135.    rewrite(MyFile);
  136.    for i := 0 to High(Steps) do
  137.    begin
  138.       for j := 0 to High(Steps[i]) do
  139.          Write(MyFile, Steps[i, j], ' ');
  140.       Writeln(MyFile);
  141.    end;
  142.    close(MyFile);
  143.    Writeln('Результат работы помещён в файл');
  144. end;
  145.  
  146. function CheckFile(Path: String): Boolean;
  147. var
  148.    IsValid: Boolean;
  149.    Num: Integer;
  150.    MyFile: TextFile;
  151.    const MIN_SIZE = 2;
  152.    const MAX_SIZE = 10000;
  153. begin
  154.    AssignFile(MyFile, Path);
  155.    reset(MyFile);
  156.    IsValid := True;
  157.    try
  158.       Read(MyFile, Num);
  159.    except
  160.       IsValid := False;
  161.    end;
  162.    if IsValid then
  163.       if (Num < MIN_SIZE) or (Num > MAX_SIZE) then
  164.          IsValid := False;
  165.    close(MyFile);
  166.    CheckFile := IsValid;
  167. end;
  168.  
  169. function UserInputPath(): String;
  170. var
  171.    Path: String;
  172. begin
  173.    repeat
  174.       repeat
  175.          Writeln('Введите абсолютный путь к файлу с входными данными');
  176.          Readln(Path);
  177.       until CheckPath(Path);
  178.       if not(CheckFile(Path)) then
  179.          Writeln('Неккоректные данные в файле, исправьте файл');
  180.    until (CheckFile(Path));
  181.    UserInputPath := Path;
  182. end;
  183.  
  184. function InputMethod: Word;
  185. var
  186.    Method: Word;
  187.    IsValid: Boolean;
  188. begin
  189.    Writeln('Каким способом хотите ввести данные?');
  190.    Writeln('1 - с помощью консоли');
  191.    Writeln('2 - с помощью файла');
  192.    repeat
  193.       IsValid := True;
  194.       try
  195.          Readln(Method);
  196.       except
  197.          begin
  198.             IsValid := False;
  199.             Writeln('Введено нецелое число');
  200.          end;
  201.       end;
  202.       if IsValid then
  203.          if (Method <> 1) and (Method <> 2) then
  204.          begin
  205.             IsValid := False;
  206.             Writeln('Введите 1 или 2');
  207.          end;
  208.    until IsValid;
  209.    InputMethod := Method;
  210. end;
  211.  
  212. function OutputMethod(): Word;
  213. var
  214.    Method: Word;
  215.    IsValid: Boolean;
  216. begin
  217.    Writeln('Куда хотите вывести результат?');
  218.    Writeln('1 - в консоль');
  219.    Writeln('2 - в файл');
  220.    repeat
  221.       IsValid := True;
  222.       try
  223.          Readln(Method);
  224.       except
  225.          begin
  226.             IsValid := False;
  227.             Writeln('Введено нецелое число');
  228.          end;
  229.       end;
  230.       if IsValid then
  231.          if (Method <> 1) and (Method <> 2) then
  232.          begin
  233.             IsValid := False;
  234.             Writeln('Введите 1 или 2');
  235.          end;
  236.    until IsValid;
  237.    OutputMethod := Method;
  238. end;
  239.  
  240. function Sort(Arr: TArray): TTArray;
  241. var
  242.    i, Temp, j, Left, Right, Mid: Integer;
  243.    Steps: TTArray;
  244. begin
  245.    SetLength(Steps, Length(Arr));
  246.    for i := 1 to High(Arr) do
  247.    begin
  248.       Temp := Arr[i];
  249.       Left := 0;
  250.       Right := i - 1;
  251.       while Left <= Right do
  252.       begin
  253.          Mid := (Left + Right) div 2;
  254.          if Temp < Arr[Mid] then
  255.             Right := Mid - 1
  256.          else
  257.             Left := Mid + 1;
  258.       end;
  259.       for j := i - 1 downto Left do
  260.          Arr[j + 1] := Arr[j];
  261.       Arr[Left] := Temp;
  262.       SetLength(Steps[i - 1], Length(Arr));
  263.       for j := 0 to High(Arr) do
  264.          Steps[i - 1, j] := Arr[j];
  265.    end;
  266.    Sort := Steps;
  267. end;
  268.  
  269. procedure PrintTask;
  270. begin
  271.    Writeln('Данная программа выполняет сортировку бинарными вставками');
  272. end;
  273.  
  274. function UserInput(): TArray;
  275. var
  276.    Method: Word;
  277.    Num: Integer;
  278.    Arr: TArray;
  279.    Path: String;
  280. begin
  281.    Method := InputMethod;
  282.    if (Method = 1) then
  283.    begin
  284.       Num := UserInputFromConsole;
  285.       UserInput := UserInputArrayFromConsole(Num);
  286.    end
  287.    else
  288.    begin
  289.       Path := UserInputPath;
  290.       UserInput := UserInputFromFile(Path);
  291.    end;
  292. end;
  293.  
  294. procedure ResultPrint(Steps: TTArray);
  295. var
  296.    Method: Word;
  297.    Path: String;
  298. begin
  299.    Method := OutputMethod;
  300.    if (Method = 1) then
  301.       PrintInConsole(Steps)
  302.    else
  303.    begin
  304.       Path := UserOutputPath;
  305.       PrintInFile(Steps, Path);
  306.    end;
  307. end;
  308.  
  309. procedure Main();
  310. var
  311.    Arr: TArray;
  312.    Steps: TTArray;
  313. begin
  314.    PrintTask;
  315.    Arr := UserInput;
  316.    Steps := Sort(Arr);
  317.    ResultPrint(Steps);
  318.    Writeln('Нажмите Enter для выхода из программы');
  319.    Readln;
  320. end;
  321.  
  322. begin
  323.    Main();
  324. end.
Add Comment
Please, Sign In to add comment