Squares

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

Re: Squares

Post by albert »

@angros47

I think i got it corrected...
Could you look over it to see if there's duplicates...

You seem to have a better mind than me at finding the duplicates...

Sorted to group the number of set bits..

all the 1 bits set start with 10
all the 3 bits set start with 11
al the 2 bits set start with 0

What values should i use for n1 = "0000" and n1 = "1111" ??? I think they might conflict with "011"

n1 = left( s1 , 4 )
if n1 = "0000" then n2 = "0110"
if n1 = "1111" then n2 = "0111"

if n1 = "0001" then n2 = "1000"
if n1 = "0010" then n2 = "1001"
if n1 = "0100" then n2 = "1010"
if n1 = "1000" then n2 = "1011"

if n1 = "0011" then n2 = "000"
if n1 = "0101" then n2 = "001"
if n1 = "0110" then n2 = "010"
if n1 = "1001" then n2 = "011"
if n1 = "1010" then n2 = "0100"
if n1 = "1100" then n2 = "0101"

if n1 = "0111" then n2 = "1100"
if n1 = "1011" then n2 = "1101"
if n1 = "1101" then n2 = "1110"
if n1 = "1110" then n2 = "1111"

For 100,000 bytes input
For the 2 bits set , 4 of them are 3 bits so ,it compresses 1 bit * 4 = 50,000 *4 = 200,000 bits compression.
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Post by albert »

Here's the Test-Bed , where i 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
            '    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 s1 , n1 , n2 , n3 , n4
    for a as longint = 1 to len( chrs ) step 1
        
        s1 = zeros + bin( chrs[ a - 1 ] )
        s1 = right( s1 , 8 )
        
        n1 = left( s1 , 4 )
        if n1 = "0000" then n2 = "0110"
        if n1 = "1111" then n2 = "0111"
        
        if n1 = "0001" then n2 = "1000"
        if n1 = "0010" then n2 = "1001"
        if n1 = "0100" then n2 = "1010"
        if n1 = "1000" then n2 = "1011"
        
        if n1 = "0011" then n2 = "000"
        if n1 = "0101" then n2 = "001"
        if n1 = "0110" then n2 = "010"
        if n1 = "1001" then n2 = "011"
        if n1 = "1010" then n2 = "0100"
        if n1 = "1100" then n2 = "0101"
        
        if n1 = "0111" then n2 = "1100"
        if n1 = "1011" then n2 = "1101"
        if n1 = "1101" then n2 = "1110"
        if n1 = "1110" then n2 = "1111"
        
        n3 = right( s1 , 4 )
        if n3 = "0000" then n4 = "0110"
        if n3 = "1111" then n4 = "0111"
        
        if n3 = "0001" then n4 = "1000"
        if n3 = "0010" then n4 = "1001"
        if n3 = "0100" then n4 = "1010"
        if n3 = "1000" then n4 = "1011"
        
        if n3 = "0011" then n4 = "000"
        if n3 = "0101" then n4 = "001"
        if n3 = "0110" then n4 = "010"
        if n3 = "1001" then n4 = "011"
        if n3 = "1010" then n4 = "0100"
        if n3 = "1100" then n4 = "0101"
        
        if n3 = "0111" then n4 = "1100"
        if n3 = "1011" then n4 = "1101"
        if n3 = "1101" then n4 = "1110"
        if n3 = "1110" then n4 = "1111"
        
        bits1+= n2
        bits2+= n4
        
        '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 = ""
    for a as longint = 1 to len( bits1 ) step 8
        final+= chr( val( "&B" + mid( bits1 , a , 8 ) ) )
    next
    final+= "END"
    for a as longint = 1 to len( bits2 ) step 8
        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

marcov
Posts: 3455
Joined: Jun 16, 2005 9:45
Location: Netherlands
Contact:

Re: Squares

Post by marcov »

Congratulations. That code made me cry.
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Post by albert »

If it starts with a "1" then your looking for 4 bits
If it starts with a "0" then your looking for 3 or 4 bits..
angros47
Posts: 2321
Joined: Jun 21, 2005 19:04

Re: Squares

Post by angros47 »

albert wrote:@angros47

Could you look over it to see if there's duplicates...

You seem to have a better mind than me at finding the duplicates...
I don't have a better mind. I just know for sure that duplicates are inevitable, for the reason I already told you


Code: Select all

        if n1 = "0000" then n2 = "0110"       <----
        if n1 = "1111" then n2 = "0111"          <------
        
        if n1 = "0001" then n2 = "1000"
        if n1 = "0010" then n2 = "1001"
        if n1 = "0100" then n2 = "1010"
        if n1 = "1000" then n2 = "1011"
        
        if n1 = "0011" then n2 = "000"
        if n1 = "0101" then n2 = "001"
        if n1 = "0110" then n2 = "010"      <-----   Duplicate of 0100  and 0101
        if n1 = "1001" then n2 = "011"      <-----   Duplicate of 0110  and 0111
        if n1 = "1010" then n2 = "0100"    <----- 
        if n1 = "1100" then n2 = "0101"    <-----
        
        if n1 = "0111" then n2 = "1100"
        if n1 = "1011" then n2 = "1101"
        if n1 = "1101" then n2 = "1110"
        if n1 = "1110" then n2 = "1111"
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Test-Bed

Post by albert »

I think i got it corrected...

n1 = left( s1 , 4 )
if n1 = "0000" then n2 = "0111"
if n1 = "1111" then n2 = "0011"

if n1 = "0001" then n2 = "1000"
if n1 = "0010" then n2 = "1001"
if n1 = "0100" then n2 = "1010"
if n1 = "1000" then n2 = "1011"

if n1 = "0011" then n2 = "000"
if n1 = "0101" then n2 = "001" <---- ?
if n1 = "0110" then n2 = "0010" <---- ? only 1 conflict... read ahead should solve it..
if n1 = "1001" then n2 = "0110"
if n1 = "1010" then n2 = "0100"
if n1 = "1100" then n2 = "0101"

if n1 = "0111" then n2 = "1100"
if n1 = "1011" then n2 = "1101"
if n1 = "1101" then n2 = "1110"
if n1 = "1110" then n2 = "1111"

Still compresses 90+% after 100 loops...

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
            '    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 s1 , n1 , n2 , n3 , n4
    for a as longint = 1 to len( chrs ) step 1
        
        s1 = zeros + bin( chrs[ a - 1 ] )
        s1 = right( s1 , 8 )
        
        n1 = left( s1 , 4 )
        if n1 = "0000" then n2 = "0111"
        if n1 = "1111" then n2 = "0011"
        
        if n1 = "0001" then n2 = "1000"
        if n1 = "0010" then n2 = "1001"
        if n1 = "0100" then n2 = "1010"
        if n1 = "1000" then n2 = "1011"
        
        if n1 = "0011" then n2 = "000"
        if n1 = "0101" then n2 = "001"
        if n1 = "0110" then n2 = "0010"
        if n1 = "1001" then n2 = "0110"
        if n1 = "1010" then n2 = "0100"
        if n1 = "1100" then n2 = "0101"
        
        if n1 = "0111" then n2 = "1100"
        if n1 = "1011" then n2 = "1101"
        if n1 = "1101" then n2 = "1110"
        if n1 = "1110" then n2 = "1111"
        
        n3 = right( s1 , 4 )
        if n3 = "0000" then n4 = "0111"
        if n3 = "1111" then n4 = "0011"
        
        if n3 = "0001" then n4 = "1000"
        if n3 = "0010" then n4 = "1001"
        if n3 = "0100" then n4 = "1010"
        if n3 = "1000" then n4 = "1011"
        
        if n3 = "0011" then n4 = "000"
        if n3 = "0101" then n4 = "001"
        if n3 = "0110" then n4 = "0010"
        if n3 = "1001" then n4 = "0110"
        if n3 = "1010" then n4 = "0100"
        if n3 = "1100" then n4 = "0101"
        
        if n3 = "0111" then n4 = "1100"
        if n3 = "1011" then n4 = "1101"
        if n3 = "1101" then n4 = "1110"
        if n3 = "1110" then n4 = "1111"
        
        if n3 = "0111" then n4 = "1100"
        if n3 = "1011" then n4 = "1101"
        if n3 = "1101" then n4 = "1110"
        if n3 = "1110" then n4 = "1111"
        
        bits1+= n2
        bits2+= n4
        
        '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 = ""
    for a as longint = 1 to len( bits1 ) step 8
        final+= chr( val( "&B" + mid( bits1 , a , 8 ) ) )
    next
    final+= "END"
    for a as longint = 1 to len( bits2 ) step 8
        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

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

Re: Squares

Post by angros47 »

Two conflicts, at least:

Code: Select all

if n1 = "0000" then n2 = "0111"
if n1 = "1111" then n2 = "0011"  <----

if n1 = "0001" then n2 = "1000"
if n1 = "0010" then n2 = "1001"
if n1 = "0100" then n2 = "1010"
if n1 = "1000" then n2 = "1011"

