...now browsing by tag


Followup to my earlier post on Hilbert curve timeseries plots

Monday, August 24th, 2009

Note that the Hilbert code is not mine.  Rather it is from a Haskell Golf Challenge post in a pastebin and appropriated because I wanted a quick Hilbert curve without having to think through a hazy minded Friday evening.  Can’t find the original post now, actually.  That’ll teach me to bookmark things that are important.  Here’s the other person’s code.  If anyone can help me claim it, I will post your name as author.  Again, apologies in advance for that :-(.

h :: [Bool] -> ([Bool], [Bool])
h = l

go :: Bool -> Bool -> ([Bool], [Bool]) -> ([Bool], [Bool])
go x y (xs,ys) = (x:xs, y:ys)

l, r :: [Bool] -> ([Bool], [Bool])
l (False:False:ns) = go False False $ right (r ns)
l (False:True:ns) = go False True $ l ns
l (True:False:ns) = go True True $ l ns
l (True:True:ns) = go True False $ left (r ns)
l _ = ([], [])

r (False:False:ns) = go False True $ left (l ns)
r (False:True:ns) = go False False $ r ns
r (True:False:ns) = go True False $ r ns
r (True:True:ns) = go True True $ right (l ns)
r _ = ([], [])

left, right :: ([Bool], [Bool]) -> ([Bool], [Bool])
left (False:xs, False:ys) = go False True $ left (xs,ys)
left (False:xs, True:ys) = go True True $ left (xs,ys)
left (True:xs, False:ys) = go False False $ left (xs,ys)
left (True:xs, True:ys) = go True False $ left (xs,ys)
left _ = ([], [])

right (False:xs, True:ys) = go False False $ right (xs,ys)
right (True:xs, True:ys) = go False True $ right (xs,ys)
right (False:xs, False:ys) = go True False $ right (xs,ys)
right (True:xs, False:ys) = go True True $ right (xs,ys)
right _ = ([], [])

-- Infrastructure for testing:
bits :: Int -> Int -> [Bool]
bits n k = go n k [] where
  go 0 k = id
  go n k = go (n-1) (k `div` 2) . (odd k:)

num :: [Bool] -> Double
num (False:xs) = num xs / 2
num (True:xs) = (num xs + 1) / 2
num [] = 0

hilbert :: Int -> Int -> (Double, Double)
hilbert n k = (\(x,y) -> (num x, num y)) (h (bits n k))


Here begins my own code.  To use the Data.Colour.blend function, I need to normalize all the values.  Here is that function, which could be made considerably more efficient with a minimax instead of independently calling minimum and maximum, but again, the point here is illustration of a technique, not the most beautiful code.

normalize :: [Double] -> [Double]
normalize values = [(val-minval) / (maxval-minval) | val <- values]
    where minval = minimum values
          maxval = maximum values

Following that, we have a function and its helper for creating a hilbert plot of the data.  Note the use of the constant 64.  The Hilbert code above keeps everything within a unit vector of the origin, so we scale out for the resolution.  The resolution should properly be ceiling . log2 of the number of items in the list, which could be calculated efficiently, but it would clutter the code.

vis :: Int -> [Double] -> BaseVisual
vis n values = concat $ zipWith vis'
                [(64*x,64*y) | (x,y) <- (map (hilbert n) [0..2^n-1])]
                (normalize values)

Finally here is the visualization of a single point whose x,y vector is now the Hilbert point for its position in the timeseries.  We blend between two colors, blue for 0 and orange for 1. This could just as easily be a more complicated colourmap, but this is the code that generated the colormap from the previous post.

vis' :: (Double,Double) -> Double -> BaseVisual
vis' (x,y) val = fillcolour (blend val c0 c1)
               . filled True
               . outlined False
               $ arc{ center = Point x y, radius=0.5 }
    where c0 = opaque blue
          c1 = opaque orange

And finally the main program.  All we do here is take the filename from the arguments, read in the lines as Double values, and map those values to colored hilbert points using our vis function.

main = do
  name <- (!!0) <$> getArgs
  k <- map read . tail . words <$> readFile name
  let visualization = vis degree k
      degree = (ceiling $ log (realToFrac . length $ k) / log 2)
  renderToSVG (name ++ ".svg") 128 128 visualization