Squares

General FreeBASIC programming questions.
angros47
Posts: 1756
Joined: Jun 21, 2005 19:04

Re: Squares

Postby angros47 » Jan 03, 2020 14:16

Albert, are you starting to understand, now, why I told you that it is mathematically impossible to compress at a constant, fix ratio?
There is always some ambiguity, no matter how you rearrange your bits
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Jan 05, 2020 0:38

@Dodicat
@StoneMonkey

I think i got something..

Bit inp = '10 01 01 01"

Top = 128 ( 10 00 00 00 )
Lower = 21 ( 16 + 4 + 1 )

Output = 128 - 21 = chr( 107 )

You subtract the bottom bits from the top bit...

Here it is in Dodicats Zlib code....

Compresses 90+% after 20 loops....
Any ideas about how to decompress it????

Code: Select all


Declare Function   compress_loop( chrs as string ) as string
Declare Function decompress_loop( chrs as string ) as string


Namespace Zlibrary

#inclib "zlib"
Extern "C"
    Declare Function compressBound(Byval sourceLen As Ulong) As Ulong
    Declare Function uncompress(Byval dest As Ubyte Ptr, Byval destLen As Uinteger Ptr, Byval source As  Ubyte Ptr, Byval sourceLen As Ulong) As Long
    Declare Function compress(Byval dest As Ubyte Ptr, Byval destLen As Uinteger Ptr, Byval source As  Ubyte Ptr, Byval sourceLen As Ulong) As Long
End Extern

Function getpassedinfo(text As String,Byref passed_length As Integer) As String
    Dim As String var1,var2
    Dim As Integer pst
    #macro splice(stri,char,var1,var2)
    pst=Instr(stri,char)
    var1="":var2=""
    If pst<>0 Then
        var1=Mid(stri,1,pst-1)
        var2=Mid(stri,pst+1)
    Else
        var1=stri
    End If
    #endmacro
    splice(text,"|",var1,var2)
    text=var2
    passed_length=Valint(var1)
    Return text
End Function


'=================   UNPACK ===============
Function unpack(file As String) As String
    Dim As Integer passed_length
    Dim As String text=getpassedinfo(file,passed_length)
    Dim As Integer stringlength,destinationlength
    stringlength=Len(text)
    destinationlength =passed_length
    Dim As Ubyte Ptr source
    Dim As Ubyte Ptr  destination =Callocate(destinationlength,1)
    source=@text[0]
    Var mistake=uncompress(destination,@destinationlength, source, stringlength)
    If mistake<>0 Then Print "There was an error":Sleep:End
    Dim As String uncompressed
    uncompressed=String(destinationlength,0)
    For i As Integer = 0 To destinationlength- 1
        uncompressed[i]=(destination[i])
    Next
    Deallocate destination
    Return uncompressed
End Function

'===================  PACK ============
Function pack(file As String) As String
    Dim As String text=file
    Dim As Integer stringlength,destinationlength
    stringlength=Len(text)
    destinationlength = compressBound(stringlength)
    Dim As Ubyte Ptr source
    Dim As Ubyte Ptr destination =Callocate(destinationlength,1)
    source=@text[0]
    Var mistake=compress(destination, @destinationlength, source, stringlength)
    If mistake <>0 Then Print "There was an error"
    Dim As String compressed
    compressed=String(destinationlength,0)
    For n As Integer=0 To destinationlength-1
        compressed[n]=destination[n]
    Next n
    compressed=stringlength &"|"+compressed
    Deallocate destination
    Return compressed
End Function

End Namespace


'==================================================================
'==================================================================
'test zipper
'==================================================================
'==================================================================
screen 19

Dim Shared As String s

Randomize

s=""
dim as string check=""
dim as string compare=""
dim as longint length = 0
dim as double compression = 0
dim as longint loops = 0

dim as double time1 , time2

