На главную Наши проекты:
Журнал   ·   Discuz!ML   ·   Wiki   ·   DRKB   ·   Помощь проекту
ПРАВИЛА FAQ Помощь Участники Календарь Избранное RSS
msm.ru
Название темы должно быть информативным !
Прежде чем задать вопрос, воспользуйтесь Поиском. и проверьте в FAQ (ЧАВО) Паскаля
Чтобы получить вразумительный ответ, подробно опишите проблему: что надо сделать, что не получается и номер ошибки (если есть), которую выводит компилятор.
Для вставки кода ваших программ используйте, пожалуйста, кнопку СODE=pas или выпадающий список СODE для других языков (подсветка синтаксиса).
[!] Как правильно задавать вопросы | Руководство по языку B.Pascal 7 & Objects/LR | Borland Pascal. Руководство пользователя
Модераторы: volvo877
  
> нахождение центра ориентированного графа
    Всем программистам привет! Respect! Столкнулся с задачкой, которую пока незнаю как делать:
    Нап. программу нахождения центра ориентированного графа.
    в гугле порыскал, нашел определение:
    Цитата
    Вершина vi называется центральной, если e(vi) = r(G). Множество всех центральных вершин графа называется его центром. Граф G может иметь единственную центральную вершину или несколько центральных вершин.
    Также в нашем факе(немного о графах) описывается только алгоритм Дейкстры. Подскажите, с чего начать хотя бы, буду очень признателен. Подскажите как быть то?
      Цитата
      Центром орграфа G называется вершина с минимальным эксцентриситетом. Другими словами, центром орграфа является вершина, для которой максимальное расстояние (длина пути) до других вершин минимально.
      (ну, откуда цитата, ты и сам догадаешься? :) )

      Там же, чуть дальше:
      Цитата
      Найти центр орграфа сравнительно просто. Пусть С — матрица стоимостей для орграфа G.

      1. Сначала применим процедуру Floyd (листинг 6.4) к матрице С для вычисления матрицы А, содержащей все кратчайшие пути орграфа G.
      2. Находим максимальное значение в каждом столбце i матрицы А. Это значение равно эксцентриситету вершины i.
      3. Находим вершину с минимальным эксцентриситетом. Она и будет центром графа G.


      Реализовать сможешь?
        спасибо volvo877 за алгоритм, но есть вопросы:
        стоимость, это имеется ввиду вес дуги? или нет?
        допустим у меня есть орграф, состоящий из 4 - вершин(n = 4). Также каждому ребру графа приписан неотрицательный вес. Граф будем полагать ориентированным, т.е. если из вершины i есть ребро в вершину j, то из этого не следует наличие ребра из j в i. В случае если вершины все же соединены взаимообратными ребрами, веса, приписанные им, могут не совпадать.
        _____2(вершина с номером два)
        ___/__\
        _4/____\3(вес дуги)
        _1__2___\3
        __\_____/
        __8\___/6(вес)
        _____4(вершина)
        стрелки от 1 к 2, от 2 к 3, от 3 к 1, от 1 к 4 и от 3 к 4. Т е в данном случае нет нет взаимообратных ребер.
        Матрица А должна быть двумерной(т к храним пары вершин). Какая потребуется матрица в этом случае? Я думаю так:
        из вершины 1 можно попасть во все остальные, и не учитывать только ее саму(но включить в массив придется), т е варианты будут:
        1-1, 1-2, 1-3, 1-4. Аналогично для остальных, т е будет матрица 4 на 4. Наверное она будет квадратной в любом случае, а ее размерность будет зависеть от количества вершин графа(хотя может и нет :no: ).
        Дальше я запускаю такой цикл:
        ExpandedWrap disabled
          var
             k, i, j : byte;
          begin
             for k := 1 to n do
             begin
                 for i := 1 to n do
                 begin
                       for j := 1 to n do
                       begin
                            A[i, j] := min(A[i, j], A[i, k] + A[k, i]);  {здесь min как я понял функция С++, в паскале незнаю похожей}
                       end;
                 end;
             end;
          end;
        после завершения вычислений в матрице A будет храниться требуемый результат – длины минимальных путей для каждой пары вершин исходного графа.

        а дальше по пунктам:
        ExpandedWrap disabled
          2. Находим максимальное значение в каждом столбце i матрицы А(как я понимаю, исключая вариант i, i, т к там всегда будет ноль). Это значение равно эксцентриситету вершины i.
          3. Находим вершину с минимальным эксцентриситетом. Она и будет центром графа G.


        Но не понятно, количество вершин допустим я задам сам, а направление дуг и их вес, тоже нужно будет вводить с клавы. И как определиться, какие вершины между собой соединять дугами? или это все жестко зашить в коде? Также чем заменить функцию min(которая выдает минимальный из перечисленных параметров)? Подскажите как быть то?
          FasterHarder,
          Цитата
          Наверное она будет квадратной в любом случае, а ее размерность будет зависеть от количества вершин графа
          Угу, так и будет (только ее размер будет зависеть от кол-ва вершин, размерность = 2). Вот в твоем случае матрица будет выглядеть так:




          /1234
          1 0478
          2 5039
          3 2606
          4 0
          В таком случае минимальный эксцентриситет будет у вершины №4, она и будет центром орграфа.

          Цитата
          а направление дуг и их вес, тоже нужно будет вводить с клавы
          У тебя граф как задается вообще? В графическом виде? Значит, запрашивай у пользователя, соединена ли вершина №i с вершиной №j, и каков "вес" дуги.

          Цитата
          чем заменить функцию min(которая выдает минимальный из перечисленных параметров)
          Написать функцию min самому - не судьба? ;)
            в общем я начал делать, вот полный исходник:
            ExpandedWrap disabled
              program centerGraph;
              {$R-}   {отключаем проверку границ диапазона}
              uses
                  crt;
              type
                  pMyVector = ^myVector;
                  myVector = array[1..1] of shortInt;
                  myArrayPtr = ^myArray;
                  myArray = array[1..1] of pMyVector;
              var
                  countTop : shortInt;    {количество вершин графа}
                  matrixArc : myArrayPtr; {динамическая матрица хранит вес дуг графа}
                  minLength : myArrayPtr; {динамическая матрица хранит минимальные расстояния между вершинами}
              {===============================================================}
              {выделяем память для динамической матрицы}
              procedure getMemory(var x : myArrayPtr);
              var
                  i : byte;
              begin
                  getMem(x, countTop * sizeOf(pMyVector));
                  for i := 1 to countTop do
                  begin
                      getMem(x^[i], countTop * sizeOf(byte));
                  end;
              end;
              {===============================================================}
              {ввод весов дуг для орграфа}
              procedure inputValueOfArc;
              var
                  i, j : byte;
              begin
                  writeln('Если указанные вершины не соединены между собой, то введите ноль.');
                  writeln('Отрицательные значения недопустимы!');
               
                  for i := 1 to countTop do
                  begin
                      for j := 1 to countTop do
                      begin
                          if(i <> j) then
                          begin
                              write('Введите стоимость/"вес" дуги, соединяющей вершину с номером ', i, ' и вершину ', j, ': ');
                              readln(matrixArc^[i]^[j]);
                              if(matrixArc^[i]^[j] < 0) then
                              begin
                                  writeln('Введено отрицательное значение веса графа, что недопустимо! По умолчанию 2.');
                                  matrixArc^[i]^[j] := 2;
                              end;
                          end
                          else
                          begin
                              matrixArc^[i]^[j] := 0;
                          end;
                      end;
                  end;
              end;
              {===============================================================}
              {отображение динамической матрицы}
              procedure printWeightArc(x : myArrayPtr; comment : string);
              var
                  i, j : byte;
              begin
                  writeln;
                  writeln('Данный граф, состоящий из ', countTop, comment);
                  for i := 1 to countTop do
                  begin
                      for j := 1 to countTop do
                      begin
                          write(x^[i]^[j], ' ');
                      end;
                      writeln;
                  end;
              end;
              {===============================================================}
              {ищем минимальный из двух -> аналогия min в це плас плас}
              function min(a, b : byte) : byte;
              begin
                  if(a >= b) then
                  begin
                      min := b;
                  end
                  else
                  begin
                      min := a;
                  end;
              end;
              {===============================================================}
              {ищем минимальные расстояния между вершинами графа}
              procedure getMinLength;
              var
                  i, j, k : byte;
              begin
                  for k := 1 to countTop do
                  begin
                      for i := 1 to countTop do
                      begin
                          for j := 1 to countTop do
                          begin
                              if(i <> j) then
                              begin
                                  minLength^[i]^[j] := min(matrixArc^[i]^[j], matrixArc^[i]^[k] + matrixArc^[k]^[i]);
                              end;
                          end;
                      end;
                  end;
              end;
              {===============================================================}
              begin
                  clrscr;
               
                  writeln('Введите количество вершин графа');
                  writeln('Рекомендация: слишком большое количество вводить не нужно(в пределах 5),');
                  writeln('т к это существенно замедлит дальнейший ввод. Отрицательное значение недопустимо');
                  readln(countTop);
               
                  if(countTop <= 0) then
                  begin
                      writeln('Введено отрицательное количество вершин графа! По умолчанию принимается 4.');
                      countTop := 4;
                  end;
               
                  getMemory(matrixArc);
                  getMemory(minLength);
                  inputValueOfArc;
                  printWeightArc(matrixArc, ' вершин имеет следующие веса дуг:');
                  getMinLength;
                  printWeightArc(minLength, ' вершин имеет следующие минимальные расстояния:');
               
                  readln;
              end.


            но в результате я получил ужасную таблицу результатов по минимальным расстояниям графа:
            1|2|3|4
            0|4|0|8
            0|0|0|0
            2|0|0|6
            0|0|0|0

            я понимаю, что скорее всего ошибка в процедуре getMinLength, но вроде сделал все как описано в алгоритме. Подскажите как быть то?
              Заполняем твою матрицу вот таким образом:
              ExpandedWrap disabled
                procedure inputValueOfArc;
                var
                    i, j : byte;
                begin
                  for i := 1 to countTop do
                    for j := 1 to countTop do matrixArc^[i]^[j] := 50; { <-- 50 в данном случае = бесконечности }
                 
                  matrixArc^[1]^[2] := 4;
                  matrixArc^[1]^[4] := 8;
                  matrixArc^[2]^[3] := 3;
                  matrixArc^[3]^[1] := 2;
                  matrixArc^[3]^[4] := 6;
                 
                end;

              и переписываем GetMinLength чуть-чуть по другому:
              ExpandedWrap disabled
                procedure getMinLength;
                var
                    i, j, k : byte;
                begin
                    for i := 1 to countTop do
                      for j := 1 to countTop do begin
                        minLength^[i]^[j] := matrixArc^[i]^[j];
                      end;
                 
                    for k := 1 to countTop do
                    begin
                        for i := 1 to countTop do
                        begin
                            for j := 1 to countTop do
                            begin
                                if minLength^[i]^[k] + minLength^[k]^[j] < minLength^[i]^[j] then begin
                                  minLength^[i]^[j] := minLength^[i]^[k] + minLength^[k]^[j]
                                end;
                            end;
                        end;
                    end;
                 
                    for i := 1 to countTop do
                      minLength^[i]^[i] := 0;
                 
                end;
              ... и посмотри на результат вычисления...

              Кстати, ты уж начал работать с shortInt, так работай с ним везде, а то sizeof(byte) дезориентирует.
                великолепно, как вам это удается :) , сейчас все получается как и должно быть, нет слов, превосходно. Теперь и функция мин не юзается :no: . Я дописал прогу до конца, но остался чисто теоретически вопрос. Как вы написали, что:
                ExpandedWrap disabled
                  2. Находим максимальное значение в каждом столбце i матрицы А. Это значение равно эксцентриситету вершины i.
                  3. Находим вершину с минимальным эксцентриситетом. Она и будет центром графа G.

                по второму пункту отбираются следующие значения:
                1 2 3 4
                5 6 7 9

                затем берем минимальный, следовательно это будет 5, и располагается в вершине с номером 1. Почему ответ 4 - ая вершина?
                вот часть дописанного исходника:
                ExpandedWrap disabled
                  {===============================================================}
                  {ищем минимальные расстояния между вершинами графа}
                  procedure getMinLength;
                  var
                      i, j, k : byte;
                  begin
                      for i := 1 to countTop do
                      begin
                          for j := 1 to countTop do
                          begin
                              minLength^[i]^[j] := matrixArc^[i]^[j];
                          end;
                      end;
                   
                      for k := 1 to countTop do
                      begin
                          for i := 1 to countTop do
                          begin
                              for j := 1 to countTop do
                              begin
                                  if(minLength^[i]^[k] + minLength^[k]^[j] < minLength^[i]^[j]) then
                                  begin
                                      minLength^[i]^[j] := minLength^[i]^[k] + minLength^[k]^[j];
                                  end;
                              end;
                          end;
                      end;
                      for i := 1 to countTop do
                      begin
                          minLength^[i]^[i] := 0;
                      end;
                  end;
                  {===============================================================}
                  {находим искомую вершину, являющуюся центром орграфа}
                  function seekCenterGraf : byte;
                  var
                      i, j : byte;
                      maxColumn, center : byte;
                      minMatrix : byte;
                  begin
                      center := 1;        {иначе может быть такая ситуация, что центр будет в первой вершине, и отобразится
                                      в переменной мусор, т к какое либо значение ни разу не будет присвоено}
                      minMatrix := minLength^[1]^[1];
                      for i := 1 to countTop do
                      begin
                          maxColumn := minLength^[i]^[1];
                          for j := 1 to countTop do
                          begin
                              if(minLength^[j]^[i] = 100) then    {бесконечность}
                              begin
                                  continue;
                              end;
                              if(minLength^[j]^[i] > maxColumn) then
                              begin
                                  maxColumn := minLength^[j]^[i];
                              end;
                          end;
                          if(minMatrix > maxColumn) then
                          begin
                              minMatrix := maxColumn;
                              center := i
                          end;
                      end;
                      seekCenterGraf := center;
                  end;
                  {===============================================================}
                  begin
                      clrscr;
                   
                      writeln('Введите количество вершин графа');
                      writeln('Рекомендация: слишком большое количество вводить не нужно(в пределах 5),');
                      writeln('т к это существенно замедлит дальнейший ввод. Отрицательное значение недопустимо');
                      readln(countTop);
                   
                      if(countTop <= 0) then
                      begin
                          writeln('Введено отрицательное количество вершин графа! По умолчанию принимается 4.');
                          countTop := 4;
                      end;
                   
                      getMemory(matrixArc);
                      getMemory(minLength);
                      inputValueOfArc;
                      printWeightArc(matrixArc, ' вершин имеет следующие веса дуг:');
                      getMinLength;
                      printWeightArc(minLength, ' вершин имеет следующие минимальные расстояния:');
                      writeln;
                      writeln('Центром данного орграфа является вершина под номером: ', seekCenterGraf:2);
                   
                      readln;
                  end.


                Подскажите как быть то?
                  Цитата FasterHarder @
                  по второму пункту отбираются следующие значения:

                  неправда... Бесконечность - она и есть бесконечность (это же не 0), так что первые три значения будут именно 50 (или +infinity), а вот четвертое - как раз 9, следовательно ответ - четвертая вершина.
                    теперь стало все понятно. Thank's за помощь уважаемый модератор ;) . Вот полный исходник, может кому пригодится:
                    единственное что еще не учтено, что в орграфе может быть несколько центров, но это уже доделать не так сложно, наверное :D(нужен будет одномерный динамический массив, с количеством элементов = количеству вершин -> записывать туда максимумы по столбцам -> первым циклом найти минимум, а вторым сравнить каждый элемент с этим минимумом, и если равны, то найден еще один центр графа).
                    ExpandedWrap disabled
                      program centerGraph;
                      {$R-}   {отключаем проверку границ диапазона}
                      uses
                          crt;
                      type
                          pMyVector = ^myVector;
                          myVector = array[1..1] of shortInt;
                          myArrayPtr = ^myArray;
                          myArray = array[1..1] of pMyVector;
                      var
                          countTop : shortInt;    {количество вершин графа}
                          matrixArc : myArrayPtr; {динамическая матрица хранит вес дуг графа}
                          minLength : myArrayPtr; {динамическая матрица хранит минимальные расстояния между вершинами}
                      {===============================================================}
                      {выделяем память для динамической матрицы}
                      procedure getMemory(var x : myArrayPtr);
                      var
                          i : byte;
                      begin
                          getMem(x, countTop * sizeOf(pMyVector));
                          for i := 1 to countTop do
                          begin
                              getMem(x^[i], countTop * sizeOf(shortInt));
                          end;
                      end;
                      {===============================================================}
                      {ввод весов дуг для орграфа}
                      procedure inputValueOfArc;
                      var
                          i, j : byte;
                      begin
                          writeln('Если указанные вершины не соединены между собой, то введите 100(аналог бесконечность).');
                          writeln('Отрицательные значения недопустимы!');
                       
                          for i := 1 to countTop do
                          begin
                              for j := 1 to countTop do
                              begin
                                  if(i <> j) then
                                  begin
                                      write('Введите стоимость/"вес" дуги, соединяющей вершину с номером ', i, ' и вершину ', j, ': ');
                                      {$I-}
                                      readln(matrixArc^[i]^[j]);
                                      {$I+}
                                      if(IOResult <> 0) then
                                      begin
                                          writeln('Ошибка ввода! Принимаем значение по умолчанию 10.');
                                          matrixArc^[i]^[j] := 10;
                                      end;
                                      if(matrixArc^[i]^[j] < 0) then
                                      begin
                                          writeln('Введено отрицательное значение веса графа, что недопустимо! По умолчанию 10.');
                                          matrixArc^[i]^[j] := 10;
                                      end;
                                  end
                                  else
                                  begin
                                      matrixArc^[i]^[j] := 0;
                                  end;
                              end;
                          end;
                      end;
                      {===============================================================}
                      {отображение динамической матрицы}
                      procedure printWeightArc(x : myArrayPtr; comment : string);
                      var
                          i, j : byte;
                      begin
                          writeln;
                          writeln('Данный граф, состоящий из ', countTop, comment);
                          for i := 1 to countTop do
                          begin
                              for j := 1 to countTop do
                              begin
                                  write(x^[i]^[j]:3, ' ');
                              end;
                              writeln;
                          end;
                      end;
                      {===============================================================}
                      {ищем минимальные расстояния между вершинами графа}
                      procedure getMinLength;
                      var
                          i, j, k : byte;
                      begin
                          for i := 1 to countTop do
                          begin
                              for j := 1 to countTop do
                              begin
                                  minLength^[i]^[j] := matrixArc^[i]^[j];
                              end;
                          end;
                       
                          for k := 1 to countTop do
                          begin
                              for i := 1 to countTop do
                              begin
                                  for j := 1 to countTop do
                                  begin
                                      if(minLength^[i]^[k] + minLength^[k]^[j] < minLength^[i]^[j]) then
                                      begin
                                          minLength^[i]^[j] := minLength^[i]^[k] + minLength^[k]^[j];
                                      end;
                                  end;
                              end;
                          end;
                          for i := 1 to countTop do
                          begin
                              minLength^[i]^[i] := 0;
                          end;
                      end;
                      {===============================================================}
                      {находим искомую вершину, являющуюся центром орграфа}
                      function seekCenterGraf : byte;
                      var
                          i, j : byte;
                          maxColumn, center : byte;
                          minMatrix : byte;
                      begin
                          center := 1;        {иначе может быть такая ситуация, что центр будет в первой вершине, и отобразится
                                          в переменной мусор, т к какое либо значение ни разу не будет присвоено}
                          minMatrix := 101;
                          for i := 1 to countTop do
                          begin
                              maxColumn := minLength^[1]^[i];
                              for j := 1 to countTop do
                              begin
                                  if(minLength^[j]^[i] > maxColumn) then
                                  begin
                                      maxColumn := minLength^[j]^[i];
                                  end;
                              end;
                              if(minMatrix > maxColumn) then
                              begin
                                  minMatrix := maxColumn;
                                  center := i
                              end;
                          end;
                          seekCenterGraf := center;
                      end;
                      {===============================================================}
                      begin
                          clrscr;
                       
                          writeln('Введите количество вершин графа');
                          writeln('Рекомендация: слишком большое количество вводить не нужно(в пределах 5),');
                          writeln('т к это существенно замедлит дальнейший ввод. Отрицательное значение недопустимо');
                          readln(countTop);
                       
                          if(countTop <= 0) then
                          begin
                              writeln('Введено отрицательное количество вершин графа! По умолчанию принимается 4.');
                              countTop := 4;
                          end;
                       
                          getMemory(matrixArc);
                          getMemory(minLength);
                          inputValueOfArc;
                          printWeightArc(matrixArc, ' вершин имеет следующие веса дуг:');
                          getMinLength;
                          printWeightArc(minLength, ' вершин имеет следующие минимальные расстояния:');
                          writeln;
                          writeln('Центром данного орграфа является вершина под номером: ', seekCenterGraf:2);
                       
                          readln;
                      end.


                    Добавлено
                    все таки спрошу, а может есть какой то другой алгоритм для поиска всех центров(т е не тот, каким я хотел сделать при помощи еще одного динамического массива). Может можно как то все сделать в цикле, когда идет поиск максимумов по столбцам? Подскажите как быть то?
                      Я не понял, у тебя проблема в матрице найти список номеров столбцов, максимумы которых минимальны? :o

                      Например, так (все равно больше чем 255 вершин не будет, да если и будет - множество можно и "расширить"):
                      ExpandedWrap disabled
                        const
                          size = 4;
                          arr: array[1 .. size, 1 .. size] of integer = (
                          ( 0,    4,    7,    8),
                          ( 5,    0,    3,    9),
                          ( 2,    6,    0,    6),
                          (50,   50,   50,    0)
                          );
                         
                        var
                          i, row, col: integer;
                          min, max: integer;
                          list: set of byte; { <--- Почему ты множества не используешь - не понимаю... }
                         
                         
                        begin
                          min := maxint;
                          list := [];
                         
                          for col := 1 to size do begin
                            max := arr[1, col];
                            for row := 2 to size do begin
                              if max < arr[row, col] then max := arr[row, col];
                            end;
                         
                            if min > max then begin
                              min := max; list := [col];
                            end
                            else if min = max then list := list + [col];
                         
                          end;
                         
                          writeln('list: ');
                          for i := 1 to size do
                            if i in list then writeln(i);
                        end.
                        Цитата
                        Я не понял, у тебя проблема в матрице найти список номеров столбцов, максимумы которых минимальны?

                        нет нет, проблемы нет, но хотелось бы наиболее оптимально. Более внимательно посмотрю ваш вариант. :)

                        Добавлено
                        все, я разобрался полностью с вашим примером, на самом деле лучше и не придумать(не то что я хотел через дополнительный динамический массив :no: ). Тут изюминка в том, что:
                        ExpandedWrap disabled
                              if min > max then begin
                                min := max; list := [col];
                              end
                              else if min = max then list := list + [col];

                        можно смело обнулять множество новым минимальным, т к все что было раньше накоплено во множестве не подходит по определению. Respect.

                        Сообщения были разделены в тему "Абсолютный центр неорграфа"
                        0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
                        0 пользователей:


                        Рейтинг@Mail.ru
                        [ Script execution time: 0,0608 ]   [ 15 queries used ]   [ Generated: 28.03.24, 12:22 GMT ]