Дана строка из n символов(все числа), заканчивающаяся нулем. Ноль в этой строке только 1....

Question

57 просмотров

Дана строка из n символов(все числа), заканчивающаяся нулем. Ноль в этой строке только 1. Требуется написать программу на Паскале, которая составит число-палиндром. Если таких чисел несколько то вывести минимальное из них. Нулей в числе быть не должно. Все имеющиеся цифры использовать не обязательно, но кол-во цифр должно быть максимально возможным

Информатика beenchmark_zn (595 баллов) 17 Апр, 18 | 57 просмотров

Дано ответов: 2

Правильный ответ

//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) 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]) 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.

Gleb1Kosyrev_zn (38.6k баллов) 17 Апр, 18

Segrif_zn · Answer 1 · 2018-04-17T20:55:48+0000

{Вариант с поиском,
Пока что просто решил игнорировать 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.