Squares

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

Re: Squares

Postby albert » May 07, 2020 21:09

@angros47

I think i got it fixed , so there's no duplicates...

The downside is.. It only compresses 100,000 by 7% after 100 loops. ( 1,000 loops , compresses 100,000 by 39% )

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

if len( n1 ) <= 5 then
outs1+= "010"
outs2+= right( "00000" + n1 , 5 )
goto done
end if

if len( n1 ) = 6 then outs1+="101"
if len( n1 ) = 7 then outs1+="00"
if len( n1 ) = 8 then outs1+="1"

outs2+= mid( n1 , 2 )

done:
================================

You have 1 , 00 , 101 , 010
angros47
Posts: 1673
Joined: Jun 21, 2005 19:04

Re: Squares

Postby angros47 » May 07, 2020 22:38

1010101 is 1-010-101 or 101-010-1?
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » May 08, 2020 18:11

@angros47

Thank for the analysis!!!

I gues it's , back to the drawing board...
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Yah-Zip

Postby albert » May 08, 2020 19:09

@Dodicat
@angros47

I think I got it.... requires 200,000 or more bytes to compress.

============================================================
n1 = "00000000" + bin( *ubp ) : ubp+= 1
n1 = right( n1 , 8 )

v1 = val( "&B" + left( n1 , 4 ) )
v2 = val( "&B" + right( n1 , 4 ) )

if v1 < v2 then outs1+= hex( v1 ) + hex( abs( v1 - v2 ) ) : outs2+= "1"
if v1 > v2 then outs1+= hex( v1 ) + hex( v1 - v2 ) : outs2+= "1"
if v1 = v2 then outs1+= hex( v1 ) + hex( v2 ) : outs2+= "0"
============================================================

Here's Dodicat's Zlib code doing 1,000,000 bytes , over 100 loops..

Code: Select all


' YAH-ZIP
'
' Writen in FreeBasic for Windows
'
'Zlibrary code by Dodicat , From Scottland
'
' compress_loop() , decompress_loop by Albert Redditt U.S.A


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
        randomize
        s = space( 1000000 )
        For n As Long = 0 to len( s ) - 1 step 1
            s[ n ] = Int( rnd * 256 )
        Next
        compare =  s
        length = len(s)
    else
        'modify compression to make further compression possible
       
        s = compress_loop(s)
   
    end if
    check = s
    compression = (100 - ( 100 / ( length / len(check) ) ))
   
    Print "original string"
    Print Len(s)
    Print
   
    Dim As String compressed=Zlibrary.pack(s)
    s = compressed
   
    Print "packed string "
    Print Len(compressed)
    Print
   
    Dim As String uncompressed=Zlibrary.unpack(compressed)
   
    Print "Retrieve"
    Print Len(uncompressed)
    Print
    'Print "compression ratio  "; 100 - ( 100 / ( Len(s) / len(compressed) ) ) ; "%"
    Print "compression ratio  "; 100 - ( 100 / ( length / len(s) ) ) ; "%"
    Print Iif(uncompressed=check,"OK","ERROR")
    Print "-------------------------------"
   
    'sleep 1000
   
    'if loops > 2 and (100 - ( 100 / ( length / len(s) ) )) < compression then exit do
   
    print "press esc to exit."
    print
    print "press a key for next compression." ; " loops = " ; loops ; " out of 100."
    'sleep
   
    if inkey = chr(27) then exit do
   
loop until loops = 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 outs3 = ""
    dim as string n1
    dim as longint v1 , v2 , v3 , v4
    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 )
       
        v1 = val( "&B" +    left( n1 , 4 ) )
        v2 = val( "&B" + right( n1 , 4 ) )
               
        if v1 < v2 then outs1+= hex( v1 ) + hex( abs( v1 - v2 ) ) : outs2+= "1"
        if v1 > v2 then outs1+= hex( v1 ) + hex( v1 - v2 )             : outs2+= "1"
        if v1 = v2 then outs1+= hex( v1 ) + hex( v2 )                    : outs2+= "0"
       
        'print
        'print n1
        'print outs1
        'print outs2
        'sleep
        'if inkey = " " then end
       
    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 2
        final+= chr( val( "&H" + mid( outs1 , a , 2 ) ) )
    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
    print "d inp = " ; len( chrs )
   
    return chrs
   