if n1 = "0011" then n2 = "000"
if n1 = "0101" then n2 = "001" <---- ?
if n1 = "0110" then n2 = "0010" <---- ? only 1 conflict... read ahead should solve it..
if n1 = "1001" then n2 = "0110"
if n1 = "1010" then n2 = "0100"
if n1 = "1100" then n2 = "0101"

if n1 = "0111" then n2 = "1100"
if n1 = "1011" then n2 = "1101"
if n1 = "1101" then n2 = "1110"
if n1 = "1110" then n2 = "1111"
badidea
Posts: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Squares

Post by badidea »

albert @ 07 Jan 2020, 18:04 (the time here):

0111 000 = 011 1000
0111 001 = 011 1001
0111 010 = 011 1010
0111 011 = 011 1011
010 1000 = 0101 000
010 1001 = 0101 001
010 1010 = 0101 010
010 1011 = 0101 011

Code: Select all

dim as string outStr(16-1) = {_
	"0110", "0111", "1000", "1001", _
	"1010", "1011",  "000",  "001", _
	"010",  "011",  "0100", "0101", _
	"1100", "1101", "1110", "1111" }

dim as string combinedStr(256-1)

dim as integer j = 0
for i1 as integer = 0 to 16-1
	for i2 as integer = 0 to 16-1
		combinedStr(j) = outStr(i1) & outStr(i2)
		j += 1
	next
next

dim as integer k1, k2, l1, l2
for j1 as integer = 0 to 256-1
	for j2 as integer = j1 to 256-1
		if j1 <> j2 then
			if combinedStr(j1) = combinedStr(j2) then
				k1 = j1 \ 16 : k2 = j1 mod 16
				l1 = j2 \ 16 : l2 = j2 mod 16
				color 10, 0 : print outStr(k1) & " ";
				color 11, 0 : print outStr(k2);
				color 15, 0 : print " = ";
				color 10, 0 : print outStr(l1) & " ";
				color 11, 0 : print outStr(l2) 
			end if
		end if
	next
next
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Post by albert »

@badidea

All the sets are 4 bits... So your looking for 4 bits..

The only exceptions are 000 and 001

