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

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> Как обойтись без меток?, потому что работает не корректно...
LOVE133
сообщение 26.08.2006 11:32
Сообщение #1


Гарцующая лошадка
**

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

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


Занимаюсь изучение графов... так вот нашла подходящую программку,переделала ее под свои нужды...только вот никак не могу избавиться от меток, так как нужно соорудить процедуру, а там метка, и паскаль ругается и работать ни в какую не хочет.Может можно как-нибудь обойтись без нее? при ее удалении выводит повторные
точки..
Код

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
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
LOVE133
сообщение 26.08.2006 16:52
Сообщение #2


Гарцующая лошадка
**

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

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


(*бъет себя по лбу,сильно , сильно*)
переделать, все переделала, а сохранить забыла...
там нужно с 1... это от старой версии осталось, но там и массив с 0 начинался...
пасип...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме


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

 



- Текстовая версия 9.08.2025 20:06
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"