Отладка и тестирование программного продукта

⇐ ПредыдущаяСтр 4 из 4

В ходе отладки и тестирования программы осуществлялся ввод графов с различным числом вершин и ребер, проверялась возможность их раскраски в заданное число цветов, при этом устанавливалось число цветов равное хроматическому числу графа, а также большее или меньшее значение. Выполнялась проверка работы программы при предельном значении числа вершин графа, а также при минимально возможном (0) и максимально возможном (полный граф) числе ребер.

Ниже представлены снимки экрана программы на различных этапах ее работы с разными исходными данными.

Рис. 12

Исходное состояние окна программы

или после нажатия кнопки «Новый граф»

Рис. 13

Окно программы с загруженным из файла графом

Рис. 14

Окно выбора числа цветов при раскраске

Рис. 15

Окно программы с предупреждением

о невозможности раскраски выбранным числом цветов

Рис. 16

Окно программы с полученным вариантом раскраски

Рис. 17

Окно программы после удаления вершины 5

из графа, изображенного на рисунке 16

Рис. 18

Окно программы после добавления вершины и ребра

в граф, изображенный на рисунке 17

Рис. 19

Окно программы с запросом на сохранение изменений в графе

при нажатии одной из кнопок – «Новый граф», «Выход», «Открыть»

Рис. 20

Окно для выбора файла с графом

Рис. 21

Окно программы с предупреждением о превышении числа вершин

Руководство пользователю

Разрабатываемая программа предназначена для нахождения раскраски заданного неориентированного графа ограниченным числом цветов с использованием алгоритма последовательного перебора.

Входными данными программы являются неориентированный граф, число вершин которого не превышает заданного ограничения, число цветов, которыми необходимо раскрасить данный граф.

К выходным данным относятся вариант раскраски графа заданным числом цветов, хроматическое число графа, сообщения о невозможности нахождения раскраски.

Максимальное число вершин графа в данной версии программы ограничивается значением 30, число ребер произвольно.

В программе используется следующий алгоритм раскраски графов.

Первая вершина окрашивается в цвет 1; затем список вершин просматривается сверху вниз (по невозрастанию степеней) и в цвет 1 окрашивается всякая вершина, которая не смежна с другой, уже окрашенной в этот цвет. Потом возвращаемся к первой в списке неокрашенной вершине, окрашиваем ее в цвет 2 и снова просматриваем список вершин сверху вниз, окрашивая в цвет 2 любую неокрашенную вершину, которая не соединена ребром с другой, уже окрашенной в цвет 2 вершиной. Аналогично действуем с цветами 3, 4 и т.д., пока не будут окрашены все вершины. Число использованных цветов будет тогда приближенным значением хроматического числа графа.

Управление программой реализуется через меню и клавиши-акселераторы. Ряд функций (добавление / удаление вершины, добавление / удаление ребра) реализуется с помощью мыши.

Пункт Файл объединяет действия с файлами, содержащими графы, а также выход из программы. Подпункт Новый обеспечивает очистку области построения и матрицу смежности графа с закрытием текущего файла. Подпункт Открыть активирует диалоговое окно открытия файла и реализует загрузку графа из выбранного файла в область построения и матрицу смежности. Подпункт Сохранить позволяет сохранить внесенные изменения в текущий граф (при первом сохранении выводится окно запроса имени файла). Подпункт Сохранить как обеспечивает сохранение текущего графа (независимо от того изменен он или нет) в новый файл. Подпункт Выход служит для завершения программы (при наличии измененного и не сохраненного графа выводится окно запроса на сохранение файла).

Пункт Редактирование включает действия, обеспечивающие построение графа. Подпункт Добавить вершину позволяет ввести в граф новую вершину с проверкой ограничения на максимальное число вершин. Номер новой вершине присваивается автоматически. Размещение вершин в области построения выполняется в случайных позициях с исключением наложения вершин друг на друга. Добавить вершину можно непосредственно мышью, щелкнув левой кнопкой на пустом месте области построения. Подпункт Удалить вершину служит для удаления выделенной вершины из текущего графа. Выделение вершины выполняется щелчком левой кнопки мыши по ее изображению. Оставшиеся вершины автоматически перенумеровываются. Подпункт Добавить ребро обеспечивает включение в граф нового ребра между двумя выделенными вершинами. Выделение вершин выполняется так же как при удалении вершины. Добавление ребра также можно выполнить путем ввода единичного значения в соответствующую клетку матрицы смежности. Подпункт Удалить ребро предназначен для удаления из графа выделенного ребра. Выделение ребер выполняется щелчком на них левой кнопки мыши. Также ребро можно удалить путем записи нулевого значения в соответствующую клетку матрицы смежности. Выполнение каждого из названных подпунктов приводит к изменению размера или содержимого матрицы смежности. Подпункт Отмена позволяет отменить последнее действие по редактированию графа. Подпункт Восстановление обеспечивает противоположное действие. Отменить и восстановить можно только удаление вершины или ребра.

ПРИЛОЖЕНИЕ: Листинг программы

program Coloring;

uses

Forms,

uMain in 'uMain.pas' {fmMain},

uInputk in 'uInputk.pas' {fmInputk},

uColoring in 'uColoring.pas',

uFiling in 'uFiling.pas',

uData in 'uData.pas',

uHelp in 'uHelp.pas' {fmHelp};

{$R *.res}

begin

Application.Initialize;

Application.CreateForm(TfmMain, fmMain);

Application.CreateForm(TfmInputk, fmInputk);

Application.CreateForm(TfmHelp, fmHelp);

Application.Run;

end.

unit uMain;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, Menus, ExtCtrls, StdCtrls, ComCtrls, Grids, Buttons, uData;

type

TfmMain = class(TForm)

MainMenu: TMainMenu;

OpenDialog: TOpenDialog;

SaveDialog: TSaveDialog;

iFile: TMenuItem;

iFNew: TMenuItem;

iFOpen: TMenuItem;

iFSave: TMenuItem;

iFSaveAs: TMenuItem;

iFBreak: TMenuItem;

iFExit: TMenuItem;

iEdit: TMenuItem;

iEUndo: TMenuItem;

iERedo: TMenuItem;

iEBreak: TMenuItem;

iEAddV: TMenuItem;

iEDelV: TMenuItem;

iEAddE: TMenuItem;

iEDelE: TMenuItem;

iHelp: TMenuItem;

iHHelp: TMenuItem;

iHAbout: TMenuItem;

stGraph: TStaticText;

StatusBar: TStatusBar;

stMatrix: TStaticText;

sgMatrix: TStringGrid;

btnNew: TBitBtn;

btnColoring: TBitBtn;

