Problem with creating a Huffman code tree

[SagaraS]

Hello,

I started to write a code to read, count and sort a byte array.

Now I want to take the next step, but I don't know how to start exactly by creating a Huffman code tree with QB64 syntax.

I don't want a C or C++ solution, I want a QB64 solution for it.

Here is my current code:

In the 'test.txt' stand an example like 'aaavvrijgtmmspoe'
The file input can be anything. So all bytes should be considered from 0 to 255.

Code: (Select All)

'Huffman Encoding

TYPE assignment
  CHAR AS _UNSIGNED _BYTE '<-- ASCII Character
  COUNT AS _UNSIGNED LONG '<-- Frequenzy of ASCII Chars (Counter)
END TYPE

DIM File AS STRING

File = "test.txt"

OPEN File FOR BINARY ACCESS READ AS #1
REDIM MEM(LOF(1) - 1) AS _UNSIGNED _BYTE
GET #1, , MEM()
CLOSE #1

' Step 1 - Calc ASCII Char Frequenzy
REDIM Table(0) AS assignment
CALC_Table Table(), MEM()

COLOR 11: PRINT " STEP 1 *** Calc ASCII Frequenzy ***"
COLOR 7
FOR i = 0 TO UBOUND(Table)
  PRINT Table(i).CHAR; " - "; Table(i).COUNT
NEXT i

OPEN "test_TABLE.txt" FOR OUTPUT AS #1
FOR i = 0 TO UBOUND(table)
  PRINT #1, HEX$(Table(i).CHAR) + " - " + LTRIM$(STR$((Table(i).COUNT)))
NEXT i
CLOSE #1

'SLEEP

' Step 2 - Huffman Tree create



SUB InsertElement (Array() AS assignment, Index AS _UNSIGNED LONG)
  DIM I AS _UNSIGNED LONG
  DIM Empty AS assignment

  IF Index > (UBOUND(Array) + 1) THEN EXIT SUB

  REDIM _PRESERVE Array(UBOUND(Array) + 1) AS assignment

  FOR I = UBOUND(Array) - 1 TO Index STEP -1
    Array(I + 1) = Array(I)
  NEXT I

  Array(Index) = Empty
END SUB

SUB RemoveElement (Array() AS assignment, Index AS _UNSIGNED LONG)
  DIM I AS _UNSIGNED LONG

  FOR I = Index TO UBOUND(Array) - 1
    Array(I) = Array(I + 1)
  NEXT I

  REDIM _PRESERVE Array(UBOUND(Array) - 1) AS assignment
END SUB

SUB CALC_Table (Table() AS assignment, Array() AS _UNSIGNED _BYTE)
  ' Step 1 - Calc ASCII Char Frequenzy
  DIM i AS _UNSIGNED LONG ' <- Counter for Array
  DIM r AS _UNSIGNED LONG ' <- Counter for Table
  DIM TableIDX AS _UNSIGNED LONG ' <- MAX Index for Table
  DIM NewEntry AS _UNSIGNED _BYTE ' <- becomes 1 if character is missing from table

  Table(TableIDX).CHAR = Array(i)
  FOR i = 0 TO UBOUND(Array)
    FOR r = 0 TO UBOUND(Table)

      ' If the character is already in the table,
      ' then increase the number of characters by 1,
      ' otherwise create a new entry.      '
      IF Array(i) = Table(r).CHAR THEN
        Table(r).COUNT = Table(r).COUNT + 1
        NewEntry = 0
        EXIT FOR
      ELSE
        NewEntry = 1
      END IF
    NEXT r

    ' New Entry in Table
    IF NewEntry = 1 THEN
      TableIDX = TableIDX + 1
      REDIM _PRESERVE Table(TableIDX) AS assignment
      Table(TableIDX).CHAR = Array(i)
      Table(TableIDX).COUNT = 1
    END IF
  NEXT i

  ' Sort table by counter of characters
  QUICKSORT Table(), LBOUND(Table), UBOUND(Table), 1
END SUB

SUB QUICKSORT (Array() AS assignment, LB AS _UNSIGNED LONG, UB AS _UNSIGNED LONG, Mode AS _UNSIGNED _BYTE)
  DIM P1 AS _UNSIGNED LONG
  DIM P2 AS _UNSIGNED LONG
  DIM REF AS assignment
  DIM temp AS assignment

  P1 = LB
  P2 = UB
  REF.CHAR = Array((P1 + P2) \ 2).CHAR
  REF.COUNT = Array((P1 + P2) \ 2).COUNT

  DO

    SELECT CASE Mode
      CASE 0:
        DO WHILE Array(P1).CHAR < REF.CHAR
          P1 = P1 + 1
        LOOP

        DO WHILE Array(P2).CHAR > REF.CHAR
          P2 = P2 - 1
        LOOP
      CASE 1:
        DO WHILE Array(P1).COUNT < REF.COUNT
          P1 = P1 + 1
        LOOP

        DO WHILE Array(P2).COUNT > REF.COUNT
          P2 = P2 - 1
        LOOP
    END SELECT

    IF P1 <= P2 THEN
      temp = Array(P1)
      Array(P1) = Array(P2)
      Array(P2) = temp

      P1 = P1 + 1
      P2 = P2 - 1
    END IF

  LOOP WHILE P1 <= P2

  IF LB < P2 THEN CALL QUICKSORT(Array(), LB, P2, Mode)
  IF P1 < UB THEN CALL QUICKSORT(Array(), P1, UB, Mode)
END SUB