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

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

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

 
 Ответить  Открыть новую тему 
> Если не сложно, проверьте правильность написания программы..., Это не должно занять много времени. Заранее благодарна.
сообщение
Сообщение #1





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

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


Ориентированный граф задан матрицей инцидентности. По заданной матрице сформировать список окрестностей вершин графа. По сформированному списку окрестностей вершин определить степени захода всех вершин графа и вершину с максимальной степенью захода. Удалить вершину с максимальной степенью захода вместе со смежными ей вершинами из списка окрестностей.

Program EinZweinDrein;
Type
EU=^Elem;
Elem=Record
nv:integer;
adres:EU;
end;
Var M:array[1..10,1..20] of integer;
Kver,kdur,maxver,imax,kdel:integer;
BegSpis,St,Sp:EU;
Procedure OpenFileForRead;
Var F_in:Text;
i,j:integer;
Begin
Assign(F_in,'Matr.txt');
Reset(F_in);
Kver:=0; Kdur:=0; i:=0;
While not Eof(F_in) do
Begin
Inc(i); j:=0;
While not Eoln(F_in) do
Begin
Inc(j);
Read(F_in,M[i,j]);
End;
Readln(F_in);
Kdur:=j;
End;
Kver:=i;
End;
Procedure VivodMatric;
Var i,j:integer;
Begin
For i:=1 to kver do
Begin
For j:=1 to kdur do
Write(M[i,j]:3);
End;
End;
Procedure Formirovanie;
Var i,j,k:integer;
Begin
New(St);
BegSpis:=St;
For i:=1 to kver do
Begin
St^.nv:=-i;
Sp:=St;
New(St);
Sp^.adres:=St;
For j:=1 to kdur do
If M[i,j]=1 then
For k:=1 to kver do
If M[k,j]=-1 then
St^.nv:=k;
End;
Sp^.adres:=nil;
End;
Procedure VivodSpis;
Begin
St:=BegSpis;
While St<>Nil do
Begin
Write(St^.nv,' ');
St:=St^.adres;
End;
End;
Procedure StepZah;
Var A:array[1..10] of integer;
i:integer;
Begin
For i:=1 to kver do
A[i]:=0;
St:=BegSpis;
While St<>Nil do
Begin
If St^.nv>0 then
A[st^.nv]:=A[st^.nv]+1;
St:=St^.adres;
End;
Writeln('Stepeni zahoda');
For i:=1 to kver do
Writeln(i,' ',A[i]);
Maxver:=A[1];
Imax:=1;
For i:=2 to kdur do
If Maxver<A[i] then
Begin
Maxver:=A[i];
Imax:=i;
End;
Maxver:=Imax;
Writeln('Maxver=',Maxver);
End;
Procedure DeleteElem;
Var K:array[1..10] of integer;
i:integer;
Begin
St:=BegSpis;
Kdel:=0;
While St<>Nil do
Begin
If St^.nv=-maxver then
Kdel:=Kdel+1;
K[kdel]:=maxver;
St:=St^.adres;
If (St<>Nil) and (st^.nv>0) then
Begin
K[kdel]:=St^.nv;
St:=St^.adres;
End;
Break;
End;
For i:=1 to kdel do
Begin
St:=BegSpis;
While St<>Nil do
Begin
If St^.nv=-K[i] then
Begin
If St=BegSpis then
BegSpis:=St^.adres
Else
Begin
Sp^.adres:=St^.adres;
St:=Sp;
End;
St:=St^.adres;
While (St<>Nil) and (St^.nv>0) do
Begin
If St=BegSpis then
BegSpis:=St^.adres
Else
Begin
Sp^.adres:=St^.adres;
Sp:=St;
End;
Sp:=St;
St:=St^.adres;
End;
End
Else if Sp^.adres=St^.adres then
Begin
Sp^.adres:=St^.adres;
St:=Sp;
End;
Sp:=St;
St:=St^.adres;
End;
End;
End;
Begin
OpenFileForRead;
VivodMatric;
Formirovanie;
VivodSpis;
StepZah;
DeleteElem;
VivodSpis;
End.


М
Просьба использовать тэги кода при публикации программного текста. Lapp

 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гость






Shymoda, погоди... Что твоя программа делает вообще? Ты ее хотя бы запускала? Она ж у тебя вылетает при выполнении DeleteElem. А выводит вообще непонятно что. Ну, допустим, единственное, что она делает правильно - это вводит исходную матрицу инцидентности (если добавить Writeln куда нужно). Вот лог работы твоей программы с произвольной матрицей инцидентности (нарисовал граф "с потолка" и заполнил значения матрицы):
 -1  0  0  0 -1  0  0  0
