Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Object Pascal: кроссплатформенные технологии > Помогите С поиском в Глубину!!!!


Автор: Banderas 5.6.2005, 23:27
Ребята, я в програмировании вобще даун! А курсовую нужно было сдать еще две недели назад. В програме приведеной здесь http://forum.vingrad.ru/index.php?showtopic=38605 вобще ничего не понял, програма компилируется, запускается и стоит, что это значит? Кто нибудь может помочь - написать полную програму, выполняющую поиск в глубину, которая читает из файла данные, обрабатывает ихи и выводит на экран результат. Желательно см коминтариями, что бы я хоть что то понял. Помогите кому нетрудно!!!!!
Заранее благодорен!

Автор: ~FoX~ 6.6.2005, 09:53
Ты прогу компили с параметром ака c:\MyGrap.txt, годе MyGrap.txt - файл с описанием графа.

Ну, а что конкретно тебе не ясно то? Задавай вопросы, будем разбираться.
Алгоритм поиска в глубину знаешь? Вот и программь, если что не так, пости сюда будем разбираться.

А если тебе нудно от и до прогу накотать, так это в раздел Работа и за денежку. СУВ.

Автор: Fedor 6.6.2005, 16:09
Цитата
Ты прогу компили с параметром ака c:\MyGrap.txt, годе MyGrap.txt - файл с описанием графа.

не компили, а запускай. ;)

Автор: Banderas 6.6.2005, 23:05
Ребята, говорю же даун в програмировании! smile Алгоритм поиска в глубину не знаю. Максимум это - поменять определенные елементы матрицы 10 на 10 местами. Для меня то что написано в програме - китайская грамота! Можно, если не трудно, для каждой процедуры, а можно даже и для каждого оператора, коментарии по-подробнее smile . И что вообще получится в результате на экране после того, как произойдет обход заданого мной графа? smile

Автор: ~FoX~ 7.6.2005, 10:02
Вобщем так:

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

После обеда накотаю небольшой примерчик рекурсивного поиска в глубину, сейчас просто времени нет.

Автор: ~FoX~ 8.6.2005, 08:45
Граф вида:
Цитата

           1.         (1.(2;3))
           /\
         2.  3.      (2.(4;5))  (3.(6;7))
        /\     /\
      4. 5. 6. 7. 


Т.е. его матрицу смежности мы запишем так:
1.txt:
Цитата

7
1 2
1 3
2 4
2 5
3 6
3 7




Код

program Project2;

{$APPTYPE CONSOLE}

uses
  SysUtils;
var    
  fin:text;    
  g:array[1..7,1..7] of word;              {матрица смежности}
  N:word;
  d,f:array[1..7] of word;                    {массивы меток}
  p:array[1..7] of word;                      {массив предков}
  color:array[1..7] of byte;                 {массив цветов}

procedure DFS_visit(u:word);
var    
   i,j:word;    
begin
   color[u]:=1;                                        {"окрашиваем"вершину u в серый цвет}    

   for i:=1 to n do
     if g[u,i]=1 then                                 {Если есть ребро из u в i...}    
       if color[i]=0 then                             {... то если цвет i белый (мы ее еще не обрабатывали)...}
         begin    
           p[i]:=u;                                       {...предок i - v...}    
           DFS_Visit(i);                                {...вызываем рекурсивно процедуру для вершины i}
         end;                                       {после выполнения цикла мы гарантируем, что обработали                                                                 все смежные u необработанные вершины}    
   color[u]:=2;                                        {помечаем u как обработанную}    
end;    

procedure ReaadGraph();
var
   i,j:word;
begin
  {читаем информацию про граф из файла, заданного первым параметром командной строки}
  {граф задан так: первая строка файла - колличество вершин. В каждой следующей строке - два числа i и j. Это означает, что в графе существует ребро i->j}
  assign(fin, 'c:\1.txt'); //1.txt - файл содержащий матрицу смежности.
  reset(fin);
  readln(fin,n);
  while not EOF(fin) do
    begin
      read(fin,i);
      readln(fin,j);
      g[i,j]:=1;
    end;
  close(fin);       {граф прочитан}
  {обнуляем массивы предков и цветов}
  for i:=1 to n do
    begin
      color[i]:=0;
      p[i]:=0;
    end;
  for i:=1 to n do
    if color[i]=0 then
      DFS_Visit(i);
  {в этот момент построенно дерево поиска, которое находится в массиве p, известно, на каком шаге каждая вершины вошла в поиск. Эту информацию можно использовать как данные для других алгоритмов}