btnExit: TBitBtn;

procedure iFOpenClick(Sender: TObject);

procedure iFSaveClick(Sender: TObject);

procedure btnColoringClick(Sender: TObject);

procedure FormActivate(Sender: TObject);

procedure btnNewClick(Sender: TObject);

procedure iFNewClick(Sender: TObject);

procedure iFSaveAsClick(Sender: TObject);

procedure iFExitClick(Sender: TObject);

procedure btnExitClick(Sender: TObject);

procedure iEAddVClick(Sender: TObject);

procedure iEDelVClick(Sender: TObject);

procedure iEAddEClick(Sender: TObject);

procedure iEDelEClick(Sender: TObject);

procedure iEUndoClick(Sender: TObject);

procedure iERedoClick(Sender: TObject);

procedure iHHelpClick(Sender: TObject);

procedure iHAboutClick(Sender: TObject);

procedure FormDeactivate(Sender: TObject);

procedure sgMatrixSelectCell(Sender: TObject; ACol, ARow: Integer;

var CanSelect: Boolean);

procedure FormPaint(Sender: TObject);

procedure FormMouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure FormMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);

private

PaintAreaWidth: Integer; // Размеры области рисования

PaintAreaHeight: Integer;

PaintAreaXMin, PaintAreaYMin: Integer; // Положение области рисования

MouseIsHeld: Boolean;

MouseHeldVNo: Byte;

RepaintOldEdge: Boolean;

DrawnEdge: record src, dst: TPoint end;

// Приведение вида формы к исходному состоянию

procedure InitForm(Repaint: Boolean = True);

// Удаление выбранной вершины

procedure RemoveVertex(

VNo: Cardinal; var VCount: byte; var RemVrx: TVertices);

// Построение матрицы смежности

procedure FillAdMatrix(A: TAdMatrix);

// Перерисовка вершины на форме

procedure RepaintVertex(x, y: Integer; ForceUpdate: Boolean = true );

// Перерисовка ребра на форме

procedure RepaintEdge(x1, y1, x2, y2: Integer);

// Перерисовка всех вершин на форме

procedure RepaintAllVertices;

// Запрос на сохранение графа в файле

function SaveRequest: Boolean;

// Инициализация структуры данных об отмененном действии

procedure InitUndo;

// Заполнение структуры данных для отмены удаления вершины

procedure FillUndoDelVrx(DelVNo: Cardinal);

// Отображение пути к файлу с графом в заголовке

procedure PrintGraphPath;

public

end;

var

fmMain: TfmMain;

implementation

{$R *.dfm}

uses Math, uColoring, uInputk, uFiling, uHelp;

type

TUndoItem = record

VNo: Byte; // Номер вершины

VPoint: TPoint; // Координаты центра вершины

end;

const

VRadius = 10; // Радиус окружности вершины

var AdMatrix: TAdMatrix; // Матрица смежности вершин текущего графа

VCount: Byte; // Число вершин текущего графа

VColor: TColoring; // Текущая раскраска вершин

VCenter: array of TPoint; // Массив координат центров вершин

UndoItem: array of TUndoItem; // Информация об отмененной операции

k: Byte; // Требуемое число цветов

GraphChanged: Boolean; // Признак измененного и не сохраненного графа

// ------------------------ ОБРАБОТЧИКИ МЕНЮ -----------------------------

// Подменю ФАЙЛ

// Выбор пункта меню для создания нового графа

procedure TfmMain.iFNewClick(Sender: TObject);

begin

btnNewClick(Sender)

end;

// Запрос на сохранение графа в файле

function TfmMain.SaveRequest: Boolean;

begin

result: =False;

if GraphChanged then

begin

if MessageDlg('Текущий граф был изменен. Сохранить? ',

mtWarning, [mbYes, mbNo], 0) = mrYes then

begin

StatusBar.SimpleText: ='Сохранение графа...';

iFSave.Click;

result: =True;

StatusBar.SimpleText: ='Готово';

end;

// Нажатие кнопки для создания нового графа

procedure TfmMain.btnNewClick(Sender: TObject);

begin

if VCount > 0 then SaveRequest;

InitForm;

InitUndo;

MainMenu.Items[0].Items[0].Enabled: =False; // Новый

btnNew.Enabled: =False;

btnColoring.Enabled: =False;

GraphChanged: =False;

SaveDialog.FileName: ='';

OpenDialog.FileName: ='';

MainMenu.Items[0].Items[2].Enabled: =False; // Сохранить

MainMenu.Items[0].Items[3].Enabled: =False; // Сохранить как

MainMenu.Items[1].Items[3].Enabled: =True; // Добавить вершину

MainMenu.Items[1].Items[4].Enabled: =False; // Удалить вершину

end;

// Выбор пункта меню для открытия файла

procedure TfmMain.iFOpenClick(Sender: TObject);

var i, j, l: Byte;

Overlap: Boolean;

x, y: Integer;

begin

if VCount > 0 then SaveRequest;

if OpenDialog.Execute then

begin

InitUndo;

if not DoReadFile(OpenDialog.FileName, VCount, AdMatrix) then

MessageDlg('Ошибка при открытии или чтении файла! ', mtError, [mbOk], 0)

else

begin

// Очистка и переформат таблицы sgMatrix

sgMatrix.Visible: =True;

for i: =0 to sgMatrix.RowCount - 1 do sgMatrix.Rows[i].Clear;

sgMatrix.RowCount: =VCount+1;

sgMatrix.ColCount: =VCount+1;

sgMatrix.FixedRows: =1;

sgMatrix.FixedCols: =1;

for i: =1 to sgMatrix.RowCount - 1 do sgMatrix.Cells[0, i]: =IntToStr(i);

for j: =1 to sgMatrix.ColCount - 1 do sgMatrix.Cells[j, 0]: =IntToStr(j);

// Отображение матрицы смежности на sgMatrix

for i: =1 to VCount do

for j: =1 to VCount do

begin

if AdMatrix[i-1, j-1] > 0 then sgMatrix.Cells[j, i]: ='1'

else sgMatrix.Cells[j, i]: ='';

end;

// Задание координат центров вершин графа случайным образом

SetLength(VCenter, VCount);

l: =0;

repeat

Overlap: =False;

x: =round(RandG(PaintAreaWidth div 2, PaintAreaWidth div 6));

y: =round(RandG(PaintAreaHeight div 2, PaintAreaHeight div 6));

// Проверка выхода координат за пределы области построения

if (x < VRadius+PaintAreaXMin) or (y < VRadius+PaintAreaYMin) or

(x > PaintAreaWidth - (VRadius + 5)) or

(y > PaintAreaHeight - (VRadius + 5)) then