end function

angros47
Posts: 1673
Joined: Jun 21, 2005 19:04

Re: Squares

Postby angros47 » May 08, 2020 19:32

if v1 is "1110" and v2 is "1111" it will output the same as if v1 is "1110" and v2 is "1101".

So, 11101111 and 11101101 will produce a duplicate.

Albert, when will you realize that your approach will ALWAYS produce duplicates?
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » May 08, 2020 23:08

I came up with an idea for an online store...

You use the foundation of a Dungeons & Dragons program...
Where you can walk down the hallways..

But instead of hallways , you have store shelves and racks and cases.. with products on them.

So you cruise through the store isles , and can see all the products on the shelves.
If you stop at a point , and turn towards the shelf , you can see the products ( close up. )..

You can click on a product and it will show you the box.
Then you can rotate the box or product ( with the mouse ) , to read the print and see its price tag... To decide if you want it or not.

Maybe using a program like "Alice" to create the 3D shopping world... https://www.alice.org/get-alice/


Would be a good idea for Amazon..
To create a huge 3D virtual shopping mall...
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » May 08, 2020 23:24

@angros47

Code: Select all

        v1 = val( "&B" +    left( n1 , 4 ) )
        v2 = val( "&B" + right( n1 , 4 ) )
               
        if v1 < v2 then outs1+= hex( v1 ) : outs1+= hex( abs( v1 - v2 ) ) : outs2+= "1"
        if v1 > v2 then outs1+= hex( v1 ) : outs1+= hex( v1 - v2 ) : outs2+= "1"
        if v1 = v2 then outs1+= hex( v1 ) : outs1+= hex( v2 ) : outs2+= "0"


The first value is always hex( v1 )

If outs2 = "0" then you know v1 and v2 are equal , else outs1 = abs( v1 - v2 ) or ( v1 - v2 )
angros47
Posts: 1673
Joined: Jun 21, 2005 19:04

Re: Squares

Postby angros47 » May 09, 2020 0:09

But if outs2 =1, you only know that v1 and v2 are different, you don't know which one is greater. So you can't know if you must add or subtract to v1 to get the value of v2
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Yah-Zip

Postby albert » May 09, 2020 0:59

@angros47

I corrected it... Compresses 1,000,000 by 46% after 100 loops.

==========================================================
v1 = val( "&B" + left( n1 , 4 ) )
v2 = val( "&B" + right( n1 , 4 ) )

if v1 < v2 then outs1+= hex( v2 ) : outs1+= hex( v2 - v1 ) : outs2+= "0"
if v1 > v2 then outs1+= hex( v1 ) : outs1+= hex( v1 - v2 ) : outs2+= "1"
if v1 = v2 then outs1+= hex( v1 ) : outs1+= hex( v2 ) : outs2+= "1"
==========================================================

Now if outs2 = "0" then you know that its v2 and ( v2 - v1 )

Else its , v1 , v2 or v1 , ( v1 - v2 ) , the possible problem is if v2 = 0 then it would look like an equate...

Code: Select all


' YAH-ZIP
'
' Writen in FreeBasic for Windows
'
'Zlibrary code by Dodicat , From Scottland
'
' compress_loop() , decompress_loop by Albert Redditt U.S.A


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
        randomize
        s = space( 1000000 )
        For n As Long = 0 to len( s ) - 1 step 1
            s[ n ] = Int( rnd * 256 )
        Next
        compare =  s
        length = len(s)
    else
        'modify compression to make further compression possible
       
        s = compress_loop(s)
   
    end if
    check = s
    compression = (100 - ( 100 / ( length / len(check) ) ))
   
    Print "original string"
    Print Len(s)
    Print
   
    Dim As String compressed=Zlibrary.pack(s)
    s = compressed
   
    Print "packed string "
    Print Len(compressed)
    Print
   
    Dim As String uncompressed=Zlibrary.unpack(compressed)
   
    Print "Retrieve"
    Print Len(uncompressed)
    Print
    'Print "compression ratio  "; 100 - ( 100 / ( Len(s) / len(compressed) ) ) ; "%"
    Print "compression ratio  "; 100 - ( 100 / ( length / len(s) ) ) ; "%"
    Print Iif(uncompressed=check,"OK","ERROR")
    Print "-------------------------------"
   
    'sleep 1000
   
    'if loops > 2 and (100 - ( 100 / ( length / len(s) ) )) < compression then exit do
   
    print "press esc to exit."
    print
    print "press a key for next compression." ; " loops = " ; loops ; " out of 100."
    'sleep
   
    if inkey = chr(27) then exit do
   
