program JaunesnesDezes;
uses Crt;
const NN = 100;
      FailasDuomenu   = 'Dezes.dat';
      FailasRezultatu = 'Dezes.rez';
type
     Deze  = record
              r : integer;
              au, pl, il : integer;
             end;
     Mas   = array[1..NN] of Deze;
     Firma = record
               n   : integer;
               A   : Mas;
              end;
{----------------------------------------------}
procedure Skaityti( var F : text;  var FF : Firma);
var i : integer;
begin
  with FF do begin
    ReadLn( F, n );
    for i := 1 to n do with A[i] do ReadLn( F, r, pl, il, au );
  end;
end;
{----------------------------------------------}
function Ar( a, b, c : real;  D : Deze): boolean;
begin
  with D do
  Ar := ( a <  au ) and
        ( b <  pl ) and
        ( c <  il );
end;
{----------------------------------------------}
function Keisti( A, B : Deze ): boolean;
begin
  with A do
  Keisti := Ar( au, pl, il, B ) or
            Ar( au, il, pl, B ) or
            Ar( pl, au, il, B ) or
            Ar( pl, il, au, B ) or
            Ar( il, pl, au, B ) or
            Ar( il, au, pl, B );
end;
{----------------------------------------------}
procedure Rikiuoti( var FF : Firma);
var i, j : integer;  D : Deze;
begin
  with FF do
  for i := 1 to n-1 do
    for j := i+1 to n do
     if Keisti( A[j], A[i]) then
       begin  D := A[i]; A[i] := A[j];  A[j] := D end;
end;
{----------------------------------------------}
procedure Mesti( var FF : Firma; k : integer);
var i : integer;
begin
  for i := k to FF.n-1 do FF.A[i] := FF.A[i+1];
  FF.n := FF.n-1;
end;
{----------------------------------------------}
procedure Matrioska( var FF : Firma; var R : text; Sp : boolean);
var i : integer; D : deze;
begin
  D := FF.A[1];
  if Sp then   Write( R, D.r:5);
  Mesti( FF, 1 );
  i := 1;
  while i <= FF.n do begin
    if Keisti( D, FF.A[i] )
    then begin
           D := FF.A[i];
           if Sp then Write( R, D.r:5);
           Mesti( FF, i);
         end
     else i := i+1;
  end;
end;
{----------------------------------------------}
procedure VisosMatrioskos( var R : text; FF : Firma);
begin
    while FF.n > 0 do begin
      Matrioska( FF, R, True );
      if FF.n > 0 then WriteLn( R );
    end;
end;
{----------------------------------------------}
procedure Kiek( FF : Firma; var R : text);
var k : integer;
begin
    k := 0;
    while FF.n > 0 do begin
      Matrioska( FF, R, False );
      k := k+1;
    end;
    WriteLn( R, k );
end;
{----------------------------------------------}
var Ekranas : byte;
    F, R : text;
    FF : Firma;
begin
 Ekranas :=  TextAttr;
 TextBackground( Blue ); ClrScr;  TextColor( Red );
 GoToXY( 10, 30);
 WriteLn( 'Pradedu dirbti');
 Assign( R, FailasRezultatu); Rewrite( R );
 Assign( F, FailasDuomenu); Reset( F );
     Skaityti( F, FF);
     Rikiuoti( FF );
     Kiek( FF, R );
     VisosMatrioskos( R, FF );
 Close(F);
 Close(R);
 GoToXY( 15, 30);
 WriteLn( 'Darbas pabaigtas');
 TextAttr := Ekranas;  ClrScr;
end.