Squares

[albert]

@Dodicat

I got a search function done in the decompression... It's sometimes getting it right..

Got to figure out how to do the search , first to last and backwards , last to first ....

Here's the "Test-Bed"

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 n1
    dim as longint v1 , v2 , v3 , v4
    for a as longint = 1 to len( chrs ) step 1
        n1 = "00000000" + bin( chrs[ a - 1 ] )
        n1 = right( n1 , 8 )
        bits+= n1
    next
    
    print "c bin = " ; len( bits ) , bits
    
    dim as string bits1 = ""
    dim as string bits2 = ""
    for a as longint = 1 to len( bits ) step 4
        
        n1 = mid( bits , a , 4 )
        
        if n1 = "0000" then bits1+= "0" : bits2+= "0"
        if n1 = "0001" then bits1+= "1" : bits2+= "0"
        if n1 = "0010" then bits1+= "2" : bits2+= "0"
        if n1 = "0011" then bits1+= "3" : bits2+= "0"
        
        if n1 = "0100" then bits1+= "0" : bits2+= "10"
        if n1 = "0101" then bits1+= "1" : bits2+= "10"
        if n1 = "0110" then bits1+= "2" : bits2+= "10"
        if n1 = "0111" then bits1+= "3" : bits2+= "10"
        
        if n1 = "1000" then bits1+= "0" : bits2+= "11"
        if n1 = "1001" then bits1+= "1" : bits2+= "11"
        if n1 = "1010" then bits1+= "2" : bits2+= "11"
        if n1 = "1011" then bits1+= "3" : bits2+= "11"
        
        if n1 = "1100" then bits1+= "00" : bits2+= "0"
        if n1 = "1101" then bits1+= "11" : bits2+= "0"
        if n1 = "1110" then bits1+= "22" : bits2+= "0"
        if n1 = "1111" then bits1+= "33" : bits2+= "0"

    next
    
    print
    print "c out = " ; len( bits1 ) , bits1
    print "c out = " ; len( bits2 ) , bits2
    
    dim as ubyte count1 = 0
    dim as string str1 = ""
    dim as ubyte dec1
    do
        str1 = str( len( bits1 ) / 4 )
        dec1 = instr( 1 , str1 , "." )
        if dec1 <> 0 then bits1+= "0" : count1+= 1
    loop until dec1 = 0
    
    dim as ubyte count2 = 0
    dim as string str2 = ""
    dim as ubyte dec2
    do
        str2 = str( len( bits2 ) / 8 )
        dec2 = instr( 1 , str2 , "." )
        if dec2 <> 0 then bits2+= "0" : count2+= 1
    loop until dec2 = 0
    
    dim as string final = ""
    dim as string s , n
    for b as longint = 1 to len( bits1 ) step 4
        s = mid( bits1 , b , 4 )
        n = ""
        n+= right( "00" + bin( val( mid( s , 1 , 1 ) ) ) , 2 )
        n+= right( "00" + bin( val( mid( s , 2 , 1 ) ) ) , 2 )
        n+= right( "00" + bin( val( mid( s , 3 , 1 ) ) ) , 2 )
        n+= right( "00" + bin( val( mid( s , 4 , 1 ) ) ) , 2 )
        final+= chr( val( "&B" +  n ) )
        'final+= chr( val( "&B" + mid( bits1 , b , 8 ) ) )
    next
    final+= "END"
    for b as longint = 1 to len( bits2 ) step 8
        final+= chr( val( "&B" + mid( bits2 , b , 8 ) ) )
    next
    
    final = chr( count1 ) + chr( count2 )  + 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 count1 = asc( left( chrs , 1 ) ) : chrs = mid( chrs , 2 )
    dim as ubyte count2 = asc( left( chrs , 1 ) ) : chrs = mid( chrs , 2 )
    
    dim as longint place = instr( 1 , chrs , "END" ) - 1
    dim as string bits1 = left( chrs , place )
    dim as string bits2 = mid( chrs , place + 4 )
    
    dim as string outs1 = ""
    dim as string n1
    dim as string v1 , v2 , v3 , v4
    for a as longint = 1 to len( bits1 ) step 1
        n1 = "00000000" + bin( bits1[ a - 1 ] )
        n1 = right( n1 , 8 )
        v1 = str( val( "&B" + mid( n1 , 1 , 2 ) ) ) 
        v2 = str( val( "&B" + mid( n1 , 3 , 2 ) ) ) 
        v3 = str( val( "&B" + mid( n1 , 5 , 2 ) ) ) 
        v4 = str( val( "&B" + mid( n1 , 7 , 2 ) ) ) 
        outs1+= v1 + v2 + v3 + v4
    next
    outs1 = left( outs1 , len( outs1 ) - count1 )
    
    dim as string outs2 = ""
    for a as longint = 1 to len( bits2 ) step 1
        n1 = "00000000" + bin( bits2[ a - 1 ] )
        n1 = right( n1 , 8 )
        outs2+= n1
    next
    outs2 = left( outs2 , len( outs2 ) - count2 )
    
    print "d out = " ; len( outs1 ) , outs1
    print "d out = " ; len( outs2 ) , outs2
    
    
    dim as string show1 = ""
    dim as string show2 = ""
    dim as string n2
    dim as longint pl1 = 1 , pl2 = 1
    do
        n1 = mid( outs2 , pl1 , 1 )
        n2 = mid( outs1 , pl2 , 1 )
        
        if n1 = "0" then
            show2+= "_" + n1 + "_"  : pl1+= 1
            if mid( outs1 , pl2 + 1 , 1 ) = n2 then 
                show1+= n2 + n2 + "_"  : pl2+= 2
            else
                show1+= "_" + n2 + "_" : pl2+=1
            end if
        end if
            
        if n1 = "1" then 
            n1+= mid( outs2 , pl1 + 1 , 1 ) : pl1+= 2 : show2+= n1 + "_"
            show1+= "_" + n2 + "_" : pl2+=1
        end if
        
    loop until pl1 > len( outs2 )
        
    print
    print "d sho = " ; len( show1 ) , show1
    print "d sho = " ; len( show2 ) , show2
    
    return chrs
   
