Squares

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

Yah-Zip

Postby albert » Mar 20, 2020 23:44

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


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


Namespace 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 Long
End Extern

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


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

'===================  PACK ============
Function pack(file As String) As String
    Dim As String text=file
    Dim As Integer stringlength,destinationlength
    stringlength=Len(text)
    destinationlength = compressBound(stringlength)
    Dim As Ubyte Ptr source
    Dim As Ubyte Ptr destination =Callocate(destinationlength,1)
    source=@text[0]
    Var mistake=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 compressed
End Function

End Namespace


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

Dim Shared As String s

Randomize

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

dim as double time1 , time2

time1 = timer
do
   
    loops+=1
   
    'one time run , create initial string
    if loops = 1 then
        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 = 100

time2 = timer

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

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

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

comp = Zlibrary.unpack(comp)

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

Sleep
end
'===============================================================================
'============================,===================================================
'begin functions
'===============================================================================
'================='==============================================================
Function compress_loop( chrs as string ) as string
   
    print "c inp = " ; len(chrs) ' , chrs
   
    dim as string 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

Postby albert » Mar 21, 2020 1:51

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

Postby bfuller » Mar 23, 2020 8:23

@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

Postby albert » Mar 23, 2020 18:57

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


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


Namespace 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 Long
End Extern

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


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

'===================  PACK ============
Function pack(file As String) As String
    Dim As String text=file
    Dim As Integer stringlength,destinationlength
    stringlength=Len(text)
    destinationlength = compressBound(stringlength)
    Dim As Ubyte Ptr source
    Dim As Ubyte Ptr destination =Callocate(destinationlength,1)
    source=@text[0]
    Var mistake=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 compressed
End Function

End Namespace


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

Dim Shared As String s

Randomize

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

dim as double time1 , time2

time1 = timer
do
   
    loops+=1
   
    'one time run , create initial string
    if loops = 1 then
        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 = 100

time2 = timer

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

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

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

comp = Zlibrary.unpack(comp)

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

Sleep
end
'===============================================================================
'============================,===================================================
'begin functions
'===============================================================================
'================='==============================================================
Function compress_loop( chrs as string ) as string
   
    print "c inp = " ; len(chrs) ' , chrs
   
    dim as string 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

Postby albert » Mar 25, 2020 22:52

@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

Postby albert » Mar 27, 2020 0:37

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

Postby albert » Mar 29, 2020 0:45

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 )

Postby albert » Apr 01, 2020 21:02

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


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


Namespace 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 Long
End Extern

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


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

'===================  PACK ============
Function pack(file As String) As String
    Dim As String text=file
    Dim As Integer stringlength,destinationlength
    stringlength=Len(text)
    destinationlength = compressBound(stringlength)
    Dim As Ubyte Ptr source
    Dim As Ubyte Ptr destination =Callocate(destinationlength,1)
    source=@text[0]
    Var mistake=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 compressed
End Function

End Namespace


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

Dim Shared As String s

Randomize

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

dim as double time1 , time2

time1 = timer
do
   
    loops+=1
   
    'one time run , create initial string
    if loops = 1 then
        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 = 100

time2 = timer

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

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

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

comp = Zlibrary.unpack(comp)

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

Sleep
end
'===============================================================================
'============================,===================================================
'begin functions
'===============================================================================
'================='==============================================================
Function compress_loop( chrs as string ) as string
   
    print "c inp = " ; len(chrs) ' , chrs
   
    dim as string 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 )

Postby angros47 » Apr 01, 2020 21:18

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

Postby albert » Apr 01, 2020 22:05

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

Postby albert » Apr 01, 2020 22:40

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


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


Namespace 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 Long
End Extern

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


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

'===================  PACK ============
Function pack(file As String) As String
    Dim As String text=file
    Dim As Integer stringlength,destinationlength
    stringlength=Len(text)
    destinationlength = compressBound(stringlength)
    Dim As Ubyte Ptr source
    Dim As Ubyte Ptr destination =Callocate(destinationlength,1)
    source=@text[0]
    Var mistake=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 compressed
End Function

End Namespace


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

Dim Shared As String s

Randomize

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

dim as double time1 , time2

time1 = timer
do
   
    loops+=1
   
    'one time run , create initial string
    if loops = 1 then
        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 = 100

time2 = timer

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

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

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

comp = Zlibrary.unpack(comp)

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

Sleep
end
'===============================================================================
'============================,===================================================
'begin functions
'===============================================================================
'================='==============================================================
Function compress_loop( chrs as string ) as string
   
    print "c inp = " ; len(chrs) ' , chrs
   
    dim as string 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 )

Postby albert » Apr 02, 2020 1:01

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


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


Namespace 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 Long
End Extern

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


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

'===================  PACK ============
Function pack(file As String) As String
    Dim As String text=file
    Dim As Integer stringlength,destinationlength
    stringlength=Len(text)
    destinationlength = compressBound(stringlength)
    Dim As Ubyte Ptr source
    Dim As Ubyte Ptr destination =Callocate(destinationlength,1)
    source=@text[0]
    Var mistake=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 compressed
End Function

End Namespace


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

Dim Shared As String s

Randomize

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

dim as double time1 , time2

time1 = timer
do
   
    loops+=1
   
    'one time run , create initial string
    if loops = 1 then
        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 = 100

time2 = timer

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

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

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

comp = Zlibrary.unpack(comp)

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

Sleep
end
'===============================================================================
'============================,===================================================
'begin functions
'===============================================================================
'================='==============================================================
Function compress_loop( chrs as string ) as string
   
    print "c inp = " ; len(chrs) ' , chrs
   
    dim as string 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 )

Postby angros47 » Apr 02, 2020 14:32

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

Postby albert » Apr 03, 2020 0:01

@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 string
Declare Function decompress_loop( chrs as string ) as string

screen 19
'=====================================================================
'=====================================================================
'start program
'=====================================================================
'=====================================================================
dim as double time1 , time2 , time3 , time4
do
   
    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)

sleep
end
'===============================================================================
'===============================================================================
'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

Postby angros47 » Apr 03, 2020 20:22

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