1 -1 -1 0 0 0 0 0
0 1 0 1 0 0 0 0
0 0 1 1 0 -1 -1 0
0 0 0 0 1 1 0 -1
0 0 0 0 0 0 1 1
-1 -2 -3 -4 -5 -6 Stepeni zahoda
1 0
2 0
3 0
4 0
5 0
6 0
Maxver=7
И что здесь означает этот список? Что значат полученные степени захода? Это надо понимать так, что ни одна вершина вообще в графе не присутствует? С чего тогда вывод о том, что максимальная степень захода именно у седьмой вершины? В представленном графе, кстати, вершин с макс. степенью захода сразу три: №4, №5 и №6, а седьмой вершины в графе нет совсем...

Дальше: Почему ты все пишешь в один список окрестностей? Список окрестностей, если я не ошибаюсь, строится для каждой вершины отдельно...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3





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

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


А-а... сорри...был косяк в процедуре формирования списка. Уже нашла, спс.
Щас попробую с остальным разобраться.
Там весь фокус в том, что тут по заданию список окрестностей для всех вершин составить надо.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4





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

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


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


Гость






Цитата
Честно говоря, как-то не соображу так сразу почему...
Ну, ты бы показала новую процедуру формирования списка, может вместе и разберемся, почему DeleteElem глючит...

Добавлено через 6 мин.
Старая версия вылетала, потому что у тебя не хватало begin/end, как я понимаю:
Procedure DeleteElem;
Var K:array[1..10] of integer;
i:integer;
Begin
St:=BegSpis;
Kdel:=0;
While St<>Nil do Begin
If St^.nv=-maxver then BEGIN { <--- }
Kdel:=Kdel+1;
K[kdel]:=maxver;
END; { <--- }
St:=St^.adres;
If (St<>Nil) and (st^.nv>0) then Begin
K[kdel]:=St^.nv;
St:=St^.adres;
End;
Break;
End;
...
А теперь подумай, что у тебя происходило, когда этих begin/end не было? На первой же итерации обращение к 0-му элементу массива (а массив-то описан с индексами 1 .. 10) - давало тебе вылет...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6





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

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


Ага... все исправлено... терь работает).
Благодарю).
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7





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

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


И еще такое дело...
В текстовом режиме программа работает. Тут вопросов нет.
Есть вопросы по реализации данного алгоритма в графическом режиме.
Конкретно - создание меню.
Какой способ был бы наиболее быстрым и простым?
И как будет выглядеть в графическом режиме, допустим, вывод матрицы на экран?
Мне просто не доводилось пока что изучать модуль GRAPH, поэтому представление о его возможностях имею весьма слабое...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Гость






Цитата
Какой способ был бы наиболее быстрым и простым?
Организация меню в программах
Зайди и посмотри...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9





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

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


И... вот процедура как бы самого графа рисования.
Ну как бы по списку окрестностей.
В целом рисует, но в самом конце спотыкается.
Никак не пойму, в чем проблема.
В принципе, у меня загвоздка только в ней.
Буду благодарна, если поможете разобраться.

Procedure RisGraph(xc,yc:integer);
Var UG,R,R1:real;
i,k,g,j:integer;
Xk,Yk,xkv,ykv,k,g:array[1..5] of integer;
Sn:string;
Begin
UG:=(2*Pi)/kver;
R:=50;
R1:=70;
For i:=1 to kver do
Begin
Xk[i]:=Round(R*cos(UG*i) + xc);
Yk[i]:=Round(R*sin(UG*i) + yc);
Xkv[i]:=Round(R1*cos(UG*i) + xc);
Ykv[i]:=Round(R1*sin(UG*i) + yc);
Setcolor(Black);
Circle(xk[i],yk[i],4);
Str(i,sn);
Setcolor(Cyan);
Outtextxy(xkv[i],ykv[i],sn);
End;
St:=BegSpis;
While St<>Nil do
Begin
If St^.nv<0 then
K:=abs(St^.nv);
St:=St^.adres;
If St^.nv>0 then
Begin
While St^.nv>0 do
Begin
G:=St^.nv;
SetLineStyle(0,0,1);
SetColor(Red);
Line(xk[k],yk[k],xk[g],yk[g]);
St:=St^.adres;
End;
End;
End;
End;


М
Просьба использовать тэги code=pas, а не цитату.
Сколько можно просить об одолжении выполнять Правила?
Lapp

 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #10





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

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


А, кстати, уже не надо, разобралась...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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

 





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