Lab 7.3 (Delphi)

unit Unit1;

interface

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

type
    TForm1 = class(TForm)
        Memo1: TMemo;
        ButtonFind: TButton;
        LabelTask: TLabel;
        StringGridEdges: TStringGrid;
        EditEdges: TEdit;
        ButtonEdges: TButton;
        LabelMaxEdges: TLabel;
        LabelVertices: TLabel;
        EditVertices: TEdit;
        LabelInfo: TLabel;
        ButtonAdd: TButton;
        LabelEdges: TLabel;
        MainMenu1: TMainMenu;
        N1: TMenuItem;
        N2: TMenuItem;
        N3: TMenuItem;
        N4: TMenuItem;
        N5: TMenuItem;
        OpenDialog1: TOpenDialog;
        SaveDialog1: TSaveDialog;
        procedure ButtonFindClick(Sender: TObject);
        procedure FormCreate(Sender: TObject);
        procedure ButtonEdgesClick(Sender: TObject);
        procedure ButtonAddClick(Sender: TObject);
        procedure EditVerticesChange(Sender: TObject);
        procedure EditVerticesKeyPress(Sender: TObject; var Key: Char);
        procedure EditEdgesChange(Sender: TObject);
        procedure EditEdgesKeyPress(Sender: TObject; var Key: Char);
        procedure StringGridEdgesSetEditText(Sender: TObject;
          ACol, ARow: Integer; const Value: string);
        procedure StringGridEdgesKeyPress(Sender: TObject; var Key: Char);
        procedure N3Click(Sender: TObject);
        procedure N2Click(Sender: TObject);
        procedure N4Click(Sender: TObject);
        procedure N5Click(Sender: TObject);
    private
        { Private declarations }
    public
        { Public declarations }
    end;

var
    Form1: TForm1;
    MaxAmountEdges: Double;
    Path: String;
    IsFileOpen: Boolean;

type
    TGraph = TObjectList<TList<Integer>>;

    // procedure AddEdge(graph: TGraph; u, v: Integer);
    // function FindVertexCover(graph: TGraph): TList<Integer>;

implementation

{$R *.dfm}

procedure AddEdge(graph: TGraph; u, v: Integer);
begin
    graph[u].Add(v);
    graph[v].Add(u);
end;

function FindVertexCover(graph: TGraph): TList<Integer>;
var
    vertexCover: TList<Integer>;
    visited: array of Boolean;
    i, u, v: Integer;
begin
    SetLength(visited, graph.Count);
    vertexCover := TList<Integer>.Create;

    for i := 0 to graph.Count - 1 do
        visited[i] := False;

    for u := 0 to graph.Count - 1 do
    begin
        if not visited[u] then
        begin
            for v in graph[u] do
            begin
                if not visited[v] then
                begin
                    visited[u] := True;
                    visited[v] := True;
                    vertexCover.Add(u);
                    vertexCover.Add(v);
                    Break;
                end;
            end;
        end;
    end;

    {
      for i := 0 to graph.Count - 1 do
      begin
      if not visited[i] then
      vertexCover.Add(i);
      end;
    }

    Result := vertexCover;
end;

procedure TForm1.ButtonFindClick(Sender: TObject);
var
    graph: TGraph;
    vertexCover: TList<Integer>;
    i, AmountVertices, Num1, Num2: Integer;
    text: String;
begin
    Memo1.Clear;
    N5.Enabled := True;
    AmountVertices := StrToInt(EditVertices.text);
    // Создаем граф
    graph := TGraph.Create;
    try
        // Добавляем вершины
        for i := 0 to AmountVertices - 1 do // 5
            graph.Add(TList<Integer>.Create);

        // Добавляем ребра в граф
        {
          AddEdge(graph, 0, 1);
          AddEdge(graph, 0, 2);
          AddEdge(graph, 1, 3);
          AddEdge(graph, 1, 4);
          AddEdge(graph, 2, 5);
          AddEdge(graph, 3, 5);
          AddEdge(graph, 4, 5);
        }
        For i := 1 to StringGridEdges.RowCount - 1 do
        Begin
            Num1 := StrToInt(StringGridEdges.Cells[1, i]);
            Num2 := StrToInt(StringGridEdges.Cells[2, i]);
            AddEdge(graph, Num1, Num2);
        End;

        // Находим вершинное покрытие
        vertexCover := FindVertexCover(graph);

        // Выводим результат
        Memo1.Lines.Add('Вершинное покрытие графа:');
        for i := 0 to vertexCover.Count - 1 do
            text := text + IntToStr(vertexCover[i]) + ' ';
        Memo1.Lines.Add(text);
    finally
        // Освобождаем память
        for i := 0 to graph.Count - 1 do
            graph[i].Free;
        // graph.Free;
        vertexCover.Free;
    end;
