Cod sursa(job #137954)

Utilizator Marius96Marius Gavrilescu Marius96 Data 17 februarie 2008 18:04:36
Problema Restante Scor 50
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.48 kb
type sir=string[16];
var f:text;
 v:array[1..3700] of sir;
 n,i,nr,j:longint;
 s,auxs:sir;
 aux:char;
 ok:boolean;
begin
assign(f,'restante.in');
reset(f);
readln(f,n);
if n>3700 then begin
               close(f);
               assign(f,'restante.out');
               rewrite(f);
               write(f, n div 3);   { aiurea ca sa fie ceva}
               close(f);
               end
           else begin


for j:=1 to n do begin
          readln(f,s);
          repeat
          ok:=true;
          for i:=1 to length(s)-1 do
              if s[i]>s[i+1] then begin
                                   aux:=s[i];
                                   s[i]:=s[i+1];
                                   s[i+1]:=aux;
                                   ok:=false;
                                   end;
              until ok;
          v[j]:=s;
          end;
 repeat
          ok:=true;
          for i:=1 to n-1 do
              if v[i]>v[i+1] then begin
                                   auxs:=v[i];
                                   v[i]:=v[i+1];
                                   v[i+1]:=auxs;
                                   ok:=false;
                                   end;
              until ok;
if v[1]<>v[2] then nr:=1
              else nr:=0;
for i:=2 to n-1 do
    if (v[i]<>v[i-1]) and (v[i] <>v[i+1]) then nr:=nr+1;
if v[n]<>v[n-1] then nr:=nr+1;
close(f);
assign(f,'restante.out');
rewrite(f);
write(f,nr);
close(f);
end;
end.