Алгоритм Хаффмена, построение схемы кодирования Опции

[18192123]

Мне нужно построить схему кодирования по алгоритму Хаффмена.
То, что у меня получилось работает далеко не корректно.. не могу найти ошибку...

Program dHaffmen;
Uses crt;
Type
    struct = Record
           id : char; {считываемый из файла символ}
           count : integer; {количество вхождений каждого символа формируемого алфавита, 
я его использую, как вероятность}
           code : array[0..30] of integer; {массив 0 и 1 - код очерёдного символа}
    end;

Var
   a : struct;
   mas : array[0..255] of struct;
   len : array[1..255] of integer; {длина очередного кода}
   f : text;
   i,j,n,kol,kol1,x,x1 : integer;
   c : char;
   flag : boolean;
   cena_kod : real;

   p : array[1..30] of integer; {вспомогательный массив для количества вхождений}
   cc : array[1..255,1..30] of integer; {матрица с кодами}

Function Found_Insert(kol1 : integer; sum : integer):integer; {находим в массиве р место, 
куда можем вставить sum и вставляем sum, 
сдвигая вниз остальные элементы}
var
   k,g : byte;
begin
for k := kol1-1 downto 2 do
    if p[k-1] <= sum then
       p[k] := p[k-1] {сдвиг элемента массива}
    else
        begin
             g := k - 1; {определение места вставляемого элемента}
             break;
        end;
p[g] := sum; {запись вставляемого элемента на нужное место}

Found_Insert := g;
end;

Procedure Postroenie(kol1 : integer; Ins : integer); {достраиваем код для n буквы 
на основе
 построенного кода для  n-1 буквы. Для этого код буквы 
с номером Ins временно исключается из массива кодов путём 
сдвига вверх кодов с номерами, большими Ins, а затем в конец 
обрабатываемой части массива  кодов сс добавляется пара кодов, 
полученных из конца буквы с номером Ins удлинением на 0 или 1}
var
   l,h,g : integer;
   kod : array[1..30] of integer;
begin
for h := 1 to 30 do
    kod[h] := cc[ins,h]; {запомнили код}
l := len[Ins]; {и его длину}
for g := Ins to kol1-2 do
    begin
    len[g] := len[g+1]; {сдвинули длину кода}
         for h := 1 to 30 do
             cc[g,h] := cc[g+1,h]; {и сам код}

    end;
for h := 1 to 30 do
    cc[kol1-1,h] := kod[h]; cc[kol1,h] := kod[h]; {копируем код символа Ins}
cc[kol1-1,l+1] := 0; cc[kol1,l+1] :=1; {наращивание кодов}
len[kol1-1] := l + 1; len[kol1] :=l + 1; {и соответственно длин кодов}

end;

Procedure Haffmen(kol1 : integer);
var
   Ins,sum : integer;
begin
if kol1 = 2 then
   begin
        cc[1,1] := 0; {для первого символа}
        len[1] := 1;
        cc[2,1] := 1; {для второго}
        len[2] := 1;
   end
else
    begin
         sum := p[kol1-1] + p[kol1]; {сумма 2-х последних веротностей в массиве р}
         Ins := Found_Insert(kol1,sum); {поиск места и вставки суммы}
         Haffmen(kol1 - 1); 
         Postroenie(kol1, Ins); {достраивание кодов}
    end;
end;



Begin
clrscr;
{initial}
a.count := 0; a.id := '~';
for i := 0 to 255 do
    begin
         mas[i].id := '0';
         mas[i].count := 0;
    end;
for i := 0 to 255 do
for j := 0 to 30 do
             mas[i].code[j] := 5;
{************************************}
assign(f,'1.txt');
reset(f);
n := -1;
kol := 0;
while not eof(f) do
      begin
           read(f,c);
           flag := false;
           n := n + 1;
           inc(kol);
           for i := 0 to kol do
               if mas[i].id = c then
                  begin
                       inc(mas[i].count);
                       flag := true;
                  end;
           if flag = false then
               begin
                    mas[n].id := c;
                    inc(mas[n].count);
               end;
           if flag = true then n := n - 1;
      end;
{теперь массив записей заполнен}
{*********************Sort*****************************}
for i := 0 to kol do
    for j := 0 to kol - i do
        if mas[j].count<mas[j+1].count then
           begin
                a := mas[j+1];
                mas[j+1] := mas[j];
                mas[j] := a
           end;
{*********************Sort*****************************}

{output structure}
for i := 0 to kol do
    if mas[i].count > 0 then
       writeln (mas[i].id,' ',mas[i].count);
writeln;
writeln(kol);
{**********************}
{kol-vo razn6ih elementov - KOL1}
kol1 := 0;
 for i := 0 to kol do
     if mas[i].count>0 then inc(kol1);
{**************************}

{***************Perezapis'!!!*****************чтоб ничего не 
перепутать в записях...но думаю и без этого можно обойтись}
write('massiv veroaytnosteu: ');
for i := 1 to kol1 do
begin
    p[i] := mas[i-1].count;
    write(' ', p[i]);
end;   writeln;
for i := 1 to 255 do
    for j := 1 to 30 do
        cc[i,j] := mas[i-1].code[j-1];
{***************Perezapis'!!!*****************}

{******Kodirovanie*******}
Haffmen(kol1);
{******Kodirovanie*******}
i := 0; j :=0;
for i:= 1 to kol1 do
    begin
         j := 1;
         write(mas[i-1].id,' ');
         for j := 1 to 30 do
             if cc[i,j]<>5 then write(cc[i,j]);
         writeln;
    end;
{Cena Kodirovania}
cena_kod := 0;
for i := 1 to kol1 do
    begin
         cena_kod := cena_kod + (mas[i-1].count/kol)*len[i]
    end;

writeln; writeln(cena_kod : 6 : 3);
{****************}
readkey;
End.

пожалуста, объясните, где я ошибаюсь...хотя подозреваю, что в процедуре построения кода...

Сообщение отредактировано: 18192123 - 3.12.2007 0:29

[Michael_Rybak]

Если ты полностью понимаешь, как работает программа, и что должно у нее получаться в каждый момент работы, используй отладчик и ищи, что работает не так. Или выводи промежуточные результаты на экран.