loop until loops = 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 outs3 = ""
    dim as string n1
    dim as longint v1 , v2 , v3 , v4
    dim as single s1
    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 )
       
        v1 = val( "&B" +    left( n1 , 4 ) )
        v2 = val( "&B" + right( n1 , 4 ) )
               
        if v1 < v2 then outs1+= hex( v2 ) : outs1+= hex( v2 - v1 ) : outs2+= "0"
        if v1 > v2 then outs1+= hex( v1 ) : outs1+= hex( v1 - v2 ) : outs2+= "1"
        if v1 = v2 then outs1+= hex( v1 ) : outs1+= hex( v2 )        : outs2+= "0"
       
        'print
        'print n1
        'print outs1
        'print outs2
        'sleep
        'if inkey = " " then end
       
    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 2
        final+= chr( val( "&H" + mid( outs1 , a , 2 ) ) )
    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
    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 » May 09, 2020 16:48

How many permutation values , are there , for "0123" ??

You got :
0123
0132

It's rather confusing..
angros47
Posts: 1673
Joined: Jun 21, 2005 19:04

Re: Squares

Postby angros47 » May 09, 2020 17:41

No, it's simple: there are 4! (factorial of 4) permutations, or 4 *3 *2 * 1= 24 permutations. In fact the first digit can have 4 values (0 to 3). The second can have three values (all but the one used in the first digit), the third can have the remaining two values, and the last one must have the only remaining value
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » May 10, 2020 0:47

@Dodicat
@angros47

I got another compression formula.... Compresses 1,000,000 down to less than 1,000 after 100 loops.

===================================
n1 = "00000000" + bin( *ubp ) : ubp+= 1
n1 = right( n1 , 8 )

bits+= n1

v1 = 0
if mid( n1 , 1 , 1 ) = "1" then v1+= 1
if mid( n1 , 2 , 1 ) = "1" then v1+= 2

v2 = 0
if mid( n1 , 3 , 1 ) = "1" then v2+= 8
if mid( n1 , 4 , 1 ) = "1" then v2+= 10

v3 = 0
if mid( n1 , 5 , 1 ) = "1" then v3+= 1
if mid( n1 , 6 , 1 ) = "1" then v3+= 2

v4 = 0
if mid( n1 , 7 , 1 ) = "1" then v4+= 8
if mid( n1 , 8 , 1 ) = "1" then v4+= 10

outs1+= hex( v1 + ( v2 \ 2 ) )
outs1+= hex( v3 + ( v4 \ 2 ) )
===================================

Here's Dodicat's Zlib doing 1,000,000 over 100 loops.

Code: Select all


' YAH-ZIP
'
' Writen in FreeBasic for Windows
'
'Zlibrary code by Dodicat , From Scottland
'
' compress_loop() , decompress_loop by Albert Redditt U.S.A


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
        randomize
        s = space( 1000000 )
        For n As Long = 0 to len( s ) - 1 step 1
            s[ n ] = Int( rnd * 256 )
        Next
        compare =  s
        length = len(s)
    else
        'modify compression to make further compression possible
       
        s = compress_loop(s)
   
    end if
    check = s
    compression = (100 - ( 100 / ( length / len(check) ) ))
   
    Print "original string"
    Print Len(s)
    Print
   
    Dim As String compressed=Zlibrary.pack(s)
    s = compressed
   
    Print "packed string "
    Print Len(compressed)
    Print
   
    Dim As String uncompressed=Zlibrary.unpack(compressed)
   
    Print "Retrieve"
    Print Len(uncompressed)
    Print
    'Print "compression ratio  "; 100 - ( 100 / ( Len(s) / len(compressed) ) ) ; "%"
    Print "compression ratio  "; 100 - ( 100 / ( length / len(s) ) ) ; "%"
    Print Iif(uncompressed=check,"OK","ERROR")
    Print "-------------------------------"
   
    'sleep 1000
   
    'if loops > 2 and (100 - ( 100 / ( length / len(s) ) )) < compression then exit do
   
    print "press esc to exit."
    print
    print "press a key for next compression." ; " loops = " ; loops ; " out of 100."
    'sleep
   
    if inkey = chr(27) then exit do
   
