Note: this is part of a series of posts is related to the “17×17 Challenge” posted by Bill Gasarch. The goal is to color cells of a 17 by 17 grid, using only four colors, such that no rectangle is formed from four cells of the same color.

This is something I’ve been wanting to play with for months now, but haven’t made the time to implement: I wondered if simulated annealing techniques could be effective in finding a complete grid covering.

We would simply start with four copies of the 74-color grid and swap their rows and columns around, within each color set, trying to cover all of the cells by the union of the four subsets. So all of the sets of cells of a single color are fundamentally simply different permutations of the same 74-cell rectangle-free Graph.

Here is an illustration of the concept. Our algorithm starts with all four colored sets of cell overlapping (the red cells are on top, covering the other three colors):

…then we swap two rows or two columns from a colored subset of cells, until the four colored subsets spread out covering as much of the grid as possible. Here we cover all but 21 cells:

A Brief Intro to Simulated Annealing

Simulated Annealing is a bit of an intimidating term (has its origins in metallurgy of all things), but the idea is simple: you start off with an initial solution (in my case, four sets of cells, all of which overlap) and then you mutate it randomly by choosing a random “neighbor” solution (in my case, a grid in which two rows or two columns of the same color are swapped).

You score these solutions so that you can compare a current solution with a proposed mutated solution, and here’s the key:

You begin by accepting nearly every mutation, whether it improves your solution or not. But as the procedure progresses you become more picky about “how much worse” a new solution can be from the previous one.

So in the classic Traveling Salesman Problem a neighbor solution would be a new route that goes from city C to city E, where in the last solution we went from city E to city C.

Threshold Acceptance

There are various ways of accomplishing the task of “ratcheting down” the computation over time. The traditional method (the method most matching the metallurgical metaphor, if you will) is to have a function that computes the probability of a proposed change being accepted. This probability function changes over time, such that as we progress it becomes more and more unlikely that a solution worse than the previous will be accepted.

Another method, and the one I chose to implement, seems to be referred to as Threshold Accepting; instead of having a probability function, you accept all mutations that are below a certain threshold of change from the previous solution. The threshold becomes more strict over time.

So in our case we might start off with a threshold of five, meaning that we will accept all changes that give us a worse solution of no more than 5 new un-colored cells. So for example: if swapping blue rows 5 and 12 create a new solution with 6 fewer colored (covered) cells from the previous solution (i.e. a worse solution by six), then it won’t be accepted by our meta-algorithm at this stage.

Notes on the implementation

The approach I tried to describe above was really attractive to me because it short-circuits the whole complex “rectangle-free” constraint entirely. We simply start with a known rectangle-free subset and see if we can make four copies fit together.

Also, because we swap two rows or columns at a time, we need only look at the local change of score produced by the swap and then add it to the global score to obtain the new global score.

The astronomical number (17!^2) of possible permutations of a single rectangle-free subset give me hope that this approach could work, but that is an open question as far as I know.

I wrote this first draft of the script in haskell (as usual), and was happy with how fast it is, thanks in large part to the vector library, which was a pleasure to work with. The code uses 4 pairs of Vectors (arrays of Ints), 8 in total, each of which represent a row or column ordering of one of the four colors.

We store the original 74-cell rectangle-free subset as a 2D Array (Int,Int) Bool. The pairs of Vectors act as references to row or column slices of this 2D array.

When we want to score a swap, we have to “render” all four colors of the pair of rows/columns in question using our 2D reference array. Then a swap consists of swapping two Ints in a single Vector. This is much more friendly on more poor laptop than if we were to try storing all four color subsets as 2D arrays and swapping them around!

You can download the code here, but mind it isn’t incredibly pretty.

Initial findings

The best I’ve done with this initial version is a grid with 19 empty cells:

It is obvious though that the heuristic needs a lot of tuning, and that in my case the “Threshold Accepting” approach isn’t working well. That is because it is far too granular: we get from complete disorder to a minimum in just a handful of threshold rounds.