end function

[albert]

@Dodicat

I went back to mods... Here's another compressor..

7 bits input..
===============================================
n1 = mid( bits , a , 7 )

v1 = val( "&B" + n1 )

v2 = v1 mod 3
v3 = v1 mod 4
v4 = v1 mod 11

n2 = str( ( ( v2 * 100 ) + ( v3 * 10 ) ) + v4 )

bits1+= chr( val( n2 ) )
==============================================

How would you tell if v4 = 10 ????

Compresses 100,000 bytes by 78% , after 100 loops : Takes 13 seconds...

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 n1 , n2
    dim as longint v1 , v2 , v3 , v4
    for a as longint = 1 to len( chrs ) step 1
        n1 = "00000000" + bin( chrs[ a - 1 ] )
        n1 = right( n1 , 8 )
        bits+= n1
    next
    
    print "c bin = " ; len( bits ) ' , bits
    
    dim as string bits1 = ""
    for a as longint = 1 to len( bits ) step 7
        
        n1 = mid( bits , a , 7 )
        
        v1 = val( "&B" + n1 )
        
        v2 = v1 mod 3
        v3 = v1 mod 4
        v4 = v1 mod 11
        
        n2  = str( ( ( v2 * 100 ) + ( v3 * 10 ) ) + v4 )
        
        bits1+= chr( val( n2 ) )
        
        'print v1 , v2 , v3 , v4 , n2
        '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]

@Richard
@Dodicat

How would you alter the below code, to automatically search for the 3 lowest values??

We need md1 , md2 , md3 , to equal the three lowest values , that will equal ( V = 127 or V = ?? )

Code: Select all

screen 19

