Cod sursa(job #267448)

Utilizator Cristian_BBerceanu Cristian Cristian_B Data 27 februarie 2009 13:34:16
Problema Restante Scor 50
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.11 kb
var ct,k,i,j,n:integer;
    aux:char;
    ok:boolean;
    c:Array[1..36000] of integer;
    v,st:array[1..36000] of string[16];
    f,g:Text;
function find(x:string):integer;
var ct:integer;
    i:integer;
begin
i:=1;
ct:=0;
while (i<=n) do
begin
 i:=i+1;
 if x=st[i] then
  ct:=ct+1;
end;
find:=ct;
end;
procedure load;
begin
assign(g,'restante.out');
rewrite(g);
assign(f,'restante.in');
reset(f);
readln(f,n);
for i:=1 to n do
readln(f,v[i]);
for i:=1 to n do
st[i]:='';
end;
BEGIN
load;
for i:=1 to n do
begin
for j:=1 to length(v[i])-1 do
 for k:=j+1 to length(v[i]) do
  if v[i][j]<v[i][k] then
  begin
   aux:=v[i][j];
   v[i][j]:=v[i][k];
   v[i][k]:=aux;
  end;
end;
k:=0;
for i:=1 to n do
begin
ok:=false;
j:=0;
while (j<=n) and (ok=false) do
begin
j:=j+1;
if v[i]=st[j] then ok:=true;
end;
if not ok then
 begin
  k:=k+1;
  st[k]:=v[i];
  c[k]:=c[k]+1;
 end;

end;
for i:=1 to k do
c[i]:=0;
for i:=1 to k do
for j:=1 to n do
if st[i]=v[j] then c[i]:=c[i]+1;
ct:=0;
for i:=1 to k do
if c[i]=1 then ct:=ct+1;
writeln(g,ct);
close(f);
close(g);

END.