ハフマン・コードによる、符号化と復号化

 投稿者：SECOND  投稿日：2013年 7月20日(土)00時23分20秒
  !----------------------------------------------------------------------
!　入力データーの、ハフマン・コードによる、符号化と復号化、往復の処理。
!
!JPG での、ハフマン・コードの使われ方を見ると、
!画像データー(DCT出力)そのものを、符号化するのでなく、
!ZRL( ZeroRunLength 各データー直前０の数)と、データーbit長 の２つの
!数量を、4bit づつ 8bit にまとめた２次元の値( ZRL・bit長 )、
!この作成された 8bit値 の方を、ハフマン符号化している。
!
!肝心な画像データー(DCT出力)は、bit長ごとに、グループ分け、されるものの、
!ほぼ、特に正の数は、そのままの数値で、ハフマン符号の後に付加される。
!が、bit長 を予め知らせるフォームになるので、例えば、
!
!X= 3bit長以下のデーターの場合、
!Y= 2^3= 8通り(0~7) ではなく、15通り(-7~0~7) 識別される事ができる。
!
! if X=0 then   !符号化側、L=bit長
!   L=0
! else
!   L=len( bstr$( abs(X),2))
!   if X< 0 then Y= X +(2^L-1) else Y=X
! end if
!
!　     3bit長                                  3bit長
!　 !-----------  2bit長             2bit長 -----------
!　 ! 0  0  0  0  -----              -----   1  1  1  1
! Y=! 0  0  1  1   0  0  --      --   1  1   0  0  1  1
!　 ! 0  1  0  1   0  1   0       1   0  1   0  1  0  1
!　 !-----------  -----  --  --  --  -----  -----------
! X= -7 -6 -5 -4  -3 -2  -1   0   1   2  3   4  5  6  7
!
! Y を元の X に戻すには、
!
! if L=0 then   !復号化側、L=bit長
!   X=0
! else
!   if Y< 2^(L-1) then X= Y -(2^L-1) else X=Y
! end if
!---------------------------------------------------------------------

!---------------------------------------------------------------------
!■このプログラムでは、次の様に、２次元の値( ZRL・bit長 ) の部分を、
!　直接の入力データーに置換え、それだけに 単純化して符号化、復号化する。
!
!● 符号化
! 文字入力データー　 → その値の頻度 の測定 →
! → ハフマン符号木と、符号木定義表( DHT DefineHuffmanTable)の作成 →
! → ハフマン・コード表の作成 → データー値の符号化。
!● 復号化
! 符号木定義表( DHT DefineHuffmanTable) → ハフマン・コード表の復元 →
! → デコーダー・テーブル作成 → データー値の復号化。
!
!■出力のテキスト中で、"座標" は、
!  上の JPG での 作成された 8bit値、２次元の値だった部分です。
!  このプログラムでは、１次元の座標にして、
! "座標" が、直接の入力データー（文字入力データー）の意味になります。
!
!------------------------------------------------------------------------

