Довести до ума. Код Фано

program Kod_Fano;
const nmax=100;
type
  Mn = set of char;
  Zap = record
    sim: char; 
    kol: byte;
    v: real;
    kod: string;
  end;
  mas = array [0..nmax] of zap;
var
  f: text;
  k, i: byte;
  a: string
  l: mas;
 
 
procedure Tekst(f: text; var a: string);
var s:string;
begin
  assign(f, 'input.txt');
  reset(f);
  s:='';
  while not eof(f) do
  begin
    readln(f, s);
    a:=a+s;
  end;
end;
 
procedure Simvol(a: string; var k: byte; var l: mas);
var
  i, j: integer;
  m: mn;
begin
  k := 0;
  m:=[];
  for i := 1 to length(a) do
   if (a[i] in m)  then 
     begin
       j := 1;
       while l[j].sim <> a[i] do inc(j);
       inc(l[j].kol);
     end  
    else 
     begin
      m := m + [a[i]];
      inc(k);
      l[k].sim := a[i];
      l[k].kol := 1;
     end;
 end;
 
procedure Ver(k: integer; var l: mas);
var
  i: integer;
begin
  for i := 1 to k do l[i].v := l[i].kol / length(a);
end;
 
 
procedure Poryadok(var l: mas);
var
  i, j: integer;
  x: zap;
begin
  for i := 1 to k - 1 do
    for j := 1 to k - i do
      if l[j].v > l[j+1].v then
      begin
        x := l[j];
        l[j] := l[j+1];
        l[j+1] := x;
      end;
end;
 
 
function seredina(n, k: byte; s:real): byte; 
var
   i: byte;s1, s2: real; 
begin
  s1 := 0;
  i := n-1;
  while s1<(s / 2) do begin inc(i); s1 := s1 + l[i].v;  end;
  s2 := s-s1;
  s1 := s1 - l[i].v; dec(i);
  If s1>s2 then seredina := i else seredina := i+1;
end;
 
 
procedure fano(n, k: integer; s: real);
var
  i, m: integer;
  s1, s2: real;
 
begin
  
  if k - n >= 1 then    
   if k - n = 1 then   
    begin
      // к  коду n-ой буквы алфавита приписать 0
      //к  коду k-ой буквы алфавита приписать 1
    end
    
    else    
    begin
      m := seredina(n, k,s);
      s1:=0;
      // к  кодам всех букв алфавита с n-ой по m-ую приписать 0
      // в переменной s1 найти сумму вероятностей всех букв алфавита с n-ой по m-ую
      s2:=0; 
      // к элементарным кодам всех букв алфавита с (m+1)-ой по k-ую приписать 1
      // в переменной s2 найти сумму вероятностей всех букв алфавита с (m+1)-ой по k-ую
      fano(n, m, s1);
      fano(m + 1, k, s2);
     end;
end;
 
 
 
begin
  Tekst(f, a);
  writeln(a);
  Simvol(a, k, l);
  Ver(k, l);
  Poryadok(l);
  for i := 1 to k do Write(l[i].sim:6); writeln;
  for i := 1 to k do Write(l[i].kol:6); writeln;
  for i := 1 to k do Write(l[i].v:6:3); writeln;
  for i := 1 to k do l[i].kod := '';
  fano(1, k, 1);
  for i := 1 to k do Write(l[i].kod:6); writeln;
end.