@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
Squares
Re: Squares
1010101 is 1-010-101 or 101-010-1?
Re: Squares
@angros47
Thank for the analysis!!!
I gues it's , back to the drawing board...
Thank for the analysis!!!
I gues it's , back to the drawing board...
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..
@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
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?
So, 11101111 and 11101101 will produce a duplicate.
Albert, when will you realize that your approach will ALWAYS produce duplicates?
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...
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...
Re: Squares
@angros47
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 )
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"
If outs2 = "0" then you know v1 and v2 are equal , else outs1 = abs( v1 - v2 ) or ( v1 - v2 )
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
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...
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
Re: Squares
How many permutation values , are there , for "0123" ??
You got :
0123
0132
It's rather confusing..
You got :
0123
0132
It's rather confusing..
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
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.
@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
Re: Squares
Hi albert,
We are coming up on the one year anniversary of this fallacy and 1500+ posts later.
From May 2019...
Time to shut it down.
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..
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.albert wrote: The compressor works. I just can't figure out how to decompress it.
Time to shut it down.
Re: Squares
@CoderJeff
Sorry!!
I won't post anymore compression , unless i have a working decompression...
Sorry!!
I won't post anymore compression , unless i have a working decompression...
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..
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..
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
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