begin

Overlap: =True; // За пределами - нужны новые координаты

continue

end;

if l = 0 then continue;

for i: =0 to l - 1 do // Проверка наложения на предыдущие вершины

if (abs(VCenter[i].X - x) < = VRadius + 3) and

(abs(VCenter[i].Y - y) < = VRadius + 3) then

begin

Overlap: =True; // Накладываются - нужны новые координаты

Break

end;

until not Overlap;

VCenter[l].X: =x; // Задание координат

VCenter[l].Y: =y;

inc(l);

until l = VCount;

// Обнуление цветов

SetLength(VColor, VCount);

for i: =0 to VCount - 1 do VColor[i]: =-1;

SaveDialog.FileName: =OpenDialog.FileName;

PrintGraphPath;

MainMenu.Items[0].Items[0].Enabled: =True; // Новый

btnNew.Enabled: =True;

btnColoring.Enabled: =True;

GraphChanged: =False;

MainMenu.Items[0].Items[2].Enabled: =False; // Сохранить

MainMenu.Items[0].Items[3].Enabled: =True; // Сохранить как

MainMenu.Items[1].Items[3].Enabled: =True; // Добавить вершину

MainMenu.Items[1].Items[4].Enabled: =True; // Удалить вершину

self.repaint;

end;

// Выбор пункта меню для сохранения файла

procedure TfmMain.iFSaveClick(Sender: TObject);

begin

if (SaveDialog.FileName < > '') or SaveDialog.Execute then

begin

InitUndo;

FillAdMatrix(AdMatrix);

if not DoSaveFile(SaveDialog.FileName, AdMatrix) then

MessageDlg('Ошибка при сохранении файла! ', mtError, [mbOk], 0)

else

begin

GraphChanged: =False;

MainMenu.Items[0].Items[2].Enabled: =False; // Сохранить

end;

// Выбор пункта меню для сохранения графа в другом файле

procedure TfmMain.iFSaveAsClick(Sender: TObject);

begin

if SaveDialog.Execute then

begin

InitUndo;

FillAdMatrix(AdMatrix);

if not DoSaveFile(SaveDialog.FileName, AdMatrix) then

MessageDlg('Ошибка при сохранении файла! ', mtError, [mbOk], 0)

else

begin

PrintGraphPath;

GraphChanged: =False;

MainMenu.Items[0].Items[2].Enabled: =False; // Сохранить

end;

// Отображение пути к файлу с графом в заголовке

procedure TfmMain.PrintGraphPath;

var Path: string;

PathWidth, HeaderWidth: Integer;

i: Word;

begin

Path: =''; i: =Length(SaveDialog.FileName);

self.Font: =stGraph.Font;

PathWidth: =self.Canvas.TextWidth(Path);

HeaderWidth: =self.Canvas.TextWidth('Исходный граф +++: ');

while PathWidth < PaintAreaWidth - HeaderWidth do

begin // Отсечение начальных символов полного имени файла

Path: =' ' + Path;

Path[1]: =SaveDialog.FileName[i];

PathWidth: =self.Canvas.TextWidth(Path);

dec(i);

if i = 0 then Break;

end;

if i > 0 then stGraph.Caption: ='Исходный граф: ...' + Path

else stGraph.Caption: ='Исходный граф: ' + Path;

end;

// Выбор пункта меню для выхода из программы

procedure TfmMain.iFExitClick(Sender: TObject);

begin

btnExitClick(Sender)

end;

// Нажатие кнопки выхода из программы

procedure TfmMain.btnExitClick(Sender: TObject);

begin

if VCount > 0 then SaveRequest;

Application.Terminate;

end;

// Подменю РЕДАКТИРОВАНИЕ

// Выбор пункта меню для добавления вершины

procedure TfmMain.iEAddVClick(Sender: TObject);

var x, y: Integer;

i: Byte;

Overlap, Colored: bool;

begin

if VCount > = MaxVCount then

begin

MessageDlg('Число вершин графа не должно превышать ' +

IntToStr(MaxVCount) + '! ', mtWarning, [mbOk], 0);

Exit

end; // Добавление вершины

InitUndo;

inc(VCount);

SetLength(VCenter, VCount);

SetLength(VColor, VCount);

SetLength(AdMatrix, VCount, VCount);

Colored: =ResetColoring(VCount, VColor); // Сброс цветов

sgMatrix.Visible: =True; // Изменение матрицы смежности

sgMatrix.RowCount: =VCount+1;

sgMatrix.Rows[VCount].Clear;

sgMatrix.ColCount: =VCount+1;

sgMatrix.Cols[VCount].Clear;

sgMatrix.FixedCols: =1;

sgMatrix.FixedRows: =1;

sgMatrix.Cells[VCount, 0]: =IntToStr(VCount);

sgMatrix.Cells[0, VCount]: =IntToStr(VCount);

repeat // Определение координат новой вершины

Overlap: =False;

x: =round(RandG(PaintAreaWidth div 2, PaintAreaWidth div 6));

y: =round(RandG(PaintAreaHeight div 2, PaintAreaHeight div 6));

// Проверка выхода координат за пределы области построения

if (x < VRadius + PaintAreaXMin) or (y < VRadius + PaintAreaYMin) or

(x > PaintAreaWidth - (VRadius + 5)) or

(y > PaintAreaHeight - (VRadius + 5)) then

begin

Overlap: =True; // За пределами - нужны новые координаты

continue

end;

for i: =0 to VCount-2 do // Проверка наложения вершин

if (abs(VCenter[i].X - x) < = VRadius + 3) and

(abs(VCenter[i].Y - y) < = VRadius + 3) then

begin

Overlap: =True; // Накладываются - нужны новые координаты

Break

end;

until not Overlap;

VCenter[VCount-1].X: =x; // Задание координат

VCenter[VCount-1].Y: =y;

if Colored then RepaintAllVertices // Перерисовка вершин

else RepaintVertex(x, y);

MainMenu.Items[0].Items[0].Enabled: =True; // Новый

btnNew.Enabled: =True;

btnColoring.Enabled: =True;

MainMenu.Items[0].Items[2].Enabled: =True; // Сохранить

MainMenu.Items[1].Items[4].Enabled: =True; // Удалить вершину

GraphChanged: =True; // Граф следует сохранить

end;

// Выбор пункта меню для удаления вершины

procedure TfmMain.iEDelVClick(Sender: TObject);

var i, j, VNo: Byte;

x, y: Integer;

RemVrx: TVertices;

begin

fmInputk.Caption: ='Выбор вершины для удаления';

fmInputk.StaticText.Caption: ='Выберите удаляемую вершину из списка: ';

