лаба №3 / Шеннона – Фано

program ShennonFano;
uses crt;
const
a :array[1..6] of char = ('a','b','c','d','e','f'); { символы }
af:array[1..6] of integer = (10, 8, 6, 5, 4, 3); { частота символов }

{ Процедура для поиска кода каждой буквы }
procedure SearchTree(branch:char; full_branch:string; start_pos:integer; end_pos:integer);
var
dS:real; { Среднее значение массива }
i, m, S:integer; { m - номер средней буквы в последовательности, S - сумма чисел, левой ветки }
c_branch:string; { текущая история поворотов по веткам }
begin
{ проверка если это вход нулевой то очистить историю }
if (a<>' ') then c_branch := full_branch + branch
else c_branch := '';

{ Критерий выхода: если позиции символов совпали, то это конец }
if (start_pos = end_pos) then
begin
WriteLn(a[start_pos], ' = ', c_branch);
exit;
end;

{ Подсчет среднего значения частоты в последовательности }
dS := 0;
for i:=start_pos to end_pos do dS:= dS + af[i];
dS := dS/2;

{ Тут какой угодно можно цикл for, while, repeat поиск середины }
S := 0;
i := start_pos;
m := i;
while ((S+af[i]<dS) and (i<end_pos)) do
begin
S := S + af[i];
inc(i); inc(m);
end;

{ Рекурсия левая ветка дерева }
SearchTree('1', c_branch, start_pos, m);
{ Правая ветка дерева }
SearchTree('0', c_branch, m+1, end_pos);

end;

begin
WriteLn('Press <enter> to show');
ReadLn;
ClrScr;
{ Поиск кода Фано, входные параметры начало и конец последовательности }
SearchTree(' ',' ', 1, 6);
ReadLn;
end.