@Dodicat
I got a formula...
Requires at least 40,000 bytes input .. With less it expands...
( 40,000 bytes in does 57% after 100 loops., )
( 1,000,000 bytes in , does 95% after 100 loops.) But it's slow taking like 200 seconds for the 100 loops.
Can you look it over to check for coding errors???
I keep playing around and changing the values , and some times forget to alter all the values...
Maybe you could refer me for the "Hutter Prize" : My apartment internet blocks all German websites...???
'Compres loop
'==========================================================
dim as string outs = ""
dim as string map = ""
dim as string s1 , s2
dim as longint v1 , v2
for a as longint = 1 to len( bits ) step 3
n1 = mid( bits , a , 3 )
s1 = ""
v1 = 0
if n1[0] = 49 then s1+= "1" : v1+= 1
if n1[1] = 49 then s1+= "10" : v1+= 1
if n1[2] = 49 then s1+= "11" : v1+= 1
s2 = ""
v2 = 0
if n1[0] = 48 then s2+= "1" : v2+= 1
if n1[1] = 48 then s2+= "10" : v2+= 1
if n1[2] = 48 then s2+= "11" : v2+= 1
s1+= "0"
s2+= "0"
if v2 < v1 then
outs+= s2
map+= "1"
else
outs+= s1
map+= "0"
end if
next
'==========================================================
Here's you Zlib code doing 100 loops of 1,000,000 bytes input... You can see for yourself...
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
'albert_redditt@yahoo.com
Declare Function compress_loop( chrs as string ) as string
Declare Function decompress_loop( chrs as string ) as string
Namespace Zlibrary
#define Z_NO_COMPRESSION 0
#define Z_BEST_SPEED 1
#define Z_BEST_COMPRESSION 9
#define Z_DEFAULT_COMPRESSION (-1)
#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
declare function compress2(byval dest as ubyte ptr, byval destLen as uinteger ptr, byval source as const ubyte ptr, byval sourceLen as uLong, byval level as long) 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=compress2(destination, @destinationlength, source, stringlength,Z_BEST_COMPRESSION)''<---- use compress2
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
using Zlibrary
'==================================================================
'==================================================================
'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 int( rnd * 1e9 )
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
'Turn char string into binary string
'============================================================
dim as string bits = ""
dim as string zeros = string( 8 , "0" )
dim as string n1
dim as ubyte ptr ubp = cptr( ubyte ptr , strptr( chrs ) )
for a as longint = 1 to len( chrs ) step 1
n1 = zeros + bin( *ubp ) : ubp+= 1
n1 = right( n1 , 8 )
bits+= n1
next
'============================================================
print "c bit = " ; len( bits ) ' , bits
'Compres loop
'==========================================================
dim as string outs = ""
dim as string map = ""
dim as string s1 , s2
dim as longint v1 , v2
for a as longint = 1 to len( bits ) step 3
n1 = mid( bits , a , 3 )
s1 = ""
v1 = 0
if n1[0] = 49 then s1+= "1" : v1+= 1
if n1[1] = 49 then s1+= "10" : v1+= 1
if n1[2] = 49 then s1+= "11" : v1+= 1
s2 = ""
v2 = 0
if n1[0] = 48 then s2+= "1" : v2+= 1
if n1[1] = 48 then s2+= "10" : v2+= 1
if n1[2] = 48 then s2+= "11" : v2+= 1
s1+= "0"
s2+= "0"
if v2 < v1 then
outs+= s2
map+= "1"
else
outs+= s1
map+= "0"
end if
next
'==========================================================
print "c out = " ; len( outs ) ' , outs
print "c map = " ; len( map ) ' , map
dim as string final = ""
for a as longint = 1 to len( outs ) step 8
final+= chr( val( "&B" + mid( outs , a , 8 ) ) )
next
final+= "END"
for a as longint = 1 to len( map ) step 8
final+= chr( val( "&B" + mid( map , 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