## Dodicat Zlib

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

### Re: Dodicat Zlib

@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 19dim as double time_s , time_edo        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 )sleepend  `
albert
Posts: 5977
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Dodicat Zlib

@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: 6888
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: Dodicat Zlib

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: 5977
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Dodicat Zlib

@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: 5977
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Dodicat Zlib

@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: 5977
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Dodicat Zlib

@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: 5977
Joined: Sep 28, 2006 2:41
Location: California, USA

### Yah-Zip

@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 = 49 then s1+= "1" : v1+= 1
if n1 = 49 then s1+= "10" : v1+= 1
if n1 = 49 then s1+= "11" : v1+= 1

s2 = ""
v2 = 0
if n1 = 48 then s2+= "1" : v2+= 1
if n1 = 48 then s2+= "10" : v2+= 1
if n1 = 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.comDeclare Function   compress_loop( chrs as string ) as stringDeclare Function decompress_loop( chrs as string ) as stringNamespace 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 longEnd ExternFunction 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 textEnd 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    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 uncompressedEnd 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    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 compressedEnd FunctionEnd Namespaceusing Zlibrary'=================================================================='=================================================================='test zipper'=================================================================='==================================================================screen 19Dim Shared As String sRandomizes=""dim as string check=""dim as string compare=""dim as longint length = 0dim as double compression = 0dim as longint loops = 0dim as double time1 , time2time1 = timerdo       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 = 100time2 = timerprintprint  "Compress time = " ; time2 - time1printprint "Press a key to decompress."sleeps = 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 val1dim as string outsfor a as longint = count to 2 step -1    s = Zlibrary.unpack(comp)    outs = decompress_loop(s)    comp = outsnextcomp = Zlibrary.unpack(comp)printprint "input = "; length , "output = " ; len(comp) , "compression ratio  "; 100 - ( 100 / ( length / len(s) ) ) ; "%"printif comp = compare then print "Decompression successful." else print "ERROR"printprintPrint "!!~~Done~~!!"Sleepend'==============================================================================='============================,==================================================='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 = 49 then s1+= "1" : v1+= 1        if n1 = 49 then s1+= "10" : v1+= 1        if n1 = 49 then s1+= "11" : v1+= 1                s2 = ""        v2 = 0        if n1 = 48 then s2+= "1" : v2+= 1        if n1 = 48 then s2+= "10" : v2+= 1        if n1 = 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: 3456
Joined: Nov 04, 2005 14:23
Location: Ontario, Canada
Contact:

### Re: Dodicat Zlib

@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: 5977
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Dodicat Zlib

@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: 6888
Joined: Jan 10, 2006 20:30
Location: Scotland

### Re: Dodicat Zlib

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: 5977
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Dodicat Zlib

@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 ???

Return to “General”

### Who is online

Users browsing this forum: No registered users and 14 guests