[shkola] Още марсианци :)

Ако може, някой да ми кажете какво точно използвам(правих го по спомени и мой
измислици щото не можах да си намеря тетрадката докато го писах)БФЦ и тн, и
дали има неща за оправяне.

program marcians;
var
 visited        :array[1..100] of boolean;
 son            :array[1..100,1..100] of boolean;
 age            :array[1..100] of byte;
 F              :text;
 N,WS,RS,G,O,K  :byte;
 NoSons         :boolean;

procedure reading;
var
 i,J,P  :byte;
 all    :boolean;
begin
 assign(F,'inp.txt');
 reset(F);
  all:=false;
  readln(F,N);
 for I:=1 to N do
  begin
   for j:=1 to N do son[I,J]:=false;
    repeat
     read(F,P);
     if P = 0 then all := true
              else son[I,P]:=true;
    until all;
    readln(F);
  end;
  close(F);
end;

procedure WriteSteck(M:byte);
Var I   :byte;
begin
 for I:=1 to WS-1 do
  if M = Age[I] then
   begin
    for I:=I to WS-1 do
     Age[I] := Age[I+1];
    ws:=ws-1;
   end;
 //   writeln(M);
 age[WS] := M;
 WS:=WS+1;
end;

function readsteck:byte;
begin
  readsteck := age[RS];
  RS:=RS-1;
end;

procedure FindYounger(M:byte);
var
 I,J    :byte;
begin
 O:=M;
 NoSons:=True;
 Visited[M]:=true;
 //writeln(son[1,2]);
 for I:=1 to N do
  begin
   if ((son[m,I]) and (not(visited[I]))) then
   begin
    FindYounger(I);
    WriteSteck(m);
    NoSons := False;
   end;
  end;
 if NoSons then WriteSteck(m);
end;

procedure writing;
var i   :byte;
begin
for I:=1 to N do write(ReadSteck,' ');
end;



//MAIN
begin
 WS:=1;
 reading;
 for G:=1 to N do visited[g]:=false;
 RS:=n;
 FindYounger(1);
 while WS<N do
  begin
   if NoSons then
    Begin
     WriteSteck(O);
     FindYounger(O+1);
    end;
  end;
 Writing;
 readln;
end.


--------------------------------------
Това писмо е изпратено от  www.mail.bg

Безплатният адрес в mail.bg предлага:
- Силна АнтиСПАМ защита
- 12MB място за поща
- SMS за ново писмо (всички оператори)
- WAP достъп от GSM и без компютър
- Безплатен POP3 достъп
- Безплатна поддръжка по телефона
______________________________________
БЕЗ ИЗЛИШНИ ВЪПРОСИ РЕГИСТРИРАЙТЕ СВОЙ
БЕЗПЛАТЕН АДРЕС НА  http://www.mail.bg

Other related posts: