Информатика 1 Семестр - работа на Автомат

{
Сортировка методом Шелла с использованием последовательности Гнута и подмассивов (Подмассивы сортируются методом вставок)
В Memo выводится показательное отображение сортировки
В StringGrid выводится этапы сортировки
}
unit HW_8_Avtomat;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Grids, Math;

type
  TForm1 = class(TForm)
    StringGrid_Sort: TStringGrid;
    Edit_GenString: TEdit;
    Edit_SortString: TEdit;
    Button_Gen: TButton;
    Button_Sort: TButton;
    Memo: TMemo;
    procedure Button_GenClick(Sender: TObject);
    procedure Button_SortClick(Sender: TObject);

  private
    function ShellSort_StringGrid(const NumbersArray: array of Real): TStringList;
    function ShellSort_Memo(const NumbersArray: array of Real): TMemo;

    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button_GenClick(Sender: TObject);
var
 Numbers: TStringList;
 i: Integer;
 Sequence: string;

begin
  Numbers := TStringList.Create;
  for i := 0 to 24 do
    Numbers.Add(IntToStr(i));

  for i := 0 to Numbers.Count - 1 do
    Numbers.Exchange(i, Random(Numbers.Count));

  Sequence := '';

  for i := 0 to Numbers.Count - 1 do
    begin
      if i <> 0 then
        Sequence := Sequence + ', ';
        Sequence := Sequence + Numbers[i];
    end;

  Edit_GenString.Text := Sequence;
  Numbers.Free;
end;

function ArrayToStr(const Arr: array of Real): string;
var
 i: Integer;

begin
 Result := '';

 for i := 0 to High(Arr) do
  begin
    if i > 0 then
      Result := Result + ', ';
      Result := Result + FloatToStr(Arr[i]);
  end;
end;

function TForm1.ShellSort_StringGrid(const NumbersArray: array of Real): TStringList;
var
 Gap, i, j : Integer;
 Temp: Real;
 TempArray: array of Real;

begin
 Result := TStringList.Create;
 SetLength(TempArray, Length(NumbersArray));
 Move(NumbersArray[0], TempArray[0], Length(NumbersArray) * SizeOf(Real));
 Gap := 1;

while Gap < Length(TempArray) div 3 do
  Gap := Gap * 3 + 1;
  while Gap > 0 do
    begin
    for i := Gap to Length(NumbersArray) - 1 do
      begin
       Temp := TempArray[i];
       j := i;
       while (j >= Gap) and (TempArray[j - Gap] > Temp) do
        begin
          TempArray[j] := TempArray[j - Gap];
          j := j - Gap;
        end;
       TempArray[j] := Temp;
       Result.Add(ArrayToStr(TempArray));
      end;
      Gap := Gap div 3;
    end;
end;

function TForm1.ShellSort_Memo(const NumbersArray: array of Real): TMemo;
var
 Gap, step_count, n, k, b, h, e, f, g, a, i, j: Integer;
 key : Real;
 display_arr: TStringList;
 TempArrayM, TempArraySwap, TempArrayEnd: array of Real;
 displayString: string;
