Реализация Алгоритма Хаффмана - Turbo Pascal

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

Здравствуйте. Прошу помочь, есть программа на ABC паскале, но необходимо чтобы было написано в Turbo паскале. Нужно ее исправить. Если возможно, сделать

проще и понятнее.

Ниже прикреплена программа. И так же фотография как это все должно выводится на экране.

uses crt;
var
st:string;
m:array[#0..#255] of integer;
i,p,j:integer;
s:real;
h:array [1..255] of real;
ch:char;
sum: array[1..255] of real;
v: array[1..255] of string;
z: array[1..255] of string;
kod: array[1..255] of string;
i_min,j_min,x:integer;
min1,min2:real;

begin
Writeln('Введите алфавит',st);
readln(st);
 
{вычисляем вероятности символов}
For i:=1 to length(st) do
begin
inc(m[st[i]]);
end;
 
 i:=1;
 for ch:=#0 to #255 do  begin
 if m[ch]>0 then
 {writeln(ch,' ',m[ch]);}
 if m[ch]>0 then  begin
  h[i]:=1/length(st)* m[ch];
  {writeln(h[i]:2:3,' ');}
  i:=i+1;
 end;
 end;
 
 s:=0;
 p := i-1;
  
 {Кодирование}
 
 begin
    i:=1;
    begin
     for ch:=#0 to #255 do
     if m[ch]>0 then begin v[i]:=ch;i:=i+1; end;
    end;
     writeln; write('алфавит:        ');
     for i:=1 to p do
     write(v[i],'      ');
     
     for i:=1 to p do
     z[i]:=v[i];                  {создаём неизменяемую строку алфавита}

    begin
     for i:=1 to p do
    sum[i]:=h[i];
    writeln; Write('вероятности: ');
     for i:=1 to p do
    write(Sum[i]:2:3,' ');
    end;
 
   repeat
    i_min:=1;
    sum[i_min]:=sum[1];
   for i:=2 to p do
     if sum[i]< sum[i_min] then begin
     i_min:=i;
     sum[i_min]:=sum[i];
     end;
 
     writeln;
     write('min1=',sum[i_min]:2:2);
     min1:=sum[i_min];     {Убираем первый минимум}
     sum[i_min]:=1;
     
     j_min:=1;
    sum[j_min]:=sum[1];
   for i:=2 to p do
     if sum[i]< sum[j_min] then begin
     j_min:=i;
     sum[j_min]:=sum[i];
     end;
     
     writeln;
     write('min2=',sum[j_min]:2:2);
     sum[i_min]:=min1;  {возвращаем значение первого минимума}
     
     if (i_min > j_min) then begin x:=i_min;
                                   i_min:=j_min;
                                   j_min:=x;
 
      end;
 
     sum[i_min]:=sum[i_min]+sum[j_min];
     sum[j_min]:=2;
         writeln;
     for i:=1 to p do
    write(sum[i]:2:2,'  ');

         {if length(v[i_min])>1 then begin }
     for i:=1 to p do begin
      for j:=1 to length(v[i_min]) do
      if (z[i]=copy(v[i_min],j,1))
      then begin kod[i]:='0' + kod[i];
                   i:=i+1;
      end;
      end;

            {if length(v[j_min])>1 then begin}
     for i:=1 to p do begin
      for j:=1 to length(v[j_min]) do
      if (z[i]=copy(v[j_min],j,1))
      then begin kod[i]:='1' + kod[i];
                   i:=i+1;
      end;
      end;
 
    v[i_min]:=v[i_min]+v[j_min];
     v[j_min]:='_';
         writeln;
     for i:=1 to p do
    write(v[i],'  ');
    writeln;
    for i:=1 to p do
    write(kod[i],'  ');
     
    until length(v[i_min])=p;
    end;
    end.

Решение задачи: «Реализация Алгоритма Хаффмана»

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

const 
{   n=28;   {количество максимальное символов}
    {Вводим константы и указатель на массивы}
    max = 122;
    search=['A'..'Z', ' ', '.'];
    prep = ['.','!','?',','];
Type    {Вводим указатели на массивы для передачи их в процедуры}
    Matr = array[1..max] of real;
 
 
var
 
    Chuf :array[1..max,1..max] of 0..1;
    Shuf: array[1..max] of 0..1;
    Lhuf:array[1..100]of integer;
    jn:array[1..max] of integer;
    P: Matr;
    Count: array[1..max] of integer;    {массив содержащий количества символов}
    Symbol: array[1..max] of char;
    proverka, qn, ent, Lcp, Hp, Mk, Hcode, Pcode, buf1: real; {переменные для частоты, проверки вероятности и тд и тп}
    Col: Integer;   {переменные для общего количества символов и пар символов}
    Fin, Fout, Fcoder: Text;                {переменные для файлов, входного и выходного}
    fname, foutname, fcode: string; {переменные для файлов, входного и выходного}
    k, i, l, s, j, lasttree, lastusel, col1, Ls, Lh, buf3: integer; 
 
    Q, ch,  buf2, ch3: Char; 
    ch1: string;
{//////////////////////////////////////////////////////////////////////////////////}
 
{Объявляем процедуру вычисления энтропии для текстового файла на английском языке. 
В процедуре подсчитываем частоты появления символов}
Procedure entropy(var P:array of real);
var 
    i: Integer;
begin
    writeln(#13, #10, '---------------------------------------------------------------');   
    write(Fout,  #13, #10, '---------------------------------------------------------------');
    writeln(#13, #10, 'ДЛЯ ОДИНОЧНЫХ СИМВОЛОВ в файле ', fname);    
    write(Fout,  #13, #10, 'ДЛЯ ОДИНОЧНЫХ СИМВОЛОВ в файле ', fname);   
    Writeln(#13, #10, 'Всего учитываемых символов в тексте (для одиночных символов): ', Col);
    write (Fout,  #13, #10, #10,'Всего учитываемых символов в тексте (для одиночных символов): ', Col);
    proverka:=0; ent:=0;
 
{считаем частоту появления букв по ASCII с 65 по 90 - т.к. они у нас все заглавные}
l:=0;
for i:=32 to 90 do 
    {прописные и заглавные буквы не отличаются}
    if (Count[i]>0) then 
        begin
            l:=l+1;
            Count[l]:=Count[i];
            P[l]:=Count[l]/Col; {частота появления букв}
            ent:=  ent - P[l]*ln(P[l])/ln(2);{записываем энтропию}
            proverka:= proverka + P[l];
            Symbol[l] := Chr (i);
                Writeln(#13, #10, 'символ: ', Symbol[l], ' Количество символов: ', Count[l], '  частота появления: ', P[l]:7:4); 
                Writeln(Fout, #13, #10, 'символ: ', Symbol[l], ' Количество символов: ', Count[l], '  частота появления: ', P[l]:7:4);
            end; 
 
{сортируем частоту по убыванию}
for i:=1 to l-1 do 
    for j:=i+1 to l do
    {if Count[i]>0 then }
        if P[i]<P[j] then 
            begin
                buf1:=P[i]; buf2:=Symbol[i]; buf3:=Count[i];
                P[i]:=P[j]; Symbol[i]:=Symbol[j]; Count[i]:=Count[j];
                P[j]:=buf1; Symbol[j]:=buf2; Count[j]:=buf3;
            end;
    Writeln(#13, #10, '//////////////////////////////////////////////////////////////////////////////////'); 
    Writeln(Fout, #13, #10, '//////////////////////////////////////////////////////////////////////////////////');
{заполним массивы для построения дерева Хаффмана}
for i:=1 to l do
begin
    Writeln(#13, #10, 'символ: ', Symbol[i], ' Количество символов: ', Count[i], '  частота появления ',i,': ', P[i]:7:4); 
    Writeln(Fout, #13, #10, 'символ: ', Symbol[i], ' Количество символов: ', Count[i], '  частота появления ',i,': ', P[i]:7:4);
end;
    Writeln(#13, #10, 'Сумма вероятностей появления символов в файле ', fname, '  = ',proverka:7:4);
    write (Fout,  #13, #10, 'Сумма вероятностей появления символов в файле ', fname, '  = ', proverka:7:4);
{   lasttree := l;  {индекс - номер последнего элемента в массиве F- лес }
{   lastusel := l;  {индекс - номер последнего элемента в массиве Т }
end;
 
 
 
 
 
function Up(l:integer; qn:real; var P:array of real):integer;
 
begin
j:=1;
for i:=l-1 downto 2 do
begin
if (P[i-1] < qn) then 
    P[i]:=P[i-1]
else 
    begin
    j:=i;
    Break;
    end;
end;
    P[j]:=qn;
    Up:=j;
 
        Writeln(#13, #10, 'Up qn   ', qn:7:4,'    ', j:4, '  P[',j,']', P[j]:7:4);
        write (Fout,  #13, #10, 'Up qn   ', qn:7:4,'    ', j:4, '  P[',j,']', P[j]:7:4);    
    for i:=1 to l do 
begin
        Writeln(#13, #10, 'UP P[',i,'] ', P[i]:7:4, i:4);
        write (Fout,  #13, #10, 'UP  P[',i,'] ', P[i]:7:4, i:4);    
end;
 
end;
 
procedure Down(var l, j: integer);
begin
for i:=1 to l do 
Shuf[i]:=Chuf[j,i];
Lh:=Lhuf[j];
 
for i:=j to l-2 do
begin
    for k:=1 to l do
        Chuf[i,k]:=Chuf[i+1,k];
Lhuf[i]:=Lhuf[i+1];
end;
 
for i:=1 to l do
begin
    Chuf[l-1,i]:=Shuf[i];
    Chuf[l,i]:=Shuf[i];
end;
Chuf[l-1,Lh+1]:=0;
Chuf[l, Lh+1]:=1;
Lhuf[l-1]:=Lh+1;
Lhuf[l]:=Lh+1;
        Writeln(#13, #10, 'Down Lh   ', Lh:4);
        write (Fout,  #13, #10, 'Down Lh   ', Lh:4);
    for i:=1 to l do 
begin
        Writeln(#13, #10, 'Down Lhuf[',i,'] ', Lhuf[l]:4);
        write (Fout,  #13, #10, 'Down Lhuf[',i,'] ', Lhuf[l]:4);    
end;
        Writeln(#13, #10, 'Down j   ', j:4,'  l', l:4);
        write (Fout,  #13, #10, 'Down j   ', j:4,'  l', l:4);   
        
end;
 
procedure Huffman(l:integer; var P:array of real);
 
begin
    for i:=1 to l do 
begin
        Writeln(#13, #10, 'Huffman 1 P[',i,'] ', P[i]:7:4, i:4);
        write (Fout,  #13, #10, 'Huffman 1 P[',i,'] ', P[i]:7:4, i:4);  
end;
if l=2 then
    begin
        Chuf[1,1]:=0; Lhuf[1]:=1;
        Chuf[2,1]:=1; Lhuf[2]:=1;
    end
else
    begin
        qn:=P[l-1]+P[l];
        Writeln(#13, #10, 'Huffman qn   ', qn:7:4, l-1:4, '  ', P[l-1]:7:4, l:4, '   ',P[l]:7:4);
        write (Fout,  #13, #10, 'Huffman qn   ', qn:7:4, l-1:4, '  ', P[l-1]:7:4, l:4, '   ',P[l]:7:4); 
        jn[l]:=Up(l,qn,P);
    for i:=1 to l do 
begin
        Writeln(#13, #10, 'Huffman 2 P[',i,'] ', P[i]:7:4, i:4);
        write (Fout,  #13, #10, 'Huffman 2 P[',i,'] ', P[i]:7:4, i:4);  
end;
    
        Writeln(#13, #10, 'Huffman jn[',l,']   ', jn[l]:4, l:4, qn:7:4);
        write (Fout,  #13, #10, 'Huffman jn[',l,']   ', jn[l]:4, l:4, qn:7:4);  
    Huffman (l-1,P);
    Down(l,jn[l]);
            Writeln(#13, #10, 'Huffman jn[',l,']   ', jn[l]:4, l:4, qn:7:4);
        write (Fout,  #13, #10, 'Huffman jn[',l,']   ', jn[l]:4, l:4, qn:7:4);
    end;
    
 
    
        
    for i:=1 to l do 
        begin
        Writeln(#13, #10, 'Huffman Lhuf[',i,'] ', Lhuf[i]:4);
        write (Fout,  #13, #10, 'Huffman Lhuf[',i,'] ', Lhuf[i]:4); 
        end;
 
end;
 
 
{//////////////////////////////////////////////////////////////////////////////////}
 
var 
    ver: real;
begin 
Q := 'y';
while Q <> 'n' do   {объявляем цикл для пакетного ввода файла}
begin
    for i:=1 to max do
    for j:=1 to max do
    Chuf[i,j]:=0;
    Count[i]:=0; 
    Shuf[i]:=0;
    Lhuf[i]:=0;
    P[i]:=0;    
 
    Col:=0;     {общее количество символов}
    {вводим имя файла}
    Writeln('Введите ПОЛНОЕ (с расширением) имя файла для чтения: ');
    readln(fname);
    foutname:= 'out' + fname;
    Assign (Fout, foutname);
    rewrite (Fout);
    write (Fout,  #13, #10, 'Оптимальный код Хаффмана');
    Writeln('Оптимальный код Хаффмана');    
    Assign(Fin, fname);
    Reset(Fin); 
{читаем посимвольно файл и заполняем массив с заданными условиями, для подсчета частоты символов}
while not Eof(Fin) do begin 
    Read(Fin, ch); 
    ch := upcase (ch);  {все символы делаем заглавными}
        if ch in prep then ch:='.'; {все знаки препинания делаем равными '.'}
        if ch in search then  
            begin
                Inc(Count[Ord(ch)]); 
                Inc(Col);
            end;
end; 
    Close(Fin);
{вызываем процедуру для вычесления энтропии текстового файла одиночных символов}
    entropy(P);
    Writeln(#13, #10, 'Энтропия для текстового файла ', fname, ' на английском языке, ');
    Writeln('с использование частоты од.символов = ',ent:7:4);
    write (Fout,  #13, #10, 'Энтропия для текстового файла ', fname, ' на английском языке, ');
    write (Fout,  #13, #10, 'с использование частоты од.символов  = ',ent:7:4);
 
Huffman(l,P); 
writeln;
writeln (Fout);
for i:=1 to l do
begin
 
writeln;
writeln (Fout);
        Write (' OUT Chuf[',i,j,'] Lhuf[',i,']  ', Lhuf[i]:4, '         ', Symbol[i]);
        write (Fout, ' OUT Chuf[',i,j,'] Lhuf[',i,']  ', Lhuf[i]:4, '         ', Symbol[i]);
for j:=1 to Lhuf[i] do
        begin
 
        Write (Chuf[i,j]:4);
        write (Fout, Chuf[i,j]:4);
end;
writeln;
writeln (Fout);
end;
 
    Close(Fout);    
    Write('Еще файл? (y/n) ');
    Readln(Q);
end;
 
end.

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

Этот код на Turbo Pascal реализует алгоритм Хаффмана для кодирования и декодирования текстовых файлов с использованием частотного анализа символов. Он создает дерево Хаффмана, которое представляет собой структуру, используемую для кодирования символов с использованием других символов. Код также вычисляет энтропию файла, которая является мерой неопределенности информации в файле.