Squares

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

Re: Squares

Postby albert » Dec 01, 2019 18:39

@Dodicat
@StoneMonkey

I added the case , of one of the values equaling zero..

if v3 = 63 then vals = "11101"

if ( v1 - 1 ) = 0 or ( v2 - 1 ) = 0 then vals+= "1" else vals+= "0"
if v1 < v2 then vals+= "00" else vals+= "11"

So the output is 8 bits...

Now it takes 300 loops , to get sizeable compression.

Compresses 10,000 to 60% after 300 loops.. Takes 10 seconds..
Compresses 100,000 to 93% after 300 loops.. Takes 1 minute..
Compresses 1,000,000 to 94% after 300 loops.. Takes 500 seconds..

Now : to figure out how to speed it up...And write the decompression..
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Yah-Zip ( Test Bed )

Postby albert » Dec 01, 2019 22:14

@Dodicat
@StoneMonkey

I can't get the decompressor working..
It's sometimes decompressing okay , but mostly not..

Can one of you guys help??

Here's the "Test-Bed" , where i try to write the decompression..

Code: Select all


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

screen 19
'=====================================================================
'=====================================================================
'start program
'=====================================================================
'=====================================================================
dim as double time1 , time2 , time3 , time4
do
   
    randomize
   
    dim as string s = ""
    For n As Long = 1 To 8
        s+=chr(Int(Rnd*256))
    Next
   
    time1=timer
    'begin compress
        dim as string comp = s
            'do
            '    dim as longint chk = len(comp) - 1
            '    comp = compress_loop(comp)
            '    if len(comp) >= chk then exit do
            '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
   
    'cls
    'draw string( 0,10) , left(s,100)
    'draw string( 0,30) , left(final_out,100)
    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)
   
    dim as string bits = ""
    dim as string zeros = string( 8 , "0" )
    dim as string n1
    dim as ubyte ptr usp = cptr( ubyte ptr , strptr( chrs ) )
    for a as longint = 1 to len( chrs ) step 1
        n1 = zeros + bin( *usp ) : usp+= 1
        n1 = right( n1 , 8 )
        bits+= n1
    next
   
    print "c bin = " ; len(bits) , bits
   
    dim as ubyte count = 0
    dim as string str1
    dim as ubyte dec1
    do
        str1 = str( len( bits ) / 6 )
        dec1 = instr( 1 , str1 , "." )
        if dec1 <> 0  then bits+= "0" : count+= 1
    loop until dec1 = 0
   
    dim as string outs1 = ""
    dim as string vals
    dim as ubyte v1 , v2 , v3
    for a as longint = 1 to len( bits ) step 6
           
        n1 = mid( bits , a , 6 )
       
        v1 = val( "&B" + mid( n1 , 01 , 3 ) ) + 1
        v2 = val( "&B" + mid( n1 , 04 , 3 ) ) + 1
       
        v3 = ( v1 * v2 ) - 1
       
        vals = right( "000000" + bin( v3 ) , 6 )
       
        if v1 = 1 or v2 = 1 then vals+= "1" else vals+= "0"
        if v1 < v2 then vals+= "0" else vals+= "1"
       
        outs1+= vals
       
        'print n1 , v1 , v2 , vals
        '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
   
    final = chr( count ) + final
   
    print
    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 count = asc( left( chrs , 1 ) )
    chrs = mid( chrs , 2 )
   
    dim as string bits = ""
    dim as string zeros = string( 8 , "0" )
    dim as string n1
    dim as ubyte ptr usp = cptr( ubyte ptr , strptr( chrs ) )
    for a as longint = 1 to len( chrs ) step 1
        n1 = zeros + bin( *usp ) : usp+= 1
        n1 = right( n1 , 8)
        bits+= n1
    next
   
    print "d bin = " ; len(bits) , bits
   
    dim as string outs1 = ""
    dim as string vals
    dim as ubyte v1 , v2 , v3 , zero , grtr
    for a as longint = 1 to len( bits ) step 8
       
        n1 = mid( bits , a , 8 )
       
        v3 = val( "&B" + mid( n1 , 1 , 6 ) )
        zero = val( mid( n1 , 7 ,1 ) )
        grtr = val( mid( n1 , 8 , 1 ) )
       
        print n1 , v3 , zero , grtr ,
       
        for b as ubyte = 0 to 7
            for c as ubyte = 0 to 7
                if ( ( b + 1 ) * ( c + 1 ) ) - 1 = v3 then v1 = c : v2 = b : exit for
            next
        next
       
        if grtr = 1 then swap v1 , v2
       
        print v3 , v1 , v2
       
        vals = right( "000" + bin( v1 ) , 3 ) + right( "000" + bin( v2 ) , 3 )
       
        outs1+= vals
       
    next
   
    outs1 = left( outs1 , len( outs1 ) - count )
   
    print "d 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
   
    print
    print "d fin = " ; len(final)
   
    return final
   