time1 = timer
do
   
    loops+=1
   
    'one time run , create initial string
    if loops = 1 then
        For n As Long = 1 To 100000
            s+=chr(Int(Rnd*256))'+48
        Next
        compare =  s
        length = len(s)
    else
        'modify compression to make further compression possible
       
        s = compress_loop(s)
   
    end if
    check = s
    compression = (100 - ( 100 / ( length / len(check) ) ))
   
    Print "original string"
    Print Len(s)
    Print
   
    Dim As String compressed=Zlibrary.pack(s)
    s = compressed
   
    Print "packed string "
    Print Len(compressed)
    Print
   
    Dim As String uncompressed=Zlibrary.unpack(compressed)
   
    Print "Retrieve"
    Print Len(uncompressed)
    Print
    'Print "compression ratio  "; 100 - ( 100 / ( Len(s) / len(compressed) ) ) ; "%"
    Print "compression ratio  "; 100 - ( 100 / ( length / len(s) ) ) ; "%"
    Print Iif(uncompressed=check,"OK","ERROR")
    Print "-------------------------------"
   
    'sleep 1000
   
    'if loops > 2 and (100 - ( 100 / ( length / len(s) ) )) < compression then exit do
   
    print "press esc to exit."
    print
    print "press a key for next compression." ; " loops = " ; loops ; " out of 20."
    'sleep
   
    if inkey = chr(27) then exit do
   
loop until loops = 20

time2 = timer

print
print  "Compress time = " ; time2 - time1
print
print "Press a key to decompress."
sleep

s = str(loops) + "_" + s ' save as an output file...

'==================================================================
'decompress
'==================================================================
dim as longint dec = instr(1,s,"_")
dim as longint count = val(left(s,dec-1))
dim as string comp = mid(s,dec+1)
dim as string val1
dim as string outs
for a as longint = count to 2 step -1
    s = Zlibrary.unpack(comp)
    outs = decompress_loop(s)
    comp = outs
next

comp = Zlibrary.unpack(comp)

print
print "input = "; length , "output = " ; len(comp) , "compression ratio  "; 100 - ( 100 / ( length / len(s) ) ) ; "%"
print
if comp = compare then print "Decompression successful." else print "ERROR"
print
print
Print "!!~~Done~~!!"

Sleep
end
'===============================================================================
'============================,===================================================
'begin functions
'===============================================================================
'================='==============================================================
Function compress_loop( chrs as string ) as string
   
    print "c inp = " ; len(chrs) ' , chrs
   
    dim as string bits1 = ""
    dim as string bits2 = ""
    dim as string zeros = string( 8 , "0" )
    dim as longint v1 , v2 , v3 , place
    dim as string n1 , n2
    for a as longint = 1 to len( chrs ) step 1
       
        n1 = zeros + bin( chrs[ a - 1 ] )
        n1 = right( n1 , 8 )
       
        place = instr( 1 , n1 , "1" )
       
        if place > 0 then
            v2 = val( "&B" + mid( n1 , place + 1 ) )
           
            n2 = ltrim( n1 , "0" )
            n2 = left( n2 , 1 ) + string( len( n2 ) - 1 , "0" )
           
            v1 = val( "&B" + n2 )
           
            v3 = v1 - v2
        else
            v3 = 0
        end if
       
        bits1+= chr( v3 )
       
        'print n1 , place , v1 , v2 , v3
        'sleep
        'if inkey = " " then end
       
    next
   
    print 128 - 21
    print "c bit = " ; len( bits1 ) ' , bits1
   
    dim as string final = bits1
    'for a as longint = 1 to len( bits1 ) step 2
    '    final+= chr( val( "&H" + mid( bits1 , a , 2 ) ) )
    'next
   
    print "c fin = " ; len(final)
   
    return final
   
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
   
    return chrs
   
end function

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

Re: Squares

Postby albert » Jan 05, 2020 2:51

Sorry

I forgot to put in a pointer to the top bit...

