Cod sursa(job #162487)

Utilizator andumMorie Daniel Alexandru andum Data 20 martie 2008 08:38:49
Problema Restante Scor 80
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.61 kb
type sir=array[1..36001] of string[20];
var n,i,j,l,k:longint;
    v:sir;
    f,g:text;
    c:char;
    ok:boolean;

procedure QuickSort(var A: sir; Lo, Hi: Integer);

procedure Sort(l, r: Integer);
var
  i, j: integer;
  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 {QuickSort};
  Sort(Lo,Hi);
end;


begin
        assign(f,'restante.in');
        assign(g,'restante.out');
        reset(f);
        rewrite(g);
        readln(f,n);
        for i:=1 to n do begin
                          readln(f,v[i]);
                          for j:=1 to length(v[i])-1 do
                           for l:=j+1 to length(v[i]) do
                                      if v[i][j]>v[i][l] then begin
                                                              c:=v[i][j];
                                                              v[i][j]:=v[i][l];
                                                              v[i][l]:=c;
                                                              end;
                         end;
        quicksort(v,1,n);
        i:=1;
        while i<=n do
        begin
             j:=i;
             while (v[i]=v[j+1]) and (j<=n) do
               j:=j+1;
             if i=j then k:=k+1;
             i:=j+1;
        end;
        write(g,k);
        close(f);
        close(g);
end.