Pagini recente » Cod sursa (job #547415) | Cod sursa (job #1142328) | Cod sursa (job #2078838) | Cod sursa (job #1183938) | Cod sursa (job #120117)
Cod sursa(job #120117)
const fi='ordine1.in';
fo='ordine.out';
var
f:text;
A:array[1..64000] of char;
Ap:Array['a'..'z'] of longint;
i,u,k:longint;
uc,c,ch:char;
Begin
for c:='a' to 'z' do
Ap[c]:=0;
assign(f,fi);reset(f);
k:=0;
while Not eof(f) do
begin
read(f,c);
k:=k+1;
Ap[c]:=Ap[c]+1;
end;
close(f);
uc:='a';
while Ap[uc]=0 do
uc:=succ(uc);
u:=0;
while u<k do
begin
ch:=uc;
while (ch<='z') and (Ap[ch]<Trunc((k-u)/2)+1) do
ch:=succ(ch);
if ch <='z' then
begin
u:=u+1;
A[u]:=ch;
Ap[ch]:=Ap[ch]-1;
end
else begin
c:=uc;
while (Ap[c]=0) and (c<='z') do
c:=succ(c);
if (c=A[u]) and (c<='z') then begin
ch:=Succ(c);
while (Ap[ch]=0) and (ch<='z')do
ch:=succ(ch);
if ch<='z' then begin
u:=u+1;
A[u]:=ch;
Ap[ch]:=Ap[ch]-1;
end;
end
else begin
u:=u+1;
A[u]:=c;
Ap[c]:=Ap[c]-1;
end;
end;
While (Ap[uc]=0)and (uc<='d') do
uc:=succ(uc);
end;
assign(f,fo);rewrite(f);
i:=1;
while A[i]<>#0 do begin
write(f,A[i]);
i:=i+1;
end;
close(f);
End.