end;

begin
  ReaadGraph;
  //========================
  //Вот тут выводи ту инфу которая тебе нужна, уж больно рисовать мне лениво было.
  //========================
  ReadLn;
end.

Автор: Banderas 8.6.2005, 23:13
ОК. Спасибо большое за разъяснения о входящей информации. Стало яснее. Но что же должно выводиться? Результата поиска у нас - построеное дерево. А как это выводиться на экран? В виде списка пройденых вершин по-порядку или как?

Автор: ~FoX~ 9.6.2005, 09:01
Banderas
Ну это уже сам прикидывай.......хочешь в псевдографике или нормальной рисуй, хочешь выводи списки пройденых вершин, вобщем все от задачи твоей зависит. Вам же должны были рассказывать как курсвую работу оформлять.

Автор: Banderas 9.6.2005, 22:56
В том то и дело что курсовик дали по графам, которые мы не то чтобы не проходили, а даже и не слышали об их существовании! А о том, как выводить данные после гобработки вообще речь не заводили! Но все равно спасибо!

Автор: ~FoX~ 10.6.2005, 08:10
Banderas
Ладно, погоди чутьчуть, накотаяю я тебе процедурку отрисовки графа. Сейчас просто некогда, может после обеда или завтра утром выволю.

Автор: Banderas 10.6.2005, 22:57
Буду ждать с нетерпением!! smile
Добавлено @ 23:02
Буду ждать с нетерпением!! smile

Автор: SaS1 20.6.2005, 02:11
У меня тоже сть такой алгоритм!
Даже два!!!
(рекурсивный и нерекурсивный)
Входные данные - списки инциденции, т.е перечисляешь все вершины и все вершины с кот они связаны
для вышепривед примера:
1 2 3
2 1 4 5
3 1 6 7
4 2
5 2
6 3
7 3
прога выводит список вершин через которые прога проходит при поиске.
1
2
4
5
3
6
7
(по-моему так)
Это нерек код:
Код

program v_glub ;
uses crt;
type
    Spis=^s;
     s=record
     i:integer;
     p1:spis;
     end;


label
    w1, m2,m3,m4,m5 ;
var
   as,aq:array[1 ..100]of spis;
   w:array[1..100] of integer;
   e:array[1..100] of boolean;
   t,ku,lw,g,pr,a,res,ml,mp,kl,st:spis;
   k,c,i,f,is,v,u,beg,en,n,ik,iu,fr:integer;
   q,h,z,qw:boolean;
   kod:char;


 procedure VVOD;
{formirowanie spiska +}
   label m;
   begin

     writeln('Nachat formirowanie spiska'); {dopoln element}
     new(ku);
     ku^.p1:=nil;
     lw:=ku;
     pr:=ku;
     textcolor(1);
     write('1-iy element   ');

     textcolor(5);             {perviy element}
     readln(k);
     a:=ku;
     new(ku);

     lw^.p1:=ku;
     ku^.p1:=nil;
     a^.p1:=ku;
     ku^.i:=k;
     as[ik]:=ku;
     i:=0;
     while true do                {formir ostalnih elementov}
      begin
        i:=i+1;
        if k=0
         then
          goto m;
        textcolor(1);
        Write(i+1,'-iy element   ');
        textcolor(5);
        read( k);
        a:=ku;
        new(ku);
        ku^.p1:=nil;
        a^.p1:=ku;
        ku^.I:=K;
        PR:=KU;
      END;
m:


     textcolor(4);
     writeln('Formirovanie spiska finish');
   END;





