I came up with this variation of the Move-to-Front transform which doesn’t require that there be a known alphabet of symbols. Instead it builds up the alphabet as it goes along and encounters a new symbol. I’m sure that this is a known algorithm, as it’s a fairly obvious variation, but I don’t know what the proper name for it is, so I’m calling it an Adaptive Move-to-Front.

I’m very interested in hearing if this is similar or identical to any other algorithms, so if anyone has any insights, please comment!

Differences from the Standard MTF Transform:

The traditional MTF algorithm, as I understand it, uses some known ordered alphabet of symbols (e.g. the bytes from 0-255, or the letters a-z), so presumably, one need not store this alphabet along with the encoded/compressed data.

With the algorithm I describe here though, the final permutation of the alphabet list, output by the encoder, must be retained to decode the message. The encoded message is identical to the output of the traditional MTF transform, except where a symbol is encoded which has not appeared previously.

Here we have zipped the output of the standard MTF (the fst) with the adaptive version (the snd) to make it easy to compare elements:

Message: “the rrrrain in sssspain falls maaiinly on the plain”

Output (standard MTF, adaptive):

[(116,0),(105,1),(103,2),(35,3),(115,4),(0,0),(0,0),(0,0),(101,5),(107,6),(112,7),(4,4),(2,2),(2,2),(2,2),(116,8),(0,0),(0,0),(0,0),(115,9),(5,5),(5,5),(5,5),(5,5),(109,10),(4,4),(113,11),(0,0),(7,7),(4,4),(114,12),(4,4),(0,0),(7,7),(0,0),(7,7),(6,6),(121,13),(6,6),(116,14),(4,4),(2,2),(14,14),(14,14),(14,14),(3,3),(13,13),(8,8),(10,10),(10,10),(8,8)]

The standard algorithm was working with the ASCII alphabet, so each new symbol is located somewhere far back into the alphabet; it is then moved to the front. In the adaptive version, when we see a new symbol, it is automatically made the next in our running alphabet and then of course moved to the front.

This means that with the adaptive version, for any given stretch from the beginning of the encoded message, we are using the minimal number of different index integers to encode the stream, always choosing the next greatest integer when we require a new one. Here is the output of the adaptive version alone:

Encoded phrase:

[0,1,2,3,4,0,0,0,5,6,7,4,2,2,2,8,0,0,0,9,5,5,5,5,10,4,
11,0,7,4,12,4,0,7,0,7,6,13,6,14,4,2,14,14,14,3,13,8,
10,10,8]

Final permutation of minimal dictionary list:
"nialp ehtoymsfr"

What these means for actual compression schemes on a binary level, I have no idea, but I would like to explore this topic much more. Without further ado, here is some code.

The Encoder:

This “adaptive move-to-front” encoder works in the same way as the standard algorithm, except that we start out with an empty alphabet list and build it up as we see new elements not yet in our list.

Essentially if, while searching for an element, we hit the empty list [], we pretend that the element we were looking for was at the end of the list.

This is exactly what happens in the traditional algorithm: when we try to encode a symbol that we haven’t yet encountered, we venture into a new part of the alphabet list that we haven’t touched yet.

The Decoder

Our decoder requires that we pass it the final permutation of the symbol list, along with the encoded list of indexes. It then simply does the reverse of the encoding function.

To decode we follow these steps:

1. Return the head of the list of symbols
2. Re-insert the symbol into the index location specified by the head of the encoded/index list
3. Move on to the next encoded index, using the new list of symbols. go to (1)

The idea behind the Move-to-Front algorithm is that we start with some known alphabet (like the list of ASCII characters), and encode our data elements as the index into that alphabet list of each element. The trick is that after each character is encoded, the alphabet list is modified by moving the element whose index we just looked up to the front of the alphabet.

Here are my implementations of encode and decode:

import Data.List


