Squares

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

Yah-Zip

I've got another formula that compresses....Compresses 100,000 byte by 99% after 100 loops..

=====================================
for a as longint = 1 to len( bits ) step 3

n1 = mid( bits , a , 3 )

v1 = val( mid( n1 , 1 , 1 ) )
v2 = val( mid( n1 , 2 , 2 ) )

n2 = str( v1 )
n3 = str( v2 )

outs1+= hex( val( "&B" + n2 + n3 ) )

next
====================================

Code: Select all

`' YAH-ZIP ( Three Step )'' Writen in FreeBasic for Windows''Zlibrary code by Dodicat , From Scottland'' compress_loop() , decompress_loop by Albert ReddittDeclare 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        s = space( 100000 )        For n As Long = 0 to len( s ) - 1 step 1            s[ n ] = Int( rnd * 256 )        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    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 outs1 = ""    dim as string outs2 = ""    dim as string n2 , n3 , n4    dim as ubyte v1 , v2 , v3    for a as longint = 1 to len( bits ) step 3                n1 = mid( bits , a , 3 )                v1 = val( mid( n1 , 1 , 1 ) )        v2 = val( mid( n1 , 2 , 2 ) )                n2 = str( v1 )        n3 = str( v2 )                outs1+= hex( val( "&B" + n2 + n3 ) )                'print        'print n1 , v1 , v2        'print outs1        'sleep        'if inkey = " " then end            next        print "c out = " ; len( outs1 ) ' , outs1    dim as string final = ""    for a as longint = 1 to len( outs1 ) step 2        final+= chr( val( "&H" + mid( outs1 , a , 2 ) ) )    next    'final+= "END"    'for a as longint = 1 to len( outs2 ) step 8    '    final+= chr( val( "&B" + mid( outs2 , a , 8 ) ) )    'next        print "c fin = " ; len(final)       return final   end function'==============================================================================='============================================================================Function decompress_loop( chrs as string ) as string        print    print "d inp = " ; len( chrs )        return chrs    end function`
albert
Posts: 5634
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Never mind !!

There's two 2's ( 0 10 ) , ( 1 0 )
albert
Posts: 5634
Joined: Sep 28, 2006 2:41
Location: California, USA

Yah-Zip

And another compression formula....

It counts then number of 0's between 1's

====================================
for a as longint = 1 to len( bits ) step 1
n1 = mid( bits , a , 1 )
count+=1

if n1 = "1" then
outs1+= "0" + bin( count - 1 )
if count > high then high = count
count = 0
end if
next
==================================

Code: Select all

`' YAH-ZIP ( Three Step )'' Writen in FreeBasic for Windows''Zlibrary code by Dodicat , From Scottland'' compress_loop() , decompress_loop by Albert ReddittDeclare 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        s = space( 100000 )        For n As Long = 0 to len( s ) - 1 step 1            s[ n ] = Int( rnd * 256 )        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    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 outs1 = ""    dim as longint count = 0 , high = 0    for a as longint = 1 to len( bits ) step 1                n1 = mid( bits , a , 1 )        count+=1                if n1 = "1" then            outs1+= "0" + bin( count - 1 )            if count > high then high = count            count = 0        end if                'print outs1        'sleep        'if inkey = " " then end            next        print "c hig = " ; high    print "c out = " ; len( outs1 ) ' , outs1    dim as string final = ""    for a as longint = 1 to len( outs1 ) step 8        final+= chr( val( "&B" + mid( outs1 , a , 8 ) ) )    next    'final+= "END"    'for a as longint = 1 to len( outs2 ) step 8    '    final+= chr( val( "&B" + mid( outs2 , a , 8 ) ) )    'next        print "c fin = " ; len(final)       return final   end function'==============================================================================='============================================================================Function decompress_loop( chrs as string ) as string        print    print "d inp = " ; len( chrs )        return chrs    end function`
angros47
Posts: 1616
Joined: Jun 21, 2005 19:04

Re: Squares

If "bin( count - 1 )" is written as an 8 bit sequence, each time you will encounter a sequence that has less than 8 consecutive zeroes you will replace them with 8 binary digits, and in that way you will make the file longer, not shorter.

Instead, if "bin( count - 1 )" is expressed as a variable length binary number, the decompression routine is unable to know how long is this number, and won't be able to decompress.
albert
Posts: 5634
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

@angros47

outs1+= "0" + bin( count - 1 )

if you change it to :

outs1+= "0" + bin( count )

It doesn't compress...

bin( count - 1 ) , creates a lot of 00's
But then if bin( count - 1 ) = "10000" , you can't tell where the end if the value is.. You can't tell where the 00's are compared to the 10000..

Back to the drawing board!!!!

