freepascal.ru

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

Помогите!!!!

я конечно не знаю что такое граф со списком инцедентностей, но гуголь выдает такое

Код: Выделить всё

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;


Спасибо, но это не то(

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

stiff Ну и в чем проблема? Это же азы. Как таблица умножения.
Код в студию. Поможем.

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

Русский язык:

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

Правила форума:

...
Безусловно будут удаляться:
Личные оскорбления в чей бы то ни было адрес, для ругани есть личная переписка по почте и приватные сообщения в форуме;
...

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

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

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

Поддерживаю. Жестковат ты Алекс. Человек, как минимум, смог разобраться в коде (пусть и простом) и понять, что "это не то". Я думаю, что сообщество не пороллить собралось.

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 секунд:
как правильно доделать-исправить?