Cod sursa(job #137949)

Utilizator Marius96Marius Gavrilescu Marius96 Data 17 februarie 2008 17:57:23
Problema Restante Scor 50
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.37 kb
var n,i,j,k,nr:longint; c:char; b1,b2:array['a'..'z'] of byte;
     v:array[1..36000] of string[16]; f:text;
     gasit, ok:boolean;
begin
assign(f,'restante.in'); reset(f);
readln(f,n);
for i:=1 to n do readln(f,v[i]);
close(f);
nr:=0;
for i:=1 to n-1 do
          if v[i]<>'' then begin
                   fillchar(b1, sizeof(b1),0);
                   gasit:=false;
                   for k:=1 to length(v[i]) do b1[v[i][k]]:=b1[v[i][k]]+1;
                   for j:=i+1 to n do
                 if v[j]<>'' then begin
                       fillchar(b2, sizeof(b1),0);
                       for k:=1 to length(v[j]) do b2[v[j][k]]:=b2[v[j][k]]+1;
                       ok:=false;
                       for c:='a' to 'z' do if b1[c]<>b2[c] then begin
                                                                 ok:=true;
                                                                 break;
                                                                 end;
                       if not(ok) then begin
                                       gasit:=true;
                                       v[j]:='';
                                      end;
                   end;
                   if gasit then v[i]:='';
                   end;
for i:=1 to n do if v[i]<>'' then nr:=nr+1;
assign(f,'restante.out'); rewrite(f);
writeln(f,nr);
close(f);
end.