loop until loops = 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 bits = ""
    dim as string outs1 = ""
    'dim as string outs2 = ""
    dim as string n1
    dim as longint v1 , v2 , v3 , v4
    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
       
        v1 = 0
        if mid( n1 , 1 , 1 ) = "1" then v1+= 1
        if mid( n1 , 2 , 1 ) = "1" then v1+= 2
       
        v2 = 0
        if mid( n1 , 3 , 1 ) = "1" then v2+= 8
        if mid( n1 , 4 , 1 ) = "1" then v2+= 10
       
        v3 = 0
        if mid( n1 , 5 , 1 ) = "1" then v3+= 1
        if mid( n1 , 6 , 1 ) = "1" then v3+= 2
       
        v4 = 0
        if mid( n1 , 7 , 1 ) = "1" then v4+= 8
        if mid( n1 , 8 , 1 ) = "1" then v4+= 10
       
        outs1+= hex( v1 + ( v2 \ 2 ) )
        outs1+= hex( v3 + ( v4 \ 2 ) )
         
        'print
        'print n1
        'print outs1
        'print outs2
        'sleep
        'if inkey = " " then end
       
    next
   
    print "c bin = " ; len( bits ) ' , bits
    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 2
        final+= chr( val( "&H" + mid( outs1 , a , 2 ) ) )
    next
    'final+= "END"
    'for a as longint = 1 to len( outs2 ) step 4
        '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

coderJeff
Site Admin
Posts: 3316
Joined: Nov 04, 2005 14:23
Location: Ontario, Canada
Contact:

Re: Squares

Postby coderJeff » May 10, 2020 13:21

Hi albert,
We are coming up on the one year anniversary of this fallacy and 1500+ posts later.

From May 2019...
albert wrote:I came up with a "lossey Compression" it compresses down to 97%..

albert wrote:I got lossless compression working...Compresses 10,000 bytes , down to under 100 bytes..

albert wrote:The compressor works. I just can't figure out how to decompress it.


I feel the community has been very kind in trying to help you understand the error. It's always been lossy compression. The compressors don't work.

Time to shut it down.
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » May 10, 2020 18:01

@CoderJeff

Sorry!!
I won't post anymore compression , unless i have a working decompression...
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Yah-Zip ( Test Bed )

Postby albert » May 11, 2020 20:42

I've got another compression formula... And ; it comes with a working decompression....

But : it's only decompressing properly , about 50% of the time...
I've looked the code over and over , and can't find any stupid coding errors...

I'm not sure where the error is... Maybe ; there's no error , and its just another bad formula?
Could someone look it over , and see where i may have made a mistake...

The only thing i can think , is ; maybe it errors when , m3 = 10 ???


In Dodicat's Zlib code , it compresses 100,000 bytes by 39% after 100 loops.. 1,000,000 bytes compresses by 71%


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

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 outs1 = ""
    dim as string which = ""
    dim as longint v1 , v2
    dim as longint m1 , m2 , m3
    for a as longint = 1 to len( chrs ) step 1
           
            v1 = chrs[ a - 1 ]
           
            if v1 > 127 then which+= "1" : v1-= 128 else which+= "0"
           
            m1 = v1 mod 3
            m2 = v1 mod 4
            m3 = v1 mod 11
           
            v2 = ( m1 * 100 ) + ( m2 * 10 ) + m3
           
            outs1+= right( "000" + str( v2 ) , 3 )
           
    next
   
    print "c out = " ; len( outs1 ) , outs1
    print "c whi = " ; len( which ) , which
   
    dim as string final = ""
    for a as longint = 1 to len( outs1 ) step 3
        final+= chr( val( mid( outs1 , a , 3 ) ) )
    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
    print "d inp = " ; len( chrs )
   
    dim as longint place = instr( 1 , chrs , "END" ) - 1
   
    dim as string out1 = left( chrs , place )
    dim as string out2 = mid( chrs , place + 4 )
   
    dim as string outs1 = ""
    for a as longint = 1 to len( out1 ) step 1
        outs1+= right( "000" + str( out1[ a - 1 ] ) , 3 )
    next
   
    dim as string which = ""
    for a as longint = 1 to len( out2 ) step 1
        which+= right( "00000000" + bin( out2[ a - 1 ] ) , 8 )
    next
   
    print "d out = " ; len( outs1 ) , outs1
    print "d whi = " ; len( which ) , which
   
    dim as string outs2 = ""
    dim as string n1 , n2
    for a as longint = 1 to len( outs1 ) step 3
       
        n1 = mid( outs1 , a , 3 )
       
        dim as longint v1 , m1 , m2 , m3
        dim as longint value
        for b as longint = 0 to 127
           
            m1 = b mod 3
            m2 = b mod 4
            m3 = b mod 11
           
            v1 = ( m1 * 100 ) + ( m2 * 10 ) + m3

            n2 = right( "000" + str( v1 ) , 3 )
           
            if n2 = n1 then value = b : exit for
       
        next
       
       outs2+= chr( value )
       
    next
   
    dim as string final = ""
    place = 1
    dim as longint v1 , v2
    for a as longint = 1 to len( outs2 ) step 1
       
        v1 = outs2[ a - 1 ]
       
        v2 = val( mid( which , place , 1 ) ) : place+= 1
       
        if v2 = 1 then v1+= 128
       
        final+= chr( v1 )
   
    next
   
    return final
   
