Squares

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

Yah-Zip

Postby albert » Apr 06, 2020 17:03

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 Redditt


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

Postby albert » Apr 06, 2020 18:01

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

Postby albert » Apr 06, 2020 20:18

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 Redditt


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

Postby angros47 » Apr 06, 2020 21:48

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

Postby albert » Apr 06, 2020 23:47

@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

Postby angros47 » Apr 07, 2020 0:11

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

Postby albert » Apr 07, 2020 0:51

@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

Postby albert » Apr 07, 2020 17:19

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 Redditt


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

Postby albert » Apr 11, 2020 23:12

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

Postby paul doe » Apr 11, 2020 23:37

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

Postby albert » Apr 12, 2020 1:43

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


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

Postby thebigh » Apr 13, 2020 12:22

Here's my derp moment of the day

Code: Select all

dim as ubyte i
for 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

Postby SARG » Apr 13, 2020 12:53

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 255
print i
next
thebigh
Posts: 34
Joined: Dec 14, 2018 11:11

Re: Squares

Postby thebigh » Apr 13, 2020 13:06

Yes. This shows clearly what's going on:

Code: Select all

dim as short i
for i = 0 to 255
next i
print i


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

Re: Squares

Postby fxm » Apr 13, 2020 14:26

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 i
for i = 0 to 255
    do_something_with( i )
next i

sleep

sub do_something_with ( byval u as ubyte )
    print u
end sub

Return to “General”

Who is online

Users browsing this forum: No registered users and 2 guests