end;

procedure TForm1.ButtonAddClick(Sender: TObject);
var
    i, Size: Integer;
begin
    Memo1.Clear;
    for i := 1 to StringGridEdges.RowCount - 1 do
        StringGridEdges.Rows[i].Clear;
    Size := StrToInt(EditEdges.text);
    If Size <= MaxAmountEdges Then
    Begin
        StringGridEdges.RowCount := Size + 1;
        For i := 1 to StringGridEdges.RowCount - 1 do
        Begin
            StringGridEdges.Cells[0, i] := IntToStr(i);
        End;
    End;
    N5.Enabled := False;
    ButtonFind.Enabled := False;
end;

procedure TForm1.ButtonEdgesClick(Sender: TObject);
var
    i, Num: Integer;
begin
    Num := StrToInt(EditVertices.text);
    MaxAmountEdges := 0.5 * (Num - 1) * Num;
    LabelMaxEdges.Caption := '';
    LabelMaxEdges.Caption := 'Максимальное количество ребер: ' +
      FloatToStr(MaxAmountEdges);
    for i := 1 to StringGridEdges.RowCount - 1 do
        StringGridEdges.Rows[i].Clear;
    EditEdges.text := '';
    StringGridEdges.RowCount := 1;
    N5.Enabled := False;
    ButtonFind.Enabled := False;
    LabelMaxEdges.Visible := True;
    Memo1.Clear;
end;

procedure TForm1.EditEdgesChange(Sender: TObject);
var
    Num, i: Integer;
    IsCorrect: Boolean;
begin
    IsCorrect := True;
    try
        Num := StrToInt(EditEdges.text);
    except
        IsCorrect := True
    end;
    If IsCorrect And ((Num > MaxAmountEdges) Or (Num < 1)) Then
        IsCorrect := False;
    ButtonAdd.Enabled := IsCorrect;
    N5.Enabled := False;
    ButtonFind.Enabled := False;
    Memo1.Clear;
    for i := 1 to StringGridEdges.RowCount - 1 do
        StringGridEdges.Rows[i].Clear
end;

