laba.3.3.(Delphi)

Program Laba_3_3;

Uses
  System.SysUtils;
Const
  MIN_SIZE = 2;
  MAX_SIZE = 10;
  MIN_VALUE = -1000;
  MAX_VALUE = 1000;
Type
  TArr = Array Of Integer;
  TMatrix = Array Of Array Of Integer;

Procedure OutputTaskInfo();
Begin
  Writeln('Данная программа сортирует введенную последовательность методом бинарных вставок.');
  Writeln('Диапазон ввода значений размера последовательности: ', MIN_SIZE, '...', MAX_SIZE, '.');
  Writeln('Диапазон для ввода чисел: ', MIN_VALUE, '...', MAX_VALUE);
End;

Function InputPathToFile(): String;
Var
  Path: String;
  IsCorrect: Boolean;
Begin
  Write('Укажите путь к файлу: ');

  Repeat
    IsCorrect := True;
    Readln(Path);

    If Not FileExists(Path) Then
    Begin
      Write('По указанному пути файл не найден! Укажите правильный путь: ');
      IsCorrect := False;
    End
    Else If ExtractFileExt(Path) <> '.txt' Then
    Begin
      Write('Ошибка, неправильный тип файла! Укажите правильный путь: ');
      IsCorrect := False;
    End;
  Until IsCorrect;

  InputPathToFile := Path;
End;

Function GetVerificationOfChoice(): Integer;
Var
  Choice: Integer;
  IsCorrect: Boolean;
Begin
  Repeat
    IsCorrect := True;
    Try
      Readln(Choice);
    Except
      Writeln('Проверьте корректность ввода данных!');
      IsCorrect := False;
    End;

    If IsCorrect And ((Choice <> 0) And (Choice <> 1)) Then
    Begin
      Writeln('Для выбора введите 0 или 1!');
      IsCorrect := False;
    End;

  Until IsCorrect;

  GetVerificationOfChoice := Choice;
End;

Function InputSizeFromConsole(): Integer;
Var
  Size: Integer;
  IsCorrect: Boolean;
Begin
  Write('Введите количество элементов последовательности: ');

  Repeat
    IsCorrect := True;
    Try
      Readln(Size);
    Except
      Writeln('Проверьте корректность ввода данных!');
      IsCorrect := False;
    End;

    If (IsCorrect And ((Size < MIN_SIZE) Or (Size > MAX_SIZE))) Then
    Begin
      Writeln('Введите значение от ', MIN_SIZE, ' до ', MAX_SIZE, '!');
      IsCorrect := False;
    End;

  Until IsCorrect;

  InputSizeFromConsole := Size;
End;

Function InputSizeFromFile(Const Path: String): Integer;
Var
  Size: Integer;
  InputFile: TextFile;
Begin
  Writeln('Происходит чтение количества членов последовательности...');
  AssignFile (InputFile, Path);

  Try
    Try
      Reset(InputFile);
      Readln(InputFile, Size);
    Finally
      CloseFile(InputFile);
    End;

    If (((Size < MIN_SIZE) Or (Size > MAX_SIZE))) Then
    Begin
      Writeln('В файле введен некорректное число! Введите количество с консоли!');
      Size := InputSizeFromConsole();
    End;
  Except
    Writeln('Ошибка при чтении данных! Введите количество с консоли!');
    Size := InputSizeFromConsole();
  End;

  InputSizeFromFile := Size;
End;

Procedure OutputSizeInConsole(Const Size: Integer);
Begin
  Writeln('Количество членов последовательности: ', Size);
End;

Procedure OutputSizeInFile(Const Size: Integer; Path: String);
Var
  OutputFile: TextFile;
  IsCorrect: Boolean;