DEBUG ON
OPTION ARITHMETIC NATIVE
OPTION BASE 0
OPTION CHARACTER byte
!
!------------------- テスト・データー ---------------------
! 注意。大きなファイルは、長い時間かかります。このプログラムと同じフォルダーに置きます。
!
!LET fl$="README.TXT"
!LET fl$="REVISION.TXT"
!LET fl$="BASIC.KW1"
LET fl$="BASIC.KW2"
!----------------------------------------------------------
!
LET xL=8                      !入力データーを区切る処理単位、１文字の bit 幅(1~8)の設定
!
!---encorder & decorder       !＊＊DHT( DefineHuffmanTable )の実体は、配列 DH() DV()
!                             !    DH(i)= (i)bit長ハフマンコードの数、DV()= 頻度降順の座標
DIM DH(32),DV(255)            !　　DH()DV() だけで、ハフマン符号木は、再生される。
DIM B(255+1)                  !huffman.code table ：DH()DV() から作成。 MAKE_H2,MAKE_H0 で実行。
DIM L(255)                    !huffman.code length：DH()DV() から作成。 MAKE_H2,MAKE_H0 で実行。
!
!---encorder                  !＊＊DHT を作るための配列類。
DIM SV(256)                   !SV(座標)= 頻度 → 頻度0の座標を除き順を詰める為 S_() DV() に分解。
DIM S_(256)                   !S_(j)=ｊ番目の頻度、DV(j)= その座標。 MAKE_DHT で作成。
DIM F_(256),Tr(32,256,3)      !Tr(,,)：ハフマン符号木、F_()：作業用。   TREE3 で使用。
!
!---decorder
DIM A(2000)                   !huffman decorder table
LET BST=2                     !huffman decorder's bit step：速さで選ぶ。1,2,3,,,
LET SHb=2^BST                 !huffman decorder：シフトに使用。n*SHb=(shl n,BST)  n/SHb=(shr n,BST)
!
!---lister
LET crlf$=CHR$(13)& CHR$(10)
!
FILE SPLITNAME (fl$) path$, name$, ext$
!
PRINT "-------------------------"
PRINT "Encorder Side"
CALL load( fl$, db$)                         !db$ ←全ファイル
PRINT "原文 db$:";LEN(db$)
CALL Encode0
PRINT "-------------------------"
PRINT "符号化 終了 huf$:";LEN(huf$)
CALL save( name$& ext$& "符号化.huf", huf$)
!
PRINT
PRINT "-------------------------"
PRINT "Decorder Side"
CALL load( name$& ext$& "符号化.huf", huf$)  !huf$ ←全ファイル
PRINT "huf$:";LEN(huf$)
CALL Decode0
PRINT "-------------------------"
PRINT "復号化 終了 out$:";LEN(out$)
CALL save( name$& ext$& "復号化"& ext$, out$)
!
PRINT
PRINT "-------------------------"
PRINT " db$:";LEN(db$) ;"bytes 原文"
PRINT "huf$:";LEN(huf$);"bytes 符号化"
PRINT "out$:";LEN(out$);"bytes 復号化　";
IF db$=out$ THEN PRINT "一致" ELSE PRINT "一致しない"

!-------　full write binary
SUB save(f$,d$)             !d$ → 全ファイル
   OPEN #1: NAME f$
   ERASE#1
   PRINT #1: d$;
   CLOSE #1
END SUB

!-------　full read binary
SUB load(f$,d$)             !d$ ← 全ファイル
   OPTION CHARACTER BYTE
   OPEN #1: NAME f$, ACCESS INPUT
   SET #1: ENDOFLINE CHR$(13)
   ASK #1: FILESIZE s9
   LET d$=""
   DO
      LINE INPUT #1,IF MISSING THEN EXIT DO :w9$
      LET d$=d$& w9$& CHR$(13)
   LOOP
   CLOSE #1
   IF s9< LEN(d$) THEN LET d$=d$(1:LEN(d$)-1)
END SUB

!==================
SUB Encode0
   LET siz=LEN(db$)                  !source DATA length
   !  ---analize source, --> frequency= SV( each data )
   MAT SV=ZER
   CALL F_BLK0
   !
   !---make tree =DHT( Define Huffman Table )
   MAT DH=ZER
   MAT DV=ZER
   CALL MAKE_DHT                     !lmx DH() <-- S_() DV() <-- SV()
   CALL list_TREE
   CALL list_DHT
   !
   !---make huffman encorder table
   MAT B=ZER                         !huffman.code table
   MAT L=ZER                         !huffman.code length
   CALL MAKE_H2                      !huffman.code table B()L() <-- DH()DV()
   CALL list_HT                      !listing huffman.code table B()L()
   !
   !---output DHT( Define Huffman Table)
   LET huf$=CHR$(lmx)                !huffman code max.length
   FOR i=1 TO lmx
      LET huf$=huf$& CHR$( DH(i))    !DH(i) 各コード長の数( tree 各階層の終端数)
   NEXT i
   FOR i=0 TO DH(0)-1                !DH(0) 全コードの数( tree 分岐路の総数)
      LET huf$=huf$& CHR$( DV(i))
   NEXT i
   !
   !---output huffman coded source
   LET huf$=huf$& dword$(siz)        !source DATA length
   LET Hw=0                          !output bit_stream_buffer
   LET BC=0                          !remainder bits in Hw
   CALL W_BLK0
   CALL W_FLUSH
