## Squares

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

### Yah-Zip

@Richard
@Dodicat

( !!~~ COMPRESSION SUCCESS ~~!! )

Maybe this will win the Hutter Prize , and get me a Nobel Prize in "Computer Science"

I finally got some actual compression....

It requires 5,000,000 or more bytes to compress... less than 5,000,000 it expands...

It takes about a half minute , to do each loop...
And it only compresses a couple kilobytes , each loop...

A Giga-Byte input , should compress down to 5,000,000 , after enough loops...

==========================================
for a as longint = 1 to len( chrs ) step 1

n1 = bin( *ubp ) : ubp+= 1

if left( n1 , 2 ) = "10" then outs1+= "0"
if left( n1 , 2 ) = "11" then outs1+= "1"

outs2+= chr( val( "&B" + "1" + mid( n1 , 3 ) ) )

next
=========================================

For every char of outs2 , you need to trim the leading 1.. and look to outs1 to see if you need a 10 or 11 in front.

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 10000000            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 which = ""    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                if left( n1 , 2 ) = "10" then outs1+= "0"        if left( n1 , 2 ) = "11" then outs1+= "1"                outs2+= chr( val( "&B" + "1" + mid( n1 , 3 ) ) )            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 8        final+= chr( val( "&B" + mid( outs1 , a , 8 ) ) )    next    final+= "END" + outs2        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 Allen Redditt
315 W. Carrillo St. #104
Santa Barbara , Ca, 93101 U.S.A.
albert
Posts: 5634
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

Never mind!!

I forgot to include the case of n1 , being less than 2 bits... 0 or 1 , so it doesn't compress.

I've got another formula that does compress , I'll post it in a little while.... After i make sure it works...

.
bfuller
Posts: 335
Joined: Jun 02, 2007 12:35
Location: Sydney, Australia

### Re: Squares

@Albert,

this has been said before, by more than one person in "Squares" but you really need to look at compression from a helicopter viewpoint.

A truly random sequence of numbers really can't be compressed----but a repeating pattern can. So you need to look for repeating patterns in the data, then test if a short description of the repeating pattern and the number of repeats is smaller than the original pattern.
Take for example a picture-----if it is just random coloured dots then no realistic compression/decompression is practical----BUT, if it is a picture of a chess board, with Black and White squares in an 8x8 board then no matter how big the chess board is, it can still be faithfully reproduced as a block of black and white squares repeating. What if the picture was of a uniform blue sky, then you could compress and decompress from a big BMP to simple word describing the colour blue and the number of pixels repeated.
I am saying that with pictures, there is a lot of repeated pixels so easy to compress, and even if not identical, side by side pixels often differ by a small amount, the difference being only a few bits----until you come to a hard boundary----which is why these sort of picture algorithms end up blurring an image if used over and over. I imagine music is similar, with lots of repeats and silence between sounds.
With picture of text, there is a lot of white space (repeated pixels) and even with text itself, many languages have a lot of redundancy which is why we can read text even with every second character removed for instance, or the top cut off.
I applaud your persistence, but encourage you to to look for examples where compression is easy, not just huge. You might actually come up with a new algorithm that is useful and unique.
albert
Posts: 5634
Joined: Sep 28, 2006 2:41
Location: California, USA

### Yah-Zip

@Richard
@Dodicat

I got yet another formula that compresses.... Compresses 100,000 by 12% - 13% after 100 loops.. : Takes 4 seconds.

It's a Simple Simon formula...

"ubp" is a ushort ptr
=====================================================================
n1 = str( *ubp ) : ubp+= 1

if len( n1 ) <= 2 then outs1+= "0" + chr( val( n1 ) )

if len( n1 ) = 3 then outs1+= chr( val( left( n1 , 2 ) ) ) + chr( val( right( n1 , 1 ) ) )

if len( n1 ) = 4 then outs1+= chr( val( left( n1 , 2 ) ) ) + chr( val( right( n1 , 2 ) ) )

if len( n1 ) = 5 then outs1+= mkshort( val( n1 ) )
====================================================================