I sit and think of a formula , sometimes it takes a couple days.. Then i try it , no matter how senseless it seems..
Sometimes it expands the data , and then the Zlib will somehow compress it , to smaller... ( never know. )

Of the couple dozen compressions of mine , that have succeeded , there's always a decompression obstacle , that can't be solved.
If it compresses , then i post it , thinking maybe someone can help write the decompression..

I figure : that i haven't yet stumbled upon , the one that will be de-compressible..
angros47
Posts: 1616
Joined: Jun 21, 2005 19:04

Re: Squares

albert wrote:I sit and think of a formula , sometimes it takes a couple days.. Then i try it , no matter how senseless it seems..
Sometimes it expands the data , and then the Zlib will somehow compress it , to smaller... ( never know. )

Once Nikola Tesla said “If he [Thomas Edison] had a needle to find in a haystack, he would not stop to reason where it was most likely to be, but would proceed at once with the feverish diligence of a bee, to examine straw after straw until he found the object of his search. … Just a little theory and calculation would have saved him ninety percent of his labor.”

I will say the same to you: instead of trying every possible algorithm, failing every time, you should learn a bit of theory. It would allow you to instantly discard some algorithms that have no chance to work

Of the couple dozen compressions of mine , that have succeeded , there's always a decompression obstacle , that can't be solved.
If it compresses , then i post it , thinking maybe someone can help write the decompression..

If you studied a bit of theory, you would be able to immediately spot where the obstacle is, instead of having to find it in the hard way
albert
Posts: 5634
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

@angros47

The guy who wrote Zlib, couldn't figure out how to decompress it... a second person came along with the decompression..

I figure i might be having the same problem..
So i keep posting the compressions , that i can't immediately figure out , how to decompress.
albert
Posts: 5634
Joined: Sep 28, 2006 2:41
Location: California, USA

Yah-Zip

I think i got it this time.... Compresses 100,000 by 86% , after 100 loops... Takes about 15 seconds

==========================================
n1 = mid( bits , a , 4 )

if n1 = "0000" then outs1+= "0" : which+= "00"
if n1 = "0001" then outs1+= "10" : which+= "00"
if n1 = "0010" then outs1+= "11" : which+= "00"

if n1 = "0011" then outs1+= "0" : which+= "01"
if n1 = "0100" then outs1+= "10" : which+= "01"
if n1 = "0101" then outs1+= "11" : which+= "01"

if n1 = "0110" then outs1+= "0" : which+= "10"
if n1 = "0111" then outs1+= "10" : which+= "10"
if n1 = "1000" then outs1+= "11" : which+= "10"

if n1 = "1001" then outs1+= "0" : which+= "110"
if n1 = "1010" then outs1+= "10" : which+= "110"
if n1 = "1011" then outs1+= "11" : which+= "110"

if n1 = "1100" then outs1+= "0" : which+= "111"
if n1 = "1101" then outs1+= "10" : which+= "111"
if n1 = "1110" then outs1+= "11" : which+= "111"

if n1 = "1111" then outs1+= "1" : which+= "111"
==========================================

Code: Select all

`' YAH-ZIP ( Three Step )'' Writen in FreeBasic for Windows''Zlibrary code by Dodicat , From Scottland'' compress_loop() , decompress_loop by Albert ReddittDeclare 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        s = space( 100000 )        For n As Long = 0 to len( s ) - 1 step 1            s[ n ] = Int( rnd * 256 )        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    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 outs1 = ""    dim as string which = ""    dim as string n2    for a as longint = 1 to len( bits ) step 4                n1 = mid( bits , a , 4 )                if n1 = "0000" then outs1+= "0"   : which+= "00"        if n1 = "0001" then outs1+= "10" : which+= "00"        if n1 = "0010" then outs1+= "11" : which+= "00"                if n1 = "0011" then outs1+= "0"   : which+= "01"        if n1 = "0100" then outs1+= "10" : which+= "01"        if n1 = "0101" then outs1+= "11" : which+= "01"                if n1 = "0110" then outs1+= "0"   : which+= "10"        if n1 = "0111" then outs1+= "10" : which+= "10"        if n1 = "1000" then outs1+= "11" : which+= "10"                if n1 = "1001" then outs1+= "0"   : which+= "110"        if n1 = "1010" then outs1+= "10" : which+= "110"        if n1 = "1011" then outs1+= "11" : which+= "110"                if n1 = "1100" then outs1+= "0"   : which+= "111"        if n1 = "1101" then outs1+= "10" : which+= "111"        if n1 = "1110" then outs1+= "11" : which+= "111"                if n1 = "1111" then outs1+= "1"   : which+= "111"                'print outs1        'sleep        'if inkey = " " then end            next        print "c out = " ; len( outs1 ) ' , outs1    dim as string final = ""    for a as longint = 1 to len( outs1 ) step 8        final+= chr( val( "&B" + mid( outs1 , a , 8 ) ) )    next    for a as longint = 1 to len( which ) step 8        final+= chr( val( "&B" + mid( which , 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`
albert
Posts: 5634
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

