Monday, April 29, 2013

Dissecting Squares

I know I posted earlier, but this has to come out of my head. And I don't think I'll have time to do much more writing this week, despite the fact that there are at least three other things on my mind that I need to idea peel.

So...

That's what I'm thinking.

And here's an attempt at forcing this primitive tool called "English" to explain what it means in my head.

First off, this is what I was thinking previously. Which is to say, not much in particular; just working my way up to meaningfully tearing into the problem. The basic problem is that there are lots of ways to dissect a square into smaller, integer-sized squares, and brute-forcing it isn't going to be viable for very high ns. In fact, from what I've observed, it took multiple days of compute time to solve for 16, and that's not encouraging.

Thing is, there are lots of little ways to cut out a lot of the brute-force work required for the calculation. An approach that starts from the universe of possibilities and filters isn't going to get very far, but we can constrain that universe pretty significantly if we pick our model carefully, and I think I have.

Characteristics of the Optimal Dissection Model

Cut at the base

A huge contribution to the final tally of work is going to be figuring out where 1x1 squares can fit. If you look at each of them as a Placement, you'll be overwhelmed pretty quickly. An easy way out of that is picking a model that lets you ignore 1x1 squares, and the easiest obvious way to do that is using a sparse array with the understanding that any unrecorded placements actually represent 1x1 squares. This lets you ignore a bunch of StartingPoints too (more on that in a moment).

Take symmetry into account

A second huge contribution to the bottom line of work for this problem is that you need to recompute a lot of dissections which you must then de-duplicate later. I don't think we can lick this one entirely; we'll still need to do Set insertions at some point in the process just to make sure we're not counting anything twice. But. We can cut out a lot of them. Specifically, since the problem already mentions rotations and reflections, we don't need to Place any squares that we know will be picked up by some other permutations' reflections or rotations. That can greatly reduce the number potential starting nodes these placement trees. It also means we'll want a representation where rotate and reflect are really, really fast operations. The sparse array approach seems to be better than using an explicit grid, but I'm not quite convinced it's optimal.

Bring it all together

So what we've got as a 10000-foot-view for the process is this:

  1. find all StartingPoints
  2. unfold each starting point, starting with squares of size nxn and working your way down to 2x2
  3. record the null dissection (a grid full of 1x1 squares)
  4. return the size of the set of recorded dissections
  • A StartingPoint is any point on our grid from '(0 0) to `(,(limit n) ,(limit n)).
  • The limit of n is (- (ceiling (/ n 2)) 1)
  • To unfold a StartingPoint, insert the solitary placement as a dissection (remember, any empty spaces are treated as "placed 1x1 squares"), then find all free SecondPoints and unfold them.
  • A SecondPoint is any free StartingPoint, or any point between `(,(limit n) ,y) and `(,(- n 2) ,y). Again, any others should be represented among reflections/rotateions of other dissections.
  • To unfold a SecondPoint, insert it as a dissection, then unfold all remaining free points on the grid (there's probably a way to cut this step down, but I can't see it yet).
  • To unfold any other point, insert it as a dissection, and unfold all remaining free points until there's no more room.
  • To insert a dissection, perform Set insertion on each of its rotateions and reflections into the set of all insertions for this particular grid.
  • A free point is one where there's enough room to put a square larger than 1x1 (this implies that place could probably remove some additional squares from the potential starting pool to make calculating this easier).

Granted, that's easier said than done. I get the feeling that when I actually go to implement this fully, a whole bunch of problems are going to crop up, but at least I have a half-way decent starting point.

Briefly, Laziness

I've gotten some questions about what, exactly, laziness is good for, so I'll want to touch on it. Briefly.

Short answer: it saves you space and time.

Space

Really, this should be obvious, but if we're going through this, lets do it properly. Here are some lists

(defparameter foo (list 1 2 3 4 5 6 7 8 9))
foo = [1, 2, 3, 4, 5, 6, 7, 8, 9] ## This one's from Python
foo = [1, 2, 3, 4, 5, 6, 7, 8, 9] -- This one's from Haskell
foo = [1, 2, 3, 4, 5, 6, 7, 8, 9] // This one's from Javascript

and here's some lazy lists

(defun lazy-numbers (&optional (starting-with 1))
  (cons starting-with (lambda () (lazy-numbers (+ starting-with 1)))))

(defparameter foo (lazy-numbers))
def lazyNumbers(startingWith=1):
    i = startingWith
    while True:
        yield i
        i += 1

foo = lazyNumbers()
foo = [1..]
function lazyNumbers (startingWith) {
    if (startingWith === undefined) startingWith = 1;
    return { num: startingWith,
             next: function () {
                 this.num += 1;
                 return this.num
             }
           }
}

foo = lazyNumbers();

Granted the second set looks more complicated, except for the Haskell line, but it has some advantages. Firstly, while the first bunch of lists is bounded, this second bunch is infinite, and you do sometimes want to express that. More to the point though, the reason these can be infinite is that they're lazy. They only compute as much of the remainder of the sequence as you actually ask for, which means they save you space in two ways

  • they don't keep the entire list in memory by default; they deal with only one element at a time and any used ones are garbage collected unless you decide to keep a pointer to them yourself
  • they never bother computing parts of the list you don't call for, so they don't waste space storing values that'll never actually get used somewhere

That's basic stuff, it should be pretty obvious. Less obvious, but more significant, is how this saves you time.

Time

By its lonesome, it actually doesn't.

(loop with lst = (list 1 2 3 4 5 6 7 8 9)
   repeat 5 for n in lst
   do (format t "~a~%" n))

has the same performance characteristics as

(loop with lst = (lazy-numbers 1) repeat 5
     repeat 5 for n = (car lst) for lst = (funcall (cdr lst))
     do (format t "~a~%" n))

But what about when we compose multiple operations on one sequence? You'll recall that back when I sat down to optimize Life for a couple of days, I made a big deal of reducing the number of iterations of our corpus. Specifically, recall that the Haskell version of Gridless Life started out like this:

import Data.List

neighbors :: (Int, Int) -> [(Int, Int)]
neighbors (x, y) = [(x+dx, y+dy) | dx <- [-1..1], dy <- [-1..1], (dx,dy) /= (0,0)]

lifeStep :: [(Int, Int)] -> [(Int, Int)]
lifeStep cells = [head g | g <- grouped cells, viable g]
  where grouped = group . sort . concat . map neighbors
        viable [_,_,_] = True
        viable [c,_] = c `elem` cells
        viable _ = False

and zoom in on one line in particular.

...
  where grouped = group . sort . concat . map neighbors
        ...

That right there is what laziness trivially enables. If you think about what's being done here, you'll realize that you'd never do this in an eager context. Because if you did, what you'd get is

  1. the argument would get evaluated
  2. it would get traversed once by map neighbors
  3. and then it would get traversed again by concat
  4. and then it would get traversed again by sort[1]
  5. and then it would get traversed again by group

which means six total trips over the entire list. That's bad because every element you touch adds to your run time, and each element you have to touch again as part of the computation is one that you can't throw out of memory. On the other hand, expressing a computation by composing smaller, easy computations is very straightforward[2]. This is a place where the code you want to run, and the code you want to write are completely different.

