Squares

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

Re: Squares

Postby albert » Dec 24, 2019 1:56

@D.J.Peters

Shakespear :

To "Be" or not to "Be"

The capital "B" in Latin is an picto-gram of a pregnant woman ( boobs and belly )
It has the meaning of "baby" or "small" or "the zeal of youth"

The lowercase "b" in Latin is a picto-gram of a flag at the bottom of a pole..
It has the meaaning of "lower" or "pull down"

In Latin the upper case and lower case have different and sometime the same meaning..

The capital "E" in Latin is a picto-gram of a door way , the line in the center indicates "enter" or "exit"..
The lowercase "e" in Latin is a picto-gram of the left hand curled up , it has the meaning of "carry"

So:
BE = baby enter , baby exit ( baby enter = to be ) , ( baby exit = not to be )
Be = baby carry
bE = lower enter , lower exit
be = lower carry

But all the Roman letters are simple picto-grams...

The E , F , L are all picto-grams of a doorway
E = enter , exit ( ex wife = enter former )

In Latin the capital "X" has the meanings of "anger" , "haste" , "intersect" , "former" it has the sound of two swords clashing..
You draw a sword and act hastily and intersect the enemy and they become former..

F = the top part of the doorway where the shadows are = dark or shadow
L = the bottom of the doorway where the sun lights it up = light or speed of light = fast
Last edited by albert on Dec 24, 2019 3:31, edited 1 time in total.
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Yah-Zip

Postby albert » Dec 24, 2019 2:13

@Dodicat
@StoneMonkey

I got my final compression formula... ( !!~~YAHOO~~!! ) ..... It works!!

v1 = ( *ubp ) : ubp+= 1
v2 = v1 mod 2
v3 = v1 \ 2
outs1+= chr( ( v2 * 100 ) + v3 )

if the outputs < 100 then the output is doubled
if the outputs >= 100 then the output is the right two digits doubled , + 1
if the outputs >= 200 then the output is 100 + the right 2 digtis doubled , + 1

Compresses 10,000 bytes in to 74% after 100 loops.. takes like .18 seconds
Compresses 100,000 bytes in to 90+% after 100 loops.. takes like 1.8 seconds
Compresses 1,000,000 bytes in to 90+% after 100 loops.. takes like 18 seconds
Compresses 10,000,000 bytes in to 90+% after 100 loops.. takes like 180 seconds

The input expands under 4000 bytes in...

Code: Select all


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 100000
            s+=chr(Int(Rnd*256))'+48
        Next
        compare =  s
        length = len(s)
    else
        'modify compression to make further compression possible
       
        s = compress_loop(s)
   
    end if
    check = s
    compression = (100 - ( 100 / ( length / len(check) ) ))
   
    Print "original string"
    Print Len(s)
    Print
   
    Dim As String compressed=Zlibrary.pack(s)
    s = compressed
   
    Print "packed string "
    Print Len(compressed)
    Print
   
    Dim As String uncompressed=Zlibrary.unpack(compressed)
   
    Print "Retrieve"
    Print Len(uncompressed)
    Print
    'Print "compression ratio  "; 100 - ( 100 / ( Len(s) / len(compressed) ) ) ; "%"
    Print "compression ratio  "; 100 - ( 100 / ( length / len(s) ) ) ; "%"
    Print Iif(uncompressed=check,"OK","ERROR")
    Print "-------------------------------"
   
    'sleep 1000
   
    'if loops > 2 and (100 - ( 100 / ( length / len(s) ) )) < compression then exit do
   
    print "press a key for next compression." ; " loops = " ; loops ; " out of 100."
    print
    print "press esc to exit."
    '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)
   
    dim as string outs1 = ""
    dim as ulongint v1 , v2 , v3
    dim as ubyte ptr ubp = cptr( ubyte ptr , strptr( chrs ) )
    for a as longint = 1 to len( chrs ) step 1
       
        v1 = ( *ubp ) : ubp+= 1
       
        v2 = v1 mod 2
       
        v3 = v1 \ 2
       
        outs1+= chr( ( v2 * 100 ) + v3 )
       
        'print v1 , v2 ,  v3 , ( v2 * 100 ) + v3
        'sleep
        'if inkey = " " then end
       
    next
   
    dim as string final = outs1
    'for a as longint = 1 to len( outs1 ) step 8
    '   final+= chr( val( "&B" + mid( outs1 , a , 8 ) ) )
    'next
   
    print "c fin = " ; len(final)
   
    return final
   
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
   
    print "d inp = " ; len(chrs)
   
    return chrs
   
