Squares

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

Re: Squares

@Dodicat

I found the problem...

outs1+= hex( val( "&B " + n2 ) )

There's a space after the B ,

Now it doesn't compress.. I couldn't figure out why it was compressing 30% on loop 1
bfuller
Posts: 339
Joined: Jun 02, 2007 12:35
Location: Sydney, Australia

Re: Squares

Albert,

did you download the book on numbers? With your brilliant mind, I am sure you could write a program for each chapter. Would be fun for you and you might even stumble on a new way of compressing things.

http://www.plouffe.fr/simon/Phys%20et%2 ... umbers.pdf
dodicat
Posts: 6728
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Chapter 15 is dedicated to squares.
I have completely lost the site.
Strange that when I was a book user I could go back years to so some topic with ease.
Just scan the book shelf to trigger a memory, and get the book down.
But now, even with bookmarking a site, things get lost.
Probably far too much information available or I am loosing some marbles.
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Yah-Zip ( Test Bed )

@Dodicat

I've got another formula that compresses... Compresses 100,000 bytes in by 98% after 100 loops..

I've got to figure out where to add and where to subtract... Got to solve the yellow values.

Here's the "Test Bed" where i write the decompression...

Code: Select all

`Declare Function      compress_loop( chrs as string ) as stringDeclare Function decompress_loop( chrs as string ) as stringscreen 19'====================================================================='====================================================================='start program'====================================================================='=====================================================================dim as double time1 , time2 , time3 , time4do       randomize       dim as string s = ""    For n As Long = 1 To 8        s+=chr(Int(Rnd*256))    Next       time1=timer    'begin compress        dim as string comp = s            'do            '    dim as longint chk = len(comp) - 1            '    comp = compress_loop(comp)            '    if len(comp) >= chk then exit do            '    if inkey = chr( 27 ) then end            'loop            for a as longint = 1 to 1 step 1                comp = compress_loop(comp)            next    'end compress    time2 = timer       time3=timer    'begin decompress        dim as string final_out = comp        for a as longint = 1 to 1 step 1            final_out = decompress_loop(final_out)        next    'end decompress    time4 = timer      'sleep       print string(99,"=")    print "inp = " ; (s)    print string(99,"=")    print "out = " ; (final_out)    print    print "compress time   = "; time2-time1    print "decompress time = "; time4-time3    print       if s = final_out then print "Decompressed OK" else print "Decompression failed."    print string(99,"=")       sleep   loop until inkey = chr(27)sleepend'==============================================================================='==============================================================================='compress'==============================================================================='===============================================================================Function compress_loop( chrs as string ) as string       print "c inp = " ; len(chrs) ' , chrs        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 bin = " ; len( bits ) , ' , bits    for a as longint = 1 to len( bits ) step 4        print mid( bits , a , 4 )  ; " " ;    next    print        dim as string outs1 = ""    dim as string outs2 = ""    dim as longint v1 , v2    for a as longint = 1 to len( bits ) step 8                n1 = mid( bits , a , 8 )                v1 = val( "&B" + mid( n1 , 1 , 4 ) )        v2 = val( "&B" + mid( n1 , 5 , 4 ) )                if v1 <= v2 then outs1+= hex( v1 ) + hex( v2 - v1 )        if v1 >   v2 then outs1+= hex( v1 ) + hex( v1 - v2 )                'print        'print n1        'print outs1        'print outs2        'sleep        'if inkey = " " then end            next        print "d bin = " ; len( outs1 ) , ', outs1    for a as longint = 1 to len( outs1 ) step 1        n1 = right( "0000" + mid( outs1 , a , 1 ) , 4 )        print n1 ; " " ;    next    print        dim as string final = ""    for a as longint = 1 to len( outs1 ) step 2        final+= chr( val( "&H" + mid( outs1 , a , 2 ) ) )    next    'for a as longint = 1 to len( outs2 ) step 8    '    final+= chr( val( "&B" + mid( outs2 , a , 8 ) ) )    'next        print "c fin = " ; len( final )       return final   end function'==============================================================================='============================================================================Function decompress_loop( chrs as string ) as string        print "d inp = " ; len( chrs )            dim as string bits = ""    dim as string zeros = string( 2 , "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 + hex( *ubp ) : ubp+= 1        n1 = right( n1 , 2 )        bits+=n1    next        print "d bin = " ; len( bits ) , ', bits        for a as longint = 1 to len( bits ) step 1        n1 = right( "0000" + mid( bits , a , 1 ) , 4 )        if a mod 2 = 1 then color 11 else color 14        print n1 ; " " ;    next    color 15    print            return chrs   end function`
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Yah-Zip ( Test Bed )

@Dodicat

I altered it some.....Now it only compresses 100,000 bytes in by 64% after 100 loops. : takes about 20 seconds