What you want to run is a tight loop that walks over the entire corpus once, and applies all of the chained functions at once per element. What you want to write is the naive composition of those chained functions, because you've otherwise created an algorithm that will only ever be useful for your particular computation, and that computation will be burdened with the specifics of iteration which will make it non-trivial at best and impenetrable at worst.

Now, granted, Common Lisp has other ways of dealing of dealing with this[3], but laziness is one general solution. If each of those functions were lazy (as, in fact, they are in Haskell), what you'd get instead is exactly what you want. One, tight loop running over the entire corpus, applying only as much grouping, sorting, concating and neighborsing as it needed to for the next part of the computation. That saves you a few trips over the input with no additional effort on your part. Talk about low-hanging fruit.

I'll be honest, I was also going to talk about my latest thoughts on the square dissection problem, but this ended up being longer than I'd like as it is. It'll probably happen next time, I guess. Probably. Stay tuned if you're into that sort of thing.


Footnotes

1 - [back] - A note on functional, lazy sorts, because I was wondering about this both back when tuning the Haskell version of Life and as I was re-visiting it for today's feature. The way that lazy sorts seem to work is basically by using a destructured heapsort. Specifically, if you take a look at this pseudocode, what's happening is that a lazy sort runs heapify right away and passes up the first element, then pulls out the next element each time it's asked for one. That results in On performance for finding the first element (which as far as I'm aware is what you'd have to do in order to get the "nextest" element in the general case anyway), followed by O(log n) performance on looking up each next element. That's good because it means you don't have to do it all at once, and it means that if you only want the first 5 sorted elements of a list of 10000, you get to avoid most of the work. On the other hand, note that this doesn't save you much memory, if any; you still need to store that heap for the whole list, even if you only want the first few chunklets.

2 - [back] - Which is why I did this for the first pass of that program, not realizing that Haskell's lazy-by-default outlook would also make it about as efficient as it could be.

3 - [back] - In fact, the situation of "I want to write the pretty code, but run the ugly code" should send any Lisp veterans off thinking about how you'd defmacro your way out of this particular annoyance.

Tuesday, April 23, 2013

Conduits and More Squares

Ok, so I've been coding something for the past little while in between thinking about squares and reading up on concurrency in haskell. I'm not going to tell you what it is, because we've established my track record, but I did want to note that it looks like it's going to rely on Conduits. A minimal module that provides some interesting additional options for defpackage.

It doesn't have a quicklisp installation package yet, so I've written a basic .asd and chucked it up onto my github in the meantime.

More Square Thoughts

I haven't been actively working on this, just sort of letting it percolate at the back of my mind while other stuff is going on. Having taken a closer look at the original solution for 1..4, and imagining how its author went about getting it, it looks like we might be able to cut a lot of placements out of the process if we picked a representation that was easy to reflect and rotate. Then the actual solution would look something like

(defclass grid ...)

(defmethod rotate ((grid grid) squares direction) ...)
(defmethod reflect ((grid grid) squares axis) ...)

(defmethod collect-rotations ((grid grid) squares)
  (insert-dissection grid squares)
  (loop repeat 3 (insert-dissection grid (rotate grid squares :cw)))
  (rotate grid squares :cw))

(defmethod collect-reflection ((grid grid) squares)
  (loop for axis in '(:x :y :xy :yx)
     do (collect-rotations (reflect grid squares axis))))

(defmethod collect-dissections ((grid grid) squares)
  (collect-rotations grid squares)
  (collect-reflections grid squares))

(loop for sq in (starting-positions a-grid)
   do (loop until (full? g) collect (place-next g) into g
         do (collect-dissections a-grid g))
   finally (return (dissection-count grid)))

Assuming this works, we could easily write a solution to the "hard" version too; just call insert-dissection directly rather than going through collect-dissection and friends.

I'm carefully refraining from defining dissection-count, insert-dissection, grid, and indeed rotate and reflect. What I know is

  • insert-dissection is going to have to do the work of ensuring that duplicate dissections are discarded, which implies storing them as a set or hash
  • the definitions of rotate and reflect will depend heavily on the definition of grid, and square storage needs to be thought out to make sure they're all fast
  • it seems like there should be a better way to solve this problem than "brute force", but I'm not seeing it yet. I've joked about it before, but this may actually be the problem that gets me off my ass and into seriously learning about genetic algorithms

That's that for now. I was going to talk a bit about how work has been going, and the shape of small-scale development in Toronto's medical industry, but it looks like a client has finally decided to respond to me, so back to the grindstone I go.

Friday, April 19, 2013

Hardware and Squares

First things first, there was finally a sale on these things, and I was getting sick of the jury-rigged Vertex in my current laptop, so I picked one up. They're back up at ~$170, but mine cost me a much more attractive $90 last week.

First impressions are ok.

I'm not going to endorse SATA3 for anyone, because it's honestly not a mind-blowing change. I mean load times are noticeably faster, but the difference isn't anything like what you get from switching to a SATA2 SSD from a traditional platter drive. If you end up trading up to this from one of the slower SSDs, be prepared to hear yourself say "Oh, that's nice" rather than "This is fucking glorious". Honestly, my purchase was a result of the fact that this sale price came under my may-as-well threshold for hardware and that my previous HD was literally held in by rubber stoppers and electrical tape.

Dissecting Squares

I'm blaming Dann for this one again. Here's the problem we decided to go after for this months' Toronto Code Retreat:

Suppose you have a grid of squares nxn large. There is a finite number of ways you can split that square grid up into squares of at least 1x1 size. For example, for a 1x1 grid, there is only 1 possible dissection. For a 2x2 grid, there are 2 (either 4 1x1 squares or 1 2x2 square). For a 3x3 grid there are 6; (either 9 1x1 squares, 1 3x3 square, or 4 separate combinations of 1 2x2 square and 5 1x1 squares). This is the Number of Square Dissections.