end function




I figured out the problem , there are some duplicats ...
I wrote a little program to find duplicates...

Code: Select all


screen 19

dim as string n1

redim as ubyte vals( 0 to 63)
redim as string muls1( 0 to 63)
redim as string muls2( 0 to 63)

dim as longint high = 0
dim as ubyte v1 , v2 , v3
for a as longint = 0 to 63 step 1
   
    n1 = right( "000000" + bin( a ) , 6 )
   
    v1 = val( "&B" + mid( n1 , 1 , 3 ) ) + 1
    v2 = val( "&B" + mid( n1 , 4 , 3 ) ) + 1
   
    v3 = ( v1 * v2 ) - 1
       
    vals( a ) = v3
    muls1(a) = str( v1 - 1 ) + " " + str(  v2 - 1 )
    muls2(a) = str( v1 - 0 ) + " " + str(  v2 - 0 )
       
next

for b as longint = 0 to 63
    for c as longint = b+1 to 63
        if muls2( b ) > muls2( c ) then
            swap vals( b ) , vals( c )
            swap muls1( b ) , muls1( c )
            swap muls2( b ) , muls2( c )
        end if
    next
next

print "value      number         equates"
for a as longint = 0 to 63
    if vals(a) > 0 then
        print
        for b as longint = 0 to 63
            if vals(b) = a then print a , vals( b ) , muls2( b ) , muls1( b )
        next
    end if
    if a mod 8 = 0 then sleep
next

print  "All Done!!"

'print
'print "dict = " ; high , dict

' dict =  30  , 0 1 2 3 4 5 6 7 9 11 13 15 8 14 17 20 23 19 27 31 24 29 34 39 35 41 47 48 55 63

sleep
end
 


The following numbers , have two sets of answers : 3 , 5 , 7 ,11 , 15 , 23 the rest of the 30 are all single values.

v1 = left( 3 ) + 1
v2 = rght( 3 ) + 1
v3 = ( v1 * v2 ) - 1

03 = 1 4 , 2 2
05 = 1 6 , 2 3
07 = 1 8 , 2 4
11 = 2 6 , 3 4
15 = 2 8 , 4 4
23 = 3 8 , 4 6

So i have to go back to 5 bits and an extension of 3 bits to make it 8 bits out.
Set the 6th bit to 1 if its a duplicate
Set the 7th bit to 1 if theres a zero
Set the 8th bit to 1 if v1 >= v2

I hope it will still compress , after all that...

( !!~~edited~~!! )
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Dec 02, 2019 1:13

@Dodicat
@StoneMonkey

The above after i added it to the compressor , it expands instead of compressing...

I think I've got a method figured out.. I'll try it tomorrow , I'm done playing around for the day..

3 , 5 , 7 ; the duplicates all have a 0 , so the ( zero pointer bit ) would solve those...

So then there's only the , 11 , 15 and 23 , dupllcates to figure...
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Dec 02, 2019 1:37

Here's my solution...

Code: Select all

       
        if v3 = 00 then vals = "000000" : goto done
        if v3 = 01 then vals = "000001" : goto done
        if v3 = 02 then vals = "000010" : goto done
        if v3 = 03 then vals = "000011" : goto done
        if v3 = 04 then vals = "000100" : goto done
        if v3 = 05 then vals = "000101" : goto done
        if v3 = 06 then vals = "000110" : goto done
        if v3 = 07 then vals = "000111" : goto done
        if v3 = 08 then vals = "001000" : goto done
        if v3 = 09 then vals = "001001" : goto done
       
        if v3 = 11 then vals = "001010" : goto done
            if v3 = 11 then vals = "100000" : goto done
       
        if v3 = 13 then vals = "001011" : goto done
       
        if v3 = 15 then vals = "001100" : goto done
            if v3 = 15 then vals = "100001" : goto done
       
        if v3 = 14 then vals = "001101" : goto done
        if v3 = 17 then vals = "001110" : goto done
        if v3 = 19 then vals = "001111" : goto done
        if v3 = 20 then vals = "010000" : goto done
       
        if v3 = 23 then vals = "010001" : goto done
            if v3 = 23 then vals = "100010" : goto done
       
        if v3 = 24 then vals = "010010" : goto done
        if v3 = 27 then vals = "010011" : goto done
        if v3 = 29 then vals = "010100" : goto done
        if v3 = 31 then vals = "010101" : goto done
        if v3 = 34 then vals = "010110" : goto done
        if v3 = 35 then vals = "010111" : goto done
        if v3 = 39 then vals = "011000" : goto done
        if v3 = 41 then vals = "011001" : goto done
        if v3 = 47 then vals = "011010" : goto done
        if v3 = 48 then vals = "011011" : goto done
        if v3 = 55 then vals = "011100" : goto done
        if v3 = 63 then vals = "011101" : goto done



