A Strange Machine

by Mithrandir

Another Haskell puzzle. This time, we have a 2D square matrix. Each cell can contain a number. We have a cursor which always resides in one cell of the matrix. Let s be the sum of values contained in the 8 neighbouring cells and the cursor’s cell. At each update step, we will modify the cell under cursor by using a bijective function of s. After this, we change the cursor location by moving it to a neighbouring cell or leaving it as it is, depending on the value of its cell.

We have to simulate such a machine, assuming that the matrix wraps at the boundary.

We will start our solution from the Network module that we developed a few days ago. We will also import the getArgs function because our code will read the number of iterations from the command line.

import Network
import System.Environment(getArgs)

Now, we can define our Machine data type. Our machine consists of a network of cells, accessed via a pair of integer coordinates, containing any kind of value. We also need two functions: one for updating the cell and one for moving the pointer. We must remember our pointer position and the size of our matrix for boundary checks.

data MM a = MM {
  network :: Network (Int, Int) a
  , f :: a -> a                   -- next cell value
  , g :: (Int, Int) -> (Int, Int) -- next pointer
  , pos :: (Int, Int)             -- initial pointer
  , size :: Int                   -- matrix size - used for printing
  }

Now, we need a function to actually build our machine. We will need it to take 3 functions as arguments: one function for seeding the initial values in the matrix and the two functions needed for the update. Also, it should receive the size of the matrix. By following the types and their semantics, we can write the following code:

buildM :: Int -> ((Int, Int) -> Int) -> (Int -> Int) ->
  (Int -> (Int, Int)) -> (Int, Int) -> MM Int
buildM size initial f g start = MM network f ng start size
  where
    network = Network initial buildNeigh
    buildNeigh p = map (\(x,y)->(x`mod`size, y`mod`size)) $ list p
    list (x, y) = [(x, y-1), (x, y+1), (x-1, y-1), (x-1, y), (x-1, y+1),
      (x+1, y-1), (x+1, y), (x+1, y+1)]
    ng p = (a, b)
      where
        delta = g $ network `valueAt` p
        b = (snd delta + snd p) `mod` size
        a = (fst delta + fst p + v) `mod` size
        v = if (snd delta + snd p) >= size then 1 else 0

And we can easily test it by building our first machine.

test = buildM 10 (\_->0) (\x-> (x+2) `mod` 256) (\_->(0,1)) (0,0)

We have a machine, we need to update it. The update process means to update one cell and one pointer, thus, it can be easily written as:

updateM :: (Num a) => MM a -> MM a
updateM m@(MM n f g p s) = m { network = update n (p, v), pos = g p }
  where
    v = f $ sum $ map (n `valueAt`) $ p:(n `neighboursOf` p)

Of course, we cannot be sure we have obtained something until we can print it. What follows now is just a bunch of utility functions, not all of them used in this demo, for printing some information about the state of our machine.

evalMAt :: MM a -> (Int, Int) -> a
evalMAt m p = (network m) `valueAt` p
 
evalM :: MM a -> a
evalM m = m `evalMAt` (pos m)
 
getPointer :: MM a -> (Int, Int)
getPointer m = pos m

Now, we really want to test our implementation outside of ghci. For this, we will implement a print-like function: we want to print one row of the matrix on a single line and the following on the following. First, we need to get some lists – in fact, we will build a list of list, each inner list being the coordinates of one line of the matrix.

constructPairs :: Int -> [[(Int, Int)]]
constructPairs size = [map ((,) x) [0..(size-1)] | x <- [0..(size-1)]]

Now, the printing is easy. I’ve used print as I was advised a few posts ago.

printM m = mapM_ printrow ps
  where
    ps = constructPairs (size m)
    cp = pos m
    n = network m
    printrow r = print $ map printcell r
    printcell c
      | c == cp = " *" ++ (show $ n `valueAt` c) ++ "* "
      | otherwise = "  " ++ (show $ n `valueAt` c) ++ "  "

We need a main function.

result n = printM $ last $ take n $ iterate updateM test
 
main = do
  args <- getArgs
  let n = read $ head args
  result n

Outside of the vi editor, we type:

$ ghc --make Machine.hs
[1 of 2] Compiling Network ( Network.hs, Network.o )
[2 of 2] Compiling Main ( Machine.hs, Machine.o )
Linking Machine ...

And we are ready to test a few examples:

$ ./Machine 100
[" 2 "," 4 "," 6 "," 8 "," 10 "," 12 "," 14 "," 16 "," 18 "," 22 "]
[" 30 "," 44 "," 64 "," 90 "," 122 "," 160 "," 204 "," 254 "," 56 "," 130 "]
[" 206 "," 90 "," 34 "," 56 "," 174 "," 150 "," 2 "," 6 "," 192 "," 104 "]
[" 146 "," 222 "," 148 "," 158 "," 28 "," 100 "," 4 "," 206 "," 254 "," 136 "]
[" 250 "," 0 "," 18 "," 98 "," 130 "," 8 "," 64 "," 18 "," 104 "," 124 "]
[" 120 "," 134 "," 252 "," 244 "," 226 "," 174 "," 10 "," 198 "," 190 "," 22 "]
[" 22 "," 18 "," 138 "," 94 "," 228 "," 128 "," 0 "," 144 "," 44 "," 144 "]
[" 186 "," 110 "," 106 "," 56 "," 252 "," 98 "," 116 "," 50 "," 128 "," 14 "]
[" 56 "," 204 "," 222 "," 126 "," 22 "," 234 "," 244 "," 28 "," 222 "," 96 "]
[" 130 "," 114 "," 174 "," 58 "," 216 "," 242 "," 24 "," 56 "," 204 "," *0* "]
$ ./Machine 150
[" 206 "," 6 "," 54 "," 30 "," 174 "," 146 "," 94 "," 160 "," 118 "," 114 "]
[" 164 "," 102 "," 16 "," 240 "," 230 "," 56 "," 50 "," 166 "," 24 "," 236 "]
[" 128 "," 28 "," 238 "," 10 "," 124 "," 234 "," 58 "," 194 "," 234 "," 148 "]
[" 160 "," 170 "," 102 "," 140 "," 106 "," 62 "," 82 "," 192 "," 126 "," 132 "]
[" 90 "," 24 "," 160 "," 180 "," 248 "," 214 "," 248 "," 146 "," 212 "," *124* "]
[" 120 "," 134 "," 252 "," 244 "," 226 "," 174 "," 10 "," 198 "," 190 "," 22 "]
[" 22 "," 18 "," 138 "," 94 "," 228 "," 128 "," 0 "," 144 "," 44 "," 144 "]
[" 186 "," 110 "," 106 "," 56 "," 252 "," 98 "," 116 "," 50 "," 128 "," 14 "]
[" 56 "," 204 "," 222 "," 126 "," 22 "," 234 "," 244 "," 28 "," 222 "," 96 "]
[" 130 "," 114 "," 174 "," 58 "," 216 "," 242 "," 24 "," 56 "," 204 "," 240 "]
$ ./Machine 1000
[" 140 "," 34 "," 174 "," 198 "," 106 "," 60 "," 168 "," 200 "," 188 "," 182 "]
[" 142 "," 74 "," 236 "," 10 "," 24 "," 94 "," 168 "," 102 "," 44 "," 4 "]
[" 166 "," 66 "," 38 "," 40 "," 188 "," 78 "," 106 "," 50 "," 120 "," 206 "]
[" 0 "," 152 "," 214 "," 130 "," 158 "," 226 "," 54 "," 160 "," 104 "," 118 "]
[" 34 "," 116 "," 10 "," 122 "," 170 "," 30 "," 64 "," 228 "," 234 "," 110 "]
[" 100 "," 210 "," 100 "," 12 "," 2 "," 186 "," 26 "," 200 "," 38 "," 154 "]
[" 172 "," 44 "," 148 "," 20 "," 188 "," 54 "," 36 "," 106 "," 254 "," 92 "]
[" 30 "," 28 "," 14 "," 72 "," 166 "," 150 "," 96 "," 154 "," 44 "," 106 "]
[" 120 "," 108 "," 10 "," 238 "," 174 "," 106 "," 140 "," 194 "," 192 "," 60 "]
[" 172 "," 154 "," 70 "," 202 "," 128 "," 58 "," 204 "," 52 "," 156 "," *86* "]

Seing that things are working as expected, we turn our attention to the time complexity of our program. By plotting the results we obtain the following picture, which really tells us that we are nearly an O(n) algorithm (in fact, the plot is O(n^1.1) as was empirically deducted).

I guess that the non-linearity is because of the network module’s implementation. But I don’t have time now for this. I’ll come back to this machine shortly.

About these ads