DeflatePro

[a740g]

This is a QB64 _INFLATE$ compatible compression library. Internally it uses Google's Zopfli. Zopfli is a highly optimized C-based compression library designed to produce efficient (though slow) Deflate or zlib-compressed data. The advantage is that the compressed data is fully compatible with QB64’s _INFLATE$ function, allowing seamless decompression.

The library contains a single function:

Code: (Select All)

' @brief Compresses a STRING buffer using the Deflate algorithm with Zopfli. The output can be decompressed using QB64's _INFLATE$ function.

' @param inputBuffer The STRING buffer to compress.

' @param compressionLevel The compression level to use (0 - 65535). 65535 provides the highest compression, while 0 uses the library’s default. Levels above 255 may yield diminishing returns and are extremely slow.

' @return The compressed string.

FUNCTION DeflatePro$ (inputBuffer AS STRING, compressionLevel AS _UNSIGNED INTEGER)

The attached file has a test program in the zip root and the library inside the "include" directory. Use it however you see fit.




FAQ:
Q: Why did you do this?
A: Why not? Ok, just for fun.

[Petr]

Thanks for posting. I use _Deflate$ to compress image masks. I appreciate you posting it here. I tested it in version 4.0 (older versions see an unknown command there). I can use it for short strings, so the program stays snappy.

[a740g]

Thanks for posting. I use _Deflate$ to compress image masks. I appreciate you posting it here. I tested it in version 4.0 (older versions see an unknown command there). I can use it for short strings, so the program stays snappy.

You are welcome.  

The library does not use any v4-specific features. So you should be able to use that with previous versions of QB64-PE.

[Sanmayce]

Thanks, such add-ons are essential for quickening (keeping the spirit of quickness alive) the "Quick" in QB64, hee-hee.

Eric Biggers's libdeflate is the best ZIP implementation known to me, he constantly makes it better each year.
Zopfli is Jyrki's implementation, he is an algorithmicwhiz, among the best programmers, his contributions in graphics, compression, hashing are industry-standard.

To me, QB64 has to be enriched with similar libraries (under one hood, e.g. QB64_Cgems).
For example, QB64 lacks FuzzyMemMem&(Haystack$, Needle$, EditDistance%) function.
Huh, even GLIBC is lacking in that department...

Keep up the good work, man, salute you!

[aadityap0901]

Check this out:
1B - A pre-compression algorithm to increase the compression-ratio of deflate:
Basic Usage: 1b -c [FILENAME]

Code: (Select All)

$Console:Only

If _CommandCount = 0 Then System

Dim As _Unsigned Long BS

Dim ST!, LT!, I$, O$, Y%, INFILE$, OUTFILE$, PATHPREFIX$, MODE%%, L&

If Command$(1) = "-c" Or Command$(1) = "--compress" Then MODE%% = 1

If Command$(1) = "-d" Or Command$(1) = "--decompress" Then MODE%% = 2

INFILE$ = Command$(2)

If _FileExists(INFILE$) = 0 Then PATHPREFIX$ = _StartDir$ + "\"

INFILE$ = PATHPREFIX$ + INFILE$

If _FileExists(INFILE$) = 0 Then Print "File "; Command$(2); " does not exists!": System

Y% = CsrLin + 1

Select Case MODE%%

    Case 1: Print "Compressing": Open INFILE$ For Binary As #1

        OUTFILE$ = INFILE$ + ".1b"

        Open OUTFILE$ For Output As #2

        Close #2

        Open OUTFILE$ For Binary As #2

        ST! = Timer(0.001)

        BS = 2 ^ Val(Command$(3))

        If BS = 1 Then BS = 2 ^ 20

        Do

            LT! = Timer(0.001)

            If LOF(1) - Seek(1) + 1 >= BS Then I$ = Space$(BS) Else I$ = Space$(LOF(1) - Seek(1) + 1)

            Get #1, , I$

            O$ = OneByteEncode$(I$)

            I$ = MKL$(Len(O$)) + O$

            Put #2, , I$

            If LOF(1) <= Seek(1) - 1 Then Exit Do

            Locate Y%, 1: Print Round(100 * (Seek(1) - 1) / LOF(1)); "%", Round(100 * LOF(2) / (Seek(1) - 1)); "%", Round(Timer(0.001) - LT!); "s", Round((Timer(0.001) - LT!) / BS * (LOF(1) - Seek(1) + 1)); "s", Round(Timer(0.001) - ST!); "s"

        Loop

        Print "Ratio:"; Round(100 * LOF(2) / LOF(1)); "%"

        Print "Time: "; Timer(0.001) - ST!; "s"

        Close

    Case 2: Print "Decompressing": Open INFILE$ For Binary As #1

        OUTFILE$ = INFILE$ + ".out"

        Open OUTFILE$ For Output As #2

        Close #2

        Open OUTFILE$ For Binary As #2

        ST! = Timer(0.001)

        Do

            LT! = Timer(0.001)

            Get #1, , L&

            If EOF(1) = -1 Then Exit Do

            I$ = Space$(L&)

            Get #1, , I$

            O$ = OneByteDecode$(I$)

            Put #2, , O$

            Locate Y%, 1: Print Round(100 * (Seek(1) - 1) / LOF(1)); "%", Round(Timer(0.001) - LT!); "s", Round(Timer(0.001) - ST!); "s"

        Loop

        Print "Time: "; Timer(0.001) - ST!; "s"

        Close

