Поиск в ширину в графе |
1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!
Поиск в ширину в графе |
Aleks |
Сообщение
#1
|
Новичок Группа: Пользователи Сообщений: 23 Пол: Мужской Репутация: 0 |
Помогите решить задачу
Напишите и используйте в программе процедуру поиска в ширину в графе, заданном списками инцидентности. Выведите на экран номера всех вершин в порядке очередности просмотра. я не знаю с чего начать, посмотрел в "FAQ" но не смог разобраться |
Aleks |
Сообщение
#2
|
Новичок Группа: Пользователи Сообщений: 23 Пол: Мужской Репутация: 0 |
как освободить память, не могу сообразить
Исходный код uses crt; const max=400; type index= ^list; list= record inf: integer; next: index; end; connection= array[1..max] of index; var lst, m: connection; ver: array[1..max] of integer; ocher: array[1..max+1] of integer; key, z, raz: integer; find_v: boolean; procedure DP_Graph; var n: index; i, j: integer; kolvo: longint; spro: boolean; procedure add; begin new(m[i]); m[i]^.inf:= ver[j]; m[i]^.next:= lst[i]; lst[i]:= m[i]; inc(kolvo); end; begin randomize; for i:=1 to raz do ver[i]:= random(1000); kolvo:= 0; for i:=1 to raz do begin lst[i]:= nil; for j:=1 to raz do begin spro:= true; if j<> raz then begin if j=i then inc(j); n:= nil; n:= lst[j]; if lst[j]<>nil then repeat if n^.inf=ver[i] then spro:= false; n:= n^.next; until (n=nil) or (not(spro)); if (round(random)=1) and spro then add; end; end; end; writeln('Kol-vo reber Grapha: ',kolvo); writeln; end; procedure print_ver; var i: integer; begin for i:=1 to raz do begin write(ver[i],''); m[i]:= lst[i]; if m[i]<>nil then repeat write(m[i]^.inf,'='); m[i]:= m[i]^.next; until m[i]= nil; writeln(''); end; end; procedure find_Graph(find_v: boolean; key: integer); var q: integer; t, ov, oc, i: integer; pr: boolean; procedure p_ver; var j, i: integer; pr: boolean; begin for i:=2 to raz do begin m[i]:= lst[i]; repeat pr:= false; q:= m[i]^.inf; m[i]:= m[i]^.next; if ocher[oc]=q then begin for j:=1 to ov do if ocher[j]=ver[i] then pr:= true; if pr=false then begin ocher[ov]:= ver[i]; inc(ov); end; end; until m[i]=nil; end; i:= 2; end; begin ov:= 1; oc:= 1; ocher[oc]:= ver[oc]; m[oc]:= lst[oc]; while m[oc]<>nil do begin q:= m[oc]^.inf; m[oc]:= m[oc]^.next; inc(ov); ocher[ov]:= q; end; inc(ov); p_ver; if ocher[oc]=key then find_v:= true; while oc<raz do begin inc(oc); for i:=1 to raz do begin p_ver; if ocher[oc]=ver[i] then begin m[i]:= lst[i]; while m[i]<> nil do begin pr:= false; q:= m[i]^.inf; m[i]:= m[i]^.next; for t:=1 to ov do if ocher[t]=q then pr:= true; if pr=false then begin ocher[ov]:= q; inc(ov); end; end; end; end; if ocher[oc]=key then find_v:= true; end; if not(find_v) then writeln('К сожалению такой вершины нет...') else writeln('Вершина графа ',key,' найдена!'); end; procedure delet; begin end; begin repeat clrscr; writeln('--', memavail); write('Kol-vo vershin Grapha (ne menee 4) : '); readln(raz); until raz>3; DP_Graph; print_ver; write('Vvedite iskom vershinu: '); readln(key); find_v:= false; find_Graph(find_v,key); for z:=1 to raz do write(ocher[z],' - '); writeln; delet; writeln; writeln('--', memavail); readln; end. |
Текстовая версия | 13.05.2024 10:22 |