end function

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

Re: Squares

Postby albert » Dec 24, 2019 3:37

@Dodicat
@StoneMonkey

I forgot about the cases of val = 200 to 255 , that val mod 2 = 0

200 \ 2 = 100
200 mod 2 = 0

So the output 100 , would look equal to 1 , ( 00 * 2 ) + 1 = 1 instead of 200

If you add 1 to the mod it takes care of that problem but the value goes over chr( 300 )

200 \ 2 = 100
( 200 mod 2 ) + 1 = 1 so the output would be 200 , 1 , ( 100 * 2 ) + 0

201 \ 2 = 100
( 201 mod 2 ) = 1 , + 1 = 2 , so the output would be 300 , ( 100 * 2 ) + 1

But how do you undo a chr( 300 ) ????
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Yah-Zip

Postby albert » Dec 26, 2019 0:45

@Dodicat
@StoneMonkey

( !!~~ MERRY CHRISTMAS ~~!! )
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Yah-Zip

Postby albert » Dec 26, 2019 18:50

@Richard
@Dodicat
@StoneMonkey

I got another compression formula...

it steps by 6 bits

v1 = left( 3 ) + 1
v2 = right( 3 ) +1

single = ( v1 + v2 ) / 2 ( the average ) : if frac( single ) = .5 then v3 = 100

outs+= chr( v3 + ( v1 *10 ) + int( single ) )

So an output of 143 : the single = 3 and since there's a 100 then the single has a .5 = 3.5 * 2 = 7
v1 = the middle digit = 4
So 7 - 4 = 3
So v2 has to be 3

So the answer is (4 - 1) , (3 - 1) = 32 ( 143 = 32 )

Code: Select all


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 100000
            s+=chr(Int(Rnd*256))'+48
        Next
        compare =  s
        length = len(s)
    else
        'modify compression to make further compression possible
       
        s = compress_loop(s)
   
    end if
    check = s
    compression = (100 - ( 100 / ( length / len(check) ) ))
   
    Print "original string"
    Print Len(s)
    Print
   
    Dim As String compressed=Zlibrary.pack(s)
    s = compressed
   
    Print "packed string "
    Print Len(compressed)
    Print
   
    Dim As String uncompressed=Zlibrary.unpack(compressed)
   
    Print "Retrieve"
    Print Len(uncompressed)
    Print
    'Print "compression ratio  "; 100 - ( 100 / ( Len(s) / len(compressed) ) ) ; "%"
    Print "compression ratio  "; 100 - ( 100 / ( length / len(s) ) ) ; "%"
    Print Iif(uncompressed=check,"OK","ERROR")
    Print "-------------------------------"
   
    'sleep 1000
   
    'if loops > 2 and (100 - ( 100 / ( length / len(s) ) )) < compression then exit do
   
    print "press a key for next compression." ; " loops = " ; loops ; " out of 100."
    print
    print "press esc to exit."
    '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)
   
    dim as string bits = ""
    dim as string zeros = string( 8 , "0" )
    dim as string n1
    dim as ubyte ptr ubp = cptr( ubyte ptr , strptr( chrs ) )
    for a as longint = 1 to len( chrs ) step 1
        n1 = zeros + bin( *ubp ) : ubp+= 1
        n1 = right( n1 , 8 )
        bits+= n1
    next
   
    print "c bin = " ; len( bits ) ' , bits
   
    dim as string outs = ""
    dim as longint v1 , v2 , v3
    dim as single s1
    dim as longint count1 , count2
    for a as longint = 1 to len( bits ) step 6
       
        n1 = mid( bits , a , 6 )
       
        v1 = val( "&B" + left(n1 , 3 ) ) + 1
        v2 = val( "&B" + right( n1 , 3 ) ) + 1
       
        s1 = ( v1 + v2 ) / 2
       
        if frac( s1 ) = .5 then v3 = 100 else v3 = 0
       
        outs+= chr( v3 +  ( v1 * 10 )  + s1 )
       
        'UNCOMMEMNT TO SEE IF VALUES EQUAL
        'print val( "&B" + n1 ) , v1 , v2 , s1 , v3 + ( v1 * 10 ) + s1
        'sleep
        'if inkey = " " then end
       
    next
   
    dim as string final = outs
    'for a as longint = 1 to len( outs ) step 2
    '    final+= chr( val( "&H" + mid( outs , a , 2 ) ) )
    'next
   
    print "c fin = " ; len(final)
   
    return final
   
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
   
    print "d inp = " ; len(chrs)
   
    return chrs
   
