Dodicat Zlib

General FreeBASIC programming questions.
Locked
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Dodicat Zlib

Post by albert »

@Dodicat

Can you work your magic , and make this code faster???
It's taking like 4 seconds per loop... Not counting the time to create the initial string of bits..

Code: Select all


screen 19

dim as double time_s , time_e
do
    
    dim as string bits = ""
    for a as longint = 1 to 1000000 * 8 step 1
        bits+= bin( int( rnd * 2 ) )
    next

    print 
    print "Input bits = " ; len( bits ) , len( bits ) \ 8

    time_s = timer
    
    dim as string outs = ""
    dim as string map = ""
    dim as string n1
    dim as ubyte v1 , v2 , v3 , v4
    for a as longint = 1 to len( bits ) step 8
        
        n1 = mid( bits , a , 8 )
        
        v1 = val( "&B" + mid( n1 , 1 , 2 ) )
        v2 = val( "&B" + mid( n1 , 3 , 2 ) )
        v3 = val( "&B" + mid( n1 , 5 , 2 ) )
        v4 = val( "&B" + mid( n1 , 7 , 2 ) )
        
        dim as string s1 = "0"
        if v1 = 0 then s1+= "1"
        if v1 = 1 then s1+= "11" 
        if v1 = 2 then s1+= "10"
        if v1 = 3 then s1+= "101"

        dim as string s2 = "0"
        if v2 = 0 then s2+= "1"
        if v2 = 1 then s2+= "11" 
        if v2 = 2 then s2+= "10"
        if v2 = 3 then s2+= "101"

        dim as string s3 = "0"
        if v3 = 0 then s3+= "1"
        if v3 = 1 then s3+= "11" 
        if v3 = 2 then s3+= "10"
        if v3 = 3 then s3+= "101"

        dim as string s4 = "0"
        if v4 = 0 then s4+= "1"
        if v4 = 1 then s4+= "11" 
        if v4 = 2 then s4+= "10"
        if v4 = 3 then s4+= "101"

        outs+= s1 + s2 + s3 + s4
        
    next 

    dim as string final = ""
    for a as longint = 1 to len( outs ) step 8
       final+= chr( val( "&B" + mid( outs , a , 8 ) ) )
    next
    
    time_e = timer
    
    print
    print "output =  "; len( final )
    print
    print "time =  " ; time_e - time_s
    print
    print "press a key to go again. esc to exit"
    sleep
    
loop until inkey = chr( 27 )

sleep
end
  
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Dodicat Zlib

Post by albert »

@Dodicat

With the row column cancel , i can't figure out the mapping..

if a row of three = all 0's or all 1's it takes a bit to describe the 0 or 1 so it compresses 2 bits per row of equate..
But if none of the three rows = 0's or 1's then it takes another bit to point that out.. so it expands all grids of no equates by a bit..

So ; if a grid has an equate it shaves 2 bits , else it adds a bit... and causes an expansion..

The number of grids with no equates , outnumbers the grids with an equate , so it expands instead of compressing...

Maybe my thinking is off... and there's a way to make it work..???

( OFF TOPIC )
I got my songs all ordered out...
Every other song is a demo i paid to have done ( they put my songs to music )
Every other song is me singing to the demo company..
https://soundcloud.com/user-704620747

I've got 18 songs done so far ( another 3 in the works. should be done in April. )
If you listen to both the demo and me singing , you'll se that the demo company doesn't always do the song as it should be done..
That's the reason i posted both...
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Dodicat Zlib

Post by dodicat »

albert.
You can make your previous code a little faster by using vallng or valint instead of val.
I don't think there is any point in trying to optimise it further until it works properly.
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Dodicat Zlib

Post by albert »

@Dodicat

If i have a dictionary 00 01 02 03

place = instr( 1 , dictionary , "03" )

Would you divide place by 3 or 4 ? to get 3 ?

The dictionary is hex values separated by a space , so you don't get odd values.

It's confusing because 01 is at place 4 and 02 is at place 7 , 03 is at place 10..
I don't know if i have to divide by 3 or 4..
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Dodicat Zlib

Post by albert »

@Dodicat

I came up with an idea.. But i don't know how to proceed with it..

You step through the ascii string and set a counter.. ( 0 to ?? )

Then you add that counter value ( bin or str or hex ) to array( chr )... When the counter reaches a certain value , you reset it to "0" and start over..

So you can represent byte chrs with fewer than the chr value bits..

Not sure how to write the code...
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Dodicat Zlib

Post by albert »

