Компьютерный форум
Правила
Вернуться   Компьютерный форум > Форум программистов > Языки программирования > Pascal
Перезагрузить страницу Графы. Процедура поиска.
Ответ
 
Опции темы Опции просмотра
  (#1 (permalink)) Старый
_Natalya_ _Natalya_ вне форума
Новичок
 
Сообщений: 2
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Регистрация: 21.02.2009
По умолчанию 21.02.2009, 20:41

Здравствуйте! Не могу сделать процедура поиска в лабе по графам. Пожалуйста, если не трудно, помогите советом, если можно, основанном на коде. В общем пишите любые мысли по поводу этого задания.
Вот сама постановка задачи: На плоскости заданы координаты N элементов, являющихся выводами печатной платы. Некоторые элементы связаны между собой. Требуется выбрать начальный элемент для построения пути, не содержащего циклов, максимальной длины. Путь строится по следующему правилу: из всех возможных элементов, связанных с данным, в путь включается ближайший элемент.

Граф сам задается с клавиатуры. Каждая вершина, характеризуется координатами. Сразу там же у меня высчитывается расстояние между заданными вершинами. Есть процедура задания матрицы смежности. В нее записывается как раз длины ребер. А вот поиск у меня никак не получается.

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

Вот код, закоменченная область-процедура поиска:
Код:
program graf3_2;
uses crt;
label 1,2;
Const max=10;
Type
    element=record
             x,y:real;{координаты элементов}
             put:real;
            { t:integer;}
            end;
    masi=array[1..max] of element;
    mat=array[1..max,1..max] of element; {матрица смежности}
    temp=array[1..max] of integer;
Var
    mas:masi;
    L,Step:temp;
    svyaz:mat;
    a,b:integer;
    i,j:integer;
    prizn:boolean;
    ch:char;
    DL:real;
    razmer:integer; {количество элементов}
{---------------------------------------------------------------------------}
Procedure Sozd;
var k:real;
Begin
  Write('Введите количество элементов:  ');
  Read(razmer);
  For i:=1 to razmer do
   For j:=1 to razmer do
    begin
     mas[i].x:=0;
     mas[i].y:=0;
     svyaz[i,j].put:=32767;
     end;
   for i:=1 to razmer do
       begin
       writeln('vvedite koordinati ',i,'-i vershini');
       readln(mas[i].x,mas[i].y);
       end;
   Repeat
     Writeln('Введите связи элементов в виде пары вершин (для выхода 99): ');
     Read(i,j);
   k:=sqrt(sqr(mas[i].x-mas[j].x)+sqr(mas[i].y-mas[j].y));{рассчитывается длина ребра}
   writeln('dlina puti ot ',i,' do ',j,' ravna ',k:2:2);
   svyaz[i,j].put:=k;
   until i=99;
   Readln;
End;
{---------------------------------------------------------------------------}
Procedure Print;
Begin
  clrscr;
  writeln('0 пути не существует');
  writeln;
  write('  ');
      For i:=1 to razmer do
       Write(i:2,' ');           {номера столбцов матрицы}
       Writeln;
       For i:=1 to razmer do
        begin
          Write(i:2);             {номера строк матрицы}
          For j:=1 to razmer do
           begin
            If (svyaz[i,j].put=32767) then write('0':3)
             else
            write(svyaz[i,j].put:2:2);
           end;
          Writeln;
        end;
End;
{---------------------------------------------------------------------------}
{Procedure Poisk(i:integer);
var
 nv,k:integer;
 poi:array[0..max] of boolean;
 des:array[0..max] of integer;
 d:integer;
 w,tsw:real;
begin
  w:=0;
  nv:=0;
  tsw:=1000;
  for i:=1 to razmer do poi[i]:=false;
  d:=a;
  poi[d]:=true;
   while not poi[b] do
          for i:=1 to razmer do
          if (poi[i]=false) and (svyaz[d,i].put>0) and (svyaz[d,i].putMax) then begin
          w:=svyaz[d,i].put;
          if tsw>w then begin
          tsw:=w;
          nv:=k;
          end;
          end;
          if nv<>0 then begin
          poi[d]:=true;
          {Inc(c);}
          des[i]:=nv;
          {Dl:=Dl+tsw;}
          d:=i;
          Poisk(nv);
          end;
           i:=b;
            while i<>a do
              begin
              write(i,'<--');
               i:=des[i];
              end;
            writeln(i);
          writeln;
      end;}
{---------------------------------------------------------------------------}
Begin
  clrscr;
  Sozd;
  prizn:=true;
  While prizn do
   begin
    Print;
    Writeln;
    Write('Введите начальный элемент:  ');
    Readln(a);
    Write('Введите конечный элемент:  ');
    Readln(b);
    Writeln;
    Poisk(a);
    Write('Повторить поиск[y/n] ? ');
    Readln(ch);
    if ch<>'y' then prizn:=false;
   end;
End.
Буду вам очень признательна. Заранее спасибо за помощь.
Ответить с цитированием
  (#2 (permalink)) Старый
Exmap Exmap вне форума
Member
 
Сообщений: 1,045
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Регистрация: 17.09.2007
По умолчанию 22.02.2009, 13:52

Сразу скажу, что отвечать на такую тему очень приятно. Мало того, что чётко приведено задание. Составлен код, показаны все свои наработки и т.д. В отличии от других тем, где пишут что-то типа "я в программировании ничего не понимаю, напишите мне Hello world, но красивый, с виндовс-окошком и чтоб был на Делфи". В общем, у меня есть желание помочь автору этой темы
По делу.
Я считаю, что для каждой вершины можно хранить отсортированный список, каждым элементом которого будет пара вершина-расстояние. Тогда при поиске "пути" из k-той вершины мы будем для каждой вершины хранить, была ли она уже в пути (а то циклы). Тогда рекурсивно вызываем процедуру построения пути из вершины k. Она идёт по списку вершин-расстояний для вершины k и находит в нём первую такую, что она ещё не была в пути. Если таких нет, то вершина k - последняя в пути, иначе рекурсивно вызываем процедуру. Таким образом строим путь из вершины k (по дороге суммируя расстояния).
Вот примерный набросок кода:
Код:
type node = record v, l:longint; end; {v - номер вершины, l - расстояние до неё (квадрат расстояния - неважно)}
var k:array[...] of boolean; p:array[...] of node;
function pathlen(v:longint):longint; {возвращает длину пути из v}
var le: longint;
begin
le:=0;
k[v]:=false;
for i:=0 to length(p[v])-1 do if k[p[v,i].v] then begin
le:=p[v,i].l+pathlen(p[v,i].v);
break;
end;
pathlen:=le;
end;
При этом массив p надо сделать и отсортировать, но я думаю это не сложно
Пока всё. Насколько я понимаю, это и было нужно?
Ответить с цитированием
  (#3 (permalink)) Старый
_Natalya_ _Natalya_ вне форума
Новичок
 
Сообщений: 2
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Регистрация: 21.02.2009
По умолчанию 22.02.2009, 14:02

Exmap, огромное вам спасибо. Буду пробовать.
Ответить с цитированием
Ads
Ответ

Опции темы
Опции просмотра

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Trackbacks are Вкл.
Pingbacks are Вкл.
Refbacks are Выкл.


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Графы Romashka2009 Prolog 14 21.11.2017 10:36
Лабораторные работы на СИ. графы Надикка Задания за деньги 1 09.06.2011 11:28
БД,графы zuzu-09 Prolog 10 01.06.2011 13:24
Задачи в Паскале на графы FigaRO67 Pascal 0 28.05.2011 15:39
Задача на графы german25rus Prolog 1 24.12.2010 16:58
Задачки про графы и деревья AntonioG1988 Prolog 9 13.09.2010 17:31
Графы Dici Pascal 0 22.05.2010 18:12
помогите с программой про графы Надёна Prolog 0 09.05.2008 22:02
замкнутые графы Pylya Prolog 8 23.12.2007 15:26
Найт все эквивалентные графы alinas Prolog 1 28.04.2007 19:14
Процедура поиска в базе данных MishaPMPU SQL 3 07.12.2005 11:48
Как сделать графы на Prolog Anonymous Prolog 0 24.05.2003 02:27



Powered by vBulletin® Version 3.8.7
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.
Нardforum.ru - компьютерный форум и программирование, форум программистов