## Squares

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

### Re: Squares

@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

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

### Re: Squares

@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

@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

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

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

@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

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

@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

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

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

@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
Posts: 3316
Joined: Nov 04, 2005 14:23
Contact:

### Re: Squares

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

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

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