END SUB

!---------
SUB F_BLK0
   LET i9=0                          !input buffer pointer
   LET By=0                          !input register remainder bit
   LET Hy=0                          !input register
   DO WHILE i9< siz OR 0< By
      LET V_=INP_E(xL)
      LET SV(V_)=SV(V_)+1
   LOOP
END SUB

!---------
SUB W_BLK0
   LET i9=0                          !input buffer pointer
   LET By=0                          !input register remainder bit
   LET Hy=0                          !input register
   DO WHILE i9< siz OR 0< By
      LET V_=INP_E(xL)
      CALL W_HUFF( L(V_),B(V_))      !L() huffman bit length,  B() huffman code
   LOOP
END SUB

!=============================================
! write bit stream
! L= データーのbit長、W= データー値(may be 0)
! 一定幅でない 入力データーを、
! 区切れのない連続の
!   bit の流れ( MSB~LSB, MSB~LSB,,) にして出力
!---------------------------------------------
SUB W_HUFF( L, W )
   LET Hw=Hw+W*2^(8-BC-L)       !Hw: b7～b(-?) 左詰め bit_stream buffer < 100h
   LET BC=BC+L
   DO WHILE 8<=BC               !BC:┌─────┐ stored data width  b7～b(-?)
      CALL WRT_D( IP(Hw))       !Hw: xxxxxxxx.xxx
      LET Hw=FP(Hw)*256         !   └───┘     output parts  b7～b0
      LET BC=BC-8               !BC:┌ ┐
   LOOP                         !Hw: xxx00000.0・・・
END SUB                         !      └───→  next data space

!---------------------------------------------
! write flush
! write bit stream の後、バッファ:Hx  内の残存
! bit を、byte 境界に合わせるため、不足 bit を
! "1" で埋めて書き出し、Hx を空にする。
!---------------------------------------------
SUB W_FLUSH
   IF 0< BC THEN CALL W_HUFF( 8-BC, 2^(8-BC)-1)  !write flush
END SUB

!======================================================
! DHT( Define Huffman Table segmet)
! 復号側に、符号化側で使用した符号木を、再現させる数表
! 構成：
! DH()= 符号木の 階層ごとの枝の数
! DV()= 出現頻度順に並べた 座標
!------------------------------------------------------
SUB MAKE_DHT
!  --- monitor SV()
   PRINT
   PRINT "頻度表"
   PRINT "座標= 横から縦の順。0～0xff　データー値"
   CALL msg_x( SV, 0,255, "","      ")   !SV( 0~255)
   PRINT "total=";Tx
   !
   !--- make S_()DV()<-- SV()
   LET SE=-1
   FOR i=0 TO 255
      IF SV(i)<>0 THEN
         LET SE=SE+1
         LET S_(SE)=SV(i)
         LET DV(SE)=i
      END IF
   NEXT i
   PRINT
   PRINT "上の表を、頻度数と、座標の２つの表に分解し、同順の対にする。"
   PRINT "---------------------------------"
   PRINT "表中、頻度数０を外して詰めたもの"
   CALL msg_x( S_, 0,SE, "","      ")    !S_(0~SE)
   PRINT "座標"
   CALL msg_x( DV, 0,SE, "    ","00")    !DV(0~SE)
   !
   !--- sort DV() by S_()
   CALL Qsort(0,SE)
   PRINT "---------------------------------"
   PRINT "頻度の多い順に置換え (座標と対)"
   CALL msg_x( S_, 0,SE, "","      ")    !S_(0~SE)
   PRINT "座標"
   CALL msg_x( DV, 0,SE, "    ","00")    !DV(0~SE)
   !
   !--- make huffman tree, DH()
   CALL TREE3
END SUB

SUB list_DHT
   PRINT
   PRINT "len.(コード長) 1~"& STR$(lmx)& " の各個数 ( Define Huffman Table )"
   CALL msg_x( DH, 1,lmx , " ","00")     !DH(1~lmx)
   PRINT " 頻度順の、座標"
   CALL msg_x( DV, 0,Tx-1, " ","00")     !DV(0~Tx-1)
END SUB

SUB msg_x( M(), S,E, s$,n$)   !16 進数 表示
   LET Tx=0
   LET w$=""
   FOR i=S TO E
      LET Tx=Tx+M(i)
      LET w$=w$& s$& RIGHT$(n$& BSTR$(M(i),16), LEN(n$))
      IF MOD(i-S,16)=15 THEN LET w$=w$& crlf$
   NEXT i
   IF MOD(i-S,16)=0 THEN PRINT w$; ELSE PRINT w$
END SUB

!---------------------------------------------------------------------------
! make huffman tree
!
! 値と頻度がセットになっているデーター個数に、同数のハフマン符号を作る。
!
!１）頻度が最小の2個を選び、1組にして、その頻度の和を、新たな1個の頻度に変更。
!２）1個少なくなった全体に、再び１）の操作を行い、全体が1組(1個)になるまで繰返す。
!
!最後の1組は、その中に2組、その2組も、各々同様に、
!最初に有ったデーター個数に至るまで、経路が木の枝のように分かれる。
!
!その経路の数は、最初に有ったデーター個数と、過不足なく同数。
!
!最後の1組から、データー１個に至る直前までの、途中の組(分岐点)をたどる時、
!各々の組の２つの枝に、0,1 の番号を付け、最後の1組から並べると、ハフマン符号ができる。
!
!１つの経路のたどる分岐点の数は、頻度が大きいデーターほど、後からつながれていて、
!より少ないので、ハフマン符号は、より短い 011・・となる。


!プログラムは、出来た枝から、直接、ハフマン符号を作らず、
!各層における枝の数を、収めた 配列テーブル DH() を作成して終っている。
!
!SUB MAKE_H2 で、DH() から、ココで作成された木構造を、011・・の形(ハフマン符号)
!へ再生する事で、符号化に使用している。復号側も、SUB makeH0 で、DH() から再生。
!
!プログラムは、ハフマン符号木の最後尾に、使わない枝( 空席)も、１つ追加している。
!下の文中、　!←(+1) 符号木の最下に、空席を１つ作る。　…の行、２つ。
!              SE+1 を、SE にすると、空席は無くなる。
!---------------------------------------------------------------------------
SUB TREE3
   MAT Tr=ZER
   FOR i=0 TO SE
      LET F_(i)=S_(i)               !数値を壊すので、コピー F_(i)で実行
   NEXT i
   LET F_(SE+1)=0                   !← 空席用
   !---minimum pair
   DO
      LET w=1e10
      FOR i=0 TO SE+1               !←(+1) 符号木の最下に、空席を１つ作る。
         IF F_(i)< w THEN
            LET w=F_(i)
            LET Ad1=i               !minimum1   !頻度最小の分岐アドレスAd1
         END IF
      NEXT i
      LET w=1e10
      FOR i=0 TO SE+1               !←(+1) 符号木の最下に、空席を１つ作る。
         IF F_(i)< w AND i<>Ad1 THEN
            LET w=F_(i)
            LET Ad2=i               !minimum2   !頻度最小の分岐アドレスAd2
         END IF
      NEXT i
      IF w=1e10 THEN EXIT DO        !分岐の組が無くなるまで
      !---
      LET F_(Ad1)=F_(Ad1)+F_(Ad2)   !次の頻度最小の組探しは、２分岐合計を１つにし、
      LET F_(Ad2)=2e10              !他方を外して行なう
      !---
      FOR Le1=lmx TO 1 STEP -1      !アドレスAd1の最上 節点レベルLe1 を探す(最初のLe1=0)
         IF Tr(Le1,Ad1,1)>0 OR Tr(Le1,Ad1,3)>0 THEN EXIT FOR
      NEXT Le1
      FOR Le2=lmx TO 1 STEP -1      !アドレスAd2の最上 節点レベルLe2 を探す(最初のLe2=0)
         IF Tr(Le2,Ad2,1)>0 OR Tr(Le2,Ad2,3)>0 THEN EXIT FOR
      NEXT Le2
      LET Le0=MAX( Le1,Le2 )+1      !両者何れよりも１つ上の節点レベル(Le0,Ad1)に、
      !---
      LET Tr(Le0,Ad1,0)=Le1         !分岐先( 節点レベル,アドレス)として２組記入
      LET Tr(Le0,Ad1,1)=Ad1
      LET Tr(Le0,Ad1,2)=Le2
      LET Tr(Le0,Ad1,3)=Ad2
      IF lmx< Le0 THEN LET lmx=Le0  !最大段数 lmx の設定、更新
   LOOP
   !---make DH()
   LET k=0
   CALL bitl(Le0,Ad1)               !全分岐路の 分岐段数 を求める。
   FOR Ad=0 TO SE
      LET DH(Tr(0,Ad,0))=DH(Tr(0,Ad,0))+1   !分岐段数 が同じ Tr(0,Ad,0) の
   NEXT Ad                                  !総数を、段数毎に、DH() に集計
   LET DH(0)=Ad
END SUB

SUB bitl(Le,Ad)                     !最上 節点(Le0,Ad1)より全分岐路を、底まで辿る
   IF 0< Le THEN
      LET k=k+1
      CALL bitl( Tr(Le,Ad,0), Tr(Le,Ad,1) )  !分岐先 1
      CALL bitl( Tr(Le,Ad,2), Tr(Le,Ad,3) )  !分岐先 2
      LET k=k-1
   ELSE
      LET Tr(0,Ad,0)=k              !最上 節点から底までの 分岐段数 kを書く
   END IF
END SUB

!-----------------------------
! Quick Sort S_() DV() by S_()
!-----------------------------
SUB Qsort(L,R)                      !降順にセット。
   local i,j
   LET i=L
   LET j=R
   LET Tx=S_(IP((L+R)/2))
   DO
      DO WHILE S_(i) >Tx            ![>]降順　[< ]昇順
         LET i=i+1
      LOOP
      DO WHILE Tx >S_(j)            ![>]降順　[< ]昇順
         LET j=j-1
      LOOP
      IF j< i THEN EXIT DO          !等号付 j<=i は、暴走。
      SWAP S_(i),S_(j)
      SWAP DV(i),DV(j)
      LET i=i+1
      LET j=j-1
   LOOP UNTIL j< i                  !等号付 j<=i は、低速。
   IF L< j THEN CALL Qsort(L,j)
   IF i< R THEN CALL Qsort(i,R)
END SUB

!===================================
! make encorder table B()L()<-- DH()
!-----------------------------------
SUB MAKE_H2
   LET i=0               !コード生成 順番(短い順)
   LET Hx=0
   FOR L_=1 TO lmx       !lmx= 最大 bit 長
      FOR N=1 TO DH(L_)
         LET V_=DV(i)    !座標DV(頻度降順)
         LET L(V_)=L_
         LET B(V_)=Hx    !コード(座標V_)
         LET i=i+1
         LET Hx=Hx+1
      NEXT N
      LET Hx=Hx*2
   NEXT L_
   LET B(256)=1
END SUB

!Page-2 へ続く
 		 

!Page-2

 投稿者：SECOND  投稿日：2013年 7月20日(土)00時21分29秒
  !Page-2 の始め

!********************************************
! Encorder side R/W file
!********************************************

! read origin data  with bits L
FUNCTION INP_E( L)
   DO WHILE By< L
      IF siz<=i9 THEN
         LET INP_E=Hy
         LET Hy=0
         LET By=0
         EXIT FUNCTION
      END IF
      LET i9=i9+1
      LET Hy=Hy+ORD(db$(i9:i9))*2^By
      LET By=By+8
   LOOP
   !----
   LET INP_E=bitand(Hy,2^L-1)
   LET Hy=IP(Hy*2^(-L))
   LET By=By-L
END FUNCTION

! JPG の符号化データー中、0xff は、制御コード marker の接頭文字として
! 機能させるので、データーとしての 0xff は、0x00 を後付する規則がある。
! このプログラムで、必要はないが、同じ書式とした。

! write huffman code  with byte
SUB WRT_D( D)
   LET huf$=huf$& CHR$(D)
   IF D=255 THEN LET huf$=huf$& CHR$(0)
