Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > [ "Начинающим" ]
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

 
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 17.05.2009, 16:49
odyvanchik odyvanchik вне форума
Прохожий
 
Регистрация: 17.05.2009
Сообщения: 1
Репутация: 10
По умолчанию Работа с графом

Привет всем...помогите пожалуйста...задача такая...задать граф с помощью матрицы смежности...расскрасить граф...(это у меня получилось)...а сейчас необходимо с помощью матрицы смежности найти матрицу расстояний, центр графа, радиус и диаметр...помогите очень надо...
это все что у меня получилось :
Код:
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: Пользуемся тегами!

Последний раз редактировалось Admin, 17.05.2009 в 17:02.
Ответить с цитированием
 


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 21:14.


 

Сайт

Форум

FAQ

Соглашения

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2025