Помощь - Поиск - Пользователи - Календарь
Полная версия: Как обойтись без меток?
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
LOVE133
Занимаюсь изучение графов... так вот нашла подходящую программку,переделала ее под свои нужды...только вот никак не могу избавиться от меток, так как нужно соорудить процедуру, а там метка, и паскаль ругается и работать ни в какую не хочет.Может можно как-нибудь обойтись без нее? при ее удалении выводит повторные
точки..
Код

PROGRAM F_i_x_C_o_n_t;
label Metka;
const MaxNodes = 5;
      Stepen = 10;
type NodePtr = 1..MaxNodes;
     Param = 1..Stepen;
     Element = 0..1;
     AdjMatrix = Array [NodePtr,NodePtr] of Element;
     JoinAdj = Array [Param] of AdjMatrix;
var Adj : AdjMatrix; { Матрица смежностей }
    AdjN : JoinAdj; { Массив степеней матрицы смежностей }
    C : AdjMatrix; { Рабочий массив }
    i,j,k: NodePtr; { Параметры циклов }
    n,l,m: Param;
{ --------------------------------------------- }
PROCEDURE P_o_w_e_r (n: Integer; A: AdjMatrix;var C: AdjMatrix);
{ Матрица C получает значение n-й степени матрицы A }
var Z : AdjMatrix;
    Val : Element;
    i,j,k,m: Integer;
BEGIN
   C:=A;
   For m:=1 to n-1 do
   begin
      For i:=1 to MaxNodes do
      For j:=1 to MaxNodes do
      begin
         Val:=0;
         For k:=1 to MaxNodes do
         Val:=Val OR (A[i,k] AND C[k,j]);
         Z[i,j]:=Val
      end;
      C:=Z
   end
END;
{ --- }
BEGIN
   { Ввод матрицы смежностей заданного графа }
   WriteLn ('Вводите элементы матрицы смежностей по стро-кам:');
   For i:= 1 to MaxNodes do
   For j:= 1 to MaxNodes do
   begin
      Write ('Введите Adj[',i,',',j, ']: ');
      ReadLn (Adj[i,j])
   end;
   { Вычисление степеней матрицы смежностей }
   For l:=1 to Stepen do
   begin
      P_o_w_e_r (l,Adj,C);
      For i:= 1 to MaxNodes do
      For j:= 1 to MaxNodes do AdjN [l,i,j]:=C[i,j]
   end;
   Write ('Вводите длину контура: '); ReadLn (n);
   { Отыскание контуров заданной длины }
   For m:=2 to n do
   begin
      For i:=1 to MaxNodes do
      If AdjN [m,i,i]=1
      { Вершина i принадлежит контуру длины n }
      then
      begin
       if m=n then
       begin
         Write ('Вершина ',i,'образует контуры длины ',m, ' с вершинами из множества:{');
         For j:=1 to MaxNodes do
         begin
            If AdjN[m,j,j]=1
            { Вершина j принадлежит }
            { контуру длины m }
            then For l:=1 to m do
            If (AdjN[l,i,j]=1) AND (m-l>0) AND (AdjN[m-l,j,i]=1)
            then
            begin
               Write (j,' '); GoTo Metka
            end;
            Metka:
         end;
         WriteLn ('}')
      end;
      end;
         WriteLn;
   end;
readln;
END.


пример матрицы
0 0 1 1 0
0 0 0 1 1
1 0 0 0 1
1 1 0 0 0
0 1 1 0 0
длина цикла - 5
klem4
без метки по идее так :

 For j:=1 to MaxNodes do
begin
If AdjN[m,j,j]=1
{ Вершина j принадлежит }
{ контуру длины m }
then For l:=1 to m do
If (AdjN[l,i,j]=1) AND (m-l>0) AND (AdjN[m-l,j,i]=1)
then
begin
Write (j,' '); GoTo Metka
end;
Metka:
end;


меняем на