begin
  n := Length(NumbersArray);
  Step_count := 0;
  SetLength(TempArrayM, Length(NumbersArray));
  Move(NumbersArray[0], TempArrayM[0], Length(NumbersArray) * SizeOf(Real));
  Gap := 1;

  while Gap < n div 3 do
    Gap := Gap * 3 + 1;

  while Gap > 0 do
    begin
      Inc(step_count);
      Memo.Lines.Add(#13#10 + 'Интервал: ' + IntToStr(Gap));
      Memo.Lines.Add(#13#10 + '===> Входящий массив:');
      display_arr := TStringList.Create;
      h := 1;

      for k := 0 to Length(TempArrayM) - 1 do
        begin
          display_arr.Add(FloatToStr(TempArrayM[k]));
          h := h + 1;
        end;

      displayString := '';

      for b := 0 to display_arr.Count - 1 do
        displayString := displayString + display_arr[b] + ', ';

      Memo.Lines.Add(TrimRight(displayString));
      display_arr.Free;
      a := (n div Gap);
      SetLength(TempArraySwap, a + 1 );
      e := 0;
      f := 0;
      Memo.Lines.Add('');
      Memo.Lines.Add('Исходный массив: ' + IntToStr(n) + ' || Количество элементов подмассивa: ' + IntToStr(a + 1) + ' || Интервал: ' + IntToStr(gap));
      Memo.Lines.Add('');
      while (f <= Length(TempArrayM) - 1) do
        begin
          Memo.Lines.Add('====> В подмассив добавлено: ' + FloatToStr(TempArrayM[f]) + ' | f = ' + IntToStr(f));
          TempArraySwap[e] := TempArrayM[f];
          f := f + gap;
          Memo.Lines.Add('=====> Новая f = ' + IntToStr(f));
          Inc(e);
        end;

      Memo.Lines.Add(#13#10 + '===> Подмассив с нулями:');
      display_arr := TStringList.Create;
      f := 0;

      for k := 0 to n - 1 do
      begin
        if (k = f) and (k <> n) then
          begin
            display_arr.Add(FloatToStr(TempArrayM[k]));
            f := f + gap;
          end
        else
          display_arr.Add('[ ]');
      end;

      displayString := '';

      for b := 0 to display_arr.Count - 1 do
        begin
          if displayString <> '' then
            displayString := displayString + ', ';
          displayString := displayString + display_arr[b];
        end;

      Memo.Lines.Add(TrimRight(displayString));
      display_arr.Free;

      for i := 1 to Length(TempArraySwap) - 1 do
        begin
          key := TempArraySwap[i];
          j := i - 1;
          while (j >= 0) and (key < TempArraySwap[j]) do
            begin
              TempArraySwap[j + 1] := TempArraySwap[j];
              j := j - 1;
            end;
          TempArraySwap[j + 1] := key;
        end;

      display_arr := TStringList.Create;

      for k := 0 to Length(TempArraySwap) - 1 do
        display_arr.Add(FloatToStr(TempArraySwap[k]));

      Memo.Lines.Add(#13#10 + '===> Отсортированный подмассив:');
      displayString := '';

      for b := 0 to display_arr.Count - 1 do
        begin
          if displayString <> '' then
            displayString := displayString + ', ';
          displayString := displayString + display_arr[b];
        end;

      Memo.Lines.Add(TrimRight(displayString));
      Memo.Lines.Add(#13#10 + 'Количество шагов: ' + IntToStr(step_count));
      display_arr.Free;
      f := 0;

    for i := 0 to Length(TempArraySwap) - 1 do
      begin
        TempArrayM[f mod Length(TempArrayM)] := TempArraySwap[i];
        f := f + gap;
      end;

      display_arr := TStringList.Create;
      h := 1;
      f := 0;

      for k := 0 to Length(TempArrayM) - 1 do
        begin
          if (k = f) and (k <> n) then
            begin
              display_arr.Add('[' + FloatToStr(TempArrayM[k]) + ']');
              f := f + gap;
            end
          else
            display_arr.Add(FloatToStr(TempArrayM[k]));
          h := h + 1;
        end;

      Memo.Lines.Add(#13#10 + 'Итоговый массив итерации:');
      displayString := '';
      f := 0;

      for b := 0 to display_arr.Count - 1 do
        begin
          if displayString <> '' then
            displayString := displayString + ', ';
          displayString := displayString + display_arr[b];
        end;

      Memo.Lines.Add(TrimRight(displayString));
      display_arr.Free;
      SetLength(TempArraySwap, 0);
      gap := gap div 3;
    end;
  SetLength(TempArraySwap, 0);
end;

procedure TForm1.Button_SortClick(Sender: TObject);
var
  Numbers, Numbers_StringGrid, SortedNumbers: TStringList;
  i, Row: Integer;
  NumbersArray, NumbersArray_StringGrid: array of Real;
  LastCell: TGridCoord;
  InputString, SpecString, InputString_StringGrid: string;
  NumberArr: TArray<string>;
begin

  Numbers := TStringList.Create;
  InputString := Edit_GenString.Text;
  Numbers.Delimiter := ',';
  Numbers.DelimitedText := InputString;
  SetLength(NumbersArray, Numbers.Count);

  for i := 0 to Numbers.Count - 1 do
    NumbersArray[i] := StrToFloat(Numbers[i]);

  Memo.Clear();
  ShellSort_Memo(NumbersArray);

  SortedNumbers := ShellSort_StringGrid(NumbersArray);
  StringGrid_Sort.RowCount := SortedNumbers.Count;

  for i := 0 to SortedNumbers.Count - 1 do
    StringGrid_Sort.Cells[0, i] := SortedNumbers[i];

  for i := SortedNumbers.Count to StringGrid_Sort.RowCount - 1 do
    StringGrid_Sort.Cells[0, i] := '';

  Row := -1;

  for Row := StringGrid_Sort.RowCount - 1 downto 0 do
    begin
      if StringGrid_Sort.Cells[0, Row] <> '' then
        Break;
    end;

  if Row >= 0 then
    Edit_SortString.Text := StringGrid_Sort.Cells[0, Row];

  SpecString := Edit_SortString.Text;
  NumberArr := SpecString.Split([',']);
  SpecString := '';

  for i := 0 to Length(NumberArr) - 1 do
    begin
      SpecString := SpecString + '[' + Trim(NumberArr[i]) + ']';
      if i < Length(NumberArr) - 1 then
        SpecString := SpecString + ', ';
    end;

  Memo.Lines[Memo.Lines.Count - 1] := SpecString;
  end;
end.