Cod sursa(job #125571)

Utilizator ProtomanAndrei Purice Protoman Data 20 ianuarie 2008 14:51:42
Problema Restante Scor 80
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.88 kb
var f1,f2:text;
    i,n,m,dimh,h,nr,j,el:longint;
    aux:string[20];
    s:array[0..36010] of string[20];
    c:array[0..30] of longint;

procedure repair(i:longint);
var l,r,max:longint;
begin
        l:=2*i;
        r:=l+1;
        max:=i;
        if (l<=dimh)and(s[l]>s[max]) then
                max:=l;
        if (r<=dimh)and(s[r]>s[max]) then
                max:=r;
        if max<>i then
        begin
                aux:=s[i];
                s[i]:=s[max];
                s[max]:=aux;
                repair(max);
        end;
end;

procedure buildheap(h:longint);
var i:longint;
begin
        for i:=h div 2 downto 1 do
                repair(i);
end;

procedure heapsort;
var i:longint;
begin
        buildheap(h);
        for i:=h downto 2 do
        begin
                aux:=s[1];
                s[1]:=s[i];
                s[i]:=aux;
                dec(dimh);
                repair(1);
        end;
end;

begin
        assign(f1,'restante.in');
        reset(f1);
        assign(f2,'restante.out');
        rewrite(f2);
        readln(f1,n);
        for i:=1 to n do
        begin
                readln(f1,s[i]);
                m:=length(s[i]);
                for j:=1 to m do
                        inc(c[ord(s[i,j])-96]);
                s[i]:='';
                el:=0;
                for j:=1 to 26 do
                        while c[j]>0 do
                        begin
                                dec(c[j]);
                                inc(el);
                                s[i]:=s[i]+chr(j+96);
                        end;
        end;
        dimh:=n;
        h:=n;
        heapsort;
        s[0]:='';
        s[n+1]:='';
        for i:=1 to n do
                if (s[i]<>s[i+1])and(s[i]<>s[i-1]) then
                        inc(nr);
        writeln(f2,nr);
        close(f1);
        close(f2);
end.