Here is a quick graph overlaying two runs, one of which starts with a threshold (each threshold round bracketed in black) of 5, the other (in blue) starts with a threshold of 2. The Y-axis is the number of uncolored cells in the grid at the current solution:

You can see that both basically look like random Brownian walks during the course of a threshold round, and quickly drop to a lower energy level (better solution) as soon as the threshold is tightened. Most dramatic is the jump when we go from 2 to 1.

This looks like we’re being thrust into a local minima, which is the opposite of what we want here. But whether a more finely-tuned annealing schedule can do better is anyone’s guess.

What’s next?

It should be very simple to implement a more traditional annealing procedure that would ease us into lower “energy levels” without the harsh dives we get from using only a handful of threshold levels. So that is what is next on the agenda for this problem.

If this annealing business looks promising after I master the black art of “tuning the meta-heuristic”, it would be cool to come up with a single-coloring algorithm, capable of generating rectangle free colorings of 72,73, or 74 cells. We would then feed those solutions into our annealing framework, finding the best combinations of colorings via a genetic algorithm or the like.

But that leads to the question I’ve posed earlier: it is sometimes trivial to determine if two colorings are “unique” (i.e. by counting colored cells in rows and columns); but when it isn’t trivial, determining whether two colorings are “equivalent” seems to be a very difficult problem.

What a hole I’ve fallen into…

Design

I found that writing the core functionality of the interpreter took almost no time, once I settled on the approach I would take. I used a monad transformer for the first time, StateT:

type REPL a = StateT ProgramState IO a

This let me pass around the state of the computation in the State monad while doing IO actions. This made some potentially-awkward befunge commands really easy to implement.

Here is an excerpt from the function execute :: Char -> REPL () which reads the befunge character at our position and returns the code to execute:

         -- Pop value and output as an integer. funge-98 spec calls for
         -- integer to be followed by a space, so we'll do that too:
         '.' -> do i <- pop
                   liftIO $ putStr $ show i ++" "
        
         -- Pop value and output as ASCII character
         ',' -> do i <- pop
                   liftIO $ putChar $ chr i

         '\\' -> do (a,b) <- pop2
                    push a
                    push b
        
         ':' -> do a <- pop
                   replicateM_ 2 (push a)
        
    -- program flow commands: --
         ' ' -> return ()    

         '>' -> setDirection right
        
         '<' -> setDirection left  
      
         '^' -> setDirection up
      
         'v' -> setDirection down
        
         '?' -> getRandomDirection >>= setDirection 

And here is the program state that gets passed in the monad:

data ProgramState = 
    ES { -- state of the code and stack:
         code :: Code,    
         stack :: Stack,
         -- state of program flow:
         position :: Position, 
         direction :: Direction,
         haltBit :: Bool,
         -- random generator:
         randGen :: StdGen, 
         -- errors or other messages we collect:
         messages :: [String],
         -- should we announce messages and warnings?:
         verbose :: Bool
        } 

I only use the accessor functions (as opposed to pattern matching) to reach into the state in my code, so it was easy to add another state parameter if I wanted to extend the functionality somewhere.

Finally here is the evaluation loop that ties the core of the interpreter together:

evalLoop :: REPL ()
evalLoop = do
     -- extract the command at our position & execute it:
    getCmd >>= execute
     -- print messages in the queue (unless quiet), and clear it:
    printMessages
     -- halt if @ command issued, else move and recurse:
    halting <- gets haltBit
    unless halting (move >> evalLoop) 

I found the most time-consuming parts of this project were in the design decisions and behaviour tweaks related to holes in the ‘93 spec, and tracking down a few silly bugs that came from wrong assumptions about the spec.

Vital in debugging were the CCBI interpreter as well as the pyfunge interpreter. It’s difficult to debug an interpreter when you don’t whether the befunge code you are testing on is buggy or whether your interpreter is!