Begin
  Writeln('Вывод количества членов последовательности в файл...');

  Repeat
    IsCorrect := True;
    AssignFile(OutputFile, Path);

    Try
      Try
        Rewrite(OutputFile);
        Write(OutputFile, Size);
        Write(OutputFile, #13);
      Finally
        Close(OutputFile);
      End;
    Except
      Writeln('Ошибка! Измените параметры файла или укажите новую ссылку!');
      IsCorrect := False;
      Path := InputPathToFile();
    End;

  Until IsCorrect;

  Writeln('Данные успешно записаны в файл!');
End;

Function FillSequenceFromConsole(Const Size: Integer): TArr;
Var
  Sequence: TArr;
  IsCorrect: Boolean;
  I: Integer;
Begin
  SetLength(Sequence, Size);

  For I := Low(Sequence) To High(Sequence) Do
  Begin
    Write('Введите значение ', I + 1,' элемента последовательности: ');

    Repeat
      IsCorrect := True;

      Try
        Read(Sequence[I]);
      Except
        Writeln('Проверьте корректность ввода данных!');
        IsCorrect := False;
      End;

      If (IsCorrect And ((Sequence[I] < MIN_VALUE) Or (Sequence[I] > MAX_VALUE))) Then
      Begin
        Writeln('Введите число от ', MIN_VALUE, ' до ', MAX_VALUE, '!');
        IsCorrect := False;
      End;
    Until IsCorrect;
  End;

  FillSequenceFromConsole := Sequence;
End;

Function FillSequenceFromFile(Const Size: Integer; Const Path: String): TArr;
Var
  Sequence: TArr;
  IsCorrect: Boolean;
  InputFile: TextFile;
  I: Integer;
Begin
  SetLength(Sequence, Size);
  Writeln('Происходит чтение последовательности из файла...');
  AssignFile(InputFile, Path);

  Repeat
    IsCorrect := True;

    Try
      Try
        Reset(InputFile);
        Readln(InputFile);

        For I := Low(Sequence) To High(Sequence) Do
        Begin
          Read(InputFile, Sequence[I]);

          If (IsCorrect And ((Sequence[I] < MIN_VALUE) Or (Sequence[I] > MAX_VALUE))) Then
            Begin
              Writeln('Ошибка при чтении последовательности! Введите последовательность с консоли!');
              IsCorrect := False;
              Sequence := FillSequenceFromConsole(Size);
            End;
        End;
      Finally
        Close(InputFile);
      End;
    Except
      Writeln('Ошибка при чтении последовательности! Введите последовательность с консоли!');
      IsCorrect := False;
      Sequence := FillSequenceFromConsole(Size);
    End;
  Until IsCorrect;

  FillSequenceFromFile := Sequence;
End;

Procedure OutputSequenceInConsole(Const Sequence: TArr);
Var
  I: Integer;
Begin
  Writeln('Вывод начальной последовательности: ');

  For I := Low(Sequence) To High(Sequence) Do
    Write(Sequence[I], ' ');
  Write(#13#10);
End;

Procedure OutputSequenceInFile(Const Sequence: TArr; Path: String);
Var
  OutputFile: TextFile;
  IsCorrect: Boolean;
  I: Integer;
Begin
  Writeln('Вывод начальной последовательности в файл...');

  Repeat
    IsCorrect := True;
    AssignFile(OutputFile, Path);

    Try
      Try
        Append(OutputFile);

        For I := Low(Sequence) To High(Sequence) Do
          Write(OutputFile, Sequence[I], ' ');
        Write(OutputFile, #13);
      Finally
        Close(OutputFile);
      End;
    Except
      Writeln('Ошибка! Измените параметры файла или укажите новую ссылку!');
      IsCorrect := False;
      Path := InputPathToFile();
    End;

  Until IsCorrect;

  Writeln('Данные успешно записаны в файл!');
End;

Function BinaryInsertionSort(Const Sequence: TArr): TMatrix;
Var
  I, J, Temp, Left, Right, Middle: Integer;
  NewSequence: TArr;
  DetailingMatrix: TMatrix;
Begin
  SetLength(NewSequence, Length(Sequence));
  SetLength(DetailingMatrix, Length(Sequence), Length(Sequence));

  For I := Low(Sequence) To High(Sequence) Do
  Begin
    NewSequence[I] := Sequence [I];
    DetailingMatrix[0, I] := Sequence [I];
  End;

  For I := 1 To High(NewSequence) do
  Begin
    If NewSequence[I - 1] > NewSequence[I] then
    Begin
      Temp := NewSequence[I];
      Left := 0;
      Right := I - 1;

      Repeat
        Middle := (Left + Right) Div 2;

        If NewSequence[Middle] < Temp Then
          Left := Middle + 1
        Else
          Right := Middle - 1;
      Until Left > Right;

      For J := I - 1 Downto Left Do
        NewSequence[J + 1] := NewSequence[J];
      NewSequence[Left] := Temp;
    End;

    For J := Low(DetailingMatrix[0]) to High(DetailingMatrix[0]) do
      DetailingMatrix[I, J] := NewSequence[J];
  End;

  BinaryInsertionSort := DetailingMatrix;
End;

Procedure OutputDetailingMatrixInConsole(Const DetailingMatrix: TMatrix);
Var
  I, J: Integer;
Begin
  Writeln('Вывод пошаговой детализации: ');

  For I := Low(DetailingMatrix) To High(DetailingMatrix) Do
  Begin
    For J := Low(DetailingMatrix[0]) To High(DetailingMatrix[0]) Do
      Write(DetailingMatrix[I, J], #9);
    Writeln('');
  End;
End;

Procedure OutputDetailingMatrixInFile(Const DetailingMatrix: TMatrix; Path: String);
Var
  OutputFile: TextFile;
  IsCorrect: Boolean;
  I, J: Integer;
Begin
  Writeln('Вывод пошаговой детализации в файл...');

  Repeat
    IsCorrect := True;
    AssignFile(OutputFile, Path);

    Try
      Try
        Append(OutputFile);

        For I := Low(DetailingMatrix) To High(DetailingMatrix) Do
        Begin
          For J := Low(DetailingMatrix[0]) To High(DetailingMatrix[0]) Do
            Write(OutputFile, DetailingMatrix[I, J], #9);
          Writeln(OutputFile,'');
        End;
        Write(OutputFile, #13);
      Finally
        Close(OutputFile);
      End;
    Except
      Writeln('Ошибка! Измените параметры файла или укажите новую ссылку!');
      IsCorrect := False;
      Path := InputPathToFile();
    End;

  Until IsCorrect;

  Writeln('Данные успешно записаны в файл!');
End;

Function ProcessUserInput(): TArr;
Var
  PathToIn: String;
  ChoiceForInput, Size: Integer;
  Sequence: TArr;
Begin
  Writeln('Вы желаете вводить данные с консоли(0) или из файла(1)?');
  ChoiceForInput := GetVerificationOfChoice();

  If ChoiceForInput = 0 Then
  Begin
    Size := InputSizeFromConsole();
    Sequence := FillSequenceFromConsole(Size);
  End;

  If ChoiceForInput = 1 Then
  Begin
    PathToIn := InputPathToFile();
    Size := InputSizeFromFile(PathToIn);
    Sequence := FillSequenceFromFile(Size, PathToIn);
  End;

  ProcessUserInput := Sequence;
End;

Procedure ProcessUserOutput(Const Size: Integer; Const Sequence: TArr; Const DetailingMatrix: TMatrix);
Var
  PathToOut: String;
  ChoiceForOutput: Integer;
Begin
  Writeln('Вы желаете получть данные в консоль(0) или в файл(1)?');
  ChoiceForOutput := GetVerificationOfChoice();

  If ChoiceForOutput = 0 Then
  Begin
    OutputSizeInConsole(Size);
    OutputSequenceInConsole(Sequence);
    OutputDetailingMatrixInConsole(DetailingMatrix);
  End;

  If ChoiceForOutput = 1 Then
  Begin
    PathToOut := InputPathToFile();
    OutputSizeInFile(Size, PathToOut);
    OutputSequenceInFile(Sequence, PathToOut);
    OutputDetailingMatrixInFile(DetailingMatrix, PathToOut);
  End;
End;

Procedure Main();
Var
  Sequence: TArr;
  DetailingMatrix: TMatrix;
Begin
  OutputTaskInfo();
  Sequence := ProcessUserInput;
  DetailingMatrix := BinaryInsertionSort(Sequence);
  ProcessUserOutput(Length(Sequence), Sequence, DetailingMatrix);
End;

Begin
  Main();
  Readln;
  Readln;
End.