Кратчайший путь в графе Опции

[SeregaR1Val]

Помогите пожалуйста с программкой:
"Поиск кратчайшего пути в графе методом полного перебора в ширину с использованием АТД очередь"
Сам алгоритм у меня есть, но ничего не знаю про АТД очередь, ни у кого нет примеров такой программы?

[volvo]

ничего не знаю про АТД очередь

Читай:
FAQ -> Очереди

[SeregaR1Val]

Читай:
FAQ -> Очереди

Толку мало, прочитал, а смысла 0. Там только процедуры описаны как записать в стек, как оттуда достать и т.д. А у меня есть конкретная задача и я не знаю как их связать. работать с очередями, стеками и деками целый семестр, поэтому хотелось бы поподробнее.

Мне дан такой алгоритм:

procedure Quepush(start);
While not QueueEmpty do
begin
      Current:=Quepop
      Finished:=Current=finish;
      j:=1;
      while j<=N do
      begin
        if (M[Current,j]<>0) and not visited(j,way) then
        begin
          Way[j]:=Current;
          Finished:=j=finish;
          if not Finished then QueuePush(j)
            else
            begin
              i:=finish;
              while i<>start do
              begin
                   write(Way[i]:3); 
                   i:=Way[i];
              end;
              writeln;
            end;
          inc(j);
        end;
     end;
end;

Start, current, finish - начальная. текущая и конечная вершина;
Finished - флаг окончания поиска; Visited - функция, проверяющая принадлежность текущей вершины построенной части пути, M - матрица смежности вершин графа.

И как совместить это я вообще не подозреваю.
Если кто-то может чем-то помочь - помогите.

Сообщение отредактировано: SeregaR1Val - 2.10.2008 17:39

[volvo]

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

Что именно "поподробнее"? Ты ж сказал, что у тебя есть алгоритм, но ты не знаешь про очереди. Все, что тебе надо знать - это то, что есть операции Put и Get, все остальное - уже детали реализации (на то он и абстрактный тип данных).

Мне дан такой алгоритм:

Не-не... Ты перепутал все на свете... Это не процедура называется Quepush... Вот так выглядит программа в простейшем случае:

uses queue_oop;

const
  N = 6;
  M: array[1 .. N, 1 .. N] of integer = (
    (0, 2, 0, 8, 0, 0),
    (0, 0, 3, 0, 7, 0),
    (0, 0, 0, 0, 1, 0),
    (0, 0, 0, 0, 6, 0),
    (0, 0, 0, 0, 0, 4),
    (0, 0, 0, 0, 0, 0)
  );

type
  WayType = array[1 .. N] of integer;

function visited(what: integer; path: WayType): boolean;
var i: integer;
begin
  visited := true;
  for i := low(path) to high(path) do
    if path[i] = what then exit;
  visited := false;
end;

var
  q: TQueue;
  i, j, start, finish, current: integer;
  finished: boolean;
  Way: WayType;

begin
  q.init;

  start := 1; finish := 5;

  q.put(start);
  While not q.isEmpty do begin
    Current := q.get;
    Finished := Current = finish;
    j:=1;
    while j<=N do begin
      if (M[Current,j] <> 0) and not visited(j, way) then begin
        Way[j] := Current;
  	Finished:=(j = finish);
        // если не закончили перебор - добавляем очередную вершину
	// в очередь, чтобы потом к ней вернуться...
        if not Finished then q.put(j)
      end;
      inc(j);
    end;
  end;

  // а когда закончили - то печатаем путь
  // от конечной вершины к начальной
  i:=finish;
  write(i:3);

  while i<>start do begin
    write(Way[i]:3);
    i:=Way[i];
  end;
  writeln;

end.

(я использовал собственный модуль queue_oop, в принципе можешь использовать любой другой, по названиям методов понятно, что они делают: Put - забрасывает элемент в конец очереди, Get - вытаскивает элемент из ее начала)

Сообщение отредактировано: volvo - 2.10.2008 19:31

[SeregaR1Val]

Спасибо большое, сейчас буду разбираться!

[SeregaR1Val]

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

 Function QueuePop(var q:TQueue):TElem;
 var
  z:TList;
 begin
  z:=q.head;
  q.head:=z^.next;
  QueuePop:=Z^.info;
  dispose(z)
 end;

Вот сама программа:

unit road2_;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Grids, Queue;

const
   N=6;{ кол-во вершин графа}
type
  WayType = array[1 .. N] of integer;

  TForm1 = class(TForm)
    StringGrid1: TStringGrid;
    Edit1: TEdit;
    Edit2: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Button1: TButton;
    Label4: TLabel;
    procedure FormActivate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormActivate(Sender: TObject);
var
   i:integer;
begin
   // нумерация строк
   for i:=1 to 10 do
       StringGrid1.Cells[0,i]:=IntToStr(i);
   // нумерация колонок
   for i:=1 to 10 do
       StringGrid1.Cells[i,0]:=IntToStr(i);
   // описание предопределенной карты
   StringGrid1.Cells[1,2]:='1';
   StringGrid1.Cells[2,1]:='1';
   StringGrid1.Cells[1,3]:='1';
   StringGrid1.Cells[3,1]:='1';
   StringGrid1.Cells[1,4]:='1';
   StringGrid1.Cells[4,1]:='1';
   StringGrid1.Cells[3,7]:='1';
   StringGrid1.Cells[7,3]:='1';
   StringGrid1.Cells[4,6]:='1';
   StringGrid1.Cells[6,4]:='1';
   StringGrid1.Cells[5,6]:='1';
   StringGrid1.Cells[6,5]:='1';
   StringGrid1.Cells[5,7]:='1';
   StringGrid1.Cells[7,5]:='1';
   StringGrid1.Cells[6,7]:='1';
   StringGrid1.Cells[7,6]:='1';
end;


procedure TForm1.Button1Click(Sender: TObject);
var
  M:array[1..N,1..N] of integer;
  q: TQueue;
  i, j, start, finish, current: integer;
  finished: boolean;
  Way: WayType;

function visited(what: integer; path: WayType): boolean;
var i: integer;
begin
  visited := true;
  for i := low(path) to high(path) do
    if path[i] = what then exit;
  visited := false;
end;

procedure step;
begin
 queueinit(q);
 queuepush(q,start);
  While not queueEmpty(q) do begin
    Current := queuepop(q);
    Finished := Current = finish;
    j:=1;
    while j<=N do begin
      if (M[Current,j] <> 0) and not visited(j, way) then begin
        Way[j] := Current;
  	Finished:=(j = finish);
        if not Finished then queuepop(q)
      end;
      inc(j);
    end;
  end;
  i:=finish;
  while i<>start do begin
    i:=Way[i];
  end;
Label1.Caption:=label1.Caption+' '+IntToStr(way[i]);
end;

begin
   Label1.caption:='';

   for i:=1 to N do
       for j:=1 to N do
          if StringGrid1.Cells[i,j] <> ''
              then M[i,j]:=StrToInt(StringGrid1.Cells[i,j])
              else M[i,j]:=0;
   start:=StrToInt(Edit1.text);
   finish:=StrToInt(Edit2.text);
   step;

end;

end.

и прикреплен юнит с Объектом очередь, скачан отсюда, с форума

Сообщение отредактировано: SeregaR1Val - 4.10.2008 13:25

[volvo]

начала вылезать ошибка, не понимаю почему

Потому что надо быть более внимательным:

procedure step;
begin
  queueinit(q);
  queuepush(q, start);
  While not queueEmpty(q) do begin
    Current := queuepop(q);
    Finished := Current = finish;
    j := 1;
    while j<=N do begin
      if (M[Current,j] <> 0) and not visited(j, way) then begin
        Way[j] := Current;
        Finished:=(j = finish);
        if not Finished then queuepush(q, j) // <--- Здесь и в оригинале было q.put(j), а не q.get
      end;
      inc(j);
    end;
  end;

  // Label1 заполняется вот так:
  Label1.Caption := IntToStr(finish);
  i := finish;
  while i <> start do begin
    i := Way[i];
    Label1.Caption := Label1.Caption + ' ' + IntToStr(i);
  end;
end;

[SeregaR1Val]

procedure step;
begin
 queueinit(q);
 queuepush(q,start);
  While not queueEmpty(q) do begin
    Current := queuepop(q);
    Finished := Current = finish;
    j:=1;
    while j<=N do begin
      if (M[Current,j] <> 0) and not visited(j, way) then begin
        Way[j] := Current;
  	Finished:=(j = finish);
        if not Finished then queuepop(q)
      end;
      inc(j);
    end;
  end;
end;

begin
   Label1.caption:='';

   for i:=1 to N do
       for j:=1 to N do
          if StringGrid1.Cells[i,j] <> ''
              then M[i,j]:=StrToInt(StringGrid1.Cells[i,j])
              else M[i,j]:=0;
   start:=StrToInt(Edit1.text);
   finish:=StrToInt(Edit2.text);
   step;
    while i<>start do begin
    Label1.caption:=IntToStr(way[i]);
     end;

end;

end.

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

[volvo]

Я ж написал тебе

// Label1 заполняется вот так:

в предыдущем посте... Что там тебе не понравилось?


Добавлено через 2 мин.
P.S.
И опять у тебя программа нерабочая, та же самая ошибка: queuepop вместо queuepush... Ты ответы что, не читаешь? Тогда зачем их пишут?

[SeregaR1Val]

И опять у тебя программа нерабочая, та же самая ошибка: queuepop вместо queuepush... Ты ответы что, не читаешь? Тогда зачем их пишут?

Извини, я просто скопировал фрагмент из прошлого своего поста и забыл поменять quepop на queuepush, то, что ты написал я сделал, всё получилось ... вот с label1 что-то у меня вывод не правильно получается ...

[мисс_граффити]

вот с label1 что-то у меня вывод не правильно получается ...

тебе же написали, как надо:

 // Label1 заполняется вот так:
  Label1.Caption := IntToStr(finish);
  i := finish;
  while i <> start do begin
    i := Way[i];
    Label1.Caption := Label1.Caption + ' ' + IntToStr(i);
  end;

[SeregaR1Val]

Я бы просто так не писал, у меня все написано также, но какие бы значения не забивал, у меня выводится неправильно! Вот даже программку мою могу выложить...