6 bits out , plus the zero pointer bit and the v1 >= v2 bit.. total 8 bits out


Time for pills and bed.....Goodnight everyone...

( !!~~Edited~~!! )
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Dec 03, 2019 2:00

@Dodicat
@StoneMonkey

I got a solution worked out... Just have to write the decompression , before i post..

Compresses 1,000 , 10,000 , 100,000 , 1,000,000 , all 90+% after 100 loops..

I might need some help with the decompression.. I'll try to do it on my own..
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Mul-Zip

Postby albert » Dec 03, 2019 2:30

@Dodicat
@StoneMonkey

Here's my solution...

Code: Select all

                if v1 = 0 and v2 = 0 then vals = "00" : goto done
               
                if v1 = 0 and v2 = 1 then vals = "01" : goto done
                if v1 = 0 and v2 = 2 then vals = "02" : goto done
                if v1 = 0 and v2 = 3 then vals = "03" : goto done
                if v1 = 0 and v2 = 4 then vals = "04" : goto done
                if v1 = 0 and v2 = 5 then vals = "05" : goto done
                if v1 = 0 and v2 = 6 then vals = "06" : goto done
                if v1 = 0 and v2 = 7 then vals = "07" : goto done
               
                if v1 = 1 and v2 = 0 then vals = "01" : goto done
                if v1 = 2 and v2 = 0 then vals = "02" : goto done
                if v1 = 3 and v2 = 0 then vals = "03" : goto done
                if v1 = 4 and v2 = 0 then vals = "04" : goto done
                if v1 = 5 and v2 = 0 then vals = "05" : goto done
                if v1 = 6 and v2 = 0 then vals = "06" : goto done
                if v1 = 7 and v2 = 0 then vals = "07" : goto done
               
                if v1 = 1 and v2 = 1 then vals = "08" : goto done
               
                if v1 = 1 and v2 = 2 then vals = "09" : goto done
                if v1 = 2 and v2 = 1 then vals = "09" : goto done
               
                if v1 = 1 and v2 = 3 then vals = "10" : goto done
                if v1 = 3 and v2 = 1 then vals = "10" : goto done
               
                if v1 = 1 and v2 = 4 then vals = "11" : goto done
                if v1 = 2 and v2 = 2 then vals = "12" : goto done
                if v1 = 4 and v2 = 1 then vals = "11" : goto done
               
                if v1 = 1 and v2 = 5 then vals = "13" : goto done
                if v1 = 5 and v2 = 1 then vals = "13" : goto done
               
                if v1 = 1 and v2 = 6 then vals = "14" : goto done
                if v1 = 2 and v2 = 3 then vals = "15" : goto done
                if v1 = 3 and v2 = 2 then vals = "15" : goto done
                if v1 = 6 and v2 = 1 then vals = "14" : goto done
               
                if v1 = 1 and v2 = 7 then vals = "16" : goto done
                if v1 = 7 and v2 = 1 then vals = "16" : goto done
               
                if v1 = 2 and v2 = 4 then vals = "17" : goto done
                if v1 = 4 and v2 = 2 then vals = "17" : goto done
               
                if v1 = 3 and v2 = 3 then vals = "18" : goto done
               
                if v1 = 2 and v2 = 5 then vals = "19" : goto done
                if v1 = 5 and v2 = 2 then vals = "19" : goto done
               
                if v1 = 2 and v2 = 6 then vals = "20" : goto done
                if v1 = 3 and v2 = 4 then vals = "21" : goto done
                if v1 = 4 and v2 = 3 then vals = "21" : goto done
                if v1 = 6 and v2 = 2 then vals = "20" : goto done
               
                if v1 = 2 and v2 = 7 then vals = "22" : goto done
                if v1 = 7 and v2 = 2 then vals = "22" : goto done
               
                if v1 = 3 and v2 = 5 then vals = "23" : goto done
                if v1 = 5 and v2 = 3 then vals = "23" : goto done
               
                if v1 = 4 and v2 = 4 then vals = "24" : goto done
               
                if v1 = 3 and v2 = 6 then vals = "25" : goto done
                if v1 = 6 and v2 = 3 then vals = "25" : goto done
               
                if v1 = 4 and v2 = 5 then vals = "26" : goto done
                if v1 = 5 and v2 = 4 then vals = "26" : goto done
               
                if v1 = 3 and v2 = 7 then vals = "27" : goto done
                if v1 = 7 and v2 = 3 then vals = "27" : goto done
               
                if v1 = 4 and v2 = 6 then vals = "28" : goto done
                if v1 = 6 and v2 = 4 then vals = "28" : goto done
               
                if v1 = 5 and v2 = 5 then vals = "29" : goto done
               
                if v1 = 4 and v2 = 7 then vals = "30" : goto done
                if v1 = 7 and v2 = 4 then vals = "30" : goto done
               
                if v1 = 5 and v2 = 6 then vals = "31" : goto done
                if v1 = 6 and v2 = 5 then vals = "31" : goto done
               
                if v1 = 5 and v2 = 7 then vals = "32" : goto done
                if v1 = 7 and v2 = 5 then vals = "32" : goto done
               
                if v1 = 6 and v2 = 6 then vals = "33" : goto done
               
                if v1 = 6 and v2 = 7 then vals = "34" : goto done
                if v1 = 7 and v2 = 6 then vals = "34" : goto done
               
                if v1 = 7 and v2 = 7 then vals = "35" : goto done
           
            done:
           
            bins = bin( val( right( vals , 1 ) ) ) + "1" + bin( val( left( vals , 1 ) ) )
           
            if v1 < v2 then bins+= "0" else bins+= "1"
           
        outs1+= chr( val( "&B"+ bins ) )