end function



For 100 loops:

1,000 bytes in compresses to 985 : 1.5% : takes .3 seconds
10,000 bytes in compresses to 1,061 : 89.39% : takes .6 seconds
100,000 bytes in compresses to 2,025 : 97.97% : takes 5.1 seconds
1,000,000 bytes in compresses to 16,355 : 98.36% : takes 75 seconds
10,000,000 bytes in compresses to 167,422 : 98.35% : takes 742 seconds
Stonemonkey
Posts: 646
Joined: Jun 09, 2005 0:08

Re: Squares

Postby Stonemonkey » Dec 27, 2019 0:39

@albert MERRY CHRISTMAS!

I'm away for a few days, no PC, only tablet, will there ever be any chance of FB on arm Android?
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Odd-Zip

Postby albert » Dec 28, 2019 4:06

@Richard
@Dodicat
@StoneMonkey

I got another compression formula... No idea how to decompress it...

It steps by 16 bits and counts the bits.. 0 to 16 = 5 bits
It then steps by odd numbers starting with 3 ( 3 , 5 , 7 , 9 , 11 etc... to 16th bit = 33 ) for a total of 288 = 9 bits...

So 16 bits in , turns into 5 bits ( count ) and 9 bits ( tally ) = 14 bits out.. So it compresses without Zlib...

Compresses to 90+% after 20 loops..

Here it is , with Dodicats Zlib code...

Any help with the decompression would be appreciated....

Code: Select all


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 100000
            s+=chr(Int(Rnd*256))'+48
        Next
        compare =  s
        length = len(s)
    else
        'modify compression to make further compression possible
       
        s = compress_loop(s)
   
    end if
    check = s
    compression = (100 - ( 100 / ( length / len(check) ) ))
   
    Print "original string"
    Print Len(s)
    Print
   
    Dim As String compressed=Zlibrary.pack(s)
    s = compressed
   
    Print "packed string "
    Print Len(compressed)
    Print
   
    Dim As String uncompressed=Zlibrary.unpack(compressed)
   
    Print "Retrieve"
    Print Len(uncompressed)
    Print
    'Print "compression ratio  "; 100 - ( 100 / ( Len(s) / len(compressed) ) ) ; "%"
    Print "compression ratio  "; 100 - ( 100 / ( length / len(s) ) ) ; "%"
    Print Iif(uncompressed=check,"OK","ERROR")
    Print "-------------------------------"
   
    'sleep 1000
   
    'if loops > 2 and (100 - ( 100 / ( length / len(s) ) )) < compression then exit do
   
    print "press esc to exit."
    print
    print "press a key for next compression." ; " loops = " ; loops ; " out of 20."
    sleep
   
    if inkey = chr(27) then exit do
   
loop until loops = 20

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)
   
    dim as string bits = ""
    dim as string zeros = string( 8 , "0" )
    dim as string n1
    for a as longint = 1 to len( chrs ) step 1
        n1 = zeros + bin( chrs[ a - 1 ] )
        n1 = right( n1 , 8 )
        bits+= n1
    next
   
    dim as string outs1 = ""
    dim as string outs2 = ""
    dim as longint count
    dim as longint v1
    for a as longint = 1 to len( bits ) step 16
       
        n1 = mid( bits , a , 16 )
       
        v1 = 0
        count = 0
        if mid( n1 , 01 , 1 ) = "1" then count+= 1 : v1+=3
        if mid( n1 , 02 , 1 ) = "1" then count+= 1 : v1+=5
        if mid( n1 , 03 , 1 ) = "1" then count+= 1 : v1+=7
        if mid( n1 , 04 , 1 ) = "1" then count+= 1 : v1+=9

        if mid( n1 , 05 , 1 ) = "1" then count+= 1 : v1+=11
        if mid( n1 , 06 , 1 ) = "1" then count+= 1 : v1+=13
        if mid( n1 , 07 , 1 ) = "1" then count+= 1 : v1+=15
        if mid( n1 , 08 , 1 ) = "1" then count+= 1 : v1+=17

        if mid( n1 , 09 , 1 ) = "1" then count+= 1 : v1+=19
        if mid( n1 , 10 , 1 ) = "1" then count+= 1 : v1+=21
        if mid( n1 , 11 , 1 ) = "1" then count+= 1 : v1+=23
        if mid( n1 , 12 , 1 ) = "1" then count+= 1 : v1+=25

        if mid( n1 , 13 , 1 ) = "1" then count+= 1 : v1+=27
        if mid( n1 , 14 , 1 ) = "1" then count+= 1 : v1+=29
        if mid( n1 , 15 , 1 ) = "1" then count+= 1 : v1+=31
        if mid( n1 , 16 , 1 ) = "1" then count+= 1 : v1+=33

        outs1+= right( string( 5 , "0" ) + bin( count ) , 5 )
        outs2+= right( string( 9 , "0" ) + bin( v1 ) , 9 )
       
    next
   
    'print 3+5+7+9+11+13+15+17+19+21+23+25+27+29+31+33 ' total = 288
   
    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"
    for a as longint = 1 to len( outs2 ) step 8
        final+= chr( val( "&B" + mid( outs2 , a , 8 ) ) )
    next
   
   
    print "c fin = " ; len(final)
   
    return final
   
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
   
    print "d inp = " ; len(chrs)
   
    return chrs
   