procedure TForm1.EditEdgesKeyPress(Sender: TObject; var Key: Char);
begin
    If not(Key in ['0' .. '9', #13, #8]) Then
        Key := #0;
    If ButtonAdd.Enabled And (Key = #13) Then
        ButtonAdd.Click
end;

procedure TForm1.EditVerticesChange(Sender: TObject);
var
    Num, i: Integer;
    IsCorrect: Boolean;
begin
    IsCorrect := True;
    try
        Num := StrToInt(EditVertices.text);
    except
        IsCorrect := True
    end;
    If IsCorrect And ((Num > 10) Or (Num < 3)) Then
        IsCorrect := False;
    ButtonEdges.Enabled := IsCorrect;
    LabelMaxEdges.Visible := False;
    EditEdges.text := '';
    N5.Enabled := False;
    ButtonFind.Enabled := False;
    Memo1.Clear;
    for i := 1 to StringGridEdges.RowCount - 1 do
        StringGridEdges.Rows[i].Clear
end;

procedure TForm1.EditVerticesKeyPress(Sender: TObject; var Key: Char);
begin
    If not(Key in ['0' .. '9', #13, #8]) Then
        Key := #0;
    If ButtonEdges.Enabled And (Key = #13) Then
        ButtonEdges.Click
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
    StringGridEdges.Cells[0, 0] := '№/№';
    StringGridEdges.Cells[1, 0] := 'верш.1';
    StringGridEdges.Cells[2, 0] := 'верш.2';
end;

procedure TForm1.N2Click(Sender: TObject);
const
    Info1 = 'Найти вершинное покрытие графа.'#13#10;
    Info2 = 'Максимальное количество вершин - 10, минимальное - 3.'#13#10;
    Info3 = 'Количество ребер вводить нужно не больше максимального.'#13#10;
    Info4 = 'Нумерация вершин начинается с нуля';
begin
    Application.MessageBox(Info1 + Info2 + Info3 + Info4, 'Справка', 0)
end;

procedure TForm1.N3Click(Sender: TObject);
begin
    Application.MessageBox('Сымоник Вадим, гр. 251004', 'Разработчик', 0)
end;

Function GetVertices(var FileInput: TextFile): String;
Const
    MIN_NUM = 3;
    MAX_NUM = 10;
Var
    Size, Num: Integer;
    Str: String;
    IsCorrect: Boolean;
Begin
    Size := 0;
    Str := '';
    If Not Eof(FileInput) Then
    Begin
        IsCorrect := True;
        Try
            Read(FileInput, Size);
        Except
            MessageBox(Form1.Handle, PChar('Недопустимый размер графа!'),
              'Ошибка', MB_ICONSTOP);
            IsCorrect := False;
            Size := 0;
        End;
    End
    Else
        MessageBox(Form1.Handle, PChar('Недостаточно данных в файле!'),
          'Ошибка', MB_ICONSTOP);
    If (Size >= MIN_NUM) And (Size <= MAX_NUM) Then
        Str := IntToStr(Size)
    Else
        Application.MessageBox('Проверьте корректность данных в файле',
          'Ошибка', 0);
    GetVertices := Str;
End;

Function GetEdges(var FileInput: TextFile): String;
Const
    MIN_NUM = 1;
Var
    Size, Num: Integer;
    Str: String;
    IsCorrect: Boolean;
Begin
    Size := 0;
    Str := '';
    If Not Eof(FileInput) Then
    Begin
        IsCorrect := True;
        Try
            Read(FileInput, Size);
        Except
            MessageBox(Form1.Handle, PChar('Недопустимый количество ребер!'),
              'Ошибка', MB_ICONSTOP);
            IsCorrect := False;
            Size := 0;
        End;
    End
    Else
        MessageBox(Form1.Handle, PChar('Недостаточно данных в файле!'),
          'Ошибка', MB_ICONSTOP);
    If (Size >= MIN_NUM) And (Size <= MaxAmountEdges) Then
        Str := IntToStr(Size)
    Else
        Application.MessageBox('Проверьте корректность данных в файле',
          'Ошибка', 0);
    GetEdges := Str;
End;

Function TakeInformationIntoCell(Var FileInput: TextFile;
  Var IsCorrect: Boolean): String;
Var
    Temp, MaxNum: Integer;
    Str: String;
Begin
    If Not Eof(FileInput) Then
    Begin
        Try
            Read(FileInput, Temp);
            Str := IntToStr(Temp);
        Except
            MessageBox(Form1.Handle, PChar('Неверные данные!'), 'Ошибка',
              MB_ICONSTOP);
            IsCorrect := False;
        End;
        MaxNum := StrToInt(Form1.EditVertices.text) - 1;
        If IsCorrect And (Temp < 0) And (Temp > MaxNum) Then
        Begin
            IsCorrect := False;
            MessageBox(Form1.Handle,
              PChar('Недопустимый диапазон входных данных!'), 'Ошибка',
              MB_ICONSTOP);
            Str := '';
        End;
    End
    Else
    Begin
        IsCorrect := False;
        MessageBox(Form1.Handle, PChar('Недостаточно значений в файле!'),
          'Ошибка', MB_ICONSTOP);
        Str := '';
    End;
    TakeInformationIntoCell := Str;
End;

Procedure InputPointsInMatrix(var FileInput: TextFile);
Var
    i, J: Integer;
    IsCorrect: Boolean;
Begin
    IsCorrect := True;
    With Form1 do
    Begin
        For i := 1 to StringGridEdges.RowCount - 1 do
        Begin
            For J := 1 to StringGridEdges.ColCount - 1 do
            Begin
                StringGridEdges.Cells[J, i] :=
                  TakeInformationIntoCell(FileInput, IsCorrect);
            End;
        End;
        ButtonFind.Enabled := IsCorrect;
    End;
End;

procedure TForm1.N4Click(Sender: TObject);
var
    FileInput: TextFile;
    Num: Integer;
begin
    If OpenDialog1.Execute Then
    Begin
        AssignFile(FileInput, OpenDialog1.FileName);
        Try
            Try
                Reset(FileInput);
                EditVertices.text := GetVertices(FileInput);
                if EditVertices.text <> '' then
                Begin
                    ButtonEdges.Click;
                    EditEdges.text := GetEdges(FileInput);
                    If EditEdges.text <> '' Then
                    Begin
                        ButtonAdd.Click;
                        InputPointsInMatrix(FileInput);
                    End;
                End;
            Finally
                CloseFile(FileInput);
            End;
        Except

        End;
    End;
end;

Function Open(): String;
begin
    with Form1 Do
    begin
        If SaveDialog1.Execute Then
        begin
            Path := SaveDialog1.FileName;
            IsFileOpen := True;
        end
        Else
            IsFileOpen := False;
    end;
    Open := Path;
end;

procedure TForm1.N5Click(Sender: TObject);
var
    F: TextFile;
begin
    Path := Open;
    If IsFileOpen Then
    Begin
        AssignFile(F, Path);
        Rewrite(F);
        Writeln(F, Memo1.text);
        Application.MessageBox('Данные успешно сохранены в файл',
          'Результат', 0);
        CloseFile(F);
    End;
end;

procedure TForm1.StringGridEdgesKeyPress(Sender: TObject; var Key: Char);
begin
    If not(Key in ['0' .. '9', #13, #8]) Then
        Key := #0;
    If ButtonFind.Enabled And (Key = #13) Then
        ButtonFind.Click
end;

procedure TForm1.StringGridEdgesSetEditText(Sender: TObject;
  ACol, ARow: Integer; const Value: string);
var
    i, J: Integer;
    N, MaxNum, Num: Integer;
    IsCorrect: Boolean;
begin
    For i := 1 to StringGridEdges.RowCount - 1 do
    Begin
        for J := 1 to StringGridEdges.ColCount - 1 do
        Begin
            IsCorrect := True;
            If StringGridEdges.Cells[J, i] <> '' Then
            Begin
                Try
                    N := StrToInt(StringGridEdges.Cells[J, i]);
                Except
                    StringGridEdges.Cells[J, i] := '';
                    Application.MessageBox
                      ('Проверьте корректность введенных данных!', 'Ошибка', 0);
                    IsCorrect := False;
                End;
                MaxNum := StrToInt(EditVertices.text) - 1;
                If IsCorrect And ((N < 0) Or (N > MaxNum)) Then
                Begin
                    StringGridEdges.Cells[J, i] := '';
                    Application.MessageBox('Нет такой вершины!', 'Ошибка', 0);
                End;
            End;
        End;
    End;

    For i := 1 to StringGridEdges.RowCount - 1 do
    Begin
        If (StringGridEdges.Cells[2, i] <> '') And
          (StringGridEdges.Cells[2, i] = StringGridEdges.Cells[1, i]) Then
        Begin
            Application.MessageBox('Нельзя вводить одинаковые вершины',
              'Предупрреждение', 0);
            StringGridEdges.Cells[2, i] := ''
        End;
    End;

    For J := 1 to StringGridEdges.RowCount - 1 do
        for i := 1 to StringGridEdges.ColCount - 1 do
            If Length(StringGridEdges.Cells[i, J]) = 0 Then
                IsCorrect := False;
    ButtonFind.Enabled := IsCorrect;
    Memo1.Clear;
    N5.Enabled := False;
end;

end.