mtf :: (Eq a, Bounded a, Enum a)=> [a] -> Maybe [Int]
mtf = sequence . snd . mapAccumL enc [ minBound.. ]
    where enc l x = (x:delete x l, elemIndex x l)


mtfD :: (Eq a, Bounded a, Enum a)=> [Int] -> [a]
mtfD = snd . mapAccumL dec [ minBound.. ]
    where dec l i = let x = l !! i 
                     in (x:delete x l, x)

The mapAccumL function is perfect for passing the state of the dictionary list. Another point of interest to mention is the use of minBound to let the function be polymorphic over any type for which there is a defined order and lowest element.

For example, we can do this:

*Main> mtf “SIX.MIXED.PIXIES.SIFT.SIXTY.PIXIE.DUST.BOXES” >>= return . mtfDec :: Maybe String
Just “SIX.MIXED.PIXIES.SIFT.SIXTY.PIXIE.DUST.BOXES”

or we can decode to Word8 bytes, if we want to get back the ASCII character in that form, just by specifying a different return type:

*Main> :m + Data.Word
*Main Data.Word> mtf “SIX.MIXED.PIXIES.SIFT.SIXTY.PIXIE.DUST.BOXES” >>= return . mtfDec :: Maybe [Word8]
Just [83,73,88,46,77,73,88,69,68,46,80,73,88,73,69,83, 46,83,73,70,84,46,83,73,88,84,89,46,80,73,88,73,69,46, 68,85,83,84,46,66,79,88,69,83]

Let me know your thoughts!

I was looking through an old post on StackOverflow about clever functional code, and the best answer, given by “yairchu” was a nice version of the Burrows-Wheeler Transform, which is an algorithm for permuting a string such that it can be compressed more effectively by other algorithms. The code posted was (import Data.List assumed):

bwp :: (Ord a)=> [a] -> [a]
bwp xs = map snd $ sort $ zip (rots xs) (rrot xs)
rots xs = take (length xs) (iterate lrot xs)
lrot xs = tail xs ++ [head xs]
rrot xs = last xs : init xs

I saw I could improve/shorten this in a couple of obvious ways and came up with this:

bwp :: (Ord a) => [a] -> [a]
bwp = map snd . sort . rots 
rots xs = zip (tail $ iterate lrot xs) xs
lrot (x:xs) = xs ++ [x]

Still unsatisfied and even more obsessed I came up with this final, prettiest version, before forcing myself to give it up already:

bwp :: (Ord a)=> [a] -> [a]
bwp = map snd . sort . rots 
rots xs =  zip (lrot xs) xs
lrot = tail . tails . cycle

Unfortunately, this last version will croak if your string happens to look like “111111″ or “cAbcAb” because sort will keep trying to compare infinites lists.

Update: I did a short post on the Move To Front transform as a follow-up to this post.

A De Bruijn sequence is (for example) a cyclical list of characters such that every word of a given length appears once and only once in the sequence. Instead of using letters, you can have a De Bruijn sequence of bits. For example here is one possibility for a sequence in which every 3-bit word appears somewhere (you have to wrap around from the end for the final “words”):

00011101

In a sense we compress a dictionary of 2^3 = 8 3-bit words (or 24 bits) to a sequence of only 2^3 = 8 bits. There are some very simple algorithms for generating these kinds of sequences of bits, and I will implement two here: the “prefer one” algorithm and a subtle variation called “prefer opposite[PDF] by Alhakim“. Here is the author’s excellent description of the traditional Prefer One algorithm from the linked paper:

” The prefer-one algorithm is a very simple method amazingly capable of generating a full cycle. For any positive integer n ≥ 1, the algorithm puts n zeroes, and proceeds after this by proposing 1 for the next bit and accepting it when the word formed by the last n bits has not been encountered previously in the sequence, otherwise 0 is placed. The algorithm stops when both 0 and 1 do not bring a new word.”

