## Squares

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

### Re: Squares

@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 stringDeclare Function decompress_loop( chrs as string ) as stringscreen 19'====================================================================='====================================================================='start program'====================================================================='=====================================================================dim as double time1 , time2 , time3 , time4do       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)sleepend'==============================================================================='==============================================================================='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
Posts: 5539
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@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 stringDeclare Function decompress_loop( chrs as string ) as stringNamespace 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 LongEnd ExternFunction 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 textEnd 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 uncompressedEnd 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 compressedEnd FunctionEnd Namespace'=================================================================='=================================================================='test zipper'=================================================================='==================================================================screen 19Dim Shared As String sRandomizes=""dim as string check=""dim as string compare=""dim as longint length = 0dim as double compression = 0dim as longint loops = 0dim as double time1 , time2time1 = timerdo       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 = 100time2 = timerprintprint  "Compress time = " ; time2 - time1printprint "Press a key to decompress."sleeps = 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 val1dim as string outsfor a as longint = count to 2 step -1    s = Zlibrary.unpack(comp)    outs = decompress_loop(s)    comp = outsnextcomp = Zlibrary.unpack(comp)printprint "input = "; length , "output = " ; len(comp) , "compression ratio  "; 100 - ( 100 / ( length / len(s) ) ) ; "%"printif comp = compare then print "Decompression successful." else print "ERROR"printprintPrint "!!~~Done~~!!"Sleepend'==============================================================================='============================,==================================================='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
Posts: 5539
Joined: Sep 28, 2006 2:41
Location: California, USA

### 3 MOD

@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 19dim as longint v , v1 , v2 , v3 , v4dim as longint  md1 , md2 , md3 , md4do                        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 )sleepend`
albert
Posts: 5539
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

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

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

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

### Re: Squares

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

@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 19dim as longint v1 , v2 , v3 , ansdim as string n1for 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        printnextsleepend`
albert
Posts: 5539
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

@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 stringDeclare Function decompress_loop( chrs as string ) as stringNamespace 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 LongEnd ExternFunction 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 textEnd 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 uncompressedEnd 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 compressedEnd FunctionEnd Namespace'=================================================================='=================================================================='test zipper'=================================================================='==================================================================screen 19Dim Shared As String sRandomizes=""dim as string check=""dim as string compare=""dim as longint length = 0dim as double compression = 0dim as longint loops = 0dim as double time1 , time2time1 = timerdo       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 = 100time2 = timerprintprint  "Compress time = " ; time2 - time1printprint "Press a key to decompress."sleeps = 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 val1dim as string outsfor a as longint = count to 2 step -1    s = Zlibrary.unpack(comp)    outs = decompress_loop(s)    comp = outsnextcomp = Zlibrary.unpack(comp)printprint "input = "; length , "output = " ; len(comp) , "compression ratio  "; 100 - ( 100 / ( length / len(s) ) ) ; "%"printif comp = compare then print "Decompression successful." else print "ERROR"printprintPrint "!!~~Done~~!!"Sleepend'==============================================================================='============================,==================================================='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
Posts: 5539
Joined: Sep 28, 2006 2:41
Location: California, USA

### Yah-Zip

@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 stringDeclare Function decompress_loop( chrs as string ) as stringNamespace 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 LongEnd ExternFunction 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 textEnd 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 uncompressedEnd 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 compressedEnd FunctionEnd Namespace'=================================================================='=================================================================='test zipper'=================================================================='==================================================================screen 19Dim Shared As String sRandomizes=""dim as string check=""dim as string compare=""dim as longint length = 0dim as double compression = 0dim as longint loops = 0dim as double time1 , time2time1 = timerdo       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 = 100time2 = timerprintprint  "Compress time = " ; time2 - time1printprint "Press a key to decompress."sleeps = 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 val1dim as string outsfor a as longint = count to 2 step -1    s = Zlibrary.unpack(comp)    outs = decompress_loop(s)    comp = outsnextcomp = Zlibrary.unpack(comp)printprint "input = "; length , "output = " ; len(comp) , "compression ratio  "; 100 - ( 100 / ( length / len(s) ) ) ; "%"printif comp = compare then print "Decompression successful." else print "ERROR"printprintPrint "!!~~Done~~!!"Sleepend'==============================================================================='============================,==================================================='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
Posts: 5539
Joined: Sep 28, 2006 2:41
Location: California, USA

### Re: Squares

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

### Re: Squares

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
Posts: 2262
Joined: Sep 25, 2005 21:54

### Re: Squares

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

### Re: Squares

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

### Re: Squares

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

### Re: Squares

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

### Re: Squares

@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 stringDeclare Function decompress_loop( chrs as string ) as stringNamespace 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 LongEnd ExternFunction 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 textEnd 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 uncompressedEnd 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 compressedEnd FunctionEnd Namespace'=================================================================='=================================================================='test zipper'=================================================================='==================================================================screen 19Dim Shared As String sRandomizes=""dim as string check=""dim as string compare=""dim as longint length = 0dim as double compression = 0dim as longint loops = 0dim as double time1 , time2time1 = timerdo       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 = 50time2 = timerprintprint  "Compress time = " ; time2 - time1printprint "Press a key to decompress."sleeps = 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 val1dim as string outsfor a as longint = count to 2 step -1    s = Zlibrary.unpack(comp)    outs = decompress_loop(s)    comp = outsnextcomp = Zlibrary.unpack(comp)printprint "input = "; length , "output = " ; len(comp) , "compression ratio  "; 100 - ( 100 / ( length / len(s) ) ) ; "%"printif comp = compare then print "Decompression successful." else print "ERROR"printprintPrint "!!~~Done~~!!"Sleepend'==============================================================================='============================,==================================================='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`