The end has to be one of the following.

100
101

110
111

1100
1101

1110
1111

Eight possible values for the ending...


Here's the "Test-Bed" where i write the decompression... I got the de-compressor started..

Code: Select all


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

screen 19
'=====================================================================
'=====================================================================
'start program
'=====================================================================
'=====================================================================
dim as double time1 , time2 , time3 , time4
do
   
    randomize
   
    dim as string s = ""
    For n As Long = 1 To 8
        s+=chr(Int(Rnd*256))
    Next
   
    time1=timer
    'begin compress
        dim as string comp = s
            'do
            '    dim as longint chk = len(comp) - 1
            '    comp = compress_loop(comp)
            '    if len(comp) >= chk then exit do
            '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
   
    'cls
    'draw string( 0,10) , left(s,100)
    'draw string( 0,30) , left(final_out,100)
    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)
   
    dim as string bits = ""
    dim as string zeros = string( 8 , "0" )
    dim as string n1
    dim as ubyte ptr usp = cptr( ubyte ptr , strptr( chrs ) )
    for a as longint = 1 to len( chrs ) step 1
        n1 = zeros + bin( *usp ) : usp+= 1
        n1 = right( n1 , 8 )
        bits+= n1
    next
   
    print "c bin = " ; len(bits) , bits
   
    dim as ubyte count
    dim as string str1
    dim as ubyte dec1
    do
        str1 = str( len( bits ) / 6 )
        dec1 = instr( 1 , str1 , "." )
        if dec1 <> 0 then bits+= "0" : count+= 1
    loop until dec1 = 0

    dim as string outs1 = ""
    dim as string vals
    dim as string bins
    dim as ubyte v1 , v2 , v3
    for a as longint = 1 to len( bits ) step 6
           
        n1 = mid( bits , a , 6 )
       
        v1 = val( "&B" + mid( n1 , 01 , 3 ) )
        v2 = val( "&B" + mid( n1 , 04 , 3 ) )
       
                if v1 = 0 and v2 = 0 then vals = "00" : goto done
               
                if v1 = 0 and v2 = 1 then vals = "01" : goto done
                if v1 = 0 and v2 = 2 then vals = "02" : goto done
                if v1 = 0 and v2 = 3 then vals = "03" : goto done
                if v1 = 0 and v2 = 4 then vals = "04" : goto done
                if v1 = 0 and v2 = 5 then vals = "05" : goto done
                if v1 = 0 and v2 = 6 then vals = "06" : goto done
                if v1 = 0 and v2 = 7 then vals = "07" : goto done
               
                if v1 = 1 and v2 = 0 then vals = "01" : goto done
                if v1 = 2 and v2 = 0 then vals = "02" : goto done
                if v1 = 3 and v2 = 0 then vals = "03" : goto done
                if v1 = 4 and v2 = 0 then vals = "04" : goto done
                if v1 = 5 and v2 = 0 then vals = "05" : goto done
                if v1 = 6 and v2 = 0 then vals = "06" : goto done
                if v1 = 7 and v2 = 0 then vals = "07" : goto done
               
                if v1 = 1 and v2 = 1 then vals = "08" : goto done
               
                if v1 = 1 and v2 = 2 then vals = "09" : goto done
                if v1 = 2 and v2 = 1 then vals = "09" : goto done
               
                if v1 = 1 and v2 = 3 then vals = "10" : goto done
                if v1 = 3 and v2 = 1 then vals = "10" : goto done
               
                if v1 = 1 and v2 = 4 then vals = "11" : goto done
                if v1 = 2 and v2 = 2 then vals = "12" : goto done
                if v1 = 4 and v2 = 1 then vals = "11" : goto done
               
                if v1 = 1 and v2 = 5 then vals = "13" : goto done
                if v1 = 5 and v2 = 1 then vals = "13" : goto done
               
                if v1 = 1 and v2 = 6 then vals = "14" : goto done
                if v1 = 2 and v2 = 3 then vals = "15" : goto done
                if v1 = 3 and v2 = 2 then vals = "15" : goto done
                if v1 = 6 and v2 = 1 then vals = "14" : goto done
               
                if v1 = 1 and v2 = 7 then vals = "16" : goto done
                if v1 = 7 and v2 = 1 then vals = "16" : goto done
               
                if v1 = 2 and v2 = 4 then vals = "17" : goto done
                if v1 = 4 and v2 = 2 then vals = "17" : goto done
               
                if v1 = 3 and v2 = 3 then vals = "18" : goto done
               
                if v1 = 2 and v2 = 5 then vals = "19" : goto done
                if v1 = 5 and v2 = 2 then vals = "19" : goto done
               
                if v1 = 2 and v2 = 6 then vals = "20" : goto done
                if v1 = 3 and v2 = 4 then vals = "21" : goto done
                if v1 = 4 and v2 = 3 then vals = "21" : goto done
                if v1 = 6 and v2 = 2 then vals = "20" : goto done
               
                if v1 = 2 and v2 = 7 then vals = "22" : goto done
                if v1 = 7 and v2 = 2 then vals = "22" : goto done
               
                if v1 = 3 and v2 = 5 then vals = "23" : goto done
                if v1 = 5 and v2 = 3 then vals = "23" : goto done
               
                if v1 = 4 and v2 = 4 then vals = "24" : goto done
               
                if v1 = 3 and v2 = 6 then vals = "25" : goto done
                if v1 = 6 and v2 = 3 then vals = "25" : goto done
               
                if v1 = 4 and v2 = 5 then vals = "26" : goto done
                if v1 = 5 and v2 = 4 then vals = "26" : goto done
               
                if v1 = 3 and v2 = 7 then vals = "27" : goto done
                if v1 = 7 and v2 = 3 then vals = "27" : goto done
               
                if v1 = 4 and v2 = 6 then vals = "28" : goto done
                if v1 = 6 and v2 = 4 then vals = "28" : goto done
               
                if v1 = 5 and v2 = 5 then vals = "29" : goto done
               
                if v1 = 4 and v2 = 7 then vals = "30" : goto done
                if v1 = 7 and v2 = 4 then vals = "30" : goto done
               
                if v1 = 5 and v2 = 6 then vals = "31" : goto done
                if v1 = 6 and v2 = 5 then vals = "31" : goto done
               
                if v1 = 5 and v2 = 7 then vals = "32" : goto done
                if v1 = 7 and v2 = 5 then vals = "32" : goto done
               
                if v1 = 6 and v2 = 6 then vals = "33" : goto done
               
                if v1 = 6 and v2 = 7 then vals = "34" : goto done
                if v1 = 7 and v2 = 6 then vals = "34" : goto done
               
                if v1 = 7 and v2 = 7 then vals = "35" : goto done
           
            done:
           
            bins = bin( val( right( vals , 1 ) ) ) + "1" + bin( val( left( vals , 1 ) ) )
           
            if v1 < v2 then bins+= "0" else bins+= "1"
           
        outs1+= chr( val( "&B"+ bins ) )
       
        'print n1 , v1 , v2 , vals , bins
        'sleep
        'if inkey = "" then end
       
    next
   
    print "c out = "; len(outs1) , ' , outs1
    for a as longint = 1 to len( outs1 ) step 1
        n1 = bin( outs1[ a - 1 ] )
        print n1 ; " " ;
    next
    print
   
    dim as string final = outs1
    'for a as longint = 1 to len( outs1 ) step 8
    '    final+= chr( val( "&B"+ mid( outs1 , a , 8 ) ) )
    'next
   
    final = chr( count ) + final

    print "c fin = "; len(final)
   
    return final
   
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
   
    print "d inp = "; len(chrs)
   
    dim as ubyte count = asc( left( chrs , 1 ) )
    chrs = mid( chrs , 2 )
   
    dim as string bits = ""
    dim as string zeros = string( 8 , "0")
    dim as string n1
    dim as ubyte ptr usp = cptr( ubyte ptr , strptr( chrs ) )
    for a as longint = 1 to len( chrs ) step 1
        n1 = bin( *usp ) : usp+= 1
        bits+= n1 + " "
    next
   
    print "d bin = "; len(bits) , bits
   
    return chrs
   