And here is my haskell implementation. It works by creating a lazy array which we build from a list being generated by searching the earlier portions of the array that already have been defined. It’s very similar to the method I used in modeling the LZ77 algorithm.:

module Main
    where

import Data.Array
import Data.List(isInfixOf)


type Bit = Bool

preferOne :: Int -> [ Bit ]
preferOne n = 
    let upB = 2^n
        arr =  listArray (1, upB) (replicate n False ++ rest)
        
        -- since we use Bool for bits, we can say (not.alreadySeen):
        rest  =  map (not . alreadySeen) [n+1 .. upB]

        alreadySeen i = or $
              do let range = [ arr!i' | i' <- [i-n+1 .. i-1]] ++ [True] 
            
                 i1 <- [1..i-n] 
                 let rangeP = [ arr!i' | i' <- [i1 .. i1+n-1] ]
            
                 return (range == rangeP)

       -- an infinite stream is returned... because I can:          
    in cycle (elems arr)

The Prefer Opposite algorithm works on the same principle, but with a couple twists. In my words it is as follows:

Start with n zeros. Search for successive bits as follows:

propose to place the bit that is different from the previous bit: if the word formed by this bit has not been seen already, then choose it, else choose the same bit as the last. When 2^3-1 bit have been written, write a 1 for the final bit. and you’re done. (you can also keep track of how long a string of ones has been written; the sequence will always end with n ones)

Here is my implementation:

preferOpposite :: Int -> [ Bit ]
preferOpposite n = 
    let upB = 2^n
        arr =  array (1, upB) (final : inits ++ rest)
        
        -- we must specify the very last element of the sequence
        -- which will always be a One:
        final = (upB,True)
        inits = [ (i,False) | i<-[1..n] ]
        rest  =  map seqBit [n+1 .. upB-1]
        
        -- if the word generated by making the current bit the opposite
        -- of the previous has already been seen, we make the bit the
        -- same as the previous:
        seqBit i =  (i, nextB)
            where bP = arr!(i-1)  --previous bit
                  nextB | or (alreadySeen i bP) = bP --same as previous
                        | otherwise         = not bP --choose opposite

        --checks if the n-length string we would form by choosing the
        --opposite for the next bit is already present in the array:
        alreadySeen i bP = do
             let range = [ arr!i' | i' <- [i-n+1 .. i-1]] ++ [not bP] 
            
             i1 <- [1..i-n] 
             let rangeP = [ arr!i' | i' <- [i1 .. i1+n-1] ]
            
             return (range == rangeP)
                
    in cycle (elems arr)

Enough code for now, let’s talk about applications of the sequence. The most easily-approachable and interesting application to me applies to those keyed entry systems, such as electronic door locks, which accept a stream of keys (i.e. they unlock as soon as the correct key sequence is input, without any need to press an “enter” key). These mechanisms are very susceptible to attack with a De Bruijn sequence of key presses.

Since the above algorithms use a binary alphabet, as opposed to say a decimal one found on electronic keypads (check out Jonas Elfström’s blog post dealing with keypads with worn out letters for more on that), I will choose as my target an old-fashined garage door opener.

An old-style garage door opener remote has 8 binary DIP switches allowing 256 different code combinations. We will imagine the garage door is susceptible to a stream-based attack like the electronic lock we described.

We can model the garage door receiver as follows:

type Combo = [ Bit ]
type Receiver = Combo -> Bool

-- True means access granted
programReceiver :: Combo -> Receiver
programReceiver = isInfixOf 
          

Now let’s test out our model with this main function:

main =  let secretCode = [False,False,True,False,True,False,True,True]
            receiver = programReceiver secretCode
            crackingStream = preferOne 8

         in if receiver crackingStream
            then print "WE'RE IN!"
            else print "...bugs"

Looks good!:

*Main> :main
“WE’RE IN!”

In the next couple posts I’ll explore improvements to the performance of these algorithms and maybe a few other things.

IMPLEMENTATION:

EXAMPLES AND CONCLUSION: