Поиск цикла длины 4.

[<Бананан>]

procedure DeepSearch(G:TGraphMatrix;bv:intege r);
var Used: array of boolean;
i: integer;
M: array of array of boolean;

вот так он прям на доске писал

[<Бананан>]

Расширение "Способы обхода графа"

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

Алгоритмы обхода
Многие алгоритмы на графах требуют систематического перебора вершин графа, при котором каждая вершина посещается ровно один раз. Существует два основных метода такого перебора, которые анализируют каждое ребро графа не более одного раза.

Алгоритм обхода вершин "в глубину" (рекурсивный вариант):
var Used:array of boolean;// Массив индикации посещённых вершин
SetLength(Used,Gr.VertexCount);

Procedure DeepSearch(v:integer);
var i: integer;
Procedure DS(v:integer);
var k:integer;
begin
Действие над вершиной v
Used[v]:=true;
for k {вершины, смежные с v} do begin
if not Used[k] then begin
DS(k);
end;
end;
end;
begin
DS(v);
// Просмотр остальных компонент связности
for i:=1 to Gr.VertexCount do
if not Used[i] then DS(i);
end;

Алгоритм обхода вершин "в ширину" (без рекурсии):

var Used:array of boolean;// Массив индикации посещённых вершин
q:TVQueue;// Очередь вершин, посещаемых на каждом шаге выполнения алгоритма
SetLength(Used,Gr.VertexCount);

Procedure WideSearch(v:TVIndex);
var i: integer;
Procedure WS(v:TVIndex);
var j,k: integer;
begin
q.Push(v);
Used[v]:=true;
while not q.Empty do begin
j:=q.Pop;
Действие над вершиной j
for k {вершины, смежные с j} do
if not used[k] then begin
q.Push(k);
Used[v]:=true;
end;
end;
end;
begin
WS(v);
// Просмотр остальных компонент связности
for i:=1 to Gr.VertexCount do
if not Used[i] then WS(i);
end;

[<Бананан>]

Вот тут-то тоже нет конца первой процедуры??? я обхожу в глубину....

[<Бананан>]

А прога должна быть такого плана, только моя должнасчитать циклы длиной 4:
{------------------------------------------------------------------------------}
{
Простой пример курсовой/лабораторной работы, подключаемой к системе СТРИН
Программа читает файл INPUT.TXT, содержащий один граф в формате матрицы
смежности,
выдает список вершин степени 1 и 2 в
OUTPUT.TXT.
Для упрощения, для ориентированных графов за степень вершины принимается
полустепень исхода.
}
{------------------------------------------------------------------------------}

program degree12;

uses
Graphs;

{ функция для вычисления степени вершины Vertex }
function GetDegree(Graph: TGraphMatrix; Vertex, VertexCount: Integer): Integer;
var i, deg: Integer;
begin
deg := 0;
for i := 0 to VertexCount-1 do
deg := deg + Graph[Vertex, i];
GetDegree := deg;
end;

var Graph: TGraphMatrix; { матрица смежности графа }
VertexCount: Integer; { число вершин графа }
i, count, deg: Integer;
F: TextFile;
begin
{ загружаем граф из файла в формате матриц смежности }
Graph_LoadFromMatrixFileName('INPUT .TXT', Graph, VertexCount);
{ подсчитываем число вершин степени 1 и 2 }
count := 0;
for i := 0 to VertexCount-1 do
begin
deg := GetDegree(Graph, i, VertexCount);
if (deg=1) or (deg=2) then
count := count+1;
end;
{ выдаем результаты }
{ обязательные результаты в файл OUTPUT.TXT }
AssignFile(F, 'OUTPUT.TXT');
Rewrite(F);
{ записываем число вершин }
Writeln(F, count);
{ записываем список вершин; нумеруем вершины от 1 }
for i := 0 to VertexCount-1 do
begin
deg := GetDegree(Graph, i, VertexCount);
if (deg=1) or (deg=2) then
Writeln(F, i+1);
end;
CloseFile(F);
end.

[puporev]

Не понимаю как с такими знаниями вы до графов добрались.

[<Бананан>]

О, это долгая история) При этом на первом курсе!!)))

[<Бананан>]

Вот значит, прграмма компилируется полнотью, но что-то не работат(((((

program cycle_;

{$APPTYPE CONSOLE}

uses
SysUtils,Graphs;

const
MAX_VERTEX_COUNT=50;

{procedure Graph_LoadFromMatrixFile(var F:TextFile;var G: TGraphMatrix;
var VertexCount: integer);}

{procedure DeepSearch(G:TGraphMatrix;bv:intege r);
var Used: array of boolean;
i: integer;
M: array of array of boolean;}

procedure DSRec(v:integer);
var TmpV: integer;
k: integer;
Used: array of boolean;
M: array of array of boolean;
VertexCount: integer;
begin
k:=0;
Used[v]:=true;
for TmpV:=0 to Pred(VertexCount) do
if M[TmpV,v] then begin
if not Used[TmpV] then begin
k:=k+1;
Used[Tmpv]:=true;
DSRec(TmpV);
if k=4 then
Used[TmpV]:=false;
{k:=k-1;
if not Used[TmpV] then
Used[TmpV]:=false;}
end;
end;
end;

var VertexCount: Integer; { ÷èñëî âåðøèí ãðàôà }
F: TextFile;
G:TGraphMatrix;
TmpV:integer;
Used: array of boolean;
begin
{ çàãðóæàåì ãðàô èç ôàéëà â ôîðìàòå ìàòðèö ñìåæíîñòè }
Graph_LoadFromMatrixFileName('INPUT .TXT', G, VertexCount);
AssignFile(F, 'OUTPUT.TXT');
for TmpV := 0 to (VertexCount-1) do
begin
DSRec(TmpV);
if Used[TmpV]=false then begin
Rewrite(F);
Writeln(F, TmpV+1);
end;
CloseFile(F);
end;
end.

[<Бананан>]

Как сделать чтбы она искала циклы длины 4??? Напишите, плиз))

[MaTBeu]

procedure Graph_LoadFromMatrixFile(var F:TextFile;var G: TGraphMatrix;
var VertexCount: integer);

procedure DeepSearch(G:TGraphMatrix;bv:integer);

Я конечно в Делфи не совсем разбираюсь... но помоему это прототипы процедур...А сами процедуры в каком-то другом юните находятся.
А вот это

var Used: array of boolean;
i: integer;
M: array of array of boolean;

я думаю можно вставить после трех эндов.

[MaTBeu]

Эх, парень... ты бы определися, что тебе помогать: писать новую прогу или исправлять старую, а то то одно, то другое.