For 100,000 in , there's 200,000 nibbles.. So that's 50,000 of each type of nibble..
( in random data there's almost and equal amount of each type of nibble. )

000 , compresses 1 bit , so for 100,000 bytes in , it compresses 50,000 bits..
001 , compresses 1 bit , so for 100,000 bytes in , it compresses 50,000 bits..

So the total compression is 100,000 bits or 12,500 bytes..

Just one set being 3 bits would compress 50,000 bits.
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Post by albert »

I've got a plan..

"000" = "0"
"001" = "1"

For 100,000 bytes in , there 200,000 nibbles... 50,000 of each type.. ( 0000 to 1111 )

Making the "000" a single "0" is three bits of compression = 150,000 bits compressed
Making the "001" a single "1" is three bits of compression = 150,000 bits compressed

Creating a binary string of where the "0"'s and "1"'s are located would take 200,000 bits.
All zeros and a "1" where the value is "0" or "1"

Total compression = 300,000 bits - ( 200,000 bits , binary pointer string ) = 100,000 bits of total compression = 12,500 bytes..

It's almost " 3:00 Beer Time " , So I'll work on it later..
Everyday at 2:40 , i walk to the market to get a 40 oz. of beer. it takes 15-20 minutes to make the trip...
Today is spirit beer day... Every other day i put fresh beer on my alter for the spirits...
dodicat
Posts: 7976
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Squares

Post by dodicat »

Lucky you can do that beer thing Albert.
I live in a village which now has no shop, no pub, no post office, no village hall, and the only telephone box was removed three weeks ago.
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Post by albert »

My plan didn't work... 100,000 in , outputs 115,700
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Post by albert »

n1 = left( s1 , 4 )
if n1 = "0000" then n2 = "0111"
if n1 = "1111" then n2 = "0011"

if n1 = "0001" then n2 = "1000"
if n1 = "0010" then n2 = "1001"
if n1 = "0100" then n2 = "1010"
if n1 = "1000" then n2 = "1011"

if n1 = "0011" then n2 = "000"
if n1 = "0101" then n2 = "001"
if n1 = "0110" then n2 = "0010"
if n1 = "1001" then n2 = "0110"
if n1 = "1010" then n2 = "0100"
if n1 = "1100" then n2 = "0101"

if n1 = "0111" then n2 = "1100"
if n1 = "1011" then n2 = "1101"
if n1 = "1101" then n2 = "1110"
if n1 = "1110" then n2 = "1111"

If it starts with a 11 then it's 4 bits
if it starts with a 10 then it's 4 bits
if it starts with a 01 then it's 4 bits
if it starts with a 00 then it's 3 bits or 4 bits , it has to be a 0011 , 000 , 001 or 0010

Just need to write the scanner to pick out the values... I need some professional help to accomplish it....
badidea
Posts: 2586
Joined: May 24, 2007 22:10
Location: The Netherlands

Re: Squares

Post by badidea »

Won't work, not even the gods can solve that.
0011 000 = 001 1000
0011 001 = 001 1001

Code: Select all

dim as string outStr(16-1) = {_
	"0111", "0011", "1000", "1001", _
	"1010", "1011",  "000",  "001", _
	"0010", "0110", "0100", "0101", _
	"1100", "1101", "1110", "1111" }

dim as string combinedStr(256-1)

dim as integer j = 0
for i1 as integer = 0 to 16-1
	for i2 as integer = 0 to 16-1
		combinedStr(j) = outStr(i1) & outStr(i2)
		j += 1
	next
next

dim as integer k1, k2, l1, l2
for j1 as integer = 0 to 256-1
	for j2 as integer = j1 to 256-1
		if j1 <> j2 then
			if combinedStr(j1) = combinedStr(j2) then
				k1 = j1 \ 16 : k2 = j1 mod 16
				l1 = j2 \ 16 : l2 = j2 mod 16
				color 10, 0 : print outStr(k1) & " ";
				color 11, 0 : print outStr(k2);
				color 15, 0 : print " = ";
				color 10, 0 : print outStr(l1) & " ";
				color 11, 0 : print outStr(l2) 
			end if
		end if
	next
next
albert
Posts: 6000
Joined: Sep 28, 2006 2:41
Location: California, USA

Re: Squares

Post by albert »

@badidea

What would you suggest???

It compresses with out Dodicats Zlib code....

Compresses just about all values to under 300 bytes ( 240 to 260 ).. 10,000,000 takes like 10 minutes..
Maybe i should call it 300 zip...

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 100000
        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 s1 , n1 , n2 , n3 , n4
    for a as longint = 1 to len( chrs ) step 1
        
        s1 = zeros + bin( chrs[ a - 1 ] )
        s1 = right( s1 , 8 )
        
        n1 = left( s1 , 4 )
        if n1 = "0000" then n2 = "0111"
        if n1 = "1111" then n2 = "0011"
        
        if n1 = "0001" then n2 = "1000"
        if n1 = "0010" then n2 = "1001"
        if n1 = "0100" then n2 = "1010"
        if n1 = "1000" then n2 = "1011"
        
        if n1 = "0011" then n2 = "000"
        if n1 = "0101" then n2 = "001"
        if n1 = "0110" then n2 = "0010"
        if n1 = "1001" then n2 = "0110"
        if n1 = "1010" then n2 = "0100"
        if n1 = "1100" then n2 = "0101"
        
        if n1 = "0111" then n2 = "1100"
        if n1 = "1011" then n2 = "1101"
        if n1 = "1101" then n2 = "1110"
        if n1 = "1110" then n2 = "1111"
        
        n3 = right( s1 , 4 )
        if n3 = "0000" then n4 = "0111"
        if n3 = "1111" then n4 = "0011"
        
        if n3 = "0001" then n4 = "1000"
        if n3 = "0010" then n4 = "1001"
        if n3 = "0100" then n4 = "1010"
        if n3 = "1000" then n4 = "1011"
        
        if n3 = "0011" then n4 = "000"
        if n3 = "0101" then n4 = "001"
        if n3 = "0110" then n4 = "0010"
        if n3 = "1001" then n4 = "0110"
        if n3 = "1010" then n4 = "0100"
        if n3 = "1100" then n4 = "0101"
        
        if n3 = "0111" then n4 = "1100"
        if n3 = "1011" then n4 = "1101"
        if n3 = "1101" then n4 = "1110"
        if n3 = "1110" then n4 = "1111"
        
        if n3 = "0111" then n4 = "1100"
        if n3 = "1011" then n4 = "1101"
        if n3 = "1101" then n4 = "1110"
        if n3 = "1110" then n4 = "1111"
        
        bits1+= n2
        bits2+= n4
        
        '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 = ""
    for a as longint = 1 to len( bits1 ) step 8
        final+= chr( val( "&B" + mid( bits1 , a , 8 ) ) )
    next
    final+= "END"
    for a as longint = 1 to len( bits2 ) step 8
        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

Locked