Pagini recente » Cod sursa (job #2806155) | Cod sursa (job #2563902) | Cod sursa (job #2128151) | Cod sursa (job #2567162) | Cod sursa (job #142517)
Cod sursa(job #142517)
var a:Array[1..1000000] of char;
b:Array['a'..'z'] of longint;
f,g:text;
c,l,k:char;
j,min,nr,i,p,x,y,poz:longint;
ok:boolean;
procedure caut(c:char ;var d:char;var ok:boolean);
begin
d:=c;ok:=true;
while(d>='a') and( b[d]=0) do
dec(d);
if d>='a' then ok:=true
else ok:=false;
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:='z';
while b[l]=0 do
dec(l);
k:=pred(l);
p:=0;
caut(pred(l),k,ok);
repeat
if ok then begin
while (b[l]<>0) and (b[k]<>0) do
begin
inc(p,2);
a[p-1]:=l;a[p]:=k;
dec(b[l]);dec(b[k]);
end;
if b[k]<>0 then begin l:=k;caut(pred(l),k,ok);
if ok then begin inc(p);a[p]:=k; dec(b[k]);end;end
else begin if b[l]=0 then
caut(pred(l),l,ok);
caut(pred(l),k,ok);
end;end;
until not ok;
c:='a';
while (c<='z') and (b[c]=0) do
inc(c);
if c<='z' then begin
nr:=b[c];
end;
if a[p]<>c then begin
inc(p);a[p]:=c;dec(nr);end;
write(g,a[p]);
for i:=p-1 downto 1 do
if (nr>0)and (a[i+1]<>c) and(a[i]<>c) then
begin
write(g,c,a[i]);dec(nr);
end
else write(g,a[i]);
close(g);
end.