fmInputk.btnSet.Caption: ='Удалить';

fmInputk.ComboBox.Items.Clear;

for i: =1 to VCount do

fmInputk.ComboBox.Items.Add(IntToStr(i));

fmInputk.Tag: =VCount;

if fmInputk.ShowModal = mrOk then

begin

VNo: =StrToInt(fmInputk.ComboBox.Text);

x: =VCenter[VNo-1].X; // Удаление вершины

y: =VCenter[VNo-1].Y;

ResetColoring(VCount, VColor); // Сброс цветов

FillUndoDelVrx(VNo); // Сохранение информации для отмены удаления

MainMenu.Items[1].Items[0].Enabled: =True; // Undo

MainMenu.Items[1].Items[1].Enabled: =False; // Redo

RemoveVertex(VNo, VCount, RemVrx);

if RemVrx < > Nil then

for j: =0 to High(RemVrx) do // Перерисовка удаленных ребер

RepaintEdge(x, y, RemVrx[j].X, RemVrx[j].Y);

RepaintVertex(x, y); // Перерисовка удаленной вершины

//if RemVrx < > Nil then

RepaintAllVertices; // Перерисовка вершин после перенумерации

RemVrx: =Nil;

if VCount = 0 then

begin // Все вершины были удалены

MainMenu.Items[0].Items[0].Enabled: =False; // Новый

btnNew.Enabled: =False;

btnColoring.Enabled: =False;

MainMenu.Items[0].Items[2].Enabled: =False; // Сохранить

MainMenu.Items[0].Items[3].Enabled: =False; // Сохранить как

MainMenu.Items[1].Items[4].Enabled: =False; // Удалить вершину

end

else

begin

GraphChanged: =True; // Граф надо сохранить

MainMenu.Items[0].Items[2].Enabled: =True; // Сохранить

end;

// Выбор пункта меню для добавления ребра

procedure TfmMain.iEAddEClick(Sender: TObject);

begin

// Резерв

end;

// Выбор пункта меню для удаления ребра

procedure TfmMain.iEDelEClick(Sender: TObject);

begin

// Резерв

end;

// Выбор пункта меню для отмены последнего действия

procedure TfmMain.iEUndoClick(Sender: TObject);

var i, j: Byte;

begin

MainMenu.Items[1].Items[0].Enabled: =False; // Undo

MainMenu.Items[1].Items[1].Enabled: =True; // Redo

if UndoItem[0].VPoint.X = -1 then

begin // Отмена удаления ребра

sgMatrix.Cells[UndoItem[0].VNo, UndoItem[1].VNo]: ='1';

sgMatrix.Cells[UndoItem[1].VNo, UndoItem[0].VNo]: ='1';

sgMatrix.Update; // Прорисовка восстановленного ребра

RepaintEdge(VCenter[UndoItem[0].VNo-1].X, VCenter[UndoItem[0].VNo-1].Y,

VCenter[UndoItem[1].VNo-1].X, VCenter[UndoItem[1].VNo-1].Y);

end

else

begin // Отмена удаления вершины вместе со смежными ребрами

inc(VCount);

SetLength(VCenter, VCount); // Восстановление массива координат вершин

if VCount > 1 then

for i: =VCount - 1 downto UndoItem[0].VNo do VCenter[i]: =VCenter[i-1];

VCenter[UndoItem[0].VNo-1]: =UndoItem[0].VPoint;

SetLength(AdMatrix, VCount, VCount); // Изменение матрицы смежности

if VCount > 1 then

begin

for j: =VCount - 1 downto UndoItem[0].VNo do // Вставка столбца

for i: =0 to VCount - 1 do

AdMatrix[i, j]: =AdMatrix[i, j-1];

for i: =0 to VCount - 1 do AdMatrix[i, UndoItem[0].VNo-1]: =0;

for i: =VCount - 1 downto UndoItem[0].VNo do // Вставка строки

for j: =0 to VCount - 1 do

AdMatrix[i, j]: =AdMatrix[i-1, j];

for j: =0 to VCount - 1 do AdMatrix[UndoItem[0].VNo-1, j]: =0;

for i: =1 to High(UndoItem) do

begin // Восстановление связей удаленной вершины

AdMatrix[UndoItem[0].VNo-1, UndoItem[i].VNo-1]: =1;

AdMatrix[UndoItem[i].VNo-1, UndoItem[0].VNo-1]: =1;

end;

sgMatrix.Visible: =True; // Изменение матрицы смежности на форме

sgMatrix.RowCount: =VCount+1;

sgMatrix.ColCount: =VCount+1;

sgMatrix.FixedCols: =1;

sgMatrix.FixedRows: =1;

for i: =1 to VCount do sgMatrix.Cells[0, i]: =IntToStr(i);

for j: =1 to VCount do sgMatrix.Cells[j, 0]: =IntToStr(j);

for i: =1 to VCount - 1 do

for j: =i+1 to VCount do

if AdMatrix[i-1, j-1] > 0 then

begin

sgMatrix.Cells[i, j]: ='1';

sgMatrix.Cells[j, i]: ='1';

end

else

begin

sgMatrix.Cells[i, j]: ='';

sgMatrix.Cells[j, i]: ='';

end;

SetLength(VColor, VCount);

MainMenu.Items[0].Items[0].Enabled: =True; // Новый

btnNew.Enabled: =True;

btnColoring.Enabled: =True;

sgMatrix.Update;

self.Repaint;

end;

// Выбор пункта меню для выполнения отмененного действия

procedure TfmMain.iERedoClick(Sender: TObject);

var x, y, j: Integer;

RemVrx: TVertices;

begin

MainMenu.Items[1].Items[0].Enabled: =True; // Undo

MainMenu.Items[1].Items[1].Enabled: =False; // Redo

if UndoItem[0].VPoint.X = -1 then

begin // Повторное удаление ребра

sgMatrix.Cells[UndoItem[0].VNo, UndoItem[1].VNo]: ='';

sgMatrix.Cells[UndoItem[1].VNo, UndoItem[0].VNo]: ='';

sgMatrix.Update; // Прорисовка удаленного ребра

RepaintEdge(VCenter[UndoItem[0].VNo-1].X, VCenter[UndoItem[0].VNo-1].Y,

VCenter[UndoItem[1].VNo-1].X, VCenter[UndoItem[1].VNo-1].Y);

end

else

begin // Повторное удаление вершины со смежными ребрами

x: =VCenter[UndoItem[0].VNo-1].X;

y: =VCenter[UndoItem[0].VNo-1].Y;

MainMenu.Items[1].Items[0].Enabled: =True; // Undo

MainMenu.Items[1].Items[1].Enabled: =False; // Redo

RemoveVertex(UndoItem[0].VNo, VCount, RemVrx);

if RemVrx < > Nil then

for j: =0 to High(RemVrx) do // Перерисовка удаленных ребер

RepaintEdge(x, y, RemVrx[j].X, RemVrx[j].Y);

RepaintVertex(x, y); // Перерисовка удаленной вершины

if RemVrx < > Nil then

RepaintAllVertices; // Перерисовка вершин после перенумерации

RemVrx: =Nil;

if VCount = 0 then

begin // Все вершины были повторно удалены

MainMenu.Items[0].Items[0].Enabled: =False; // Новый

btnNew.Enabled: =False;

btnColoring.Enabled: =False;

MainMenu.Items[0].Items[2].Enabled: =False; // Сохранить

MainMenu.Items[0].Items[3].Enabled: =False; // Сохранить как

MainMenu.Items[1].Items[3].Enabled: =True; // Добавить вершину

MainMenu.Items[1].Items[4].Enabled: =False; // Удалить вершину

end

else

begin

GraphChanged: =True; // Граф надо сохранить

MainMenu.Items[0].Items[2].Enabled: =True; // Сохранить

end;

// Заполнение структуры данных для отмены удаления вершины

procedure TfmMain.FillUndoDelVrx(DelVNo: Cardinal);

var VDeg: Word;

i, p: Byte;

begin

VDeg: =0; // Вычисление локальной степени удаляемой вершины

for i: =1 to VCount do

if sgMatrix.Cells[i, DelVNo] < > '' then inc(VDeg);

SetLength(UndoItem, VDeg+1);

p: =0; // Заполнение структуры для отмены удаления

UndoItem[p].VNo: =DelVNo;

UndoItem[p].VPoint: =VCenter[DelVNo-1];

for i: =1 to VCount do

if sgMatrix.Cells[i, DelVNo] < > '' then

begin

inc(p);

UndoItem[p].VNo: =i; // Сохранение данных о смежной вершине

UndoItem[p].VPoint: =VCenter[i-1];

end;

// Подменю СПРАВКА

// Вызов помощи

procedure TfmMain.iHHelpClick(Sender: TObject);

begin

fmHelp.Tag: =1;

self.WindowState: =wsMinimized;

fmHelp.ShowModal;

self.WindowState: =wsNormal;

end;

// О программе

procedure TfmMain.iHAboutClick(Sender: TObject);

begin

fmHelp.Tag: =2;

self.WindowState: =wsMinimized;

fmHelp.ShowModal;

self.WindowState: =wsNormal;

end;

// -------------------- ВЫЧИСЛИТЕЛЬНЫЕ ПРОЦЕДУРЫ ----------------------

// Запуск процесса раскраски графа

procedure TfmMain.btnColoringClick(Sender: TObject);

var ColorCount, i: Byte;

begin

StatusBar.SimpleText: ='Раскраска...';

FillAdMatrix(AdMatrix);

fmInputk.Caption: ='Выбор числа цветов k';

fmInputk.StaticText.Caption: ='Выберите нужное число цветов из списка: ';

fmInputk.btnSet.Caption: ='Задать';

fmInputk.ComboBox.Items.Clear;

for i: =1 to VCount do

fmInputk.ComboBox.Items.Add(IntToStr(i));

fmInputk.Tag: =VCount;

if fmInputk.ShowModal = mrOk then

begin

InitUndo;

k: =StrToInt(fmInputk.ComboBox.Text);

// Минимальная раскраска (определение хроматического числа графа)

ColorCount: =DoMinColoring(AdMatrix, VCount, VColor);

if k < ColorCount then

MessageDlg('Раскраска вершин текущего графа ' + IntToStr(k) +

' цветом(ами) невозможна! ' + #13 + 'Необходимо не менее ' +

IntToStr(ColorCount) + ' цветов.', mtWarning, [mbOk], 0)

else // Неминимальная раскраска k цветами

DoNonminColoring(VCount, VColor, ColorCount, k);

RepaintAllVertices; // Перерисовка вершин

end;

StatusBar.SimpleText: ='Готово';

end;

// Построение матрицы смежности по содержимому sgMatrix

procedure TfmMain.FillAdMatrix(A: TAdMatrix);

var i, j: Byte;

begin

for i: =1 to sgMatrix.RowCount-1 do

for j: =1 to sgMatrix.ColCount-1 do

A[i-1, j-1]: =StrToIntDef(sgMatrix.Cells[j, i], 0);

end;

// ---------------- ПРОЦЕДУРЫ ОТОБРАЖЕНИЯ И РЕДАКТИРОВАНИЯ -------------------

// Перерисовка текущего графа в области построения

procedure TfmMain.FormPaint(Sender: TObject);

var i, j: Byte;

VNo: String[3];

VNoWidth, VNoHeight: Word;

begin

Canvas.Pen.Color: =clBlack;

Canvas.Pen.Width: =1;

// Отображение границ области построения графа

Canvas.Brush.Color: =clBtnFace;

Canvas.Brush.Style: =bsSolid;

Canvas.Rectangle(PaintAreaXMin, PaintAreaYMin,

PaintAreaXMin + PaintAreaWidth, PaintAreaYMin + PaintAreaHeight);

Canvas.Pen.Color: =clBlue;

Canvas.Pen.Width: =1;

if MouseIsHeld and not RepaintOldEdge then

begin

// Прорисовка нового ребра, создаваемого перетаскиванием

Canvas.MoveTo(DrawnEdge.src.X, DrawnEdge.src.Y);

Canvas.LineTo(DrawnEdge.dst.X, DrawnEdge.dst.Y);

end;

// Прорисовка ребер графа

Canvas.Pen.Width: =2;

for i: =1 to VCount - 1 do

for j: =i+1 to VCount do

if sgMatrix.Cells[j, i] < > '' then

begin

Canvas.MoveTo(VCenter[i-1].X, VCenter[i-1].Y);

Canvas.LineTo(VCenter[j-1].X, VCenter[j-1].Y);

end;

// Прорисовка вершин графа с учетом назначенных цветов

Canvas.Pen.Color: =clBlack;

Canvas.Pen.Width: =1;

Canvas.Brush.Style: =bsSolid;

for i: =1 to VCount do

begin

Canvas.Ellipse( // Окружность i-й вершины

VCenter[i-1].X - VRadius, VCenter[i-1].Y - VRadius,

VCenter[i-1].X + VRadius, VCenter[i-1].Y + VRadius);

if VColor[i-1] < = 0 then Canvas.Brush.Color: =clWhite

else Canvas.Brush.Color: =RealColors[VColor[i-1]-1];

