Программа вывода последовательности цифр в порядке увеличения частоты их встречаемости - Pascal

Формулировка задачи:

Болел два месяца — не знаю, что делать.

На самом деле тут работы на

две минуты

: скопипастил всё что нужно, осталось доработать (согласовать куски кода скопированные из разных источников).

ЗАДАНИЕ

В исходном текстовом файле записаны строки, содержащие цифры в произвольном порядке, возможно разделенные другими символами. Требуется написать программу, которая для каждой строки исходного файла будет выводить в результирующий файл последовательность цифр ('0','1'..'9') из входной последовательности в порядке увеличения частоты их встречаемости. Каждая цифра при этом должна быть распечатана один раз. Если какие-то цифры встречаются одинаковое число раз, то они выводятся по возрастанию. Например, пусть в одной из строк исходного файла содержатся следующие символы: 12324#32 в результирующем файле должно быть: 1432

program Lab3;
 
uses
  crt;
 
const
  FILE1 = 'C:\Users\user\Desktop\Lab3\fname1.txt';
  FILE2 = 'C:\Users\user\Desktop\Lab3\fname2.txt';
 
type
  mas = array[1..10] of integer;
  matr = array[1..10] of mas;
 
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;
    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;
//--- нашёл в интернете
  
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);    
    if (s <> '') then Alg(s, t)
    else (t := '');
    writeln(f2, t);
    end;
    close(f1); close(f2);
    end;
    
procedure FileNew(var fname1, fname2: string; f1, f2: text);
begin
  writeln('Введите имя исходного файла:'); // запрашиваем C:\Users\user\Desktop\Lab3\fname1.txt
  readln(fname1);
  fname1 := FILE1;
  if FileExists(fname1) then
  begin
    writeln('Введите имя результирующего файла'); // запрашиваем C:\Users\user\Desktop\Lab3\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.

Решение задачи: «Программа вывода последовательности цифр в порядке увеличения частоты их встречаемости»

Листинг программы

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.

Объяснение кода листинга программы

Объявляются переменные:
- s - строковая переменная
- b - массив целых чисел от 0 до 9
- c - массив целых чисел от 0 до 9
- i, p, q, t - целочисленные переменные
Запускается цикл while not EoF do, который выполняется до тех пор, пока не достигнут конец файла.
Считывается строка из файла и сохраняется в переменную s с помощью ReadLn(s).
Инициализируется массив b значениями от 0 до 9.
Инициализируется массив c значениями 0 для каждого индекса от 0 до 9.
Выполняется цикл для перебора символов в строке s и подсчета частоты встречаемости цифр от 0 до 9. Если символ является цифрой, то увеличивается соответствующий элемент массива c.
Устанавливаются значения переменных p и q равные максимальному индексу массива b.
Запускается цикл repeat...until, в котором проводится сортировка массивов b и c в порядке увеличения частоты встречаемости цифр.
Для каждой пары соседних элементов массива производится проверка частоты встречаемости (элемент c) и их значений (элемент b) и, если необходимо, происходит их обмен местами.
После сортировки выводятся отсортированные цифры, для которых частота встречаемости больше 0, в порядке увеличения частоты методом Write(b[i]);, а затем переход на новую строку методом WriteLn.
Повторять шаги с 3 по 10 до тех пор, пока файл не закончится.