end function

Stonemonkey
Posts: 646
Joined: Jun 09, 2005 0:08

Re: Squares

Postby Stonemonkey » Dec 03, 2019 20:13

@albert, looks like you've got 0x and x0 giving out the same code.
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Dec 04, 2019 1:04

@StoneMonkey

0x and x0 are solved by

if v1 < v2 then bins+= "0" else bins+= "1"


I worked out a new formula , but it takes 400 loops to get 90% compression..
Richard
Posts: 3030
Joined: Jan 15, 2007 20:44
Location: Australia

Re: Squares

Postby Richard » Dec 04, 2019 4:26

As dyscalculia is to arithmetic, so what? is to algebra.
Cross multiply;
∴ dyscalculia * algebra / arithmetic = what?
Futility?
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Dec 04, 2019 22:39

@Richard

I finally got a method that will work.. It's a simple Simon solution.. ( 0 to 63 )

I just have to hard wire the values , into the de-compressor..

I should have it done , in a couple days..

For 100 loops :
Compresses 1,000 10%
Compresses 10,000 90%
Compresses 100,000 98% ( takes 9 to 11 seconds )
Compresses 1,000,000 98% ( takes 130 to 140 seconds )
Compresses 5,000,000 98% ( takes ~540 seconds )

I'm afraid that ; if i post it , i won't be able to sell it..