Canvas.FloodFill( // Закраска окружности

VCenter[i-1].X, VCenter[i-1].Y, Canvas.Pen.Color, fsBorder);

VNo: =IntToStr(i); // Вывод номера вершины

VNoWidth: =Canvas.TextWidth(VNo);

VNoHeight: =Canvas.TextHeight(VNo);

Canvas.TextOut(

VCenter[i-1].X - VNoWidth div 2, VCenter[i-1].Y - VNoHeight div 2, VNo);

end;

// Редактирование матрицы смежности вершин графа

procedure TfmMain.sgMatrixSelectCell(

Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean);

var Colored: Boolean;

begin

CanSelect: =True;

if ACol = ARow then Exit;

InitUndo;

if sgMatrix.Cells[ACol, ARow] = '' then

begin // Добавление ребра

sgMatrix.Cells[ACol, ARow]: ='1';

sgMatrix.Cells[ARow, ACol]: ='1';

end

else

begin // Удаление ребра

sgMatrix.Cells[ACol, ARow]: ='';

sgMatrix.Cells[ARow, ACol]: ='';

UndoItem[0].VNo: =ARow; // Заполнение структуры для отмены удаления

UndoItem[1].VNo: =ACol;

UndoItem[0].VPoint.X: =-1; // Признак одного удаленного ребра

MainMenu.Items[1].Items[0].Enabled: =True; // Undo

MainMenu.Items[1].Items[1].Enabled: =False; // Redo

end;

RepaintEdge(VCenter[ARow-1].X, VCenter[ARow-1].Y,

VCenter[ACol-1].X, VCenter[ACol-1].Y);

Colored: =ResetColoring(VCount, VColor); // Сброс цветов

if Colored then RepaintAllVertices; // Перерисовка вершин

GraphChanged: =True; // Граф нужно сохранить

MainMenu.Items[0].Items[2].Enabled: =True; // Сохранить

end;

// Добавление или удаление вершины графа мышью

