IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Алгоритм Хаффмена, построение схемы кодирования
сообщение
Сообщение #1


Профи
****

Группа: Пользователи
Сообщений: 920
Пол: Женский
Реальное имя: Марина

Репутация: -  2  +


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


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 -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Michael_Rybak
*****

Группа: Пользователи
Сообщений: 1 046
Пол: Мужской
Реальное имя: Michael_Rybak

Репутация: -  32  +


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

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 26.10.2020 13:30
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name