Digs - Персональная территория

Авторский проект Артема Глазкова
? 
        Версия для печати (цвет)  

Алгоритмы
» Раскраска текста
» Радиальная раскладка графа
» Генерация случайных графов
» Сбалансированное дерево

Использование материалов
Заметка #23
25 октября 2006

Генерация случайных графов


    Программисты очень ленивый народ. Они никогда не будут делать того, что может сделать за них компьютер. Для предыдущей заметки, мне требовался некоторый граф, для которого предстояло сделать раскладку. А где взять такой граф? Можно конечно построить его на бумаге, а потом занести в компьютер все его ребра. Либо написать редактор графов или найти такой в инете. В любом случае граф придется выдумать и нарисовать. А так как программисту проще написать программу, чем что-то там рисовать, то я просто сел и написал следующий алгоритм генерации графа.

    Алгоритм
    В одной из книжек лежащих в данный момент на моей полке было предложено создать некоторое число узлов и полным перебором пар с некоторой вероятностью добавить ребра между узлами. Честно говоря, после постройки графа по такому принципу (слово «алгоритм» язык не повернулся сказать), я увидел практически хаос. Тогда я решил, что для правильных соединений узлов они изначально должны все-таки иметь некоторое место в пространстве.

    Для реализации этой идеи я придумал использовать матрицу, в которой ячейки это узлы графа. В принципе саму матрицу физически можно было и не создавать, но дальнейшее усовершенствование алгоритма все же потребовало ее наличия.

    Теперь, делая перебор всех пар, я добавлял ребра в граф с вероятностью, которая тем меньше, чем больше расстояние между ячейками матрицы. Такой подход давал возможность избавиться от хаотичного соединения узлов графа. Далее начались множественные эксперименты с подбором коэффициента вероятности. В итоге графы получались либо очень запутанные (при большой вероятности образования ребра), либо слишком простые и практически без самопересечений (а для раскладки мне все же хотелось самопересечений).

    Далее, моя логика подсказывала мне, что чем меньше колец в графе, тем вероятнее этот граф будет планарным. А мне требовалось как раз наоборот. Следовательно, предстояло придумать способ, который увеличит количество колец. Выход нашелся сразу: нужно было их заранее сделать перед стартом алгоритма.

    Для создания кольца, находим произвольную точку матрицы. Чтобы действовал тот же принцип избавления от хаоса, другие точки кольца нужно выбирать в близлежащих ячейках от начальной точки. После этого, все точки в той последовательности, в которой они находились, добавляются парами как ребра в граф. И конечно не забыть соединить последнюю точку с первой. Вот тут нам и пригодится матрица в ее физическом представлении. Когда будем формировать кольца, то для найденных узлов будем помечать в матрице какому кольцу (просто номер) они принадлежат. Во-первых, это даст возможность отследить ситуацию, при которой один и тот же узел мог принадлежать более чем одному кольцу. Во-вторых, я добавил в алгоритм логику, при которой ребро не добавлялось, если оба его конца являлись узлами одного и того же кольца.

   Результатом всего выше сказанного явилась следующая процедура:

//AGridSize – размер матрицы
procedure RandomGraf(AGridSize: Integer);
var Circle,x,y,x1,y1,R : Integer;
    Grid : array of array of Integer; //матрица. Не нулевое значение – номер кольца
    cs,p1,p2 : TPoint;
    L : array of TPoint; //список точек, для построения кольца
    LCount : Integer;

  //данная функция ищет произвольную точку недалеко от начальной
  //для построения кольца
  function RandomPoint : TPoint;
  var Ind : Integer;
  begin
    while LCount>0 do
      begin
        //получили случайную точку
        Ind := Random(LCount);
        //если не принадлежит кольцу, то нашли
        if Grid[L[Ind].x,L[Ind].y]=0 then
          begin
            Result := L[Ind];
            L[Ind] := L[LCount-1];
            Dec(LCount);
            exit;
          end;
      end;
    //если массив точек пуст, возвращаем Point(-1,-1)
    Result := Point(-1,-1);
  end;
  //добавление ребра
  procedure Add(p1,p2 : TPoint);
  begin
    AddEdge('у.'+IntToStr(p1.x*10+p1.y),'у.'+IntToStr(p2.x*10+p2.y));
  end;
