Question

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

Answer 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.

Answer 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 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.