Var s,sub,sub1,res:string; i,j,k,q,m,n,n1,min1,min:integer; ar:array of string; ar1:array of string; c:char; b:boolean; begin readln(s); delete(s,pos('0',s),length(s)-pos('0',s)+1); b:=false; k:=0; m:=length(s); i:=0; n:=0; while i<>m do begin; inc(i); for j:=i to m do begin; if s[i]=s[j] then inc(k); if k=2 then break; end; if k=2 then begin; c:=s[i]; inc(n); setlength(ar,n+1); ar[n]:=c; i:=0; for q:=1 to 2 do delete(s,pos(c,s),1); end; k:=0; m:=length(s); end; if n<>0 then b:=true; i:=0; k:=0; n1:=0; m:=length(s); while i<>m do begin; inc(i); for j:=i to m do if s[i]=s[j] then inc(k); if k=1 then begin; c:=s[i]; inc(n1); setlength(ar1,n1+1); ar1[n1]:=c; i:=0; while pos(c,s)<>0 do delete(s,pos(c,s),1); end; k:=0; m:=length(s); end; for i:=1 to n do sub+=ar[i]; writeln(sub); min:=2147483647; for i:=1 to n do begin; if strtoint(sub)<min then min:=strtoint(sub); c:=sub[length(sub)]; for j:=length(sub)-1 downto 1 do sub[j+1]:=sub[j]; sub[1]:=c; end; min1:=2147483647; for i:=1 to n1 do if strtoint(ar1[i])<min1 then min1:=strtoint(ar1[i]); if b=false then begin; writeln(min1); exit; end; sub1:=inttostr(min1); sub:=inttostr(min); res:=sub+sub1; if length(sub)<>0 then for i:=1 to length(sub) div 2 do begin c:=sub[i]; sub[i]:=sub[length(sub)-i+1]; sub[length(sub)-i+1]:=c; end; res:=res+sub; writeln(res); end.
{Вариант с поиском, Пока что просто решил игнорировать 0, раз он все равно в конце}
var s: string; i,j,k,l: integer; t,f: boolean; mi,mj: integer; x,y:array[boolean] of integer; begin mi := 1; mj := 0; readln(s); l := length(s); //- 1; {оканчивается на 0?} k := 1; f := true; while f and (k <= l) do begin f := s[k] <> '0'; if f then k := k + 1 end; x[false] := 1; y[false] := k - 1; x[true] := k + 1; y[true] := l;
for f := false to true do for i := x[f] to y[f] do begin j := y[f]; while j - i >= mj - mi do begin t := true; k := 0; while t and (k <= (j - i) div 2) do begin t := s[i + k] = s[j - k]; k := k + 1 end; if t then if j - i > mj - mi then begin mi := i; mj := j; end else if j - i = mj - mi then begin k := 0; t := true; while t and (k <= j - i) do begin t := s[i + k] = s[mi + k]; if t then k := k + 1 end; t := not t; if t then t := s[i + k] < s[mi + k]; if t then begin mi := i; mj := j; end end; j := j - 1 end end; for k := mi to mj do write(s[k]) end.
{Вариант с составлением}
var a: array['1'..'9'] of integer; i: integer; c: char; t: boolean; begin for c := '1' to '9' do a[c] := 0; repeat read(c); if (c >= '1') and (c <= '9') then a[c] := a[c] + 1; until c = '0'; for c := '1' to '9' do for i := 1 to a[c] div 2 do write(c); c := '1'; t := true; while t and (c <= '9') do begin if odd(a[c]) then begin write(c); t := false end; c := succ(c) end; for c := '9' downto '1' do for i := 1 to a[c] div 2 do write(c)
Var
s,sub,sub1,res:string;
i,j,k,q,m,n,n1,min1,min:integer;
ar:array of string;
ar1:array of string;
c:char;
b:boolean;
begin
readln(s);
delete(s,pos('0',s),length(s)-pos('0',s)+1);
b:=false;
k:=0;
m:=length(s);
i:=0;
n:=0;
while i<>m do
begin;
inc(i);
for j:=i to m do
begin;
if s[i]=s[j] then inc(k);
if k=2 then break;
end;
if k=2 then
begin;
c:=s[i];
inc(n);
setlength(ar,n+1);
ar[n]:=c;
i:=0;
for q:=1 to 2 do
delete(s,pos(c,s),1);
end;
k:=0;
m:=length(s);
end;
if n<>0 then b:=true;
i:=0;
k:=0;
n1:=0;
m:=length(s);
while i<>m do
begin;
inc(i);
for j:=i to m do
if s[i]=s[j] then inc(k);
if k=1 then
begin;
c:=s[i];
inc(n1);
setlength(ar1,n1+1);
ar1[n1]:=c;
i:=0;
while pos(c,s)<>0 do
delete(s,pos(c,s),1);
end;
k:=0;
m:=length(s);
end;
for i:=1 to n do
sub+=ar[i];
writeln(sub);
min:=2147483647;
for i:=1 to n do
begin;
if strtoint(sub)<min then
min:=strtoint(sub);
c:=sub[length(sub)];
for j:=length(sub)-1 downto 1 do
sub[j+1]:=sub[j];
sub[1]:=c;
end;
min1:=2147483647;
for i:=1 to n1 do
if strtoint(ar1[i])<min1 then min1:=strtoint(ar1[i]);
if b=false then
begin;
writeln(min1);
exit;
end;
sub1:=inttostr(min1);
sub:=inttostr(min);
res:=sub+sub1;
if length(sub)<>0 then
for i:=1 to length(sub) div 2 do
begin
c:=sub[i];
sub[i]:=sub[length(sub)-i+1];
sub[length(sub)-i+1]:=c;
end;
res:=res+sub;
writeln(res);
end.
Пока что просто решил игнорировать 0, раз он все равно в конце}
var
s: string;
i,j,k,l: integer;
t,f: boolean;
mi,mj: integer;
x,y:array[boolean] of integer;
begin
mi := 1;
mj := 0;
readln(s);
l := length(s); //- 1; {оканчивается на 0?}
k := 1;
f := true;
while f and (k <= l) do
begin
f := s[k] <> '0';
if f then k := k + 1
end;
x[false] := 1;
y[false] := k - 1;
x[true] := k + 1;
y[true] := l;
for f := false to true do
for i := x[f] to y[f] do
begin
j := y[f];
while j - i >= mj - mi do
begin
t := true;
k := 0;
while t and (k <= (j - i) div 2) do
begin
t := s[i + k] = s[j - k];
k := k + 1
end;
if t then
if j - i > mj - mi then
begin
mi := i;
mj := j;
end
else
if j - i = mj - mi then
begin
k := 0;
t := true;
while t and (k <= j - i) do
begin
t := s[i + k] = s[mi + k];
if t then k := k + 1
end;
t := not t;
if t then
t := s[i + k] < s[mi + k];
if t then
begin
mi := i;
mj := j;
end
end;
j := j - 1
end
end;
for k := mi to mj do
write(s[k])
end.
{Вариант с составлением}
var
a: array['1'..'9'] of integer;
i: integer;
c: char;
t: boolean;
begin
for c := '1' to '9' do
a[c] := 0;
repeat
read(c);
if (c >= '1') and (c <= '9') then
a[c] := a[c] + 1;
until c = '0';
for c := '1' to '9' do
for i := 1 to a[c] div 2 do
write(c);
c := '1';
t := true;
while t and (c <= '9') do
begin
if odd(a[c]) then
begin
write(c);
t := false
end;
c := succ(c)
end;
for c := '9' downto '1' do
for i := 1 to a[c] div 2 do
write(c)
end.