Нужна помощь с задачей

Ответить
Absorber
Сообщения: 1
Зарегистрирован: 02 янв 2014, 21:23

02 янв 2014, 21:37

Задача: найти медиану графа, т.е такую его вершину. что сумма расстояний от нее до остальных вершин минимальна

Код: Выделить всё

var
  Form1: TForm1;
  r_g,i,j,k,s:Integer;
implementation
 
{$R *.dfm}
 
procedure TForm1.button1Click(Sender: TObject);
begin
if (length(Edit1.Text)>0)then
begin
  r_g:=StrToInt(Edit1.Text);
  StringGrid1.ColCount:= r_g;
  StringGrid1.RowCount:= r_g;
  StringGrid2.ColCount:= r_g;
  StringGrid2.RowCount:= r_g;
end
else
Application.MessageBox('Необходимо ввести число','Ошибка', MB_OK+MB_ICONSTOP);
end;
 
//задать граф
procedure TForm1.Button3Click(Sender: TObject);
begin
 for i:=0 to r_g-1 do
  for j:=0 to r_g-1 do
      begin
       if i=j then StringGrid1.Cells[i,j]:=IntToStr(0);  {между одной и той же вершиной}
       if i=j then StringGrid2.Cells[i,j]:=IntToStr(0)  {не может быть ребёр}
       else
       randomize;
       if i<>j then StringGrid1.Cells[i,j]:=IntToStr(random(2));
      end;
end;
 
//задать матрицу кратч. расстояний
procedure TForm1.Button2Click(Sender: TObject);
begin
 for i := 0 to StringGrid1.ColCount-1 do
       for j := 0 to StringGrid1.RowCount-1 do
         if StringGrid1.Cells[i, j] = ('0') then
            StringGrid2.Cells[i, j] := IntToStr(999)
         else
         if StringGrid1.Cells[i, j] = ('1') then
            StringGrid2.Cells[i, j] := 'inf';
end;
 
 
//Медиана по алг Флойда
procedure TForm1.Button9Click(Sender: TObject);
begin
     k := 1;
     while k < StringGrid2.ColCount-1 do
       begin
         for i := 1 to StringGrid2.ColCount-1 do
           for j := 1 to StringGrid2.RowCount-1 do
             begin
               if (i <> k) and (j <> k) and (i <> j) then
               if StrToInt(StringGrid2.Cells[i, j]) > StrToInt(StringGrid2.Cells[i, k]) + StrToInt(StringGrid2.Cells[k, j]) then
                   begin
                     StringGrid2.Cells[i, j] := IntToStr(StrToInt(StringGrid2.Cells[i, k]) + StrToInt(StringGrid2.Cells[k, j]));
                   end;
             end;
         k := k + 1;
       end;
end;
 
end.
Училка сказала, что прога должна нормально работать, нужно только устранить ошибки. Я копался, копался - и не разобрался. Помогите !!!
К слову сказать, прогу я не полностью понимаю, т.к слепил её из своих набросков и того, что нашёл в интернете.. Растолкуйте, если кто разбирается.
Ответить