Pagini recente » Cod sursa (job #1202281) | Cod sursa (job #1170786) | Cod sursa (job #2730066) | Cod sursa (job #86632) | Cod sursa (job #141512)
Cod sursa(job #141512)
var a:Array[1..1000000] of char;
b:Array['a'..'z'] of longint;
f,g:text;
c,l,k,t:char;
j,min,nr,i,p,x,y,poz:longint;
ok:boolean;
{function numar3(var j:longint):longint;
var k:integer;
begin
for k:=j+1 to 30 do
if a[k]<>0 then begin
inc(nr);
if nr=3 then begin
numar3:=k;
break;
end;
end;
end;
function numar1(var j:longint):longint;
var k:integer;
begin
for k:=j+1 to 30 do
if a[k]<>0 then begin
numar1:=k;
exit;
end;
end;
function numar2(var j:longint):longint;
var k,nr,x:byte;
begin
nr:=0;
t:=0;
for k:=j+1 to 30 do
if a[k]<>0 then begin
inc(nr);
if nr=2 then begin
numar2:=k;
exit;
end;
end;
end; }
procedure caut(c:char;var d:char;var ok:boolean);
begin
d:=c;
while (b[d]=0) and (d<='z') do
inc(d);
if d>'z' then
ok:=false
else
ok:=true;
end;
begin
assign(f,'ordine.in');reset(f);
assign(g,'ordine.out');rewrite(g);
for l:='a' to 'z' do
b[l]:=0;
while not eof(f) do begin
while not eoln(f) do begin
read(f,c);
inc(b[c]);
end;
readln(f);
end;
l:='a';
while b[l]=0 do
inc(l);
k:=succ(l);
caut(k,k,ok);
repeat
if b[l]<b[k] then begin
for i:=1 to b[l] do
begin
inc(p);
a[p]:=l;
inc(p);
a[p]:=k;
end;
b[k]:=b[k]-b[l];
b[l]:=0;
caut(succ(k),t,ok) ;
l:=k;
k:=t;
end
else
if b[l]=b[k] then begin
for i:=1 to b[l] do begin
inc(p);
a[p]:=l;
inc(p);
a[p]:=k;
end;
b[l]:=0;
b[k]:=0;
caut(succ(l),l,ok);
caut(succ(l),k,ok);
end
else
begin
for i:=1 to b[k] do begin
inc(p);
a[p]:=l;
inc(p);
a[p]:=k;
end;
b[l]:=b[l]-b[k];
b[k]:=0;
caut(succ(k),k,ok);
end;
until not ok;
c:='a';
while (c<='z') and (b[c]=0) do
inc(c);
if c<='z' then begin
nr:=b[c];
if a[p]<>c then begin
inc(p);
a[p]:=c;
nr:=nr-1;
end;
if nr<>0 then begin
for i:=1 to p do
if a[i]=c then begin
poz:=i;
break;
end;
for i:=1 to poz-nr-1 do
write(g,a[i]);
for i:=1 to nr do
write(g,c,a[poz-nr+i-1]);
for i:=poz to p do
write(g,a[i]);
end;
end
else
{ ok:=false;
if a[k]<>0 then begin
inc(nr);
if nr=2 then
ok:=true;
if ok then begin
j:=k;
break;
end;
inc(k);
end
else
inc(i);
end;
while (a[i]<>0) or (a[j]<>0) do begin
write(g,b[i],b[j]);
dec(a[i]);
dec(a[j]);
nr2:=0;
for p:=1 to 30 do
if a[p]<>0 then
inc(nr2);
if nr2=1 then
break;
if (a[i]=0) and (a[j]=0) then begin
i:=numar1(i);
j:=numar2(j);
end;
if a[i]=0 then begin
i:=j;
j:=numar1(j);
end
else
if a[j]=0 then
j:=numar1(j);
end;
for i:=1 to 30 do
if a[i]<>0 then
for k:=1 to a[i] do
write(g,b[i]); }
for i:=1 to p do
write(g,a[i]);
close(g);
end.