END SUB

!********************************************
! Decorder Side R/W file
!********************************************

! read huffman code  with byte
FUNCTION INP_D
   IF LEN(huf$)<=i9 THEN EXIT FUNCTION
   LET i9=i9+1
   LET INP_D=ORD(huf$(i9:i9))
END FUNCTION

! write origin data  with bits L
SUB OUT_D( D, L)
   LET Hy=Hy+D*2^By          !By: staying bits in register Hy
   LET By=By+L
   DO WHILE 8<=By
      IF siz<=o9 THEN EXIT SUB
      LET o9=o9+1
      LET out$=out$& CHR$(bitand(Hy,255))
      LET Hy=IP(Hy*2^(-8))
      LET By=By-8
   LOOP
END SUB

!********************************************
SUB Decode0
   LET i9=0                  !input byte pointer
   !
   !---read tree =DHT( Define Huffman Table)
   MAT DH=ZER
   MAT DV=ZER
   LET lmx=INP_D             !huffman code max.length
   FOR i=1 TO lmx
      LET DH(i)=INP_D        !DH(i) 各コード長の数( tree 各階層の終端数)
      LET DH(0)=DH(0)+DH(i)  !DH(0) 全コードの数( tree 分岐路の総数)
   NEXT i
   FOR i=0 TO DH(0)-1
      LET DV(i)=INP_D
   NEXT i
   !
   !---make huffman.code table & decorder table
   MAT B=ZER              !code table
   MAT L=ZER              !code length
   CALL makeH0            !Code table B() L()<-- DH()
   CALL makeD0            !Decorder table A()<-- B() L() DH() DV()
   CALL list_DHT
   CALL list_HT
   CALL list_A
   !
   !---read huffman code
   LET siz=INP_D+256*INP_D+65536*INP_D+16777216*INP_D  !output data size
   LET o9=0                                            !output byte pointer
   LET out$=""                                         !output byte buffer
   LET By=0               !remainder in output bit register
   LET Hy=0               !output bit register
   !---
   LET BC=0               !remainder in input register
   LET Hx=0               !input register
   CALL R_BLK0
END SUB

SUB R_BLK0
   DO WHILE o9< siz
      CALL DEC1_NS
      CALL OUT_D(V_,xL)
   LOOP
END SUB

!==========================================================
! decorder
! 区切れなく連続する bit の流れから、A() で復号。
! L_ ← 検出された登録ハフマンコードの bit長
! V_ ← 検出された登録ハフマンコードに対応する座標( 8bit値)
!----------------------------------------------------------
SUB DEC1_NS
   LET NA=0
   DO
      IF BC< BST THEN CALL DEC1_IN
      LET W=Hx*SHb                     !bits width BST
      !----
      LET NA=A(NA+IP(W))               !line adr.  NA=0 table end
      IF 32768<=NA THEN EXIT DO        !DU0L LLLL VVVV VVVV
      LET BC=BC-BST
      LET Hx=FP(W)
   LOOP
   LET L_=MOD(IP(NA/256),128)          ! U0L LLLL
   LET V_=MOD(NA,256)                  !          VVVV VVVV
   IF lmx< L_ THEN PRINT "unused code"
   !----
   LET W=MOD(L_,BST)
   IF W=0 THEN LET W=BST
   LET BC=BC-W
   LET Hx=FP(Hx*2^W)
END SUB

SUB DEC1_IN
   LET W=INP_D
   IF W=255 THEN
      LET M=INP_D
      IF M<>0 THEN LET w=1/0   !EXTYPE=3001, ffxx marker, abnormally break
   END IF                      !BC:    ┌┐buffer remain
   LET Hx=Hx+W*2^(-8-BC)       !Hw:  xx.xxxxxxxxx bits(BST).～b(-?)
   LET BC=BC+8                 !W:       └──→ next input space
END SUB                        !BST:└┘decord pitch

