Cod sursa(job #119718)
Utilizator | Data | 2 ianuarie 2008 22:15:36 | |
---|---|---|---|
Problema | Ordine | Scor | 0 |
Compilator | fpc | Status | done |
Runda | Arhiva de probleme | Marime | 1.47 kb |
const fi='ordine.in';
fo='ordine.out';
var
f:text;
A:array[1..64000] of char;
Ap:Array['a'..'z'] of longint;
i,u,max,k:longint;
c,x,ch:char;
s:string;
Begin
assign(f,fi);reset(f);
while Not eof(f) do
begin
read(f,c);
Ap[c]:=Ap[c]+1;
k:=k+1;
if Ap[c]>max then begin
max:=Ap[c];
x:=c;
end;
end;
close(f);
u:=0;
c:='a';
s:='';
while c<'z' do
begin
if Ap[c]>0 then
if A[u]<>c then begin
u:=u+1;
A[u]:=c;
Ap[c]:=Ap[c]-1;
if s<>'' then begin
u:=u+1;
A[u]:=s[1];
Ap[s[1]]:=Ap[s[1]]-1;
delete(s,1,1);
end;
end
else begin
for i:=1 to Ap[c]-1 do
s:=s+c;
c:=succ(c)
end
else c:=succ(c);
end;
assign(f,fo);rewrite(f);
close(f);
End.