procedure qwer(ik:integer);
label w1,w2;
begin
w1:  if as[ik]^.p1=nil then
   begin
    if f-1<=0 then goto w2;
    f:=f-1;
    ik:=w[f];  goto w1;
  end;

  if e[as[ik]^.p1^.i]=false then
   begin
     as[ik]:=as[ik]^.p1;
     goto w1;
   end;

   f:=f+1;fr:=fr+1;
   a:=st;
   new(st);
   st^.i:=as[ik]^.p1^.i;
   st^.p1:=a;
   w[fr]:=as[ik]^.p1^.i;
   ik:=w[fr];
   e[as[ik]^.i]:=false;
        qwer(ik);
 w2:
end;

begin
clrscr;
writeln('vvedite kolichestvo vershin');
readln(n);
for ik := 1 to n do       {Formirovanie spiscov reber}
begin
vvod;
end;
For ik:= 1 to n do
e[ik]:= true;
f:=1;ik:=1;fr:=1;
w[1]:=1;
 e[1]:=false;
 new(st);
 st^.i:=1;
 st^.p1:=nil;
 qwer(ik);
      window(60,3,78,40);
     textbackground(3);
     i:=n;
     ku:=st;
     g:=ku;
     repeat

       writeln(i,'-iy element  ',g^.i);
       ku:=ku^.p1;
       i:=i-1;
       dispose(g);
       g:=ku;
    until g^.p1=nil;
    writeln(i,'-iy element  ',g^.i);

end.



А это рекурсивный код:
Код

program v_glub;
uses crt;
type
    Spis=^s;
     s=record
     i:integer;
     p1:spis;
     end;


label
    w1,w2 ,m2,m3,m4,m5 ;
var
   as,aq:array[1 ..100]of spis;
   w:array[1..100] of integer;
   e:array[1..100] of boolean;
   t,ku,lw,pr,a,res,ml,mp,kl:spis;
   k,c,i,f,is,v,u,beg,en,n,ik,iu,fr:integer;
   q,h,z,qw,qa:boolean;
   kod:char;


 procedure VVOD;
{formirowanie spiska +}
   label m;
   begin

     writeln('Nachat formirowanie spiska'); {dopoln element}
     new(ku);
     ku^.p1:=nil;
     lw:=ku;
     pr:=ku;
     textcolor(1);
     write('1-iy element   ');

     textcolor(5);             {perviy element}
     readln(k);
     a:=ku;
     new(ku);

     lw^.p1:=ku;
     ku^.p1:=nil;
     a^.p1:=ku;
     ku^.i:=k;
     as[ik]:=ku;
     i:=0;
     while true do                {formir ostalnih elementov}
      begin
        i:=i+1;
        if k=0
         then
          goto m;
        textcolor(1);
        Write(i+1,'-iy element   ');
        textcolor(5);
        read( k);
        a:=ku;
        new(ku);
        ku^.p1:=nil;
        a^.p1:=ku;
        ku^.I:=K;
        PR:=KU;
      END;
m:


     textcolor(4);
     writeln('Formirovanie spiska finish');
   END;







begin
clrscr;
writeln('vvedite kolichestvo vershin');
readln(n);
for ik := 1 to n do       {Formirovanie spiscov reber}
begin
vvod;
end;
For ik:= 1 to n do
e[ik]:= true;
for ik:= 1 to n do
writeln(as[ik]^.i);

f:=1;ik:=1;fr:=1;
w[1]:=1;
 e[1]:=false;
 writeln('1-iy  ',w[1]);
qa:=true;
while qa=true do
begin
qa:=false;
writeln('voshlo');
w1:  if as[ik]^.p1=nil then
   begin

   f:=f-1;
   ik:=w[f];  goto w1;
  end;

  if e[as[ik]^.p1^.i]=false then
   begin
     as[ik]:=as[ik]^.p1;
     goto w1;
   end;

   f:=f+1;fr:=fr+1;
   writeln('f=',f);
   writeln(f,' po scgetu  ',as[ik]^.p1^.i);
   w[fr]:=as[ik]^.p1^.i;
   ik:=w[fr];
   e[as[ik]^.i]:=false;


for i:= 1 to n do
if e[i]=true then qa:=true;
end;
for ik:=1 to n do
writeln(w[ik]);


end.



Там могут быть лишние переменные описаны:(

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)