Cod sursa(job #117702)

Utilizator DanielGGlodeanu Ioan Daniel DanielG Data 21 decembrie 2007 23:53:56
Problema Litere Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.65 kb
var a:array[1..30000] of char;
b:array[1..10000] of integer;
aux,n,i,j,l,k,m:integer;
f,g:text;
ok:boolean;
begin
assign(f,'litere.in');reset(f);
assign(g,'litere.out');rewrite(g);
readln(f,n);
for i:=1 to n do
read(f,a[i]);
for j:=1 to n do
b[j]:=(ord(a[j]));
m:=0;
while m<100000 do
begin
k:=1;
l:=2;
repeat
if b[k]>b[l] then begin
aux:=b[k];
b[k]:=b[l];
b[l]:=aux;
inc(m);
end
else
begin
inc(k);
inc(l);
end;
until l=18;
ok:=true;
for i:=1 to n-1 do
begin
for j:=i+1 to n do
if b[i]>b[j] then
begin
ok:=false;
break;
end;
if (not ok) then break;
end;
if ok then break;
end;
writeln(g,m);
close(f);
close(g);
end.