There might be a problem with the mkshort( val( n1 ) ) , if it can be undone ?? If you can tell it from the others ??

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        s = space( 100000 )        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        dim as string outs1 = ""    dim as string n1     dim as ushort ptr ubp = cptr( ushort ptr , strptr( chrs ) )    for a as longint = 1 to len( chrs ) step 2                n1 = str( *ubp ) : ubp+= 1                if len( n1 ) <= 2 then outs1+= "0" + chr( val( n1 ) )                if len( n1 ) = 3 then outs1+= chr( val( left( n1 , 2 ) ) ) + chr( val( right( n1 , 1 ) ) )                if len( n1 ) = 4 then outs1+= chr( val( left( n1 , 2 ) ) ) + chr( val( right( n1 , 2 ) ) )                 if len( n1 ) = 5 then outs1+= mkshort( val( n1 ) )            next        print "c out = " ; len( outs1 ) ' , outs1        dim as string final = outs1    'for a as longint = 1 to len( outs1 ) step 2    '    final+= chr( val( "&H" + mid( outs1 , 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`
albert
Posts: 5634
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@Dodicat

Another idea...

ubp = ubyte ptr
==========================
v1 = ( *ubp ) : ubp+= 1

v2 = v1 mod 2
v3 = v1 mod 129

v4 = ( v2 * 100 ) + v3

outs1+= chr( v4 )
=========================

mod 2 & mod 129 solves all 256 byte values...

How do you tell if v3 > 99 ??? How to undo it ??

Compresses 100,000 by 90% after 100 loops...

( Off Topic )
We've got 26 confirmed cases of Corona Virus in Santa Barbara county where i live....
They're still waiting for 150 test kits to come back , the number might go up...
There's 10 cases in Santa Barbara City where i live...
albert
Posts: 5634
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

I've got another compression formula...

Now , it's just a matter of telling if a output chr() is 7 or 8 bits ???

Compresses 100,000 bytes by 84% after 100 loops : Takes about 6 to 8 seconds.

Code: Select all

`Function compress_loop( chrs as string ) as string       print "c inp = " ; len(chrs) ' , chrs        dim as string outs1 = ""    dim as string which = ""    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 = bin( *ubp ) : ubp+= 1                if len( n1 ) <= 6 then            which+="1"            outs1+= chr( val( "&B" + n1 ) )            goto done        end if                if left( n1 , 2 ) = "10" then which+= "00"        if left( n1 , 2 ) = "11" then which+= "10"                outs1+= chr( val( "&B" + mid( n1 , 3 ) ) )                done:            next        print "c out = " ; len( outs1 ) ' , outs1    print "c out = " ; len( which ) ' , which        dim as string final = outs1 + "END"    'for a as longint = 1 to len( outs2 ) step 8    '    final+= chr( val( "&B" + mid( outs2 , a , 8 ) ) )    'next    for a as longint = 1 to len( which ) step 8        final+= chr( val( "&B" + mid( which , a , 8 ) ) )    next        print "c fin = " ; len(final)       return final   end function`
albert
Posts: 5634
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

Santa Barbara , California , U.S.A.
Now has 25 cases of Covid-19 in the city..
albert
Posts: 5634
Joined: Sep 28, 2006 2:41
Location: California, USA

### Yah-Zip ( swap )

@Dodicat

I've got another formula that compresses... compresses 100,000 bytes by 97% after 100 loops : Takes about 4 seconds...

It swaps the second and third digits , on a condition...

====================================================
n1 = "000" + str( *ubp ) : ubp+= 1
n1 = right( n1 , 3 )

n2 = n1
if n2[ 2 ] <= 53 and n2[ 1 ] >= 54 then swap n2[ 1 ] , n2[ 2 ]

outs1+= n2
===================================================

Can it be undone????

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        s = space( 100000 )        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        dim as string outs1 = ""    dim as string outs2 = ""    dim as string n1 , n2    dim as ubyte ptr ubp = cptr( ubyte ptr , strptr( chrs ) )    for a as longint = 1 to len( chrs ) step 1                n1 = "000" + str( *ubp ) : ubp+= 1        n1 = right( n1 , 3 )                n2 = n1        if n2[ 2 ] <= 53 and n2[ 1 ] >= 54 then swap n2[ 1 ] , n2[ 2 ]                outs1+= n2                'print n1 , n2        'sleep        'if inkey = " " then end            next        print "c out = " ; len( outs1 ) ' , outs1        dim as string final = ""    for a as longint = 1 to len( outs1 ) step 3        final+= chr( val( mid( outs1 , a , 3 ) ) )    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`
angros47
Posts: 1616
Joined: Jun 21, 2005 19:04

### Re: Yah-Zip ( swap )

albert wrote:Can it be undone????

No, it can't. I don't even need to check your code to know: with your premises, it's unavoidable to have duplicates: check it, and you'll find some.
albert
Posts: 5634
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@angros47

I think you mighty be right...

if n2[ 2 ] <= 53 and n2[ 1 ] >= 54 then swap n2[ 1 ] , n2[ 2 ]

if the third digit is less than 6 and the second digit is greater than 5 then swap digits..

A 146 won't swap ... 6 is greater than 5 and the 4 is less than 6
But a 164 , would swap to become a 146

So , there are duplicates..

If you just swap all the time... it also compresses , but the total can go over 255... 249 would equal 294...

Back to the drawing board....
albert
Posts: 5634
Joined: Sep 28, 2006 2:41
Location: California, USA

### Yah-Zip ( swap )

@Dodicat
@angros47

I think i got it this time.....

If the third digit is 0 , 1 , 2 then swap the first and third digits. Compresses 100,000 bytes by 35% after 100 loops : Takes like 18 seconds..

If both the first and last digits are less than 3 , then you need to swap them back..

========================================
n1 = "000" + str( *ubp ) : ubp+= 1
n1 = right( n1 , 3 )

n2 = n1
if n2[ 2 ] <= 50 then swap n2[ 0 ] , n2[ 2 ]

outs1+= n2
=======================================

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        s = space( 100000 )        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        dim as string outs1 = ""    dim as string outs2 = ""    dim as string n1 , n2    dim as ubyte ptr ubp = cptr( ubyte ptr , strptr( chrs ) )    for a as longint = 1 to len( chrs ) step 1                n1 = "000" + str( *ubp ) : ubp+= 1        n1 = right( n1 , 3 )                n2 = n1        if n2[ 2 ] <= 50 then swap n2[ 0 ] , n2[ 2 ]                outs1+= n2                'print n1 , n2        'sleep        'if inkey = " " then end            next        print "c out = " ; len( outs1 ) ' , outs1        dim as string final = ""    for a as longint = 1 to len( outs1 ) step 3        final+= chr( val( mid( outs1 , a , 3 ) ) )    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: 5634
Joined: Sep 28, 2006 2:41
Location: California, USA

### Yah-Zip ( swap )

@dodicat
@angros47

Again it can go over 255...

Here's another swap formula...

================================================
for a as longint = 1 to len( chrs ) step 1

n1 = "00" + hex( *ubp ) : ubp+= 1
n1 = right( n1 , 2 )

n2 = n1
if val( "&H" + n2 ) >= 128 then swap n2[ 0 ] , n2[ 1 ]

outs1+= n2

next
===============================================

Can it be undone???

Here's the code in Dodicat's Zlib..

Code: Select all

`' YAH-ZIP ( swap )'' 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        s = space( 100000 )        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        dim as string outs1 = ""    dim as string outs2 = ""    dim as string n1 , n2    dim as ubyte ptr ubp = cptr( ubyte ptr , strptr( chrs ) )    for a as longint = 1 to len( chrs ) step 1                n1 = "00" + hex( *ubp ) : ubp+= 1        n1 = right( n1 , 2 )                n2 = n1        if val( "&H" + n2 ) >= 128 then swap n2[ 0 ] , n2[ 1 ]                outs1+= n2                'print n1 , n2        'sleep        'if inkey = " " then end            next        print "c out = " ; len( outs1 ) ' , outs1        dim as string final = ""    for a as longint = 1 to len( outs1 ) step 2        final+= chr( val( "&H" + mid( outs1 , 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`
angros47
Posts: 1616
Joined: Jun 21, 2005 19:04

### Re: Yah-Zip ( swap )

albert wrote:Can it be undone???

No, it can't.

Apply it to all values from 0 to 255, and you will see that it doesn't work. It's the pigeon hole problem.
albert
Posts: 5634
Joined: Sep 28, 2006 2:41
Location: California, USA

### Yah-Zip

@Dodicat

I've got yet another compression formula... Compresses 100,000 bytes by 87% after 100 loops.... Takes like 30 - 40 seconds

Need help with the decompression....

Here's the "Test Bed"

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 n1    dim as ubyte ptr ubp = cptr( ubyte ptr , strptr( chrs ) )    for a as longint = 1 to len( chrs ) step 1        n1 = "00000000" + bin( *ubp ) : ubp+= 1        n1 = right( n1 , 8 )        bits+= n1    next        print "c bin = " ; len( bits ) , bits        dim as ubyte count1 = 0    dim as string str1    dim as ubyte dec1    do        str1 = str( len( bits ) / 3 )        dec1 = instr( 1 , str1 , "." )        if dec1 <> 0 then bits+= "0" : count1+= 1    loop until dec1 = 0        print "c bin = " ; len( bits ) , bits        dim as string outs1 = ""    for a as longint = 1 to len( bits ) step 3                n1 = mid( bits , a , 3 )                if n1 = "000" then outs1+= "0"        if n1 = "110" then outs1+= "1"        if n1 = "111" then outs1+= "2"        if n1 = "101" then outs1+= "03"        if n1 = "100" then outs1+= "31"        if n1 = "001" then outs1+= "32"        if n1 = "011" then outs1+= "33"        if n1 = "010" then outs1+= "30"            next        print "c out = " ; len( outs1 ) , outs1        dim as ubyte count2 = 0    dim as string str2    dim as ubyte dec2    do        str2 = str( len( outs1 ) / 4 )        dec2 = instr( 1 , str2 , "." )        if dec2 <> 0 then outs1+= "0" : count2+= 1    loop until dec2 = 0        dim as string final = ""    dim as string s , n    for a as longint = 1 to len( outs1 ) step 4        s = mid( outs1 , a , 4 )        n = ""        n+= right( "00" + bin( val( mid( s , 1 , 1 ) ) ) , 2 )        n+= right( "00" + bin( val( mid( s , 2 , 1 ) ) ) , 2 )        n+= right( "00" + bin( val( mid( s , 3 , 1 ) ) ) , 2 )        n+= right( "00" + bin( val( mid( s , 4 , 1 ) ) ) , 2 )        final+= chr( val( "&B" + n ) )        'final+= chr( val( "&B" + mid( outs1 , a , 8 ) ) )    next        final = chr( count1 ) + chr( count2 ) + 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 count1 = asc( left( chrs ,1 ) ) : chrs = mid( chrs , 2 )    dim as ubyte count2 = asc( left( chrs ,1 ) ) : chrs = mid( chrs , 2 )    dim as string bits = ""    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 = "00000000" + bin( *ubp ) : ubp+= 1        n1 = right( n1 , 8 )        bits+= n1    next        dim as string outs1 = ""    for a as longint = 1 to len( bits ) step 2        outs1+= str( val( "&B" + mid( bits , a , 2 ) ) )    next    outs1 = left( outs1 , len( outs1 ) - count2 )         print "c out = " ; len( outs1 ) , outs1        return chrs    end function`

( !!~~EDITED~~!! )
angros47
Posts: 1616
Joined: Jun 21, 2005 19:04

### Re: Squares

Duplicate, Albert:

Code: Select all

`000 100 = 0 31 101 110 = 03 1`

Return to “General”

### Who is online

Users browsing this forum: No registered users and 3 guests