@Dodicat

This code:

n1 = mid( bits , a , 4 )

if left( n1 , 2 ) = right( n1 , 2 ) then map+= "1" : outs+= str( val( "&B" + mid( n1 , 3 ) ) )

if left( n1 , 2 ) <> right( n1 , 2 ) then map+= "0" : outs+= str( val( "&B" + mid( n1 , 2 ) ) )

With the second case... map = "0" , outs = 3 bits..
Can you determine the first bit from the last 2 ??? Seeing that they don't equal each other..

It compresses 4% on loop 1 with 1,000,000 bytes input..
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Yah-Zip

Post by albert »

@Dodicat

I got a formula...

Requires at least 40,000 bytes input .. With less it expands...
( 40,000 bytes in does 57% after 100 loops., )
( 1,000,000 bytes in , does 95% after 100 loops.) But it's slow taking like 200 seconds for the 100 loops.

Can you look it over to check for coding errors???
I keep playing around and changing the values , and some times forget to alter all the values...

Maybe you could refer me for the "Hutter Prize" : My apartment internet blocks all German websites...???


'Compres loop
'==========================================================
dim as string outs = ""
dim as string map = ""
dim as string s1 , s2
dim as longint v1 , v2
for a as longint = 1 to len( bits ) step 3

n1 = mid( bits , a , 3 )

s1 = ""
v1 = 0
if n1[0] = 49 then s1+= "1" : v1+= 1
if n1[1] = 49 then s1+= "10" : v1+= 1
if n1[2] = 49 then s1+= "11" : v1+= 1

s2 = ""
v2 = 0
if n1[0] = 48 then s2+= "1" : v2+= 1
if n1[1] = 48 then s2+= "10" : v2+= 1
if n1[2] = 48 then s2+= "11" : v2+= 1

s1+= "0"
s2+= "0"

if v2 < v1 then
outs+= s2
map+= "1"
else
outs+= s1
map+= "0"
end if

next
'==========================================================

Here's you Zlib code doing 100 loops of 1,000,000 bytes input... You can see for yourself...

Code: Select all


' YAH-ZIP
'
' Writen in FreeBasic for Windows
'
'Zlibrary code by Dodicat , From Scottland
'
' compress_loop() , decompress_loop by Albert Redditt U.S.A

'albert_redditt@yahoo.com

Declare Function   compress_loop( chrs as string ) as string
Declare Function decompress_loop( chrs as string ) as string


Namespace Zlibrary

#define Z_NO_COMPRESSION         0
#define Z_BEST_SPEED             1
#define Z_BEST_COMPRESSION       9
#define Z_DEFAULT_COMPRESSION  (-1)

#inclib "zlib"
Extern "C"
    Declare Function compressBound(Byval sourceLen As Ulong) As Ulong
    Declare Function uncompress(Byval dest As Ubyte Ptr, Byval destLen As Uinteger Ptr, Byval source As  Ubyte Ptr, Byval sourceLen As Ulong) As Long
    Declare Function compress(Byval dest As Ubyte Ptr, Byval destLen As Uinteger Ptr, Byval source As  Ubyte Ptr, Byval sourceLen As Ulong) As Long
    declare function compress2(byval dest as ubyte ptr, byval destLen as uinteger ptr, byval source as const ubyte ptr, byval sourceLen as uLong, byval level as long) as long
End Extern

Function getpassedinfo(text As String,Byref passed_length As Integer) As String
    Dim As String var1,var2
    Dim As Integer pst
    #macro splice(stri,char,var1,var2)
    pst=Instr(stri,char)
    var1="":var2=""
    If pst<>0 Then
        var1=Mid(stri,1,pst-1)
        var2=Mid(stri,pst+1)
    Else
        var1=stri
    End If
    #endmacro
    splice(text,"|",var1,var2)
    text=var2
    passed_length=Valint(var1)
    Return text
End Function


'=================   UNPACK ===============
Function unpack(file As String) As String
    Dim As Integer passed_length
    Dim As String text=getpassedinfo(file,passed_length)
    Dim As Integer stringlength,destinationlength
    stringlength=Len(text)
    destinationlength =passed_length
    Dim As Ubyte Ptr source
    Dim As Ubyte Ptr  destination =Callocate(destinationlength,1)
    source=@text[0]
    Var mistake=uncompress(destination,@destinationlength, source, stringlength)
    If mistake<>0 Then Print "There was an error":Sleep:End
    Dim As String uncompressed
    uncompressed=String(destinationlength,0)
    For i As Integer = 0 To destinationlength- 1
        uncompressed[i]=(destination[i])
    Next
    Deallocate destination
    Return uncompressed
End Function

'===================  PACK ============
Function pack(file As String) As String
    Dim As String text=file
    Dim As Integer stringlength,destinationlength
    stringlength=Len(text)
    destinationlength = compressBound(stringlength)
    Dim As Ubyte Ptr source
    Dim As Ubyte Ptr destination =Callocate(destinationlength,1)
    source=@text[0]
    Var mistake=compress2(destination, @destinationlength, source, stringlength,Z_BEST_COMPRESSION)''<----  use compress2
    If mistake <>0 Then Print "There was an error"
    Dim As String compressed
    compressed=String(destinationlength,0)
    For n As Integer=0 To destinationlength-1
        compressed[n]=destination[n]
    Next n
    compressed=stringlength &"|"+compressed
    Deallocate destination
    Return compressed
End Function

End Namespace

using Zlibrary

'==================================================================
'==================================================================
'test zipper
'==================================================================
'==================================================================
screen 19

Dim Shared As String s

Randomize

s=""
dim as string check=""
dim as string compare=""
dim as longint length = 0
dim as double compression = 0
dim as longint loops = 0

dim as double time1 , time2

time1 = timer
do
   
    loops+=1
   
    'one time run , create initial string
    if loops = 1 then
        randomize int( rnd * 1e9 )
        s = space( 1000000 )
        For n As Long = 0 to len( s ) - 1 step 1
            s[ n ] = Int( rnd * 256 )
        Next
        compare =  s
        length = len(s)
    else
        'modify compression to make further compression possible
       
        s = compress_loop(s)
    
    end if
    check = s
    compression = (100 - ( 100 / ( length / len(check) ) ))
   
    Print "original string"
    Print Len(s)
    Print
   
    Dim As String compressed=Zlibrary.pack(s)
    s = compressed
   
    Print "packed string "
    Print Len(compressed)
    Print
   
    Dim As String uncompressed=Zlibrary.unpack(compressed)
   
    Print "Retrieve"
    Print Len(uncompressed)
    Print
    'Print "compression ratio  "; 100 - ( 100 / ( Len(s) / len(compressed) ) ) ; "%"
    Print "compression ratio  "; 100 - ( 100 / ( length / len(s) ) ) ; "%"
    Print Iif(uncompressed=check,"OK","ERROR")
    Print "-------------------------------"
   
    'sleep 1000
   
    'if loops > 2 and (100 - ( 100 / ( length / len(s) ) )) < compression then exit do
   
    print "press esc to exit."
    print
    print "press a key for next compression." ; " loops = " ; loops ; " out of 100"
    'sleep
    
    if inkey = chr(27) then exit do
   
loop until loops = 100
time2 = timer

print
print  "Compress time = " ; time2 - time1
print
print "Press a key to decompress."
sleep

s = str(loops) + "_" + s ' save as an output file...

'==================================================================
'decompress
'==================================================================
dim as longint dec = instr(1,s,"_")
dim as longint count = val(left(s,dec-1))
dim as string comp = mid(s,dec+1)
dim as string val1
dim as string outs
for a as longint = count to 2 step -1
    s = Zlibrary.unpack(comp)
    outs = decompress_loop(s)
    comp = outs
next

comp = Zlibrary.unpack(comp)

print
print "input = "; length , "output = " ; len(comp) , "compression ratio  "; 100 - ( 100 / ( length / len(s) ) ) ; "%"
print
if comp = compare then print "Decompression successful." else print "ERROR"
print
print
Print "!!~~Done~~!!"

