Squares
Re: Squares
@Richard
I figured out how to compress data to the maximum....You turn each byte into a number of zeros , or a number of ones.
A megabyte string , compresses down , to just a few bytes..
But you don't know where 1 byte ends and then next begins..If you put in a separator , it doesn't compress...
I figured out how to compress data to the maximum....You turn each byte into a number of zeros , or a number of ones.
A megabyte string , compresses down , to just a few bytes..
But you don't know where 1 byte ends and then next begins..If you put in a separator , it doesn't compress...
Re: Squares
That's a really good start! If you are stuck with the details of decompression, here is some reading for you.albert wrote:A megabyte string , compresses down , to just a few bytes..
Re: Squares
@Richard
@Dodicat
I came up with a "lossey Compression" it compresses down to 97%..
It turns the data into binary , and then replaces all the "00's" with "01's"
The input data needs to be several kilobytes for it to compress.. it doens't work on hundreds...
@Dodicat
I came up with a "lossey Compression" it compresses down to 97%..
It turns the data into binary , and then replaces all the "00's" with "01's"
The input data needs to be several kilobytes for it to compress.. it doens't work on hundreds...
Code: Select all
Declare Function compress_loop( chrs as string ) as string
Declare Function decompress_loop( chrs as string ) as string
Namespace Zlibrary
#inclib "zlib"
Extern "C"
Declare Function compressBound(Byval sourceLen As Ulong) As Ulong
Declare Function uncompress(Byval dest As Ubyte Ptr, Byval destLen As Uinteger Ptr, Byval source As Ubyte Ptr, Byval sourceLen As Ulong) As Long
Declare Function compress(Byval dest As Ubyte Ptr, Byval destLen As Uinteger Ptr, Byval source As Ubyte Ptr, Byval sourceLen As Ulong) As Long
End Extern
Function getpassedinfo(text As String,Byref passed_length As Integer) As String
Dim As String var1,var2
Dim As Integer pst
#macro splice(stri,char,var1,var2)
pst=Instr(stri,char)
var1="":var2=""
If pst<>0 Then
var1=Mid(stri,1,pst-1)
var2=Mid(stri,pst+1)
Else
var1=stri
End If
#endmacro
splice(text,"|",var1,var2)
text=var2
passed_length=Valint(var1)
Return text
End Function
'================= UNPACK ===============
Function unpack(file As String) As String
Dim As Integer passed_length
Dim As String text=getpassedinfo(file,passed_length)
Dim As Integer stringlength,destinationlength
stringlength=Len(text)
destinationlength =passed_length
Dim As Ubyte Ptr source
Dim As Ubyte Ptr destination =Callocate(destinationlength,1)
source=@text[0]
Var mistake=uncompress(destination,@destinationlength, source, stringlength)
If mistake<>0 Then Print "There was an error":Sleep:End
Dim As String uncompressed
uncompressed=String(destinationlength,0)
For i As Integer = 0 To destinationlength- 1
uncompressed[i]=(destination[i])
Next
Deallocate destination
Return uncompressed
End Function
'=================== PACK ============
Function pack(file As String) As String
Dim As String text=file
Dim As Integer stringlength,destinationlength
stringlength=Len(text)
destinationlength = compressBound(stringlength)
Dim As Ubyte Ptr source
Dim As Ubyte Ptr destination =Callocate(destinationlength,1)
source=@text[0]
Var mistake=compress(destination, @destinationlength, source, stringlength)
If mistake <>0 Then Print "There was an error"
Dim As String compressed
compressed=String(destinationlength,0)
For n As Integer=0 To destinationlength-1
compressed[n]=destination[n]
Next n
compressed=stringlength &"|"+compressed
Deallocate destination
Return compressed
End Function
End Namespace
'==================================================================
'==================================================================
'test zipper
'==================================================================
'==================================================================
screen 19
Dim Shared As String s
Randomize
s=""
dim as string check=""
dim as string compare=""
dim as longint length = 0
dim as double compression = 0
dim as longint loops = 0
do
loops+=1
'one time run , create initial string
if loops = 1 then
For n As Long = 1 To 10000
s+=chr(Int(Rnd*256))'+48)
Next
compare = s
length = len(s)
else
'modify compression to make further compression possible
s = compress_loop(s)
end if
check = s
compression = (100 - ( 100 / ( length / len(check) ) ))
Print "original string"
Print Len(s)
Print
Dim As String compressed=Zlibrary.pack(s)
s = compressed
Print "packed string "
Print Len(compressed)
Print
Dim As String uncompressed=Zlibrary.unpack(compressed)
Print "Retrieve"
Print Len(uncompressed)
Print
'Print "compression ratio "; 100 - ( 100 / ( Len(s) / len(compressed) ) ) ; "%"
Print "compression ratio "; 100 - ( 100 / ( length / len(s) ) ) ; "%"
Print Iif(uncompressed=check,"OK","ERROR")
Print "-------------------------------"
'sleep 1000
'if loops > 2 and (100 - ( 100 / ( length / len(s) ) )) < compression then exit do
print "press a key for next compression."
print
print "press esc to exit."
sleep
if inkey = chr(27) then exit do
loop until loops = 20
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 "!!~~Done~~!!"
Sleep
end
'===============================================================================
'===============================================================================
'begin functions
'===============================================================================
'===============================================================================
Function compress_loop( chrs as string ) as string
dim as string binari=""
dim as string zeros= string(8,"0")
for a as longint = 1 to len(chrs) step 1
binari+=right(zeros + bin(chrs[a-1]),8)
next
'print "inp = "; len(binari) , binari
dim as string outputs = binari
dim as string n1
for a as longint = 1 to len(binari) step 2
n1 = mid(binari,a,2)
if n1 = "00" then mid(outputs,a,2) = "01"
next
'print "out = "; len(outputs) , outputs
dim as string final_out= ""
for a as longint = 1 to len(outputs) step 8
final_out+= chr(val("&B"+mid(outputs,a,8)))
next
'print "out = " ; len(final_out) , final_out
return final_out
end function
'===============================================================================
'===============================================================================
Function decompress_loop( chrs as string ) as string
dim as string binari=""
for a as longint = 0 to len(chrs)-1 step 1
binari+=right("00000000"+bin(chrs[a]),8)
next
'print "len = " ; len(binari) , binari
dim as string final_out = chrs
return final_out
end function
Re: Squares
@Richard
I got lossless compression working...Compresses 10,000 bytes , down to under 100 bytes..
I can't post the code.. I need to copyright it or patent it..
After several days and hours and hours of playing with the zlib compressor , I finally figured out how to trick it , into compressing random data..
I got lossless compression working...Compresses 10,000 bytes , down to under 100 bytes..
I can't post the code.. I need to copyright it or patent it..
After several days and hours and hours of playing with the zlib compressor , I finally figured out how to trick it , into compressing random data..
Re: Squares
@albert.
I believe in the science of information theory which says that you cannot compress truly random data.
I think you have tricked yourself, not Zlib.
I believe in the science of information theory which says that you cannot compress truly random data.
I think you have tricked yourself, not Zlib.
Re: Squares
@Richard
The compressor works. I just can't figure out how to decompress it.
I'll go ahead and post it.
you have , stepping by 2 bits
00
01
10
1
So it turns 8 bits into 7 , so it compresses , and 11 is the most prolific set... so 10,000 compresses to under 9,000 on the first run.
10-01 has 00
10-10 has 101
01-01 has 101
So i'm confused about decompression..
You can put "000" as the first set, but it doesn't compress as much , but solves the "00" issue.
I can't figure out the "101" issue...
The compressor works. I just can't figure out how to decompress it.
I'll go ahead and post it.
you have , stepping by 2 bits
00
01
10
1
So it turns 8 bits into 7 , so it compresses , and 11 is the most prolific set... so 10,000 compresses to under 9,000 on the first run.
10-01 has 00
10-10 has 101
01-01 has 101
So i'm confused about decompression..
You can put "000" as the first set, but it doesn't compress as much , but solves the "00" issue.
I can't figure out the "101" issue...
Code: Select all
Declare Function compress_loop( chrs as string ) as string
Declare Function decompress_loop( chrs as string ) as string
Namespace Zlibrary
#inclib "zlib"
Extern "C"
Declare Function compressBound(Byval sourceLen As Ulong) As Ulong
Declare Function uncompress(Byval dest As Ubyte Ptr, Byval destLen As Uinteger Ptr, Byval source As Ubyte Ptr, Byval sourceLen As Ulong) As Long
Declare Function compress(Byval dest As Ubyte Ptr, Byval destLen As Uinteger Ptr, Byval source As Ubyte Ptr, Byval sourceLen As Ulong) As Long
End Extern
Function getpassedinfo(text As String,Byref passed_length As Integer) As String
Dim As String var1,var2
Dim As Integer pst
#macro splice(stri,char,var1,var2)
pst=Instr(stri,char)
var1="":var2=""
If pst<>0 Then
var1=Mid(stri,1,pst-1)
var2=Mid(stri,pst+1)
Else
var1=stri
End If
#endmacro
splice(text,"|",var1,var2)
text=var2
passed_length=Valint(var1)
Return text
End Function
'================= UNPACK ===============
Function unpack(file As String) As String
Dim As Integer passed_length
Dim As String text=getpassedinfo(file,passed_length)
Dim As Integer stringlength,destinationlength
stringlength=Len(text)
destinationlength =passed_length
Dim As Ubyte Ptr source
Dim As Ubyte Ptr destination =Callocate(destinationlength,1)
source=@text[0]
Var mistake=uncompress(destination,@destinationlength, source, stringlength)
If mistake<>0 Then Print "There was an error":Sleep:End
Dim As String uncompressed
uncompressed=String(destinationlength,0)
For i As Integer = 0 To destinationlength- 1
uncompressed[i]=(destination[i])
Next
Deallocate destination
Return uncompressed
End Function
'=================== PACK ============
Function pack(file As String) As String
Dim As String text=file
Dim As Integer stringlength,destinationlength
stringlength=Len(text)
destinationlength = compressBound(stringlength)
Dim As Ubyte Ptr source
Dim As Ubyte Ptr destination =Callocate(destinationlength,1)
source=@text[0]
Var mistake=compress(destination, @destinationlength, source, stringlength)
If mistake <>0 Then Print "There was an error"
Dim As String compressed
compressed=String(destinationlength,0)
For n As Integer=0 To destinationlength-1
compressed[n]=destination[n]
Next n
compressed=stringlength &"|"+compressed
Deallocate destination
Return compressed
End Function
End Namespace
'==================================================================
'==================================================================
'test zipper
'==================================================================
'==================================================================
screen 19
Dim Shared As String s
Randomize
s=""
dim as string check=""
dim as string compare=""
dim as longint length = 0
dim as double compression = 0
dim as longint loops = 0
do
loops+=1
'one time run , create initial string
if loops = 1 then
For n As Long = 1 To 10000
s+=chr(Int(Rnd*256))'+48)
Next
compare = s
length = len(s)
else
'modify compression to make further compression possible
s = compress_loop(s)
end if
check = s
compression = (100 - ( 100 / ( length / len(check) ) ))
Print "original string"
Print Len(s)
Print
Dim As String compressed=Zlibrary.pack(s)
s = compressed
Print "packed string "
Print Len(compressed)
Print
Dim As String uncompressed=Zlibrary.unpack(compressed)
Print "Retrieve"
Print Len(uncompressed)
Print
'Print "compression ratio "; 100 - ( 100 / ( Len(s) / len(compressed) ) ) ; "%"
Print "compression ratio "; 100 - ( 100 / ( length / len(s) ) ) ; "%"
Print Iif(uncompressed=check,"OK","ERROR")
Print "-------------------------------"
'sleep 1000
'if loops > 2 and (100 - ( 100 / ( length / len(s) ) )) < compression then exit do
print "press a key for next compression."
print
print "press esc to exit."
sleep
if inkey = chr(27) then exit do
loop until loops = 20
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 "!!~~Done~~!!"
Sleep
end
'===============================================================================
'===============================================================================
'begin functions
'===============================================================================
'===============================================================================
Function compress_loop( chrs as string ) as string
dim as string binari=""
dim as string zeros= string(8,"0")
for a as longint = 1 to len(chrs) step 1
binari+=right(zeros + bin(chrs[a-1]),8)
next
'print "inp = "; len(binari) , binari
dim as string outputs = ""
dim as string n1
for a as longint = 1 to len(binari) step 2
n1 = mid(binari,a,2)
if n1 = "00" then outputs+ = "00"
if n1 = "01" then outputs+ = "01"
if n1 = "10" then outputs+ = "10"
if n1 = "11" then outputs+ = "1"
next
'print "out = "; len(outputs) , outputs
dim as ubyte count=0
dim as string str1
dim as longint dec1
do
str1=str(len(outputs)/8)
dec1=instr(1,str1,".")
if dec1<>0 then outputs+= "0" : count+=1
loop until dec1=0
dim as string final_out= ""
for a as longint = 1 to len(outputs) step 8
final_out+= chr(val("&B"+mid(outputs,a,8)))
next
final_out = chr(count) + final_out
'print "out = " ; len(final_out) , final_out
return final_out
end function
'===============================================================================
'===============================================================================
Function decompress_loop( chrs as string ) as string
dim as ubyte count = asc(left(chrs,1))
chrs = mid(chrs,2)
dim as string binari=""
for a as longint = 0 to len(chrs)-1 step 1
binari+=right("00000000"+bin(chrs[a]),8)
next
binari = left(binari,len(binari)-count)
'print "len = " ; len(binari) , binari
dim as string final_out = chrs
return final_out
end function
Re: Squares
Albert wrote:I got lossless compression working...
Then it is simply another a "hash function". It is not "lossless compression".Albert wrote:The compressor works. I just can't figure out how to decompress it.
Re: Squares
@Richard
I was trying to use the instr() function to search for the sets..
10-10 has a 10 and 01
01-01 has a 01 and 10
01-10 solves out okay..
I've been racking my brain , how to solve it by stepping through the data..
Because it only uses a single 1 for the "11" set. you can't step through the data by 2's. so it's not systematic..
I'm sure there's a way to accomplish it. I'm just stupid and fumbling...
But you know that any numbers of 1's , that's not followed by a 0 , solve out to "11's"
I think you didn't run the code and look into it , before you called it a hash function..
if you step through it by 1's when you run into a 0 you need to read ahead to see if its a 1001 or a 1010 or a 0110 or a 0101..
I just can't seem to wrap my head around the concept to solve it...
if n1 = "00" then outputs+ = "000"
if n1 = "01" then outputs+ = "010"
if n1 = "10" then outputs+ = "10"
if n1 = "11" then outputs+ = "1"
compresses but requires 40+ loops
I was trying to use the instr() function to search for the sets..
10-10 has a 10 and 01
01-01 has a 01 and 10
01-10 solves out okay..
I've been racking my brain , how to solve it by stepping through the data..
Because it only uses a single 1 for the "11" set. you can't step through the data by 2's. so it's not systematic..
I'm sure there's a way to accomplish it. I'm just stupid and fumbling...
But you know that any numbers of 1's , that's not followed by a 0 , solve out to "11's"
I think you didn't run the code and look into it , before you called it a hash function..
if you step through it by 1's when you run into a 0 you need to read ahead to see if its a 1001 or a 1010 or a 0110 or a 0101..
I just can't seem to wrap my head around the concept to solve it...
if n1 = "00" then outputs+ = "000"
if n1 = "01" then outputs+ = "010"
if n1 = "10" then outputs+ = "10"
if n1 = "11" then outputs+ = "1"
compresses but requires 40+ loops
Re: Squares
Not 100% sure of your requirements Albert.
Here is a string tally function.
Here is a string tally function.
Code: Select all
Function TALLY(SomeString As String,PartString As String,a() As Integer) As Long
Dim As Long LenP=Len(PartString),count
Dim As Long position=Instr(SomeString,PartString)
If position=0 Then Return 0
While position>0
count+=1
position=Instr(position+LenP,SomeString,PartString)
Wend
Redim a(1 To count)
Var u=count
position=Instr(SomeString,PartString)
a(1)=position
count=1
While count < u
count+=1
position=Instr(position+LenP,SomeString,PartString)
a(count)=position
Wend
Return u
End Function
screen 12
dim as ulongint u=-1
u=u\1000000
dim as string b=bin(u)
dim as long flag
for n as long=0 to len(b)-1
if n<len(b) then
if b[n]=asc("0") and b[n+1] = asc("1") then color 4 :flag=1
end if
print chr(b[n]);
flag+=1
if flag=3 then color 15:flag=0
next
print
redim as integer a()
var t=tally(bin(u),"01",a())
print "position of 01 in string"
for n as long=lbound(a) to ubound(a)
print a(n)
next
print
print "number of occurrencies = ";t
print "Length of string ";len(b)
sleep
Data Compression
@Dodicat
I need to find the stray "1's" that expand to "1111"
See compress_loop() , I need to write a decompressor
I need to find the stray "1's" that expand to "1111"
See compress_loop() , I need to write a decompressor
Code: Select all
Declare Function compress_loop( chrs as string ) as string
Declare Function decompress_loop( chrs as string ) as string
screen 19
dim as double time1,time2,time3,time4
do
randomize
dim as string s=""
For n As Long = 1 To 10
s+=chr(Int(Rnd*256))'+48)
Next
time1=timer
'begin compress
dim as string comp = compress_loop(s)
'end compress
time2 = timer
time3=timer
'begin decompress
dim as string final_out = decompress_loop(comp)
'end decompress
time4 = timer
print
print string(99,"=")
print s
print string(99,"=")
print 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."
sleep
loop until inkey = chr(27)
sleep
end
'===============================================================================
'===============================================================================
'begin functions
'===============================================================================
'===============================================================================
Function compress_loop( chrs as string ) as string
dim as string binari=""
dim as string zeros= string(8,"0")
for a as longint = 1 to len(chrs) step 1
binari+=right(zeros + bin(chrs[a-1]),8)
next
print "comp in = " ; len(binari) ; " " ; binari
dim as string outputs = ""
dim as string n1
for a as longint = 1 to len(binari) step 4
n1 = mid(binari,a,4)
if n1="1111" then outputs+= "1" else outputs+=n1
next
print "comp out = "; len(outputs) ; " " ; outputs
dim as ubyte count=0
dim as string str1
dim as longint dec1
do
str1=str(len(outputs)/8)
dec1=instr(1,str1,".")
if dec1<>0 then outputs+= "0" : count+=1
loop until dec1=0
dim as string final_out= ""
for a as longint = 1 to len(outputs) step 8
final_out+= chr(val("&B"+mid(outputs,a,8)))
next
final_out = chr(count) + final_out
'print "out = " ; len(final_out) , final_out
return final_out
end function
'===============================================================================
'===============================================================================
Function decompress_loop( chrs as string ) as string
dim as ubyte count = asc(left(chrs,1))
chrs=mid(chrs,2)
dim as string binari=""
dim as string zeros= string(8,"0")
for a as longint = 1 to len(chrs) step 1
binari+=right(zeros + bin(chrs[a-1]),8)
next
binari = left(binari,len(binari)-count)
print "decomp = " ; len(binari) ; " " ; binari
dim as string final_out = chrs
'for a as longint = 1 to len(outs) step 8
' final_out+= chr(val("&B"+mid(outs,a,8)))
'next
return final_out
end function
Re: Squares
I figured out a formula....
But it takes like 200 loops to compress 90%
I'm working on the de-compressor...
But it takes like 200 loops to compress 90%
I'm working on the de-compressor...
Code: Select all
Declare Function compress_loop( chrs as string ) as string
Declare Function decompress_loop( chrs as string ) as string
Namespace Zlibrary
#inclib "zlib"
Extern "C"
Declare Function compressBound(Byval sourceLen As Ulong) As Ulong
Declare Function uncompress(Byval dest As Ubyte Ptr, Byval destLen As Uinteger Ptr, Byval source As Ubyte Ptr, Byval sourceLen As Ulong) As Long
Declare Function compress(Byval dest As Ubyte Ptr, Byval destLen As Uinteger Ptr, Byval source As Ubyte Ptr, Byval sourceLen As Ulong) As Long
End Extern
Function getpassedinfo(text As String,Byref passed_length As Integer) As String
Dim As String var1,var2
Dim As Integer pst
#macro splice(stri,char,var1,var2)
pst=Instr(stri,char)
var1="":var2=""
If pst<>0 Then
var1=Mid(stri,1,pst-1)
var2=Mid(stri,pst+1)
Else
var1=stri
End If
#endmacro
splice(text,"|",var1,var2)
text=var2
passed_length=Valint(var1)
Return text
End Function
'================= UNPACK ===============
Function unpack(file As String) As String
Dim As Integer passed_length
Dim As String text=getpassedinfo(file,passed_length)
Dim As Integer stringlength,destinationlength
stringlength=Len(text)
destinationlength =passed_length
Dim As Ubyte Ptr source
Dim As Ubyte Ptr destination =Callocate(destinationlength,1)
source=@text[0]
Var mistake=uncompress(destination,@destinationlength, source, stringlength)
If mistake<>0 Then Print "There was an error":Sleep:End
Dim As String uncompressed
uncompressed=String(destinationlength,0)
For i As Integer = 0 To destinationlength- 1
uncompressed[i]=(destination[i])
Next
Deallocate destination
Return uncompressed
End Function
'=================== PACK ============
Function pack(file As String) As String
Dim As String text=file
Dim As Integer stringlength,destinationlength
stringlength=Len(text)
destinationlength = compressBound(stringlength)
Dim As Ubyte Ptr source
Dim As Ubyte Ptr destination =Callocate(destinationlength,1)
source=@text[0]
Var mistake=compress(destination, @destinationlength, source, stringlength)
If mistake <>0 Then Print "There was an error"
Dim As String compressed
compressed=String(destinationlength,0)
For n As Integer=0 To destinationlength-1
compressed[n]=destination[n]
Next n
compressed=stringlength &"|"+compressed
Deallocate destination
Return compressed
End Function
End Namespace
'==================================================================
'==================================================================
'test zipper
'==================================================================
'==================================================================
screen 19
Dim Shared As String s
Randomize
s=""
dim as string check=""
dim as string compare=""
dim as longint length = 0
dim as double compression = 0
dim as longint loops = 0
do
loops+=1
'one time run , create initial string
if loops = 1 then
For n As Long = 1 To 100000
s+=chr(Int(Rnd*256))'+48)
Next
compare = s
length = len(s)
else
'modify compression to make further compression possible
s = compress_loop(s)
end if
check = s
compression = (100 - ( 100 / ( length / len(check) ) ))
Print "original string"
Print Len(s)
Print
Dim As String compressed=Zlibrary.pack(s)
s = compressed
Print "packed string "
Print Len(compressed)
Print
Dim As String uncompressed=Zlibrary.unpack(compressed)
Print "Retrieve"
Print Len(uncompressed)
Print
'Print "compression ratio "; 100 - ( 100 / ( Len(s) / len(compressed) ) ) ; "%"
Print "compression ratio "; 100 - ( 100 / ( length / len(s) ) ) ; "%"
Print Iif(uncompressed=check,"OK","ERROR")
Print "-------------------------------"
'sleep 1000
'if loops > 2 and (100 - ( 100 / ( length / len(s) ) )) < compression then exit do
print "press a key for next compression."
print
print "press esc to exit."
'sleep
if inkey = chr(27) then exit do
loop until loops = 200
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 "!!~~Done~~!!"
Sleep
end
'===============================================================================
'===============================================================================
'begin functions
'===============================================================================
'===============================================================================
Function compress_loop( chrs as string ) as string
dim as string binari=""
dim as string zeros="00000000"
dim as string n1
for a as longint = 1 to len(chrs) step 1
n1 = bin(chrs[a-1])
binari+= right( zeros + n1,8)
next
'print "bin = " ; len(binari) , binari
dim as ubyte count=0
dim as string str1
dim as longint dec1
do
str1=str(len(binari)/64)
dec1=instr(1,str1,".")
if dec1<>0 then binari = "0" + binari : count+=1
loop until dec1=0
dim as string outs1=""
dim as string map =""
dim as ulongint v1
for a as longint = 1 to len(binari) step 64
v1 = valulng("&B"+mid(binari,a,64))
if v1<= (2^63) then
outs1+=right(string(63,"0")+bin(v1),63)
map+="1"
else
map+="0"
outs1+=right(string(63,"0")+bin(v1-((2^63)+1)),63)
end if
next
'print "outs1 = " ; len(outs1) , outs1
'print "map = " ; len(map) , map
dim as ubyte count1=0
do
str1=str(len(map)/8)
dec1=instr(1,str1,".")
if dec1<>0 then map+="0":count1+=1
loop until dec1=0
dim as ubyte count2=0
do
str1=str(len(outs1)/8)
dec1=instr(1,str1,".")
if dec1<>0 then outs1+="0":count2+=1
loop until dec1=0
dim as string out1=""
for a as longint = 1 to len(map) step 8
out1+=chr(val("&B"+mid(map,a,8)))
next
dim as string out2=""
for a as longint = 1 to len(outs1) step 8
out2+=chr(val("&B"+mid(outs1,a,8)))
next
dim as string final_out = chr(count) + chr(count1) + chr(count2) + out1 + "END" + out2
'print "fin = " ; len(final_out) ', final_out
return final_out
end function
'===============================================================================
'===============================================================================
Function decompress_loop( chrs as string ) as string
dim as ubyte count = asc(left(chrs,1))
chrs=mid(chrs,2)
dim as ubyte count1 = asc(left(chrs,1))
chrs=mid(chrs,2)
dim as ubyte count2 = asc(left(chrs,1))
chrs=mid(chrs,2)
dim as string outs1 = left(chrs,instr(1,chrs,"END")-1)
dim as string outs2 = mid(chrs,instr(1,chrs,"END")+3)
dim as string out1=""
for a as longint = 1 to len(outs1) step 1
out1+=right("00000000" + bin(outs1[a-1]),8)
next
out1=left(out1,len(out1)-count1)
dim as string out2=""
for a as longint = 1 to len(outs2) step 1
out2+=right("00000000" + bin(outs2[a-1]),8)
next
out2=left(out2,len(out2)-count2)
'print "out1 = " ; len(out1) , out1
'print "out2 = " ; len(out2) , out2
dim as string final_out = chrs
return final_out
end function
Re: Squares
@Dodicat
I can't seem to get the de-compressor working.. Can you help??
I can't seem to get the de-compressor working.. Can you help??
Code: Select all
Declare Function compress_loop( chrs as string ) as string
Declare Function decompress_loop( chrs as string ) as string
screen 19
dim as double time1,time2,time3,time4
do
randomize
dim as string s=""
For n As Long = 1 To 10
s+=chr(Int(Rnd*256))'+8)
Next
time1=timer
'begin compress
dim as string comp = compress_loop(s)
'end compress
time2 = timer
time3=timer
'begin decompress
dim as string final_out = decompress_loop(comp)
'end decompress
time4 = timer
print
print string(99,"=")
'print s
print string(99,"=")
'print 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."
sleep
loop until inkey = chr(27)
sleep
end
'===============================================================================
'===============================================================================
'begin functions
'===============================================================================
'===============================================================================
Function compress_loop( chrs as string ) as string
dim as string binari=""
dim as string zeros="00000000"
dim as string n1
for a as longint = 1 to len(chrs) step 1
n1 = bin(chrs[a-1])
binari+= right( zeros + n1,8)
next
print "bin = " ; len(binari) , binari
dim as ubyte count=0
dim as string str1
dim as longint dec1
do
str1=str(len(binari)/64)
dec1=instr(1,str1,".")
if dec1<>0 then binari+= "0" : count+=1
loop until dec1=0
dim as string outs1=""
dim as string map =""
dim as ulongint v1
for a as longint = 1 to len(binari) step 64
v1 = valulng("&B"+mid(binari,a,64))
if v1> (2^63) then
v1-=((2^63)+1)
map+="1"
else
map+="0"
end if
outs1+=right(string(63,"0")+bin(v1),63)
next
print "outs1 = " ; len(outs1) , outs1
print "map = " ; len(map) , map
dim as ubyte count1=0
do
str1=str(len(map)/8)
dec1=instr(1,str1,".")
if dec1<>0 then map = "0"+ map : count1+=1
loop until dec1=0
dim as ubyte count2=0
do
str1=str(len(outs1)/8)
dec1=instr(1,str1,".")
if dec1<>0 then outs1 ="0" + outs1 : count2+=1
loop until dec1=0
dim as string out1=""
for a as longint = 1 to len(map) step 8
out1+=chr(val("&B"+mid(map,a,8)))
next
dim as string out2=""
for a as longint = 1 to len(outs1) step 8
out2+=chr(val("&B"+mid(outs1,a,8)))
next
dim as string final_out = chr(count) + chr(count1) + chr(count2) + out1 + "END" + out2
print "fin = " ; len(final_out) , final_out
return final_out
end function
'===============================================================================
'===============================================================================
Function decompress_loop( chrs as string ) as string
dim as ubyte count = asc(left(chrs,1))
chrs=mid(chrs,2)
dim as ubyte count1 = asc(left(chrs,1))
chrs=mid(chrs,2)
dim as ubyte count2 = asc(left(chrs,1))
chrs=mid(chrs,2)
dim as string outs1 = left(chrs,instr(1,chrs,"END")-1)
dim as string outs2 = mid(chrs,instr(1,chrs,"END")+3)
dim as string out1=""
for a as longint = 1 to len(outs1) step 1
out1+=right("00000000" + bin(outs1[a-1]),8)
next
out1=mid(out1,count1+1)
dim as string out2=""
for a as longint = 1 to len(outs2) step 1
out2+=right("00000000" + bin(outs2[a-1]),8)
next
out2=mid(out2,count2+1)
dim as string map = out1
print "map = " ; len(map) , map
print "out2 = " ; len(out2) , out2
dim as longint map_loc = 1
dim as ulongint v1
dim as string binari=""
for a as longint = 1 to len(out2) step 63
v1 = valulng("&B"+mid(out2,a,63))
if mid(map,map_loc,1) = "1" then v1+=((2^63)+1)
map_loc+=1
binari+=right(string(64,"0")+bin(v1),64)
next
binari = left(binari,len(binari)-count)
print "bin = " ; len(binari) , binari
dim as string final_out = ""
for a as longint = 1 to len(binari) step 8
final_out+=chr(val("&B"+mid(binari,a,8)))
next
final_out=trim(final_out,chr(0))
return final_out
end function
Re: Squares
@Dodicat
I got the de-compressor working, but now it doesn't compress...
if v1 > (2^63) then v1-= (2^63)+1 , was returning a e+18 value , so it was writing 0's into the string, which allowed it to compress.
I got the de-compressor working, but now it doesn't compress...
if v1 > (2^63) then v1-= (2^63)+1 , was returning a e+18 value , so it was writing 0's into the string, which allowed it to compress.
Code: Select all
Declare Function compress_loop( chrs as string ) as string
Declare Function decompress_loop( chrs as string ) as string
screen 19
dim as double time1,time2,time3,time4
do
randomize
dim as string s=""
For n As Long = 1 To 10
s+=chr(Int(Rnd*256))'+8)
Next
time1=timer
'begin compress
dim as string comp = compress_loop(s)
'end compress
time2 = timer
time3=timer
'begin decompress
dim as string final_out = decompress_loop(comp)
'end decompress
time4 = timer
print
print string(99,"=")
'print s
print string(99,"=")
'print 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."
sleep
loop until inkey = chr(27)
sleep
end
'===============================================================================
'===============================================================================
'begin functions
'===============================================================================
'===============================================================================
Function compress_loop( chrs as string ) as string
dim as string binari=""
dim as string zeros="00000000"
dim as string n1
for a as longint = 1 to len(chrs) step 1
n1 = bin(chrs[a-1])
binari+= right( zeros + n1,8)
next
print "bin = " ; len(binari) , binari
dim as ubyte count=0
dim as string str1
dim as longint dec1
do
str1=str(len(binari)/64)
dec1=instr(1,str1,".")
if dec1<>0 then binari+= "0" : count+=1
loop until dec1=0
dim as string outs1=""
dim as string map =""
dim as ulongint v1
dim as ulongint v2 = (2^63) + 1
for a as longint = 1 to len(binari) step 64
v1 = valulng("&B"+mid(binari,a,64))
if v1 > (2^63) then
v1-=v2
map+="1"
else
map+="0"
end if
outs1+=right(string(63,"0")+bin(v1),63)
next
print "outs1 = " ; len(outs1) , outs1
print "map = " ; len(map) , map
dim as ubyte count1=0
do
str1=str(len(map)/8)
dec1=instr(1,str1,".")
if dec1<>0 then map+= "0" : count1+=1
loop until dec1=0
dim as ubyte count2=0
do
str1=str(len(outs1)/8)
dec1=instr(1,str1,".")
if dec1<>0 then outs1+="0" : count2+=1
loop until dec1=0
dim as string out1=""
for a as longint = 1 to len(map) step 8
out1+=chr(val("&B"+mid(map,a,8)))
next
dim as string out2=""
for a as longint = 1 to len(outs1) step 8
out2+=chr(val("&B"+mid(outs1,a,8)))
next
dim as string final_out = chr(count) + chr(count1) + chr(count2) + out1 + "END" + out2
print "fin = " ; len(final_out) , final_out
return final_out
end function
'===============================================================================
'===============================================================================
Function decompress_loop( chrs as string ) as string
dim as ubyte count = asc(left(chrs,1))
chrs=mid(chrs,2)
dim as ubyte count1 = asc(left(chrs,1))
chrs=mid(chrs,2)
dim as ubyte count2 = asc(left(chrs,1))
chrs=mid(chrs,2)
dim as string outs1 = left(chrs,instr(1,chrs,"END")-1)
dim as string outs2 = mid(chrs,instr(1,chrs,"END")+3)
dim as string out1=""
for a as longint = 1 to len(outs1) step 1
out1+=right("00000000" + bin(outs1[a-1]),8)
next
out1 = left(out1,len(out1)-count1)
dim as string out2=""
for a as longint = 1 to len(outs2) step 1
out2+=right("00000000" + bin(outs2[a-1]),8)
next
out2 = left(out2,len(out2)-count2)
dim as string map = out1
print "map = " ; len(map) , map
print "out2 = " ; len(out2) , out2
dim as longint map_loc = 1
dim as ulongint v1
dim as ulongint v2 = (2^63) + 1
dim as string binari=""
for a as longint = 1 to len(out2) step 63
v1 = valulng("&B"+mid(out2,a,63))
if mid(map,map_loc,1) = "1" then v1+=v2
map_loc+=1
binari+=right(string(64,"0")+bin(v1),64)
next
binari = left(binari,len(binari)-count)
print "bin = " ; len(binari) , binari
dim as string final_out = ""
for a as longint = 1 to len(binari) step 8
final_out+=chr(val("&B"+mid(binari,a,8)))
next
return final_out
end function
Re: Squares
Hi albert, this is in reference to an earlier post, but I think the issue is relevant for your most recent incarnation as well. Sorry, I didn't analyze your newest.
When compressing, if you replace some pattern, word, sequence (what ever you want to call it), and it duplicates a pattern that can already exist, the information about it is lost forever.
For example, in a previous version of your compressor, translating the sequence:
"11110001" => "10001"
"10001111" => "10001"
From the output, you can never know which was the original sequence.
In a lot of the questions and bug reports from users about fbc, users are only looking at the end-points; from written code to program output. They don't really understand the in between parts. And why should they? Maybe the documentation was poor, maybe there is a bug in the compiler, etc. But if one is writing the algorithm, then it would be worthwhile to understand the in between parts. What's happening at each step? If there is no understanding there, then it's just a trial-and-error approach, which I think is what you are experiencing, when compressor/decompressor works/doesn't work, but don't know why.
When compressing, if you replace some pattern, word, sequence (what ever you want to call it), and it duplicates a pattern that can already exist, the information about it is lost forever.
For example, in a previous version of your compressor, translating the sequence:
"11110001" => "10001"
"10001111" => "10001"
From the output, you can never know which was the original sequence.
In a lot of the questions and bug reports from users about fbc, users are only looking at the end-points; from written code to program output. They don't really understand the in between parts. And why should they? Maybe the documentation was poor, maybe there is a bug in the compiler, etc. But if one is writing the algorithm, then it would be worthwhile to understand the in between parts. What's happening at each step? If there is no understanding there, then it's just a trial-and-error approach, which I think is what you are experiencing, when compressor/decompressor works/doesn't work, but don't know why.
DATA COMPRESSION
@Richard
@Dodicat
@CoderJeff
I finally got "real-life" , lossless data compression.....But , I'm a little confused about writing the de-compression..
It turns out to be a simple Simon formula..
It only works on data sizes , less than 65,535 bytes. It uses ushort location pointers..
Richard or Dodicat or someone else , can you write the de-compressor??
You can do data up to 100,000 bytes if you do : outs(v1)+=mkshort( a \ 2 ) instead of mkshort( a )
[ i edited it with mkl( a ) and it still compresses..] So now it can do files up to MKL length.
[ edited ]
I might be jumping the gun , here , But i emailed the compressor to DARPA , they might think it's useful ?? Might get a job??
@Dodicat
@CoderJeff
I finally got "real-life" , lossless data compression.....But , I'm a little confused about writing the de-compression..
It turns out to be a simple Simon formula..
It only works on data sizes , less than 65,535 bytes. It uses ushort location pointers..
Richard or Dodicat or someone else , can you write the de-compressor??
You can do data up to 100,000 bytes if you do : outs(v1)+=mkshort( a \ 2 ) instead of mkshort( a )
[ i edited it with mkl( a ) and it still compresses..] So now it can do files up to MKL length.
Code: Select all
Declare Function compress_loop( chrs as string ) as string
Declare Function decompress_loop( chrs as string ) as string
Namespace Zlibrary
#inclib "zlib"
Extern "C"
Declare Function compressBound(Byval sourceLen As Ulong) As Ulong
Declare Function uncompress(Byval dest As Ubyte Ptr, Byval destLen As Uinteger Ptr, Byval source As Ubyte Ptr, Byval sourceLen As Ulong) As Long
Declare Function compress(Byval dest As Ubyte Ptr, Byval destLen As Uinteger Ptr, Byval source As Ubyte Ptr, Byval sourceLen As Ulong) As Long
End Extern
Function getpassedinfo(text As String,Byref passed_length As Integer) As String
Dim As String var1,var2
Dim As Integer pst
#macro splice(stri,char,var1,var2)
pst=Instr(stri,char)
var1="":var2=""
If pst<>0 Then
var1=Mid(stri,1,pst-1)
var2=Mid(stri,pst+1)
Else
var1=stri
End If
#endmacro
splice(text,"|",var1,var2)
text=var2
passed_length=Valint(var1)
Return text
End Function
'================= UNPACK ===============
Function unpack(file As String) As String
Dim As Integer passed_length
Dim As String text=getpassedinfo(file,passed_length)
Dim As Integer stringlength,destinationlength
stringlength=Len(text)
destinationlength =passed_length
Dim As Ubyte Ptr source
Dim As Ubyte Ptr destination =Callocate(destinationlength,1)
source=@text[0]
Var mistake=uncompress(destination,@destinationlength, source, stringlength)
If mistake<>0 Then Print "There was an error":Sleep:End
Dim As String uncompressed
uncompressed=String(destinationlength,0)
For i As Integer = 0 To destinationlength- 1
uncompressed[i]=(destination[i])
Next
Deallocate destination
Return uncompressed
End Function
'=================== PACK ============
Function pack(file As String) As String
Dim As String text=file
Dim As Integer stringlength,destinationlength
stringlength=Len(text)
destinationlength = compressBound(stringlength)
Dim As Ubyte Ptr source
Dim As Ubyte Ptr destination =Callocate(destinationlength,1)
source=@text[0]
Var mistake=compress(destination, @destinationlength, source, stringlength)
If mistake <>0 Then Print "There was an error"
Dim As String compressed
compressed=String(destinationlength,0)
For n As Integer=0 To destinationlength-1
compressed[n]=destination[n]
Next n
compressed=stringlength &"|"+compressed
Deallocate destination
Return compressed
End Function
End Namespace
'==================================================================
'==================================================================
'test zipper
'==================================================================
'==================================================================
screen 19
Dim Shared As String s
Randomize
s=""
dim as string check=""
dim as string compare=""
dim as longint length = 0
dim as double compression = 0
dim as longint loops = 0
do
loops+=1
'one time run , create initial string
if loops = 1 then
For n As Long = 1 To 10000
s+=chr(Int(Rnd*256))'+48)
Next
compare = s
length = len(s)
else
'modify compression to make further compression possible
s = compress_loop(s)
end if
check = s
compression = (100 - ( 100 / ( length / len(check) ) ))
Print "original string"
Print Len(s)
Print
Dim As String compressed=Zlibrary.pack(s)
s = compressed
Print "packed string "
Print Len(compressed)
Print
Dim As String uncompressed=Zlibrary.unpack(compressed)
Print "Retrieve"
Print Len(uncompressed)
Print
'Print "compression ratio "; 100 - ( 100 / ( Len(s) / len(compressed) ) ) ; "%"
Print "compression ratio "; 100 - ( 100 / ( length / len(s) ) ) ; "%"
Print Iif(uncompressed=check,"OK","ERROR")
Print "-------------------------------"
'sleep 1000
'if loops > 2 and (100 - ( 100 / ( length / len(s) ) )) < compression then exit do
print "press a key for next compression."
print
print "press esc to exit."
sleep
if inkey = chr(27) then exit do
loop until loops = 20
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 "!!~~Done~~!!"
Sleep
end
'===============================================================================
'===============================================================================
'begin functions
'===============================================================================
'===============================================================================
Function compress_loop( chrs as string ) as string
'works for files up to 65535 bytes
redim as string outs(0 to 65535)
dim as ulongint v1
for a as longint = 1 to len(chrs) step 2
v1 = cvs(mid(chrs,a,2))
outs(v1)+=mkl(a)
next
dim as string final_out=""
for a as longint = 0 to 65535
final_out+=outs(a) + "_"
next
print "fin = "; len(final_out)
return final_out
end function
'===============================================================================
'===============================================================================
Function decompress_loop( chrs as string ) as string
dim as string final_out = chrs
return final_out
end function
I might be jumping the gun , here , But i emailed the compressor to DARPA , they might think it's useful ?? Might get a job??