IPB
ЛогинПароль:

> ВНИМАНИЕ!

Прежде чем задать вопрос, смотрите FAQ.
Рекомендуем загрузить DRKB.

Наладить общение поможет, если вы подпишитесь по почте на новые темы в этом форуме.

 
 Ответить  Открыть новую тему 
> Кратчайший путь в графе
сообщение
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 37
Пол: Мужской
Реальное имя: Серёга

Репутация: -  0  +


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


Гость






Цитата
ничего не знаю про АТД очередь
Читай:
FAQ -> Очереди
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Новичок
*

Группа: Пользователи
Сообщений: 37
Пол: Мужской
Реальное имя: Серёга

Репутация: -  0  +


Цитата(volvo @ 1.10.2008 8:47) *

Толку мало, прочитал, а смысла 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 -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Гость






Цитата
работать с очередями, стеками и деками целый семестр, поэтому хотелось бы поподробнее.
Что именно "поподробнее"? Ты ж сказал, что у тебя есть алгоритм, но ты не знаешь про очереди. Все, что тебе надо знать - это то, что есть операции 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 -
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Новичок
*

Группа: Пользователи
Сообщений: 37
Пол: Мужской
Реальное имя: Серёга

Репутация: -  0  +


Спасибо большое, сейчас буду разбираться!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Новичок
*

Группа: Пользователи
Сообщений: 37
Пол: Мужской
Реальное имя: Серёга

Репутация: -  0  +


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

 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 -


Прикрепленные файлы
Прикрепленный файл  QUEUE.pas ( 1018 байт ) Кол-во скачиваний: 171
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Гость






Цитата
начала вылезать ошибка, не понимаю почему
Потому что надо быть более внимательным:
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;
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Новичок
*

Группа: Пользователи
Сообщений: 37
Пол: Мужской
Реальное имя: Серёга

Репутация: -  0  +


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 недавно и поэтому вопрос ламерский: как вывести массив в форме? Пытаюсь сделать уже несколько дней smile.gif Со StringGrid вроде как разобрался, считается тоже все хорошо, но вывести на экран не могу.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


Гость






Я ж написал тебе
Цитата
// Label1 заполняется вот так:
в предыдущем посте... Что там тебе не понравилось?


Добавлено через 2 мин.
P.S.
И опять у тебя программа нерабочая, та же самая ошибка: queuepop вместо queuepush... Ты ответы что, не читаешь? Тогда зачем их пишут? dry.gif
 К началу страницы 
+ Ответить 
сообщение
Сообщение #10


Новичок
*

Группа: Пользователи
Сообщений: 37
Пол: Мужской
Реальное имя: Серёга

Репутация: -  0  +


Цитата(volvo @ 9.10.2008 17:31) *

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

Извини, я просто скопировал фрагмент из прошлого своего поста и забыл поменять quepop на queuepush, то, что ты написал я сделал, всё получилось ... вот с label1 что-то у меня вывод не правильно получается ...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #11


просто человек
******

Группа: Пользователи
Сообщений: 3 641
Пол: Женский
Реальное имя: Юлия

Репутация: -  55  +


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

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


--------------------
Все содержимое данного сообщения (кроме цитат) является моим личным скромным мнением и на статус истины в высшей инстанции не претендует.
На вопросы по программированию, физике, математике и т.д. в аське и личке не отвечаю. Даже "один-единственный раз" в виде исключения!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #12


Новичок
*

Группа: Пользователи
Сообщений: 37
Пол: Мужской
Реальное имя: Серёга

Репутация: -  0  +


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


Прикрепленные файлы
Прикрепленный файл  ____.rar ( 191.84 килобайт ) Кол-во скачиваний: 110
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 28.10.2020 18:40
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name