Squares

General FreeBASIC programming questions.
Locked
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Post by albert »

@Dodicat

Thanks for the info.... I'll go on to something else..

Lucky 7 turns out to be unlucky..
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Post by albert »

@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....
angros47
Posts: 2324
Joined: Jun 21, 2005 19:04

Re: Squares

Post by angros47 »

It compresses, but it also creates duplicates so it can't be decompressed. Check it
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Post by albert »

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..
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Post by albert »

@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..

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

angros47
Posts: 2324
Joined: Jun 21, 2005 19:04

Re: Squares

Post by angros47 »

I'd recommend you to read this: https://en.wikipedia.org/wiki/Lossless_ ... imitations, to figure why your algorithm can't work
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Post by albert »

@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....
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Post by albert »

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..

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

albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Yah-Zip ( 8 Bit )

Post by albert »

@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 )

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

albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Post by albert »

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....
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Post by albert »

@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
dodicat
Posts: 7983
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Post by dodicat »

Thank Albert.
Cheers.
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Post by albert »

@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...

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

albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Magnetic Propulsion

Post by albert »

@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??
Last edited by albert on Feb 04, 2020 3:11, edited 1 time in total.
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Post by albert »

@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..
===================================================================================
Locked