2010-06-10

You are Here

I am a terrible person: I read code, I think to myself "I can do better" and I set out thus, out of pride. I did just that with an OCaml implementation of the geohash geographical encoding. Even if the code I read was perfectly workable, I found it unidiomatic and somewhat bloated. I wrote two versions, the first one compact but impenetrable, the second one from first principles: what would be an executable description of the algorithm? To wit:

let decode =
   (narrow (-90., 90.) *** narrow (-180., 180.)) % swap % split
  % List.concat % List.map (to_bits 5 % decode_base32) % explode

Because of (or despite!) the point-free, combinator-heavy style I intended this to be read as a pipeline or as a recipe, from right to left (it is an applicative-order pipeline), much as the algorithm description does:

  1. Explode the code string into a list of characters
  2. For each character, decode it as a base-32 digit decomposing it into a list of 5 bits
  3. Flatten the list of lists of bits into a big list of bits
  4. Split the list of bits into a pair of lists for the even bits and the odd bits
  5. Swap both components of the pair, since the coding uses the even bits for the longitude
  6. Narrow each list independently into a coordinate starting from the corresponding interval

The result is a (latitude, longitude) pair. Supposing that every step is invertible, the algorithm for encoding a coordinate into a geohash is:

let encode nchars =
  let bits = 5 * nchars in
  let lo = bits / 2 in
  let hi = bits - lo in
    implode % List.map (encode_base32 % of_bits) % group 5 % join
  % swap % (expand lo (-90., 90.) *** expand hi (-180., 180.))

Again, this is easy to follow as a recipe or as a succint description:

  1. Given the desired hash length, compute the number of bits for the latitude and for the longitude
  2. Expand each coordinate independently into a list of bits describing its position in the corresponding interval
  3. Swap both components of the pair
  4. Join both lists by alternating even and odd elements
  5. Group the bits in the list into sublists by taking 5 bits at a time
  6. For each group, convert the list of 5 bits into an integer and encode it as a base-32 digit
  7. Implode the list of characters into a code string

Now I have a number of inverse or near-inverse pairs of functions to write, namely:

  • explode and implode
  • decode_base32 and encode_base32
  • to_bits and of_bits
  • List.concat and group
  • split and join
  • narrow and expand

Let's start with the (well-known to Haskellers) combinators (though they pronounce % as .):

let ( $ ) f x = f x
let ( % ) f g x = f (g x)

The first is the application operator and the second is the composition operator. Next are some operators on pairs borrowed from Control.Arrow:

let first f (x, y) = (f x, y)
let second f (x, y) = (x, f y)
let ( *** ) f g (x, y) = (f x, g y)
let swap (x, y) = (y, x)

They allow applying a function to one or both members of a pair, and to manipulate its components. Note that swapswapid. This completes the functional scaffolding. The first and more imperative pair of functions is explode and implode:

let explode s =
  let res = ref [] in
  for i = String.length s - 1 downto 0 do
    res := String.unsafe_get s i :: !res
  done;
  !res

let implode l =
  let b = Buffer.create 10 in
  List.iter (Buffer.add_char b) l;
  Buffer.contents b

