Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 25.03.2011, 16:56   #1
havoc
 
Регистрация: 23.03.2011
Сообщений: 6
По умолчанию Поиск абсолютной b(p)-медианы графа. алгоритм. или его часть.

подскажите пожалуйста алгоритм, может есть у кого? (не приближенный)

или хотябы поиск числа сочетаний b-элементов из множества n(n=1,2,3...). т.е. все возможные сочетания из b вершин графа это. составная часть основного алгоритма.
что ни пытаюсь навоять - получается громоздко и всеравно как надо неработает

Последний раз редактировалось havoc; 25.03.2011 в 17:03.
havoc вне форума Ответить с цитированием
Старый 25.03.2011, 17:11   #2
Летучий_СкилетиК
Форумчанин
 
Аватар для Летучий_СкилетиК
 
Регистрация: 04.02.2011
Сообщений: 260
По умолчанию

Цитата:
Сообщение от havoc Посмотреть сообщение

поиск числа сочетаний b-элементов из множества n(n=1,2,3...). т.е. все возможные сочетания из b вершин графа
в смысле сочитания n по m? если да то код такой:
Код:
	  type Sequence=array [byte] of byte;
	  var M,N:byte;
	      X:Sequence;
   procedure Generate(k:byte);
	    var i,j:byte;
	  begin
	    if k=N then
	      begin for i:=1 to N do write(X[i]);writeln end
	    else
	      for j:=1 to M do
		begin X[k+1]:=j; Generate(k+1) end
	  end;
	begin
	  write('M,N=');readln(M,N);
	  Generate(0)
 end.
p.s дайте полное условие задачи

Последний раз редактировалось Летучий_СкилетиК; 25.03.2011 в 17:19.
Летучий_СкилетиК вне форума Ответить с цитированием
Старый 25.03.2011, 17:50   #3
havoc
 
Регистрация: 23.03.2011
Сообщений: 6
По умолчанию

Цитата:
Сообщение от Летучий_СкилетиК Посмотреть сообщение
в смысле сочитания n по m? если да то код такой:
Код:
	  type Sequence=array [byte] of byte;
	  var M,N:byte;
	      X:Sequence;
   procedure Generate(k:byte);
	    var i,j:byte;
	  begin
	    if k=N then
	      begin for i:=1 to N do write(X[i]);writeln end
	    else
	      for j:=1 to M do
		begin X[k+1]:=j; Generate(k+1) end
	  end;
	begin
	  write('M,N=');readln(M,N);
	  Generate(0)
 end.
p.s дайте полное условие задачи
про число сочетаний вроде оно, спасибо
про b-медиану попробую сформулировать:
дан взвешенный неориентированный граф.
1. задается колличество медиан b<=общему колличеству вершин
2. выбираем произвольно b вершин.
3. все оставшиеся вершины прикрепляем к одной из b выбранных вершин по кратчайшему пути.
4. рассчитываем передаточное число для каждой из b вершин(сумма произведений длины пути(кратчайшего) до прикрепленой вершины на ее вес), при этом каждая часть графа считается отдельно. (т.е. всего b графов, каждый состоит из тех вершин которые мы прикрепили)
5. суммируем b передаточных чисел, запоминаем.
6. проделываем пункты 2-5 пока не переберем все сочетания
7. из получившегося массива выбираем минимальное значение. b-вершины для которых оно получено и будут являться b-медианой графа.
как-то так. думаю врятли кто будет заморачиваться, если готового нету. сделаю(надеюсь) - выложу.

Последний раз редактировалось havoc; 26.03.2011 в 08:20.
havoc вне форума Ответить с цитированием
Старый 26.03.2011, 08:13   #4
havoc
 
Регистрация: 23.03.2011
Сообщений: 6
По умолчанию

хочу записать все сочетания в строки двумерного массива. делаю так:
Код:
for i:=1 to b do
 nvers[i]:=i;
k:=0;
repeat
inc(k);
 for i:=1 to b do
  g[k,i]:=nvers[i];
 i:=b;
 while nvers[i]=vdmax-b+i do
  dec(i);
 inc(nvers[i]);
 for j:=i+1 to b do
 nvers[j]:=nvers[j-1]+1;

until i=0 ;
ругается на
Код:
g[k,i]:=nvers[i];
пишет
Цитата:
Hint] CHILDWIN.PAS(64): Overriding virtual method 'TMDIChild.CreateParams' has lower visibility (private) than base class 'TForm' (protected)
но если убрать эту строку и просто выводить массив nvers[i] в цикле от 1 до b после каждого повторения, сочетания отображаются корректно, ошибок нет.

UPD: ошибка найдена, неверно была задана длинна массива

Последний раз редактировалось havoc; 26.03.2011 в 12:25.
havoc вне форума Ответить с цитированием
Старый 27.03.2011, 23:06   #5
havoc
 
Регистрация: 23.03.2011
Сообщений: 6
По умолчанию

как обещал, алгоритм поиска b-медианы:

Код:
procedure lUr(var mas:array of array of integer);

var X, Y, h,k,i,j,b,sum,vdmax,minst: Integer;
    a: array of array of integer;
    c: array of array of integer;      
    rbmas:array of array of integer;
    nvers: array of integer;
    g:array of array of integer;
    res1,res2,res3: extended;
    prizn:boolean;
    q:array of tcolor; //массив цветов для разных групп вершин
    s:string;