end function



I added in a print of the times m3 = 10 , and it doesn't seem to affect the outcome..
It sometimes decompresses okay when m3 = 10.. So i don't know where the error is...
And it sometimes fails , when there are no 10's

Here's the "Test Bed" with the m3 = 10 printout..

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 outs1 = ""
    dim as string which = ""
    dim as longint v1 , v2
    dim as longint m1 , m2 , m3
   
    print "equals 10 = " ,
    for a as longint = 1 to len( chrs ) step 1
           
            v1 = chrs[ a - 1 ]
           
            if v1 > 127 then which+= "1" : v1-= 128 else which+= "0"
           
            m1 = v1 mod 3
            m2 = v1 mod 4
            m3 = v1 mod 11
           
            v2 = ( m1 * 100 ) + ( m2 * 10 ) + m3
           
            outs1+= right( "000" + str( v2 ) , 3 )
           
            if m3 = 10 then print "1" ; else print  "0" ;
           
    next
   
    print
    print "c out = " ; len( outs1 ) , outs1
    print "c whi = " ; len( which ) , which
   
    dim as string final = ""
    for a as longint = 1 to len( outs1 ) step 3
        final+= chr( val( mid( outs1 , a , 3 ) ) )
    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
    print "d inp = " ; len( chrs )
   
    dim as longint place = instr( 1 , chrs , "END" ) - 1
   
    dim as string out1 = left( chrs , place )
    dim as string out2 = mid( chrs , place + 4 )
   
    dim as string outs1 = ""
    for a as longint = 1 to len( out1 ) step 1
        outs1+= right( "000" + str( out1[ a - 1 ] ) , 3 )
    next
   
    dim as string which = ""
    for a as longint = 1 to len( out2 ) step 1
        which+= right( "00000000" + bin( out2[ a - 1 ] ) , 8 )
    next
   
    print "d out = " ; len( outs1 ) , outs1
    print "d whi = " ; len( which ) , which
   
    dim as string outs2 = ""
    dim as string n1 , n2
    for a as longint = 1 to len( outs1 ) step 3
       
        n1 = mid( outs1 , a , 3 )
       
        dim as longint v1 , m1 , m2 , m3
        dim as longint value
        for b as longint = 0 to 127 step 1
           
            m1 = b mod 3
            m2 = b mod 4
            m3 = b mod 11
           
            v1 = ( m1 * 100 ) + ( m2 * 10 ) + m3

            n2 = right( "000" + str( v1 ) , 3 )
           
            if n2 = n1 then value = b : exit for
       
        next
       
       outs2+= chr( value )
       
    next
   
    dim as string final = ""
    place = 1
    dim as longint v1 , v2
    for a as longint = 1 to len( outs2 ) step 1
       
        v1 = outs2[ a - 1 ]
       
        v2 = val( mid( which , place , 1 ) ) : place+= 1
       
        if v2 = 1 then v1+= 128
       
        final+= chr( v1 )
   
    next
   
    return final
   
end function


Return to “General”

Who is online

Users browsing this forum: No registered users and 5 guests