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

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

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 17.09.2017, 12:47   #1
amastudent
 
Регистрация: 17.09.2017
Сообщений: 6
Смущение Вывести граф с помощью GraphABC

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


Код:
uses GraphABC;
 
CONST MAX_N = 100;
var 
  
   //x, y, r : real;
   a : array[1..MAX_N , 1..MAX_N] of integer;
   n , m , i , j , x , y,r : integer;
  
 
 
procedure DrawGraph(n : integer);
var
  i : integer;
  s : string;
{--------цикл, рисующий окружность----------------}
begin
  for i:=1 to n do 
    begin
     circle(x+cos(2*Pi*i/n)*r, y+sin(2*Pi*i/n)*r, 5); //нарисовать вершины
     str(i, s); //переменная, содержащая номер вершины в строковом виде
     TextOut(x, y, s); //на каждой вершине написать ее номер (как вместо x и y подставить координаты текущей вершины?)
    end;
{--------цикл, рисующий ребра----------------}
  for i:=1 to n do
    begin
      //если из вершины с координатами x1,y1 есть путь до вершины с координатами x2, y2 - рисуем ребро 
      //как осуществить проверку такого условия?
      
      line(x1,y1,x2,y2);
      for i:=1 to n do //i - вершины, от каждой вершины рисуем n-1 ребро
        for j:=1 to n-1 do //j - ребра, ребер на 1 меньше, чем вершин, потому что пути из самого себя нет
          begin
            //как организовать цикл, рисующий от вершины ребра?
          end;
    
    end;
end;
{--------заполняем матрицу смежности -------------------------}
procedure MatFull (n : integer; a : array of integer);
var
  i, j : integer;
 
Begin
    Read(n); //количество вершин
    
    for i := 1 to n do begin
        read(x , y); //считываем вершину
        a[x][y] := 1; //метим путь из x в y
        a[y][x] := 1; //граф неориентированный, метим обратный путь
    end;
    
End;
  
{--------выводим матрицу на экран-----------}
procedure DispMat (n : integer; a : array of integer);
var
  i, j :integer;
  begin
  for i := 1 to n do begin //выписываем матрицу смежности
        for j := 1 to n do
            Write(a[i][j] , ' ');
        WriteLn;    
    end;    
  
  end;
BEGIN  
  writeln ('Введите количество городов:');
  readln (n); // количество вершин
  
  MatFull(n, a); //формируем матрицу смежности
  DispMat (n, a); //выводим матрицу на экран
     
END.
amastudent вне форума Ответить с цитированием
Старый 18.09.2017, 14:13   #2
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,238
По умолчанию

примерно так можно:

Код:
uses GraphABC;

CONST MAX_N = 100;
type TArrLinkGraph = array[1..MAX_N , 1..MAX_N] of integer;

(*function min(a,b:integer):integer;
begin
  if a<b then min:=a else min:=b
end;*)

procedure DrawGraph(n : integer; var a : TArrLinkGraph);
const r0 = 50;
var
  i,j, x0, y0, x1, y1, x2, y2 : integer;
  s : string;
  r: real;
{--------цикл, рисующий окружность----------------}
begin
  r := min(WindowWidth div 2, WindowHeight div 2)-r0-10;
  x0:=WindowWidth div 2; y0:=WindowHeight div 2;
  for i:=1 to n do
    begin
     x1 := round(x0+cos(2*Pi*i/n)*r); y1 := round(y0+sin(2*Pi*i/n)*r);
     circle(x1, y1, r0); //нарисовать вершины
     TextOut(x1, y1, IntToStr(i)); //на каждой вершине написать ее номер (как вместо x и y подставить координаты текущей вершины?)
    end;
{--------цикл, рисующий ребра----------------}
  for i:=1 to n do
    begin
      //если из вершины с координатами x1,y1 есть путь до вершины с координатами x2, y2 - рисуем ребро
      //как осуществить проверку такого условия?
      //line(x1,y1,x2,y2);
        for j:=i+1 to n do //j - ребра, ребер на 1 меньше, чем вершин, потому что пути из самого себя нет
          begin
            if a[i,j]=1 then begin
               x1 := round(x0+cos(2*Pi*i/n)*r); y1 := round(y0+sin(2*Pi*i/n)*r);
               x2 := round(x0+cos(2*Pi*j/n)*r); y2 := round(y0+sin(2*Pi*j/n)*r);
               Line(x1,y1,x2,y2);
            end;
          end;
    end;
end;
{--------заполняем матрицу смежности -------------------------}
procedure MatFull (n : integer; var a : TArrLinkGraph);
var
  i, x, y : integer;
Begin
    for i := 1 to n*n div 2 do begin
        Write('Укажите два города, связанные дорогой: (0 0 - больше связей нет)');
        ReadLn(x , y); //считываем вершины
        if (x=0) and (y=0) then Exit;
        if (x>0) and (x<=n) and (y>0) and (y<=n) then begin
            WriteLn(x,' <->',y);
            a[x,y] := 1; //метим путь из x в y
            a[y,x] := 1;
        end;
    end;

End;

{--------выводим матрицу на экран-----------}
procedure DispMat (n : integer; a : TArrLinkGraph);
var
  i, j :integer;
begin
  WriteLn;
  for i := 1 to n do begin //выписываем матрицу смежности
        for j := 1 to n do
            Write(a[i,j] , ' ');
        WriteLn;
    end;
end;

var

   //x, y, r : real;
   a : TArrLinkGraph;
   n , m , i , j , x , y,r : integer;

BEGIN
  writeln ('Введите количество городов:');
  //readln (n); // количество вершин
  n:=6;

  //MatFull(n, a); //формируем матрицу смежности
  a[1,4] := 1; a[1,5] := 1;
  a[2,3] := 1;
  a[3,6] := 1;
  a[4,6] := 1;
  DispMat (n, a); //выводим матрицу на экран

  DrawGraph(n, a);

END.
если у Вас PascalABC.NET должно заработать сразу.
если у Вас PascalABC и будет ругаться на min - тогда раскомментируйте функцию min

p.s. вместо:
задания в коде
Цитата:
Код:
  writeln ('Введите количество городов:');
  //readln (n); // количество вершин
  n:=6;

  //MatFull(n, a); //формируем матрицу смежности
  a[1,4] := 1; a[1,5] := 1;
  a[2,3] := 1;
  a[3,6] := 1;
  a[4,6] := 1;
напишите:
Код:
  writeln ('Введите количество городов:');
  readln (n); // количество вершин
  MatFull(n, a); //формируем матрицу смежности
Serge_Bliznykov вне форума Ответить с цитированием
Ответ


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

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Неориентированный граф.Вставить в граф ребро( помогите найти ошибку) ggjgj Общие вопросы C/C++ 1 20.05.2017 17:12
помогите вывести все перестановки, алгоритм: с помощью двух массивов Лия123 Помощь студентам 3 17.11.2014 23:33
Определить степени вершин графа и если граф однородный - вывести степень однородности(любой язык) serg0 Помощь студентам 0 18.02.2013 23:31
Вывести динамический масив с помощью функции Gavreil Общие вопросы C/C++ 2 17.12.2008 21:27
Как с помощью формул можно сравнить и вывести данные kutt Microsoft Office Excel 2 24.09.2008 17:05