End Select

System

Function Round (__N As Double)

    Round = Int(100 * __N) / 100

End Function

Function Remain~& (A~&, B~&)

    Remain~& = A~& \ B~& + Sgn(A~& Mod B~&)

End Function

Function OneByteEncode$ (__I$)

    Dim As _Unsigned _Byte __ONEBYTE, __C

    Dim As _Unsigned Long __BYTE_BUFFER_OFFSET, __POSITION_BUFFER_OFFSET, __I, __LENA, __Frequency_Table(0 To 255)

    Dim __J As _Unsigned _Bit * 3

    Dim As String __BYTE_BUFFER, __POSITION_BUFFER

    __LENA = Len(__I$)

    For __I = 1 To __LENA

        __BYTE~%% = Asc(__I$, __I)

        __Frequency_Table(__BYTE~%%) = __Frequency_Table(__BYTE~%%) + 1

    Next __I

    For __BI~%% = 0 To 255

        If __Frequency_Table(__BI~%%) > __Frequency_Table(__ONEBYTE) Then __ONEBYTE = __BI~%%

    Next __BI~%%

    __BYTE_BUFFER = String$(Len(__I$), 0): __POSITION_BUFFER = String$(Remain(Len(__I$), 8) + 1, 0)

    For __I = 1 To Len(__I$)

        __C = Asc(__I$, __I): If __J = 0 Then __POSITION_BUFFER_OFFSET = __POSITION_BUFFER_OFFSET + 1

        If __C <> __ONEBYTE Then

            Asc(__POSITION_BUFFER, __POSITION_BUFFER_OFFSET) = _SetBit(Asc(__POSITION_BUFFER, __POSITION_BUFFER_OFFSET), __J)

            __BYTE_BUFFER_OFFSET = __BYTE_BUFFER_OFFSET + 1: Asc(__BYTE_BUFFER, __BYTE_BUFFER_OFFSET) = __C

        End If

        __J = __J + 1

    Next __I

    __POSITION_BUFFER = _Deflate$(Left$(__POSITION_BUFFER, __POSITION_BUFFER_OFFSET))

    __BYTE_BUFFER = _Deflate$(Left$(__BYTE_BUFFER, __BYTE_BUFFER_OFFSET))

    OneByteEncode$ = MKL$(Len(__I$)) + MKL$(Len(__POSITION_BUFFER)) + MKL$(Len(__BYTE_BUFFER)) + Chr$(__ONEBYTE) + __POSITION_BUFFER + __BYTE_BUFFER

    __POSITION_BUFFER = ""

    __BYTE_BUFFER = ""

    Exit Function

End Function

Function OneByteDecode$ (__I$)

    Dim As _Unsigned Long __I, __BYTE_BUFFER_OFFSET, __POSITION_BUFFER_OFFSET

    Dim As _Unsigned _Bit * 3 __J

    Dim As String __BYTE_BUFFER, __POSITION_BUFFER, __OUT_BUFFER

    __OUT_LENGTH~& = CVL(Left$(__I$, 4))

    __POSITION_BUFFER_DEFLATE_LENGTH~& = CVL(Mid$(__I$, 5, 4))

    __BYTE_BUFFER_DEFLATE_LENGTH~& = CVL(Mid$(__I$, 9, 4))

    __ONEBYTE~%% = Asc(__I$, 13)

    __POSITION_BUFFER = _Inflate$(Mid$(__I$, 14, __POSITION_BUFFER_DEFLATE_LENGTH~&))

    __BYTE_BUFFER = _Inflate$(Mid$(__I$, 14 + __POSITION_BUFFER_DEFLATE_LENGTH~&, __BYTE_BUFFER_DEFLATE_LENGTH~&))

    __OUT_BUFFER = String$(__OUT_LENGTH~&, 0)

    __POSITION_BUFFER_OFFSET = 0

    __BYTE_BUFFER_OFFSET = 0

    For __I = 1 To __OUT_LENGTH~&

        If __J = 0 Then __POSITION_BUFFER_OFFSET = __POSITION_BUFFER_OFFSET + 1

        If _ReadBit(Asc(__POSITION_BUFFER, __POSITION_BUFFER_OFFSET), __J) Then

            __BYTE_BUFFER_OFFSET = __BYTE_BUFFER_OFFSET + 1

            Asc(__OUT_BUFFER, __I) = Asc(__BYTE_BUFFER, __BYTE_BUFFER_OFFSET)

        Else

            Asc(__OUT_BUFFER, __I) = __ONEBYTE~%%

        End If

        __J = __J + 1

    Next __I

    __POSITION_BUFFER = ""

    __BYTE_BUFFER = ""

    OneByteDecode = __OUT_BUFFER

End Function

Function RLEEncode$ (__I$)

    Dim As _Unsigned _Byte __CB, __LB, __C

    Dim As Long __I

    Dim As String __OUT_BUFFER

    __OUT_BUFFER = String$(Len(__I$) * 2, 0)

    __LB = Asc(__I$, 1)

    __C = 1

    For __I = 2 To Len(__I$)

        __CB = Asc(__I$, __I)

        If __CB = __LB And __C < 255 Then

            __C = __C + 1

        Else

            __OUT_BUFFER_OFFSET = __OUT_BUFFER_OFFSET + 1

            Asc(__OUT_BUFFER, __OUT_BUFFER_OFFSET) = __LB

            __OUT_BUFFER_OFFSET = __OUT_BUFFER_OFFSET + 1

            Asc(__OUT_BUFFER, __OUT_BUFFER_OFFSET) = __C

            __C = 1

            __LB = __CB

        End If

    Next __I

    __OUT_BUFFER_OFFSET = __OUT_BUFFER_OFFSET + 1

    Asc(__OUT_BUFFER, __OUT_BUFFER_OFFSET) = __LB

    __OUT_BUFFER_OFFSET = __OUT_BUFFER_OFFSET + 1

    Asc(__OUT_BUFFER, __OUT_BUFFER_OFFSET) = __C

    If 5 + __OUT_BUFFER_OFFSET > Len(__I$) Then

        RLEEncode$ = Chr$(0) + __I$

    Else

        RLEEncode$ = Chr$(1) + MKL$(Len(__I$)) + Left$(__OUT_BUFFER, __OUT_BUFFER_OFFSET + 1)

    End If

    __OUT_BUFFER = ""

End Function

Function RLEDecode$ (__I$)

    Dim As _Unsigned _Byte __B, __C

    Dim As Long __I, __OUT_BUFFER_OFFSET

    Dim As String __OUT_BUFFER

    If Asc(__I$, 1) = 0 Then

        RLEDecode$ = Mid$(__I$, 2)

        Exit Function

    End If

    __OUT_LENGTH~& = CVL(Mid$(__I$, 2, 4))

    __OUT_BUFFER = String$(__OUT_LENGTH~&, 0)

    __OUT_BUFFER_OFFSET = 1

    For __I = 6 To Len(__I$) - 1

        __B = Asc(__I$, __I): __I = __I + 1: __C = Asc(__I$, __I)

        Mid$(__OUT_BUFFER, __OUT_BUFFER_OFFSET, __C) = String$(__C, __B)

        __OUT_BUFFER_OFFSET = __OUT_BUFFER_OFFSET + __C

    Next __I

    RLEDecode$ = __OUT_BUFFER

    __OUT_BUFFER = ""

End Function

I made a lot of other versions too, but this turned out to be the best of 4

[a740g]

@aadityap0901 I tried it. 1b is very picky and only shows goodness in very few cases. It generally does poorly when the data already has gone through some type of compression. But that is expected. Deflate does marginally better in these cases though.





The ".deflate" files are just raw dumps from _DEFLATE$.

[aadityap0901]

Yes, 1b is picky about that, but it just takes out the byte having the highest frequency, and then encodes it as a zero bit.