unit Main;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Menus, Vcl.StdCtrls, Vcl.ComCtrls,
  Vcl.ExtCtrls, Vcl.NumberBox, Vcl.Grids, DirectionalList, System.Generics.Collections, System.StrUtils,
  System.IOUtils;


type

    TVertexArray = array of TVertexList;

  TMainForm = class(TForm)
    MainMenu: TMainMenu;
    FileMenu: TMenuItem;
    ImportSubmenu: TMenuItem;
    ExportSubmenu: TMenuItem;
    InstructionMenu: TMenuItem;
    AboutDeveloperMenu: TMenuItem;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    PageControl: TPageControl;
    PageAddLists: TTabSheet;
    PageViewGraph: TTabSheet;
    PageMain: TTabSheet;
    Label1: TLabel;
    Label2: TLabel;
    PaintBox: TPaintBox;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    UpDown: TUpDown;
    StringGridList: TStringGrid;
    ButtonSaveList: TButton;
    NumberBoxVertex: TNumberBox;
    OpenDialog: TOpenDialog;
    SaveDialog: TSaveDialog;
    PopupMenu: TPopupMenu;
    procedure FormCreate(Sender: TObject);
    procedure NumberBoxVertexChangeValue(Sender: TObject);
    procedure UpdateVertex();
    procedure StringGridListKeyPress(Sender: TObject; var Key: Char);
    procedure ButtonSaveListClick(Sender: TObject);
    procedure UpDownClick(Sender: TObject; Button: TUDBtnType);
    procedure N4Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure PaintBoxPaint(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure ImportSubmenuClick(Sender: TObject);
    procedure ImportAdjList(OpenFileDialog : TOpenDialog);
    procedure ExportSubmenuClick(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure AboutDeveloperMenuClick(Sender: TObject);
    procedure InstructionMenuClick(Sender: TObject);
    procedure FileMenuClick(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure StringGridListKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);

  private
    { Private declarations }
  public
    { Public declarations }
    procedure InitPageAddLists();
  end;

var
    MainForm: TMainForm;
    VertexArray : TVertexArray;
    VertexCount : Integer;
    CoverList : TList<Integer>;

implementation

{$R *.dfm}

Function GetVertexCover(const Graph : TVertexArray) : TList<Integer>;
var
    I : Integer;
    Cover : TList<Integer>;
    DeletedVertex : TList<Integer>;
    Vertex, Neighbor : Integer;
    TempGraph : TVertexArray;
begin
    Cover := TList<Integer>.Create; // Шаг 1
    DeletedVertex := TList<Integer>.Create;

    TempGraph := Graph;

    for I := Low(TempGraph) to High(TempGraph) do // Шаг 2
    begin
        Vertex := I + 1;
        if not DeletedVertex.Contains(Vertex) then
        begin
            if not Cover.Contains(Vertex) then // Шаг 3
            begin
                Cover.Add(Vertex);

                // Удалить смежные вершины
                while TempGraph[i].Head <> NIL do
                begin
                    DeletedVertex.Add(TempGraph[I].Head.Vertex);
                    TempGraph[I].Head := TempGraph[I].Head^.Next;
                end;
            end;
        end;
    end;

    GetVertexCover := Cover;
end;

procedure TMainForm.AboutDeveloperMenuClick(Sender: TObject);
begin
    Application.MessageBox('Разработал студент группы 251005, Федорцов Вадим.','О разработчике',MB_OK+MB_ICONINFORMATION);
end;

procedure TMainForm.Button1Click(Sender: TObject);
begin
    PaintBox.OnPaint(NIL);
end;

procedure TMainForm.ButtonSaveListClick(Sender: TObject);
var
    I, J : Integer;
begin

    With StringGridList do
    begin
        VertexCount := RowCount;
        SetLength(VertexArray, VertexCount);

        for I := 0 to RowCount - 1 do
        begin
            VertexArray[I] := TVertexList.Create;

            for J := 0 to ColCount - 1 do
            begin
                if Cells[J+1,I] <> '' then
                begin
                    VertexArray[I].AddNewVertexInList(Cells[J+1,I].ToInteger);
                end
                else
                    break;
            end;

        end;
    end;

    CoverList := GetVertexCover(VertexArray);
end;

procedure TMainForm.ExportSubmenuClick(Sender: TObject);
var
  StreamWriter: TStreamWriter;
  i: Integer;
begin

    if SaveDialog.Execute() then
    begin
        try
            if not ForceDirectories(ExtractFilePath(SaveDialog.FileName)) then
                raise Exception.Create('Невозможно создать директорию.');

            if FileExists(SaveDialog.FileName) then
            begin
                if NOT DeleteFile(PChar(SaveDialog.FileName)) then
                    raise Exception.Create('Отказ в доступе к файлу.');
            end;
            StreamWriter := TStreamWriter.Create(SaveDialog.FileName);
            try
                StreamWriter.WriteLine('Вершинное покрытие графа:');
                for i := 0 to CoverList.Count - 1 do
                begin
                  if (CoverList[i] < 0) then
                    raise Exception.Create('Вершина должна быть положительной.');

                  StreamWriter.WriteLine(IntToStr(CoverList[i]));
                end;
            finally
                StreamWriter.Free;
            end;
        Except
            On E : Exception do
                Application.MessageBox(PCHAR('Ошибка: ' + E.Message),'Экспорт',MB_OK+MB_ICONERROR);
        end;
    end;
end;

procedure TMainForm.FileMenuClick(Sender: TObject);
begin
    if VertexArray = NIL then
    begin
        ExportSubmenu.Enabled := false;
    end
    else
    begin
        ExportSubmenu.Enabled := true;
    end;
end;

procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
    CanClose :=  Application.MessageBox('Действительно закрыть программу?','Закрытие программы',MB_YESNO + MB_ICONQUESTION) = IDYES ;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
    InitPageAddLists;
    VertexCount := 0;
    CoverList := TList<Integer>.Create;
    PageControl.ActivePageIndex := 2;
end;

function IsAdjListValid(const VertexArray : TVertexArray; Count : Integer) : Boolean;
var
    Visited : array of Boolean;
    Vertex, Neighbor : Integer;
begin
    IsAdjListValid := False;

    if Count = 0  then
        Exit;

    SetLength(Visited, Count);

    for Vertex := 0 to Count - 1 do
    begin

        if (Vertex < 0) OR (Vertex >= Count) then
            Exit;

        Visited[Vertex] := True;

        while VertexArray[Vertex].Head <> NIL do
        begin

            Neighbor := VertexArray[Vertex].Head.Vertex;

            if Visited[Neighbor] then
                Exit;

            Visited[Neighbor] := True;

            VertexArray[Vertex].Head := VertexArray[Vertex].Head^.Next;
        end;
    end;


    IsAdjListValid := True;

end;

procedure TMainForm.ImportAdjList(OpenFileDialog : TOpenDialog);
var
    StreamReader: TStreamReader;
    VertexList : TVertexList;
    Line, StrNeighbor: string;
    TempVertexArr : TVertexArray;
    Count, I, J, Vertex, Neighbor: Integer;
begin

    if (OpenFileDialog.Execute()) then
    begin
        try
            PageControl.ActivePageIndex := 0;
            Count := 0;
            StreamReader := TStreamReader.Create(OpenFileDialog.FileName);

            SetLength(TempVertexArr, 5); // Базово задаем 5, потом поменяем

            Try
                While NOT StreamReader.EndOfStream do
                Begin

                    if Count > 5 then
                        Break;

                    Line := StreamReader.ReadLine;

                    TempVertexArr[Count] := TVertexList.Create;

                    for StrNeighbor in SplitString(Line, ' ') do
                    begin
                        Neighbor := StrToInt(StrNeighbor);
                        if Neighbor = 0 then
                            Exit;
                        TempVertexArr[Count].AddNewVertexInList(Neighbor);
                    end;

                    Inc(Count);
                End;
            Finally
                StreamReader.Free;
            End;

            SetLength(TempVertexArr, Count);

            NumberBoxVertex.Text := Count.ToString;
            UpDown.Position := Count;
            StringGridList.RowCount := Count;
            StringGridList.ColCount := Count;

            for I := Low(TempVertexArr) to High(TempVertexArr) do
            begin
                J := 1;
                while TempVertexArr[I].Head <> NIL do
                begin
                    StringGridList.Cells[J, I] := TempVertexArr[I].Head.Vertex.ToString;
                    Inc(J);
                    TempVertexArr[I].Head := TempVertexArr[I].Head^.Next;
                end;
            end;

        Except
            On E : EInOutError do
            begin
                Application.MessageBox('Импорт отменен. Ошибка работы с файлом.','Импорт',MB_OK+MB_ICONWARNING);
            end;
            On E : Exception do
            begin
                Application.MessageBox(PChar('Импорт отменен. Ошибка: ' + E.Message),'Импорт',MB_OK+MB_ICONWARNING);
            end;
        end;
    end
    else
    begin
        Application.MessageBox('Импорт отменен пользователем.','Импорт',MB_OK+MB_ICONWARNING)
    end;

end;

procedure TMainForm.ImportSubmenuClick(Sender: TObject);
begin
    ImportAdjList(OpenDialog);
end;

Procedure TMainForm.InitPageAddLists();
begin
    UpDown.Associate := NumberBoxVertex;
    NumberBoxVertexChangeValue(NIL);
end;

procedure TMainForm.InstructionMenuClick(Sender: TObject);
begin
    Application.MessageBox('Задайте список смежности. Доступные цифры: 1, 0. После этого, вы можете визуализировать граф и получить вершинное покрытие'
                           + #13#10'Импортировать список смежности, инструкция:'
                           + #13#10'1. Файл должен содержать только нули и единицы.'#13#10
                           + '2. Файл должен быть прямоугольной таблицей, то есть все строки должны иметь одинаковую длину.'#13#10
                           + '3. Для неориентированного графа матрица смежности должна быть симметричной относительно главной диагонали.'#13#10
                           + 'Пример:'#13#10
                           + '0 1 1 0'#13#10
                           + '1 0 1 1'#13#10
                           + '1 1 0 1'#13#10,'Инструкция к программе',MB_OK+MB_ICONINFORMATION);
end;

Procedure TMainForm.UpdateVertex();
var
    I : Integer;
begin
    for I := 0 to StringGridList.RowCount - 1 do
    begin
        StringGridList.Cells[0, I] := (I + 1).ToString;
    end;
end;

procedure TMainForm.UpDownClick(Sender: TObject; Button: TUDBtnType);
begin
    if Button = btPrev then
    begin
        StringGridList.Rows[UpDown.Position].Clear;
        StringGridList.Cols[UpDown.Position].Clear;
    end;
end;

procedure TMainForm.N1Click(Sender: TObject);
begin
    Application.MessageBox('Граф задан списками инцидентности. Разработать программу, находящую вершинное покрытие графа. Граф визуализировать. Найденные вершины выделить цветом и вывести на форму.','Задание',MB_OK+MB_ICONINFORMATION);
end;

procedure TMainForm.N2Click(Sender: TObject);
begin
    if VertexArray = NIL then
    begin
        N4.Enabled := False
    end
    else
    begin
        N4.Enabled := True;
    end;
end;

procedure TMainForm.N3Click(Sender: TObject);
begin
    PageControl.ActivePageIndex := 0;
end;

procedure TMainForm.N4Click(Sender: TObject);
begin
    PageControl.ActivePageIndex := 1;
    PaintBoxPaint(NIL);
end;

procedure TMainForm.NumberBoxVertexChangeValue(Sender: TObject);
begin
    StringGridList.RowCount := NumberBoxVertex.Value.ToString.ToInteger;
    StringGridList.ColCount := NumberBoxVertex.Value.ToString.ToInteger;
    if StringGridList.ColCount > 1 then
    begin
        StringGridList.FixedCols := 1;
        StringGridList.Enabled := True;
    end
    else
        if StringGridList.ColCount = 1 then
            StringGridList.Enabled := False;
    UpdateVertex();
end;

Procedure PaintGraph(const Graph : TVertexArray; PaintBox : TPaintBox);
const
    Scale = 15;
    R = 50;
    ScalesArr : array [0..4,0..1] of Integer = ((120,200),(450,90),(120,350),(810, 275),(450,460));
var
    I, J : Integer;
    X, Y : Integer;
    TempList : PVertexList;
begin

    for I := 0 to VertexCount - 1 do
    begin
        TempList := VertexArray[I].Head;

        while Templist <> NIL do
        begin
            PaintBox.Canvas.MoveTo(ScalesArr[I,0],ScalesArr[I,1]);
            PaintBox.Canvas.LineTo(ScalesArr[TempList.Vertex-1,0],ScalesArr[TempList.Vertex-1,1]);
            TempList := TempList^.Next;
        end;
    end;

    for I := 0 to VertexCount - 1 do
    begin

        PaintBox.Canvas.Pen.Width := 5;

        if CoverList.Contains(I + 1) then
            PaintBox.Canvas.Pen.Color := clGreen
        else
            PaintBox.Canvas.Pen.Color := clBlack;

        x := ScalesArr[I,0];
        y := ScalesArr[I,1];

        PaintBox.Canvas.Ellipse(x - R, y - R, x + R, y + R);
        PaintBox.Canvas.Font.Size := 22;
        PaintBox.Canvas.TextOut(X-Scale, Y-Scale-10, (I + 1).ToString);
    end;
end;


procedure TMainForm.PaintBoxPaint(Sender: TObject);
begin
    PaintGraph(VertexArray, PaintBox);
end;

Function CheckOnRepeat(StringGrid : TStringGrid; Key : Char) : Boolean;
var
    R : Word;
    J, K, Counter : Integer;
begin

    CheckOnRepeat := False;

    R := StringGrid.Row;
    Counter := 0;

    for J := 0 to StringGrid.ColCount - 1 do
    begin

        if Key = StringGrid.Cells[J,R] then
            Inc(Counter);
    end;

    if Counter > 0 then
        CheckOnRepeat := True;
end;

procedure TMainForm.StringGridListKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
    If (SsShift In Shift) And (Key = VK_Insert) Then
        Abort;
end;

procedure TMainForm.StringGridListKeyPress(Sender: TObject; var Key: Char);
var
    C, R : Word;
    MaxLength : Char;
begin


    C := StringGridList.Col;
    R := StringGridList.Row;

    MaxLength := char(StringGridList.RowCount+48);

    if NOT (Key in ['1'..MaxLength,#8]) then
    begin
        Key := #0;
    end
    else
        if (Key <> #8) AND (StringGridList.Cells[C,R].Length > 0) then
        begin
            Key := #0
        end
        else
        begin
            if (C > 1) AND (StringGridList.Cells[C - 1, R] = '') then
                StringGridList.Col := C - 1
            else
                if CheckOnRepeat(StringGridList, Key) then
                begin
                    Key := #0;
                end;
        end;
end;



end.