Cod sursa(job #125804)

Utilizator Pepelea_FlaviuFlaviu Pepelea Pepelea_Flaviu Data 20 ianuarie 2008 18:33:08
Problema Restante Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.08 kb
var fi,fo:text;
    r:array[0..36001]of string[17];
    cc:array['a'..'z']of byte;
    n,i,j,ct:longint;
    c:char;
    s:string[17];
function part(st,dr:longint):longint;
var i,j,s:longint;
    aux:string;
begin
  i:=st; j:=dr; s:=-1;
  while i<j do
    begin
      if (r[i]>r[j]) then
        begin
          aux:=r[i]; r[i]:=r[j]; r[j]:=aux; s:=-s; end;
      if s=1 then inc(i)
             else dec(j);
    end;
  part:=i;
end;
procedure qsort(st,dr:longint);
var p:longint;
begin
  if st<dr then
    begin
      p:=part(st,dr);
      qsort(st,p-1);
      qsort(p+1,dr);
    end;
end;
begin
  assign(fi,'restante.in'); reset(fi);
  assign(fo,'restante.out'); rewrite(fo);
  readln(fi,n);
  for i:=1 to n do
    begin
      readln(fi,s);
      for c:='a' to 'z' do cc[c]:=0;
      for j:=1 to length(s) do inc(cc[s[j]]);
      for c:='a' to 'z' do
        for j:=1 to cc[c] do
          r[i]:=r[i]+c;
    end;
  qsort(1,n); ct:=0;
  for i:=1 to n do
    if (r[i]<>r[i-1])and(r[i]<>r[i+1]) then inc(ct);
  writeln(fo,ct);
  close(fi); close(fo);
end.