Мне нужно построить схему кодирования по алгоритму Хаффмена.
То, что у меня получилось работает далеко не корректно.. не могу найти ошибку...
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.
Если ты полностью понимаешь, как работает программа, и что должно у нее получаться в каждый момент работы, используй отладчик и ищи, что работает не так. Или выводи промежуточные результаты на экран.