графы

Общие вопросы программирования, алгоритмы и т.п.

Модератор: Модераторы

графы

Сообщение stiff » 01.09.2016 09:04:35

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

Помогите!!!!
stiff
незнакомец
 
Сообщения: 3
Зарегистрирован: 01.09.2016 08:59:49

Re: графы

Сообщение DYUMON » 01.09.2016 11:46:29

я конечно не знаю что такое граф со списком инцедентностей, но гуголь выдает такое
Код: Выделить всё
const
  MaxN = 100;
  MaxM = MaxN;

var
  M,N : Integer;
  G : array [1 .. MaxN,1 .. MaxN] of Boolean;
  Cur,ACur : Integer;
  ASol,BSol,Prev : array [1 .. MaxN] of Integer;
  Ql,Qr : Integer;
  Q : array [1 .. MaxN*2+1] of Integer;

function PBFS(A : Integer) : Boolean;
var
  B : integer;
  Found : Boolean;
begin
  fillchar(Prev,sizeof(Prev),0);
  Ql := 1;
  Qr := 1;
  Q[1] := A;
  Found := false;
  while (Qr>=Ql) and not Found do
  begin
    Cur := Q[Ql];
    Inc(Ql);
    for B:=1 to N do
      if G[Cur,B] then
      begin
        ACur := B;
        if BSol[ACur]=0 then
        begin
          Found := true;
          break;
        end
        else if Prev[Bsol[ACur]]=0 then
        begin
          Prev[BSol[ACur]]:=Cur;
          inc(Qr);
          Q[Qr]:=BSol[ACur];
        end;
      end;
     end;
     PBFS:=Found;
end;

procedure PMax;
var
  A,B : Integer;
  Tmp : Integer;
begin
  fillchar(ASol,sizeof(ASol),0);
  fillchar(BSol,sizeof(BSol),0);
  for A:=1 to M do
    if PBFS(A) then
      while Cur<>0 do
      begin
        Tmp:=ASol[Cur];
        BSol[ACur]:=Cur;
        ASol[Cur]:=ACur;
        Cur:=Prev[Cur];
        ACur:=Tmp;
      end;
end;
Аватара пользователя
DYUMON
постоялец
 
Сообщения: 234
Зарегистрирован: 11.03.2009 13:32:54

Re: графы

Сообщение stiff » 01.09.2016 12:08:18

Спасибо, но это не то(
stiff
незнакомец
 
Сообщения: 3
Зарегистрирован: 01.09.2016 08:59:49

Re: графы

Сообщение alex208210 » 01.09.2016 13:01:07

Сиди дома и учи программирование бездарь. Контрольные нужно делать самому, а не списывать у других.
alex208210
постоялец
 
Сообщения: 207
Зарегистрирован: 12.05.2010 13:16:51

Re: графы

Сообщение vada » 01.09.2016 14:54:38

stiff Ну и в чем проблема? Это же азы. Как таблица умножения.
Код в студию. Поможем.
Аватара пользователя
vada
энтузиаст
 
Сообщения: 691
Зарегистрирован: 14.02.2006 13:43:17

Re: графы

Сообщение resident » 01.09.2016 20:07:59

alex208210 писал(а):Сиди дома и учи программирование бездарь.

Русский язык:
Если обращение стоит в конце предложения, то перед ним ставится запятая, а после него тот знак, который нужен по смыслу: точка, восклицательный или вопросительный знак.

Правила форума:
...
Безусловно будут удаляться:
Личные оскорбления в чей бы то ни было адрес, для ругани есть личная переписка по почте и приватные сообщения в форуме;
...
resident
энтузиаст
 
Сообщения: 605
Зарегистрирован: 13.03.2013 16:58:51

Re: графы

Сообщение Deimos » 01.09.2016 21:59:47

alex208210 писал(а):Сиди дома и учи программирование бездарь. Контрольные нужно делать самому, а не списывать у других.


stiff писал(а):Спасибо, но это не то(


resident писал(а):Правила форума:


Поддерживаю. Жестковат ты Алекс. Человек, как минимум, смог разобраться в коде (пусть и простом) и понять, что "это не то". Я думаю, что сообщество не пороллить собралось.
Deimos
постоялец
 
Сообщения: 169
Зарегистрирован: 17.01.2010 00:31:30

Re: графы

Сообщение stiff » 02.09.2016 08:48:24

Program SIAOD_LAB_7;
uses crt;
type list=^S;
S=record
inf:word;
adr1:list;
adr2:list;
end;
var graf:array[1..10] of list;
i,j,k,k1,o,os:integer;
kolver:integer;
PrSpis,PrSpisInc:list;
NeSpis:list;
ObSpis,NeObSpis:List;

procedure Spisok1(inf:Word);
var Spis:list;
begin
New(Spis);
Spis^.inf:=inf;
Spis^.Adr1:=Nil;
Spis^.Adr2:=Nil;
PrSpis^.Adr1:=Spis;
PrSpis:=Spis;
If k=0 Then NeSpis:=Spis;
Inc(k);
end;

procedure Spisok2(inf:Word);
var Spis:list;
begin
New(Spis);
Spis^.inf:=inf;
Spis^.Adr1:=Nil;
Spis^.Adr2:=Nil;
PrSpisInc^.Adr2:=Spis;
PrSpisInc:=Spis;
Inc(k1);
end;


procedure SpisokInc;
var ve,re:Integer; Spis:list;
begin
k:=0;
NeSpis:=Nil;
Spis:=NeSpis;
Write('Vvedite kol-vo vershin: ');
Read(kolver);
for i:=1 to kolver do
begin
Spisok1(i);
Write('Vvedite kol-vo reber dla vershini ', i,'= ');
Readln(re);
PrSpisInc:=PrSpis;
k1:=0;
for j:=1 to re do
begin
Write('Vvedite vershiny, v = ');
Readln(ve);
Spisok2(ve);
end;
end;
end;

procedure obhod;
var f:boolean; Spis, Spp:list; ve:integer;
begin
f:=false;
Spis:=NeSpis;
ve:=Spis^.inf;
Spp:=NeSpis;
for i:=1 to kolver do
begin
[COLOR="Magenta"]собственно начиная от сюда[/COLOR]
if Spis^.inf=0 then
begin
writeln ('Y vershini net dug')
end
else
begin
writeln ('Dygi est');
end;
{while (Spis<>Nil) do
begin
ve:=Spis^.inf;
if not obhod(ve) then writeln('Vvvvvv');
Spis:=Spis^.Adr2;
end;
Spis:=Spp^.Adr1;
Spp:=Spis;}
[COLOR="magenta"] И заканчивая тут я делаю что то не то....[/COLOR]
end;
end;

begin
clrscr;
spisokinc;
if kolver<>0 then
begin

obhod;
end
else
Writeln('Versin net');
writeln('Nagmite klavishu');
repeat until keypressed;
END.

Добавлено спустя 38 секунд:
как правильно доделать-исправить?
stiff
незнакомец
 
Сообщения: 3
Зарегистрирован: 01.09.2016 08:59:49


Вернуться в Общее

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 6

Рейтинг@Mail.ru