Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- program laba3_3;
- Uses
- System.SysUtils;
- Type
- TArray = array of Integer;
- TTArray = array of array of Integer;
- procedure PrintTask; forward;
- function InputValue(Min, Max: Integer): Integer; forward;
- function UserInputFromConsole(): Integer; forward;
- function UserInputArrayFromConsole(Num: Integer): TArray; forward;
- function UserInputFromFile(Path: String): TArray; forward;
- function CheckPath(Path: String): Boolean; forward;
- function UserOutputPath(): String; forward;
- procedure PrintInConsole(Steps: TTArray); forward;
- procedure PrintInFile(Steps: TTArray; Path: string); forward;
- function CheckFile(Path: String): Boolean; forward;
- function UserInputPath(): String; forward;
- function InputMethod: Word; forward;
- function OutputMethod(): Word; forward;
- function Sort(Arr: TArray): TTArray; forward;
- function UserInput(): TArray; forward;
- procedure ResultPrint(Steps: TTArray); forward;
- function InputValue(Min, Max: Integer): Integer;
- var
- CurrentValue: Integer;
- IsValid: Boolean;
- begin
- repeat
- IsValid := True;
- try
- Read(CurrentValue);
- except
- begin
- IsValid := False;
- Writeln('Введено нецелое число');
- end;
- end;
- if IsValid then
- if (CurrentValue < Min) or (CurrentValue > Max) then
- begin
- IsValid := False;
- Writeln('Введите число в заданном диапазоне');
- end;
- until IsValid;
- InputValue := CurrentValue;
- end;
- function UserInputFromConsole(): Integer;
- var
- Num: Integer;
- const MIN_SIZE = 2;
- const MAX_SIZE = 10000;
- begin
- Write('Введите кол-во элементов массива в диапазоне ', MIN_SIZE, '..', MAX_SIZE, ': ');
- Num := InputValue(MIN_SIZE, MAX_SIZE);
- Readln;
- UserInputFromConsole := Num;
- end;
- function UserInputArrayFromConsole(Num: Integer): TArray;
- var
- Arr: TArray;
- i: Integer;
- const MIN_VALUE = -10000;
- const MAX_VALUE = 10000;
- begin
- Writeln('Введите элементы массива в диапазоне ', MIN_VALUE, '..', MAX_VALUE, ': ');
- SetLength(Arr, Num);
- for i := 0 to Num - 1 do
- Arr[i] := InputValue(MIN_VALUE, MAX_VALUE);
- UserInputArrayFromConsole := Arr;
- end;
- function UserInputFromFile(Path: String): TArray;
- var
- Num, i: Integer;
- MyFile: TextFile;
- Arr: TArray;
- begin
- AssignFile(MyFile, Path);
- reset(MyFile);
- Readln(MyFile, Num);
- SetLength(Arr, Num);
- for i := 0 to Num - 1 do
- Read(MyFile, Arr[i]);
- closefile(MyFile);
- UserInputFromFile := Arr;
- end;
- function CheckPath(Path: String): Boolean;
- begin
- if FileExists(Path) then
- begin
- Writeln(Path, ' существует');
- CheckPath := True;
- end
- else
- begin
- Writeln(Path, ' не существует');
- Writeln('Введите корректный путь к файлу');
- end;
- end;
- function UserOutputPath(): String;
- var
- Path: String;
- begin
- Writeln('Введите абсолютный путь к файлу для вывода результата');
- Readln(Path);
- UserOutputPath := Path;
- end;
- procedure PrintInConsole(Steps: TTArray);
- var
- i, j: Integer;
- begin
- for i := 0 to High(Steps) do
- begin
- for j := 0 to High(Steps[i]) do
- Write(Steps[i, j], ' ');
- Writeln;
- end;
- end;
- procedure PrintInFile(Steps: TTArray; Path: string);
- var
- i, j: Integer;
- MyFile: TextFile;
- begin
- AssignFile(MyFile, Path);
- rewrite(MyFile);
- for i := 0 to High(Steps) do
- begin
- for j := 0 to High(Steps[i]) do
- Write(MyFile, Steps[i, j], ' ');
- Writeln(MyFile);
- end;
- close(MyFile);
- Writeln('Результат работы помещён в файл');
- end;
- function CheckFile(Path: String): Boolean;
- var
- IsValid: Boolean;
- Num: Integer;
- MyFile: TextFile;
- const MIN_SIZE = 2;
- const MAX_SIZE = 10000;
- begin
- AssignFile(MyFile, Path);
- reset(MyFile);
- IsValid := True;
- try
- Read(MyFile, Num);
- except
- IsValid := False;
- end;
- if IsValid then
- if (Num < MIN_SIZE) or (Num > MAX_SIZE) then
- IsValid := False;
- close(MyFile);
- CheckFile := IsValid;
- end;
- function UserInputPath(): String;
- var
- Path: String;
- begin
- repeat
- repeat
- Writeln('Введите абсолютный путь к файлу с входными данными');
- Readln(Path);
- until CheckPath(Path);
- if not(CheckFile(Path)) then
- Writeln('Неккоректные данные в файле, исправьте файл');
- until (CheckFile(Path));
- UserInputPath := Path;
- end;
- function InputMethod: Word;
- var
- Method: Word;
- IsValid: Boolean;
- begin
- Writeln('Каким способом хотите ввести данные?');
- Writeln('1 - с помощью консоли');
- Writeln('2 - с помощью файла');
- repeat
- IsValid := True;
- try
- Readln(Method);
- except
- begin
- IsValid := False;
- Writeln('Введено нецелое число');
- end;
- end;
- if IsValid then
- if (Method <> 1) and (Method <> 2) then
- begin
- IsValid := False;
- Writeln('Введите 1 или 2');
- end;
- until IsValid;
- InputMethod := Method;
- end;
- function OutputMethod(): Word;
- var
- Method: Word;
- IsValid: Boolean;
- begin
- Writeln('Куда хотите вывести результат?');
- Writeln('1 - в консоль');
- Writeln('2 - в файл');
- repeat
- IsValid := True;
- try
- Readln(Method);
- except
- begin
- IsValid := False;
- Writeln('Введено нецелое число');
- end;
- end;
- if IsValid then
- if (Method <> 1) and (Method <> 2) then
- begin
- IsValid := False;
- Writeln('Введите 1 или 2');
- end;
- until IsValid;
- OutputMethod := Method;
- end;
- function Sort(Arr: TArray): TTArray;
- var
- i, Temp, j, Left, Right, Mid: Integer;
- Steps: TTArray;
- begin
- SetLength(Steps, Length(Arr));
- for i := 1 to High(Arr) do
- begin
- Temp := Arr[i];
- Left := 0;
- Right := i - 1;
- while Left <= Right do
- begin
- Mid := (Left + Right) div 2;
- if Temp < Arr[Mid] then
- Right := Mid - 1
- else
- Left := Mid + 1;
- end;
- for j := i - 1 downto Left do
- Arr[j + 1] := Arr[j];
- Arr[Left] := Temp;
- SetLength(Steps[i - 1], Length(Arr));
- for j := 0 to High(Arr) do
- Steps[i - 1, j] := Arr[j];
- end;
- Sort := Steps;
- end;
- procedure PrintTask;
- begin
- Writeln('Данная программа выполняет сортировку бинарными вставками');
- end;
- function UserInput(): TArray;
- var
- Method: Word;
- Num: Integer;
- Arr: TArray;
- Path: String;
- begin
- Method := InputMethod;
- if (Method = 1) then
- begin
- Num := UserInputFromConsole;
- UserInput := UserInputArrayFromConsole(Num);
- end
- else
- begin
- Path := UserInputPath;
- UserInput := UserInputFromFile(Path);
- end;
- end;
- procedure ResultPrint(Steps: TTArray);
- var
- Method: Word;
- Path: String;
- begin
- Method := OutputMethod;
- if (Method = 1) then
- PrintInConsole(Steps)
- else
- begin
- Path := UserOutputPath;
- PrintInFile(Steps, Path);
- end;
- end;
- procedure Main();
- var
- Arr: TArray;
- Steps: TTArray;
- begin
- PrintTask;
- Arr := UserInput;
- Steps := Sort(Arr);
- ResultPrint(Steps);
- Writeln('Нажмите Enter для выхода из программы');
- Readln;
- end;
- begin
- Main();
- end.
Add Comment
Please, Sign In to add comment