Sleep
end
'===============================================================================
'============================,===================================================
'begin functions
'===============================================================================
'================='==============================================================
Function compress_loop( chrs as string ) as string
   
    print "c inp = " ; len(chrs) ' , chrs
    
    'Turn char string into binary string
    '============================================================
    dim as string bits = ""
    dim as string zeros = string( 8 , "0" )
    dim as string n1
    dim as ubyte ptr ubp = cptr( ubyte ptr , strptr( chrs ) )
    for a as longint = 1 to len( chrs ) step 1
        n1 = zeros + bin( *ubp ) : ubp+= 1
        n1 = right( n1 , 8 )
        bits+= n1
    next
    '============================================================
    
    print "c bit = " ; len( bits ) ' , bits
    
    'Compres loop
    '==========================================================
    dim as string outs = ""
    dim as string map = ""
    dim as string s1 , s2
    dim as longint v1 , v2
    for a as  longint = 1 to len( bits ) step 3
        
        n1 = mid( bits , a , 3 )
        
        s1 = ""
        v1 = 0
        if n1[0] = 49 then s1+= "1" : v1+= 1
        if n1[1] = 49 then s1+= "10" : v1+= 1
        if n1[2] = 49 then s1+= "11" : v1+= 1
        
        s2 = ""
        v2 = 0
        if n1[0] = 48 then s2+= "1" : v2+= 1
        if n1[1] = 48 then s2+= "10" : v2+= 1
        if n1[2] = 48 then s2+= "11" : v2+= 1
        
        s1+= "0"
        s2+= "0"
        
        if v2 < v1 then
            outs+= s2
            map+= "1"
        else
            outs+= s1
            map+= "0"
        end if
        
    next
    '==========================================================
    
    print "c out = " ; len( outs ) ' , outs
    print "c map = " ; len( map ) ' , map

    dim as string final = ""
    for a as longint = 1 to len( outs ) step 8
        final+= chr( val( "&B" + mid( outs , a , 8 ) ) )
    next
    final+= "END"
    for a as longint = 1 to len( map ) step 8
        final+= chr( val( "&B" + mid( map , a , 8 ) ) )
    next
    
    print "c fin = " ; len( final )
    
    return final
   
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
    
    print
    print "d inp = " ; len( chrs )

    return chrs
    
end function

coderJeff
Site Admin
Posts: 4313
Joined: Nov 04, 2005 14:23
Location: Ontario, Canada
Contact:

Re: Dodicat Zlib

Post by coderJeff »

@Albert. Ignoring your posts is not an option for me. The typical pattern is that it escalates in some form. The quickest and most effective way to snuff out that possibility is to kick you from forum. I don't want to do that, but it works. The compression posts have been the most frequent since my recent involvement with the forum, so that's been the focus.

I truly hope that the only response that comes next is dodicat or nothing at all; that's my wish.
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Dodicat Zlib

Post by albert »

@CoderJeff

My above formula..

With 3 bits input.. you can't have (1 and 1) or (2 and 2) or( 3 and 3 )..

The set bits bits are 1 and 2 or 0 and 3

000 = 3 and 0
001 = 2 and 1
010 = 2 and 1
011 = 2 and 1
100 = 2 and 1
101 = 2 and 1
110 = 2 and 1
111 = 3 and 0

So you set the map to ( 0 or 1 ) for which ever value has the least set bits. Fewer 0's or fewer 1's
Then the output is either 0 or Left-Center-Right for the single bit set.

For the L-R-C = 1 , 10 11..
if its 000 or 111 then map = 0 or 1 and out = 0 = 2 bits total , so it compresses a bit
if only the left bit is set the out is map + "1" , so it compresses a bit..

if its R-C then the out is 3 bits , map + 10 or 11 , = 3 bits , so no compression..
Last edited by albert on Apr 02, 2021 16:44, edited 2 times in total.
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Dodicat Zlib

Post by dodicat »

Thanks Albert.
Maybe just perfect your code and optimise it for speed on your own.
It'll be more satisfying doing it that way for you anyway.
Maybe coderjeff will allow you an occasional forum post on the subject once a month or so.
There is no sense in continual posting and posting, you are just getting the moderators annoyed - again.
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Dodicat Zlib

Post by albert »

@Dodicat

With 3 bits in:
For the "which bit is set" : None - Left - Center - Right = 0 , 1 , 10 11..

You end up with a bunch of 1111's , and you can't tell a 1 from a 11..

Back to the drawing board.....

I tried setting it to 0 , L , C , R , it expanded....
0 - L - C - R = 4 * 4 = 16 possible values.. That's 4 bits.. so it would expand , is my guess..

( 0 , 1 , 101 , 1001 ) , Compresses 1% per loop , but it's too slow to be useful.. and the 0 , 1 , might add up to 101 ???
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Yah-Zip

Post by albert »

@everyone

I finally got compression.... Works on all sizes of input at or above , 2,000 bytes.

Compresses 1,000,000 bytes , all the way down to 3,800 bytes , after 100 loops..
Takes close to 25 seconds.. Got to speed it up...

Dodicat ; can you work your macro magic ?? and speed it up...
Takes 250 seconds to do 10,000,000 bytes.. I'd like to do whole movie files , several Giga-Bytes..
Each time you add a 0 to the input len it takes 10x longer to compress.. Can't have people waiting 25,000 seconds to compress a gigabyte..

