I got it working,,, I used a quadranary system on the output , so now we can step by 4 digits..
Since it only uses 0 , 1 , 2 , 3 .... 3333 the highest number possible = 255 = 11 11 11 11.
Compresses 10,000 70% after 40 loops...
Now ; it's just finding the stray 1's and 3's...
Here's you Zlib code..
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." ; " loops = " ; loops ; " out of 40."
print
print "press esc to exit."
sleep
if inkey = chr(27) then exit do
loop until loops = 40
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 bytes=""
dim as string zeros=string(64,"0")
dim as ulongint n1
dim as ulongint ptr usp = cptr(ulongint ptr,strptr(chrs))
for a as longint = 1 to len(chrs) step 8
n1 = *usp : usp+=1
bytes+=right(zeros+bin(n1),64)
next
print "c inp = "; len(bytes) ', bytes
dim as longint count1=0
dim as string str1
dim as longint dec1
do
str1=str(len(bytes)/3)
dec1=instr(1,str1,".")
if dec1<>0 then bytes = "0" + bytes : count1+=1
loop until dec1=0
dim as string outputs=""
dim as string bits
for a as longint = 1 to len(bytes) step 3
bits = mid(bytes,a,3)
if bits = "000" then outputs+="0"
if bits = "001" then outputs+="1"
if bits = "010" then outputs+="12"
if bits = "011" then outputs+="21"
if bits = "100" then outputs+="22"
if bits = "101" then outputs+="23"
if bits = "110" then outputs+="32"
if bits = "111" then outputs+="3"
next
print "c out = "; len(outputs) ', outputs
dim as longint count2=0
do
str1=str(len(outputs)/4)
dec1=instr(1,str1,".")
if dec1<>0 then outputs+="0" : count2+=1
loop until dec1=0
dim as string final=""
dim as string b , num
for a as longint = 1 to len(outputs) step 4
b = mid(outputs,a,4)
num=""
num+=right("00" + bin(val(mid(b,1,1))),2)
num+=right("00" + bin(val(mid(b,2,1))),2)
num+=right("00" + bin(val(mid(b,3,1))),2)
num+=right("00" + bin(val(mid(b,4,1))),2)
final+=chr(val("&B"+num))
next
print "c fin = "; len(final) ' , final
final = chr(count1) + chr(count2) + final
return final
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
dim as longint count1 = asc(left(chrs,1))
chrs = mid(chrs,2)
dim as longint count2 = asc(left(chrs,1))
chrs = mid(chrs,2)
return chrs
end function
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 8
s+=chr(Int(Rnd*256))'+8)
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
'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
'cls
'draw string( 0,10) , left(s,100)
'draw string( 0,30) , left(final_out,100)
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
'===============================================================================
'===============================================================================
'begin functions
'===============================================================================
'===============================================================================
Function compress_loop( chrs as string ) as string
dim as string bytes=""
dim as string zeros=string(64,"0")
dim as ulongint n1
dim as ulongint ptr usp = cptr(ulongint ptr,strptr(chrs))
for a as longint = 1 to len(chrs) step 8
n1 = *usp : usp+=1
bytes+=right(zeros+bin(n1),64)
next
dim as longint count1=0
dim as string str1
dim as longint dec1
do
str1=str(len(bytes)/3)
dec1=instr(1,str1,".")
if dec1<>0 then bytes = "0" + bytes : count1+=1
loop until dec1=0
print "c inp = "; len(bytes) , bytes
dim as string outputs=""
dim as string bits
for a as longint = 1 to len(bytes) step 3
bits = mid(bytes,a,3)
if bits = "000" then outputs+="0"
if bits = "001" then outputs+="1"
if bits = "010" then outputs+="12"
if bits = "011" then outputs+="21"
if bits = "100" then outputs+="22"
if bits = "101" then outputs+="23"
if bits = "110" then outputs+="32"
if bits = "111" then outputs+="3"
next
print "c out = "; len(outputs) , outputs
dim as longint count2=0
do
str1=str(len(outputs)/4)
dec1=instr(1,str1,".")
if dec1<>0 then outputs+="0" : count2+=1
loop until dec1=0
dim as string final=""
dim as string b , num
for a as longint = 1 to len(outputs) step 4
b = mid(outputs,a,4)
num=""
num+=right("00" + bin(val(mid(b,1,1))),2)
num+=right("00" + bin(val(mid(b,2,1))),2)
num+=right("00" + bin(val(mid(b,3,1))),2)
num+=right("00" + bin(val(mid(b,4,1))),2)
final+=chr(val("&B"+num))
next
print "c fin = "; len(final) ' , final
final = chr(count1) + chr(count2) + final
return final
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
dim as longint count1 = asc(left(chrs,1))
chrs = mid(chrs,2)
dim as longint count2 = asc(left(chrs,1))
chrs = mid(chrs,2)
dim as string bytes=""
dim as ulongint n1
for a as longint = 0 to len(chrs)-1 step 1
n1 = chrs[a]
bytes+=right("00000000"+bin(n1),8)
next
dim as string octal=""
for a as longint = 1 to len(bytes) step 2
octal+=str(val("&B"+mid(bytes,a,2)))
next
octal = left(octal,len(octal)-count2)
print "d inp = "; len(octal) , octal
'Need to find stray 1's and 3's
'need to create output...
return chrs
end function