One last detail that I am proud of is the test suite that I have integrated into my darcs repo. Darcs automatically runs the befunge-93 portion of the amazing mycology test suite by Matti Niemenmaa on each commit, as well as two smaller test befunge programs from phlamethrower, testing that the interpreter hasn’t changed behavior.

Play With It

You can check out the full source for the program here, or get my whole darcs repository with:

$ darcs get --tag=v0.2 http://coder.bsimmons.name/code/Befunge

And here are a few nice programs to try out, written by folks cleverer than I, and stolen from vsync’s funge stuff here.

aturley.bf by Andrew Turley:

>84*>:#v_55+"ude.ub@yelruta">:#,_@>188*+>\02p\12p\:22p#v_$    55+,1-         v
    ^  0 v +1\                   _^#-+*<>22g02g*"_@"*-!1- #v_v>
       >:>::3g: ,\188                  ^^               -1\g21\g22

life.bf by Dmitry M Litvinov:

v>>31g> ::51gg:2v++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
9p BXY|-+98 *7^>+\-0|< + *                                                     *    +
*5 ^:+ 1pg15\,:< + *                                                     ***  +
10^  <>$25*,51g1v+                                                            +
-^ p< | -*46p15:+<+                                                            +
> 31^> 151p>92*4v+                                                            +
 ^_ ".",   ^ vp1< +                                                            +
>v >41p      >0 v+                                                            +
:5! vg-1g15-1g14< +                                                            +
+1-+>+41g1-51gg+v+                                                            +
1p-1vg+1g15-1g14< +                                                            +
g61g>+41g51g1-g+v+                                                            +
14*1v4+g+1g15g14< +                           * *                              +
5>^4>1g1+51g1-g+v+                           * *                              +
^ _^v4+gg15+1g14< +                           ***                              +
>v! >1g1+51g1+g+v+                                                            +
g8-v14/*25-*4*88< +                                                            +
19+>g51gg" "- v  +                                                            +
4*5  v< v-2:_3v+                                                            +
 >^   |!-3_$  v< -+                                                            +
^    < <      <|<+                                                         ***+
>g51gp ^ >51gp^>v+                                                            +
^14"+"< ^g14"!"<++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

prime.bf by Kalyna Zazelenchuk:

222p35*89+*11p>133p                   >33g1+33p   22g33g- v>22g33g%#v_v
 o                                                        >|
  2                             v,,,,, ,,,,,.g22"is prime."< 1                            >    v^                             < ^_@#-g11g22p22+1g22,*25<,,,,,,,,,,,,,.g22"is not prime."<

There is still a lot that could be done, but I think I’m done with it for now. Thanks for looking!

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.

The function listArray is similar except that it assumes that the list is already ordered by index so there is no need to provide tuples of (index, value). Becase listArray actually uses zip internally to produce the tupled list, so the programmer can pass a list to listArray which exceeds the declared bounds of the array and the function will quietly drop the extra list tail:

Prelude Data.Array> listArray (1,3) ['a','b','c',undefined]
array (1,3) [(1,'a'),(2,'b'),(3,'c')]

But when a list that exceeds the specified bound is passed to array, it dies a horrible death:

Prelude Data.Array> array (1,3) [(1,'a'),(2,'b'),(3,'c'),(4,'d')]
array *** Exception: Error in array index

I think the array function should be modified by adding a simple take to automatically drop any excess list elements:

array (l,u) ies
    = let n = safeRangeSize (l,u)
      in unsafeArray (l,u)
                     [(safeIndex (l,u) n i, e) | (i, e) <- take n ies]

This change would bring the function into better alignment with other prelude functions which expect infinite lists and drop tails as needed. It can be argued that the programmer might want to know that he is passing too long a list to his function, in which case I think the safeRangeSize function, etc. should be eliminated.

IMPLEMENTATION:

EXAMPLES AND CONCLUSION: