Как можно получить кодовое слово

[videolord]

Привет всем!!! Как можно разделить вероятности на одинаковые группы и получить кодовое слово
(Звучит странно но нигде не нашел нормальную реализацию этого алгорима <Код Шеннона-Фано>)
1283807535_2fgj.gif
и еще фотка
1.bmp

[videolord]

помогите пожалуйста исправить баг или просто перепутал что ли,
но выводит как то некорректно
answer.gif
а должен выводить такие значения
1.gif
код на Delphi

program Project2;

{$APPTYPE CONSOLE}

uses
  SysUtils;
 const k=6;
 type
 mass=array [1..k] of real;
 var p,a: mass;
  i,x: integer;
 code: array [1..k] of string[20];
procedure shannona(b:mass);
 procedure divide(var nS:integer; n1,n2:integer);
 var
 s,s1,s2: real;
 i:integer;
 begin
 s:=0;
 for i:=n1 to n2 do s:=s+a[i];
 s1:=0; s2:=0;
 i:=n1-1;
 repeat
 inc(i);
 s1:=s1+a[i];
 s2:=s1+a[i+1];
 until abs(s/2-s1)<abs(s/2-s2);
 nS:=i;
 for x:=n1 to nS do
 if (s/2-s1)>=0 then code[x]:=code[x]+'1'
 else code[x]:=code[x]+'0';
 for x:=nS+1 to n2 do
 if (s/2-s1)<0 then code[x]:=code[x]+'1'
 else code[x]:=code[x]+'0';
 end;
 var
 tmp: real;
 j,n1,n2,nS: integer;
 begin
 for i:=1 to k do code[i]:='';
 for i:=1 to k do a[i]:=b[i];
 for i:=1 to k do
 for j:=k downto(i+1) do
 if a[i]<a[j]
 then
 begin
 tmp:=a[i];
 a[i]:=a[j];
 a[j]:=tmp;
 end;
 j:=1;
 repeat
 divide(nS,j,k);
 n1:=nS;
 while (nS-j)>0 do divide(nS,j,nS);
 j:=nS+1;
 n2:=n1;
 while (n1-j)>0 do divide(n1,j,n1);
 j:=n2+1;
 until j>(k-1);
 end;
begin
p[1]:=0.25;
p[2]:=0.25;
p[3]:=0.15;
p[4]:=0.15;
p[5]:=0.12;
p[6]:=0.1;
shannona(p);
for i:=1 to k do
begin
write('p[',i:2,']  ');
 write(p[i]:0:3,' ');
 write(code[i]:5,' ');
writeln('');
end;
readln;
end.