Cod sursa(job #125841)

Utilizator ioalexno1Alexandru Bunget ioalexno1 Data 20 ianuarie 2008 19:12:00
Problema Restante Scor 50
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.29 kb
program alex;
var f:text;
    s:array[1..36000]of string[16];
    j,i,n,k,m,nr:longint;
    h:string[16];
    z:char;
    e:boolean;
begin
assign(f,'restante.in');reset(f);
readln(f,n);
nr:=0;
for i:=1 to n do
    begin
    readln(f,s[i]);
    m:=length(s[i]);
    e:=false;
    k:=1;
    while e=false do
          begin
          e:=true;
          for j:=1 to m-k do
              if s[i][j]>s[i][j+1] then begin
                                        z:=s[i][j];
                                        s[i][j]:=s[i][j+1];
                                        s[i][j+1]:=z;
                                        e:=false;
                                        end;
             k:=k+1;
              end;
    end;
e:=false;
k:=1;
while e=false do
      begin
      e:=true;
      for i:=1 to n-k do
          if s[i]>s[i+1] then begin
                              h:=s[i];
                              s[i]:=s[i+1];
                              s[i+1]:=h;
                              e:=false;
                              end;
     k:=k+1;
     end;
i:=0;
repeat
i:=i+1;
if s[i]<>s[i+1] then nr:=nr+1
                else
while s[i]=s[i+1] do
      i:=i+1;
until i=n;
close(f);
assign(f,'restante.out');rewrite(f);
writeln(f,nr);
close(f);
end.