(A complete illustration of the first four terms is over in the OEIS page. There's also a further three pages illustrating the fifth term. This gets big in a hurry.)

The challenge:

  • "Easy" Mode: Write a function that takes a number N and returns the Number of Square Dissections of an N by N grid.
  • "Hard" Mode: Write a second function with the same input as above that returns the number of unique, under rotation and reflection, dissections.

Before you chuckle at this, bear in mind that a general solution is publishable[1]. According to Dann, the sequence is solved up to an N of 15 or so, and that's already some ungodly number best expressed by exponents.

A couple of people took a stab at working "Hard" mode solutions[2], but as far as I know, no one managed to get to a working solution for "Easy" mode. This is the first Code Retreat I've gone to where I've felt deeply inadequate as a programmer, and that the most popular tool "a notebook" rather than a particular programming language.

As to the problem, I tried a bunch of approaches, none of which seemed to do anything other than annoy me. In terms of problem-solving, I'm usually a data-representation guy. Maybe it's the design degree making me focus on that, I don't fucking know, but it works fairly well. Given a thorny problem, my first reflex is to figure out a way of storing the data such that the mechanical components of the solution are going to be as simple as possible with no more moving parts than necessary. Which is why my train of thought as the problem was coming in was something like...

Can we do this as a naive area calculation? No, that actually fails on the 3x3 grid. We need to represent area and position, or we might represent the remaining area of the board in a more explicit way. Too complicated. Ok, we need to fit things into other things; is this actually a factoring problem? No, we're looking for the count of unique ways of factoring a thing rather than actual factorization. Doing it that way sounds like it would be computationally expensive. Can we model it as a tree of possible square placements? We'd need to represent each square as a width x y triple, at minimum, starting with (list (- n 2) 0 0) and working from there. But there are multiple interconnected combinations that can start with each 2x2 square on a 4x4 grid, and we can't actually prune a lot of sub-branches. Can we do this as a graph traversal? Sounds pretty go... wait, no. No, we wouldn't be visiting each node once. In fact, we can't know a-priori how many times a given node would have to be visited, or what the endpoints of any valid traversal are. Can we model this as an inventory system? Each grid has yae space and adding a square depletes it; when you get stuck, fill the rest with ones, each fill is a different dissection, count the results. Wait, isn't that going to be O^scary^fucking-scary? You need to generate all possible inventory combinations and de-duplicate. I guess you could keep a set of dissections somewhere and keep a canonical sorting order for placed squares. That still implies a representation that tracks position and size rather than just a size and a count. Is it possible that a 2D grid is actually a better representation for this one?-Inaimathi's brain

As it happens, sitting down and throwing together a simple program to test some of these didn't do anything to help. I'd start, get about a third of the way through, then realize that I wasn't accounting for this or that edge case. Or I'd figure out that edge-cases were covered, but the approach doesn't scale up to a general solution. The most promising I've got so far, and this is nowhere near a working solution yet, looks like

(defun positions (board-size square-size)
  (loop for x from 0 to (- board-size square-size)
     append (loop for y from 0 to (- board-size square-size)
               collect (list square-size x y))))

(defun next-squares (board-size starting-square disregard)
  (destructuring-bind (sq-size sq-x sq-y) starting-square
    (loop for current-sq-size from sq-size downto 2
         append (loop for x from sq-x 
                   append (loop for y from sq-y
                             when (and (or (= x sq-size) (= y sq-size)) 
                                       (not (member (list current-sq-size x y) disregard :test #'equal))) 
                             collect (list current-sq-size x y)
                             until (>= (+ sq-size y) board-size))
                   until (>= (+ sq-size x) board-size)))))

(defun tree-out (board-size list-of-squares)
  (loop for sq in list-of-squares
     collect sq into dis
     collect (next-squares board-size sq dis)))

which is godawful, and doesn't work yet, but it isn't obvious that it can't work so I'm rolling with it. The (very) general high-level approach is starting from the largest possible sub-squares of a given grid and doing a depth-first placement traversal. Each successful placement will then be sorted and stored in a set, which will ensure uniqueness[3]. There's a few places where we can definitely prune possibilities, but not as many as I thought there would be, which means that this will ultimately be a fairly expensive operation in any case.

Ugh. This isn't where I was planning on sinking the next week or so of my free time. I wanted to say a few words about Raspberry Pi hacking, and about its GPIO facilities specifically, or to talk a bit more about Wai in the context of large web applications, or maybe finally unveil my Plan For World Domination™© centered around building a general HTML-based MMO, but no.

I got a meme on me. So instead, I'll be thinking about squares.

And how they fit into each other.


Footnotes

1 - [back] - A proof that it's an NP-complete problem in the general case would also be noteworthy apparently.

2 - [back] - That is, taking the list of all dissections of a given grid size and filtering out the rotationally/reflectively unique ones.

3 - [back] - This can all happen in a single traversal, though there might be some opportunity for easy parallelism depending on how the implementation shakes out.

Tuesday, April 16, 2013

Simple web chat using Haskell's Wai/Warp

Here's a quick and dirty chat application written in Wai[1].

{-# LANGUAGE OverloadedStrings #-}
module Main where

import Control.Concurrent.Chan

import Control.Monad.Trans (liftIO)

import Network.Wai
import Network.Wai.EventSource
import Network.Wai.Handler.Warp (run)
import Network.Wai.Middleware.Gzip (gzip, def)
import Network.Wai.Parse (parseRequestBody, lbsBackEnd)
import Network.HTTP.Types (status200, ok200)

import Blaze.ByteString.Builder.Char.Utf8 (fromString)
import Data.ByteString.Char8 (ByteString, unpack)

app :: Chan ServerEvent -> Application
app chan req = do
  (params, _) <- parseRequestBody lbsBackEnd req
  case pathInfo req of
    [] -> return $ ResponseFile status200 [("Content-Type", "text/html")] "static/index.html" Nothing
    ["post"] -> liftIO $ postMessage chan $ lookPost "message" params
    ["source"] -> eventSourceAppChan chan req
    path -> error $ "unexpected pathInfo " ++ show (queryString req)

lookPost :: ByteString -> [(ByteString, ByteString)] -> String
lookPost paramName params = case lookup paramName params of
  Just val -> unpack val
  _ ->  ""

postMessage :: Chan ServerEvent -> String -> IO Response
postMessage chan msg = do
  writeChan chan $ ServerEvent (Just $ fromString "message") Nothing $ [fromString msg]
  return $ responseLBS ok200 [] "Posted"

main :: IO ()
main = do  
  chan <- newChan
  run 8000 $ gzip def $ app chan

That's the most basic example I could find/cobble together of using SSEs in Wai. That's the library called Network.Wai.EventSource up there, and you can see the channel represented in the expressions involving newChan, eventSourceAppChan and writeChan. Basically, we set up a Chan[2] at server startup, we hand out an endpoint whenever someone requests /source, and we write to all endpoints whenever someone requests /post.

The file index.html is exactly what you think it is; about 10 lines each of HTML and JavaScript that set up the front-end EventSource hooks and make sure the chat list gets updated with each new message. You could write it yourself without very much trouble.

This isn't particularly interesting. Firstly because, as you can see, it's ridiculously simple, and secondly because it doesn't scale. I mean it scales with users, sure. According to the Warp benchmarks, we can expect this to support somewhere between 20k and 50k people chatting depending on their loquaciousness, but since they'll all be chatting anonymously in the same room, the experience will stop being useful well before that. The next step confounded me for a little while because I had the assumption that using state in Haskell meant using the State monad[3]. It turns out that's probably not what you'd want here.

What we're after is a system where you can start up arbitrary new rooms, and post to a specific one. In other words, something like

{-# LANGUAGE OverloadedStrings #-}
module Main where

import Control.Concurrent.Chan
import Control.Concurrent (forkIO, threadDelay)

import Control.Monad.Trans (liftIO)
import Control.Monad.Trans.Resource (ResourceT)

import Network.Wai
import Network.Wai.EventSource
import Network.Wai.Handler.Warp (run)
import Network.Wai.Middleware.Gzip (gzip, def)
import Network.Wai.Parse (parseRequestBody, lbsBackEnd)

import Network.HTTP.Types (status200, ok200)
import Blaze.ByteString.Builder.Char.Utf8 (fromString)
import qualified Data.ByteString.Char8 as C

import Data.IORef
import Data.Text (unpack, pack)

app :: IORef [(String, Chan ServerEvent)] -> Application
app channels req = do
  (params, _) <- parseRequestBody lbsBackEnd req
  case pathInfo req of
    [] -> serveFile "text/html" "static/index.html"
    ["jquery.js"] -> serveFile "text/javascript" "static/jquery.min.js"
    ["chat.js"] -> serveFile "text/javascript" "static/chat.js"
    [channelName, action] -> do
      chan <- liftIO $ getOrCreateChannel channels $ unpack channelName
      case action of
        "post" -> 
          liftIO $ postMessage chan $ lookPost "message" params
        "source" -> 
          eventSourceAppChan chan req
        _ -> serveFile "text/html" "static/index.html"
    _ -> serveFile "text/html" "static/index.html"

serveFile :: C.ByteString -> FilePath -> ResourceT IO Response
serveFile mime filePath = return $ ResponseFile status200 [("Content-Type", mime)] filePath Nothing

lookPost :: C.ByteString -> [(C.ByteString, C.ByteString)] -> String
lookPost paramName params = case lookup paramName params of
  Just val -> C.unpack val
  _ ->  ""

getOrCreateChannel :: IORef [(String, Chan ServerEvent)] -> String -> IO (Chan ServerEvent)
getOrCreateChannel channels name = do
  res <- readIORef channels
  case lookup name res of
    Just chan -> 
      return chan
    _ -> do
      new <- newChan
      atomicModifyIORef channels (\cs -> ((name, new):cs, new))
      return new

postMessage :: Chan ServerEvent -> String -> IO Response
postMessage chan msg = do
  writeChan chan $ ServerEvent (Just $ fromString "message") Nothing $ [fromString msg]
  return $ responseLBS ok200 [] "Posted"

main :: IO ()
main = do
  channels <- newIORef []
  run 8000 $ gzip def $ app channels

That's a bit chunkier, but not by very much.

The significant operations there all involve something called an IORef, which is Haskell-talk for "a pointer". You can think of it an IO-based global variable that you can store stuff in[4], in this case, a map of channel names to channel streams.

That index.html file has a bunch of front-end changes too, mostly to do with acquiring and displaying multiple SSE sources, but we're not interested in that today. In the back-end, you'll notice that we've got a new function, getOrCreateChannel, which takes a "pointer" to our channel map and a name, and either returns the result of looking up that name, or inserts and returns a corresponding entry. readIORef "dereferences" that "pointer" to our map, and atomicModifyIORef mutates it. The rest of it should be self-explanatory.

Because we need to do a channel lookup before calling postMessage or eventSourceAppChan, our routes get a bit more complicated. We need to call getOrCreateChannel on the passed in channelName, then pass that to the appropriate function and return the response[5].

Finally, instead of passing a single channel to our app, we need to pass it a "pointer" to our lookup table. That happens in main at the bottom there.

The result of this exercise, as long as we put the front-end together appropriately, is a multi-room, anonymous, HTML chat system. More importantly though, this is a demonstration of how to handle simple global states in Haskell without tearing all your hair out.

I really wish someone else had written this before I started thinking about it...


Footnotes

1 - [back] - No, still not Yesod. Feel perfectly free to use it if that's your thing, but I'd still recommend Happstack if you absolutely, positively need a framework..

2 - [back] - Which I assume is reasonably efficient, since it's one of Haskell's basic concurrency constructs.

3 - [back] - Also, because I'm still not quite awesome enough at this that I can manipulate type expressions in my head. As a result, successful signature changes rarely happen first try, and I often find myself commenting them out then resorting to :t in GHCi and following the compilers' lead. I assume that's mechanical rather than a conceptual problem though, and talking about how I need more practice won't really help you out in any way.

4 - [back] - The IORef docs warn that using more than one of these in a program makes them unreliable in a multi-threaded setting. The thing is:

  • This chat program is extremely simple, needing only one global map to store open channels
  • If it ever got to the point of needing a more complex model, I'd hook it up to AcidState rather than trying to fiddle with MVars myself.

5 - [back] - You can see that happening in the branch labeled [channelName, action] ->, though we easily could have separated it into an external function rather than nesting cases.

Friday, March 29, 2013

Actors Again

That cl-actors fork has gotten a few hours thrown at it. This time around, I integrated the Optima pattern-matching library, and made certain things a little easier. I'm nowhere near done yet though; in addition to the rest of the ToDos from last time, and seeing what I can do with green threads, I need to settle things that the Erlang guys have clearly been thinking about for a few years.

First

How do you deal with error reporting/handling here? And I specifically mean

(defmethod initialize-instance :after ((self actor) &key)
  "Uses the main function name to create a thread"
  (with-slots (behavior in name thread) self
    (setf thread 
          (bt:make-thread 
           (lambda () 
             (loop
                (handler-case
                    (let ((res (funcall behavior (dequeue in))))
                      (loop for target in (targets self)
                         do (enqueue res target)))
                  (match-error (e)
                    (format t "There isn't a match clause that fits. Do something more intelligent with unmatched messages.~%~a~%~%" e))
                  (error (e)
                    (format t "BLEARGH! I AM SLAIN! (this should kill the actor, and possibly call some fall-back mechanism)~%~a~%~%" e)))))
           :name name))))

here. Spitting unmatched messages out at *standard-output* sounds kind of ok, until you start thinking about how you'd deal with any kind of non-trivial system, or a situation where you want to defer those messages to someone else who might know how to deal with them. The standard Supervisor infrastructure that Erlang implements looks like it would be a good solution, and will probably going to be easier to put together in Lisp. That's more or less the only sane option for things like unmatched messages, because you don't ever want those to derail the whole system.

The second case there is more ambiguous though.

  (error (e)
    (format t "BLEARGH! I AM SLAIN! (this should kill the actor, and possibly call some fall-back mechanism)~%~a~%~%" e))

That handles all other errors. Run-time snafus like passing the wrong number of arguments to format. For these, you do really, truly want to take the actor out of commission until it gets fixed; there's no point whatsoever in trying to process further messages until that time. So another reasonable approach here would be to use Common Lisp's built-in condition system. That is, re-raise the error and give the user a restart option to define a new behavior in-line.

I don't know, there might be pitfalls there that I'm not seeing, which is why I need to think pretty hard about it, and then try it out.

Second

I want to make sure that networks resulting from this system are flexible enough to withstand change. That's a tougher one, and the built in behav function from the original cl-actors doesn't quite satisfy. The two things we want to preserve from an actor when we're modifying it, if we want robust networks, are its state and its inbound message queue. The second is hopefully obvious, but the first might not be given how that behav function I just linked is implemented. It leaves the task of assigning new state up to the user, who may not know what the latest state of the actor is. Worse than that, there may be no way for them to find out, because that state is locked away in a closure with no hooks other than the ones manually defined by the behavior they're trying to replace. I'm not entirely sure what the solution there is, but it probably won't be straightforward.

What I apparently want is a macro that takes a series of ematch clauses, and returns a macro that accepts a list of state variables/values, which returns a function that takes a message and returns whatever we want to pass on. I'd call that first macro to define the skeleton of my new behavior, then pass the result through to an actor which would provide its own internal state to fill in the gaps, then take the result of that operation and assign it to a new behavior. The end result would be a function which I can define on the outside somewhere, but which will take into consideration an actors most current internal state when finally applied. The queue, of course, goes nowhere, and assuming the new behavior function doesn't error out anywhere, the actor should continue dequeueing on its merry way

Finally

That "assuming" isn't to be glossed over. Replacing an actor or behavior with another is straightforward in toy examples, but in an actual, running system, you want good fail-over capabilities. Specifically, if the new guy chokes on his first couple of messages, you want the option of slotting in the old process before too much time has elapsed. You definitely don't want to grind the entire downstream system to a halt while the programmers figure out what the issue is with the new code. Another thing that might be useful is a default :test message that you can throw at an actor which should tell the sender whether it can respond to the given message. In a situation where you're replacing an existing actor with a new one, or just replacing the behavior of an existing actor, you want to know that the messages sent out by the new thing are going to be intelligible to their targets before committing to the change-over. How the reporting for this is going to work, I haven't the first clue, but I've got more than enough implementation to do already, so I'll probably leave that one for the next article.

Friday, March 22, 2013

Actors

Two things this time. First...

...An Admission

I'm weak.

It turns out there are exactly two things I'm willing to run non-free software for, and one is wifi access[1]. Another other option is of course, buying an Atheros wifi card, which I intend to do eventually but don't have the spare $100 right at this very moment. Lets move on and say no more about this.

Actors

I've been on vacation for a little while now, which finally gave me the chance to get back into some Common Lisp[2]. You know, since I've mostly been hacking Python at work for the past five months or so. Specifically, I got to do some long-overdue thinking on that Actors library I forked forever and a fucking day ago.

The big problem with actors as they're implemented here is that, while they don't care where their messages come from, they very much do care where their messages go. To be fair, this seems to be a very common implementation, and not limited to cl-actors, so I don't think it's worth holding against the author. What it does is force you to choose between three fairly shitty alternatives for composeability:

1, Message Targets

Define a communication convention whereby a piece of the message is going to specify the actor that it needs to be passed to next.

(define-actor greeter () (target name)
  (send target (format nil "Hello, ~a!" name))
  next)

(define-actor printer (stream) (msg)
  (format stream "~a~%" msg)
  next)

(defparameter *greeter* (greeter))
(defparameter *printer* (printer :stream *standard-output*))

(send *greeter* *printer* "whoeverthefuck")

The problem here is that you're setting up a situation where each sender is going to have to know the entire call chain its message will be going through. That's not good because changing any node suddenly becomes an exercise in frustration if you've got a non-trivial actor network set up, and it only gets worse if you want to do anything other than straight chaining actors. For instance, think about how you would implement an imbalanced tree here; a situation where you have actors A through F, and what needs to happen is

    actor-A
    ├──> actor-B
    ├──> actor-C
    └──> actor-D
         └──> actor-E ──> actor-F

2. Globals

The Erlang equivalent is "registered processes"; you define a global name which will refer to your actor instance, and any other actors that need to interact with it use that global name.

(define-actor greeter () (name)
  (send *printer* (format nil "Hello, ~a!" name))
  next)

(define-actor printer (stream) (msg)
  (format stream "~a~%" msg)
  next)

(defparameter *greeter* (greeter))
(defparameter *printer* (printer :stream *standard-output*))

(send *greeter* "whoeverthefuck")

The problem has moved from the last line to the second line. This approach requires you to re-write pieces of every non-leaf actor if you want to use them in a new context. Ideally, an actor wouldn't have care where its messages go, or at least it wouldn't have to care about it until after it's instantiated. That would let you increase the isolation of your components, thereby giving you more and easier opportunities for code reuse.

3. Local State

Instead of manually specifying targets, make the actor track its targets with a piece of local state. You'd then have to pass targets in along with the other initialization parameters.

(define-actor greeter (targets) (name)
  (let ((msg (format nil "Hello, ~a!" name)))
    (mapcar (lambda (trg) ;; blast you, canonical truth value T!
              (send trg msg))
            targets))
  next)

(define-actor printer (stream) (msg)
  (format stream "~a~%" msg)
  next)

(defparameter *printer* (printer :stream *standard-output*))
(defparameter *greeter* (greeter :targets (list *printer*)))

(send *greeter* "whoeverthefuck")

The two problems with this are complexity and definition dependencies. Complexity because, as you can see from that new greeter definition, most of the body code is now dealing with where the message is meant to go next, rather than with the business logic of what this actor is supposed to be doing. I'm tempted to call this the Yak Shaving Anti-pattern, except that someone else has certainly identified and named it already.

The other problem is apparent in the change among those two defparameter lines. Note that *greeter* is now defined second, and that this isn't an accident. If you did it the other way around, you'd discover that *printer* must be defined in order for it to be specified as a message target.It may be a minor annoyance, but I prefer to avoid those where I can.

The Solution?

As far as I can see, oh and thanks to Paul Tarvydas for pointing me in this direction, it's to separate the actors from their call chains. That is, define an actor as essentially a queue, a thread and a function that returns some value given some message, then introduce an external mechanism by which to get that return value to the next node in the network. What we really want to be able to do is something like

(define-actor greeter () (name)
  (format nil "Hello, ~a!" name))

(define-actor printer (stream) (msg)
  (format stream "~a~%" msg))

(defparameter *greeter* (greeter))
(defparameter *printer* (printer :stream *standard-output*))

(link *greeter* *printer*)

(send *greeter* "whoeverthefuck")

which concentrates the links entirely into that call to link, and leaves the actors themselves cheerfully oblivious to what they're interacting with at the time. It also separates out the general patterns of communication[3] from the business logic of an actor body, so your define-actors are only dealing with the stuff they want to do, rather than the minutia of who needs to do the next bit. So, here's how we do it. Firstly, we'll want to change the definition of an actor to take into account the fact that others may be watching.

(defclass actor ()
  ((name :initarg :name
         :initform (error ":name must be specified")
         :accessor name)
   (behavior :initarg :behavior
             :initform (error ":behavior must be specified")
             :accessor behavior
             :documentation "Behavior")
   (watched-by :initarg :watched-by :initform nil 
             :accessor watched-by)
   (in :initform (make-queue) :accessor in
       :documentation "Queue of incoming messages")
   thread))

watched-by is the addition there; it'll hold a list of all actors and/or queues that might need to be notified about this actors' output. Next, we'll want to simplify define-actor slightly, because we want to collect the return value from its behavior rather than assuming it sends the message on itself

(defmacro define-actor (name state vars &body body)
  "Macro for creating actors with the behavior specified by body"
  `(defun ,name (&key (self) ,@state)
     (declare (ignorable self)) ;; You might not care about referencing self, and that's ok
     (setf self (make-actor (lambda ,vars (progn ,@body)) ,(string name)))
     self))

I also took the opportunity to do away with the need for an explicit next. Near as I can tell, this is just going to prevent me from changing out behaviors at runtime and creating one-cycle actors. My intuition about the first is that it'd be easier to define a new actor and insert it into the network than it would be to reliably and correctly rip out the behavior function of one we already have in place, so I don't mind losing that, though I reserve the right to change my mind if experience teaches me the contrary. The second one is a situation where I'd really want to use a thread with an embedded lambda anyway, so not being able to use an actor there doesn't sound particularly disastrous.

Finally, we'll need to change what each cycle through the message queue does.

(defmethod initialize-instance :after ((self actor) &key)
  "Uses the main function name to create a thread"
  (with-slots (behavior in name thread) self
    (setf thread 
          (bt:make-thread 
           (lambda () 
             (loop 
                for res = (apply behavior (dequeue in))
                when (watched-by self)
                  ;; TODO -- Add customization to protocol, rather than always send-all
                do (loop for target in (watched-by self)
                      do (enqueue (list res) target))))
           :name name))))

so, instead of just applying behavior to each message, we get the result and send it on to any watchers. The TODO is there because, as written, an actor always notifies all watchers, and we might want to do something like round-robin scheduling instead. The main reason I'm thinking along those lines is that I'm planning to use this library in the construction of a non-blocking web-server, where I'd want a single listener but multiple, parallel parsers/response-generators picking up some percentage of total load. Doing something other than "send one to everyone" is an integral part of that strategy. We'll see how it goes.

I should note that you don't have to decide to use only one of send/link here; even with the connection system working[4] there are use cases where you really do want a manual send in an actor body. To be fair, most of those use cases seem to be places where you wouldn't really want to use actors in the first place, but I've reserved judgment and left in both options in the interests of flexibility.

Still ToDo

I've already mentioned separating out the send pattern for an actor so that you can have more flexibility in deciding targets. Although, to be fair, I'm not entirely sure whether that's the best approach; it might be possible to implement different behaviors by just specifying different network shapes rather than by complicating actors further. I'll think on it, and probably solicit some advice from people smarter than I am.

Some additional network-oriented constructs would be nice. We've already got link and chain, but it seems like splice, prune and nip might be useful too. splice would take two linked actors and a third actor, and insert the third one between the first two. prune would take an actor, kill it and remove it from any watched-by lists it might be on. nip would basically do the opposite of splice; take three linked actors, remove the middle one and connect the first to the last.

While I'm at it, it would be nice if all these functions, real and notional, played by Actor Model rules rather than doing hard edits. For instance, instead of link doing (push target (watched-by self)), it would send a message to self which would get processed when it came up in the queue. This has a bit more background complexity than the straight-up side-effect, but it prevents the actor from dropping any messages that might be getting processed while the change is taking place.

While I'm at that, it would be nice if actors automatically responded to certain messages without being specified explicitly in the define-actor body. Off the top of my head, :link (for creating connections), :drop (for breaking them), :set (for changing actor state) and :ping (to allow for supervisor-style constructs later).

The reason I'm just listing these rather than building them right now is that some of them would require a fundamental change to the way the system works. For one thing, accepting default messages implies that we're taking a message which is only one object that we then pattern-match on. For another, things like prune imply either a centralized storage method for all actors, or imply two-way links between nodes, neither of which I'm sure is a good idea. It might be better to assume that connections are only going to be created at startup.

Anyhow, in the meanwhile, what I've got here is a trivially composeable actor system, which lets you re-use any of them at will in any context that applies. That by itself makes the effort worth it as far as I'm concerned. I'll see what I can do for the next pass.


Footnotes

1 - [back] - The other is vintage gaming. Which doesn't pollute my main machine, but I do have a desktop set up at home which has a virtual Win XP machine where I installed a bunch of games from the golden age of fantasy gaming; copies of Icewind Dale 2, Planescape Torment, Baldur's Gate 2, and Dungeon Keeper.

2 - [back] - And a bunch of sketching, but this isn't the place for that. If you're interested, go to my deviantart instead, I'll be uploading a new batch shortly.

3 - [back] - Though, as you'll see later, those could probably be separated further still. I'll be working on it for the next little while.

4 - [back] - And in most cases, producing much more elegant and flexible code, I might add.

Thursday, March 14, 2013

What Programming Language Should I Learn?

I've seen this question pop up on various forums with disturbing frequency lately. Enough that I just wrote this so that I can link people to it instead of typing the advice out each time. The stuff I cover here has already been touched on in a post called Self Titled. Go read that if you want more perspective on my opinion, but it's fairly long so I need to put something shorter and more accessible together.

A Better Question

is "What do I want to do with my programming skills?"

If your goal is merely employment in commercial IT in the shallow future, then the answer is simple. You should learn C++. Then one of Java, C#, Objective C or PHP depending on what niche you want to work in. Then you should stop learning things. After a little bit of a grind, and as long as you're not a complete asshole, or idiot, or both, you'll get promoted to team lead somewhere. At that point you're not writing code, so it doesn't really matter what languages you know or how well.

That's it, you can go.

Pretend the rest of this article doesn't exist.

If You're Still Reading

your goal is to push the bleeding edge of Comp Sci/IT forward, and you have your work cut out for you.

If you're serious about this goal, then you need to understand something. Being a new programmer and asking "What language should I learn?" is roughly like being an aspiring carpenter and asking "Should I learn to use hammers or screwdrivers?". You won't get good answers because it's the wrong question. Usually, you get an avalanche of people coming in to push their pet language forward ("Definitely just stick to the hammer"), or to push the currently fashionable answers ("No one uses hammers anymore, learn to use a nail gun"), and you shouldn't listen to any of them.

Languages are tools, but they're not like physical tools. A language is not a bandsaw. It's the Theory of Relativity. A collection of cognitive tools and abstractions that help you think about unfamiliar and counterintuitive concepts precisely enough to explain them to very stupid machines, and perhaps to very inattentive humans. I say this because the askers of the big question often say that someone has told them something like "Blub is old; don't bother with it". That's not a valid argument against a language. Theories don't rust. Occasionally they're disproven, or revised, but merely being old isn't enough to discredit them[1].

If you want to be a brilliant programmer with a chance of impacting the deep future, sure, you need to understand how the underlying physical machine actually works, and C/C++ helps with that, but it's nowhere near sufficient. You need to really understand OO, which means spending a while hacking on Smalltalk or Ruby or Simula. You need to understand the different kinds of OO on offer, which means dealing with class-based systems (like C++/Java et al), prototype systems (JavaScript or Self) and generic-based systems (Common Lisp) at minimum.

You need to go beyond OO; understand functional and declarative programming, in both strongly/statically and dynamically typed flavors. If you just want a list of languages, that means a whirlwind tour of Haskell/Scala/an ML, a Lisp, Prolog or Erlang, and more than I can reasonably list here besides. It's probably a good bet to just look at the Programming Paradigms page on Wikipedia and read anything linked off the right sidebar, it's all relevant.

You need a thorough understanding of compilers, which you can get by putting a few years into really, truly understanding Lisp macros and/or reading the Purple Dragon book[2] and/or writing one. You'll need to know about data structures, both traditional and functional[3], about set theory, and graph theory, and probability theory, and advanced algebra and probably a hundred other things I missed. Including things that are only incidentally related to programming, like source control, human management/interaction, hardware maintenance, writing, security, typing and the social impacts of the work we do.

Learning to program is not a thing you pick up in seven days, and you could do a lot worse than to start by reading that article. Just make sure to also disabuse yourself of the idea that you do it by picking one language and sticking to that.

TL DR

So, in case you skipped directly to this line, the short answer is "all of them, and that's just for starters". Good luck; I'll see you on the other side.


Footnotes

1 - [back] -"Blub has an inactive community" or "Blub's community is principally composed of assholes" are valid arguments against using a language. But keep in mind that you can still learn a lot by understanding a language that assholes use, or that very few people decided to use. Also, keep in mind that the metrics related to these arguments are relative and necessarily personal; if you're close friends with five or six people who use Io, then it really doesn't matter much what the rest of the world is doing.

2 - [back] - If the price-tag scares you, I should mention that there's a way to get a softcover edition for something like $40, but it doesn't include the same exercise sections or cover and is printed on pretty shitty stock. That's what I ended up doing, and mine's still in one piece even after a few years, but I can't find the link to that deal anymore even though one of the customer images is that edition of the book..

3 - [back] - I'm putting the Amazon link there, but the first link in a google search about "Purely Functional Data Structures" seems to be a legitimate, free PDF copy of the same from CMU.

Sunday, March 10, 2013

Haskell Profiling: Third Impact, or, AcidState vs. The World

The other question mentioned last time was "How does AcidState stack up against the other database back-ends?". So, here's a crack at the answer.

My benchmarking method was basically to port the GoGet back-end to HDBC and MongoDB, then see how each one does at

  • user insertion
  • user listing
  • item insertion
  • user querying

All of this was done on a 64-bit Debian Wheezy machine running on top of a Core i3. Data for other platforms/architectures welcome, but I'm not going there myself. Without further ado:

  • SM - Starting with empty tables/collections and dealing with user #42
  • MD - Starting with 1000 user records and dealing with user #789
  • LG - Starting with 50000 user records and dealing with user #42
  • LG2 - Starting with 50000 user records and dealing with user #45678
  • LG-O - Starting with 50000 user records and dealing with user #45678, compiled with ghc -O --make instead of just ghc --make

These are hosted on my own server because Blogger doesn't seem to like the Criterion markup. You'll find the same files in the codebase if you prefer viewing local copies.

You'll note that I only managed the tiny benchmark for MySQL, and it's absent from the rest; this is because the connection kept choking randomly, which is consistent with my real-world experience. Not pictured is the four or five attempts/clears/restarts that I had to pull before even getting the numbers for a 100 user corpus. No other database, including SQLite, did anything similar.

So lets do a rundown.

Obvious

  • The vast majority of time spent inserting a user goes to generating the scrypt hash. This is obvious because of the huge difference between inserting an item and inserting a user. And, really, this is what you want in a real-world scenario. It should take fairly significant resources to try a password so as to make brute-forcing them a poor option, but in hindsight I could have saved myself a lot of time and compute by cutting that portion of user insertion across the board for benchmarking purposes.
  • The ghc optimization flag approximately halves most numbers, and improves AcidState lookups by about 5x.
  • MongoDB consistently outperforms all comers when it comes to user insertion, and performs very well on sub-insertion with small data-sets. The $push directive seems to be much faster than merely popping a new top-level record in, which I assume is why it manages to take about 1/3 the time of the next contender until we get up to the 50k corpus.
  • SQLite loses in every category at every corpus size, but not by as much as I was expecting. It's actually a pretty good little lightweight DB engine, assuming you don't need to support too many simultaneous requests or too much data.
  • AcidState is an absolute fucking monster. The benchmarks it loses, it loses narrowly[1], but the benchmarks it wins, it wins by an 8x or larger margin. Take special note that while the other engines bench in the high single/low double digit milliseconds, Acid consistently posts list and select numbers in the low double-digit microseconds. Granted, insertion speed goes down a bit based on corpus size, but selection speed is always the same range of extremely low numbers. That's excellent for web applications, which tend to have a usage profile of "rare-ish insertions coupled with large and common lookups". It performs suspiciously well on selects. Well enough that I went back to GHCi and tried mapM (getUserAcid acid) [40000..40050] and mapM_ (getUserAcid acid) [40000..45000] on the large corpus, just to make sure it wasn't recording thunk time instead of actual result time. It isn't. An IxSet lookup is actually just that fast.

Not-So Obvious

There isn't as big a difference in code size as I was expecting. Honestly, I thought AcidState would be much chunkier than the competition, but it only turns out to be the longest by about 10 lines. This might be because I was determined to work with Haskell-style type declarations in each of the models. The reasoning there was that I'd typically be wanting to pull out data then convert it to some external data format after the fact[2], so getting a record in a canonical typed format was going to happen sooner or later anyway. This ends up working hardest against MongoDB, where conversion from very loosely-typed k/v pairs ends up looking something like

itemFromMongo [nameField, commentField, statusField, countField] = 
  Item { itemName =  name, itemComment = comment, itemStatus = status, itemCount = count }
  where Database.MongoDB.String n = value nameField
        name = Text.unpack n
        Database.MongoDB.String c = value commentField
        comment = Text.unpack c
        Database.MongoDB.String s = value statusField
        status = read $ Text.unpack s
        Int32 co = value countField
        count = fromIntegral co

...which is ugly as fuck. A couple of those lines could have been eliminated by declaring itemName and itemComment as Text rather than string, but that would only make it very slightly less ugly.

MySQL crashes like a champ. I use it in a couple of real applications, and I remember having configuration problems there too. It really seems to want a fresh connection each time you do any significant chunk of work, and that seems like it would slow the whole thing down further. Like I said, this is probably a misconfiguration somewhere, and I welcome help if someone wants to go over the tests again on a different machine, giving MySQL more airtime. For the benchmarks it completed, it performs marginally better than AcidState on insertion and very marginally better than SQLite on selection.

It is almost trivially easy to port between HDBC back-ends. You need to call a different connect function and pass it different arguments, but that's more or less it. The only other hiccup I ran into here is the different table creation syntax; SQLite barfs if you try to declare something AUTO_INCREMENT[3], but MySQL requires the statement or leaves you to specify the ID manually. I'm not sure what the differences are between implementations of the SQL standard across other engines, but they seem minimal enough that hopping around wouldn't be difficult.

MongoDB really really doesn't mesh with the Haskell way of doing things. I already mentioned this in the first Not-So Obvious point, but I wanted to highlight it a bit more. This is not to say it's bad. In fact, it would be my top choice if not for the massive impedance mismatch it has with the language. My negative opinion may also be exacerbated by the fact that I've used it in Python and Clojure, where there are no such problems because both languages deal with loosely typed k/v pairs as their primary hash construct[4]. As always, it's possible that I'm doing it wrong, in which case, do point that out.

Finally, a hidden advantage that AcidState and to a lesser extent SQLite have is ease of deployment. The other engines all require some degree of setup beyond coding. MySQL needs an installed, running, properly configured server, with appropriate databases and users created, and your program needs to use the appropriate credentials when communicating. MongoDB needs an installed, running server[5]. SQLite just requires that the deployment machine have libsqlite3.so or sqlite3.dll as appropriate. You need to create your tables the first time, but that's it. AcidState doesn't even require that much. All you need to make sure of is that you have the AcidState Haskell library installed when you're compiling your program. The resulting binary has no external deps whatsoever, so you can just run it on any machine of the appropriate architecture and platform. Personally, I'd be willing to give up non-trivial amounts of performance for a simplified setup process, so I'm quite happy that the easiest DB to work with from that perspective is also benching at or near the top for everything, at every corpus size.

Code Notes

That's all my thoughts on results; if that's all you were here for, you can safely disregard the rest of the article.

The code for these tests is here, but it's very raw at the moment. I plan to write some docs and make it easier to run these tests shortly. There's just a couple of things I want to call attention to explicitly so I don't forget about them.

First, note that I'm making one connection and handing it to each function.

main = do
  acid <- openLocalState Acid.initialDB
  mongo <- Mongo.newConn
  sqlite <- Database.HDBC.Sqlite3.connectSqlite3 "GoGetDB"
--  mysql <- Database.HDBC.MySQL.connectMySQL defaultMySQLConnectInfo
  defaultMain 
    [ 
      benchBlock "AcidState" acid 
      (insertUserAcid, insertItemAcid, getUserAcid, (\acid -> query' acid Acid.GetAccounts)),
      bgroup "HDBC" 
      [ 
--        hdbcBlock "MySQL" mysql,
        hdbcBlock "SQLite" sqlite
      ], 
      benchBlock "MongoDB" mongo 
      (insertUserMongo, insertItemMongo, getUserMongo, Mongo.getAccounts)
    ]
  Mongo.close mongo
  Database.HDBC.disconnect sqlite
--  Database.HDBC.disconnect mysql
  createCheckpointAndClose acid

This is the recommended usage for AcidState and MongoDB, but I'm not entirely convinced it's the best approach for arbitrary SQL databases, or entirely sure how HDBC handles connection-pooling. The end result is, I think, to somewhat deflate the times attributed to using the HDBC back-ends.

Second, if you look at how the SQL database is organized

createTables :: Connection -> IO [Integer]
createTables conn = withCommit conn q
  where q conn = mapM (\s -> run conn s []) 
            ["CREATE TABLE accounts (id INTEGER PRIMARY KEY AUTO_INCREMENT, name VARCHAR(120), passphrase VARCHAR(250))",
             "CREATE TABLE items (user VARCHAR(120), name VARCHAR(120), comment VARCHAR(120), status VARCHAR(4), count INTEGER)"]

You'll see that I slightly re-configured the storage approach to match the back-end's relational model. Also, while the individual account selectors return a Maybe Account, getAccounts just does the naive SQL thing of SELECT * FROM

getAccounts :: Connection -> IO [[SqlValue]]
getAccounts conn = withCommit conn q
  where q conn = quickQuery' conn "SELECT * FROM accounts" []

getAccountBy conn column value = withCommit conn q
  where qString = "SELECT * FROM accounts WHERE " ++ column ++ " = ?"
        q conn = do
          res <- quickQuery' conn qString [toSql value]
          case res of
            [] -> return $ Nothing
            (u@[_, SqlByteString name, _]:rest) -> do
              items <- getAccountItems conn $ unpack name
              return $ Just $ accountFromSql u items

accountByName :: Connection -> String -> IO (Maybe Account)
accountByName conn name = getAccountBy conn "name" name

accountById :: Connection -> Integer -> IO (Maybe Account)
accountById conn id = getAccountBy conn "id" id

The MongoDB back-end does the same sort of thing

getAccounts pipe = do
  res <- run pipe $ find (select [] "accounts") >>= rest
  return $ case res of
    Right accounts -> accounts
    _ -> []

getAccountBy pipe property value = do
  res <- run pipe $ findOne $ select [property =: value] "accounts"
  return $ case res of
    Right (Just acct) -> Just $ accountFromMongo acct
    _ -> Nothing

accountById :: Pipe -> Integer -> IO (Maybe Account)
accountById pipe id = getAccountBy pipe "id" id

accountByName :: Pipe -> String -> IO (Maybe Account)
accountByName pipe name = getAccountBy pipe "name" name

That means that both Mongo and the HDBC back-ends should have a massive advantage over Acid for this particular function. Really, if I wanted to make it fair and get everyone to return the same data type, I'd have to write a JOIN for the SQL approach and map a conversion function over the whole thing. Acid gets that for free and, just in case I haven't pointed it out thoroughly enough yet, still schools all the rest on listing accounts.

Thirdly, I used manual auto-incrementing for MongoDB

newAccount :: Val v => Pipe -> v -> v -> IO Account
newAccount pipe name pass = do
  Right ct <- run pipe $ count $ select [] "accounts"
  let u = ["id" =: succ ct, "items" =: ([] :: [Database.MongoDB.Value]), "name" =: name, "passphrase" =: pass]
  run pipe $ insert "accounts" u
  return $ accountFromMongo u

I don't think this adds too much overhead to user insertion, since the Mongo docs imply that count is not an expensive operation, but I thought I'd mention it. This is not how I'd do it in the real world, but I didn't feel like figuring out how to reliably predict a MongoDB ID hash for the purposes of benching it.

Now, to be fair, while the field is tilted slightly towards HDBC, the task actually favors noSQL data stores because of how Accounts and Items relate to one another. Where I'd have to pull some JOIN trickery in a relational database, a mere IxSet lookup gives me the same effect with AcidState, and a recursively nesting Document type does it for Mongo.

Next Steps

What I'd really like at this point is some peer review. Either refinements to the tasks, or implementations for other database back-ends[6], or data from different machines/environments, or general comments on approach/results. It would also be nice if someone did benchmarks with a large enough corpus that the entire thing didn't fit in memory. Remember, the question I'm trying to answer here is "How well does AcidState stack up against other data storage options in Haskell", and at this point the answer looks to be "It destroys them and pisses on the ashes". If that's not your experience, or if I missed some approach or edge case in my testing, it would be nice to find out before I start outright recommending it to everyone.

And that error checking is something I'll have to leave to the internet.


Footnotes

1 - [back] - Except that MongoDB is significantly better at item insertion for data sets in the ~1k user range.

2 - [back] - Probably JSON, for most of my purposes.

3 - [back] - It just automatically does the Right Thing©™ with a PRIMARY KEY field.

4 - [back] - If you've never tried Clojure with Monger, incidentally, I suggest you stop reading now and go give it a shot. It is goddamned glorious.

5 - [back] - I've heard that at higher traffic levels, Mongo tends to need more configuration and apparently assumes that it has the run of all server resources itself. I haven't run into such problems, and it seems like you could fix this by putting it on its own server in any case.

6 - [back] - Specifically, I'm looking for pointers on how to get MySQL working properly, and I wouldn't mind someone putting together running code for PostgreSQL, but I won't be doing either myself.