Sudoku in ocamljs, part 3: functional reactive programming

In part 1 and part 2 of this series, we made a simple Sudoku game and connected it to a game server. In this final installment I want to revisit how we check that a board satisfies the Sudoku rules. There's a small change to the UI: instead of a "Check" button, the board is checked continuously as the player enters numbers; any conflicts are highlighted as before. Here's the final result.

Let's review how we want checking to work: a cell is colored red if any other cell in the same row, column, or square (outlined in bold) contains the same number; otherwise the cell is colored white. Now take another look at the check_board function from part 1. Is it obvious that this code meets the specification? The function is essentially stateful, clearing all the cell colors then setting them red when it discovers a conflict. In fact, I had a bug in it related to state--I was clearing the background color in the None arm of check_set, so each checked constraint would overwrite the highlighting of the previous ones where they overlapped.

It would be easier to convince ourselves that we'd gotten it right if the code looked more like the specification. What we want is a function that maps each cell and its "adjacent" cells (the ones in the same row, column, or square) to a boolean (true if the cell is highlighted). Abstracting from the DOM details, suppose a cell is an int option and we have a function adjacents i j that returns a list of cells adjacent to the cell at (i, j). Then the check function is just:

let highlighted cell i j =
  cell <> None && List.mem cell (adjacents i j)

So how do we hook this function into the UI? We could just call it for every cell, every time we get a change event for some cell. That seems like a lot of needless computation, since almost all the cells haven't changed. On the other hand, if we manually keep track of which cells might be affected by a change, our code is no longer obviously correct. It would be nice to have some kind of incremental update, like a spreadsheet.

This is where functional reactive programming comes in. The main idea is to write functions over behaviors, or values that can change. If you change an input to a function, the output (another behavior) is automatically recomputed. The dependency bookkeeping is taken care of by the framework; we'll use the froc library.

It turns out to be convenient to give behaviors a monadic interface. So we have a type 'a behavior; we turn a constant into a behavior with return, and we use a behavior with bind. We saw in part 2 that the monadic interface of Lwt enables blocking: since bind takes a function to apply to the result of a thread, the framework can wait until the thread has completed before applying it. With froc, the framework applies the function passed to bind whenever the bound behavior changes. With both Lwt and froc you can think of a computation as a collection of dependencies rather than a linear sequence.

There's another important piece of functional reactive programming: events. An 'a event in froc is a channel over which values of type 'a can be passed. You can connect froc events to DOM events to interact with the stateful world of the UI. The library includes several functions for working with events (e.g. mapping a function over an event stream) and in particular for mediating between behaviors and events, such as:

val hold : 'a -> 'a event -> 'a behavior

which takes an initial value and an event channel, and returns a behavior that begins at the initial value then changes to each successive value that's sent on the channel, and

val changes : 'a behavior -> 'a event

which takes a behavior and returns an event channel that has a value sent on it whenever the behavior changes.

This all probably seems a bit abstract, so let's dive into the example code:

module D = Dom
let d = D.document

module F = Froc
module Fd = Froc_dom
let (>>=) = F.(>>=)

We set up some constants we'll need below. The Froc module contains the core FRP implementation, not tied to a particular UI toolkit; Froc_dom contains functions that are specific to DOM programming (with the Dom module we saw before).

let make_cell v =
  let ev = F.make_event () in
  let cell = F.hold v ev in
  let set v = F.send ev v in
  (cell, set)
let notify_e e f =
  F.notify_e e (function
    | F.Fail _ -> ()
    | F.Value v -> f v)

These are a couple of functions that really should be part of froc (and will be in the next version). The first makes a cell, which is a behavior (the hold of an event channel) along with a function to set its value (which sends the value on the channel). It's like a ref cell, but we can bind it so changes are propagated. We'll have one of these for each square on the Sudoku board, but it is a generally useful construct.

The second papers over a design error in the froc API: like with Lwt threads, a froc behavior or event value can be either a normal value or an exception (together, a result). The notify_e function sets a callback that's called when an event arrives on the channel, but most of the time we just want to ignore exceptional events.