top bit 128 , lower bits 127 ( 128 - 127 = 1 )
top bit 4 , lower bits 3 ( 4 - 3 = 1 )

Without a top bit pointer , there's no way to tell one 1 from another...

With a top bit pointer added , it doesn't compress..

128 , 64 , 32 , 16 , 8 , 4 , 2 = ( 0 to 6 ) , takes 3 bits to specify a top pointer... so it could be 8 bits in and 10 bits out...

I got another idea to try.....
Richard
Posts: 3038
Joined: Jan 15, 2007 20:44
Location: Australia

Re: Squares

Postby Richard » Jan 05, 2020 3:04

angros47 wrote:Albert, are you starting to understand, now, why I told you that it is mathematically impossible to compress at a constant, fix ratio?
The field of mathematics (beyond arithmetic) is not part of Albert's equations. It is therefore conceptually impossible to prove how such an obvious and simple concept could possibly be impossible. Such a compression may be discovered, so clearly it must be worth the search. Albert is searching for that holy grail in this tour de force using the Monte Carlo technique. The only problem Albert is having is finding someone clever enough to reverse his hash functions. If an infinite number of monkeys could come up with the works of Shakespeare, then just imagine what Albert might achieve with his computer and a little persistence.
bfuller
Posts: 339
Joined: Jun 02, 2007 12:35
Location: Sydney, Australia

Re: Squares

Postby bfuller » Jan 05, 2020 6:14

Happy New Year to you all.

@Albert, have a look at this little book. I stumbled on it some time ago. It should keep you going for a long time.
For others, still fascinating for the frustrated math geniuses in us.