=====================================
n1 = "00000000" + bin( *ubp )
n1 = right( n1 , 8 )

s1 = ltrim( n1 , "1" )
if len( s1 ) < 8 then s1 = "1" + s1

s2 = n1

if s2 < s1 then
*ubp = val( "&B" + s2 )
else
map[ a ] = 49
*ubp = val( "&B" + s1 )
end if

ubp+= 1
=====================================


Here's you Zlib code doing 1,000,000 bytes input...

Code: Select all


' YAH-ZIP
'
' Writen in FreeBasic for Windows
'
'Zlibrary code by Dodicat , From Scottland
'
' compress_loop() , decompress_loop by Albert Redditt U.S.A

'albert_redditt@yahoo.com

Declare Function   compress_loop( chrs as string ) as string
Declare Function decompress_loop( chrs as string ) as string


Namespace Zlibrary

#define Z_NO_COMPRESSION         0
#define Z_BEST_SPEED             1
#define Z_BEST_COMPRESSION       9
#define Z_DEFAULT_COMPRESSION  (-1)

#inclib "zlib"
Extern "C"
    Declare Function compressBound(Byval sourceLen As Ulong) As Ulong
    Declare Function uncompress(Byval dest As Ubyte Ptr, Byval destLen As Uinteger Ptr, Byval source As  Ubyte Ptr, Byval sourceLen As Ulong) As Long
    Declare Function compress(Byval dest As Ubyte Ptr, Byval destLen As Uinteger Ptr, Byval source As  Ubyte Ptr, Byval sourceLen As Ulong) As Long
    declare function compress2(byval dest as ubyte ptr, byval destLen as uinteger ptr, byval source as const ubyte ptr, byval sourceLen as uLong, byval level as long) as long
End Extern

Function getpassedinfo(text As String,Byref passed_length As Integer) As String
    Dim As String var1,var2
    Dim As Integer pst
    #macro splice(stri,char,var1,var2)
    pst=Instr(stri,char)
    var1="":var2=""
    If pst<>0 Then
        var1=Mid(stri,1,pst-1)
        var2=Mid(stri,pst+1)
    Else
        var1=stri
    End If
    #endmacro
    splice(text,"|",var1,var2)
    text=var2
    passed_length=Valint(var1)
    Return text
End Function


'=================   UNPACK ===============
Function unpack(file As String) As String
    Dim As Integer passed_length
    Dim As String text=getpassedinfo(file,passed_length)
    Dim As Integer stringlength,destinationlength
    stringlength=Len(text)
    destinationlength =passed_length
    Dim As Ubyte Ptr source
    Dim As Ubyte Ptr  destination =Callocate(destinationlength,1)
    source=@text[0]
    Var mistake=uncompress(destination,@destinationlength, source, stringlength)
    If mistake<>0 Then Print "There was an error":Sleep:End
    Dim As String uncompressed
    uncompressed=String(destinationlength,0)
    For i As Integer = 0 To destinationlength- 1
        uncompressed[i]=(destination[i])
    Next
    Deallocate destination
    Return uncompressed
End Function

'===================  PACK ============
Function pack(file As String) As String
    Dim As String text=file
    Dim As Integer stringlength,destinationlength
    stringlength=Len(text)
    destinationlength = compressBound(stringlength)
    Dim As Ubyte Ptr source
    Dim As Ubyte Ptr destination =Callocate(destinationlength,1)
    source=@text[0]
    Var mistake=compress2(destination, @destinationlength, source, stringlength,Z_BEST_COMPRESSION)''<----  use compress2
    If mistake <>0 Then Print "There was an error"
    Dim As String compressed
    compressed=String(destinationlength,0)
    For n As Integer=0 To destinationlength-1
        compressed[n]=destination[n]
    Next n
    compressed=stringlength &"|"+compressed
    Deallocate destination
    Return compressed
End Function

End Namespace

using Zlibrary

'==================================================================
'==================================================================
'test zipper
'==================================================================
'==================================================================
screen 19

Dim Shared As String s

Randomize

s=""
dim as string check=""
dim as string compare=""
dim as longint length = 0
dim as double compression = 0
dim as longint loops = 0

dim as double time1 , time2