let attach_input_value i b =
  notify_e (F.changes b) (fun v -> i#_set_value v)
let attach_backgroundColor e b =
  notify_e
    (F.changes b)
    (fun v -> e#_get_style#_set_backgroundColor v)

These are functions that should be part of Froc_dom. To attach a DOM element to a behavior means to update the DOM element whenever the behavior changes. But there are lots of ways to update a DOM element, and Froc_dom doesn't include them all. (This design contrasts with that of Flapjax, where you work with behaviors whose value is an entire DOM element. It's certainly possible to do this in froc, but more tedious because of the types.)

let (check_enabled, set_check_enabled) = make_cell false

Now we're in the application code. The check_enabled cell controls whether checking is turned on--we'll see below what this is for, as you may have noticed that there is no such switch in the actual UI.

let make_board () =
  let make_input () =
    let input = (d#createElement "input" : D.input) in
    input#setAttribute "type" "text";
    input#_set_size 1;
    input#_set_maxLength 1;
    let style = input#_get_style in
    style#_set_border "none";
    style#_set_padding "0px";

    let (cell, set) = make_cell None in
    attach_input_value input
      (cell >>= function
        | None -> F.return ""
        | Some v -> F.return (string_of_int v));
    let ev =
      F.map
        (function
          | "1" | "2" | "3" | "4" | "5"
          | "6" | "7" | "8" | "9"  as v ->
            Some  (int_of_string v)
          | _ -> None)
        (Fd.input_value_e input) in
    notify_e ev set;
    (cell, set, input) in

Here we make the game board much as we did in part 1. The main difference is that instead of working directly with DOM input nodes, we connect each input to a cell of type int option. The attach_input call sets the value of the DOM input node whenever the cell changes, and the notify_e call sets the cell whenever the input node changes. (This doesn't loop, because Fd.input_value_e makes an event stream from the "onchange" events of the input, and "onchange" events are only sent when the user changes the input, not when it's changed from Javascript.) We take the stream of strings and map it into a stream of int options, validating the string as we go.

  let rows =
    Array.init 9 (fun i ->
      Array.init 9 (fun j ->
        make_input ())) in

  let adjacents i j =
    let adj i' j' =
      (i' <> i || j' <> j) &&
        (i' = i or j' = j or
            (i' / 3 = i / 3 && j' / 3 = j / 3)) in
    let rec adjs i' j' l =
      match i', j' with
        | 9, _ -> l
        | _, 9 -> adjs (i'+1) 0 l
        | _, _ ->
            let l =
              if adj i' j'
              then
                let (cell,_,_) = rows.(i').(j') in
                cell::l
              else l in
            adjs i' (j'+1) l in
    adjs 0 0 [] in

We make the game board as a matrix of inputs as before, but now each element of the matrix contains a cell (an int option behavior), the function to set that cell, and the actual DOM input element. Next we set up the rule-checking. The adjacents function returns a list of cells adjacent to the cell at (i, j) (adjacent in the sense we discussed above). All my bugs when I wrote this example were in this function, but it clearly embodies the specification we're trying to meet: a cell is adjacent to the current cell if it is not the same cell and is in the same row, column, or square. (The loop would be clearer if we had Array.foldi.)

  ArrayLabels.iteri rows ~f:(fun i row ->
    ArrayLabels.iteri row ~f:(fun j (cell, _, input) ->
      let adjs = adjacents i j in
      attach_backgroundColor input
        (check_enabled >>= function
          | false -> F.return "#ffffff"
          | true ->
              F.bindN adjs (fun adjs ->
                cell >>= fun v ->
                  if v <> None && List.mem v adjs
                  then F.return "#ff0000"
                  else F.return "#ffffff"))));

This is the functional reactive core of the program. For each square on the board we compute essentially the highlighted function above, but in monadic form (the bindN function binds a list of behaviors at once), and attach the result to the background color of the input node. Because the set of adjacent cells does not depend on the value of the cells, we can hoist its computation out of the reactive part so it won't be recomputed every time a cell changes (and since dependency on a behavior is captured in the type of a function, the fact that this typechecks tells us it is safe to do!).

That's it. The rest of the program is almost the same as before. (Here's the full code.) The one important change has to do with check_enabled. In the reaction to cell changes, we consult check_enabled, returning the unhighlighted color when it's false. Since we do this before binding the cells, a change to a cell causes no recomputation when check_enabled is false. So we turn off check_enabled while loading a new game board, saving a lot of needless recomputation that otherwise makes it annoyingly slow.

It's interesting to compare functional reactive programming to the model-view-controller pattern. The point of MVC is to separate the changeable state (the model) from how it is displayed (the view). Although MVC is typically implemented with change events and state update, a view behaves as a pure function of the state (or can be made so by making the state of UI components explicit). So you could think of FRP as "automatic" MVC: you just write down dependencies (with bind) and the framework manages events and state update. For small examples this may not seem like a big win, but FRP takes care of some complexities that tend to swamp MVC apps: managing dynamic dependencies (registering and unregistering event handlers in response to events) and maintaining coherence (i.e. functional behavior) over different event orders.

I haven't yet written a serious application with froc, but so far I think it is awesome!