Cod sursa(job #111181)
Utilizator | Data | 28 noiembrie 2007 19:55:18 | |
---|---|---|---|
Problema | Ordine | Scor | 100 |
Compilator | fpc | Status | done |
Runda | Arhiva de probleme | Marime | 3.31 kb |
var f1,f2:text;
c,impl:char;
a:array[1..1000000] of char;
v,vi,ur,ui,pr,pri:array[1..100] of longint;
i,j,g,n,r,h,min,min2,ug:longint;
ok:boolean;
procedure cauta;
begin
for i:=1 to 30 do
if v[i]>0 then
begin
min:=i;
min2:=ur[i];
break;
end;
end;
procedure executa;
begin
for i:=1 to n do
if a[i]='0' then
begin
if a[i-1]=chr(min+96) then
begin
a[i]:=chr(min2+96);
dec(v[min2]);
end
else
begin
a[i]:=chr(min+96);
dec(v[min]);
end;
if v[min2]=0 then
begin
pr[min2]:=ur[min2];
min2:=ur[min2];
end;
if v[min]=0 then
begin
pr[min2]:=ur[min2];
min:=min2;
min2:=ur[min2];
end;
end;
end;
procedure caz1;
begin
h:=n;
while v[g]>0 do
begin
a[h]:=impl;
dec(h,2);
dec(v[g]);
end;
cauta;
executa;
end;
procedure caz2;
begin
h:=n-1;
while v[g]>0 do
begin
a[h]:=impl;
dec(h,2);
dec(v[g]);
end;
cauta;
executa;
end;
procedure verificare;
begin
ok:=true;
for i:=2 to n do
if a[i]=a[i-1] then
ok:=false;
for i:=1 to 30 do
if v[i]<>0 then
ok:=false;
if ok=false then
for i:=1 to n do
a[i]:='0';
end;
begin
assign(f1,'ordine.in');
reset(f1);
assign(f2,'ordine.out');
rewrite(f2);
while not eoln(f1) do
begin
read(f1,c);
if c in ['a'..'z'] then
begin
inc(n);
inc(v[ord(c)-96]);
end;
end;
vi:=v;
for i:=1 to 30 do
begin
r:=r-v[i];
if (r<=0)and(v[i]>0) then
begin
r:=-r;
impl:=chr(i+96);
g:=i;
end;
end;
for i:=1 to 30 do
if (v[i]>0)and(g<>i) then
begin
pr[i]:=ug;
ur[ug]:=i;
ug:=i;
end;
ui:=ur;
pri:=pr;
for i:=1 to n do
a[i]:='0';
caz1;
verificare;
v:=vi;
ur:=ui;
pr:=pri;
if ok=false then caz2;
for i:=1 to n do
write(f2,a[i]);
close(f1);
close(f2);
end.