dim as longint v , v1 , v2 , v3 , v4
dim as longint  md1 , md2 , md3 , md4
do
            
            do
                'ADJUST ( RND * ? ) TO DIFFERENT VALUES , HAS TO BE 3 OR GREATER
                'YOU CAN PLAY AROUND AND FIND THE LOWEST MODS THAT EQUAL ( V ) BELOW.
                md1 = int( rnd * 4 )
                md2 = int( rnd * 5 )
                md3 = int( rnd * 12 )
                
            loop until md1 > 1 and md2 > 1 and md3 > 1
            
            'SET ( V ) TO MAX BIT VALUE YOU WANT TO SEARCH.
            v = 127
            
            v1 = v mod md1
            v2 = v mod md2
            v3 = v mod md3
            
            dim as longint s , s1 , s2 , s3 , s4 , value
            'IF YOUR DOING MORE THAN 16 BITS SET ,BELOW TO MAX BIT VALUE
            for b as longint = 0 to 65536 step 1
                s = b
                s1 = s mod md1
                s2 = s mod md2
                s3 = s mod md3
                if s1 = v1 and s2 = v2 and s3 = v3 then value = b : exit for
            next
        
        if v = value then print v , value  , md1 , md2 , md3 : sleep
        
loop until inkey = chr( 27 )

sleep
end

[albert]

I got another song written...

Pearl Snap Studios is working on the demo.. It should be done in a few days..
Here's the lyric.

===================================================================
I think Adam & Eve were the beginning of the Jewish genealogy..
After Cain killed Able , he went to a village and picked out a wife.. and had offspring..
Maybe Adam & Eve were alien grays and Cain married a humanoid??? Then the offspring genome was contaminated and couldn't live as long??
===================================================================

( genre = Country Rock )

( title= Hallelujah )

( entry music )

never thought too much about it
i never had too much to say

read the bible while i stumble
hoping that , my soul can be saved

reading the books of the bible
just stumble along as i pray

asking jesus's forgiveness
for all the mistakes that i've made

and i sing a hallelujah
(music)
and i sing a hallelujah

( music )

just kneeling down in the temple
before the altar and i pray

asking god for his forgiveness
i know somehow i have to pay

he resides up in the heavens
like a beacon he always shines

and i hope that my , soul is saved
i take a sip of holy wine

and i sing a hallelujah
(music)
and i sing a hallelujah

( music )

and the empty church i ponder
i wonder if i might be saved

and just kneeling at the altar
somehow living got in the way

here to ask for my forgiveness
and kneeling down i start to pray

thanking jesus of nazareth
for taking all my sins away

and i sing a hallelujah
(music)
and i sing a hallelujah

( exit music )

albert_redditt@yahoo.com

Albert Redditt
315 W. Carrillo St. #104
Santa Barbara , Ca. 93101 U.S.A.

[albert]

I came up with a funny name for a Chinese dish...

Pi Don Shu

( peed on shoe ) !!~ HA-HA ~!!

Maybe a flank steak with lemon sauce???

[albert]

@Dodicat

I was working with quadra-decimal... stepping by 3 digits.. 000 to 333

You add 1 to the left digit , and add 1 to the right 2 digits...

So you have 1 , 2 , 3 , 4 and ( 01 02 03 04 ) , ( 11 12 13 14 ) , ( 21 22 23 24 ) , ( 31 32 33 34 )

Then you multiply the left digit by the right 2 digits.
If the left digit is less than the right 2 digits then you add 100 to the output..

I'm getting some duplicates...

Code: Select all

screen 19

dim as longint v1 , v2 , v3 , ans
dim as string n1

for a as longint = 1 to 4
        
    v1 = a
    
    for b as longint = 0 to 3
        
        v2 = b
        
        for c as longint = 1 to 4
            
            v3 = ( b * 10 ) + c
            
            ans = v1 * v3
            
            if v1 < v3 then ans+=100
            
            n1 = right( "   " + str( ans ) , 3 )
            
            print n1 ; " " ; 
            
        next
    
    next
    
    print