procedure TfmMain.FormMouseUp(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

var i, j: Byte;

RemVrx: TVertices;

Colored, AddVrx: Boolean;

x0, y0: Integer;

begin

if (Button = mbLeft) and (Shift = []) then

begin

if (X < VRadius + PaintAreaXMin) or (Y < VRadius + PaintAreaYMin) or

(X > PaintAreaWidth - (VRadius + 5)) or

(Y > PaintAreaHeight - (VRadius + 5)) then

begin // За пределами области построения графа

Beep;

MouseIsHeld: =false; // Левая клавиша отпущена

MouseHeldVNo: =0;

Repaint;

Exit

end;

if MouseIsHeld then AddVrx: =False else AddVrx: =True;

i: =1;

while i < = VCount do // Проверка наложения вершин

begin

if (abs(VCenter[i-1].X - X) < = VRadius) and

(abs(VCenter[i-1].Y - Y) < = VRadius) then

begin

Colored: =ResetColoring(VCount, VColor); // Сброс цветов

if MouseHeldVNo = i then

begin // Удаление вершины с номером i

MouseHeldVNo: =0;

MouseIsHeld: =false;

x0: =VCenter[i-1].X;

y0: =VCenter[i-1].Y;

FillUndoDelVrx(i); // Сохранение информации для отмены удаления

MainMenu.Items[1].Items[0].Enabled: =True; // Undo

MainMenu.Items[1].Items[1].Enabled: =False; // Redo

RemoveVertex(i, VCount, RemVrx);

if RemVrx < > Nil then

for j: =0 to High(RemVrx) do // Перерисовка удаленных ребер

RepaintEdge(x, y, RemVrx[j].X, RemVrx[j].Y);

RepaintVertex(x0, y0); // Перерисовка удаленной вершины

//if RemVrx < > Nil then

RepaintAllVertices; // Перерисовка вершин после перенумерации

RemVrx: =Nil;

if VCount = 0 then

begin

MainMenu.Items[0].Items[0].Enabled: =False; // Новый

btnNew.Enabled: =False;

btnColoring.Enabled: =False;

MainMenu.Items[0].Items[2].Enabled: =False; // Сохранить

MainMenu.Items[0].Items[3].Enabled: =False; // Сохранить как

MainMenu.Items[1].Items[4].Enabled: =False; // Удалить вершину

end

else

begin

GraphChanged: =True; // Граф нужно сохранить

MainMenu.Items[0].Items[2].Enabled: =True; // Сохранить

end;

end

else

begin // Добавление ребра между вершинами i и MouseHeldVNo

if sgMatrix.Cells[MouseHeldVNo, i] = '' then

begin

InitUndo;

sgMatrix.Cells[MouseHeldVNo, i]: ='1'; // Добавление ребра в матрицу

sgMatrix.Cells[i, MouseHeldVNo]: ='1';

RepaintEdge(VCenter[i-1].X, VCenter[i-1].Y, // Прорисовка ребра

VCenter[MouseHeldVNo-1].X, VCenter[MouseHeldVNo-1].Y);

if Colored then RepaintAllVertices; // Перерисовка вершин

end;

MouseHeldVNo: =0;

MouseIsHeld: =false;

GraphChanged: =True; // Граф нужно сохранить

MainMenu.Items[0].Items[2].Enabled: =True; // Сохранить

end;

Exit

end;

inc(i);

end;

if VCount > = MaxVCount then

begin

MessageDlg('Число вершин графа не должно превышать ' +

IntToStr(MaxVCount) + '! ', mtWarning, [mbOk], 0);

Exit

end;

if not AddVrx then

begin // Удерживалась клавиша мыши - вершину не добавляем

MouseIsHeld: =False;

MouseHeldVNo: =0;

RepaintEdge(DrawnEdge.src.X, DrawnEdge.src.Y, // Прорисовка области

DrawnEdge.dst.X, DrawnEdge.dst.Y);

Exit;

end;

InitUndo;

inc(VCount); // Добавление вершины

SetLength(VCenter, VCount);

SetLength(VColor, VCount);

SetLength(AdMatrix, VCount, VCount);

Colored: =ResetColoring(VCount, VColor); // Сброс цветов

sgMatrix.Visible: =True; // Изменение матрицы смежности

sgMatrix.RowCount: =VCount+1;

sgMatrix.Rows[VCount].Clear;

sgMatrix.ColCount: =VCount+1;

sgMatrix.Cols[VCount].Clear;

sgMatrix.FixedCols: =1;

sgMatrix.FixedRows: =1;

sgMatrix.Cells[VCount, 0]: =IntToStr(VCount);

sgMatrix.Cells[0, VCount]: =IntToStr(VCount);

VCenter[VCount-1].X: =X; // Задание координат

VCenter[VCount-1].Y: =Y;

if Colored then RepaintAllVertices // Перерисовка вершин

else RepaintVertex(X, Y);

MainMenu.Items[0].Items[0].Enabled: =True; // Новый

btnNew.Enabled: =True;

btnColoring.Enabled: =True;

GraphChanged: =True; // Граф нужно сохранить

MainMenu.Items[0].Items[2].Enabled: =True; // Сохранить

MainMenu.Items[1].Items[4].Enabled: =True; // Удалить вершину

end;

// Захват вершины левой кнопкой мыши

procedure TfmMain.FormMouseDown(Sender: TObject;

Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

var i: Byte;

begin

if (Button = mbLeft) and (Shift = [ssLeft]) then

begin

i: =1;

while i < = VCount do // Проверка нажатия на вершине

begin

if (abs(VCenter[i-1].X - X) < = VRadius) and

(abs(VCenter[i-1].Y - Y) < = VRadius) then

begin

MouseIsHeld: =true;

MouseHeldVNo: =i; // Номер выбранной вершины

Exit

end;

inc(i)

end;

// Соединение вершин перетаскиванием

procedure TfmMain.FormMouseMove(

Sender: TObject; Shift: TShiftState; X, Y: Integer);

var Rect: TRect;

begin

if MouseIsHeld then

begin

if (X < PaintAreaXMin) or (Y < PaintAreaYMin) or

(X > PaintAreaWidth) or (Y > PaintAreaHeight) then

// За пределами области построения графа

Exit;

// Очистка области, где ребро было на предыдущем шаге

Rect.Left: =min(DrawnEdge.src.X, DrawnEdge.dst.X)-3;

Rect.Right: =max(DrawnEdge.src.X, DrawnEdge.dst.X)+3;

Rect.Top: =min(DrawnEdge.src.Y, DrawnEdge.dst.Y)-3;

Rect.Bottom: =max(DrawnEdge.src.Y, DrawnEdge.dst.Y)+3;

RepaintOldEdge: =True;

InvalidateRect(Handle, @Rect, true);

Update;

DrawnEdge.src.X: =X; // Прорисовка нового ребра в следующей позиции

DrawnEdge.src.Y: =Y;

DrawnEdge.dst.X: =VCenter[MouseHeldVNo-1].X;

DrawnEdge.dst.Y: =VCenter[MouseHeldVNo-1].Y;

Rect.Left: =min(DrawnEdge.src.X, DrawnEdge.dst.X)-3;

Rect.Right: =max(DrawnEdge.src.X, DrawnEdge.dst.X)+3;

Rect.Top: =min(DrawnEdge.src.Y, DrawnEdge.dst.Y)-3;

Rect.Bottom: =max(DrawnEdge.src.Y, DrawnEdge.dst.Y)+3;

RepaintOldEdge: =False;

InvalidateRect(Handle, @Rect, true);

Update;

end;

procedure TfmMain.RemoveVertex( // Удаление выбранной вершины

VNo: Cardinal; var VCount: byte; var RemVrx: TVertices);

var i, j, RemVCount: Byte;

begin

if VCount = 0 then Exit;

FillAdMatrix(AdMatrix); // Перезапись sgMatrix в матрицу смежности

RemVCount: =0; // Формирование массива координат центров

for i: =1 to VCount do // вершин, смежных с удаляемой

if AdMatrix[VNo-1, i-1] > 0 then

begin

inc(RemVCount);

Setlength(RemVrx, RemVCount);

RemVrx[RemVCount-1].X: =VCenter[i-1].X;

RemVrx[RemVCount-1].Y: =VCenter[i-1].Y;

end;

for i: =VNo to VCount - 1 do // Перенумерация матрицы смежности

begin // и сдвиг массива координат центров вершин

VCenter[i-1]: =VCenter[i];

sgMatrix.Cells[i, 0]: =IntToStr(i);

sgMatrix.Cells[0, i]: =IntToStr(i);

end;

j: =VNo-1; // Удаление столбца VNo

while j < VCount - 1 do

begin

for i: =0 to VCount - 1 do AdMatrix[i, j]: =AdMatrix[i, j+1];

inc(j)

end;

i: =VNo-1; // Удаление строки VNo

while i < VCount - 1 do

begin

for j: =0 to VCount - 1 do AdMatrix[i, j]: =AdMatrix[i+1, j];

inc(i)

end;

dec(VCount); // Изменение размеров структур данных

SetLength(VCenter, VCount);

SetLength(VColor, VCount);

SetLength(AdMatrix, VCount, VCount);

if VCount = 0 then begin

InitForm; // Все вершины удалены

Exit

end;

sgMatrix.RowCount: =VCount+1; // Вершины еще остались

sgMatrix.ColCount: =VCount+1;

for i: =1 to VCount do // Восстановление измененной матрицы смежности

for j: =1 to VCount do

if AdMatrix[i-1, j-1]> 0 then

begin

sgMatrix.Cells[i, j]: ='1';

sgMatrix.Cells[j, i]: ='1';

end

else

begin

sgMatrix.Cells[i, j]: ='';

sgMatrix.Cells[j, i]: ='';

end;

// Перерисовка вершины на форме

procedure TfmMain.RepaintVertex(x, y: Integer; ForceUpdate: Boolean);

var Rect: TRect;

begin

Rect.Left: =x-VRadius;

Rect.Right: =x+VRadius;

Rect.Top: =y-VRadius;

Rect.Bottom: =y+VRadius;

InvalidateRect(Handle, @Rect, true);

if ForceUpdate then Update;

end;

// Перерисовка всех вершин на форме

procedure TfmMain.RepaintAllVertices;

var i: Byte;

begin

if VCount = 0 then Exit;

for i: =0 to VCount - 1 do

RepaintVertex(VCenter[i].X, VCenter[i].Y, false);

Update;

end;

// Перерисовка ребра на форме

procedure TfmMain.RepaintEdge(x1, y1, x2, y2: Integer);

var Rect: TRect;

begin

Rect.Left: =min(x1, x2)-2;

Rect.Right: =max(x1, x2)+2;

Rect.Top: =min(y1, y2)-2;

Rect.Bottom: =max(y1, y2)+2;

InvalidateRect(Handle, @Rect, true);

Update;

end;

// ------------------------ ИНИЦИАЛИЗАЦИЯ -----------------------------

// Приведение вида формы к исходному состоянию

procedure TfmMain.InitForm(Repaint: Boolean);

begin

VCount: =0;

sgMatrix.Visible: =False;

sgMatrix.RowCount: =1;

sgMatrix.ColCount: =1;

stGraph.Caption: ='Исходный граф: ';

if Repaint then fmMain.Repaint;

end;

// Инициализация глобальных и компонентных данных модуля

procedure TfmMain.FormActivate(Sender: TObject);

begin

InitForm(False);

InitUndo;

Randomize;

PaintAreaXMin: =stGraph.Left;

PaintAreaYMin: =stGraph.Top + stGraph.Height;

PaintAreaWidth: =sgMatrix.Left - PaintAreaXMin;

PaintAreaHeight: =StatusBar.Top - PaintAreaYMin;

MouseIsHeld: =False;

MouseHeldVNo: =0;

RepaintOldEdge: =False;

GraphChanged: =False;

MainMenu.Items[0].Items[0].Enabled: =False; // Новый

MainMenu.Items[0].Items[2].Enabled: =False; // Сохранить

MainMenu.Items[0].Items[3].Enabled: =False; // Сохранить как

MainMenu.Items[1].Items[4].Enabled: =False; // Удалить вершину

btnNew.Enabled: =False;

btnColoring.Enabled: =False;

StatusBar.SimpleText: ='Готово';

end;

// Завершающие действия

procedure TfmMain.FormDeactivate(Sender: TObject);

begin

AdMatrix: =Nil;

VCenter: =Nil;

VColor: =Nil;

UndoItem: =Nil;

end;

// Запрос на закрытие формы

procedure TfmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);

begin

btnExitClick(Sender);

CanClose: =True;

end;

// Инициализация структуры данных об отмененном действии

procedure TfmMain.InitUndo;

begin

SetLength(UndoItem, 2);

UndoItem[0].VNo: =0;

UndoItem[1].VNo: =0; // Блокировка пунктов меню

MainMenu.Items[1].Items[0].Enabled: =False; // Undo

MainMenu.Items[1].Items[1].Enabled: =False; // Redo

end;

end.

unit uData;

interface

uses Types, Graphics;

const MaxVCount = 30; // Максимальное число вершин графа

type // Глобально используемые типы

TAdMatrix = array of array of Byte; // Матрица смежности графа

TColoring = array of ShortInt; // Вектор цветов вершин

TRealColors = array[0..MaxVCount-1] of TColor; // Системные имена цветов

TVertices = array of TPoint; // Координаты центров вершин

TGraphFile = file of Byte; // Файл графа

implementation

end.

unit uFiling;

interface

uses uData;

// Функция сохранения графа в файле по матрице смежности

function DoSaveFile(const FileName: string; const AdMatrix: TAdMatrix): Boolean;

// Функция чтения графа из файла в матрицу смежности

function DoReadFile(const FileName: string;

var VCount: Byte; var AdMatrix: TAdMatrix): Boolean;

implementation

uses Math;

var GraphFile: TGraphFile; // Файл для сохранения графа

// Функция сохранения графа в файле по матрице смежности

function DoSaveFile(const FileName: string; const AdMatrix: TAdMatrix): Boolean;

var VCount, FileSize: Word;

FileImage: array of Byte;

i, j, Bit, m, u: Byte;

begin

result: =False;

if (FileName='') or (AdMatrix=Nil) then Exit;

AssignFile(GraphFile, FileName);

try // Открытие файла на запись

Rewrite(GraphFile);

except

Exit

end;

VCount: =High(AdMatrix)+1; // Создание массива для образа файла

FileSize: =Ceil(VCount*(VCount-1)/16);

SetLength(FileImage, FileSize+1);

FileImage[0]: =VCount;

Write(GraphFile, FileImage[0]);

m: =1; u: =0; Bit: =0;

for i: =0 to VCount - 2 do

for j: =i+1 to VCount - 1 do

begin // Перезапись матрицы смежности в массив

if Bit > 0 then u: =u shl 1;

inc(Bit);

if AdMatrix[i, j] > 0 then u: =u or $1;

if Bit > = 8 then

begin

Bit: =0;

FileImage[m]: =u;

Write(GraphFile, FileImage[m]);

inc(m);

u: =0;

end;

if Bit > 0 then // Дозапись последнего байта

begin

FileImage[m]: =u;

Write(GraphFile, FileImage[m]);

end;

CloseFile(GraphFile);

FileImage: =Nil;

result: =True;

end;

// Функция чтения графа из файла в матрицу смежности

function DoReadFile(const FileName: string;

var VCount: Byte; var AdMatrix: TAdMatrix): Boolean;

var OldVCount, FileSize: Word;

FileImage: array of Byte;

i, j, k, mask, q: Byte;

begin

result: =True;

if FileName='' then Exit;

AssignFile(GraphFile, FileName);

try // Открытие файла на чтение

Reset(GraphFile);

except

result: =False;

Exit

end;

OldVCount: =VCount;

Read(GraphFile, VCount); // Чтение числа вершин графа

if VCount > MaxVCount then begin

VCount: =OldVCount; // Некорректное число вершин

result: =False;

end

else

begin // Считывание матрицы смежности в массив

FileSize: =Ceil(VCount*(VCount-1)/16);

SetLength(FileImage, FileSize);

k: =0;

while not eof(GraphFile) do

begin

Read(GraphFile, FileImage[k]);

inc(k);

end;

if k = 0 then result: =False

else

begin

// Преобразование массива в матрицу смежности графа

SetLength(AdMatrix, VCount, VCount);

i: =0; j: =1;

for k: =0 to FileSize - 1 do

begin // Преобразование k-го элемента массива

if k = FileSize - 1 then

begin

mask: =1; // Расчет числа значащих бит последнего элемента

q: =(VCount*(VCount-1) div 2) mod 8;

mask: =mask shl (q-1);

end

else mask: =$80;

repeat // Распаковка битового образа элемента массива

if mask and FileImage[k] > 0 then

begin

AdMatrix[i, j]: =1;

AdMatrix[j, i]: =1;

end;

inc(j);

if j = VCount then

begin

inc(i);

j: =i+1;

end;

mask: =mask shr 1;

until mask = 0;

end;

FileImage: =Nil;

end;

CloseFile(GraphFile);

end;

end.

unit uColoring;

interface

uses uData, Graphics;

// Раскраска графа в минимальное число цветов

function DoMinColoring(const AdMatrix: TAdMatrix;

VCount: Cardinal; VColor: TColoring): Word;

// Раскраска графа в NewColorCount цветов по найденной минимальной раскраске

procedure DoNonminColoring(VCount: Cardinal; VColor: TColoring;

MinColorCount, NewColorCount: Byte);

// Обнуление массива цветов вершин графа

function ResetColoring(VCount: Cardinal; VColor: TColoring): boolean;

⇐ Предыдущая 1 2 34