Here's the method , it's simple , just shorting the bits.

000 = "0"
001 = "1"
010 = "10"
011 = "11"
100 = "100"
101 = "101"
110 = "110"
111 = "111"

( !~Edited~! )

Playing around ; i found a way to tell if it's , 1 , 2 or 3 bits.. to look for...

If it starts with a 0 , then it has to be a zero...
if it starts with a 1 , then it can be 1 of 7 values...
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Dec 05, 2019 1:27

I got to find a way to speed it up..

1,000,000 takes 130 seconds
5,000,000 takes 540 seconds 4x ( a normal song ( 3.5 to 4 minutes) *.mp3 ) 9 minutes is too long...

A movie file ( 4 gigabytes ) , would take a month to compress..

Before i work on the decompression , i need to speed the compressor up...
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Dec 05, 2019 1:51

I got the compressor doing 1,000,000 in 98 seconds.. ( shaved off 40 seconds )

5,000,000 takes 460 seconds ( instead of 540 ) ( shaved off 100 seconds )

Got to speed it up more....

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

What's the fastest way to get 6 bits??
Is there a faster way than mid() ??
Maybe strptr or zstring ptr ??

for a as longint = 1 to len( bits ) step 6
n1 = mid( bits , a , 6 )
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Yah-Zip ( 6 bit )

Postby albert » Dec 05, 2019 2:44

@Richard
@Dodicat
@StoneMonkey

I decided to go ahead and post the code... ( Make it freeware )

"Yah-Zip.bas"

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
        randomize
        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 a key for next compression." ; " loops = " ; loops ; " out of 100."
    print
    print "press esc to exit."
    'sleep
   
    if inkey = chr(27) then exit do
   
loop until loops = 100

time2 = timer

print "Compress time = " ; time2 - time1

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 "!!~~Done~~!!"