The first traverses the string from right to left to accumulate each character on the head of the resulting list; the second uses a string buffer to build the resulting string a character at a time. I use unsafe_get because, well, these are as low-level functions as they come, so squeezing a bit extra from them doesn't seem inappropriate. Each is the other's inverse, or in more abstract terms the pair (explode, implode) witnesses the monoid isomorphism between OCaml strings and lists of characters (that's why Haskell identifies both datatypes).

Aside: I won't attempt any proofs to avoid making a long post even longer. Some are easy, most are tedious, and the preceding is probably difficult. I've verified a few of the inverse pairs but not all of them, so I don't consider this code verified by any stretch of the word. I am, however, confident that the code works.

Now decode_base32and encode_base32 are also fairly imperative, but just because I chose to use an array as the map between characters and their base-32 encodings:

let codetable = [|
'0'; '1'; '2'; '3'; '4'; '5'; '6'; '7';
'8'; '9'; 'b'; 'c'; 'd'; 'e'; 'f'; 'g';
'h'; 'j'; 'k'; 'm'; 'n'; 'p'; 'q'; 'r';
's'; 't'; 'u'; 'v'; 'w'; 'x'; 'y'; 'z'
|]

This means that for encoding a 5-bit number indexing into the array is enough, but decoding a base-32 character requires a lookup. Since the array is sorted by character, a binary search is a good choice:

let binsearch ?(compare=Pervasives.compare) v e =
  let i = ref 0
  and j = ref (Array.length v) in
  if !j = 0 then raise Not_found else
  while !i <> !j - 1 do
    let m = (!i + !j) / 2 in
    if compare v.(m) e <= 0
      then i := m
      else j := m
  done;
  if v.(!i) = e then !i else raise Not_found

let encode_base32 i = codetable.(i land 31)
and decode_base32 c = binsearch codetable (Char.lowercase c)

(This binary search is completely general). Now decode_base32encode_base32id (for the restricted domain of 5-bit integers) if and only if binsearch v v.(i) = i for i in range of v. Similarly, encode_base32decode_base32id (again, for the restricted domain of base-32 characters) if and only if v.(binsearch v x) = x. The conditions on binsearch amount to it being correct (and would make for excelent unit or random testing).

The next inverse pair is to_bits and of_bits:

let iota =
  let rec go l i =
    if i <= 0 then l else let i = i - 1 in go (i :: l) i
  in go []

let to_bits k n = List.rev_map (fun i -> (n land (1 lsl i)) != 0) $ iota k

let of_bits = List.fold_left (fun n b -> 2 * n + if b then 1 else 0) 0

The first maps a list of bit positions (given by iota, the initial natural interval) into the corresponding bits by direct testing, most-significant (highest) bit first; the second computes the binary value of the list of bits by a Horner iteration.

The following functions are very general functions on lists. Any function f : α listα list list such that List.concatfid is called a partition. One such function is group:

let group k l =
  let rec go gs gss i = function
  | []           -> List.rev (if gs = [] then gss else List.rev gs :: gss)
  | l when i = 0 -> go [] (List.rev gs :: gss) k l
  | x :: xs      -> go (x :: gs) gss (i - 1) xs
  in go [] [] k l

It collects up to k elements in the stack gs, pushing complete groups into the stack gss. The last group might be incomplete and it is added to the top of the stack before returning it. A function that I will need later is the the converse of List.fold_right, appropriately called unfold:

let rec unfold f e n =
  if n <= 0 then [] else
  let (x, e') = f e in
  x :: unfold f e' (n - 1)

unfold generates a list of the given length n from a seed e and a function f that computes the head and the next seed. Now split and join are another very functional couple:

let cons x xs = x :: xs

let split l =
  let rec even = function
  | [] -> [], []
  | x :: xs -> first (cons x) $ odd xs
  and odd = function
  | [] -> [], []
  | x :: xs -> second (cons x) $ even xs
  in even l

let rec join (xs, ys) = match xs with
| [] -> ys
| x :: xs -> x :: join (ys, xs)

In general, splitjoin is not the identity on pairs of lists (think of ([], l) for nonempty l), but indeed joinsplitid, and a proof could proceed by induction. Now all these functions are completely general (except perhaps for the base-32 encoding and decoding) and have little if anything to do with geocaching. The last pair, narrow and expand, are the meat of the algorithm:

let avg (x, y) = (x +. y) /. 2.

let bisect (lo, hi as interval) b =
  let md = avg interval in
  if b then (md, hi) else (lo, md)

let narrow interval = avg % List.fold_left bisect interval

narrow repeatedly bisects the interval, keeping the upper or lower half depending on the next bit in the input list, finally returning the midpoint of the final interval. Its inverse is expand:

let divide x (lo, hi as interval) =
  let md = avg interval in
  if x > md
    then true , (md, hi)
    else false, (lo, md)

let expand bits interval x = unfold (divide x) interval bits

It unfolds each bit in turn, by divideing the interval and finding which half contains x. These functions are inverses in the sense that, for any interval i = (min, max) and list l, expand (List.length l) i (narrow i l) = l and conversely, for any n ≥ 0 and minxmax:

|narrow i (expand n i x) - x| ≤ (max - min)2-n-1

These are the crucial properties that make encode the true inverse of decode. The astute reader might have noticed the resemblance of geohashing with arithmetic coding: in a sense, a geohash is the base-32 encoding of the coordinates lossly compressed with an uniform probability model. One way to improve the precision of the encoding would be by allocating a predefined weight to each hemispherical quadrant, by taking into account that more landmass is present in the north-eastern quadrant of the globe. This would require splitting the intervals not along the middle but, say, the first third, thus representing more precise locations with the same number of bits in continental Europe and the Far East, then in North America, then in Africa and Oceania, and lastly in South America.

2010-05-28

Gematric Search

Given an array A.(0 ≤ i < N) of nonnegative integers, that is:

(0)   ⟨∀ i : 0 ≤ i < N : A.i ≥ 0⟩

and a positive integer s > 0, we want to find a segment of A that sums to s, if it exists. Define:

      S.i.j = ⟨∑ k : 0 ≤ ik < jN : A.k

The gematric search for s in A is to find, if possible, a pair (p, q) such that S.p.q = s (it is hoped that conoisseurs would readily make the connection). Note a number of things:

  • S.i.j is a total function on i, j
  • By definition, the sum on an empty range is zero:
    (1)   S.i.i = 0
    

    for all integer i.

  • For arguments in range of A, S.i.j is monotone on its second argument and antitone on its first. That is, given 0 ≤ i′i < jj′N:
    (2)   S.i.j ≤ S.i.j′
    (3)   S.i.j ≤ S.i′.j
    

What should the result be if no such segment is present in A? One possibility would be setting a flag found, such that the program ensures:

      ¬found ∨ S.p.q = s

An alternative would be to guarantee some condition on (p, q) equivalent by design to found. Given that s ≠ 0, one such condition would be satisfied by S.p.q = 0 as a suitable sentinel. By (1), this is implied by p = q, and we choose the weaker postcondition:

(4)   p = q ∨ S.p.q = s

Now (4) is trivially satisfied by:

{ A.(0 ≤ i < N) ∧ s > 0 }
gemsearch ≡
   p := 0; q := 0; sum := 0;
   { reduce |sum - s| under invariance of (4) }
{ p = q ∨ S.p.q = s }

where sum = S.p.q at each step. How should we meet the refinement obligation in the program? We clearly have three cases:

  • sum = s

    We have found our segment, and we can stop looking.

  • sum < s

    By (2) we can extend the segment on the right, provided we can, that is, if qN.

  • sum > s

    By (3) we can shrink the segment on the left, provided we can, that is, if pq. But since s > 0, this is implied by pN, a weaker condition symmetric to the previous one and thus preferable. It is also suitable for the repetition guard, since its negation implies the postcondition.

We have:

{ A.(0 ≤ i < N) ∧ s > 0 }
gemsearch ≡
   p := 0; q := 0; sum := 0;
   do pNsumsif sum < sqNsum := sum + A.q; q := q + 1
      [] sum > ssum := sum - A.p; p := p + 1
      [] … → ?
      fi
   od
{ p = q ∨ S.p.q = s }

The conditional is not exhaustive. Let's calculate what the obligations are for third case:

   ¬((sum < sqN) ∨ sum > s)
≡ { DeMorgan, twice }
   (sumsq = N) ∧ sums
≡ { Distribute }
   (sumssums) ∨ (q = Nsums)
≡ { Tertium non datur }
   sum = s ∨ (q = Nsums)
⇐ { Loop condition }
   q = Nsum < s

This condition expresses a deficient suffix of A which is, by (3), as large as it can be, hence we can quit the search. Left-factoring the common condition on s, we arrive at our final program:

{ A.(0 ≤ i < N) ∧ s > 0 }
gemsearch ≡
   p := 0; q := 0; sum := 0;
   do pNsumsif sum < sif qNsum := sum + A.q; q := q + 1
         [] q = Np := N
         fi
      [] sum > ssum := sum - A.p; p := p + 1
      fi
   od
{ p = q ∨ S.p.q = s }

The algorithm is of complexity obviously linear on N, since no element of A is accessed more than twice.

2010-05-15

Observable sharing and executable proofs

Every rational number has an infinite repeating decimal expansion. In particular, every integer admits two decimal expansions: one with and one without a "tail of nines". This means that 1 = 0.9999…, a provable fact that many people still choose to disbelieve. What do I mean here by "provable"? I mean "provable by finitistic reasoning", that is, by a purely algebraic proof free of notions of continuity or convergence. The proof in this particular (and particularly popular) case goes like this:

    x     = 0.9999…
≡ { product by base is shift of decimal point }
  10x     = 9.9999…
≡ { subtraction of finitely-expanded integer }
  10x - 9 = 0.9999…
≡ { identity of decimal expansion }
  10x - 9 = x
≡ { algebra }
   9x     = 9
≡ { cancellation of multiplication }
    x     = 1

The last two steps are elementary consequences of the fact that integers form a ring. The first three steps require justification. By definition, a decimal expansion of a positive real number x is a (possibly semi-infinite) sequence of digits 0 ≤ di < 10 such that for all iN, di = 0, and

x = ⟨∑ i :: 10idi

and the decimal point separates the digits corresponding to 100 and 10-1, namely d0 from d-1.

Lemma 0 Any decimal number x can be expressed as the sum of an integer and a (possibly infinite) decimal part

Proof: By definition, x has a finite number of decimal digits to the left of the decimal point, namely for 0 ≤ i < N, hence:

  x
= { definition }
  ⟨∑ i :: 10idi ⟩
= { associativity of addition, a finite number N of times }
  ⟨∑ i : 0 ≤ i < N : 10idi⟩ + ⟨∑ i : 0 > i : 10idi⟩
= { naming the first term }
  n + ⟨∑ i : 0 > i : 10idi

This justifies representing a positive real number as a pair of an integer and a possibly infinite purely fractional decimal expansion:

type dec = Dec of int * int list

A sufficient condition for two numbers to be equal is that their decimal representations are the same:

let eq (Dec (e, ds)) (Dec (e', ds')) = e = e' && ds == ds'

Here, since the decimal expansions could be infinite, I use physical equality on lists. This is a stronger condition than stated above. Now, the proof for the first step:

Lemma 1 Multiplying a positive real number x by 10 shifts the decimal point in its decimal expansion one place to the right

Proof:

  10⋅x
= { lemma 0 }
  10⋅(n + ⟨∑ i : 0 > i : 10idi⟩)
= { product finitely distributes over sum }
  10⋅n + 10⋅⟨∑ i : 0 > i : 10idi⟩
= { product formally distributes over sum }
  10⋅n + ⟨∑ i : 0 > i : 10i+1di⟩
= { substitute i := i-1 }
  10⋅n + ⟨∑ i : 1 > i : 10idi-1⟩
= { lemma 0 }
  (10⋅n + d0) + ⟨∑ i : 0 > i : 10idi-1

Note that the third step is not strictly speaking finitist but formal: it requires taking the distributivity of product over a summation as axiomatic if induction is not accepted. This justifies the following:

let mul10 = function
| Dec (e, []     ) -> Dec (10 * e    , [])
| Dec (e, d :: ds) -> Dec (10 * e + d, ds)

The proof for the second step:

Lemma 2 Subtracting an integer k from a positive real number x only affects its integer part

Proof:

  x - k
= { lemma 0 }
  (n + ⟨∑ i : 0 > i : 10idi⟩) - k
= { commutativity and associativity of sum }
  (n - k) + ⟨∑ i : 0 > i : 10idi

This justifies the following:

let subi (Dec (e, ds)) n =
  if e < n then failwith "subi" else
  Dec (e - n, ds)

Now the proof for the third step is purely executable and relies on physical equality of infinite lists of digits represented as circular lists:

let nines = let rec ds = 9 :: ds in Dec (0, ds)

Of course, for more general repeating expansions, equality on heads won't suffice, but this case is nicely handled by a one-liner:

let lemma = assert (eq nines (subi (mul10 nines) 9))

The purely verbal mathematical statement of this truth is that, since the first two steps operate on a finite prefix of the infinite expansion, the inifinite suffix is unchanged by the operations and hence identical to itself. In other words, the infinite summation is a purely formal object that remains unchanged from step to step.

Will this proof finally lay the "controversy" to rest, persuading even the staunchest finitist?

Edit: Thanks to id that alerted me in my confusion between structural and physical equality.

2010-04-23

Properly Bound

To all practitioners: the type of bind is not the type of >>=. For a monad α m, the latter has type:

val (>>=) : α m → (αβ m) → β m

only because >>= is used as a combinator that allows pipelining computations from left to right, as per usual convention:

… m >>= fun x →
  n >>= fun y →
  …
  return f x y

On the other hand, if you want to take maximum advantage of the Theorems for Free! then your bind should have type:

val bind : (αβ m) → (α m → β m)

because it is a natural transformation, together with return:

val return : αα m

You can see immediately how both "fit" together; in particular, the second monad law (right identity) falls off naturally (!) from the types:

bind return ≡ id

The first monad law (left identity) is also immediately natural:

bind f ∘ return ≡ f

since bind f's domain coincides with return's range by inspection. The third monad law (associativity) is much less regular but you can see a hint of the mechanics of adjointedness if you read bind g as a whole:

bind g ∘ bind f ≡ bind (bind g ∘ f)

This note is motivated by a reading of Jérémie Dimino's slides about Jérôme Vouillon's Lwt, specifically slide 6 (Edit: thanks Gabriel for the heads up about proper attribution).

2010-04-22

The elusive Binary Search

Jon Bentley has scarred a couple of generations of programmers, or he was and continues to be right:

I've assigned this problem in courses at Bell Labs and IBM. […] In several classes and with over a hundred programmers, the results varied little: ninety percent of the programmers found bugs in their programs (and I wasn't always convinced of the correctness of the code in which no bugs were found).

Jon Bentley, Programming Pearls, p. 36

This disjunction is not meant to be exclusive. The question whether programmers know how to write a binary search or not crops again in connection with this quote (but the topic is perennial), and reddit jumps to try its collective hand at the task and fail with numbers echoing Bentley's. The remedy (namely, closely study Dijkstra's A Discipline of Programming, or at least the van Gasteren and Feijen's paper) is as effective as it is bitter. The alternative is to learn the algorithm by heart:

let binsearch v e =
  let n = Array.length v in
  if n = 0 then raise Not_found else
  let i = ref 0
  and j = ref n in
  while !i <> !j - 1 do
    let m = (!i + !j) / 2 in
    if v.(m) <= e
      then i := m
      else j := m
  done;
  if v.(!i) = e then !i else raise Not_found

(note: the midpoint calculation cannot overflow in OCaml). No ifs, no buts, not a single thing changed: the algorithm as presented above is proved correct. Alas, we live in an age of practical assurances, and like Thomas we trust more a green-lighted battery of tests than a formal derivation (who understands those anyway?). There is a nice, 4096-case test set available on-line; a parser and a test harness are simple enough to build for it. Each case consists of a label, a test value, a list of values and an expected outcome:

type test = Test of string * int * int array * bool

The file format is line-oriented; this makes easy to use a regexp-based parser. To ease the use of regular expressions, I build a test function out of a pattern:

let matching patt =
  let re = Str.regexp patt in
  fun str -> Str.string_match re str 0

(I close over the compiled regexp for efficiency). The required regexps are:

let is_label  = matching "^Problem [0-9]+$"
let is_start  = matching "^in \\[$"
let is_value  = matching "^-?[0-9]+$"
let is_endyes = matching "^\\]\\? yes$"
let is_endno  = matching "^\\]\\? no$"
let is_sep    = matching "^$"

Syntax errors in the test cases file are signalled by an exception:

exception SyntaxError of int * string

I keep track of the lines read for purposes of error reporting:

let lineno = ref 0

let syntax_error str = raise (SyntaxError (!lineno, str))

let read inch =
  try let l = input_line inch in incr lineno; Some l
  with End_of_file -> None

The parser reads a file and returns a list of test cases; it uses mutually-recursive functions as a traditional recursive-descent parser with synthetic attributes. Each function corresponds to a terminal in the production case ::= label value start value* end sep:

let rec parse_tests inch = List.rev (parse_case inch [])

and parse_case inch tests = match read inch with
| Some line when is_label  line -> parse_member inch tests line
| None -> tests
| _ -> syntax_error "PROBLEM expected"

and parse_member inch tests label = match read inch with
| Some line when is_value  line -> parse_start  inch tests label (int_of_string line)
| _ -> syntax_error "MEMBER expected"

and parse_start inch tests label cand = match read inch with
| Some line when is_start  line -> parse_value  inch tests label cand []
| _ -> syntax_error "START expected"

and parse_value inch tests label cand vals = match read inch with
| Some line when is_endyes line -> parse_finish inch tests label cand vals true
| Some line when is_endno  line -> parse_finish inch tests label cand vals false
| Some line when is_value  line ->
  parse_value  inch tests label cand (int_of_string line :: vals)
| _ -> syntax_error "VALUE or END expected"

and parse_finish inch tests label cand vals test = match read inch with
| Some line when is_sep    line ->
  parse_case   inch (Test (label, cand, Array.of_list (List.rev vals), test) :: tests)
| _ -> syntax_error "SEPARATOR expected"

The test harness iterates a test function over the resulting list, recording the number of successful tests along the total:

let test_binsearch inch =
  let count = ref 0
  and pass  = ref 0 in
  List.iter (fun (Test (label, cand, vals, test)) ->
    let result =
      try ignore (binsearch vals cand); test
      with Not_found -> not test
    in
    incr count;
    if result then begin
      Printf.printf "TEST %s: PASS\n" label;
      incr pass
    end else
      Printf.printf "TEST %s: FAIL\n" label
    ) (parse_tests inch);
  Printf.printf "\nSUMMARY: Passed %d of %d tests (%.2f %%)\n"
    !pass !count (100. *. float !pass /. float !pass)

In order to be tidy about using files, I use a helper handler:

let unwind ~protect f x =
  try let y = f x in let () = protect x in y
  with e -> let () = protect x in raise e

let with_input_channel f inch = unwind ~protect:close_in f inch

The main expression turns this little (less than 90 lines of code) program into an executable suitable for command-line execution:

let () =
  let inch =
    try let fname = Array.get Sys.argv 1 in open_in_bin fname
    with Invalid_argument _ -> stdin
  in with_input_channel test_binsearch inch

That's it. Compile and execute it with:

$ ocamlopt.opt -o binsrch.exe str.cmxa binsrch.ml
$ ./binsrch.exe tests.txt > tests.out

(I'm using Cygwin here, don't hate me). The result is as expected:

TEST Problem 1: PASS
TEST Problem 2: PASS
TEST Problem 3: PASS
[snip…]
TEST Problem 4094: PASS
TEST Problem 4095: PASS
TEST Problem 4096: PASS

SUMMARY: Passed 4096 of 4096 tests (100.00 %)

Now do yourself a favor and go read Dijkstra.