begin
b:=4;     //колличество искомых медиан
res1:=1;
res2:=1;
res3:=1;
SetLength(nvers, CircleMax + 1);
SetLength(q, b + 1);
for i:=1 to circlemax do                //массив из существующих номеров вершин
   nvers[i]:=i;

for i:=1 to b do
  res1:=res1*i;
for i:=1 to vdmax-b do
 res2:=res2*i;
for i:=1 to vdmax do
 res3:=res3*i ;
h:=round(res3/(res2*res1));  //колличество комбинаций b вершин 

SetLength(rbmas, h+1,CircleMax + 1);
SetLength(g, h+1,b+1);
SetLength(a, CircleMax + 1,CircleMax + 1);
SetLength(c, CircleMax + 1,CircleMax + 1);

for X := 1 to circlemax do                             //заполняем матрицу весов
   for Y := 1 to circlemax do begin
        begin
         c[x,y]:=mas[x,y];          //это будет преобразовано в матрицу кратчайших расстояний
         a[x,y]:=y                       //это в матрицу кратчайших маршрутов
         end
       else
        begin
        c[x,y]:=2147483647;       //бесконечность
        a[x,y]:=0;
        end;
       if x=y then
        c[x,y]:=0;              //расст. от верш до самой себя =0

     end;
                                         
for k:=1 to circlemax do                 
    for i:=1 to circlemax do
      for j:=1 to circlemax do
       if (c[i,k] < 2147483647) and (c[k,j] < 2147483647) then
        if (c[i,k]+c[k,j] < c[i,j]) then
        begin
          c[i,j]:=c[i,k]+c[k,j];       //заполняем матрицу кратчайших расстояний
          a[i,j]:=a[i,k];  //и матрицу кратчайших маршрутов по алг. Флойда
        end;

   minst:=2147483647;
{------это для поиска обычной(одной медианы графа)-------}
   for x:=1 to circlemax do              
     begin   
     sum:=0;
     for y:=1 to circlemax do
       begin
        sum:=sum+c[x,y]* Circle[y].VesV;// считаем передаточные числа вершин
    
        end;
    if sum<minst then begin       // ищим минимум
    minst:=sum;
    h:=x;       //номер вершины, являющейся медианой
    end;
   end;
{--------------конец------------------}


{формируем массив из комбинаций b вершин}
for i:=1 to b do
 nvers[i]:=i   ;          //первая комбинация
k:=0;
repeat
inc(k);
 for i:=1 to b do
  g[k,i]:=nvers[i];
 i:=b;
 while nvers[i]=vdmax-b+i do
  dec(i);
 inc(nvers[i]);
 for j:=i+1 to b do
 nvers[j]:=nvers[j-1]+1;
until i=0 ;
{конец}

h:=round(res3/(res2*res1)); //макс. колличество комбинаций

for i:=1 to h do                 //цикл по строке матрицы сочетаний
 for k:=1 to circlemax do //цикл по столбцу матрицы кратчайших расстояний
 begin    
  minst:= 2147483647;
   for j:=1 to b do             //цикл по столбцу матрицы сочетаний
    begin                             
     prizn:=true;
     for y:=1 to b do          //проверка есть ли в текущем сочетании вершин
      if g[i,y]=k then prizn:=false ; // вершина с номером к

    if prizn=true then
    if (k<>g[i,j]) and (c[g[i,j],k]*Circle[k].VesV<minst) then
      begin
      minst:=c[g[i,j],k]*Circle[k].VesV;   //ищим от какой вершины из текущего
       rbmas[i,k]:=g[i,j];     //cочетания до вершины k расстояние минимальное
      end;                             //записываем в массив rbmas   у него строка
    end;                              //это номер сочетания, столбец номер вершины в 
 end;                                //графе, сам элемент - номер вершина из сочетания 
                                        //за которой закрепляется вершина графа

minst:=2147483647;
for i:=1 to h do begin
sum:=0;                         //считем сумму передаточных чисел вершин каждого
 for j:=1 to circlemax do //сочетания, находим минимальную, запоминаем
  if  rbmas[i,j]<>0 then      //номер сочетания
   sum:=sum+c[rbmas[i,j],j]*Circle[j].VesV;
 if sum<minst then
  begin
  minst:=sum;
  x:=i;
 end;
end;

{все, теперь используя найденный номер сочетания выводим элементы g[x,i]. это и будут искомые вершины.
 еще можно вывести маршруты от b медиан до прикрепленных вершин. да впринцепи много чего сделать
 со сгенерированными данными}
код, конечно кривоват, неоптимален, но я его для графического редактора писал а там имеются некоторые особенности.
надеюсь комунибудь будет полезно

Последний раз редактировалось havoc; 27.03.2011 в 23:27.
havoc вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Алгоритм обхода графа helena91 Паскаль, Turbo Pascal, PascalABC.NET 1 01.03.2011 15:40
показать алгоритм в виде графа. Нина93 Помощь студентам 0 26.12.2010 14:31
Комбинаторный алгоритм и использование графа DaRy Помощь студентам 1 08.02.2010 21:50
Поиск возможных путей графа RammFan Общие вопросы Delphi 2 19.06.2008 10:45