Помогите с сортировкой Опции

[RussoTuristo]

Задача состоит в нахождении минимального остова графа ... Задаю матрицу смежности ( элементу матрицы a[i,j]:=w, где w - вес ребра)
Мне нужно отсортировать рёбра по весу, задача вроде лёгкая, но либо я туплю, либо всё не так просто ...

For i:=1 to n do
   For j:=1 to n do
   if Pred a[i,j]< a[i,j] then .....

Хотел использовать пузырьковую сортировку ...
Проблема состоит в том что я не знаю как записать предыдущий элемент...
Или может как-то по-другому надо поступать?

Сообщение отредактировано: RussoTuristo - 18.12.2008 17:29

[amega]

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

[RussoTuristo]

k:=0;
for i:=1 to n do
   for j:=1 to n do
   inc(k);
   a[i,j]:=b[k];
   p:=k;

Переписали в массив

for i:=1 to n do
   for k:=p downto i+1
   if b[k-1]>b[k] then
   begin
       T:=b[k-1];
       b[k-1]:=b[k];
       b[k]:=T;
   end

Отсортировали массив ...
Но мне нужно работать именно с элементами a[i,j] потому что нужно окрашивать вершины (m[i]:=1 - вершина вошла в остов ....)
Как обратно переделать чтоб отсортированный массив b[k] стал a[i,j]?

Сообщение отредактировано: RussoTuristo - 19.12.2008 14:45

[volvo]

Переписали в массив

Ты ничего в массив не переписал:

k:=0;
for i:=1 to n do
   for j:=1 to n do
   inc(k); { <--- В цикле у тебя выполняется только этот оператор }
   a[i,j]:=b[k];
   p:=k;

, то есть все, чего ты добился - это изменение в цикле K, и присваивания непонятно чему (после цикла в переменных I, J может храниться все, что угодно) значения b[ K ]...

P.S. Нахождение мин. остова алгоритмами Прима и Краскала есть здесь: графы

Будет проще из твоей матрицы смежности сделать список ребер, и прогнать алгоритм Краскала, чем изобретать велосипед...

[RussoTuristo]

спасибо, насчет массива понял, забыл begin end

А насчет алгоритмов, не мог бы кто-нибудь пояснить алгоритмы, приведенные в ссылках ..

Мне надо решить жадным алгоритмом, т.е найти ребро минимального веса, окрасить вершины, инцидентные этому ребру. Затем найти ребро минимального веса, смежное найденному и т.д.
Просто сложновато разобраться в алгоритмах, они там без пояснений. По-моему алгоритм Прима похож на нужный мне (Насколько я понимаю их отличие в том, что алгоритм прима в качестве начальной берет первую попавшуюся вершину, а жадный - нужный мне, для начала берет ребро минимального веса, вроде правильно понял и если там представлена реализация этого алгоритма Прима) ...

[RussoTuristo]

Построение минимального каркаса методом Прима:

procedure solve;
var sm,sp:set of 1..maxn;
    min,i,j,l,t:integer;
begin
   min:=maxint;
   sm:=[1..n];sp:=[];
   for i:=1 to n-1 do
      for j:=i+1 to n do
         if (a[i,j] < min) and (a[i,j] <> 0) then
            begin
               min:=a[i,j];
               l:=i;t:=j;
            end;
   sp:=[l,t];sm:=sm-[l,t];
   write(l,' ',t ,'  ');

Ищем ребро минимально веса. Включаем вершины в список минимального остова, и исключаем вершины из списка неокрашенных ...

 while sm <> [] do
      begin
         min:=maxint;
         l:=0;t:=0;
         for i:=1 to n do
            if not (i in sp) then
               for j:=1 to n do
                  if (j in sp) and (a[i,j] < min) and (a[i,j] <> 0) then
                     begin
                        min:=a[i,j];
                        l:=i;t:=j;
                     end;
         sp:=sp+[l];sm:=sm-[l];
         write(l,' ',t,'  ');
      end;
end;

Потом находим оставшиеся рёбра остова ... вроде всё так ...

sp - список включенных ребер
sm - список оставшихся вершин

Есть еще один вопросик: Можно ли в этот алгоритм как-нибудь вставить стек, очередь или дек? Возможно ли их применение в этом алгоритме?

Сообщение отредактировано: RussoTuristo - 19.12.2008 18:09

[RussoTuristo]

procedure TForm1.SpeedButton3Click(Sender: TObject);
var
sm,sp:set of 1..maxn;
min,i,j,l,t:integer;
begin

min:=maxint;
sm:=[1..n];
sp:=[];
for i:=1 to n-1 do
  for j:=i+1 to n do
    begin
      min:=a[i,j];
      l:=i;
      t:=j;
    end;
ar[i,j]:=a[l,t];

while sm<>[] do
  begin
    min:=maxint;
    l:=0;
    t:=0;
    for i:=1 to n do
      if not (i in sp) then
        for j:=1 to n do
          if (j in sp) and (a[i,j]<min) and (a[i,j]<>0) then
            begin
              min:=a[i,j];
              l:=i; t:=j;
            end;
    sp:=sp+[l]; sm:=sm-[l];
    ar[i,j]:=a[l,t];
  end;
end;

Вроде все так ....


Помогите пожалуйста:

var
  Form1: TForm1;
    f:file of integer;
    idown,n,wrt,i,j:integer;
    a,ar:array[1..10,1..10] of integer;
    m:array[1..10] of integer;
    vx:array[1..10] of integer;
vy:array[1..10] of integer;

implementation

{$R *.dfm}

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
assignfile(f,extractfilepath(application.exename)+'\in.krs');
rewrite(f);
for i:= 1 to n do              {записуем в файл введенные данные }
for j:= 1 to n do
begin
if sg.cells[i,j]='-' then
wrt:=999
else
wrt:=strtoint(sg.cells[i,j]);
write(f,wrt);
end;
closefile(f);
end;

Выдает ошибку
[Warning] Unit1.pas(72): Unsafe type 'f: file of Integer'

Сообщение отредактировано: RussoTuristo - 20.12.2008 17:30

[RussoTuristo]

Может всё-таки кто-нибудь сможет помочь с ошибкой ...
Завтра сдавать программу, я вообще не понимаю из-за чего эта ошибка вылезает, запускаешь прогу и вылезает сообщение: is not a valid integer value. Хотя раньше запускалась программа, а с вводом данных я ничего не трогал ...