!======================================
! B()L()<-- DH() for decorder table A()
!--------------------------------------
SUB makeH0
   LET i=0               !コード生成 順番(短い順)
   LET Hx=0
   FOR L_=1 TO lmx       !lmx= 最大 bit 長
      FOR P=1 TO DH(L_)
         LET L(i)=L_
         LET B(i)=Hx     !コード(生成順), 座標DV(頻度降順) と同順。
         LET i=i+1
         LET Hx=Hx+1
      NEXT P
      LET Hx=Hx*2
   NEXT L_
   LET B(256)=0
END SUB

!=============================================
! make decorder table A()<-- B() L() DH() DV()
!---------------------------------------------
SUB makeD0
   FOR LH=lmx TO 1 STEP -1
      IF DH(LH)<>0 THEN EXIT FOR
   NEXT LH                          !bit length max. in huffman table
   LET LM=CEIL(LH/BST)*BST          !bit length max. bound by BST
   !---
   LET i=0                          !start huffman table adr.
   LET LA=0                         !line adr.
   LET NC=0                         !next start Decord code
   LET P=BST                        !start Decord code width
   DO
      LET D_=NC                                      !start Decord code
      LET D_=D_*SHb                                  !shr(U_,BST)
      LET D9=2^P                                     ! over Decord code
      LET NC=-1
      LET LB=LA+(D9-D_)                              !1st nest adr.
      DO
         CALL SERCH
         IF 0< L_ THEN
            LET A(LA)= BVAL("8000",16)+L_*256+DV(i)  !D00L LLLL VVVV VVVV   !b15=end. +L.+V.
         ELSEIF P=LM THEN
            LET A(LA)= BVAL("C000",16)+LH*256        !DU0L LLLL VVVV VVVV   !b15=end. b14=Unused. +L.
         ELSE
            IF NC=-1 THEN LET NC=D_
            LET A(LA)=LB                             !0nnn nnnn nnnn nnnn   !nest adr.
            LET LB=LB+SHb                            !next nest adr.
         END IF
         LET D_=D_+1
         LET LA=LA+1
      LOOP UNTIL D9<=D_
      LET P=P+BST
   LOOP UNTIL LM< P
   !---
   LET A(LA)=0                                       !(0),table stop mark
END SUB

SUB SERCH
   FOR i=i TO DH(0)-1
      LET L_=L(i)
      IF L_<=P THEN LET w=IP( D_*2^(L_-P)) ELSE EXIT FOR
      IF w<=B(i) THEN
         IF w=B(i) THEN EXIT SUB ELSE EXIT FOR
      END IF
   NEXT i
   LET L_=-1
END SUB

!=========================================
! print Decoder table. Process_list<-- A()
!-----------------------------------------
SUB list_A
   PRINT
   PRINT "******  Decoder table A() ******"
   PRINT "下表は、BST 幅( 現在は "& STR$(BST)& "bit)づつ区切って読込み"
   PRINT "配列 A() をたどって、不明な長さ(len.)の Code を、"
   PRINT "特定( 復号)していく仕組み。　座標<>""--"" で終点。"
   PRINT "----------------------------------------------"
   LET L4=MAX(LM,4)
   PRINT "Line  A()   Code"& REPEAT$(" ",L4-4)& " len. 座標"
   !---
   LET LA=0             !line adr.
   LET NC=0
   LET P=BST
   DO
      LET D_=NC         !next start Decord code
      LET D_=D_*SHb
      LET D9=2^P        !over Decord code
      LET NC=-1
      DO
         LET W=A(LA)
         !! IF W=0 THEN EXIT DO
         IF 32768<=W THEN               !DU0L LLLL VVVV VVVV
            LET L_=MOD( IP(W/256),128)  ! U0L LLLL
            LET V_=MOD(W,256)           !          VVVV VVVV
            LET w1$=USING$("##",MOD(L_,32))& "  "& RIGHT$("0"& BSTR$(V_,16),2)
            IF 64< L_ THEN LET w1$(3:6)="  -- Unused"
         ELSE                           !0nnn nnnn nnnn nnnn
            IF NC=-1 THEN LET NC=D_
            LET L_=0
            LET V_=0
            LET w1$=" -  -- Line"& STR$(W)
         END IF
         LET w$=USING$( "####",LA)& right$("     "& BSTR$(W,16),6)& "  "
         LET w$=w$& right$("0000000"& BSTR$(D_,2),P)& REPEAT$(" ",L4+2-P)& w1$
         PRINT w$
         !---
         LET D_=D_+1
         LET LA=LA+1
      LOOP UNTIL D9<=D_
      LET P=P+BST                       !next Decord code width
   LOOP UNTIL LM< P  !W=0
   !---
   PRINT USING$( "####",LA)& right$("     "& BSTR$( A(LA),16),6)  !verify end
   PRINT "decoder table end"
