Squares
Re: Squares
@Dodicat
Thanks for the info.... I'll go on to something else..
Lucky 7 turns out to be unlucky..
Thanks for the info.... I'll go on to something else..
Lucky 7 turns out to be unlucky..
Re: Squares
@Dodicat
@Richard
If i create a dictionary of , say , 15 different bytes..
And go through the data and replace those 15 bytes with 0 to 15 , what do i do with the bytes that equal 0 to 15??
It compresses ; because some of the data bytes , equal 0 to 15....
@Richard
If i create a dictionary of , say , 15 different bytes..
And go through the data and replace those 15 bytes with 0 to 15 , what do i do with the bytes that equal 0 to 15??
It compresses ; because some of the data bytes , equal 0 to 15....
Re: Squares
It compresses, but it also creates duplicates so it can't be decompressed. Check it
Re: Squares
I forgot to upload my "Raised On Country" song... To Sound Cloud
Here it is....
https://soundcloud.com/user-704620747
A little long , but it came out okay.. Nashville Song Service , they did a good job with the music..
For people who wonder:
Besides writing programs that don';t work , I write song lyrics also...
I send the lyrics to a demo company to produce the song.. They usually charge $350 to $1000 a song..
Here it is....
https://soundcloud.com/user-704620747
A little long , but it came out okay.. Nashville Song Service , they did a good job with the music..
For people who wonder:
Besides writing programs that don';t work , I write song lyrics also...
I send the lyrics to a demo company to produce the song.. They usually charge $350 to $1000 a song..
Re: Squares
@Dodicat
I found another formula that compresses... But it also can't be decompressed...
Just something interesting i discovered..
n1 = mid( bits , a , 8 )
v1 = val( "&B" + mid( n1 , 1 , 4 ) )
v2 = val( "&B" + mid( n1 , 5 , 4 ) )
if v1<= v2 then bits1+= hex( v1 ) + hex( v2 )
if v1> v2 then bits1+= hex( v2 ) + hex( v1 )
Just putting the smallest nibble first , compresses to 99% , 100,000 bytes in turns into 560 bytes , after 100 loops..
I found another formula that compresses... But it also can't be decompressed...
Just something interesting i discovered..
n1 = mid( bits , a , 8 )
v1 = val( "&B" + mid( n1 , 1 , 4 ) )
v2 = val( "&B" + mid( n1 , 5 , 4 ) )
if v1<= v2 then bits1+= hex( v1 ) + hex( v2 )
if v1> v2 then bits1+= hex( v2 ) + hex( v1 )
Just putting the smallest nibble first , compresses to 99% , 100,000 bytes in turns into 560 bytes , after 100 loops..
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
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 bit = " ; len( bits ) ' , bits
dim as string bits1 = ""
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 bits1+= hex( v1 ) + hex( v2 )
if v1> v2 then bits1+= hex( v2 ) + hex( v1 )
'UNCOMMENT TO SEE VALUES.
'print
'print n1 , v1 , v2 , v3 , bits1
'sleep
'if inkey = " " then end
next
print "c out = " ; len( bits1 ) ', bits1
dim as string final = ""
for a as longint = 1 to len( bits1 ) step 2
final+= chr( val( "&H" + mid( bits1 , 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
I'd recommend you to read this: https://en.wikipedia.org/wiki/Lossless_ ... imitations, to figure why your algorithm can't work
Re: Squares
@angros47
The above can't be decompressed , because you don't know which nibble is which.. All you know is the smallest nibble is first..
You can't tell from the output , if v1 or v2 is the smallest..
Maybe if v2 < v1 then you output a chr() else you output hex() ???
I'll keep playing with it to see if i can come up with something....
The above can't be decompressed , because you don't know which nibble is which.. All you know is the smallest nibble is first..
You can't tell from the output , if v1 or v2 is the smallest..
Maybe if v2 < v1 then you output a chr() else you output hex() ???
I'll keep playing with it to see if i can come up with something....
Re: Squares
I think I've got something..
Can it be undone???
============================================
dim as string bits1 = ""
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 bits1+= hex( v1 ) + hex( v2 - v1 )
if v1> v2 then bits1+= hex( v1 ) + hex( v1 - v2 )
next
===========================================
Compresses 100,000 bytes by 98% after 100 loops..
Can it be undone???
============================================
dim as string bits1 = ""
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 bits1+= hex( v1 ) + hex( v2 - v1 )
if v1> v2 then bits1+= hex( v1 ) + hex( v1 - v2 )
next
===========================================
Compresses 100,000 bytes by 98% after 100 loops..
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
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 bit = " ; len( bits ) ' , bits
dim as string bits1 = ""
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 bits1+= hex( v1 ) + hex( v2 - v1 )
if v1> v2 then bits1+= hex( v1 ) + hex( v1 - v2 )
'UNCOMMENT TO SEE VALUES.
'print
'print n1 , v1 , v2 , v3 , bits1
'sleep
'if inkey = " " then end
next
print "c out = " ; len( bits1 ) ', bits1
dim as string final = ""
for a as longint = 1 to len( bits1 ) step 2
final+= chr( val( "&H" + mid( bits1 , 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
Yah-Zip ( 8 Bit )
@Richard
@Dodicat
( !!~~ COMPRESSION SUCCESS ~~!! )
Compresses 100,000 bytes by 65% after 100 loops : Takes 24 seconds..
=======================================================
n1 = mid( bits , a , 8 )
v1 = val( "&B" + mid( n1 , 1 , 4 ) )
v2 = val( "&B" + mid( n1 , 5 , 4 ) )
if v1<= v2 then bits1+= hex( v1 ) + hex( v2 )
if v1> v2 then bits1+= hex( v1 ) + hex( v1 - v2 )
======================================================
If the first hex digit is less than the second one , then you know it's V1 , v2
If the first hex digit is greater than the second one , then you know it's V1 , ( v1- v2 )
@Dodicat
( !!~~ COMPRESSION SUCCESS ~~!! )
Compresses 100,000 bytes by 65% after 100 loops : Takes 24 seconds..
=======================================================
n1 = mid( bits , a , 8 )
v1 = val( "&B" + mid( n1 , 1 , 4 ) )
v2 = val( "&B" + mid( n1 , 5 , 4 ) )
if v1<= v2 then bits1+= hex( v1 ) + hex( v2 )
if v1> v2 then bits1+= hex( v1 ) + hex( v1 - v2 )
======================================================
If the first hex digit is less than the second one , then you know it's V1 , v2
If the first hex digit is greater than the second one , then you know it's V1 , ( v1- v2 )
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
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 bit = " ; len( bits ) ' , bits
dim as string bits1 = ""
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 bits1+= hex( v1 ) + hex( v2 )
if v1> v2 then bits1+= hex( v1 ) + hex( v1 - v2 )
'UNCOMMENT TO SEE VALUES.
'print
'print n1 , v1 , v2 , bits1
'sleep
'if inkey = " " then end
next
print "c out = " ; len( bits1 ) ', bits1
dim as string final = ""
for a as longint = 1 to len( bits1 ) step 2
final+= chr( val( "&H" + mid( bits1 , 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
While writing the decompression , i ran into a problem...
if v1> v2 then bits1+= hex( v1 ) + hex( v1 - v2 )
if v1 = 3 and and v2 = 0 , then the output would be 33 , it would look like an equate of 3 , 3
If you add 1 to v2 , ( ( v1 - (v2+1) ) then it doesn't compress...
Back to the drawing board....
if v1> v2 then bits1+= hex( v1 ) + hex( v1 - v2 )
if v1 = 3 and and v2 = 0 , then the output would be 33 , it would look like an equate of 3 , 3
If you add 1 to v2 , ( ( v1 - (v2+1) ) then it doesn't compress...
Back to the drawing board....
Re: Squares
@Dodicat
I rewrote the Scottish "Auld Lang Syne" song , and called it "New Years Eve"
New Years was a month ago , I intend to get it demo'd later this year so it will be ready for the next New Year..
( Genre = ??? )
( Title = New Years Eve )
( entry music )
should we all drink another beer , for the passing of yule-tide
we're ringing in another year , and with cheer we all imbibe
and should our new years eve dinner , be of pork or country ham
they sailed cross the ocean blue , and here's a toast to the land
and should our new years eve this year , turn into a valentine
we count our blessings as we go , i'll be hers and she'll be mine
we're ringing in another year , as the old one passes by
and with a cheer we drink a beer, as the hour hand goes high
( music )
should we all drink another beer , for the passing of yule-tide
we're ringing in another year , and with cheer we all imbibe
should we all meet on new years eve , for a party at the end
as the new year is ringing in, have you got a cheer to lend
should we all meet on new years eve , drinking beer and shots and wine
we're waiting for the ball to drop , with a taste of bubbly wine
should we ring in another year , with a cheer a shout a cry
we're drinking beer and shots and wine , as the old year passes by
( music )
should we all drink another beer , for the passing of yule-tide
we're ringing in another year , and with cheer we all imbibe
( exit music )
albert_redditt@yahoo.com
Albert Redditt
315 W. Carrillo St. #104
Santa Barbara, Ca. 93101 U.S.A.
Here's me singing it : https://soundcloud.com/user-704620747
I rewrote the Scottish "Auld Lang Syne" song , and called it "New Years Eve"
New Years was a month ago , I intend to get it demo'd later this year so it will be ready for the next New Year..
( Genre = ??? )
( Title = New Years Eve )
( entry music )
should we all drink another beer , for the passing of yule-tide
we're ringing in another year , and with cheer we all imbibe
and should our new years eve dinner , be of pork or country ham
they sailed cross the ocean blue , and here's a toast to the land
and should our new years eve this year , turn into a valentine
we count our blessings as we go , i'll be hers and she'll be mine
we're ringing in another year , as the old one passes by
and with a cheer we drink a beer, as the hour hand goes high
( music )
should we all drink another beer , for the passing of yule-tide
we're ringing in another year , and with cheer we all imbibe
should we all meet on new years eve , for a party at the end
as the new year is ringing in, have you got a cheer to lend
should we all meet on new years eve , drinking beer and shots and wine
we're waiting for the ball to drop , with a taste of bubbly wine
should we ring in another year , with a cheer a shout a cry
we're drinking beer and shots and wine , as the old year passes by
( music )
should we all drink another beer , for the passing of yule-tide
we're ringing in another year , and with cheer we all imbibe
( exit music )
albert_redditt@yahoo.com
Albert Redditt
315 W. Carrillo St. #104
Santa Barbara, Ca. 93101 U.S.A.
Here's me singing it : https://soundcloud.com/user-704620747
Re: Squares
Thank Albert.
Cheers.
Cheers.
Re: Squares
@Richard
@Dodicat
Another compression formula... Lossy compression..
Compresses 100,000 bytes to 16,500 bytes , 83% , after 100 loops : Takes 20 seconds.
======================================
n1 = mid( bits , a , 6 )
v1 = val( "&B" + n1 ) + 1
randomize 0
for b as longint = 1 to v1 step 1
v2 = int( rnd * 256 )
next
bits1+= chr( v2 )
=====================================
It gets most values right , there's some values that are off...
@Dodicat
Another compression formula... Lossy compression..
Compresses 100,000 bytes to 16,500 bytes , 83% , after 100 loops : Takes 20 seconds.
======================================
n1 = mid( bits , a , 6 )
v1 = val( "&B" + n1 ) + 1
randomize 0
for b as longint = 1 to v1 step 1
v2 = int( rnd * 256 )
next
bits1+= chr( v2 )
=====================================
It gets most values right , there's some values that are off...
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
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 bit = " ; len( bits ) ' , bits
dim as string bits1 = ""
dim as string n2
dim as longint v1 , v2 , v3
for a as longint = 1 to len( bits ) step 6
n1 = mid( bits , a , 6 )
v1 = val( "&B" + n1 ) + 1
randomize 0
for b as longint = 1 to v1 step 1
v2 = int( rnd * 256 )
next
bits1+= chr( v2 )
'UNCOMMENT TO SEE VALUES.
'dim as longint count = 0
'randomize 0
'do
' v3 = int( rnd * 256 ) : count+= 1
'loop until v3 = v2
'print
'print v1 , v2 , v3 , count
'sleep
'if inkey = " " then end
next
print "c out = " ; len( bits1 ) ', bits1
dim as string final = bits1
'for a as longint = 1 to len( bits1 ) step 2
' final+= chr( val( mid( bits1 , 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
Magnetic Propulsion
@Richard
@Dodicat
I think i already posted about this.. "Magnetic Propulsion"
You create a magnetic field in space and then turn it off , then you repel the created field , before it collapses..
So you have a field coil to create the field , and then turn it off , and then turn on a repelling coil.
When you turn the field coil off , the field collapses at the speed of light...
So you have a fraction of a second to repel the collapsing field.. ( that fraction of a second for the field collapse , might be in nano-seconds? )
So you pulse the outer coil at some frequency..
And then pulse the inner coil at some real high frequency like MHz or GHz.
You calculate the size of the field the outer coil creates , and then calculate the speed of light traveling that distance..to get the collapse time.
Then you pulse the inner coil faster than that collapse time..
So if your outer coil creates a 4 inch field , then you calculate how many seconds it takes light to travel 4 inches..
And then , you have to pulse the inner coil , before that time frame is over...
I was pondering on the movie , "Back To The Future" , where they go into the future , and in the future , they have "Hover Boards"
I was contemplating on how the "Hover Boards" might work...
Create a field and then repel it..
Might be how alien space ships work??
I was thinking of how to create a program , to visualize the two opposing fields...
It might be like a sky-diver throwing out a board , and trying to take a step up , from it??
@Dodicat
I think i already posted about this.. "Magnetic Propulsion"
You create a magnetic field in space and then turn it off , then you repel the created field , before it collapses..
So you have a field coil to create the field , and then turn it off , and then turn on a repelling coil.
When you turn the field coil off , the field collapses at the speed of light...
So you have a fraction of a second to repel the collapsing field.. ( that fraction of a second for the field collapse , might be in nano-seconds? )
So you pulse the outer coil at some frequency..
And then pulse the inner coil at some real high frequency like MHz or GHz.
You calculate the size of the field the outer coil creates , and then calculate the speed of light traveling that distance..to get the collapse time.
Then you pulse the inner coil faster than that collapse time..
So if your outer coil creates a 4 inch field , then you calculate how many seconds it takes light to travel 4 inches..
And then , you have to pulse the inner coil , before that time frame is over...
I was pondering on the movie , "Back To The Future" , where they go into the future , and in the future , they have "Hover Boards"
I was contemplating on how the "Hover Boards" might work...
Create a field and then repel it..
Might be how alien space ships work??
I was thinking of how to create a program , to visualize the two opposing fields...
It might be like a sky-diver throwing out a board , and trying to take a step up , from it??
Last edited by albert on Feb 04, 2020 3:11, edited 1 time in total.
Re: Squares
@Richard
@Dodicat
It might be like a sky-diver throwing out a board , and trying to take a step up??
I was pondering on , the magnetic field is created by particles..
And those particles are traveling ( orbiting ) in a circle , at the speed of light..
And they would have resistance to being pushed out of their orbits..
So, field repulsion , would then be possible..
Magnets repel , because the particles , can't be easily pushed out of their orbits..
If the praticles could easily be displaced , like a sky-diver stepping up on a board..
Then the two opposing magnets wouldn't repel.... They would easily displace each others particles..
So , field repulsion must therefore be possible....
If you take two magnets , and try to push like sides together..
You can push them together , but not without some resistance..
So the magnetons can be displaced from their orbits but have some resistance...
So:
It's not like a sky-diver , trying to step up on a board he threw out..
It's like a logger trying to walk across across logs , floating on a river... There's some resistance to sinking...
So : field repulsion is therefore , quite possible...
===================================================================================
Just use Philosophy:
Philosophy is the art of pondering a problem , till you have arrived at the grandest solution..
===================================================================================
@Dodicat
It might be like a sky-diver throwing out a board , and trying to take a step up??
I was pondering on , the magnetic field is created by particles..
And those particles are traveling ( orbiting ) in a circle , at the speed of light..
And they would have resistance to being pushed out of their orbits..
So, field repulsion , would then be possible..
Magnets repel , because the particles , can't be easily pushed out of their orbits..
If the praticles could easily be displaced , like a sky-diver stepping up on a board..
Then the two opposing magnets wouldn't repel.... They would easily displace each others particles..
So , field repulsion must therefore be possible....
If you take two magnets , and try to push like sides together..
You can push them together , but not without some resistance..
So the magnetons can be displaced from their orbits but have some resistance...
So:
It's not like a sky-diver , trying to step up on a board he threw out..
It's like a logger trying to walk across across logs , floating on a river... There's some resistance to sinking...
So : field repulsion is therefore , quite possible...
===================================================================================
Just use Philosophy:
Philosophy is the art of pondering a problem , till you have arrived at the grandest solution..
===================================================================================