ハフマン法
Huffman codingは、データーの圧縮方法で、コンピューターで使用されるデーターByte単位で8ビットが一つの単位となっています。
この場合、一つの文字が8ビットとすると、5文字で40ビットとなります。
もし、5文字しか無かった場合、3ビットあれば、5文字を表現することができます。
実際には、同じ種類の文字の出現率により出現率の大きい文字に少ないビット数を割り当て、出現率の少ない文字にはビット数の多い方を割り当てます。
現在の実際の文字は、8ビットでは不足するので、16ビットになっていますが、データーは8ビット単位扱われている為、8ビット単位で圧縮します。
8ビットなので、値の種類は、0～255で256種類となります。
これに、単純にHuffman
codingを行うと、元の8ビットより長いビット数になるものが現れます。
又、変換した値を元の値に戻す為の、辞書のようなものが必要になり、元のデーターが短い場合は、Huffman codingにより元の長さより長くなってしまいます。
元のデーターが長いものであれば、同じ8ビットの値が現れる確率が高くなり、全体として短く圧縮することができます。
どの様にして圧縮されるかの説明は難しいので、ハフマン法でWEB検索をして調べて下さい。
左図は、此処でのプログラムの実行例です。
プログラムは、C言語辞典 にあったものをDelphi用に書き直したものです。
bit
in out 確認にチェックを入れると、圧縮ファイル書き込み時にはビットの値を文字"0"と"1"としてテキストファイル(outbits.txt)に書き出します。
復元展開時には、圧縮されたビットコードだけを">"の後にテキストファイル(inbits.txt)に書き出します。
圧縮前のファイル名はin.txtとしてあり、圧縮ファイルはd.compです。
復元時は、d.compを読み込んで、out.txtとして復元します。
各ファイルは、実行ファイルと同じフォルダーにしておく必要があります。
ファイル名を自由に指定したい場合は、TOpenDialog、TSaveDialogを追加してください。
圧縮復元は、Textファイルでなくても可能です。
左図は圧縮されたコードがどの様になっているかを表したもので、参考例です。
0が左の枝、1が右の枝となっていますが、枝の部分は配列となっていて、左の枝の配列と、右の枝の配列となります。
末端(葉)の部分にはそれぞれに、8ビットコードがはいり、其々の節の部分には配列番号+256の値が入ります。
実際にin.txtファイルに次の文字を書きこんで圧縮してみます。
文字コードは UTF-8
"AAAAAABBBBBBCCCCCCDDDEE"
圧縮すると、次のビット単位の値が圧縮ファイルとしてd.compファイルと書き出されます。
d.compの内容は、Binエディターがないと確認できないので、ビット単位でテキストファイルに"0"と"1"を書き出したものが次のものです。
"11100100010100100010000100000110010000100010000110101010101011010101010101111111111110010010010000000000"
必要なビット数は8ビット×Nバイトですが、8ビット(1バイト)の倍数とならない場合が多いので、最後にビット0を追加して8ビット(1バイト)の倍数にしています。
復元すると、out.txtとして、書き出します。
その時に、短く変換されたコードを">"を区切りとして、inbits.txtに書き出と次のようになります。
">01>01>01>01>01>01>10>10>10>10>10>10>11>11>11>11>11>11>001>001>001>000>000"
この時の 右の枝の配列は 259, 65, 68, 67
左の枝の配列は 257,258, 69, 66
256を含み256より大きい値は256を減算すると配列番号になります、小さい値はそのまま8ビット(0～FF)の値です。
プログラム
unit main;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
Button2: TButton;
CheckBox1: TCheckBox;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private 宣言 }
public
{ Public 宣言 }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
const
N = 256; // 文字の種類数
CHARBITS = 8; // 1バイトのビット数
BRANCH = N - 2; // 枝の数 0 ～ 254 255個
MNSIZE = 2 * N - 2; // 配列の上限値 0～510 511個
var
heapsize : integer; // 優先待ち行列用ヒープサイズ
heap : array[0..MNSIZE] of integer; // 優先待ち行列用ヒープ配列
parent : array[0..MNSIZE] of integer; // Huffman木
left : array[0..BRANCH] of integer; // 左の枝
right : array[0..BRANCH] of integer; // 右の枝
freq : array[0..MNSIZE] of cardinal; // 各値(0～$FF)の出現頻度
infile, outfile, testfile : Thandle; // 入力ファイル, 出力ファイル
outcount : cardinal; // 出力バイト数カウンタ
getcount : byte; // ビット入力カウンタ
putcount : byte; // ビット出力カウンタ
bitbuf : byte; // ビット入出力バッファ
avail : integer; // 木の節の数カウント
TReeF : byte; // 木の書き込みエラーフラグ
WBF : Word;
function rightbits(n, x: byte): byte; // xの右nビット
var
u : byte;
begin
u := 1;
u := (u shl n) - 1; // 1 n=4 左シフト BIN 00000001 => 00010000 - 1 -> 00001111
result := x and u; // xの下位ビット取り出し
end;
procedure error(massage : pchar); // メッセージ出し
begin
application.MessageBox(massage, '注意', 0);
end;
procedure testbitout; // 出力ビット確認用 ファイルにビット情報書き出し
var
i : integer;
t, b : byte;
c, d : word;
begin
t := bitbuf;
c := 49; // '1'
d := 48; // '0'
for i := 1 to CHARBITS do begin // 8回
b := t and 128; // bin 10000000
if b <> 0 then filewrite(testfile, c , 2) // UTF-16LE filewrite(testfile, c , 1)
else filewrite(testfile, d , 2);
t := t shl 1; // 左シフト
end;
end;
function getbit: byte; // 1bit読み込む
var
c : word;
begin
if getcount > 0 then begin // getcount が 0 より大きかったら
dec(getcount); // デクリメント
end
else begin // getcount が 0 だったら
getcount := CHARBITS - 1; // 7
fileread(infile, bitbuf, 1); // 1バイトバッファに読み込み
end;
result := (bitbuf shr getcount) and 1; // getcountビット右シフト 末ビットのみ取り出し
if Form1.CheckBox1.Checked = true then begin // tree以下のビット書き出し
if WBF and 2 = 2 then begin // 先頭に>書き込み 確認用
c := 62; // '>'
filewrite(testfile, c , 2);
WBF := WBF and 1;
end;
if WBF and 1 = 1 then begin
if result > 0 then c := 49 // '1'
else c := 48; // '0'
filewrite(testfile, c , 2); // UTF-16LE filewrite(testfile, c , 1)
end;
end;
end;
function getbits(n : byte): byte; // nbit読み込む
var
x : byte;
begin
x := 0;
while n > getcount do begin
n := n - getcount;
x := x or (rightbits(getcount, bitbuf) shl n); // bitbufの下位getcount取り出しn分左シフト x とor
fileread(infile, bitbuf, 1); // 1バイト読み込み
getcount := CHARBITS; // 8ビット
end;
getcount := getcount - n;
result := x or (rightbits(n, bitbuf shr getcount)); // bitbufをgetcount分右シフト 下位nビット取り出し x とor
end;
function putbit(bit : byte): integer; // 1bit 書き出す 成功 0 失敗 1
begin // bitbufに1ビット追加 8ビットに達したら1byteファイルに書き出し
result := 0;
dec(putcount);
if bit <> 0 then bitbuf := bitbuf or (1 shl putcount); // bitがゼロでなかったら1をputcount左シフト bitbufとor
if putcount = 0 then begin // putcountがゼロだったら
if filewrite(outfile, bitbuf, 1) <= 0 then begin // bitbuf書き込み
error(pchar('書けません'));
result := 1; // putbit error = 1
exit;
end;
if Form1.CheckBox1.Checked = True then testbitout; // 出力ビット確認用
bitbuf := 0; // 書き込みが出来たらbitbufクリア
putcount := CHARBITS; // putcountを8ビット分にセット
inc(outcount); // 書き込みバイト数カウントアップ
end;
end;
function putbits(n, x : byte): integer; // xの値nbitを追加書き出す 成功 0 失敗 2
begin // bitbufにnビット追加するが8ビットを超える場合は
result := 0; // 先頭8ビット分を書き出し余った分はbitbufの先頭に移動し残す
while n >= putcount do begin // 書き込みビット数がnと等しいか小さかったら
n := n - putcount; // nが書き込みビット位置
bitbuf := bitbuf or rightbits(putcount, x shr n); // xをn分右シフト下位putcount分取り出しbitbufとor
if filewrite(outfile, bitbuf, 1) <= 0 then begin // bitbuf 1バイト書き込み
error(pchar('書けません'));
result := 2; // putbits error 2
break;
end;
if Form1.CheckBox1.Checked = True then testbitout; // 出力ビット確認用
bitbuf := 0; // 書き込みが出来たらbitbufクリア
putcount := CHARBITS; // putcountを8ビット分にセット
inc(outcount); // 書き込みバイト数カウントアップ
end;
if result = 2 then exit; // 書き込みエラーがあったら終了
putcount := putcount - n;
bitbuf := bitbuf or (rightbits(n, x) shl putcount); // xから下位nビット取り出しbitbufとor
end;
procedure downheap(i : integer); // 優先待ち行列に挿入
var
j, k : integer;
begin
k := heap[i]; // kに一時保存
repeat // 出現率順捜査
j := i + i; // j = 2 * i
if j <= heapsize then begin
if (j < heapsize) and (freq[heap[j]] > freq[heap[j + 1]]) then inc(j);
if freq[k] <= freq[heap[j]] then break; // kの頻度がheap[j]の頻度より小さくなったら終了
heap[i] := heap[j]; // 入れ替え
i := j;
end;
until j > heapsize;
heap[i] := k; // kを新しい位置に
end;
function writetree(i : integer): integer; // 枝を出力 成功 0 失敗 3
var
m : integer;
begin
result := 3; // writetree error = 3
if TReeF = 1 then exit;
TReeF := 1;
if i < N then begin // 葉
if putbit(0) > 0 then exit; // bit=0 書き込み エラーが有ったら終了
if putbits(CHARBITS, i) > 0 then exit; // 8bis(i)コード書き込み エラーが有ったら終了
TReeF := 0;
end
else begin // 節
if putbit(1) > 0 then exit; // bit=1 書き込み エラーが有ったら終了
TReeF := 0;
m := i - N;
writetree(left[m]); // 左の枝
writetree(right[m]); // 右の枝
end;
result := 0;
end;
procedure encode; // 圧縮
var
i, j, k, avail, tablesize, jr, c, m : integer;
ir : byte;
incount : cardinal;
codebit : array[0..N-1] of byte; // 符号語
cf : double;
begin
for i := 0 to MNSIZE do freq[i] := 0; // 頻度クリア
repeat
j := fileread(infile, ir, 1); // 一バイト読み込み
if j > 0 then inc(freq[ir]) // 読めたら頻度数え
until j <= 0;
heap[1] := 0; // 長さゼロのファイルに備える
heapsize := 0;
for i := 0 to N - 1 do begin // 優先待ち行列に登録
if freq[i] <> 0 then begin // 各値(0～$FFの出現数がゼロで無かったら
inc(heapsize);
heap[heapsize] := i // 出現数がゼロで無いものだけとなります
end;
end;
for i := heapsize div 2 downto 1 do downheap(i); // ヒープ作り
for i := 0 to MNSIZE do parent[i] := 0; // 木クリア
k := heap[1]; // 以下のループが一回も実行されない場合に備える
avail := N; // 以下のループでハフマン木を作成 256～
while heapsize > 1 do begin // 2個以上残りがある間
i := heap[1]; // 最小の要素を取り出す
heap[1] := heap[heapsize];
dec(heapsize);
downheap(1); // ヒープ再構築
j := heap[1]; // 次に最小の要素を取り出す
k := avail; // 新しい節の生成 256～
inc(avail);
freq[k] := freq[i] + freq[j]; // 頻度を合計 freq配列の256～に保存
heap[1] := k;
downheap(1); // 待ち行列に登録
parent[i] := k; // 木を作る
parent[j] := -k;
m := k - N; // k = 256～510
left[m] := i; // 左の枝
right[m] := j; // 右の枝
end;
TReeF := 0; // 木を出力エラーフラグクリア
putcount := CHARBITS; // 最初のスタートは8ビット分
c := writetree(k); // 木を出力
if c > 0 then begin
Form1.Memo1.Lines.Append('treeの出力に失敗しました。');
exit;
end;
tablesize := outcount; // 表の大きさ
incount := 0;
fileseek(infile, 0, 0); // 再走査 ファイルの先頭に読み取りセット
repeat // エンコード出力
jr := fileread(infile, ir, 1); // 一バイト読み込みir
if jr > 0 then begin // 読み込めたら エンコード
k := 0; // ビット数クリア
j := parent[ir];
while j <> 0 do begin // ビットエンコード
if j > 0 then begin
codebit[k] := 0;
end
else begin
codebit[k] := 1;
j := -j;
end;
inc(k);
j := parent[j];
end;
for i := k - 1 downto 0 do begin // 出力 ピット数k分
c := putbit(codebit[i]); // ビット出力
if c > 0 then break;
end;
inc(incount); // 読み込んだバイト数カウント
end;
until (jr <= 0) or (c > 0); // 読み込めない 又は 出力失敗だったら終了
i := putbits(CHARBITS - 1, 0); // bitbufに残りが有ったら残りを出力 不足分bit=0を追加
if (c > 0) or (i > 0) then begin
Form1.Memo1.Lines.Append('エンコードに失敗しました。');
exit;
end;
Form1.Memo1.Lines.Append('In=' + intTostr(incount));
Form1.Memo1.Lines.Append('OUT=' + intTostr(outcount) + ' '
+ 'table ' + inttostr(tablesize));
if incount <> 0 then begin // 圧縮比の表示
cf := (1000 * outcount + incount / 2) / incount;
cf := round(cf);
cf := cf / 1000;
Form1.Memo1.Lines.Append('Out / in =' + floatTostr(cf));
end;
end;
function readtree: integer; // 木を読む
var
i, m : integer;
begin
if getbit > 0 then begin // bit = 1 葉でない節
i := avail; // 再帰の為availはグローバル変数
inc(avail);
if i > MNSIZE then begin
error(pchar('表が間違っています'));
result := MNSIZE + 1;
exit;
end;
m := i - N;
left[m] := readtree; // 左の枝を読む
right[m] := readtree; // 右の枝を読む
result := i; // 節の値を返す
end
else begin
result := getbits(CHARBITS); // 8ビット(文字)取得
end;
end;
procedure decode(size : integer); // 復元
var
j, root, c, ck : integer;
k, m : integer;
begin
WBF := 0; // ビット書き出しリセット
c := 1;
ck := 0;
avail := N;
root := readtree; // 木を読む
if root > MNSIZE then exit; // 木の表が間違っていたので終了
for k := 0 to size - 1 do begin // 各文字を読む
WBF := 3; // 確認用ビット好きだしセット
j := root; // 根 j = 0 ～ 510 文字(8bit)が一種類しか
while j >= N do begin // 無い場合は枝が出来ないので j < N
m := j - N; // j = 256～510 m = 0～254
if getbit > 0 then j := right[m] // right[0..254] left[0..254]
else j := left[m];
end;
c := filewrite(outfile, j, 1);
if c <= 0 then begin // 書きこめなかったら打ち切り
ck := k;
break;
end;
end;
if c <= 0 then begin
Form1.Memo1.Lines.Append('打ち切ったバイト数 = ' + inttostr(ck));
end
else
Form1.Memo1.Lines.Append('復元したバイト数 = ' + inttostr(size)); // 復元したバイト数
end;
procedure TForm1.Button1Click(Sender: TObject);
var
size, check : integer;
comp, text, bitstr : string;
begin
comp := 'd.comp'; // 圧縮ファイル名
text := 'out.txt'; // 展開ファイル名
bitstr := 'inbits.txt';
infile := fileopen(comp, fmOpenRead); // 入力圧縮ファイル0pen
if infile = INVALID_HANDLE_VALUE then begin
error(pchar('圧縮ファイル開けません。'));
exit;
end;
outfile := filecreate(text, fmOpenWrite, 0); // 出力ファイル作成 既存のファイルがあったらopen
if outfile = INVALID_HANDLE_VALUE then begin
error(pchar('展開先ファイル開けません。'));
fileclose(infile);
exit;
end;
check := fileread(infile, size, sizeof(size)); // 先頭から元ファイルのサイズ読み込み
if check < 0 then begin
error(pchar('圧縮ファイルから読みだせません。'));
fileclose(infile);
fileclose(outfile);
exit;
end;
if checkbox1.Checked = True then begin // bit入出力確認なら
testfile := filecreate(bitstr, fmOpenWrite, 0);
if testfile = INVALID_HANDLE_VALUE then begin
error(pchar('ビットテストoutファイル開けません。'));
fileclose(infile);
fileclose(outfile);
exit;
end;
end;
getcount := 0; // 初期化
decode(size); // デコード
fileclose(infile);
fileclose(outfile);
if checkbox1.Checked = True then fileclose(testfile); // bit入出力確認なら
end;
procedure TForm1.Button2Click(Sender: TObject);
var
size : integer;
comp, text, bitstr : string;
begin
text := 'in.txt'; // 入力ファイル名
comp := 'd.comp'; // 圧縮ファイル名
bitstr := 'outbits.txt';
infile := fileopen(text, fmOpenRead); // 入力ファイルopen
if infile = INVALID_HANDLE_VALUE then begin
error(pchar('入力ファイル開けません。'));
exit;
end;
outfile := filecreate(comp, fmOpenWrite, 0); // 出力ファイル作成 既存のファイルがあったらopen
if outfile = INVALID_HANDLE_VALUE then begin
error(pchar('圧縮先ファイル開けません。'));
fileclose(infile);
exit;
end;
if checkbox1.Checked = True then begin // bit入出力確認なら
testfile := filecreate(bitstr, fmOpenWrite, 0);
if testfile = INVALID_HANDLE_VALUE then begin
error(pchar('ビットテストoutファイル開けません。'));
fileclose(infile);
fileclose(outfile);
exit;
end;
end;
memo1.Clear;
outcount := 0; // 初期化
getcount := 0;
bitbuf := 0;
size := fileseek(infile, 0, 2); // infile ファイルサイズ取得
if size < 0 then begin
error(pchar('入力ファイル読めません。'));
fileclose(infile);
fileclose(outfile);
exit;
end;
if filewrite(outfile, size, sizeof(size)) < 0 then begin // outfile ファイルサイズ書き込み
error(pchar('圧縮先ファイル書きこめません。'));
fileclose(infile);
fileclose(outfile);
exit;
end;
fileseek(infile, 0, 0); // infile ファイル位置先頭へ
encode; // エンコード
if TReeF = 0 then begin
fileclose(infile);
fileclose(outfile);
if checkbox1.Checked = True then fileclose(testfile); // bit入出力確認なら
end;
end;
end.
huffman_coding.zip
三角関数、逆三角関数、その他関数 に戻る