Cod sursa(job #579925)

Utilizator ion_calimanUAIC Ion Caliman ion_caliman Data 12 aprilie 2011 16:29:57
Problema Cutii Scor 40
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.66 kb
var     a:array[1..3,1..3500] of integer;
        n,t,nr,i:integer;
        buf:array[1..1000000] of char;
        f,g:text;

procedure sw(var a,b:integer);
var     t:integer;
begin
  t:=a; a:=b; b:=t;
end;

procedure qs3(left,right:integer);
var     i,j,r:integer;
begin
  i:=left; j:=right; r:=a[3,(i+j) div 2];
  while i<j do
    begin
      while r>a[3,i] do inc(i);
      while r<a[3,j] do dec(j);
      if i<=j then
        begin
          sw(a[3,i],a[3,j]);
          inc(i);
          dec(j);
        end;
    end;
  if i<right then qs3(i,right);
  if j>left then qs3(left,j);
end;

procedure qs2(left,right:integer);
var     i,j,r:integer;
begin
  i:=left; j:=right; r:=a[2,(i+j) div 2];
  while i<j do
    begin
      while r>a[2,i] do inc(i);
      while r<a[2,j] do dec(j);
      if i<=j then
        begin
          sw(a[2,i],a[2,j]);
          sw(a[3,i],a[3,j]);
          inc(i);
          dec(j);
        end;
    end;
  if i<right then qs2(i,right);
  if j>left then qs2(left,j);
end;

procedure qs(left,right:integer);
var     i,j,r:integer;
begin
  i:=left; j:=right; r:=a[1,(i+j) div 2];
  while i<j do
    begin
      while r>a[1,i] do inc(i);
      while r<a[1,j] do dec(j);
      if i<=j then
        begin
          sw(a[1,i],a[1,j]);
          sw(a[2,i],a[2,j]);
          sw(a[3,i],a[3,j]);
          inc(i);
          dec(j);
        end;
    end;
  if i<right then qs(i,right);
  if j>left then qs(left,j);
end;

procedure sortare;
var     i,j,k,l:integer;
begin
  qs(1,n);
  i:=1;
  while i<n do
    begin
      j:=i;
      while a[1,i]=a[1,j+1] do inc(j);
      qs2(i,j);
      k:=i;
      while k<j do
        begin
          l:=k;
          while a[2,k]=a[2,l+1] do inc(l);
          qs3(k,l);
          k:=l+1;
        end;
      i:=j+1;
    end;
end;

procedure cmls;
var     best:array[1..30001] of integer;
        max:integer;
        i,j:integer;
begin
  for i:=1 to n do best[i]:=0;
  best[n]:=1;
  max:=1;
  for i:=n-1 downto 1 do
    begin
      best[i]:=1;
      for j:=i+1 to n do
        if (a[1,i]<a[1,j])and(a[2,i]<a[2,j])and(a[3,i]<a[3,j])and(best[i]<best[j]+1) then
          begin
            best[i]:=best[j]+1;
            if best[i]>max then max:=best[i];
          end;
    end;
  nr:=max;
end;

procedure citire;
var     i:integer;
begin
  for i:=1 to n do
    readln(f,a[1,i],a[2,i],a[3,i]);
  nr:=0;
  sortare;
  cmls;
  writeln(g,nr);
end;

begin
  assign(f,'cutii.in');
  assign(g,'cutii.out');
  reset(f);
  rewrite(g);
  settextbuf(f,buf);
  settextbuf(g,buf);

  readln(f,n,t);
  for i:=1 to t do
    citire;

  close(g);
end.