time1 = timer
do
   
    loops+=1
   
    'one time run , create initial string
    if loops = 1 then
        randomize int( rnd * 1e9 )
        s = space( 1000000 )
        For n As Long = 0 to len( s ) - 1 step 1
            s[ n ] = Int( rnd * 256 )
        Next
        compare =  s
        length = len(s)
    else
        'modify compression to make further compression possible
       
        s = compress_loop(s)
   
    end if
    check = s
    compression = (100 - ( 100 / ( length / len(check) ) ))
   
    Print "original string"
    Print Len(s)
    Print
   
    Dim As String compressed=Zlibrary.pack(s)
    s = compressed
   
    Print "packed string "
    Print Len(compressed)
    Print
   
    Dim As String uncompressed=Zlibrary.unpack(compressed)
   
    Print "Retrieve"
    Print Len(uncompressed)
    Print
    'Print "compression ratio  "; 100 - ( 100 / ( Len(s) / len(compressed) ) ) ; "%"
    Print "compression ratio  "; 100 - ( 100 / ( length / len(s) ) ) ; "%"
    Print Iif(uncompressed=check,"OK","ERROR")
    Print "-------------------------------"
   
    'sleep 1000
   
    'if loops > 2 and (100 - ( 100 / ( length / len(s) ) )) < compression then exit do
   
    print "press esc to exit."
    print
    print "press a key for next compression." ; " loops = " ; loops ; " out of 100"
    'sleep
   
    if inkey = chr(27) then exit do
   
loop until loops = 100
time2 = timer

print
print  "Compress time = " ; time2 - time1
print
print "Press a key to decompress."
sleep

s = str(loops) + "_" + s ' save as an output file...

'==================================================================
'decompress
'==================================================================
dim as longint dec = instr(1,s,"_")
dim as longint count = val(left(s,dec-1))
dim as string comp = mid(s,dec+1)
dim as string val1
dim as string outs
for a as longint = count to 2 step -1
    s = Zlibrary.unpack(comp)
    outs = decompress_loop(s)
    comp = outs
next

comp = Zlibrary.unpack(comp)

print
print "input = "; length , "output = " ; len(comp) , "compression ratio  "; 100 - ( 100 / ( length / len(s) ) ) ; "%"
print
if comp = compare then print "Decompression successful." else print "ERROR"
print
print
Print "!!~~Done~~!!"

Sleep
end
'===============================================================================
'============================,===================================================
'begin functions
'===============================================================================
'================='==============================================================
Function compress_loop( chrs as string ) as string
   
    print "c inp = " ; len(chrs) ' , chrs
   
    dim as string map = string( len( chrs ) , "0" )
    dim as string s1 , s2
    dim as string n1
    dim as string zeros = string( 8 , "0" )
    dim as ubyte ptr ubp = cptr( ubyte ptr , strptr( chrs ) )
    for a as longint = 0 to len( chrs ) - 1 step 1
        
        n1 = "00000000" + bin( *ubp )
        n1 = right( n1 , 8 )
        
        s1 = ltrim( n1 , "1" )
        if len( s1 ) < 8 then s1 = "1" + s1
        
        s2 = n1
        
        if s2 < s1 then
             *ubp = val( "&B" + s2 )
        else 
            map[ a ] = 49
            *ubp = val( "&B" + s1 )
        end if
        
        ubp+= 1
        
    next
   
    print "c out = " ; len( chrs ) ' , chrs
    print "c map = " ; len( map ) ' , map

    dim as string final = chrs
    'for a as longint = 1 to len( outs ) step 2
    '    final+= chr( val( "&H" + mid( outs , a , 2 ) ) )
    'next
    final+= "END"
    for a as longint = 1 to len( map ) step 8
        final+= chr( val( "&B" + mid( map , a , 8 ) ) )
    next
    
    print "c fin = " ; len( final )
   
    return final
   
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
   
    print
    print "d inp = " ; len( chrs )

    return chrs
   
end function


!!~~EDITED~~!!
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Dodicat Zlib

Post by albert »

It might not work after all...

s1 = ltrim( n1 , "1" )
if len( s1 ) < 8 then s1 = "1" + s1

s2 = ltrim( n1 , "0" )

if s2 < s1 then
*ubp = val( "&B" + s2 )
else
map[ a ] = 49
*ubp = val( "&B" + s1 )
end if

if you make "if s2 < s1 then" , equal "if s2 <= s1 then".. It expands 4% instead of compressing by 5% ?????

.
coderJeff
Site Admin
Posts: 4313
Joined: Nov 04, 2005 14:23
Location: Ontario, Canada
Contact:

Re: Dodicat Zlib

Post by coderJeff »

