Cod sursa(job #126878)

Utilizator antoanelaAntoanela Siminiuc antoanela Data 22 ianuarie 2008 22:23:15
Problema Restante Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.04 kb
program restante;
var f,g:text;
    y:string;
    x:array[1..16]of char;
    aux:char;
    a:array[1..36000]of string;
    v:array[1..36000]of longint;
    n,k,ord,c,i,j,ok,l:longint;
begin
assign(f,'restante.in');
assign(g,'restante.out');
reset(f);
rewrite(g);
readln(f,n);
k:=0;
for i:=1 to n do
  begin
    readln(f,y);
    for j:=1 to length(y) do
      x[j]:=y[j];
      repeat
        ord:=0;
        for j:=1 to length(y)-1 do
          if (x[j]>x[j+1])then
            begin
              aux:=x[j];
              x[j]:=x[j+1];
              x[j+1]:=aux;
              ord:=1;
            end;
      until ord=0;
    l:=length(y);
    y:='';
    for j:=1 to l do y:=y+x[j];
    ok:=0;
    for j:=1 to k do
      if (a[j]=x)then
        begin
          v[j]:=v[j]+1;
          ok:=1;
          break;
        end;
    if (ok=0)then
        begin
          k:=k+1;
          a[k]:=x;
          v[k]:=1;
        end;
  end;
for i:=1 to k do
  if (v[i]>1)then c:=c+1;
writeln(g,c);
close(f);
close(g);
end.