删除 (Standard IO)

题意/Description:

       Alice上化学课时又分心了，他首先画了一个3行N列的表格，然后把数字1到N填入表格的第一行，保证每个数只出现一次，另外两行他也填入数字1到N，但不限制每个数字的出现次数。
　　Alice现在想删除若干列使得每一行排完序后完全一样，编程计算最少需要删除多少列。

 

读入/Input：

       第一行包含一个整数N(1<=N<=100000)，表示表格的列数。
　　接下来三行每行包含N个整数，每个数在1到N之间，而且第一行的数互不相同。

 

输出/Output：

       输出最少需要删除的列数。

 

题解/solution：

       读入时，求出每一行数字的个数。然后枚举每一列，只要第一行的数在第二第三行没有出现，就删除。累加ans。

 

代码/Code：

var
  n,m,ans:longint;
  a,d:array [0..100001,1..3] of longint;
  f:array [0..100001] of longint;
  v:array [0..100001] of boolean;
function fd(o:longint):boolean;
begin
  exit((d[o,1]>d[o,2]) or (d[o,1]>d[o,3]));
end;

procedure qsort(l,r:longint);
var
  i,j,mid:longint;
  t:array [1..3] of longint;
begin
  i:=l; j:=r;
  mid:=a[(l+r) div 2,1];
  repeat
    while a[i,1]<mid do inc(i);
    while a[j,1]>mid do dec(j);
    if i<=j then
      begin
        t:=a[i]; a[i]:=a[j]; a[j]:=t;
        inc(i); dec(j);
      end;
  until i>j;
  if l<j then qsort(l,j);
  if i<r then qsort(i,r);
end;

procedure init;
var
  i,j:longint;
begin
  readln(n);
  for i:=1 to 3 do
    for j:=1 to n do
      begin
        read(a[j,i]);
        inc(d[a[j,i],i]);
      end;
  qsort(1,n);
  ans:=0;
end;

procedure main;
var
  i,ta,he,t,k:longint;
begin
  ta:=0; he:=0;
  for i:=1 to n do
    if fd(i) then
      begin
        inc(ta); f[ta]:=i;
        v[i]:=true;
      end;
  while he<ta do
    begin
      inc(he); t:=f[he];
      if fd(t) then
        begin
          for i:=1 to 3 do
            begin
              k:=a[t,i];
              dec(d[k,i]);
              if (not v[k]) and (fd(k)) then
                begin
                  inc(ta); f[ta]:=k;
                  v[k]:=true;
                end;
            end;
          inc(ans);
        end;
      v[t]:=false;
    end;
end;

begin
  init;
  main;
  writeln(ans);
end.