Вывести цифры, встречающиеся в последовательности, в порядке увеличения частоты их встречаемости

var
    s :string;
    d, p :array[0 .. 1000] of longint;
    i, c, j :longint;
begin
    read(s);
 
    for i := 1 to length(s) do
        inc(d[ord(s[i]) - 48]);
 
    for i := 0 to 9 do
        p[i] := i;
 
    for i := 1 to 100 do
        for j := 0 to 8 do
            if (d[p[j]] > d[p[j + 1]]) then begin
                c := p[j];
                p[j] := p[j + 1];
                p[j + 1] := c;
            end;
 
    for i := 0 to 9 do
        if (d[p[i]] <> 0) then 
            write(p[i]);
        
end.

program zz;
Uses
    Crt;
var
   i,g,q,k:integer;
   s,s1:string;
   a:array[1..10] of integer;
begin
readln(s);
k:=10;
 for i:=1 to length(s) do
  begin
   val(s[i], g, q);
   a[g]:=a[g]+1;
  end;
 
s:='';
 
 for i:=1 to 10 do
  begin
   if (a[i] < k) and (a[i] <> 0) then k:=a[i];
  end;
 
g:=1;
 
 for i:=1 to 10 do
  begin
   if (a[i] = k) then
    begin
     str(i, s1);
     s:=s+s1;
    end;
  end;
 
 for g:=1 to 100 do
  begin
   for i:=1 to 10 do
    begin
     if (a[i]=g) and (a[i]<>k) then
      begin
       str(i, s1);
       s:=s+s1;
      end;
    end;
  end;
 
writeln(s);
readkey;
end.

const
  d: array ['0'..'9'] of Char = '0123456789';
var
  c: array ['0'..'9'] of Integer;
  s: String;
  i, ti: Integer;
  j, tc: Char;
begin
  Write('Введите последовательность цифр: '); ReadLn(s);
  for i:=1 to Length(s) do
    if s[i] in ['0'..'9'] then Inc(c[s[i]])
    else Break;
  repeat
    i:=0;
    for j:='0' to '8' do
      if (c[j]>c[succ(j)]) or (c[j]=c[succ(j)]) and (d[j]>d[succ(j)])
      then begin
        ti:=c[j]; c[j]:=c[succ(j)]; c[succ(j)]:=ti;
        tc:=d[j]; d[j]:=d[succ(j)]; d[succ(j)]:=tc;
        Inc(i);
      end;
  until i=0;
  for j:='0' to '9' do if c[j]>0 then Write(d[j]); WriteLn;
end.