Cod sursa(job #141188)

Utilizator DanielGGlodeanu Ioan Daniel DanielG Data 22 februarie 2008 20:33:01
Problema Restante Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.51 kb
const
     nmax=36000;
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 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 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.