From Chapter One
ANYONE interested in puzzles will find the theory of numbers a
delightful and inexhaustible source of puzzle problems. It has
justly been called the "Queen of Mathematics" (itself the "Queen of
the Sciences"), and fairly scintillates with intellectual gems contributed
by the world's foremost mathematicians. There is an irresistible
fascination in finding numbers having specified properties, and one
soon falls under their spell and begins to understand why many men
were willing to devote so much time to this subject.

http://www.plouffe.fr/simon/Phys%20et%2 ... umbers.pdf

Its called "Recreations in the Theory of Numbers" by Albert H Beiler. If the link doesn't work, just google it.
dodicat
Posts: 6728
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Postby dodicat » Jan 05, 2020 10:44

I think if somebody says to you that something is mathematically impossible (as per angros47), then a mathematical proof of this is required.
And I don't think that the one particle left in the universe approach is sufficiently rigorous.
Nice link Bfuller.
However, as I suggested in squares a few days back, playing with numbers and Astro physics and other such fanciful pursuits should be put on the back burner for a while, Mother Earth should now be the foremost concern.
However a little digression now and then is OK in my book.
I see that member dinosaur is returning (or has returned) to his homeland, will you resume your popping in for a cup of tea now and then?
For the squares boat people:
When you go out to the sea in boats it brings you different realities, one being, out there and relying on a little human made creation to ensure your safe passage back to terra firma.
Maybe the same for space people, I wouldn't know.
angros47
Posts: 1756
Joined: Jun 21, 2005 19:04

Re: Squares

Postby angros47 » Jan 05, 2020 13:36

dodicat wrote:I think if somebody says to you that something is mathematically impossible (as per angros47), then a mathematical proof of this is required.


You are right. In fact, I provided a mathematical proof of it: https://freebasic.net/forum/viewtopic.php?p=265180#p265180
Do you think that my approach is sufficiently rigorous?
dodicat
Posts: 6728
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Postby dodicat » Jan 05, 2020 14:06

Thank you angros47.
I am an ardent follower of squares, but I missed that one in October.
It is neat enough certainly, but then I could say that in every Olympic Games contest an athlete wants to break the 100 metre record.
The day will never come when the world will say that the current record will never be beaten, thus some day an athlete will run 100 metres in a flash.
Your proof is induction taken to the extreme, but mathematical/philosophical enough I reckon for squares anyway.
So thank you.
But Albert is doing only 100 or so loops at a time and is not being too unrealistic IMHO.
Richard
Posts: 3038
Joined: Jan 15, 2007 20:44
Location: Australia

Re: Squares

Postby Richard » Jan 05, 2020 14:07

angros47 wrote:Do you think that my approach is sufficiently rigorous?
Your mathematical proof can only be understood and believed by mathematicians.

It is simply an admission that a mathematician has proved that a mathematician can't do it.
I see no reason why that might stop Albert from trying.
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Binary Data Compressor ( BDC )

Postby albert » Jan 05, 2020 18:19

@Richard
@Dodicat
@StoneMonkey

I think i got it...

n1 = 8 bits

n2 = ""
if mid( n1 , 1 , 1 ) = "1" then n2+= "0"
if mid( n1 , 2 , 1 ) = "1" then n2+= "1"
if mid( n1 , 3 , 1 ) = "1" then n2+= "10"
if mid( n1 , 4 , 1 ) = "1" then n2+= "11"
if n2 = "" then n2 = "00"

n3 = ""
if mid( n1 , 5 , 1 ) = "1" then n3+= "0"
if mid( n1 , 6 , 1 ) = "1" then n3+= "1"
if mid( n1 , 7 , 1 ) = "1" then n3+= "10"
if mid( n1 , 8 , 1 ) = "1" then n3+= "11"
if n3 = "" then n3 = "00"

bits1+= n2 + "0"
bits2+= n3 + "0"

Each set ends in a "0" so you can tell them apart....
4 bits set or not set is kinda rare , while 2 bits set , is the most common....So it compresses..

Compresses 10,000 to 87% after 100 loops..
Compresses 100,000 and up to 90+% after 100 loops.. It's kinda slow though...

Code: Select all


Declare Function   compress_loop( chrs as string ) as string
Declare Function decompress_loop( chrs as string ) as string


Namespace Zlibrary

#inclib "zlib"
Extern "C"
    Declare Function compressBound(Byval sourceLen As Ulong) As Ulong
    Declare Function uncompress(Byval dest As Ubyte Ptr, Byval destLen As Uinteger Ptr, Byval source As  Ubyte Ptr, Byval sourceLen As Ulong) As Long
    Declare Function compress(Byval dest As Ubyte Ptr, Byval destLen As Uinteger Ptr, Byval source As  Ubyte Ptr, Byval sourceLen As Ulong) As Long
End Extern

Function getpassedinfo(text As String,Byref passed_length As Integer) As String
    Dim As String var1,var2
    Dim As Integer pst
    #macro splice(stri,char,var1,var2)
    pst=Instr(stri,char)
    var1="":var2=""
    If pst<>0 Then
        var1=Mid(stri,1,pst-1)
        var2=Mid(stri,pst+1)
    Else
        var1=stri
    End If
    #endmacro
    splice(text,"|",var1,var2)
    text=var2
    passed_length=Valint(var1)
    Return text
End Function


'=================   UNPACK ===============
Function unpack(file As String) As String
    Dim As Integer passed_length
    Dim As String text=getpassedinfo(file,passed_length)
    Dim As Integer stringlength,destinationlength
    stringlength=Len(text)
    destinationlength =passed_length
    Dim As Ubyte Ptr source
    Dim As Ubyte Ptr  destination =Callocate(destinationlength,1)
    source=@text[0]
    Var mistake=uncompress(destination,@destinationlength, source, stringlength)
    If mistake<>0 Then Print "There was an error":Sleep:End
    Dim As String uncompressed
    uncompressed=String(destinationlength,0)
    For i As Integer = 0 To destinationlength- 1
        uncompressed[i]=(destination[i])
    Next
    Deallocate destination
    Return uncompressed
End Function

'===================  PACK ============
Function pack(file As String) As String
    Dim As String text=file
    Dim As Integer stringlength,destinationlength
    stringlength=Len(text)
    destinationlength = compressBound(stringlength)
    Dim As Ubyte Ptr source
    Dim As Ubyte Ptr destination =Callocate(destinationlength,1)
    source=@text[0]
    Var mistake=compress(destination, @destinationlength, source, stringlength)
    If mistake <>0 Then Print "There was an error"
    Dim As String compressed
    compressed=String(destinationlength,0)
    For n As Integer=0 To destinationlength-1
        compressed[n]=destination[n]
    Next n
    compressed=stringlength &"|"+compressed
    Deallocate destination
    Return compressed
End Function

End Namespace


'==================================================================
'==================================================================
'test zipper
'==================================================================
'==================================================================
screen 19

Dim Shared As String s

Randomize

s=""
dim as string check=""
dim as string compare=""
dim as longint length = 0
dim as double compression = 0
dim as longint loops = 0

dim as double time1 , time2

time1 = timer
do
   
    loops+=1
   
    'one time run , create initial string
    if loops = 1 then
        For n As Long = 1 To 100000
            s+=chr(Int(Rnd*256))'+48
        Next
        compare =  s
        length = len(s)
    else
        'modify compression to make further compression possible
       
        s = compress_loop(s)
   
    end if
    check = s
    compression = (100 - ( 100 / ( length / len(check) ) ))
   
    Print "original string"
    Print Len(s)
    Print
   
    Dim As String compressed=Zlibrary.pack(s)
    s = compressed
   
    Print "packed string "
    Print Len(compressed)
    Print
   
    Dim As String uncompressed=Zlibrary.unpack(compressed)
   
    Print "Retrieve"
    Print Len(uncompressed)
    Print
    'Print "compression ratio  "; 100 - ( 100 / ( Len(s) / len(compressed) ) ) ; "%"
    Print "compression ratio  "; 100 - ( 100 / ( length / len(s) ) ) ; "%"
    Print Iif(uncompressed=check,"OK","ERROR")
    Print "-------------------------------"
   
    'sleep 1000
   
    'if loops > 2 and (100 - ( 100 / ( length / len(s) ) )) < compression then exit do
   
    print "press esc to exit."
    print
    print "press a key for next compression." ; " loops = " ; loops ; " out of 100."
    'sleep
   
    if inkey = chr(27) then exit do
   
loop until loops = 100

time2 = timer

print
print  "Compress time = " ; time2 - time1
print
print "Press a key to decompress."
sleep

s = str(loops) + "_" + s ' save as an output file...

'==================================================================
'decompress
'==================================================================
dim as longint dec = instr(1,s,"_")
dim as longint count = val(left(s,dec-1))
dim as string comp = mid(s,dec+1)
dim as string val1
dim as string outs
for a as longint = count to 2 step -1
    s = Zlibrary.unpack(comp)
    outs = decompress_loop(s)
    comp = outs
next

comp = Zlibrary.unpack(comp)

print
print "input = "; length , "output = " ; len(comp) , "compression ratio  "; 100 - ( 100 / ( length / len(s) ) ) ; "%"
print
if comp = compare then print "Decompression successful." else print "ERROR"
print
print
Print "!!~~Done~~!!"

Sleep
end
'===============================================================================
'============================,===================================================
'begin functions
'===============================================================================
'================='==============================================================
Function compress_loop( chrs as string ) as string
   
    print "c inp = " ; len(chrs) ' , chrs
   
    dim as string bits1 = ""
    dim as string bits2 = ""
    dim as string zeros = string( 8 , "0" )
    dim as string n1 , n2 , n3
    for a as longint = 1 to len( chrs ) step 1
       
        n1 = zeros + bin( chrs[ a - 1 ] )
        n1 = right( n1 , 8 )
       
        n2 = ""
        if mid( n1 , 1 , 1 ) = "1" then n2+= "0"
        if mid( n1 , 2 , 1 ) = "1" then n2+= "1"
        if mid( n1 , 3 , 1 ) = "1" then n2+= "10"
        if mid( n1 , 4 , 1 ) = "1" then n2+= "11"
        if n2 = "" then n2 = "00"
       
        n3 = ""
        if mid( n1 , 5 , 1 ) = "1" then n3+= "0"
        if mid( n1 , 6 , 1 ) = "1" then n3+= "1"
        if mid( n1 , 7 , 1 ) = "1" then n3+= "10"
        if mid( n1 , 8 , 1 ) = "1" then n3+= "11"
        if n3 = "" then n3 = "00"
       
        bits1+= n2 + "0"
        bits2+= n3 + "0"
       
        'print n1 , val( "&B" + n1 ) , n2 , n3
        'sleep
        'if inkey = " " then end
       
    next
   
    print "c bit = " ; len( bits1 ) ' , bits1
   
    dim as string final = ""
    'dim as string s , n
    for a as longint = 1 to len( bits1 ) step 8
        's = mid( bits1 , a , 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 , a , 8 ) ) )
    next
    final+= "END"
    for a as longint = 1 to len( bits2 ) step 8
        's = mid( bits2 , a , 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( bits2 , a , 8 ) ) )
    next
   
    print "c fin = " ; len(final)
   
    return final
   
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
   
   
    return chrs
   
end function

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

Re: Squares

Postby angros47 » Jan 05, 2020 18:50

So if n1 is 11111111, n2 should be 011011 (6 bits), and so n3. Add the 0 separators, and you end with 6+1+6+1=14 bits instead of 8. You will not compress, you will bloat the data set.

And having 4 bit set (or not set) is actually pretty common, in pictures for examples, if a big area is white.
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Jan 05, 2020 19:02

@angros47

Run the above "BDC" compressor code , and see the compression, for yourself...

0 bits , or 8 bits , only happens like 10,000 times in 100,000 bytes input..

If the input is "0000+0000" then the output would be "000" and "000" = six bits out.

The most common nibbles have 1 or 2 bits set..
So ; most often , it's 8 bits in , and 2 to 8 bits out..

bits = num , 2 bits set is the most common...
0 = 1
1 = 4
2 = 6
3 = 4
4 = 1
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

BDC ( Test Bed )

Postby albert » Jan 05, 2020 20:11

"Binary Data Compressor" ( BDC )

Here's Test-Bed , where i write the de-compressor...

I could use some help with the decompression.... I got the de-compressor started...

First nibble , is in bits1 , bin1
Second nibble , is in bits2 , bin2

Code: Select all


'Binary Data Compressor ( BDC )

Declare Function      compress_loop( chrs as string ) as string
Declare Function decompress_loop( chrs as string ) as string

screen 19
'=====================================================================
'=====================================================================
'start program
'=====================================================================
'=====================================================================
dim as double time1 , time2 , time3 , time4
do
   
    randomize
   
    dim as string s = ""
    For n As Long = 1 To 8
        s+=chr(Int(Rnd*256))
    Next
   
    time1=timer
    'begin compress
        dim as string comp = s
            'do
            '    dim as longint chk = len(comp) - 1
            '    comp = compress_loop(comp)
            '    if len(comp) >= chk then exit do
            '    if inkey = chr( 27 ) then end
            'loop
            for a as longint = 1 to 1 step 1
                comp = compress_loop(comp)
            next
    'end compress
    time2 = timer
   
    time3=timer
    'begin decompress
        dim as string final_out = comp
        for a as longint = 1 to 1 step 1
            final_out = decompress_loop(final_out)
        next
    'end decompress
    time4 = timer
   
   'sleep
   
    print string(99,"=")
    print "inp = " ; (s)
    print string(99,"=")
    print "out = " ; (final_out)
    print
    print "compress time   = "; time2-time1
    print "decompress time = "; time4-time3
    print
   
    if s = final_out then print "Decompressed OK" else print "Decompression failed."
    print string(99,"=")
   
    sleep
   
loop until inkey = chr(27)

sleep
end
'===============================================================================
'===============================================================================
'compress
'===============================================================================
'===============================================================================
Function compress_loop( chrs as string ) as string
   
    print "c inp = " ; len(chrs) ' , chrs
   
    dim as string bits1 = ""
    dim as string bits2 = ""
    dim as string zeros = string( 8 , "0" )
    dim as string n1 , n2 , n3
    for a as longint = 1 to len( chrs ) step 1
       
        n1 = zeros + bin( chrs[ a - 1 ] )
        n1 = right( n1 , 8 )
       
        n2 = ""
        if mid( n1 , 1 , 1 ) = "1" then n2+= "0"
        if mid( n1 , 2 , 1 ) = "1" then n2+= "1"
        if mid( n1 , 3 , 1 ) = "1" then n2+= "10"
        if mid( n1 , 4 , 1 ) = "1" then n2+= "11"
        if n2 = "" then n2 = "00"
       
        n3 = ""
        if mid( n1 , 5 , 1 ) = "1" then n3+= "0"
        if mid( n1 , 6 , 1 ) = "1" then n3+= "1"
        if mid( n1 , 7 , 1 ) = "1" then n3+= "10"
        if mid( n1 , 8 , 1 ) = "1" then n3+= "11"
        if n3 = "" then n3 = "00"
       
        bits1+= n2 + "0"
        bits2+= n3 + "0"
       
        'print n1 , val( "&B" + n1 ) , n2 , n3
        'sleep
        'if inkey = " " then end
       
    next
   
    print "c bit = " ; len( bits1 ) , bits1
    print "c bit = " ; len( bits2 ) , bits2
   
    dim as ubyte count1  = 0
    dim as string str1
    dim as ubyte dec1
    do
        str1 = str( len( bits1 ) / 8 )
        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 a as longint = 1 to len( bits1 ) step 8
        's = mid( bits1 , a , 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 , a , 8 ) ) )
    next
    final+= "END"
    for a as longint = 1 to len( bits2 ) step 8
        's = mid( bits2 , a , 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( bits2 , a , 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 )
    chrs = mid( chrs , place + 4 )
    dim as string bits2 = chrs
   
    dim as string bin1 = ""
    dim as string zeros = string( 8 , "0" )
    dim as string n1
    for a as longint = 1 to len( bits1 ) step 1
        n1 = zeros + bin( bits1[ a - 1 ] )
        n1 = right( n1 , 8 )
        bin1+= n1
    next
    bin1 = left( bin1 , len( bin1 ) - count1 )
   
    dim as string bin2 = ""
    for a as longint = 1 to len( bits2 ) step 1
        n1 = zeros + bin( bits2[ a - 1 ] )
        n1 = right( n1 , 8 )
        bin2+= n1
    next
    bin2 = left( bin2 , len( bin2 ) - count2 )
   
    print "d bit = " ; len( bin1 ) , bin1
    print "d bit = " ; len( bin2 ) , bin2
       
   
    return chrs
   
end function

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

Re: Squares

Postby albert » Jan 05, 2020 20:32

I think i got a problem

11001
1 10 0 - 1
11 0 - 01

1001
10 - 01
10 0 - 1

I got to start or end the nibble , with something other than "0"
badidea
Posts: 2154
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Squares

Postby badidea » Jan 05, 2020 21:29

angros47 wrote:..

There is no point in trying to convince albert. All have tried. He has been working on a magic compressor for 20 years and will continue to do so.
Last edited by badidea on Jan 05, 2020 22:12, edited 1 time in total.

Return to “General”

Who is online

Users browsing this forum: No registered users and 9 guests