Дана строка из n символов(все числа), заканчивающаяся нулем. Ноль в этой строке только 1. Требуется написать программу на Паскале, которая составит число-палиндром. Если таких чисел несколько то вывести минимальное из них. Нуле...
Дана строка из n символов(все числа), заканчивающаяся нулем. Ноль в этой строке только 1. Требуется написать программу на Паскале, которая составит число-палиндром. Если таких чисел несколько то вывести минимальное из них. Нулей в числе быть не должно. Все имеющиеся цифры использовать не обязательно, но кол-во цифр должно быть максимально возможным
Гость
Ответ(ы) на вопрос:
Гость{Вариант с поиском,
Пока что просто решил игнорировать 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.
Гость//Pascal ABC.NET v3.1 сборка 1172
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)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.
Не нашли ответ?
Похожие вопросы