Cod sursa(job #143058)

Utilizator AndreiDDiaconeasa Andrei AndreiD Data 25 februarie 2008 21:37:37
Problema Restante Scor 20
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.46 kb
const nmax=36;
Type  vect=array[1..nmax] of string[16];
Var f:text;
nr,L,i,N,j:longint;
s:string[16];
ok:boolean;
c:char;
A:vect;
procedure QuickSortC(var A:vect;Lo,Hi:longint);
procedure SortC(l,r:longint);
var
  i,j:longint;
  x,y:string[16];
begin
  i:=l;
  j:=r;
  x:=a[(l+r) div 2];
  repeat
    while a[i]<x do inc(i);
    while x<a[j] do dec(j);
    if i<=j then begin
      y:=a[i];
      a[i]:=a[j];
      a[j]:=y;
inc(i);
dec(j);
    end;
  until i>j;
  if l<j then SortC(l,j);
  if i<r then SortC(i,r);
end;
begin
  SortC(Lo,Hi);
end;
Begin
     assign(f,'restante.in'); reset(f);
     Readln(f,n);
for i:=1 to n do begin
Readln(f,s);
L:=Length(s)-1;
         repeat
               ok:=True;
               For j:=1 to L do
                   if s[j]>s[j+1] then begin
                                            ok:=False;
                                            c:=s[j];
                                            s[j]:=s[j+1];
                                            s[j+1]:=c;
                                       end;
                   L:=L-1;
         until ok;
         A[i]:=s;
     end;
     close(f);
     QuickSortC(A,1,N);
     i:=1;
     nr:=0;
     while i<=N do
     begin
          j:=i;
          while A[j+1]=A[i] do
                j:=j+1;
          if i=j then nr:=nr+1;
          i:=j+1;
     end;
     assign(f,'restante.out'); rewrite(f);
     write(f,nr);
     close(f);
End.