Если у вас возникли сложности с курсовой, контрольной, дипломной, рефератом, отчетом по практике, научно-исследовательской и любой другой работой - мы готовы помочь.
Предоплата всего
Подписываем
const
n = 27;
type
tRMassiv = array[1..n] of real;
tStrMassiv = array[1..n] of string;
tIMassiv = array[1..n] of byte;
var
p: tRMassiv; kod: tStrMassiv;
f:text;
i:integer;
H,L,Izb,k:real;
rS:string;
{***********************************************}
{для хранения промежуточных множест организуем стек из таких множеств}
type
tSob =
record
perv, posl: byte;
kod: string;
p: real;
end;
var
stek: array[1..n] of tSob;
versh: byte;
procedure initStek;
begin
versh := 0
end;
procedure push(sob: tSob);
begin
inc(versh);
stek[versh].perv := sob.perv;
stek[versh].posl := sob.posl;
stek[versh].kod := sob.kod;
stek[versh].p := sob.p;
end;
{процедура чтобы вытолкнуть из стека и запомнить 2 события}
procedure pop(var sob: tSob);
begin
sob.perv := stek[versh].perv;
sob.posl := stek[versh].posl;
sob.kod := stek[versh].kod;
sob.p := stek[versh].p;
dec(versh)
end;{pop}
{проверяет есть ли имя элемента или нет}
function nePust: Boolean;
begin
nePust := versh > 0
end;
{***********************************************}
{формирование кодов символов}
procedure formKodov(p: tRMassiv; var kod: tStrMassiv);
var
otec, sun: tSob; sumP: real; i, g: byte;
begin
initStek;
otec.perv := 1; otec.posl := n; otec.kod := ''; otec.p := 1;
push(otec);
while nePust do
begin
pop(otec); {вытолкнуть otec}
{определение границ разбиения множества на 2 подмножества }
sumP := 0; g := otec.perv;
repeat
sumP := sumP + p[g];
inc(g)
until (sumP + p[g]) * 2 > otec.p;
if sumP > otec.p - sumP - p[g] then
dec(g)
else
sumP := sumP + p[g];
{формирование и обработка левого сына}
sun.kod := otec.kod + '0';
sun.perv := otec.perv;
sun.posl := g;
sun.p := sumP;
if sun.perv = sun.posl then
kod[sun.perv] := sun.kod
else
push(sun);
{формирование и обаботка правого сына}
sun.kod := otec.kod + '1';
sun.perv := g + 1;
sun.posl := otec.posl;
sun.p := otec.p - sumP;
if sun.perv = sun.posl then
kod[sun.perv] := sun.kod
else
push(sun);
end;
end;
begin
{прочитать из файла частоты букв}
assign(f, 'gol.txt');
reset(f);
begin
for i:=1 to 27 do
begin
readln(f, kod[i]);
writeln(kod[i])
end;;
close(f);
end;
{обратиться к процедуре formkodov}
{напечатать коды символов}
{посчитать энтропию,среднюю длинну символов,и разность (средн.длинна-энтропия)}
H:=0;l:=0;
for i:=1 to 27 do
begin
H:=p[i]*-log10(p[i])/log10(2);
L:=p[i]*length(kod[i]);
end;
Izb:=L-H;
writeln('Средняя энтропия = ', H);
writeln('Средняя длина = ', L);
writeln('Избыточность = ', Izb);
{упорядоченный список вероятностей (по убыванию)}
for i := 1 to 26 do
if p[i] < p[i+1] then begin
k := p[i];
p[i] := p[i+1];
p[i+1] := k
end;
{обратиться к процедуре formkodov}
{напечатать коды символов}
{посчитать энтропию,среднюю длинну символов,и разность (средн.длинна-энтропия)}
for i:=1 to 27 do
begin
H:=p[i]*-log10(p[i])/log10(2);
L:=p[i]*length(kod[i]);
Izb:=L-H;
end;
writeln('Средняя энтропия = ', H);
writeln('Средняя длина = ', L);
writeln('Избыточность = ', Izb);
end.