I came up with some names for the Grid Compressor:
Singularity
Black hole
Nemesis
Alien Gray
God Zip
Yah Zip
Spirit Zip
Cloud 6
Star 6
Grid Zip
G77 Zip
Which one sounds best?
Squares
Re: Squares
"Black hole" is perfect for a compressor without decompressor.
Re: Squares
@fxm
Black Hole compressor:
It keeps pulling money in , and no money escapes it... ( haha )
@Richard
I ran into a problem with the grid compressor....
You convert a file into binary , then feed it into the grid 49 bits at a time..
The binary probably is not a even number of 49 , so it would put 0's in the last grid at the end of the binary.
How would you know how to take those 0's off in the decompression?
Since the data could end with a 0 if its a binary 2. if you rtrim() the 0's you would lose the end zero..
If you stick 0's at the beginning , to make the binary ,an even multiple of 49 , the first byte could start with a zero.
So if you ltrim() the leading zeros you might lose the initial zero.
Do you have a solution?
Black Hole compressor:
It keeps pulling money in , and no money escapes it... ( haha )
@Richard
I ran into a problem with the grid compressor....
You convert a file into binary , then feed it into the grid 49 bits at a time..
The binary probably is not a even number of 49 , so it would put 0's in the last grid at the end of the binary.
How would you know how to take those 0's off in the decompression?
Since the data could end with a 0 if its a binary 2. if you rtrim() the 0's you would lose the end zero..
If you stick 0's at the beginning , to make the binary ,an even multiple of 49 , the first byte could start with a zero.
So if you ltrim() the leading zeros you might lose the initial zero.
Do you have a solution?
Re: Squares
Cryogenics? I thought this was about data (de)compression, not helium (de)compression.dodicat wrote:Looking into cryogenics I note that people will pay about 200000 dollars for the process, and for the less well heeled, about 80000 dollars a head (literally).badidea wrote:Without a working decompressor, your compressor is just a fancy hash generator.
So these half way processes have value.
Re: Squares
I think i got the compressor working.. There's no way to decompress yet..
Recursing the compression : For some reason , it only compresses down to 252 bytes.. instead of 6 bytes..
I got to speed it up.
For files greater than 100,000 bytes , it takes like 20+ seconds , to solve the grid. as the size gets smaller , it speeds up.
Maybe cptr( ubyte ptr ) , would speed it up. But then , you still have like 49 subtractions per grid.
Turning the ascii string into binary is slowing it down...
dim as string binari = ""
for a as longint = 0 to len(ascii_in)-1 step 1
binari+=right("00000000"+bin(ascii_in[a]),8)
next
Maybe stepping by 8's and using a ulongint pointer would speed it up..
But then how would you create the binary ?? right( string( 21 , "0") + str( ptr ) , 21) ?? any one got a solution?
Recursing the compression : For some reason , it only compresses down to 252 bytes.. instead of 6 bytes..
I got to speed it up.
For files greater than 100,000 bytes , it takes like 20+ seconds , to solve the grid. as the size gets smaller , it speeds up.
Maybe cptr( ubyte ptr ) , would speed it up. But then , you still have like 49 subtractions per grid.
Code: Select all
'Grid compresor
'convert a file into binary
'load the binary into a 7x7 grid = 49 bits
'sum all the rows "how many 1's" in each row 0 to 7 = 3 bits
'sum all the columns "how many 1's" in each column 0 to 7 = 3 bits
'
'the output is 42 bits , (0 to 7) ^ 14
'3 bits for each row and 3 bits for each column , 14 sets of 3 bits.
'
'the difference between 49 bits in and 42 bits out is 7 bits.
'so there are 7 bits worth of duplicate grids (127 dups).
'
'I haven't yet, figured out how to point to a duplicate grid.
'theres no way to decompress the data yet.
'
'I was going to solve all possible grids and put them in the cloud.
'49 bits worth of grids = 127^7
'
'the compressor , i was going to give a way , for free
'then charge a monthly band-width fee to decompress in the cloud.
'
'the computer passes the summed grids to the cloud server.
'the cloud server , would then return a grid for the sum.
'
'you would have one or more cloud servers in each country , where ever they have DNS name servers.
screen 19
dim as string ascii_in = ""
dim as string final=""
dim as longint length = 0
dim as double time1 , time2 , time_total
do
if len(ascii_in) = 0 then
for a as longint = 1 to 10000
ascii_in+=chr( int( rnd*256 ) )
length = len(ascii_in)
next
else
ascii_in = final
end if
time1=timer
'left pad the asc string with "Z's"
'then when you turn the binary grid back to ascii , you know to ltrim the Z's
if len(ascii_in) mod 49 > 0 then ascii_in = string( ( 49 - len(ascii_in) mod 49 ) , "Z") + ascii_in
dim as string binari = ""
for a as longint = 0 to len(ascii_in)-1 step 1
binari+=right("00000000"+bin(ascii_in[a]),8)
next
dim as string*49 _49
dim as string h_out = ""
dim as string v_out = ""
dim as string f_out = ""
for a as longint = 0 to len(binari)-1 step 49
_49 = mid(binari,a,49)
dim as ubyte horz( 1 to 7 )
dim as ubyte vert( 1 to 7 )
horz(1)+= (_49[00]-48) + (_49[01]-48) +(_49[02]-48) +(_49[03]-48) +(_49[04]-48) +(_49[05]-48) +(_49[06]-48)
horz(2)+= (_49[07]-48) + (_49[08]-48) +(_49[09]-48) +(_49[10]-48) +(_49[11]-48) +(_49[12]-48) +(_49[13]-48)
horz(3)+= (_49[14]-48) + (_49[15]-48) +(_49[16]-48) +(_49[17]-48) +(_49[18]-48) +(_49[19]-48) +(_49[20]-48)
horz(4)+= (_49[21]-48) + (_49[22]-48) +(_49[23]-48) +(_49[24]-48) +(_49[25]-48) +(_49[26]-48) +(_49[27]-48)
horz(5)+= (_49[28]-48) + (_49[29]-48) +(_49[30]-48) +(_49[31]-48) +(_49[32]-48) +(_49[33]-48) +(_49[34]-48)
horz(6)+= (_49[35]-48) + (_49[36]-48) +(_49[37]-48) +(_49[38]-48) +(_49[39]-48) +(_49[40]-48) +(_49[41]-48)
horz(7)+= (_49[42]-48) + (_49[43]-48) +(_49[44]-48) +(_49[45]-48) +(_49[46]-48) +(_49[47]-48) +(_49[48]-48)
h_out = right("000"+bin(horz(1)),3)
h_out+= right("000"+bin(horz(2)),3)
h_out+= right("000"+bin(horz(3)),3)
h_out+= right("000"+bin(horz(4)),3)
h_out+= right("000"+bin(horz(5)),3)
h_out+= right("000"+bin(horz(6)),3)
h_out+= right("000"+bin(horz(7)),3)
vert(1)+=(_49[00]-48) + (_49[07]-48) + (_49[14]-48) + (_49[21]-48) + (_49[28]-48) + (_49[35]-48) + (_49[42]-48)
vert(2)+=(_49[01]-48) + (_49[08]-48) + (_49[15]-48) + (_49[22]-48) + (_49[29]-48) + (_49[36]-48) + (_49[43]-48)
vert(3)+=(_49[02]-48) + (_49[09]-48) + (_49[16]-48) + (_49[23]-48) + (_49[30]-48) + (_49[37]-48) + (_49[44]-48)
vert(4)+=(_49[03]-48) + (_49[10]-48) + (_49[17]-48) + (_49[24]-48) + (_49[31]-48) + (_49[38]-48) + (_49[45]-48)
vert(5)+=(_49[04]-48) + (_49[11]-48) + (_49[18]-48) + (_49[25]-48) + (_49[32]-48) + (_49[39]-48) + (_49[46]-48)
vert(6)+=(_49[05]-48) + (_49[12]-48) + (_49[19]-48) + (_49[26]-48) + (_49[33]-48) + (_49[40]-48) + (_49[47]-48)
vert(7)+=(_49[06]-48) + (_49[13]-48) + (_49[20]-48) + (_49[27]-48) + (_49[34]-48) + (_49[41]-48) + (_49[48]-48)
v_out = right("000"+bin(vert(1)),3)
v_out+= right("000"+bin(vert(2)),3)
v_out+= right("000"+bin(vert(3)),3)
v_out+= right("000"+bin(vert(4)),3)
v_out+= right("000"+bin(vert(5)),3)
v_out+= right("000"+bin(vert(6)),3)
v_out+= right("000"+bin(vert(7)),3)
f_out+= h_out+v_out
next
final=""
for b as longint = 1 to len(f_out) step 8
final+=chr(val("&B"+mid(f_out,b,8)))
next
time2=timer
time_total+=time2-time1
print
print "out len = "; len(final) , "Compression = "; ( 100 - (100 / (length / len(final))) )
print
print "Time = " ; time2-time1 , time_total
print
'print "press a key to compress again."
'sleep
loop until len(final) = 252
sleep
end
dim as string binari = ""
for a as longint = 0 to len(ascii_in)-1 step 1
binari+=right("00000000"+bin(ascii_in[a]),8)
next
Maybe stepping by 8's and using a ulongint pointer would speed it up..
But then how would you create the binary ?? right( string( 21 , "0") + str( ptr ) , 21) ?? any one got a solution?
Re: Squares
@Albert. There is no way your grid approach is going to be reversible.Albert wrote:I think i got the compressor working.. There's no way to decompress yet..
You need to stop posting hash functions and get back to us when you have a package that will compress to 50% or more, and will decompress to the original data every time.
Re: Squares
@Richard
It decompresses in the cloud..
There would be a cloud server , that would tak in the sums and output the corresponding grid.
Here it is again....
Got the binari figured out and sped up..
Now to convert the string indexing to ptr's
Now it only compresses down to 2,016 bytes..
It decompresses in the cloud..
There would be a cloud server , that would tak in the sums and output the corresponding grid.
Here it is again....
Got the binari figured out and sped up..
Now to convert the string indexing to ptr's
Now it only compresses down to 2,016 bytes..
Code: Select all
'Grid compresor
'convert a file into binary
'load the binary into a 7x7 grid = 49 bits
'sum all the rows "how many 1's" in each row 0 to 7 = 3 bits
'sum all the columns "how many 1's" in each column 0 to 7 = 3 bits
'
'the output is 42 bits , (0 to 7) ^ 14
'3 bits for each row and 3 bits for each column , 14 sets of 3 bits.
'
'the difference between 49 bits in and 42 bits out is 7 bits.
'so there are 7 bits worth of duplicate grids (127 dups).
'
'I haven't yet, figured out how to point to a duplicate grid.
'theres no way to decompress the data yet.
'
'I was going to solve all possible grids and put them in the cloud.
'49 bits worth of grids = 127^7
'
'the compressor , i was going to give a way , for free
'then charge a monthly band-width fee to decompress in the cloud.
'
'the computer passes the summed grids to the cloud server.
'the cloud server , would then return a grid for the sum.
'
'you would have one or more cloud servers in each country , where ever they have DNS name servers.
screen 19
dim as string ascii_in = ""
dim as string final=""
dim as longint length = 0
dim as double time1 , time2 , time_total
do
if len(ascii_in) = 0 then
for a as longint = 1 to 100000
ascii_in+=chr( int( rnd*256 ) )
length = len(ascii_in)
next
else
ascii_in = final
end if
time1=timer
'left pad the asc string with "Z's"
'then when you turn the binary grid back to ascii , you know to ltrim the Z's
if len(ascii_in) mod (49*8) > 0 then ascii_in = string( ( (49*8) - len(ascii_in) mod (49*8) ) , "Z") + ascii_in
dim as string binari=""
dim as ulongint ptr usp = cptr(ulongint ptr , strptr(ascii_in))
for a as longint = 1 to len(ascii_in) step 8
binari+=right( string(64,"0") + bin(*usp),64)
usp+=1
next
dim as string*49 _49
dim as string h_out = ""
dim as string v_out = ""
dim as string f_out = ""
for a as longint = 0 to len(binari)-1 step 49
_49 = mid(binari,a,49)
dim as ubyte horz( 1 to 7 )
dim as ubyte vert( 1 to 7 )
horz(1)+= (_49[00]-48) + (_49[01]-48) +(_49[02]-48) +(_49[03]-48) +(_49[04]-48) +(_49[05]-48) +(_49[06]-48)
horz(2)+= (_49[07]-48) + (_49[08]-48) +(_49[09]-48) +(_49[10]-48) +(_49[11]-48) +(_49[12]-48) +(_49[13]-48)
horz(3)+= (_49[14]-48) + (_49[15]-48) +(_49[16]-48) +(_49[17]-48) +(_49[18]-48) +(_49[19]-48) +(_49[20]-48)
horz(4)+= (_49[21]-48) + (_49[22]-48) +(_49[23]-48) +(_49[24]-48) +(_49[25]-48) +(_49[26]-48) +(_49[27]-48)
horz(5)+= (_49[28]-48) + (_49[29]-48) +(_49[30]-48) +(_49[31]-48) +(_49[32]-48) +(_49[33]-48) +(_49[34]-48)
horz(6)+= (_49[35]-48) + (_49[36]-48) +(_49[37]-48) +(_49[38]-48) +(_49[39]-48) +(_49[40]-48) +(_49[41]-48)
horz(7)+= (_49[42]-48) + (_49[43]-48) +(_49[44]-48) +(_49[45]-48) +(_49[46]-48) +(_49[47]-48) +(_49[48]-48)
h_out = right("000"+bin(horz(1)),3)
h_out+= right("000"+bin(horz(2)),3)
h_out+= right("000"+bin(horz(3)),3)
h_out+= right("000"+bin(horz(4)),3)
h_out+= right("000"+bin(horz(5)),3)
h_out+= right("000"+bin(horz(6)),3)
h_out+= right("000"+bin(horz(7)),3)
vert(1)+=(_49[00]-48) + (_49[07]-48) + (_49[14]-48) + (_49[21]-48) + (_49[28]-48) + (_49[35]-48) + (_49[42]-48)
vert(2)+=(_49[01]-48) + (_49[08]-48) + (_49[15]-48) + (_49[22]-48) + (_49[29]-48) + (_49[36]-48) + (_49[43]-48)
vert(3)+=(_49[02]-48) + (_49[09]-48) + (_49[16]-48) + (_49[23]-48) + (_49[30]-48) + (_49[37]-48) + (_49[44]-48)
vert(4)+=(_49[03]-48) + (_49[10]-48) + (_49[17]-48) + (_49[24]-48) + (_49[31]-48) + (_49[38]-48) + (_49[45]-48)
vert(5)+=(_49[04]-48) + (_49[11]-48) + (_49[18]-48) + (_49[25]-48) + (_49[32]-48) + (_49[39]-48) + (_49[46]-48)
vert(6)+=(_49[05]-48) + (_49[12]-48) + (_49[19]-48) + (_49[26]-48) + (_49[33]-48) + (_49[40]-48) + (_49[47]-48)
vert(7)+=(_49[06]-48) + (_49[13]-48) + (_49[20]-48) + (_49[27]-48) + (_49[34]-48) + (_49[41]-48) + (_49[48]-48)
v_out = right("000"+bin(vert(1)),3)
v_out+= right("000"+bin(vert(2)),3)
v_out+= right("000"+bin(vert(3)),3)
v_out+= right("000"+bin(vert(4)),3)
v_out+= right("000"+bin(vert(5)),3)
v_out+= right("000"+bin(vert(6)),3)
v_out+= right("000"+bin(vert(7)),3)
f_out+= h_out+v_out
next
final=""
for b as longint = 1 to len(f_out) step 8
final+=chr(val("&B"+mid(f_out,b,8)))
next
time2=timer
time_total+=time2-time1
print
print "out len = "; len(final) , "Compression = "; ( 100 - (100 / (length / len(final))) )
print
print "Time = " ; time2-time1 , "Time total = "; time_total
loop until len(final) <= 2016
sleep
end
Re: Squares
@Dodicat
Send me an email..
Send me an email..
Re: Squares
My compression idea can't be decompressed...
It's somehow recording the single into the byte?
( see: fin = chr( v1 ) ) ; if you make it fin = chr( int( v1 ) ) it doesn't compress.
It's somehow recording the single into the byte?
( see: fin = chr( v1 ) ) ; if you make it fin = chr( int( v1 ) ) it doesn't compress.
Code: Select all
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
'============== use =========
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
do
loops+=1
if len(s) = 0 then
For n As Long = 1 To 10000
s+=chr(Int(Rnd*10)+48)
Next
compare = s
length = len(s)
else
dim as string fin=""
dim as single v1
for a as longint = 0 to len(s)-1 step 1
v1 = s[a] / 2
if frac(v1) <> 0 then v1+=128
fin+=chr(v1) 'bad answer
next
s = fin
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 (100 - ( 100 / ( length / len(s) ) )) < compression then exit do
loop
print "Press a key to decompress."
sleep
s = str(loops) + "_" + s ' ave as an output file...
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
dim as ubyte v1
for a as longint = count to 2 step -1
s = Zlibrary.unpack(comp)
outs=""
for b as longint = 0 to len(s)-1 step 1
val1 = right("00000000"+bin(s[b]),8)
outs+=chr( (val("&B"+mid(val1,2))*2) + val(left(val1,1)) )
next
comp = outs
next
s = Zlibrary.unpack(comp)
'print compare
'print
'print s
print
print "input = "; length , "output = " ; len(s) , "compression ratio "; 100 - ( 100 / ( length / len(s) ) ) ; "%"
print
Print "!!~~Done~~!!"
Sleep
end
Re: Squares
Albert.
To decompress, the first few characters of a compressed file are lengh+"|"
examples
1231|
23|
109776|
If you cut off this bit the de-compressor doesn't get fed the length of the string, thus returns an error.
If you view the first few characters of a compressed file you will see what I mean, that is of course if chr(13)is not included in in these first few in which case you will not see the numbers.
example
I'll email later on if you wish, I haven't used email for months, Plusnet (my provider) wants me to re-do my password (some sort of security re-vamp), or perhaps a scammer at work, I'll have to look into it later.
I don't know about America, but this country now is abound with scams and cons.
To decompress, the first few characters of a compressed file are lengh+"|"
examples
1231|
23|
109776|
If you cut off this bit the de-compressor doesn't get fed the length of the string, thus returns an error.
If you view the first few characters of a compressed file you will see what I mean, that is of course if chr(13)is not included in in these first few in which case you will not see the numbers.
example
Code: Select all
print "231|"+chr(13)+"xxxxxxxxx"
sleep
I don't know about America, but this country now is abound with scams and cons.
Re: Squares
This compression thing is really fascinating, but I really wonder whether its participants are just pulling the legs of the rest of the World ;-)
Re: Squares
@Dodicat
Don't email me
I already posted the code.. It failed to decompress..
I've got some more ideas to try..
Don't email me
I already posted the code.. It failed to decompress..
I've got some more ideas to try..
Re: Squares
@Dodicat
The decompressor works , here it is doing 10 loops.
The decompressor works , here it is doing 10 loops.
Code: Select all
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
'============== use =========
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
do
loops+=1
if len(s) = 0 then
For n As Long = 1 To 10000
s+=chr(Int(Rnd*10)+48)
Next
compare = s
length = len(s)
else
dim as string fin=""
dim as single v1
for a as longint = 0 to len(s)-1 step 1
v1 = s[a] / 2
if frac(v1) <> 0 then v1+=128
fin+=chr(int(v1)) 'bad answer
next
s = fin
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 (100 - ( 100 / ( length / len(s) ) )) < compression then exit do
loop until loops = 10
print "Press a key to decompress."
sleep
s = str(loops) + "_" + s ' ave as an output file...
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=""
for b as longint = 0 to len(s)-1 step 1
val1 = right("00000000"+bin(s[b]),8)
outs+=chr( (val("&B"+mid(val1,2))*2) + val(left(val1,1)) )
next
comp = outs
next
s = Zlibrary.unpack(comp)
'print compare
'print
'print s
print
print "input = "; length , "output = " ; len(s) , "compression ratio "; 100 - ( 100 / ( length / len(s) ) ) ; "%"
print
print "decompression sucessful."
print
Print "!!~~Done~~!!"
Sleep
end
Re: Squares
If you subtract .5 from each byte ..
It compresses like crazy..
But errors in the decompression..
If you subtract a whole value -1 to -255 , it doesn't compress. But it decompresses okay.
It compresses like crazy..
But errors in the decompression..
If you subtract a whole value -1 to -255 , it doesn't compress. But it decompresses okay.
Re: Squares
Here it is again....
Can anyone figure out , why it can't reproduce fin+=chr( s[a] - .5 )
if you do fin+= chr( s[a] - .6 ) it doesn't compress but decompresses just fine??
It doesn't work with - .5
Can anyone figure out , why it can't reproduce fin+=chr( s[a] - .5 )
if you do fin+= chr( s[a] - .6 ) it doesn't compress but decompresses just fine??
It doesn't work with - .5
Code: Select all
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
'============== use =========
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
do
loops+=1
'one time run , create initial string
if len(s) = 0 then
For n As Long = 1 To 10000
s+=chr(Int(Rnd*10)+48)
Next
compare = s
length = len(s)
else
'modify compression to make further compression possible
dim as string fin=""
dim as single v1
for a as longint = 0 to len(s)-1 step 1
v1 = s[a] - .5
fin+=chr((v1))
next
s = fin
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 (100 - ( 100 / ( length / len(s) ) )) < compression then exit do
loop until loops = 10
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
dim as single v1
for a as longint = count to 2 step -1
s = Zlibrary.unpack(comp)
'print s
'sleep
outs=""
for b as longint = 0 to len(s)-1 step 1
v1 = s[b]+.5
'val1 = right("00000000"+bin(s[b]),8)
'outs+=chr( (val("&B"+mid(val1,2))*2) + val(left(val1,1)) )
outs+=chr(v1)
next
comp = outs
next
s = Zlibrary.unpack(comp)
'print compare
'print
'print s
print
print "input = "; length , "output = " ; len(s) , "compression ratio "; 100 - ( 100 / ( length / len(s) ) ) ; "%"
print
print "decompression sucessful."
print
Print "!!~~Done~~!!"
Sleep
end