end function

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

Quad-Zip

Postby albert » Dec 28, 2019 19:21

This compression requires someone with a lot of math skills , to decompress it..

it steps by 16 bits..

It sums the set bits 1 to 16 and then counts the number of set bits in each quadrant..

The sum of the bits , 1 + 2 + 3 + 4 + 5 +.... to 16 = 136 so it's 8 bits out..

For the set bits , it only records 0 to 3 = 2 bits... if all 4 bits in a quad are set , then it outputs 0..
You have 4 counts , one count for each quad... so it outputs 8 bits ( 2 bits for each quad ).. So the total out , is 16 bits...

Not sure how it compresses with a 1:1 ratio , but it compresses 90+% after 40 loops..

I need help with the decompression...

Code: Select all


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 100000
            s+=chr(Int(Rnd*256))'+48
        Next
        compare =  s
        length = len(s)
    else
        'modify compression to make further compression possible
       
        s = compress_loop(s)
   
    end if
    check = s
    compression = (100 - ( 100 / ( length / len(check) ) ))
   
    Print "original string"
    Print Len(s)
    Print
   
    Dim As String compressed=Zlibrary.pack(s)
    s = compressed
   
    Print "packed string "
    Print Len(compressed)
    Print
   
    Dim As String uncompressed=Zlibrary.unpack(compressed)
   
    Print "Retrieve"
    Print Len(uncompressed)
    Print
    'Print "compression ratio  "; 100 - ( 100 / ( Len(s) / len(compressed) ) ) ; "%"
    Print "compression ratio  "; 100 - ( 100 / ( length / len(s) ) ) ; "%"
    Print Iif(uncompressed=check,"OK","ERROR")
    Print "-------------------------------"
   
    'sleep 1000
   
    'if loops > 2 and (100 - ( 100 / ( length / len(s) ) )) < compression then exit do
   
    print "press esc to exit."
    print
    print "press a key for next compression." ; " loops = " ; loops ; " out of 40."
    sleep
   
    if inkey = chr(27) then exit do
   