END SUB

!=========================
! print huffman code table
!-------------------------
SUB list_HT
   PRINT
   PRINT "huffman code"
   PRINT " 頻度 座標 len. コード(";
   IF MOD(B(256),2)=1 THEN PRINT "座標順)" ELSE PRINT "生成順、頻度降順)"
   LET sum=0
   FOR i=0 TO 255
      IF L(i)<>0 THEN
         IF MOD(B(256),2)=1 THEN                            !1=Sort at value. Encorder 用
            LET V_=i
            LET w$=RIGHT$("    "& BSTR$(SV(i),16),5)& "  "  !times
            LET sum=sum+L(i)*SV(i)
         ELSE                                               !0=Sort at length. Decorder 用
            LET V_=DV(i)
            LET w$=RIGHT$("    "& BSTR$(S_(i),16),5)& "  "  !times
            LET sum=sum+L(i)*S_(i)
         END IF
         LET w$=w$& right$("0"& BSTR$(V_,16),2)& "  "       !value
         LET w$=w$& right$(" "& STR$(L(i)),2)& "   "        !huffman code length
         LET w$=w$& right$("0000000"& BSTR$(B(i),2),L(i))   !huffman code
         PRINT w$
      END IF
   NEXT i
   PRINT " 合計( 頻度 * bit)=";sum
END SUB

!===================
! print huffman tree
!-------------------
SUB list_TREE
   PRINT
   PRINT "huffman tree　　****１行が長い時( ～ 数1000桁 )、右端で折り返さない注意！****"
   PRINT "                0,00: 7,01 などの意味 → 縦0階,横00番：縦7階,横01番 に２分岐"
   !---disp.nest
   FOR Le=Le0 TO 0 STEP -1
      LET w$=right$(" "& BSTR$(Le,16),2)& "|"
      FOR Ad=0 TO SE+1
         IF Tr(Le,Ad,1)>0 OR Tr(Le,Ad,3)>0 THEN
            LET w$=w$&
&& right$(" "& BSTR$(Tr(Le,Ad,0),16),2)& ","& right$("0"& BSTR$(Tr(Le,Ad,1),16),2)& ":"&
&& right$(" "& BSTR$(Tr(Le,Ad,2),16),2)& ","& right$("0"& BSTR$(Tr(Le,Ad,3),16),2)& "|"
         ELSE
            LET w$=w$& "----"& right$(" "& BSTR$(Le,16),2)& "-----|"
         END IF
      NEXT Ad
      PRINT w$
   NEXT Le
   !---hor.scale
   LET w$=""
   FOR Ad=0 TO SE+1
      LET w$=w$& "     "& right$("0"& BSTR$(Ad,16),2)& "     "   !Care tail SP.
   NEXT Ad
   !---hor.frequency
   LET w$=w$& crlf$& "頻度 "
   FOR Ad=0 TO SE+1
      IF 0< S_(Ad) THEN LET w1$=left$( BSTR$(S_(Ad),16)& "     ",6) ELSE LET w1$="unused "
      LET w$=w$& w1$& "      "
   NEXT Ad
   !---hor.value
   LET w$=w$& crlf$& "座標 "
   FOR Ad=0 TO SE+1
      IF 0< S_(Ad) THEN LET w1$=right$("0"& BSTR$(DV(Ad),16),2)& "    " ELSE LET w1$="unused"
      LET w$=w$& w1$& "      "
   NEXT Ad
   !---hor.rank
   LET w$=w$& crlf$& "len. "
   FOR Ad=0 TO SE+1
      LET w$=w$& right$(" "& BSTR$(Tr(0,Ad,0),16),2)& "          "
   NEXT Ad
   PRINT w$
END SUB

END
 		 

戻る