![]() |
|
#1
|
|||
|
|||
![]() Привет всем...помогите пожалуйста...задача такая...задать граф с помощью матрицы смежности...расскрасить граф...(это у меня получилось)...а сейчас необходимо с помощью матрицы смежности найти матрицу расстояний, центр графа, радиус и диаметр...помогите очень надо...
это все что у меня получилось ![]() Код:
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, Grids, ComCtrls; type TForm1 = class(TForm) GroupBox1: TGroupBox; Label1: TLabel; Button1: TButton; Edit1: TEdit; Button2: TButton; GroupBox2: TGroupBox; StringGrid1: TStringGrid; Splitter1: TSplitter; GroupBox3: TGroupBox; StringGrid2: TStringGrid; Panel1: TPanel; Label3: TLabel; UpDown1: TUpDown; CheckBox1: TCheckBox; Label2: TLabel; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure StringGrid1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure StringGrid1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure StringGrid1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean); procedure FormCreate(Sender: TObject); procedure Edit1Change(Sender: TObject); procedure StringGrid1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; procedure Search(m: integer); var Form1: TForm1; run, painting: boolean; n, kol_krasok, k, a, b: integer; col: array of integer;// массив, содержащий цвета вершин C: array of array of Integer;// матрица смежности implementation {$R *.dfm} procedure Search(m: integer); var i, j: integer; doit: boolean; begin if m>n then begin // найдено решение Form1.Label3.Caption:='Количество цветов: '+inttostr(kol_krasok); for i:=1 to n do Form1.StringGrid2.Cells[i, 1]:=IntToStr(col[i]); run:=false; end else begin for i:=1 to kol_krasok do begin col[m]:=i; doit:=true; if m=1 then Search(m+1) else begin // если цвета вершин 1,...,m-1 соседних с m-ой не i, то запускаем перебор for j:=1 to m-1 do if (C[m, j]=1) and (col[j]=i) then doit:=false; if doit then Search(m+1); end; end; if (kol_krasok<k) and run then begin kol_krasok:=kol_krasok+1; col[m]:=kol_krasok; Search(m+1); kol_krasok:=kol_krasok-1; end; end; end; procedure TForm1.Button1Click(Sender: TObject); var q: integer; begin Label2.Caption:='Идет анализ...'; Form1.Repaint; kol_krasok:=1; k:=n; run:=true; for q:=1 to n do col[q]:=0; Search(1); Label2.Caption:='Готово!'; end; procedure TForm1.Button2Click(Sender: TObject); var i, j: integer; begin //обновляем МАТРИЦУ смежности SetLength(C, n+1, n+1); SetLength(col,n+1); for i:=0 to n do for j:=0 to n do C[i, j]:=0; for i:=1 to n do for j:=1 to n do if StringGrid1.Cells[i,j]='' then C[i, j]:=0 else C[i, j]:=1; Button1.Enabled:=true; end; procedure TForm1.StringGrid1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin if painting then if not(CheckBox1.Checked) then StringGrid1.Cells[a,b]:='1' else StringGrid1.Cells[a,b]:=''; end; procedure TForm1.StringGrid1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin painting:=true; end; procedure TForm1.StringGrid1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin painting:=false; end; procedure TForm1.StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer; var CanSelect: Boolean); begin a:=ACol; b:=ARow; end; procedure TForm1.FormCreate(Sender: TObject); var i, j: integer; begin Button2.Click; n:=10; SetLength(C, n+1, n+1); SetLength(col,n+1); for i:=0 to n do for j:=0 to n do C[i, j]:=0; C[1, 2]:=1; C[1, 8]:=1; C[2, 1]:=1; C[2, 3]:=1; C[2, 8]:=1; C[2, 10]:=1; C[3, 2]:=1; C[3, 4]:=1; C[4, 3]:=1; C[4, 5]:=1; C[5, 4]:=1; C[5, 6]:=1; C[6, 5]:=1; C[6, 7]:=1; C[7, 6]:=1; C[8, 1]:=1; C[8, 2]:=1; C[8, 9]:=1; C[9, 8]:=1; C[9, 10]:=1; C[10, 2]:=1; C[10, 9]:=1; //обновляем таблицу смежности for i:=1 to n do for j:=1 to n do if C[i, j]=0 then StringGrid1.Cells[i,j]:='' else StringGrid1.Cells[i,j]:='1'; end; procedure TForm1.Edit1Change(Sender: TObject); var i: integer; begin n:=strtoint(edit1.text); StringGrid1.RowCount:=n+1; StringGrid1.ColCount:=n+1; StringGrid2.ColCount:=n+1; for i:=1 to n+1 do StringGrid1.Cells[0,i]:=IntToStr(i); for i:=1 to n+1 do StringGrid1.Cells[i,0]:=IntToStr(i); StringGrid2.Cells[0,0]:='Вершины'; StringGrid2.Cells[0,1]:='Краски'; StringGrid2.ColWidths[0]:=100; for i:=1 to n+1 do StringGrid2.Cells[i,0]:=IntToStr(i); Button1.Enabled:=false; end; procedure TForm1.StringGrid1Click(Sender: TObject); begin Button1.Enabled:=false; end; end. Последний раз редактировалось Admin, 17.05.2009 в 17:02. |