dodicat wrote:Maybe just perfect your code and optimise it for speed on your own.
albert wrote:It might not work after all...
If you would write the decompress loop you would probably figure this out.
I may have mentioned before in other posts: if you remove any bits you need someway of knowing how many to put back later. ltrim() removes bits but the number to add or original length is never saved anywhere.

Let's call this your one compression post for the month.
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Dodicat Zlib

Post by albert »

@Any One

@CoderJeff , i posted the fix at the same time you posted the above..


I got it fixed. It's back to compressing

But now it only compresses 1,000,000 by 92% (~8,000 bytes. ) after 100 loops.. and it takes 55 seconds.

Is there a way to speed it up???

dim as string map = string( len( chrs ) , "0" )
dim as string s1 , s2
dim as string n1
dim as ubyte ptr ubp = cptr( ubyte ptr , strptr( chrs ) )
for a as longint = 0 to len( chrs ) - 1 step 1

n1 = "00000000" + bin( *ubp )
n1 = right( n1 , 8 )

s1 = ""
s2 = ""
if n1[ 0 ] = 48 then
s1 = ltrim( n1 , "0" )
if s1 = "" then s1 = "0"
*ubp = val( "&B" + s1 )
else
s2 = "1" + ltrim( n1 , "1" )
map[ a ] = 49
*ubp+= val( "&B" + s2 )
end if

ubp+= 1

next

Here's 1,000,000 bytes in Dodicat's Zlib code.

Code: Select all


' YAH-ZIP
'
' Writen in FreeBasic for Windows
'
'Zlibrary code by Dodicat , From Scottland
'
' compress_loop() , decompress_loop by Albert Redditt U.S.A

'albert_redditt@yahoo.com

Declare Function   compress_loop( chrs as string ) as string
Declare Function decompress_loop( chrs as string ) as string


Namespace Zlibrary

#define Z_NO_COMPRESSION         0
#define Z_BEST_SPEED             1
#define Z_BEST_COMPRESSION       9
#define Z_DEFAULT_COMPRESSION  (-1)

#inclib "zlib"
Extern "C"
    Declare Function compressBound(Byval sourceLen As Ulong) As Ulong
    Declare Function uncompress(Byval dest As Ubyte Ptr, Byval destLen As Uinteger Ptr, Byval source As  Ubyte Ptr, Byval sourceLen As Ulong) As Long
    Declare Function compress(Byval dest As Ubyte Ptr, Byval destLen As Uinteger Ptr, Byval source As  Ubyte Ptr, Byval sourceLen As Ulong) As Long
    declare function compress2(byval dest as ubyte ptr, byval destLen as uinteger ptr, byval source as const ubyte ptr, byval sourceLen as uLong, byval level as long) as long
End Extern

Function getpassedinfo(text As String,Byref passed_length As Integer) As String
    Dim As String var1,var2
    Dim As Integer pst
    #macro splice(stri,char,var1,var2)
    pst=Instr(stri,char)
    var1="":var2=""
    If pst<>0 Then
        var1=Mid(stri,1,pst-1)
        var2=Mid(stri,pst+1)
    Else
        var1=stri
    End If
    #endmacro
    splice(text,"|",var1,var2)
    text=var2
    passed_length=Valint(var1)
    Return text
End Function


'=================   UNPACK ===============
Function unpack(file As String) As String
    Dim As Integer passed_length
    Dim As String text=getpassedinfo(file,passed_length)
    Dim As Integer stringlength,destinationlength
    stringlength=Len(text)
    destinationlength =passed_length
    Dim As Ubyte Ptr source
    Dim As Ubyte Ptr  destination =Callocate(destinationlength,1)
    source=@text[0]
    Var mistake=uncompress(destination,@destinationlength, source, stringlength)
    If mistake<>0 Then Print "There was an error":Sleep:End
    Dim As String uncompressed
    uncompressed=String(destinationlength,0)
    For i As Integer = 0 To destinationlength- 1
        uncompressed[i]=(destination[i])
    Next
    Deallocate destination
    Return uncompressed
End Function

'===================  PACK ============
Function pack(file As String) As String
    Dim As String text=file
    Dim As Integer stringlength,destinationlength
    stringlength=Len(text)
    destinationlength = compressBound(stringlength)
    Dim As Ubyte Ptr source
    Dim As Ubyte Ptr destination =Callocate(destinationlength,1)
    source=@text[0]
    Var mistake=compress2(destination, @destinationlength, source, stringlength,Z_BEST_COMPRESSION)''<----  use compress2
    If mistake <>0 Then Print "There was an error"
    Dim As String compressed
    compressed=String(destinationlength,0)
    For n As Integer=0 To destinationlength-1
        compressed[n]=destination[n]
    Next n
    compressed=stringlength &"|"+compressed
    Deallocate destination
    Return compressed