loop until loops = 40

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)
   
    dim as string bits = ""
    dim as string zeros = string( 8 , "0" )
    dim as string n1
    for a as longint = 1 to len( chrs ) step 1
        n1 = zeros + bin( chrs[ a - 1 ] )
        n1 = right( n1 , 8 )
        bits+= n1
    next
   
    print "c bin = " ; len( bits ) ' , bits
   
    dim as string outs1 = ""
    dim as string outs2 = ""
    dim as longint count1 , count2 , count3 , count4
    dim as longint v1
    for a as longint = 1 to len( bits ) step 16
       
        n1 = mid( bits , a , 16 )
       
        v1 = 0
        count1 = 0
        count2 = 0
        count3 = 0
        count4 = 0
        if mid( n1 , 01 , 1 ) = "1" then v1+= 01 : count1+= 1
        if mid( n1 , 02 , 1 ) = "1" then v1+= 02 : count1+= 1
        if mid( n1 , 03 , 1 ) = "1" then v1+= 03 : count1+= 1
        if mid( n1 , 04 , 1 ) = "1" then v1+= 04 : count1+= 1
       
        if mid( n1 , 05 , 1 ) = "1" then v1+= 05 : count2+= 1
        if mid( n1 , 06 , 1 ) = "1" then v1+= 06 : count2+= 1
        if mid( n1 , 07 , 1 ) = "1" then v1+= 07 : count2+= 1
        if mid( n1 , 08 , 1 ) = "1" then v1+= 08 : count2+= 1
   
        if mid( n1 , 09 , 1 ) = "1" then v1+= 09 : count3+= 1
        if mid( n1 , 10 , 1 ) = "1" then v1+= 10 : count3+= 1
        if mid( n1 , 11 , 1 ) = "1" then v1+= 11 : count3+= 1
        if mid( n1 , 12 , 1 ) = "1" then v1+= 12 : count3+= 1

        if mid( n1 , 13 , 1 ) = "1" then v1+= 13 : count4+= 1
        if mid( n1 , 14 , 1 ) = "1" then v1+= 14 : count4+= 1
        if mid( n1 , 15 , 1 ) = "1" then v1+= 15 : count4+= 1
        if mid( n1 , 16 , 1 ) = "1" then v1+= 16 : count4+= 1
       
        outs1+= right( string( 8 , "0" ) + bin( v1 ) , 8 )
       
        outs2+= right( string( 2 , "0" ) + bin( count1 ) , 2 )
        outs2+= right( string( 2 , "0" ) + bin( count2 ) , 2 )
        outs2+= right( string( 2 , "0" ) + bin( count3 ) , 2 )
        outs2+= right( string( 2 , "0" ) + bin( count4 ) , 2 )
       
        'UNCOMMENT TO SEE IF VALUES EQUAL
        'print n1 , v1 , count1 , count2 , count3 , count4
        'sleep
        'if inkey = " " then end
       
    next
   
    'print 1+2+3+4 + 5+6+7+8+9+10+11+12+13+14+15+16
   
    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"
    for a as longint = 1 to len( outs2 ) step 8
        final+= chr( val( "&B" + mid( outs2 , a , 8 ) ) )
    next
   
   
    print "c fin = " ; len(final)
   
    return final
   
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
   
    print "d inp = " ; len(chrs)
   
    return chrs
   
end function

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

Re: Squares

Postby albert » Dec 28, 2019 20:19

Never mind.. it has duplicates...

1
2
3
4

4 + 1 = 5 and 2 bits set...
2 + 3 = 5 and 2 bits set...

5
6
7
8

8 + 5 = 13 and two bits set
6 + 7 = 13 and two bits set.

I go to alter the numbers... I'll play around with it...
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Quad-Zip

Postby albert » Dec 28, 2019 20:30

I got it , so no outputs , equal other outputs...

if mid( n1 , 01 , 1 ) = "1" then v1+= 01 : count1+= 1
if mid( n1 , 02 , 1 ) = "1" then v1+= 02 : count1+= 1
if mid( n1 , 03 , 1 ) = "1" then v1+= 03 : count1+= 1
if mid( n1 , 04 , 1 ) = "1" then v1+= 05 : count1+= 1

if mid( n1 , 05 , 1 ) = "1" then v1+= 06 : count2+= 1
if mid( n1 , 06 , 1 ) = "1" then v1+= 07 : count2+= 1
if mid( n1 , 07 , 1 ) = "1" then v1+= 08 : count2+= 1
if mid( n1 , 08 , 1 ) = "1" then v1+= 10 : count2+= 1

if mid( n1 , 09 , 1 ) = "1" then v1+= 11 : count3+= 1
if mid( n1 , 10 , 1 ) = "1" then v1+= 12 : count3+= 1
if mid( n1 , 11 , 1 ) = "1" then v1+= 13 : count3+= 1
if mid( n1 , 12 , 1 ) = "1" then v1+= 15 : count3+= 1

if mid( n1 , 13 , 1 ) = "1" then v1+= 16 : count4+= 1
if mid( n1 , 14 , 1 ) = "1" then v1+= 17 : count4+= 1
if mid( n1 , 15 , 1 ) = "1" then v1+= 18 : count4+= 1
if mid( n1 , 16 , 1 ) = "1" then v1+= 20 : count4+= 1

Now there's no values in each quad that equal each other...

Code: Select all


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 100000
            s+=chr(Int(Rnd*256))'+48
        Next
        compare =  s
        length = len(s)
    else
        'modify compression to make further compression possible
       
        s = compress_loop(s)
   
    end if
    check = s
    compression = (100 - ( 100 / ( length / len(check) ) ))
   
    Print "original string"
    Print Len(s)
    Print
   
    Dim As String compressed=Zlibrary.pack(s)
    s = compressed
   
    Print "packed string "
    Print Len(compressed)
    Print
   
    Dim As String uncompressed=Zlibrary.unpack(compressed)
   
    Print "Retrieve"
    Print Len(uncompressed)
    Print
    'Print "compression ratio  "; 100 - ( 100 / ( Len(s) / len(compressed) ) ) ; "%"
    Print "compression ratio  "; 100 - ( 100 / ( length / len(s) ) ) ; "%"
    Print Iif(uncompressed=check,"OK","ERROR")
    Print "-------------------------------"
   
    'sleep 1000
   
    'if loops > 2 and (100 - ( 100 / ( length / len(s) ) )) < compression then exit do
   
    print "press esc to exit."
    print
    print "press a key for next compression." ; " loops = " ; loops ; " out of 40."
    sleep
   
    if inkey = chr(27) then exit do
   
