Cod sursa(job #569288)

Utilizator david93Demeny David david93 Data 1 aprilie 2011 12:00:11
Problema Jocul Flip Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.94 kb
uses crt;
type
 kl=array[0..100] of longint;
 op=^lp;
 lp=record
  a:longint;
  k:op;
 end;
 pl=array[0..100]of op;
var
 a,b,c,i,m,n,k,h,min:longint;
 j,t,d:kl;
 v:pl;
 p:op;
 f,g:text;
procedure punct(k,h:longint;var min:longint);
var p:op;
begin
 if j[k]=1
  then
   min:=d[k]
  else
   begin
    j[k]:=1;
    p:=v[k];
    t[k]:=t[h]+1;
    d[k]:=t[k];
    while p<>nil do
     begin
      if (t[p^.a]+1<t[k])or(j[p^.a]=0)
       then
        begin
        punct(p^.a,k,min);

        if min<d[k] then d[k]:=min;
        if t[k]<min then write(g,k);
       end;
      p:=p^.k;
     end;

   end;
end;
begin
 assign(f,'punct.in');
 reset(f);
 assign(g,'punct.out');
 rewrite(g);
 readln(f,n,m);
 for i:=1 to m do
   begin
    readln(f,a,b);
    new(p);
    p^.a:=b;
    p^.k:=v[a];
    v[a]:=p;
    new(p);
    p^.a:=a;
    p^.k:=v[b];
    v[b]:=p;
   end;
 punct(1,0,d[0]);
 close(f);
 close(g);
end.