End Function

End Namespace

using Zlibrary

'==================================================================
'==================================================================
'test zipper
'==================================================================
'==================================================================
screen 19

Dim Shared As String s

Randomize

s=""
dim as string check=""
dim as string compare=""
dim as longint length = 0
dim as double compression = 0
dim as longint loops = 0

dim as double time1 , time2

time1 = timer
do
   
    loops+=1
   
    'one time run , create initial string
    if loops = 1 then
        randomize int( rnd * 1e9 )
        s = space( 1000000 )
        For n As Long = 0 to len( s ) - 1 step 1
            s[ n ] = Int( rnd * 256 )
        Next
        compare =  s
        length = len(s)
    else
        'modify compression to make further compression possible
       
        s = compress_loop(s)
   
    end if
    check = s
    compression = (100 - ( 100 / ( length / len(check) ) ))
   
    Print "original string"
    Print Len(s)
    Print
   
    Dim As String compressed=Zlibrary.pack(s)
    s = compressed
   
    Print "packed string "
    Print Len(compressed)
    Print
   
    Dim As String uncompressed=Zlibrary.unpack(compressed)
   
    Print "Retrieve"
    Print Len(uncompressed)
    Print
    'Print "compression ratio  "; 100 - ( 100 / ( Len(s) / len(compressed) ) ) ; "%"
    Print "compression ratio  "; 100 - ( 100 / ( length / len(s) ) ) ; "%"
    Print Iif(uncompressed=check,"OK","ERROR")
    Print "-------------------------------"
   
    'sleep 1000
   
    'if loops > 2 and (100 - ( 100 / ( length / len(s) ) )) < compression then exit do
   
    print "press esc to exit."
    print
    print "press a key for next compression." ; " loops = " ; loops ; " out of 100"
    'sleep
   
    if inkey = chr(27) then exit do
   
loop until loops = 100
time2 = timer

print
print  "Compress time = " ; time2 - time1
print
print "Press a key to decompress."
sleep

s = str(loops) + "_" + s ' save as an output file...

'==================================================================
'decompress
'==================================================================
dim as longint dec = instr(1,s,"_")
dim as longint count = val(left(s,dec-1))
dim as string comp = mid(s,dec+1)
dim as string val1
dim as string outs
for a as longint = count to 2 step -1
    s = Zlibrary.unpack(comp)
    outs = decompress_loop(s)
    comp = outs
next

comp = Zlibrary.unpack(comp)

print
print "input = "; length , "output = " ; len(comp) , "compression ratio  "; 100 - ( 100 / ( length / len(s) ) ) ; "%"
print
if comp = compare then print "Decompression successful." else print "ERROR"
print
print
Print "!!~~Done~~!!"

Sleep
end
'===============================================================================
'============================,===================================================
'begin functions
'===============================================================================
'================='==============================================================
Function compress_loop( chrs as string ) as string
   
    print "c inp = " ; len(chrs) ' , chrs
   
    dim as string map = string( len( chrs ) , "0" )
    dim as string s1 , s2
    dim as string n1
    dim as ubyte ptr ubp = cptr( ubyte ptr , strptr( chrs ) )
    for a as longint = 0 to len( chrs ) - 1 step 1
        
        n1 = "00000000" + bin( *ubp )
        n1 = right( n1 , 8 )
        
        s1 = ""
        s2 = ""
        if n1[ 0 ] = 48 then 
            s1 = ltrim( n1 , "0" )
            if s1 = "" then s1 = "0"
            *ubp = val( "&B" + s1 )
        else
            s2 = "1" + ltrim( n1 , "1" )
            map[ a ] = 49
            *ubp+= val( "&B" + s2 )
        end if
        
        ubp+= 1
    
    next
   
    print "c out = " ; len( chrs ) ' , chrs
    print "c map = " ; len( map ) ' , map

    dim as string final = chrs
    'for a as longint = 1 to len( outs ) step 2
    '    final+= chr( val( "&H" + mid( outs , a , 2 ) ) )
    'next
    final+= "END"
    for a as longint = 1 to len( map ) step 8
        final+= chr( val( "&B" + mid( map , a , 8 ) ) )
    next
    
    print "c fin = " ; len( final )
   
    return final
   
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
   
    print
    print "d inp = " ; len( chrs )

    return chrs
   
end function

Locked