loop until loops = 40

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)
   
    dim as string bits = ""
    dim as string zeros = string( 8 , "0" )
    dim as string n1
    for a as longint = 1 to len( chrs ) step 1
        n1 = zeros + bin( chrs[ a - 1 ] )
        n1 = right( n1 , 8 )
        bits+= n1
    next
   
    print "c bin = " ; len( bits ) ' , bits
   
    dim as string outs1 = ""
    dim as string outs2 = ""
    dim as longint count1 , count2 , count3 , count4
    dim as longint v1
    for a as longint = 1 to len( bits ) step 16
       
        n1 = mid( bits , a , 16 )
       
        v1 = 0
        count1 = 0
        count2 = 0
        count3 = 0
        count4 = 0
        if mid( n1 , 01 , 1 ) = "1" then v1+= 01 : count1+= 1
        if mid( n1 , 02 , 1 ) = "1" then v1+= 02 : count1+= 1
        if mid( n1 , 03 , 1 ) = "1" then v1+= 03 : count1+= 1
        if mid( n1 , 04 , 1 ) = "1" then v1+= 05 : count1+= 1
       
        if mid( n1 , 05 , 1 ) = "1" then v1+= 06 : count2+= 1
        if mid( n1 , 06 , 1 ) = "1" then v1+= 07 : count2+= 1
        if mid( n1 , 07 , 1 ) = "1" then v1+= 08 : count2+= 1
        if mid( n1 , 08 , 1 ) = "1" then v1+= 10 : count2+= 1
   
        if mid( n1 , 09 , 1 ) = "1" then v1+= 11 : count3+= 1
        if mid( n1 , 10 , 1 ) = "1" then v1+= 12 : count3+= 1
        if mid( n1 , 11 , 1 ) = "1" then v1+= 13 : count3+= 1
        if mid( n1 , 12 , 1 ) = "1" then v1+= 15 : count3+= 1

        if mid( n1 , 13 , 1 ) = "1" then v1+= 16 : count4+= 1
        if mid( n1 , 14 , 1 ) = "1" then v1+= 17 : count4+= 1
        if mid( n1 , 15 , 1 ) = "1" then v1+= 18 : count4+= 1
        if mid( n1 , 16 , 1 ) = "1" then v1+= 20 : count4+= 1
       
        outs1+= right( string( 8 , "0" ) + bin( v1 ) , 8 )
       
        outs2+= right( string( 2 , "0" ) + bin( count1 ) , 2 )
        outs2+= right( string( 2 , "0" ) + bin( count2 ) , 2 )
        outs2+= right( string( 2 , "0" ) + bin( count3 ) , 2 )
        outs2+= right( string( 2 , "0" ) + bin( count4 ) , 2 )
       
        'UNCOMMENT TO SEE IF VALUES EQUAL
        'print n1 , v1 , count1 , count2 , count3 , count4
        'sleep
        'if inkey = " " then end
       
    next
   
    'print 1+2+3+5 + 6+7+8+10 + 11+12+13+15 + 16+17+18+20
   
    'print 1 + 3+5+7+9+11+13+15+17+19+21+23+25+27+29+31
   
    'print 1+2+3+4 + 5+6+7+8+9+10+11+12+13+14+15+16
   
    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"
    for a as longint = 1 to len( outs2 ) step 8
        final+= chr( val( "&B" + mid( outs2 , a , 8 ) ) )
    next
   
   
    print "c fin = " ; len(final)
   
    return final
   
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
   
    print "d inp = " ; len(chrs)
   
    return chrs
   
end function

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

Re: Squares

Postby albert » Dec 28, 2019 21:36

Now there's another problem...

if mid( n1 , 01 , 1 ) = "1" then v1+= 01 : count1+= 1
if mid( n1 , 02 , 1 ) = "1" then v1+= 02 : count1+= 1
if mid( n1 , 03 , 1 ) = "1" then v1+= 03 : count1+= 1
if mid( n1 , 04 , 1 ) = "1" then v1+= 05 : count1+= 1