for j := 1 to MaxNodes do
if AdjN[m,j,j]=1 then begin
l := 1;
while (l <= m) and NOT ( (AdjN[l,i,j]=1) AND (m-l>0) AND (AdjN[m-l,j,i]=1) ) do inc(l);
if l <= m then write(j, ' ');
end;
volvo
Цитата(LOVE133 @ 26.08.2006 11:32)
Может можно как-нибудь обойтись без нее? при ее удалении выводит повторные точки..

Просто так метку удалять нельзя, иначе действительно будут повторные точки (метка-то введена как раз для их отсечения)... Попробуй так: Описание метки удалить, вместо Goto Metka; поставь Break;, и саму метку тоже удали...

Break как раз и делает то же самое, что и твоя Metka - прекращает выполнение цикла, и выходит на следующую за этим циклом инструкцию...
LOVE133
Большое вам спасибо...может если время есть, поможете немного с алгоритмом...потому как писать свое гораздо проще , чем расшифровывать соседское.С трудом воспринимаю кусок про создание массива матрицы, возведенной в разные степени.
begin
Val:=0;
For k:=1 to MaxNodes do
Val:=Val OR (A[i,k] AND C[k,j]);
Z[i,j]:=Val
end;

еще интересный вопрос о том , по какому принципу определяется принадлежность точки контуру.Евстигнеева помню (использование матрицы смежности, и матриц в степени к и к-1 елси путь длиной к).ТОлько вот не очень понятно как этот алгоритм реализуется вот в этом куске программы
begin
Write ('Вершина ',i,'образует контуры длины ',m, ' с вершинами из множества:{');
For j:=1 to MaxNodes do
begin
If AdjN[m,j,j]=1
{ Вершина j принадлежит }
{ контуру длины m }
then For l:=1 to m do
If (AdjN[l,i,j]=1) AND (m-l>0) AND (AdjN[m-l,j,i]=1)
then
begin
Write (j,' '); GoTo Metka
end;
Metka:
end;
volvo
Цитата(LOVE133 @ 26.08.2006 12:38)
С трудом воспринимаю кусок про создание массива матрицы, возведенной в разные степени.
begin
Val:=0;
For k:=1 to MaxNodes do
Val:=Val OR (A[i,k] AND C[k,j]);
Z[i,j]:=Val
end;


Ну, если принять что элементами матрицы могут быть только 0 или 1, то такая запись возведения матрицы в степень аналогична этому:
begin
Val:=0;
For k:=1 to MaxNodes do
Val:=Val + (A[i,k] * C[k,j]);
Z[i,j]:=Val
end;
(т.к. логические операци в данном случае эквивалентны арифметическим), что и является правильным алгоритмом... У нас тоже в FAQ-е есть такое smile.gif
Как вычислить заданный многочлен от матрицы A (см. matrixMult и matrixPower)
LOVE133
теперь он мне рожицы рисует... а чиво с ними делать , я не знаю... пыталась все как у людей сделать, сообщения об ошибках и все прочее... вот теперь, когда матрицу не правильно вводишь, то рисует рожицы и потом так же менюшку рисует с рожами по второму разу. Я приблизительно догадываюсь , что дело тут в окнах, вернее в их размерах.Вот что получилось
Код: (Показать/Скрыть)
volvo
Проблема даже не в окошках... Смотри, что происходит:
type
NodePtr = 1..MaxNodes; { <--- Заметь, от 1 до MaxNodes, а не от 0 }
Param = 1..Stepen;
Element = 0..1;
AdjMatrix = Array [NodePtr,NodePtr] of Element;


Уже здесь:

Procedure  WinText(n:integer; var a:AdjMatrix);
...
for i:=0 to Pred( n) do
for j:=0 to Pred( n) do
begin
read(a[i,j]); { На первой же итерации - попытка чтения A[0, 0] }
gotoxy(2,7+i);
end;
...

у тебя будет неверный ввод данных (в частности - выход за границы массива).
LOVE133
(*бъет себя по лбу,сильно , сильно*)
переделать, все переделала, а сохранить забыла...
там нужно с 1... это от старой версии осталось, но там и массив с 0 начинался...
пасип...
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.