Cod sursa(job #125069)

Utilizator raduzerRadu Zernoveanu raduzer Data 20 ianuarie 2008 11:13:59
Problema Restante Scor 100
Compilator fpc Status done
Runda preONI 2008, Runda 3, Clasa a 9-a Marime 1.35 kb
var n,i,j,z,x:longint;
    a:array[1..37000] of string;
    b:array['a'..'z'] of integer;
    c:char;


procedure Sort(l, r: longint);
var
  i, j: longint;
  x, y: string;
begin
  i := l; j := r; x := a[(l+r) DIV 2];
  repeat
    while a[i] < x do i := i + 1;
    while x < a[j] do j := j - 1;
    if i <= j then
    begin
      y := a[i]; a[i] := a[j]; a[j] := y;
      i := i + 1; j := j - 1;
    end;
  until i > j;
  if l < j then Sort(l, j);
  if i < r then Sort(i, r);
end;


begin
     assign(input,'restante.in');
     reset(input);
     assign(output,'restante.out');
     rewrite(output);
     readln(n);
     for i:=1 to n do
     begin
          readln(a[i]);
          for c:='a' to 'z' do b[c]:=0;
          for j:=1 to length(a[i]) do
          begin
               inc(b[a[i][j]]);
          end;
          z:=0;
          for c:='a' to 'z' do
          begin
               for x:=1 to b[c] do
               begin
                    inc(z);
                    a[i][z]:=c;
               end;
          end;
     end;
     sort(1,n);
     z:=0;
     i:=0;
     while i<n do
     begin
          inc(i);
          if (a[i]=a[i+1]) then inc(z);
          while a[i]=a[i+1] do
          begin
               inc(i);
               inc(z);
          end;
     end;
     writeln(n-z);
close(output);
end.