Cod sursa(job #128028)

Utilizator Cristian_BBerceanu Cristian Cristian_B Data 25 ianuarie 2008 22:04:19
Problema Stergeri Scor 30
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.27 kb
uses crt;
type pnod=^nod;
 nod=record
 inf:integer;
 leg:pnod;
end;
var k,i,n,m,j:integer;
    c1,a,b:pnod;
    x,y:array[1..255] of integer;
    f:text;
procedure cit_f;
begin
 assign(f,'stergeri.in');
 reset(f);
 readln(f,n,m,k);
 for i:=1 to m do
 readln(f,x[i],y[i]);
 close(f);
end;
procedure nod1;
begin
 new(a);
 a^.inf:=1;
 a^.leg:=nil;
 c1:=a;
 b:=a;
end;
procedure pune_nod(i:integer);
begin
 new(a);
 b^.leg:=a;
 a^.inf:=i;
 a^.leg:=nil;
 b:=a;
end;

procedure parcurge;
begin
 a:=c1;
 while a<>nil do
 begin
  write(a^.inf,' ');
  a:=a^.leg;
 end;
end;
procedure lista;
begin
  nod1;
  for i:=2 to n do
  pune_nod(i);
end;
procedure sterge1(poz1,poz2:integer);
var ret:pnod;
begin
 a:=c1;
 if poz1=1 then
 begin
  for j:= poz1 to poz2 do
  b:=a;
  a:=a^.leg;
  dispose(b);
  c1:=a;
 end
 else

 begin
  for j:=1 to  poz1-1  do
  begin
   b:=a;
   a:=a^.leg;
   end;
  ret:=b;
 for j:=poz1 to  poz2  do
   begin
    b:=a;
    a:=a^.leg;
    dispose(b);
   end;
  ret^.leg:=a;
 end;
end;

BEGIN
 clrscr;
 cit_f;
 lista;
 for i:=1 to m do
  sterge1(x[i],y[i]);
 parcurge;
  a:=c1;
  for i:=1 to k-1 do
  a:=a^.leg;
  assign(f,'stergeri.out');
  rewrite(f);
  write(f,a^.inf);
  close(f);
END.