if mid( n1 , 05 , 1 ) = "1" then v1+= 06 : count2+= 1
if mid( n1 , 06 , 1 ) = "1" then v1+= 07 : count2+= 1
if mid( n1 , 07 , 1 ) = "1" then v1+= 08 : count2+= 1
if mid( n1 , 08 , 1 ) = "1" then v1+= 10 : count2+= 1

if mid( n1 , 09 , 1 ) = "1" then v1+= 11 : count3+= 1
if mid( n1 , 10 , 1 ) = "1" then v1+= 12 : count3+= 1
if mid( n1 , 11 , 1 ) = "1" then v1+= 13 : count3+= 1
if mid( n1 , 12 , 1 ) = "1" then v1+= 15 : count3+= 1

if mid( n1 , 13 , 1 ) = "1" then v1+= 16 : count4+= 1
if mid( n1 , 14 , 1 ) = "1" then v1+= 17 : count4+= 1
if mid( n1 , 15 , 1 ) = "1" then v1+= 18 : count4+= 1
if mid( n1 , 16 , 1 ) = "1" then v1+= 20 : count4+= 1

a 15
Could be a 12 and 3 = 1 bit set in each quad
Could be a 13 and 2 = 1 bit set in each quad

Got to play around with it some more....
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Low-Zip

Postby albert » Dec 29, 2019 3:02

I revisited an older compression..

Summing the 1's and 0's and taking the lowest value...

if sum0 <= sum1 then outs+= right( "0000" + bin( 8 + sum0 ) , 4 )
if sum1 < sum0 then outs+= right( "0000" + bin( 8 - sum1 ) , 4 )

If it's an 8 then the lowest value is 0
If its greater than 8 then sum0 is the lowest , take the opposite ( sum1 )
If it's less than 8 then sum1 is the lowest.. take sum1

Not sure how to handle 8 ? , if it's sum0 or sum1 ? ( we are looking for sum1 = input )

It takes 100 loops to get 90+% compression , and it's kinda slow ... Got to speed it up.. Before i work on the decompression..

Code: Select all


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 100000
            s+=chr(Int(Rnd*256))'+48
        Next
        compare =  s
        length = len(s)
    else
        'modify compression to make further compression possible
       
        s = compress_loop(s)
   
    end if
    check = s
    compression = (100 - ( 100 / ( length / len(check) ) ))
   
    Print "original string"
    Print Len(s)
    Print
   
    Dim As String compressed=Zlibrary.pack(s)
    s = compressed
   
    Print "packed string "
    Print Len(compressed)
    Print
   
    Dim As String uncompressed=Zlibrary.unpack(compressed)
   
    Print "Retrieve"
    Print Len(uncompressed)
    Print
    'Print "compression ratio  "; 100 - ( 100 / ( Len(s) / len(compressed) ) ) ; "%"
    Print "compression ratio  "; 100 - ( 100 / ( length / len(s) ) ) ; "%"
    Print Iif(uncompressed=check,"OK","ERROR")
    Print "-------------------------------"
   
    'sleep 1000
   
    'if loops > 2 and (100 - ( 100 / ( length / len(s) ) )) < compression then exit do
   
    print "press esc to exit."
    print
    print "press a key for next compression." ; " loops = " ; loops ; " out of 100."
    'sleep
   
    if inkey = chr(27) then exit do
   
loop until loops = 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)
   
    dim as string bits = ""
    dim as string zeros = string( 8 , "0" )
    dim as string n1
    for a as longint = 1 to len( chrs ) step 1
        n1 = zeros + bin( chrs[ a - 1 ] )
        n1 = right( n1 , 8 )
        bits+= n1
    next
   
    print "c bin = " ; len( bits ) ' , bits
   
    dim as string outs = ""
    dim as longint sum0 , sum1
    for a as longint = 1 to len( bits ) step 4
       
        n1 = mid( bits , a , 4 )
       
        sum0 = 0
        sum1 = 0
        for b as longint = 1 to len( n1 ) step 1
            if n1[ b - 1 ] = 48 then sum0+= 1 shl ( len( n1 ) - b )
            if n1[ b - 1 ] = 49 then sum1+= 1 shl ( len( n1 ) - b )
        next
           
        if sum0 <= sum1 then outs+= right( "0000" + bin( 8 + sum0 ) , 4 )
        if sum1 <   sum0 then outs+= right( "0000" + bin( 8 - sum1 ) , 4 )
       
        'UNCOMMENT TO SEE VALUES
        'print n1 ,  outs
        'sleep
        'if inkey = " " then end
       
    next
   
    print "c out = " ; len( outs ) ' , outs
   
    dim as string final = ""
    for a as longint = 1 to len( outs ) step 8
        final+= chr( val( "&B" + mid( outs , a , 8 ) ) )
    next
   
    print "c fin = " ; len(final)
   
    return final
   
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
   
    print "d inp = " ; len(chrs)
   
    return chrs
   
end function

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

Postby albert » Jan 01, 2020 1:06

@Richard
@Dodicat
@StoneMonkey

( !!~~ HAPPY NEW YEAR ~~!! )
dodicat
Posts: 6687
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Postby dodicat » Jan 01, 2020 21:32

Happy New Year Albert, and all.
If we are both alive and these words are written again next year, and your decompressor is still not done, then we can just say that Rome wasn't built in a day, I suppose.
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Yah-Zip

Postby albert » Jan 02, 2020 0:20

@Richard
@Dodicat
@StoneMonkey

I got a compressor formula....

But it only compresses 100,000 bytes to 23% after 100 loops.. takes 10 seconds.. ( 400 loops compresses to 64% and takes 45 seconds... )

1,000,000 bytes in compresses to 68% for 400 loops takes 375 seconds... Too slow to use..
10,000 bytes in only compresses to 19% after 400 loops. takes 19 seconds....


Method :
==========================================================
chrs = ascii chrs input string

v1 = 128 - chrs[ a - 1 ]

if v1 > 0 then bits1+= right( zeros + bin( abs( v1 ) ) , 7 ) : which+= "1"
if v1 < 0 then bits2+= right( zeros + bin( abs( v1 ) ) , 7 ) : which+= "0"
==========================================================

Code: Select all


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 100000
            s+=chr(Int(Rnd*256))'+48
        Next
        compare =  s
        length = len(s)
    else
        'modify compression to make further compression possible
       
        s = compress_loop(s)
   
    end if
    check = s
    compression = (100 - ( 100 / ( length / len(check) ) ))
   
    Print "original string"
    Print Len(s)
    Print
   
    Dim As String compressed=Zlibrary.pack(s)
    s = compressed
   
    Print "packed string "
    Print Len(compressed)
    Print
   
    Dim As String uncompressed=Zlibrary.unpack(compressed)
   
    Print "Retrieve"
    Print Len(uncompressed)
    Print
    'Print "compression ratio  "; 100 - ( 100 / ( Len(s) / len(compressed) ) ) ; "%"
    Print "compression ratio  "; 100 - ( 100 / ( length / len(s) ) ) ; "%"
    Print Iif(uncompressed=check,"OK","ERROR")
    Print "-------------------------------"
   
    'sleep 1000
   
    'if loops > 2 and (100 - ( 100 / ( length / len(s) ) )) < compression then exit do
   
    print "press esc to exit."
    print
    print "press a key for next compression." ; " loops = " ; loops ; " out of 100."
    'sleep
   
    if inkey = chr(27) then exit do
   
loop until loops = 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)
   
    dim as string bits1 = ""
    dim as string bits2 = ""
    dim as string which = ""
    dim as string zeros = string( 7 , "0" )
    dim as longint v1
    for a as longint = 1 to len( chrs ) step 1
       
        v1 = 128 - chrs[ a - 1 ]
       
        if v1 > 0 then bits1+= right( zeros + bin( abs( v1 ) ) , 7 ) : which+= "1"
        if v1 < 0 then bits2+= right( zeros + bin( abs( v1 ) ) , 7 ) : which+= "0"
       
        'UNCOMMENT TO SEE VALUES
        'print v1 , right( which , 1 )
        'sleep
        'if inkey = " " then end
       
    next
       
    print "c bin = "; len( bits1 ) ' , bits1
    print "c bin = "; len( bits2 ) ' , bits2
   
   
    dim as string final = ""
    for a as longint = 1 to len( bits1 ) step 8
        final+= chr( val( "&B" + mid( bits1 , a , 8 ) ) )
    next
    final+= "END"
    for a as longint = 1 to len( bits2 ) step 8
        final+= chr( val( "&B" + mid( bits2 , a , 8 ) ) )
    next
    final+= "END"
    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
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
   
    print "d inp = " ; len(chrs)
   
    return chrs
   
end function



( !~ Edited ~! )

I forgot about the case of v1 = 0 , so it doesn't compress after all..

Return to “General”

Who is online

Users browsing this forum: No registered users and 7 guests