Cod sursa(job #197468)

Utilizator theratmantheratman theratman Data 4 iulie 2008 12:30:48
Problema Litere Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.71 kb
var f,g:text;
    a:array[1..26,1..9999] of longint;
    s:array[1..10000] of longint;
    i,n,j,h,nr,l,aux:longint;
    x:char;
begin
assign(f,'litere.in');reset(f);
assign(g,'litere.out');rewrite(g);
readln(f,n);
for i:=1 to n do begin
 read(f,x);
 s[i]:=ord(x)-96;
 inc(a[s[i],1]);
 a[s[i],a[s[i],1]+1]:=i;
end;
l:=1;
nr:=0;
for i:=1 to 26 do begin
 for j:=2 to a[i,1]+1 do
  if a[i,j]=l then inc(l)
   else begin
    for h:=2 to a[s[l],1]+1 do
     if a[s[l],h]=l then break;
    inc(nr,abs(a[i,j]-l));
    aux:=a[s[l],h];
    a[s[l],h]:=a[i,j];
    a[i,j]:=aux;
    aux:=s[l];
    s[l]:=s[a[aux,h]];
    s[a[aux,h]]:=aux;
    inc(l);
   end;
end;
writeln(g,nr);
close(f);
close(g);
end.