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

> Да? Ну давайте программку, чтоб мой контрольный пример решала. Я теснее полчаса не могу найти алгоритма

в самом начале спрашивали ведь, я мыслил вы с начала читали, а переделать вопрос я не мог т.к. теснее был дан ответ

Как-то обидно :с

Составления - труднее алгоритмически. Поиска - сложен только метод с хэшами, но его никто не требует. А так там только вычислительная сложность.

Так. В смысле. Желаю убедиться, что все верно сообразил. Вы в курсе, я обновил ответ, там сейчас две программки? 1-ая для поиска, 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 ilt;gt;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 nlt;gt;0 then b:=true;
 i:=0;
 k:=0;
 n1:=0;
 m:=length(s);
  while ilt;gt;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)lt;gt;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)lt;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])lt;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)lt;gt;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 lt;= l) do
   begin
   f := s[k] lt;gt; '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 gt;= mj - mi do
   begin
   t := true;
   k := 0;
   while t and (k lt;= (j - i) div 2) do
     begin
     t := s[i + k] = s[j - k];
     k := k + 1
     end;
   if t then
   if j - i gt; 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 lt;= 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] lt; 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 gt;= '1') and (c lt;= '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 lt;= '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.