===================================================
n1 = mid( bits , a , 8 )

v1 = val( "&B" + mid( n1 , 1 , 4 ) )
v2 = val( "&B" + mid( n1 , 5 , 4 ) )

if v1 <= v2 then outs1+= hex( v1 ) + hex( v2 )
if v1 > v2 then outs1+= hex( v1 ) + hex( v1 - v2 )
===================================================

If v1 <= v2 then the output is normal v1 + v2
if v1 > v2 then the output is v1 + ( v1 - v2 )

Got to solve the yellow values...

Here's the "Test Bed" where i write the decompression..

Code: Select all

`Declare Function      compress_loop( chrs as string ) as stringDeclare Function decompress_loop( chrs as string ) as stringscreen 19'====================================================================='====================================================================='start program'====================================================================='=====================================================================dim as double time1 , time2 , time3 , time4do       randomize       dim as string s = ""    For n As Long = 1 To 8        s+=chr(Int(Rnd*256))    Next       time1=timer    'begin compress        dim as string comp = s            'do            '    dim as longint chk = len(comp) - 1            '    comp = compress_loop(comp)            '    if len(comp) >= chk then exit do            '    if inkey = chr( 27 ) then end            'loop            for a as longint = 1 to 1 step 1                comp = compress_loop(comp)            next    'end compress    time2 = timer       time3=timer    'begin decompress        dim as string final_out = comp        for a as longint = 1 to 1 step 1            final_out = decompress_loop(final_out)        next    'end decompress    time4 = timer      'sleep       print string(99,"=")    print "inp = " ; (s)    print string(99,"=")    print "out = " ; (final_out)    print    print "compress time   = "; time2-time1    print "decompress time = "; time4-time3    print       if s = final_out then print "Decompressed OK" else print "Decompression failed."    print string(99,"=")       sleep   loop until inkey = chr(27)sleepend'==============================================================================='==============================================================================='compress'==============================================================================='===============================================================================Function compress_loop( chrs as string ) as string       print "c inp = " ; len(chrs) ' , chrs        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 bin = " ; len( bits ) , ' , bits    for a as longint = 1 to len( bits ) step 4        print mid( bits , a , 4 )  ; " " ;    next    print        dim as string outs1 = ""    dim as string outs2 = ""    dim as longint v1 , v2    for a as longint = 1 to len( bits ) step 8                n1 = mid( bits , a , 8 )                v1 = val( "&B" + mid( n1 , 1 , 4 ) )        v2 = val( "&B" + mid( n1 , 5 , 4 ) )                if v1 <= v2 then outs1+= hex( v1 ) + hex( v2 )        if v1 >   v2 then outs1+= hex( v1 ) + hex( v1 - v2 )                'print        'print n1        'print outs1        'print outs2        'sleep        'if inkey = " " then end            next        print "d bin = " ; len( outs1 ) , ', outs1    for a as longint = 1 to len( outs1 ) step 1        n1 = right( "0000" + mid( outs1 , a , 1 ) , 4 )        print n1 ; " " ;    next    print        dim as string final = ""    for a as longint = 1 to len( outs1 ) step 2        final+= chr( val( "&H" + mid( outs1 , a , 2 ) ) )    next    'for a as longint = 1 to len( outs2 ) step 8    '    final+= chr( val( "&B" + mid( outs2 , a , 8 ) ) )    'next        print "c fin = " ; len( final )       return final   end function'==============================================================================='============================================================================Function decompress_loop( chrs as string ) as string        print "d inp = " ; len( chrs )            dim as string bits = ""    dim as string zeros = string( 2 , "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 + hex( *ubp ) : ubp+= 1        n1 = right( n1 , 2 )        bits+=n1    next        print "d bin = " ; len( bits ) , ', bits        for a as longint = 1 to len( bits ) step 1        n1 = right( "0000" + mid( bits , a , 1 ) , 4 )        if a mod 2 = 1 then color 11 else color 14        print n1 ; " " ;    next    color 15    print        return chrs   end function`
angros47
Posts: 1756
Joined: Jun 21, 2005 19:04

Re: Squares

albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

@Dodicat

Never mind....

If v1 <= v2 then the output is normal v1 + v2
if v1 > v2 then the output is v1 + ( v1 - v2 )

if v2 = 0 then outputs = v1 , ( v1 - v2 ) It comes out to an equate.. like the first case.. no way to solve it..
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

@angros47

Hutter with an udder.. I'd like to win that prize!!!

One thought..

If you bring in a byte , input = bin( str[ 0 ] ) , The input has to start with a 1 unless the byte is 0
So you can lose the first bit... But if that first bit is followed by 0's then you don't know how many zeros to add back in....
You just know you have to add a 1 to the front...
D.J.Peters
Posts: 8190
Joined: May 28, 2005 3:28
Contact:

Re: Squares

@angros47 i donloaded the one GB xml/text file.
On a older PC with WIN 10 4GB VisualCode, Geany, FBIDE, MS Editor, FireFox all creasched while opening the file exept an Hex-Editor I'm in love with :-)

Than I reboot in Linux the simple editor gEdit does the job perfect including syntax highlighting.

I'm suree VisualCode and Geany crashed while highlighting the GB at once.

By the way I hate you, I try to compress the beast again and again, without your post my life would be much more lovely :-)

Joshy
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Yah-Zip ( Alter Bin )

@Richard
@Dodicat

I think I've finally done it... Compresses 100,000 bytes in by 80+% after 100 loops : Takes about 4 to 10 seconds...

( I need some help with the decompression... )

===================================
bits = character string converted to binary.

n1 = mid( bits , a , 6 )

s1 = 0
if n1[ 0 ] = 49 then s1+= 28
if n1[ 1 ] = 49 then s1+= 14
if n1[ 2 ] = 49 then s1+= 7
if n1[ 3 ] = 49 then s1+= 5
if n1[ 4 ] = 49 then s1+= 3
if n1[ 5 ] = 49 then s1+= 1

outs1+= chr( s1 )
===================================

I think I've checked all the possible values , so there's no duplicates..

Here it is doing 100,000 bytes in , in Dodicat's Zlib code...

Code: Select all

`' YAH-ZIP ( Alter Bin ) '' Writen in FreeBasic for Windows''Zlibrary code by Dodicat , From Scottland'' compress_loop() , decompress_loop by Albert ReddittDeclare Function   compress_loop( chrs as string ) as stringDeclare Function decompress_loop( chrs as string ) as stringNamespace Zlibrary#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 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[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 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[0]    Var mistake=compress(destination, @destinationlength, source, stringlength)    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 Namespace'=================================================================='=================================================================='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        For n As Long = 1 To 100000            s+=chr(Int(Rnd*256))'+48        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        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 bin = " ; len( bits ) ' , bits        dim as ubyte count = 0    dim as string str1    dim as ubyte dec1    do        str1 = str( len( bits ) / 6 )        dec1 = instr( 1 , str1 , "." )        if dec1 <> 0 then bits+= "0" : count+= 1    loop until dec1 = 0        dim as string outs1 = ""    dim as longint s1    for a as longint = 1 to len( bits ) step 6                n1 = mid( bits , a , 6 )                s1 = 0        if n1[ 0 ] = 49 then s1+=  28        if n1[ 1 ] = 49 then s1+=  14        if n1[ 2 ] = 49 then s1+=    7        if n1[ 3 ] = 49 then s1+=    5        if n1[ 4 ] = 49 then s1+=    3         if n1[ 5 ] = 49 then s1+=    1                outs1+= chr( s1 )                'print n1 , s1        'sleep        'if inkey = " " then end            next        print "c out = " ; len( outs1 ) ' , outs1    dim as string final = outs1        final = chr( count ) + final        print "c fin = " ; len(final)       return final   end function'==============================================================================='============================================================================Function decompress_loop( chrs as string ) as string        print    print "d inp = " ; len( chrs )        dim as ubyte count = asc( left( chrs , 1 ) ) : chrs = mid( chrs , 2 )        dim as string bits = ""    dim as longint v1    for a as longint = 1 to len( chrs ) step 1                v1 = chrs[ a - 1 ]                'NEED TO SOLVE VALUES...                    next            return chrs    end function`
Posts: 2154
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Yah-Zip ( Alter Bin )

albert wrote:I think I've checked all the possible values , so there's no duplicates..

"001110" and "010001" both result in 15

And there are more:

Code: Select all

`dim as integer bits, s1dim as string n1for bits = 0 to &b111111   n1 = bin(bits, 6)   s1 = 0   if n1[ 0 ] = 49 then s1+= 28   if n1[ 1 ] = 49 then s1+= 14   if n1[ 2 ] = 49 then s1+= 7   if n1[ 3 ] = 49 then s1+= 5   if n1[ 4 ] = 49 then s1+= 3   if n1[ 5 ] = 49 then s1+= 1   print n1, s1next`
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Sorry , it was a badidea!!
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Yah-Zip

@Dodicat

I think i got it this time...

if mid( outs2 , a , 1 ) = "0" then you pull a value from outs1 ( 0 , 1 , 2 )
if mid( outs2 , a , 1 ) = "1" then you insert a "11" at that location

Here's Dodicat's Zlib code doing 100,000 bytes in over 50 loops.. ( compresses 99+% )

Code: Select all

`' YAH-ZIP'' Writen in FreeBasic for Windows''Zlibrary code by Dodicat , From Scottland'' compress_loop() , decompress_loop by Albert ReddittDeclare Function   compress_loop( chrs as string ) as stringDeclare Function decompress_loop( chrs as string ) as stringNamespace Zlibrary#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 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[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 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[0]    Var mistake=compress(destination, @destinationlength, source, stringlength)    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 Namespace'=================================================================='=================================================================='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        For n As Long = 1 To 100000            s+=chr(Int(Rnd*256))'+48        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 50."    'sleep        if inkey = chr(27) then exit do   loop until loops = 50time2 = 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        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 bin = " ; len( bits ) ' , bits        dim as string outs1 = ""    for a as longint = 1 to len( bits ) step 2                n1 = mid( bits , a , 2 )                    if n1 = "00" then outs1+= "0" : mid( bits , a , 2 ) = "0~"        if n1 = "01" then outs1+= "1" : mid( bits , a , 2 ) = "0~"        if n1 = "10" then outs1+= "2" : mid( bits , a , 2 ) = "0~"        if n1 = "11" then mid( bits , a , 2 ) = "1~"            next    dim as string outs2 = ""    for a as longint = 1 to len( bits ) step 1        n1 = mid( bits , a , 1 )        if n1 <> "~" then outs2+= n1    next    print "c out = " ; len( outs1 ) ' , outs1    print "c out = " ; len( outs2 ) ' , outs2        dim as string final = ""    for a as longint = 1 to len( outs1 ) step 3        final+= chr( val( "&O" + mid( outs1 , a , 3 ) ) )    next    final+= "END"    for a as longint = 1 to len( outs2 ) step 8        final+= chr( val( "&B" + mid( outs1 , 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`
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Yah-Zip

I need someone to check this out for me...

For some reason it's compressing 70% on loop 1..

Can't figure it out... Did i finally get compression ????

Code: Select all

`' YAH-ZIP'' Writen in FreeBasic for Windows''Zlibrary code by Dodicat , From Scottland'' compress_loop() , decompress_loop by Albert ReddittDeclare Function   compress_loop( chrs as string ) as stringDeclare Function decompress_loop( chrs as string ) as stringNamespace Zlibrary#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 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[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 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[0]    Var mistake=compress(destination, @destinationlength, source, stringlength)    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 Namespace'=================================================================='=================================================================='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        For n As Long = 1 To 1000000            s+=chr(Int(Rnd*256))'+48        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        dim as string outs1 = ""    dim as string outs2 = ""    dim as string n1    dim as longint v1    dim as ubyte ptr ubp = cptr( ubyte ptr , strptr( chrs ) )    for a as longint = 1 to len( chrs ) step 1                n1 = bin( *ubp ) : ubp+= 1                v1 = instr( 1 , n1 , "0" )                outs1+= mkshort( val( "1" + "&B" + mid( n1 , v1 ) ) )        outs2+= str( v1 )            next        print "c out = " ; len( outs1 ) ' , outs1    print "c out = " ; len( outs2 ) ' , outs2    dim as string final = outs1    'for a as longint = 1 to len( outs1 ) step 3    '    final+= chr( val( "&O" + mid( outs1 , a , 3 ) ) )    'next    final+= "END"    for a as longint = 1 to len( outs2 ) step 2        final+= chr( val( mid( outs2 , a , 2 ) ) )    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`
dodicat
Posts: 6728
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Albert.
A compressor but without a decompressor.
I could take a note of the swaps, write to a separate file and compress this.
Then use the two files to get back.
Maybe I'll try it out tomorrow.

Code: Select all

`#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 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[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 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[0]    Var mistake=compress(destination, @destinationlength, source, stringlength)    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 FunctionEnum    up    downEnd Enumdim shared as long directiondirection=upsub sort(s As string,begin As Long,Finish As Long)     Dim As Long i=begin,j=finish    Dim As ubyte x =S[(I+J)\2]    While  I <= J    if direction=down then        While S[I] > X:I+=1:Wend        While S[J] < X:J-=1:Wend    else        While S[I] < X:I+=1:Wend        While S[J] > X:J-=1:Wend    end if    If I<=J Then       Swap S[I],S[J]'todo  save the swaps i and j     I+=1:J-=1    end if    wend    If J > begin Then sort(S,begin,J)    If I < Finish Then sort(S,I,Finish)End sub#define range(f,l) int(Rnd*((l+1)-(f))+(f))dim as string f=string(500000,0)for n as long=0 to len(f)-1    f[n]=range(65,122)    nextdim as double t=timer,t2sort(f,0,len(f)-1)print fprint "Length ";len(f)var c=pack(f)printprintprint cprint "Compressed length  "; len(c)print "compression  ";len(c)/len(f)var orig=unpack(c)print "Decompress length "; len(orig)t2=timerprint "Total time  ";t2-tprint "Done"sleep `