Cod sursa(job #45985)

Utilizator HubaNagy Csaba Huba Data 2 aprilie 2007 10:47:41
Problema Elimin Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.17 kb
type kore= set of byte;
var
 dect:set of byte;
 munk,drum,luc,ut:array [1..255] of set of byte;
 f:text;
 x,y,k,j,i,a,b,n:byte;
 ok:boolean;



begin
K:=1;
 assign(f,'sant.in');reset(f);
 readln(f,n);
  For i:=1 to n do Begin
     readln(f,a,b);
      dect:=[];
      dect:=dect+[a..b];
     j:=1;




    while (ut[j]<>[])and(dect*ut[j]=[]) do       inc(j);


   if ut[j]=[] then    ut[j]:=ut[j]+dect
    else begin inc(k);ut[j]:=ut[j]*dect;end;

    luc[j]:=luc[j]+[i];
   end;

  for x:=2 to k do
   for y:=x+1 to k do
    if (ut[x]*ut[y]<>[]) then begin
      ut[x]:=ut[x]*ut[y];
      ut[y]:=[];
      luc[x]:=luc[x]*luc[y];
      luc[y]:=[];
     end;
close(f);

 assign(f,'sant.out');rewrite(f);
  x:=0;
   for y:=1 to 255 do
    if ut[y]<>[] then begin inc(x);
     drum[x]:=ut[y];
      munk[x]:=luc[y];
    end;
  writeln(f,x);
  for i:=1 to x do begin
   x:=0;
     write(f,i,' ');
     while [x]*drum[i]=[] do
     inc(x);

     write(f,x,' ');
   x:=255;
     while [x]*drum[i]=[] do
     dec(x);

     writeln(f,x);

  for y:=1 to n do
    if munk[i]*[y]<>[]  then write(f,y,' ');

   writeln(f);
 end;
close(f);

end.