Sleep
end
'===============================================================================
'============================,===================================================
'begin functions
'===============================================================================
'================='==============================================================
Function compress_loop( chrs as string ) as string
   
    print "c inp = " ; len(chrs)
   
    dim as string bits = ""
    dim as string zeros = string( 8 , "0" )
    dim as string n1
    dim as ubyte ptr usp = cptr( ubyte ptr , strptr( chrs ) )
    for a as longint = 1 to len( chrs ) step 1
        n1 = zeros + bin( *usp ) : usp+= 1
        n1 = right( n1 , 8 )
        bits+= n1
    next
   
    print "c bin = " ; len(bits) ' , bits
   
    dim as string outs1 = ""
    dim as string vals
    dim as string bins
    dim as ubyte v1 , v2 , v3
    for a as longint = 1 to len( bits ) step 6
           
        n1 = mid( bits , a , 6 )
       
        v3 = val( "&B" + n1 )
        vals = "00" + oct( v3 )
        vals = right( vals , 2 )
       
        v1 = vals[ 0 ] - 48
        v2 = vals[ 1 ] - 48
       
        bins = "1"
        bins+= bin( v1 )
       
        bins+= "1"
        bins+= bin( v2 )
       
        v3 = val( "&B" + bins )
        outs1+= chr( v3 )
       
        'print vals , bins
        'sleep
        'if inkey = " " then end
       
    next
   
    print "c out = "; len(outs1) ' , outs1
   
    dim as string final = outs1
    'for a as longint = 1 to len( outs1 ) step 8
    '    final+= chr( val( "&B"+ mid( outs1 , a , 8 ) ) )
    'next

    print "c fin = "; len(final)
   
    return final
   
end function
'===============================================================================
'============================================================================
Function decompress_loop( chrs as string ) as string
   
    print "d inp = "; len(chrs)
   
    return chrs
   
end function



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

Code: Select all


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

screen 19
'=====================================================================
'=====================================================================
'start program
'=====================================================================
'=====================================================================
dim as double time1 , time2 , time3 , time4
do
   
    randomize
   
    dim as string s = ""
    For n As Long = 1 To 8
        s+=chr(Int(Rnd*256))
    Next
   
    time1=timer
    'begin compress
        dim as string comp = s
            'do
            '    dim as longint chk = len(comp) - 1
            '    comp = compress_loop(comp)
            '    if len(comp) >= chk then exit do
            '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
   
    'cls
    'draw string( 0,10) , left(s,100)
    'draw string( 0,30) , left(final_out,100)
    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)
   
    dim as string bits = ""
    dim as string zeros = string( 8 , "0" )
    dim as string n1
    dim as ubyte ptr usp = cptr( ubyte ptr , strptr( chrs ) )
    for a as longint = 1 to len( chrs ) step 1
        n1 = zeros + bin( *usp ) : usp+= 1
        n1 = right( n1 , 8 )
        bits+= n1
    next
   
    dim as ubyte count = 0
    dim as string str1
    dim as ubyte dec1
    do
        str1 = str( len( bits ) / 6 )
        dec1 = instr( 1 , str1 , "." )
        if dec1 <> 0  then bits+= "0" : count+=1
    loop until dec1 = 0
   
    print "c bin = " ; len(bits) , bits
   
    dim as string outs1 = ""
    dim as string vals
    dim as string bins
    dim as ubyte v1 , v2 , v3
    for a as longint = 1 to len( bits ) step 6
           
        n1 = mid( bits , a , 6 )
       
        v3 = val( "&B" + n1 )
        vals = "00" + oct( v3 )
        vals = right( vals , 2 )
       
        v1 = vals[ 0 ] - 48
        v2 = vals[ 1 ] - 48
       
        bins = "1"
        bins+= bin( v1 )
       
        bins+= "1"
        bins+= bin( v2 )
       
        v3 = val( "&B" + bins )
        outs1+= chr( v3 )
       
        'print vals , bins
        'sleep
        'if inkey = " " then end
       
    next
   
    print "c out = "; len(outs1) ' , outs1
   
    print "c out = " ,
    for a as longint = 1 to len( outs1 ) step 1
        n1 = bin( outs1[ a - 1 ] )
        print n1 ; " " ;
    next
    print
   
    dim as string final = outs1
    'for a as longint = 1 to len( outs1 ) step 8
    '    final+= chr( val( "&B"+ mid( outs1 , a , 8 ) ) )
    'next
   
    final = chr( count ) + final
   
    print
    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 count = asc( left( chrs , 1 ) )
    chrs = mid( chrs , 2 )
   
    dim as string bits = ""
    dim as string zeros = string( 8 , "0")
    dim as string n1
    dim as ubyte ptr usp = cptr( ubyte ptr , strptr( chrs ) )
    print "d out = " ,
    for a as longint = 1 to len( chrs ) step 1
        n1 = bin( *usp ) : usp+= 1
        bits+= n1
        print n1 ; " " ;
    next
   
    print
    print "d bin = "; len(bits) ', bits
   
    return chrs
   