begin
  //создаем и обнуляем матрицу
  SetLength(L,AGridSize*AGridSize);
  SetLength(Grid,AGridSize,AGridSize);
  for x:=0 to AGridSize-1 do
    for y:=0 to AGridSize-1 do Grid[x,y] := 0;

  //количество колец от 3 до 6
  for Circle:=1 to Random(4)+3 do
    begin
      //находим случайную точку, не принадлежащую ни одному кольцу
      LCount := 0;
      for x:=0 to AGridSize-1 do
        for y:=0 to AGridSize-1 do
          if Grid[x,y]=0 then
            begin
              L[LCount] := Point(x,y);
              Inc(LCount);
            end;
      if LCount=0 then break;
      cs := L[Random(LCount)];
      Grid[cs.x,cs.y] := Circle;
      LCount := 0;
      //помещаем в список все потенциальные точки кольца из квадрата 5x5
      for x:=Max(0,cs.x-2) to Min(AGridSize-1,cs.x+2) do
        for y:=Max(0,cs.y-2) to Min(AGridSize-1,cs.y+2) do
          if Grid[x,y]=0 then
            begin
              L[LCount] := Point(x,y);
              Inc(LCount);
            end;
      p1 := cs;
      y := 1;
      //в кольце от 3 до 8 точек
      for x:=1 to Random(6)+2 do
        begin
          //получили точку
          p2 := RandomPoint;
          //если нашлась, то добавляем ребро
          if p2.x<>-1 then
            begin
              Add(p1,p2);
              Grid[p2.x,p2.y] := Circle;
              p1 := p2;
              Inc(y);
            end
          else break;
        end;
      //если точек больше двух, то соединяем последнюю с первой
      if y>2 then Add(p1,cs);
    end;

  //цикл по матрице
  for x:=0 to AGridSize-1 do
    for y:=0 to AGridSize-1 do
  //вторая точка правее и ниже первой
      for x1:=x to AGridSize-1 do
        for y1:=y to AGridSize-1 do
          begin
            //точку саму с собой не соединяем
            if (x=x1)and(y=y1) then continue;
            //если обе точки принадлежат кольцу, то ребро не создаем
            if (Grid[x,y]<>0)and(Grid[x,y]=Grid[x1,y1]) then continue;
            //расстояние межлу точками помноженное на 10
            R := Trunc(10*Sqrt(Sqr(x-x1)+Sqr(y-y1)));
            //с некоторой вероятностью добавляем ребро
            if (Random(5+R)<1) then Add(Point(x,y),Point(x1,y1));
          end;
end;

    Вот так она у меня и выглядит. Теперь предлагаю немного ее изменить, с целью сделать граф еще менее хаотичным. Во-первых, нужно вообще запретить ребра к слишком дальним узлам. Для этого в основном цикле по матрице третий и четвертый циклы ограничить сверху так, чтобы выбор производился, к примеру, в квадрате 3 на 3 ячейки.

...
for x1:=x to Min(x+2,AGridSize-1) do
  for y1:=y to Min(y+2,AGridSize-1) do
...

    Во-вторых, нужно ограничить число ребер выходящих из одного узла. Для этого будем считать количество ребер и при достижении максимума не давать отработать телу основного цикла.
    Создаем массив учета количества ребер и обнуляем:

  ECount : array of array of Integer;
  ...
begin
  ...
  SetLength(ECount,AGridSize,AGridSize);
  for x:=0 to AGridSize-1 do
    for y:=0 to AGridSize-1 do ECount[x,y] := 0;

    Теперь меняем процедуру добавления ребер. Здесь автоматически будем увеличивать ячейки-счетчики ребер:

procedure Add(p1,p2 : TPoint);
begin
  Inc(ECount[p1.x,p1.y]);
  Inc(ECount[p2.x,p2.y]);
  AddEdge('у.'+IntToStr(p1.x*10+p1.y),'у.'+IntToStr(p2.x*10+p2.y));
end;

    Количество выходящих ребер, к примеру, ограничиваем четырьмя. После этого основной цикл будет такой:

for x:=0 to AGridSize-1 do
  for y:=0 to AGridSize-1 do
    //если нет 4-х ребер, тогда выполняем внутренние циклы
    if ECount[x,y]<4 then
      for x1:=x to Min(x+2,AGridSize-1) do
        for y1:=y to Min(y+2,AGridSize-1) do
          //у второго узла также должно быть меньше 4-х ребер
          if ECount[x1,y1]<4 then
            begin
              //если достигли 4-х ребер, тогда прерываем текущий цикл
              if ECount[x,y]>=4 then break;
              if (x=x1)and(y=y1) then continue;
              if (Grid[x,y]<>0)and(Grid[x,y]=Grid[x1,y1]) then continue;
              R := Trunc(10*Sqrt(Sqr(x-x1)+Sqr(y-y1)));
              if (Random(5+R)<1) then Add(Point(x,y),Point(x1,y1));
            end;

    В заключении напомню, что получившийся граф может быть не связным. Про это нужно помнить. Можно конечно, найти все части и создать соединения, но я себе такую задачу не ставил. Оставляю ее вам :)


© 2005-16, Powered By Digs (Написать письмо, vk)