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

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

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

> Если не сложно, проверьте правильность написания программы..., Это не должно занять много времени. Заранее благодарна.
Shymoda
сообщение 13.04.2009 15:15
Сообщение #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 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
Shymoda
сообщение 13.04.2009 19:29
Сообщение #2





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

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


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

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


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

 



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