Squares
Re: Squares
@Dodicat
I found the problem...
outs1+= hex( val( "&B " + n2 ) )
There's a space after the B ,
Now it doesn't compress.. I couldn't figure out why it was compressing 30% on loop 1
I found the problem...
outs1+= hex( val( "&B " + n2 ) )
There's a space after the B ,
Now it doesn't compress.. I couldn't figure out why it was compressing 30% on loop 1
Re: Squares
Albert,
did you download the book on numbers? With your brilliant mind, I am sure you could write a program for each chapter. Would be fun for you and you might even stumble on a new way of compressing things.
http://www.plouffe.fr/simon/Phys%20et%2 ... umbers.pdf
did you download the book on numbers? With your brilliant mind, I am sure you could write a program for each chapter. Would be fun for you and you might even stumble on a new way of compressing things.
http://www.plouffe.fr/simon/Phys%20et%2 ... umbers.pdf
Re: Squares
Chapter 15 is dedicated to squares.
Richard had a nice link several years ago to mathematical enigmas.
I have completely lost the site.
Strange that when I was a book user I could go back years to so some topic with ease.
Just scan the book shelf to trigger a memory, and get the book down.
But now, even with bookmarking a site, things get lost.
Probably far too much information available or I am loosing some marbles.
Richard had a nice link several years ago to mathematical enigmas.
I have completely lost the site.
Strange that when I was a book user I could go back years to so some topic with ease.
Just scan the book shelf to trigger a memory, and get the book down.
But now, even with bookmarking a site, things get lost.
Probably far too much information available or I am loosing some marbles.
Yah-Zip ( Test Bed )
@Dodicat
I've got another formula that compresses... Compresses 100,000 bytes in by 98% after 100 loops..
I've got to figure out where to add and where to subtract... Got to solve the yellow values.
Here's the "Test Bed" where i write the decompression...
I've got another formula that compresses... Compresses 100,000 bytes in by 98% after 100 loops..
I've got to figure out where to add and where to subtract... Got to solve the yellow values.
Here's the "Test Bed" where i write the decompression...
Code: Select all
Declare Function compress_loop( chrs as string ) as string
Declare Function decompress_loop( chrs as string ) as string
screen 19
'=====================================================================
'=====================================================================
'start program
'=====================================================================
'=====================================================================
dim as double time1 , time2 , time3 , time4
do
randomize
dim as string s = ""
For n As Long = 1 To 8
s+=chr(Int(Rnd*256))
Next
time1=timer
'begin compress
dim as string comp = s
'do
' dim as longint chk = len(comp) - 1
' comp = compress_loop(comp)
' if len(comp) >= chk then exit do
' if inkey = chr( 27 ) then end
'loop
for a as longint = 1 to 1 step 1
comp = compress_loop(comp)
next
'end compress
time2 = timer
time3=timer
'begin decompress
dim as string final_out = comp
for a as longint = 1 to 1 step 1
final_out = decompress_loop(final_out)
next
'end decompress
time4 = timer
'sleep
print string(99,"=")
print "inp = " ; (s)
print string(99,"=")
print "out = " ; (final_out)
print
print "compress time = "; time2-time1
print "decompress time = "; time4-time3
print
if s = final_out then print "Decompressed OK" else print "Decompression failed."
print string(99,"=")
sleep
loop until inkey = chr(27)
sleep
end
'===============================================================================
'===============================================================================
'compress
'===============================================================================
'===============================================================================
Function compress_loop( chrs as string ) as string
print "c inp = " ; len(chrs) ' , chrs
dim as string 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 bin = " ; len( bits ) , ' , bits
for a as longint = 1 to len( bits ) step 4
print mid( bits , a , 4 ) ; " " ;
next
print
dim as string outs1 = ""
dim as string outs2 = ""
dim as longint v1 , v2
for a as longint = 1 to len( bits ) step 8
n1 = mid( bits , a , 8 )
v1 = val( "&B" + mid( n1 , 1 , 4 ) )
v2 = val( "&B" + mid( n1 , 5 , 4 ) )
if v1 <= v2 then outs1+= hex( v1 ) + hex( v2 - v1 )
if v1 > v2 then outs1+= hex( v1 ) + hex( v1 - v2 )
'print
'print n1
'print outs1
'print outs2
'sleep
'if inkey = " " then end
next
print "d bin = " ; len( outs1 ) , ', outs1
for a as longint = 1 to len( outs1 ) step 1
n1 = right( "0000" + mid( outs1 , a , 1 ) , 4 )
print n1 ; " " ;
next
print
dim as string final = ""
for a as longint = 1 to len( outs1 ) step 2
final+= chr( val( "&H" + mid( outs1 , a , 2 ) ) )
next
'for a as longint = 1 to len( outs2 ) step 8
' final+= chr( val( "&B" + mid( outs2 , a , 8 ) ) )
'next
print "c fin = " ; len( final )
return final
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
print "d inp = " ; len( chrs )
dim as string bits = ""
dim as string zeros = string( 2 , "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 + hex( *ubp ) : ubp+= 1
n1 = right( n1 , 2 )
bits+=n1
next
print "d bin = " ; len( bits ) , ', bits
for a as longint = 1 to len( bits ) step 1
n1 = right( "0000" + mid( bits , a , 1 ) , 4 )
if a mod 2 = 1 then color 11 else color 14
print n1 ; " " ;
next
color 15
print
return chrs
end function
Yah-Zip ( Test Bed )
@Dodicat
I altered it some.....Now it only compresses 100,000 bytes in by 64% after 100 loops. : takes about 20 seconds
===================================================
n1 = mid( bits , a , 8 )
v1 = val( "&B" + mid( n1 , 1 , 4 ) )
v2 = val( "&B" + mid( n1 , 5 , 4 ) )
if v1 <= v2 then outs1+= hex( v1 ) + hex( v2 )
if v1 > v2 then outs1+= hex( v1 ) + hex( v1 - v2 )
===================================================
If v1 <= v2 then the output is normal v1 + v2
if v1 > v2 then the output is v1 + ( v1 - v2 )
Got to solve the yellow values...
Here's the "Test Bed" where i write the decompression..
I altered it some.....Now it only compresses 100,000 bytes in by 64% after 100 loops. : takes about 20 seconds
===================================================
n1 = mid( bits , a , 8 )
v1 = val( "&B" + mid( n1 , 1 , 4 ) )
v2 = val( "&B" + mid( n1 , 5 , 4 ) )
if v1 <= v2 then outs1+= hex( v1 ) + hex( v2 )
if v1 > v2 then outs1+= hex( v1 ) + hex( v1 - v2 )
===================================================
If v1 <= v2 then the output is normal v1 + v2
if v1 > v2 then the output is v1 + ( v1 - v2 )
Got to solve the yellow values...
Here's the "Test Bed" where i write the decompression..
Code: Select all
Declare Function compress_loop( chrs as string ) as string
Declare Function decompress_loop( chrs as string ) as string
screen 19
'=====================================================================
'=====================================================================
'start program
'=====================================================================
'=====================================================================
dim as double time1 , time2 , time3 , time4
do
randomize
dim as string s = ""
For n As Long = 1 To 8
s+=chr(Int(Rnd*256))
Next
time1=timer
'begin compress
dim as string comp = s
'do
' dim as longint chk = len(comp) - 1
' comp = compress_loop(comp)
' if len(comp) >= chk then exit do
' if inkey = chr( 27 ) then end
'loop
for a as longint = 1 to 1 step 1
comp = compress_loop(comp)
next
'end compress
time2 = timer
time3=timer
'begin decompress
dim as string final_out = comp
for a as longint = 1 to 1 step 1
final_out = decompress_loop(final_out)
next
'end decompress
time4 = timer
'sleep
print string(99,"=")
print "inp = " ; (s)
print string(99,"=")
print "out = " ; (final_out)
print
print "compress time = "; time2-time1
print "decompress time = "; time4-time3
print
if s = final_out then print "Decompressed OK" else print "Decompression failed."
print string(99,"=")
sleep
loop until inkey = chr(27)
sleep
end
'===============================================================================
'===============================================================================
'compress
'===============================================================================
'===============================================================================
Function compress_loop( chrs as string ) as string
print "c inp = " ; len(chrs) ' , chrs
dim as string 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 bin = " ; len( bits ) , ' , bits
for a as longint = 1 to len( bits ) step 4
print mid( bits , a , 4 ) ; " " ;
next
print
dim as string outs1 = ""
dim as string outs2 = ""
dim as longint v1 , v2
for a as longint = 1 to len( bits ) step 8
n1 = mid( bits , a , 8 )
v1 = val( "&B" + mid( n1 , 1 , 4 ) )
v2 = val( "&B" + mid( n1 , 5 , 4 ) )
if v1 <= v2 then outs1+= hex( v1 ) + hex( v2 )
if v1 > v2 then outs1+= hex( v1 ) + hex( v1 - v2 )
'print
'print n1
'print outs1
'print outs2
'sleep
'if inkey = " " then end
next
print "d bin = " ; len( outs1 ) , ', outs1
for a as longint = 1 to len( outs1 ) step 1
n1 = right( "0000" + mid( outs1 , a , 1 ) , 4 )
print n1 ; " " ;
next
print
dim as string final = ""
for a as longint = 1 to len( outs1 ) step 2
final+= chr( val( "&H" + mid( outs1 , a , 2 ) ) )
next
'for a as longint = 1 to len( outs2 ) step 8
' final+= chr( val( "&B" + mid( outs2 , a , 8 ) ) )
'next
print "c fin = " ; len( final )
return final
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
print "d inp = " ; len( chrs )
dim as string bits = ""
dim as string zeros = string( 2 , "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 + hex( *ubp ) : ubp+= 1
n1 = right( n1 , 2 )
bits+=n1
next
print "d bin = " ; len( bits ) , ', bits
for a as longint = 1 to len( bits ) step 1
n1 = right( "0000" + mid( bits , a , 1 ) , 4 )
if a mod 2 = 1 then color 11 else color 14
print n1 ; " " ;
next
color 15
print
return chrs
end function
Re: Squares
Albert, are you competing for the Hutter Prize? http://prize.hutter1.net/
https://en.wikipedia.org/wiki/Hutter_Prize
For everyone else, I'll also share this link: https://www.quora.com/What-is-the-most- ... ocess-used
https://en.wikipedia.org/wiki/Hutter_Prize
For everyone else, I'll also share this link: https://www.quora.com/What-is-the-most- ... ocess-used
Re: Squares
@Dodicat
Never mind....
If v1 <= v2 then the output is normal v1 + v2
if v1 > v2 then the output is v1 + ( v1 - v2 )
if v2 = 0 then outputs = v1 , ( v1 - v2 ) It comes out to an equate.. like the first case.. no way to solve it..
Never mind....
If v1 <= v2 then the output is normal v1 + v2
if v1 > v2 then the output is v1 + ( v1 - v2 )
if v2 = 0 then outputs = v1 , ( v1 - v2 ) It comes out to an equate.. like the first case.. no way to solve it..
Re: Squares
@angros47
Hutter with an udder.. I'd like to win that prize!!!
One thought..
If you bring in a byte , input = bin( str[ 0 ] ) , The input has to start with a 1 unless the byte is 0
So you can lose the first bit... But if that first bit is followed by 0's then you don't know how many zeros to add back in....
You just know you have to add a 1 to the front...
Hutter with an udder.. I'd like to win that prize!!!
One thought..
If you bring in a byte , input = bin( str[ 0 ] ) , The input has to start with a 1 unless the byte is 0
So you can lose the first bit... But if that first bit is followed by 0's then you don't know how many zeros to add back in....
You just know you have to add a 1 to the front...
-
- Posts: 8586
- Joined: May 28, 2005 3:28
- Contact:
Re: Squares
@angros47 i donloaded the one GB xml/text file.
On a older PC with WIN 10 4GB VisualCode, Geany, FBIDE, MS Editor, FireFox all creasched while opening the file exept an Hex-Editor I'm in love with :-)
Than I reboot in Linux the simple editor gEdit does the job perfect including syntax highlighting.
I'm suree VisualCode and Geany crashed while highlighting the GB at once.
By the way I hate you, I try to compress the beast again and again, without your post my life would be much more lovely :-)
Joshy
On a older PC with WIN 10 4GB VisualCode, Geany, FBIDE, MS Editor, FireFox all creasched while opening the file exept an Hex-Editor I'm in love with :-)
Than I reboot in Linux the simple editor gEdit does the job perfect including syntax highlighting.
I'm suree VisualCode and Geany crashed while highlighting the GB at once.
By the way I hate you, I try to compress the beast again and again, without your post my life would be much more lovely :-)
Joshy
Yah-Zip ( Alter Bin )
@Richard
@Dodicat
I think I've finally done it... Compresses 100,000 bytes in by 80+% after 100 loops : Takes about 4 to 10 seconds...
( I need some help with the decompression... )
===================================
bits = character string converted to binary.
n1 = mid( bits , a , 6 )
s1 = 0
if n1[ 0 ] = 49 then s1+= 28
if n1[ 1 ] = 49 then s1+= 14
if n1[ 2 ] = 49 then s1+= 7
if n1[ 3 ] = 49 then s1+= 5
if n1[ 4 ] = 49 then s1+= 3
if n1[ 5 ] = 49 then s1+= 1
outs1+= chr( s1 )
===================================
I think I've checked all the possible values , so there's no duplicates..
Here it is doing 100,000 bytes in , in Dodicat's Zlib code...
@Dodicat
I think I've finally done it... Compresses 100,000 bytes in by 80+% after 100 loops : Takes about 4 to 10 seconds...
( I need some help with the decompression... )
===================================
bits = character string converted to binary.
n1 = mid( bits , a , 6 )
s1 = 0
if n1[ 0 ] = 49 then s1+= 28
if n1[ 1 ] = 49 then s1+= 14
if n1[ 2 ] = 49 then s1+= 7
if n1[ 3 ] = 49 then s1+= 5
if n1[ 4 ] = 49 then s1+= 3
if n1[ 5 ] = 49 then s1+= 1
outs1+= chr( s1 )
===================================
I think I've checked all the possible values , so there's no duplicates..
Here it is doing 100,000 bytes in , in Dodicat's Zlib code...
Code: Select all
' YAH-ZIP ( Alter Bin )
'
' Writen in FreeBasic for Windows
'
'Zlibrary code by Dodicat , From Scottland
'
' compress_loop() , decompress_loop by Albert Redditt
Declare Function compress_loop( chrs as string ) as string
Declare Function decompress_loop( chrs as string ) as string
Namespace Zlibrary
#inclib "zlib"
Extern "C"
Declare Function compressBound(Byval sourceLen As Ulong) As Ulong
Declare Function uncompress(Byval dest As Ubyte Ptr, Byval destLen As Uinteger Ptr, Byval source As Ubyte Ptr, Byval sourceLen As Ulong) As Long
Declare Function compress(Byval dest As Ubyte Ptr, Byval destLen As Uinteger Ptr, Byval source As Ubyte Ptr, Byval sourceLen As Ulong) As Long
End Extern
Function getpassedinfo(text As String,Byref passed_length As Integer) As String
Dim As String var1,var2
Dim As Integer pst
#macro splice(stri,char,var1,var2)
pst=Instr(stri,char)
var1="":var2=""
If pst<>0 Then
var1=Mid(stri,1,pst-1)
var2=Mid(stri,pst+1)
Else
var1=stri
End If
#endmacro
splice(text,"|",var1,var2)
text=var2
passed_length=Valint(var1)
Return text
End Function
'================= UNPACK ===============
Function unpack(file As String) As String
Dim As Integer passed_length
Dim As String text=getpassedinfo(file,passed_length)
Dim As Integer stringlength,destinationlength
stringlength=Len(text)
destinationlength =passed_length
Dim As Ubyte Ptr source
Dim As Ubyte Ptr destination =Callocate(destinationlength,1)
source=@text[0]
Var mistake=uncompress(destination,@destinationlength, source, stringlength)
If mistake<>0 Then Print "There was an error":Sleep:End
Dim As String uncompressed
uncompressed=String(destinationlength,0)
For i As Integer = 0 To destinationlength- 1
uncompressed[i]=(destination[i])
Next
Deallocate destination
Return uncompressed
End Function
'=================== PACK ============
Function pack(file As String) As String
Dim As String text=file
Dim As Integer stringlength,destinationlength
stringlength=Len(text)
destinationlength = compressBound(stringlength)
Dim As Ubyte Ptr source
Dim As Ubyte Ptr destination =Callocate(destinationlength,1)
source=@text[0]
Var mistake=compress(destination, @destinationlength, source, stringlength)
If mistake <>0 Then Print "There was an error"
Dim As String compressed
compressed=String(destinationlength,0)
For n As Integer=0 To destinationlength-1
compressed[n]=destination[n]
Next n
compressed=stringlength &"|"+compressed
Deallocate destination
Return compressed
End Function
End Namespace
'==================================================================
'==================================================================
'test zipper
'==================================================================
'==================================================================
screen 19
Dim Shared As String s
Randomize
s=""
dim as string check=""
dim as string compare=""
dim as longint length = 0
dim as double compression = 0
dim as longint loops = 0
dim as double time1 , time2
time1 = timer
do
loops+=1
'one time run , create initial string
if loops = 1 then
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 esc to exit."
print
print "press a key for next compression." ; " loops = " ; loops ; " out of 100."
'sleep
if inkey = chr(27) then exit do
loop until loops = 100
time2 = timer
print
print "Compress time = " ; time2 - time1
print
print "Press a key to decompress."
sleep
s = str(loops) + "_" + s ' save as an output file...
'==================================================================
'decompress
'==================================================================
dim as longint dec = instr(1,s,"_")
dim as longint count = val(left(s,dec-1))
dim as string comp = mid(s,dec+1)
dim as string val1
dim as string outs
for a as longint = count to 2 step -1
s = Zlibrary.unpack(comp)
outs = decompress_loop(s)
comp = outs
next
comp = Zlibrary.unpack(comp)
print
print "input = "; length , "output = " ; len(comp) , "compression ratio "; 100 - ( 100 / ( length / len(s) ) ) ; "%"
print
if comp = compare then print "Decompression successful." else print "ERROR"
print
print
Print "!!~~Done~~!!"
Sleep
end
'===============================================================================
'============================,===================================================
'begin functions
'===============================================================================
'================='==============================================================
Function compress_loop( chrs as string ) as string
print "c inp = " ; len(chrs) ' , chrs
dim as string bits = ""
dim as string 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 bin = " ; len( bits ) ' , bits
dim as ubyte count = 0
dim as string str1
dim as ubyte dec1
do
str1 = str( len( bits ) / 6 )
dec1 = instr( 1 , str1 , "." )
if dec1 <> 0 then bits+= "0" : count+= 1
loop until dec1 = 0
dim as string outs1 = ""
dim as longint s1
for a as longint = 1 to len( bits ) step 6
n1 = mid( bits , a , 6 )
s1 = 0
if n1[ 0 ] = 49 then s1+= 28
if n1[ 1 ] = 49 then s1+= 14
if n1[ 2 ] = 49 then s1+= 7
if n1[ 3 ] = 49 then s1+= 5
if n1[ 4 ] = 49 then s1+= 3
if n1[ 5 ] = 49 then s1+= 1
outs1+= chr( s1 )
'print n1 , s1
'sleep
'if inkey = " " then end
next
print "c out = " ; len( outs1 ) ' , outs1
dim as string final = outs1
final = chr( count ) + final
print "c fin = " ; len(final)
return final
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
print
print "d inp = " ; len( chrs )
dim as ubyte count = asc( left( chrs , 1 ) ) : chrs = mid( chrs , 2 )
dim as string bits = ""
dim as longint v1
for a as longint = 1 to len( chrs ) step 1
v1 = chrs[ a - 1 ]
'NEED TO SOLVE VALUES...
next
return chrs
end function
Re: Yah-Zip ( Alter Bin )
"001110" and "010001" both result in 15albert wrote:I think I've checked all the possible values , so there's no duplicates..
And there are more:
Code: Select all
dim as integer bits, s1
dim as string n1
for bits = 0 to &b111111
n1 = bin(bits, 6)
s1 = 0
if n1[ 0 ] = 49 then s1+= 28
if n1[ 1 ] = 49 then s1+= 14
if n1[ 2 ] = 49 then s1+= 7
if n1[ 3 ] = 49 then s1+= 5
if n1[ 4 ] = 49 then s1+= 3
if n1[ 5 ] = 49 then s1+= 1
print n1, s1
next
Re: Squares
Sorry , it was a badidea!!
Yah-Zip
@Dodicat
@badidea
I think i got it this time...
if mid( outs2 , a , 1 ) = "0" then you pull a value from outs1 ( 0 , 1 , 2 )
if mid( outs2 , a , 1 ) = "1" then you insert a "11" at that location
Here's Dodicat's Zlib code doing 100,000 bytes in over 50 loops.. ( compresses 99+% )
@badidea
I think i got it this time...
if mid( outs2 , a , 1 ) = "0" then you pull a value from outs1 ( 0 , 1 , 2 )
if mid( outs2 , a , 1 ) = "1" then you insert a "11" at that location
Here's Dodicat's Zlib code doing 100,000 bytes in over 50 loops.. ( compresses 99+% )
Code: Select all
' YAH-ZIP
'
' Writen in FreeBasic for Windows
'
'Zlibrary code by Dodicat , From Scottland
'
' compress_loop() , decompress_loop by Albert Redditt
Declare Function compress_loop( chrs as string ) as string
Declare Function decompress_loop( chrs as string ) as string
Namespace Zlibrary
#inclib "zlib"
Extern "C"
Declare Function compressBound(Byval sourceLen As Ulong) As Ulong
Declare Function uncompress(Byval dest As Ubyte Ptr, Byval destLen As Uinteger Ptr, Byval source As Ubyte Ptr, Byval sourceLen As Ulong) As Long
Declare Function compress(Byval dest As Ubyte Ptr, Byval destLen As Uinteger Ptr, Byval source As Ubyte Ptr, Byval sourceLen As Ulong) As Long
End Extern
Function getpassedinfo(text As String,Byref passed_length As Integer) As String
Dim As String var1,var2
Dim As Integer pst
#macro splice(stri,char,var1,var2)
pst=Instr(stri,char)
var1="":var2=""
If pst<>0 Then
var1=Mid(stri,1,pst-1)
var2=Mid(stri,pst+1)
Else
var1=stri
End If
#endmacro
splice(text,"|",var1,var2)
text=var2
passed_length=Valint(var1)
Return text
End Function
'================= UNPACK ===============
Function unpack(file As String) As String
Dim As Integer passed_length
Dim As String text=getpassedinfo(file,passed_length)
Dim As Integer stringlength,destinationlength
stringlength=Len(text)
destinationlength =passed_length
Dim As Ubyte Ptr source
Dim As Ubyte Ptr destination =Callocate(destinationlength,1)
source=@text[0]
Var mistake=uncompress(destination,@destinationlength, source, stringlength)
If mistake<>0 Then Print "There was an error":Sleep:End
Dim As String uncompressed
uncompressed=String(destinationlength,0)
For i As Integer = 0 To destinationlength- 1
uncompressed[i]=(destination[i])
Next
Deallocate destination
Return uncompressed
End Function
'=================== PACK ============
Function pack(file As String) As String
Dim As String text=file
Dim As Integer stringlength,destinationlength
stringlength=Len(text)
destinationlength = compressBound(stringlength)
Dim As Ubyte Ptr source
Dim As Ubyte Ptr destination =Callocate(destinationlength,1)
source=@text[0]
Var mistake=compress(destination, @destinationlength, source, stringlength)
If mistake <>0 Then Print "There was an error"
Dim As String compressed
compressed=String(destinationlength,0)
For n As Integer=0 To destinationlength-1
compressed[n]=destination[n]
Next n
compressed=stringlength &"|"+compressed
Deallocate destination
Return compressed
End Function
End Namespace
'==================================================================
'==================================================================
'test zipper
'==================================================================
'==================================================================
screen 19
Dim Shared As String s
Randomize
s=""
dim as string check=""
dim as string compare=""
dim as longint length = 0
dim as double compression = 0
dim as longint loops = 0
dim as double time1 , time2
time1 = timer
do
loops+=1
'one time run , create initial string
if loops = 1 then
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 esc to exit."
print
print "press a key for next compression." ; " loops = " ; loops ; " out of 50."
'sleep
if inkey = chr(27) then exit do
loop until loops = 50
time2 = timer
print
print "Compress time = " ; time2 - time1
print
print "Press a key to decompress."
sleep
s = str(loops) + "_" + s ' save as an output file...
'==================================================================
'decompress
'==================================================================
dim as longint dec = instr(1,s,"_")
dim as longint count = val(left(s,dec-1))
dim as string comp = mid(s,dec+1)
dim as string val1
dim as string outs
for a as longint = count to 2 step -1
s = Zlibrary.unpack(comp)
outs = decompress_loop(s)
comp = outs
next
comp = Zlibrary.unpack(comp)
print
print "input = "; length , "output = " ; len(comp) , "compression ratio "; 100 - ( 100 / ( length / len(s) ) ) ; "%"
print
if comp = compare then print "Decompression successful." else print "ERROR"
print
print
Print "!!~~Done~~!!"
Sleep
end
'===============================================================================
'============================,===================================================
'begin functions
'===============================================================================
'================='==============================================================
Function compress_loop( chrs as string ) as string
print "c inp = " ; len(chrs) ' , chrs
dim as string bits = ""
dim as string 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 bin = " ; len( bits ) ' , bits
dim as string outs1 = ""
for a as longint = 1 to len( bits ) step 2
n1 = mid( bits , a , 2 )
if n1 = "00" then outs1+= "0" : mid( bits , a , 2 ) = "0~"
if n1 = "01" then outs1+= "1" : mid( bits , a , 2 ) = "0~"
if n1 = "10" then outs1+= "2" : mid( bits , a , 2 ) = "0~"
if n1 = "11" then mid( bits , a , 2 ) = "1~"
next
dim as string outs2 = ""
for a as longint = 1 to len( bits ) step 1
n1 = mid( bits , a , 1 )
if n1 <> "~" then outs2+= n1
next
print "c out = " ; len( outs1 ) ' , outs1
print "c out = " ; len( outs2 ) ' , outs2
dim as string final = ""
for a as longint = 1 to len( outs1 ) step 3
final+= chr( val( "&O" + mid( outs1 , a , 3 ) ) )
next
final+= "END"
for a as longint = 1 to len( outs2 ) step 8
final+= chr( val( "&B" + mid( outs1 , 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
Yah-Zip
I need someone to check this out for me...
For some reason it's compressing 70% on loop 1..
Can't figure it out... Did i finally get compression ????
For some reason it's compressing 70% on loop 1..
Can't figure it out... Did i finally get compression ????
Code: Select all
' YAH-ZIP
'
' Writen in FreeBasic for Windows
'
'Zlibrary code by Dodicat , From Scottland
'
' compress_loop() , decompress_loop by Albert Redditt
Declare Function compress_loop( chrs as string ) as string
Declare Function decompress_loop( chrs as string ) as string
Namespace Zlibrary
#inclib "zlib"
Extern "C"
Declare Function compressBound(Byval sourceLen As Ulong) As Ulong
Declare Function uncompress(Byval dest As Ubyte Ptr, Byval destLen As Uinteger Ptr, Byval source As Ubyte Ptr, Byval sourceLen As Ulong) As Long
Declare Function compress(Byval dest As Ubyte Ptr, Byval destLen As Uinteger Ptr, Byval source As Ubyte Ptr, Byval sourceLen As Ulong) As Long
End Extern
Function getpassedinfo(text As String,Byref passed_length As Integer) As String
Dim As String var1,var2
Dim As Integer pst
#macro splice(stri,char,var1,var2)
pst=Instr(stri,char)
var1="":var2=""
If pst<>0 Then
var1=Mid(stri,1,pst-1)
var2=Mid(stri,pst+1)
Else
var1=stri
End If
#endmacro
splice(text,"|",var1,var2)
text=var2
passed_length=Valint(var1)
Return text
End Function
'================= UNPACK ===============
Function unpack(file As String) As String
Dim As Integer passed_length
Dim As String text=getpassedinfo(file,passed_length)
Dim As Integer stringlength,destinationlength
stringlength=Len(text)
destinationlength =passed_length
Dim As Ubyte Ptr source
Dim As Ubyte Ptr destination =Callocate(destinationlength,1)
source=@text[0]
Var mistake=uncompress(destination,@destinationlength, source, stringlength)
If mistake<>0 Then Print "There was an error":Sleep:End
Dim As String uncompressed
uncompressed=String(destinationlength,0)
For i As Integer = 0 To destinationlength- 1
uncompressed[i]=(destination[i])
Next
Deallocate destination
Return uncompressed
End Function
'=================== PACK ============
Function pack(file As String) As String
Dim As String text=file
Dim As Integer stringlength,destinationlength
stringlength=Len(text)
destinationlength = compressBound(stringlength)
Dim As Ubyte Ptr source
Dim As Ubyte Ptr destination =Callocate(destinationlength,1)
source=@text[0]
Var mistake=compress(destination, @destinationlength, source, stringlength)
If mistake <>0 Then Print "There was an error"
Dim As String compressed
compressed=String(destinationlength,0)
For n As Integer=0 To destinationlength-1
compressed[n]=destination[n]
Next n
compressed=stringlength &"|"+compressed
Deallocate destination
Return compressed
End Function
End Namespace
'==================================================================
'==================================================================
'test zipper
'==================================================================
'==================================================================
screen 19
Dim Shared As String s
Randomize
s=""
dim as string check=""
dim as string compare=""
dim as longint length = 0
dim as double compression = 0
dim as longint loops = 0
dim as double time1 , time2
time1 = timer
do
loops+=1
'one time run , create initial string
if loops = 1 then
For n As Long = 1 To 1000000
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 esc to exit."
print
print "press a key for next compression." ; " loops = " ; loops ; " out of 100."
sleep
if inkey = chr(27) then exit do
loop until loops = 100
time2 = timer
print
print "Compress time = " ; time2 - time1
print
print "Press a key to decompress."
sleep
s = str(loops) + "_" + s ' save as an output file...
'==================================================================
'decompress
'==================================================================
dim as longint dec = instr(1,s,"_")
dim as longint count = val(left(s,dec-1))
dim as string comp = mid(s,dec+1)
dim as string val1
dim as string outs
for a as longint = count to 2 step -1
s = Zlibrary.unpack(comp)
outs = decompress_loop(s)
comp = outs
next
comp = Zlibrary.unpack(comp)
print
print "input = "; length , "output = " ; len(comp) , "compression ratio "; 100 - ( 100 / ( length / len(s) ) ) ; "%"
print
if comp = compare then print "Decompression successful." else print "ERROR"
print
print
Print "!!~~Done~~!!"
Sleep
end
'===============================================================================
'============================,===================================================
'begin functions
'===============================================================================
'================='==============================================================
Function compress_loop( chrs as string ) as string
print "c inp = " ; len(chrs) ' , chrs
dim as string outs1 = ""
dim as string outs2 = ""
dim as string n1
dim as longint v1
dim as ubyte ptr ubp = cptr( ubyte ptr , strptr( chrs ) )
for a as longint = 1 to len( chrs ) step 1
n1 = bin( *ubp ) : ubp+= 1
v1 = instr( 1 , n1 , "0" )
outs1+= mkshort( val( "1" + "&B" + mid( n1 , v1 ) ) )
outs2+= str( v1 )
next
print "c out = " ; len( outs1 ) ' , outs1
print "c out = " ; len( outs2 ) ' , outs2
dim as string final = outs1
'for a as longint = 1 to len( outs1 ) step 3
' final+= chr( val( "&O" + mid( outs1 , a , 3 ) ) )
'next
final+= "END"
for a as longint = 1 to len( outs2 ) step 2
final+= chr( val( mid( outs2 , a , 2 ) ) )
next
print "c fin = " ; len(final)
return final
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
print
print "d inp = " ; len( chrs )
return chrs
end function
Re: Squares
Albert.
A compressor but without a decompressor.
I could take a note of the swaps, write to a separate file and compress this.
Then use the two files to get back.
Maybe I'll try it out tomorrow.
A compressor but without a decompressor.
I could take a note of the swaps, write to a separate file and compress this.
Then use the two files to get back.
Maybe I'll try it out tomorrow.
Code: Select all
#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
Enum
up
down
End Enum
dim shared as long direction
direction=up
sub sort(s As string,begin As Long,Finish As Long)
Dim As Long i=begin,j=finish
Dim As ubyte x =S[(I+J)\2]
While I <= J
if direction=down then
While S[I] > X:I+=1:Wend
While S[J] < X:J-=1:Wend
else
While S[I] < X:I+=1:Wend
While S[J] > X:J-=1:Wend
end if
If I<=J Then
Swap S[I],S[J]'todo save the swaps i and j
I+=1:J-=1
end if
wend
If J > begin Then sort(S,begin,J)
If I < Finish Then sort(S,I,Finish)
End sub
#define range(f,l) int(Rnd*((l+1)-(f))+(f))
dim as string f=string(500000,0)
for n as long=0 to len(f)-1
f[n]=range(65,122)
next
dim as double t=timer,t2
sort(f,0,len(f)-1)
print f
print "Length ";len(f)
var c=pack(f)
print
print
print c
print "Compressed length "; len(c)
print "compression ";len(c)/len(f)
var orig=unpack(c)
print "Decompress length "; len(orig)
t2=timer
print "Total time ";t2-t
print "Done"
sleep