next

sleep
end

[albert]

@Dodicat

I got something that works.. Now i got to see if it can be reversed...

Compresses 100,000 by 98% after 100 loops : Takes 3 seconds.. It's real fast...

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 bits1 = ""
    dim as string n1
    dim as longint v1
    for a as longint = 1 to len( chrs ) step 1
        
        v1 = chrs[ a - 1 ]
        
        if v1 = 0 then 
            bits1+=chr( 0 )
        else
            dim as longint v2 = 0
            dim as single count = 0
            do
                v2+= 1
                count+= .5
            loop until v2 = v1
            if frac( count ) <> 0 then count+= 128
            bits1+= chr( count )
        end if
        
     next
    
    print "c bin = " ; len( bits1 ) ' , bits1
    
    dim as string final = bits1
    'for a as longint = 1 to len( bits2 ) step 2
    '    final+= chr( val( mid( bits2 , 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]

@Richard
@Dodicat

( !!~ COMPRESSION SUCCESS ~!! )

It's a formula , i tried before and it didn't compress...
I tried it again with different sizes , and it compresses above 30,000 bytes in. ( i was trying it at 10,000 bytes in.. it expanded 116% )

30,000 bytes in compresses 27%
100,000 bytes in compresses 59% ( stays at 59% for for 30 or 40 loops. )
1,000,000 bytes in compresses 93% : takes 78 seconds... Got to speed it up...