end function



it does "1" + bin( 3 bits ) + "1" + bin( 3 bits ) = 4 to 8 bits

So:
00 = 1010
01 = 1011
02 = 10110 etc.....

Here's all the possible octal outputs , the vals output needs to be turned back into value = val( "&O" + vals )

Code: Select all


if bins = "1010" then vals = "00"
if bins = "1011" then vals = "01"
if bins = "10110" then vals = "02"
if bins = "10111" then vals = "03"
if bins = "101100" then vals = "04"
if bins = "101101" then vals = "05"
if bins = "101110" then vals = "06"
if bins = "101111" then vals = "07"
if bins = "1110" then vals = "10"
if bins = "1111" then vals = "11"
if bins = "11110" then vals = "12"
if bins = "11111" then vals = "13"
if bins = "111100" then vals = "14"
if bins = "111101" then vals = "15"
if bins = "111110" then vals = "16"
if bins = "111111" then vals = "17"
if bins = "11010" then vals = "20"
if bins = "11011" then vals = "21"
if bins = "110110" then vals = "22"
if bins = "110111" then vals = "23"
if bins = "1101100" then vals = "24"
if bins = "1101101" then vals = "25"
if bins = "1101110" then vals = "26"
if bins = "1101111" then vals = "27"
if bins = "11110" then vals = "30"
if bins = "11111" then vals = "31"
if bins = "111110" then vals = "32"
if bins = "111111" then vals = "33"
if bins = "1111100" then vals = "34"
if bins = "1111101" then vals = "35"
if bins = "1111110" then vals = "36"
if bins = "1111111" then vals = "37"
if bins = "110010" then vals = "40"
if bins = "110011" then vals = "41"
if bins = "1100110" then vals = "42"
if bins = "1100111" then vals = "43"
if bins = "11001100" then vals = "44"
if bins = "11001101" then vals = "45"
if bins = "11001110" then vals = "46"
if bins = "11001111" then vals = "47"
if bins = "110110" then vals = "50"
if bins = "110111" then vals = "51"
if bins = "1101110" then vals = "52"
if bins = "1101111" then vals = "53"
if bins = "11011100" then vals = "54"
if bins = "11011101" then vals = "55"
if bins = "11011110" then vals = "56"
if bins = "11011111" then vals = "57"
if bins = "111010" then vals = "60"
if bins = "111011" then vals = "61"
if bins = "1110110" then vals = "62"
if bins = "1110111" then vals = "63"
if bins = "11101100" then vals = "64"
if bins = "11101101" then vals = "65"
if bins = "11101110" then vals = "66"
if bins = "11101111" then vals = "67"
if bins = "111110" then vals = "70"
if bins = "111111" then vals = "71"
if bins = "1111110" then vals = "72"
if bins = "1111111" then vals = "73"
if bins = "11111100" then vals = "74"
if bins = "11111101" then vals = "75"
if bins = "11111110" then vals = "76"
if bins = "11111111" then vals = "77"



Here's the program to generate the outputs.

Code: Select all


screen 19

dim as string n1
dim as string vals
dim as string bins
dim as ubyte v1 , v2

open "Yah-Zip_Oct_Vals.bas" for output as #1

    for a as longint = 0 to 63 step 1
       
        n1 = right("000000" + bin( a ) , 6 )
       
        vals = right( "00" + oct( val( "&B" + n1 ) ) , 2 )
       
        v1 = val( left( vals , 1 ) )
        v2 = val( right( vals , 1 ) )
           
        bins = "1"
        bins+= bin( v1 )
       
        bins+= "1"
        bins+= bin( v2 )
       
        print #1 , "if bins = " ; chr(34) ; bins ; chr(34) ; " then vals = " ; chr(34) ; vals ; chr(34)
       
    next

close #1



( !!~~ I finally did it ~~!! )

The boy who cried WOLF finally saw a wolf...
Stonemonkey
Posts: 646
Joined: Jun 09, 2005 0:08

Re: Squares

Postby Stonemonkey » Dec 05, 2019 19:13

But was he able to bring all the sheep back?
albert
Posts: 5916
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Postby albert » Dec 05, 2019 23:31

@StoneMonkey

Disregard the above compressor....

There's duplicates.

"1" + bin( 3 ) + "1" + bin( 3 )

32 = 1-11-1-10
70 = 1-111-1-0

Both the same... and there's other duplicates...

Return to “General”

Who is online

Users browsing this forum: Bing [Bot] and 4 guests