I came up with an idea for a website...

Called "Friends" or "Board-Room"

You have an IP address set up for the people to login into.
Then that IP address , ships out video and audio to the all those logged into that IP.

Each persons camera and microphone , transmits to the IP address..Then that IP address , transmits it out to all the computers logged in..

It sets up the screen , into squares , of each person logged in.

You could charge X\$ per year or month , for each person to use the service...

When someone is talking , it highlights their square.. so the others know to not talk...

Great for remote board meetings and large family gatherings..

Become a begillioniare or close.....by creating the IP server..

You could encrypt the video and audio with something like my Vari_Cyph. Where each IP uses a different key..
So companies , can ensure their boardroom meetings , are secure from corporate spying..
paul doe
Posts: 1175
Joined: Jul 25, 2017 17:22
Location: Argentina

Re: Squares

Congratulations, you've just invented videoconference:

https://getvoip.com/blog/2016/11/21/free-web-conferencing/
albert
Posts: 5634
Joined: Sep 28, 2006 2:41
Location: California, USA

Yah-Zip

@Dodicat

I got another Compression formula.. Compresses 100,000 bytes down to under 900 bytes after 100 loops.

bits = binary string of input chr's
========================================
n1 = mid( bits , a , 2 )

n1 = ltrim( n1 , "0" ) : if n1 = "" then n1 = "0"

if len( n1 ) = 1 then
outs1+= "000" + n1
goto done
end if

if len( n1 ) = 2 then
outs1+= right( n1 , 1 )
goto done
end if

done:

========================================

Here's Dodicat's Zlib code , doing 100,000 bytes in , over 100 loops.

Code: Select all

`' YAH-ZIP ( Three Step )'' Writen in FreeBasic for Windows''Zlibrary code by Dodicat , From Scottland'' compress_loop() , decompress_loop by Albert ReddittDeclare 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        s = space( 100000 )        For n As Long = 0 to len( s ) - 1 step 1            s[ n ] = Int( rnd * 256 )        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    dim as ubyte ptr ubp = cptr( ubyte ptr , strptr( chrs ) )    for a as longint = 1 to len( chrs ) step 1        n1 = "00000000" + bin( *ubp ) : ubp+= 1        n1 = right( n1 , 8 )        bits+= n1    next        print "c bin = " ; len( bits ) ' , bits        dim as string outs1 = ""    dim as string which = ""    for a as longint = 1 to len( bits ) step 2                n1 = mid( bits , a , 2 )                n1 = ltrim( n1 , "0" ) : if n1 = "" then n1 = "0"                if len( n1 ) = 1 then            outs1+= "000" + n1            goto done        end if                if len( n1 ) = 2 then            outs1+= right( n1 , 1 )            goto done        end if                done:                'print        'print which        'print outs1        'sleep        'if inkey = " " then end                       next        print "c out = " ; len( outs1 ) ' , outs1    print "c whi = " ; len( which ) ' , which    dim as string final = ""    for a as longint = 1 to len( outs1 ) step 8        final+= chr( val( "&B" + mid( outs1 , a , 8 ) ) )    next    final+= "END"    for a as longint = 1 to len( which ) step 8        final+= chr( val( "&B" + mid( which , 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`
thebigh
Posts: 34
Joined: Dec 14, 2018 11:11

Re: Squares

Here's my derp moment of the day

Code: Select all

`dim as ubyte ifor i = 0 to 255    do_something_with( i )    lots_of_lines_of_complex_code( i )    tedious_blather( i )next i`

Scratching my head why this loop ran forever. Was something in my many dozens of lines of complex code causing i to be changed from within the loop somehow? Nope!

Can anyone else spot the issue?
SARG
Posts: 1044
Joined: May 27, 2005 7:15
Location: FRANCE

Re: Squares

It's a classic issue for beginners

The loop doesn't go after 255. As it's a ubyte it's reset to zero after 255 so the limit >255 is never reached.
Use short, long or integer to solve this issue. Or build in another way.
Look the display

Code: Select all

`for i as ubyte = to 255print inext`
thebigh
Posts: 34
Joined: Dec 14, 2018 11:11

Re: Squares

Yes. This shows clearly what's going on:

Code: Select all

`dim as short ifor i = 0 to 255next iprint i`

Now try putting 256 in a ubyte.
fxm
Posts: 9558
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Squares

No problem if your procedures expect a ubyte as parameter (the conversion will be automatic):

Code: Select all

`declare sub do_something_with ( byval u as ubyte )dim as ushort ifor i = 0 to 255    do_something_with( i )next isleepsub do_something_with ( byval u as ubyte )    print uend sub`