program Lab3;

uses
  crt;

const
  FILE1 = 'C:\Users\user\Desktop\Lab3\fname1.txt';
  FILE2 = 'C:\Users\user\Desktop\Lab3\fname2.txt';

procedure About;
begin
  writeln('Л***');
  writeln('В***');
  writeln;

  writeln('Г***');
  writeln('К***');
  writeln;

  writeln('Задание.');
  writeln('Требуется написать программу, которая для каждой строки исходного файла');
  writeln('будет выводить в результирующий файл последовательность цифр из входной');
  writeln('последовательности в порядке увеличения частоты их встречаемости.');
  writeln('Примечание.');
  writeln('* Каждая цифра при этом должна быть распечатана один раз.');
  writeln('* Если какие-то цифры встречаются одинаковое число раз,');
  writeln('то они выводятся по возрастанию.');
  writeln('Например.');
  writeln('Пусть в одной из строк исходного файла содержатся следующие символы:');
  writeln('123**24#32');
  writeln('В результирующем файле должно быть:');
  writeln('1432');
end;

procedure Alg;
var
  s: String;
  b, c: array [0..9] of Integer;
  i, p, q, t: Integer;
begin
  while not EoF do
  begin
    ReadLn(s);
    for i := 0 to 9 do b[i] := i;
    for i := 0 to 9 do c[i] := 0;
    for i := 1 to Length(s) do
      if s[i] in ['0'..'9'] then Inc(c[Ord(s[i]) - Ord('0')]);
    q := High(b);
    repeat
      p := q;q := 0;
      for i := 0 to p - 1 do
        if (c[i + 1] < c[i]) or (c[i + 1] = c[i]) and (b[i + 1] < b[i]) then begin
          q := i;
          t := b[i];b[i] := b[i + 1];b[i + 1] := t;
          t := c[i];c[i] := c[i + 1];c[i + 1] := t;
        end;
    until q = 0;
    for i := 0 to 9 do if c[i] <> 0 then Write(b[i]);WriteLn;
  end;
end;

procedure FileToFile(var f1, f2: text);
var
  s, t: string;
begin
  reset(f1); rewrite(f2);// открываем файл 1, перезаписываем файл 2
  while not eof(f1) do // подсчитываем кол-во символов
  begin
    readln(f1, s);
    t := s;
    Alg;
    writeln(f2, t);
  end;
end;

procedure FileNew(var fname1, fname2: string; f1, f2: text);
begin
  writeln('Введите имя исходного файла:'); // fname1.txt
  readln(fname1);
  fname1 := FILE1;
  if FileExists(fname1) then
  begin
    writeln('Введите имя результирующего файла'); // fname2.txt
    readln(fname2);
    fname2 := FILE2;
    assign(f1, fname1);assign(f2, fname2);
    FileToFile(f1, f2);
  end
  else writeln('Файл с таким именем не существует.');
  close(f1);close(f2); // закрываем файл
  readln;
end;

var
  fname1, fname2: string;
  f1, f2: text;

begin
  About;
  FileNew(fname1, fname2, f1, f2);
end.