Here it is doing 1,000,000 bytes in.

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 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 bits1 = ""
    dim as string bits2 = ""
    dim as string n1
    dim as longint ones , zeros
    dim as ubyte ptr ulp = cptr( ubyte ptr , strptr( chrs ) )
    for a as longint = 1 to len( chrs ) step 1
        
        n1 = bin( *ulp ) : ulp+= 1
        
        ones = 0
        zeros = 0
        for b as longint = 1 to len( n1 ) step 1
            if n1[ b - 1 ] = 49 then ones+=1
            if n1[ b - 1 ] = 48 then zeros+= 1 shl ( len( n1 ) - b )
        next
        
        bits1+= bin( zeros )
        bits2+= right( "0000" + bin( ones ) , 4 )
        
        'print n1 , ones , zeros
        'sleep
        'if inkey = " " then end
        
    next
    
    print "c bin = " ; len( bits1 ) ' , bits1
    
    dim as string final = ""
    for a as longint = 1 to len( bits1 ) step 8
        final+= chr( val( "&B" + mid( bits1 , a , 8 ) ) )
    next
    for a as longint = 1 to len( bits2 ) step 8
        final+= chr( val( "&B"  +mid( bits2 , 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

It inputs a byte stripping the left zeros ,
it then sums the binary values of the 0's and puts it into a binary output string ( bits1 ).
it then counts the number of 1's and puts it into a 4 bit output string ( bits2 )

Then it turns the two binary strings into chars....

[albert]

I got my "Hallelujah" and "Gone" songs demo'd

https://soundcloud.com/user-704620747

Pearl Snap Studios , did a good job on the music for "Hallelujah"

[albert]

For the "Yah-Zip" above..

bits1+= bin( zeros )
bits2+= right( "0000" + bin( ones ) , 4 )

Changed to:

bits1+= bin( zeros )
bits2+= right( "0000" + bin( len( n1 ) ) , 4 )

Then you know how long the input is supposed to be...

[srvaldez]

I got my "Hallelujah" and "Gone" songs demo'd

https://soundcloud.com/user-704620747

Pearl Snap Studios , did a good job on the music for "Hallelujah"

Hi Albert
yes, they did a good rendition of Hallelujah, congratulations.

[albert]

@srvaldez

The "Gone" song , i didn't like too much...

It was supposed to be a light rock song.. A sombre song... It's a song about a man coming home and finding his wife dead of an overdose.

The music was supposed to sound similar to the KISS song "Beth" from the 1970's

I came up with the lyric while i was singing "Beth"

The "Beth" line:
"This place , seems so empty , that our house , just ain't our home"
Became:
"Never seemed so empty , until i found you gone"
"Leaving me alone to , to try to carry on"


Here's my "Gone" lyric :

[ Genre = Rock ]

[ Title = Gone ]

[entry music ]

never seemed so empty , until i found you gone
leaving me alone to , to try to carry on

[ music ]

they say your soul goes on , long after you have gone
why do i feel empty , the emptiness goes on
memories they flash by , the memories of you
i can't stop the feeling , what am i supposed to do
two of us together , and oh the times we had
fighting back a tear and , the thought just makes me mad

[ music ]

never seemed so empty , until i found you gone
leaving me alone to , to try to carry on

[ music ]

the life of the party , the parties that we had
time to say a goodbye , goodbye just makes me mad
memories they linger , the memories of you
i can't stop the feeling , what am i supposed to do
i will still remember , remember that you've gone
time for me to just try, just try to carrry on

[ music ]

never seemed so empty , until i found you gone
leaving me alone to , to try to carry on

[ music ]

struggled with addiction , how could you go so wrong
took to much of heaven , and now i found you gone

[ exit music ]


albert_redditt@yahoo.com

Albert Redditt
315 W. Carrillo St. #104
Santa Barbara, Ca. 93101 U.S.A

[albert]

@Richard

====================================================
n1 = bin( *ulp ) : ulp+= 1

'ones = 0
'zeros = 0
sum = 0
for b as longint = 1 to len( n1 ) step 1
'if n1[ b - 1 ] = 48 then zeros+=1
'if n1[ b - 1 ] = 49 then ones+=1
if n1[ b - 1 ] = 48 then sum+= 1 shl ( len( n1 ) - b )
next

bits1+= bin( sum )
bits2+= str( len( n1 ) )
====================================================

How would you determine , how many bits of "bits1" , you need to bring in , for each digit of "bits2" ???

Bits2 holds the length of the n1 input byte.. bits2 holds the binary sum of the zeros of the n1 input....

Can it be undone?

[albert]

One of the guys in my apartment complex , was saying his pecker gets hard when the wind blows..

So i said: Mr. SlightBreez.

Then SlightBreez became SlyBreez ( get some on the sly )
Then SlyBreez became CheatinBreez then CheatinBreez became ChetBreez

Just playing around with words... Doing Calculus with names..

[albert]

@Richard
@Dodicat

I got another compression formula that compresses...

It builds a random dictionary of 128 bytes...
Then it searches through the input for the dictionary bytes..
If the dictionary bytes are in the input , then it cuts it out of the input , and adds a dict pointer into an output string..

Requires input to be 30,000 bytes or greater...

Compresses 100,000 bytes in by 61% : Takes 17 seconds..
It's real slow, I've got to figure out how to speed it up.. 1,000,000 bytes takes like 7 minutes for the first loop..

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 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 dict = ""
    dim as string n1
    randomize 0
    do
        n1 = chr( int( rnd * 256 ) )
        if instr( 1 , dict , n1 ) = 0 then dict+= n1
    loop until len( dict ) = 128
    
    dim as string bits = string( len( chrs ) , chr( 130 ) )
    dim as longint place1 , place2
    for a as longint = 1 to len( chrs ) step 1
        
        n1 = mid( chrs , a , 1 )
        
        place1 = instr( 1 , dict , n1 )
        
        if place1 > 0 then
            
            place2 = 0
            do
                place2 = instr( place2 + 1 , chrs , n1 )
                if place2 > 0 then
                    chrs = left( chrs , place2 - 1 ) + mid( chrs , place2 + 1 )
                    mid( bits , place2 , 1 ) = chr( place1 )
                end if
            loop until place2 = 0
        
        end if
        
    next
    
    print "c bin = " ; len( bits ) ' , bits

    dim as string final = chrs + "END" + bits + "End" + dict
    
    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