Median Sort

Code Jam gcj2021 Haskell

Median sort is this year’s qualifier’s interactive problem. A rather fun one, IMHO. On the surface, it’s dead simple: we are to sort an array. We’re even given the leeway to pick ascending or descending order per our very own preference!

The catch is: we’re not provided with the most useful operation the common sorting algorithms tend to make use of: actually indexing the array. We’re not even allowed its first contender: comparing two array positions’ values.

The only operation we’re provided, as the title suggests, is “Median”. Median takes three distinct array indices as parameters, and returns the one whose value is the median of the three values.

Let’s start by implementing the querying process. As the GCJ interactive runner has one of the weirdest operating modes out there, it’s where it’s easiest to commit the most deadly blunders.

query :: [Int] -> IO Int
query xs = do
  putStrLn $ unwords $ map show xs
  hFlush stdout
  r <- readLn
  when (r < 0) exitSuccess
  pure r

I’m flushing stdout explicitly after a print instead of changing the stream’s global buffering mode, mostly because I do not want to be writing anything to that stream from anywhere else but this function.

I’m checking for disqualification directly there. If the call to exitSuccess in that case reads weird to you, it’s because it really is. But such is the GCJ interactive protocol. Despite numerous complaints from higher-caliber contestants than I, they’ve always stuck to their guns and preserved the stupid parts of it. Oh well.

I love interactive problems in general, but I hate the GCJ interface to them.

I’m not enforcing a list length of 3 because that function is going to serve as the “I’m done” signal as well.

With that out of the way, we can start thinking about the problem per se.

As the statement reminds, with only that “median” query available, it’s impossible to determine whether we’re going to be sorting up or down, which is obviously why both are accepted. Now what strategy can we devise to make use of a minimal number of median queries to discover the array’s order? Conversely, what’s the maximum information we can extract out of a median query, and how does it depend on the choice of the input parameters?

I haven’t checked the problem analyses yet, so I’ll just describe my personal train of thought here. Just reading the test sets’ constraints gives a lot of information out already.

Test set 1 allows 300 queries per test, for lists of size 10. There are \({10!\over 2} \approx 1,8×10^6\) ordered-yet-undirected permutations of [1..10]. Large but not intractable. I suppose it’s feasible to generate all of them, possibly lazily, then interactively filter the ones who match the judge’s answers on median queries. The rest of the problem would be to find queries that restrict the search space by as much as possible at each query. Intuitively it seems like it would be possible to reach the optimum—dividing the search space by two at each step—given the structure of the data. That would need \(log_2 P\) attempts, so 21 in the worst case, which is a lot better than the 300 we’re allowed. Which is a hint that’s probably overkill for a ridiculous solution, and just random queries might be enough.

I may give it a go for the kicks, but it’s bound to be improductive for the larger sets, so let’s not waste any more time on that.

My idea went like this. One median query gives a relative order among three elements. If I make a second median query, how can I relate the information it yields to the first one? Well, in the general case I can’t: while it also gives a relative ordering among three elements, there’s no way of knowing whether that relative ordering goes in the same direction as the first one. So I’ll need it to include not only one but two elements whose order is bound by the first query.

This applies to any two pairs of queries, so globally it appears as though I can’t extract any information from a query if it doesn’t fuse two parameters with another one. Inductively, a query can’t ever mention more than one element that wasn’t mentioned before.

What information does a median query yield where two out of three parameters are “known”? Well, it provides some kind of a band filter: if \(a < b\), then \(Median(a,b,x)\) can be either of:

So intuitively, we’ll make the best use out of that information if those bands are of the same size.

This looks like a beginning of a ternary search. What’s missing? The extracted ordering is a bit coarse at first, but we can try to pin it down to a total ordering by iterating on it. Then repeat for the next numbers.

To bootstrap it, we need two elements whose ordering is “known”. Any pair will do, so we’ll just take 1 and 2 and postulate \(a_1 < a_2\).

And we’ve got a convoluted insertion sort:

InsertionSort(N) returns S:
  let S := [1,2]
  for i := 3 to N:
    let p := TernarySearch(S,i)
    insert i as S[p]

  let a,b be distinct indices that best subdivide S
  m := Median(S[a],S[b],i)
  if m = S[a] then return TernarySearch(S[..a],i)
  if m = S[b] then return TernarySearch(S[b..],i)
  if m = i then return TernarySearch(S[a..b],i)

The ternary search has an upper bound of \(\left\lceil log_3 N\right\rceil\),1 so the overall algorithm would consume fewer than \((N-2)log_3 N\) queries. That’s about 410, this is bad news, we’re only allowed 300. But it’s an overestimate, so let’s dig deeper.

\[ Q \le \sum_{L=3}^N \left\lceil log_3 L\right\rceil = (\ldots) = 378 \]

Still not good enough. But I’m counting the bands’ bounds twice during recursion, perhaps if I refined that? Hah hah no, I got my figures wrong. The maximum array size is 50, not 100. So the first calculation actually results in 171 overestimated worst-case. It’s good enough for both test sets 2 and 3.

Whew. A good thing I didn’t worry about the math during the contest and just implemented it.

Of course, the devil is in the implementation details. So many things could go wrong around the border conditions of a ternary search it’s not even funny. Let’s kick the paranoia level up a notch and define a few newtypes to avoid mixing up the many possible interpretations of Int.

In the course of the algorithm, I’ll be maintaining a sequence of array indices. I’ll keep it such that at any point the indices it holds are ordered in the same direction as [array[1],array[2]]. I’ll call indices the indices of the hidden array; I’ll call ranks the indices in the index sequence of the array indices. A ranking is such a sequence.

Unfortunately the core Haskell Seq type enforces Int indices ranks, so I’ll wrap the accessors I need.

newtype Rank = Rank Int deriving (Eq,Ord,Enum,Num,Real,Integral)
newtype Index = Index Int deriving (Enum)
type Ranking = Seq Index

insertAt :: Rank -> Index -> Ranking -> Ranking
insertAt (Rank i) e q = Q.insertAt i e q

index :: Ranking -> Rank -> Index
index q (Rank r) = Q.index q r

firstRank,lastRank :: Ranking -> Rank
firstRank _ = Rank 0
lastRank q = Rank (Q.length q - 1)

Just a word about the last two functions there.

  1. The useless parameter to firstRank is for similarity with lastRank. Don’t worry, it won’t kill performance.
  2. For an N-element sequence, I’m indexing CS-style with rank \(0\) being the first and \(N-1\) the last. But that’s not the whole story. We are to repeatedly insert elements in (remote-)sorted order, so those rankings will double as insertion points. Inserting at \(0\) means a new first element. But inserting at \(N-1\) does not mean a new last element: that would be \(N\). Keep that in mind: it would be a major source of mistakes if we relaxed our attention.

Bottom-up, let’s now wrap the query function to more type-safe variants.

submit :: Ranking -> IO ()
submit = void . query . coerce . toList

data Trisection = Before | Between | After

medianOrder :: Ranking -> Rank -> Rank -> Index -> IO Trisection
medianOrder q a b (Index i) = do
  let Index sa = index q a
      Index sb = index q b
  m <- query [sa,sb,i]
  if | m == sa -> pure Before
     | m == sb -> pure After
     | m ==  i -> pure Between

This is more verbose than my submitted code, but it’s much better to gain the confidence to move stuff around and experiment.

We now have all the infrastructure we need to tackle the algorithm itself. Proceeding top-down for a change, the sort is self-describing:

insertionSort :: Int -> IO Ranking
insertionSort n = foldM insert q0 [Index 3..Index n]
  where q0 = Q.fromList [Index 1,Index 2]
        insert q i = do
          p <- ternarySearch q i
          pure (insertAt p i q)

And now the real meat. The place where all the off-by-one errors lurk, ready to strike your solution with a TLE or worse, a WA.

I’ll use the common wrapper/worker idiom to keep in scope both the current ranking and the index to be ranked. So the wrapper reads as such:

ternarySearch :: Seq Index -> Index -> IO Rank
ternarySearch q i = ternary (firstRank q) (succ (lastRank q)) where

The ternary worker is intended to be called with the bounds between which the ranking should land, inclusive. Note how this translates to one past lastRank. Let’s also assert the bounds should always be properly ordered, possibly equal.

In the normal case, we can actually split the sought range in three non-null parts, and recurse there. More specifically, and considering it’s always possible to be handed a value that’s going to land out of the current range, we can successfully trisect it if we can find two distinct points in the range to “median” on. So if the ranking spans at least two elements. In that case, we compute said two points as good as we can, query where the index to be ranked places, and refine from there.

ternary :: Rank -> Rank -> IO Rank
  ternary l r
    | w >= 2 = do
        let a = l + w     `div` 3
            b = l + w * 2 `div` 3
        medianOrder q a b i >>= \case
          Before  -> ternary  l    a
          After   -> ternary (b+1) r
          Between -> ternary (a+1) b
    where w = r - l

What do we need to check cautiously?

So the common case looks solid enough. Moving on.

    | w == 0 = pure l

When \(l=r\), there’s only a single possible resulting ranking. So there’s no need to query, we have it already.

What’s left? The \(l+1=r\) case.

If the bounds are exactly 1 apart, we can’t trisect using two values in-between, as there is only one. So we’ve “only” got to compare our index to the value we have. Except we don’t know how to do that: all we’ve got is that Median operation.

There are multiple ways out of this. The one I selected2 is to welcome in one of the ranking’s extrema. It’s possible because we can’t both still be on a \(w=1\) case and on the full ranking range at the same time, since the recursion starts with a sequence of two and always shortens the range on recursion.3

Which extremum should we include? Very pragmatically: the one that isn’t already in. It sounds simple, but it’s the most painful part of the entire algorithm to get right. Not so much because it’s difficult, but because it’s that much more work to do when we feel we should have been done with this for quite some time already.

So here’s my take at it:

    | otherwise = binary l

  binary :: Rank -> IO Rank
  binary a@(Rank 0) = do
    let b = lastRank q
    medianOrder q a b i >>= \case
      Before  -> pure a
      Between -> pure (a+1)
      After   -> error "Consistency failure"
  binary b = do
    let a = Rank 0
    medianOrder q a b i >>= \case
      Before  -> error "Consistency failure"
      Between -> pure b
      After   -> pure (b+1)

It’s a bit verbose, but it’s clear enough. It passes the local judge in “hard” mode:

judge: Total Queries Used: 14553/17000

Judge return code: 0
Solution return code: 0
A solution and judge both finishing with exit code 0 (without
exceeding time or memory limits) would be interpreted as Correct
in the system.

As expected, we’re well under the query count limit. Yay!

Now those two binary implementation cases look awfully similar. Can we merge them? Hey, why not! Let’s have a little equational reasoning.

We’re down to the following clause:

  binary :: Rank -> IO Rank
  binary x = do
    let a = firstRank q
        b = if x == a then lastRank q else x
    medianOrder q a b i >>= \case
      Before  -> pure a
      Between -> pure $ if x == a then (a+1) else b
      After   -> pure (b+1)

Better? More elegant? A strange art-like beauty that should never make it to a production codebase near you? Hey, it’s only Code Jam code!

This concludes today’s problem, namely this year’s qualifier’s problem D. As usual, the complete code is on github.

I’m not done with it, though. There’s still the ridiculous solution to implement for the small test set. And… have you noticed how close that binary worker is to an actual comparison function? Insertion sort was a good first fit, but we may be able to do better.4

See you soon for either that or problem E!

  1. Note that this is not big-O notation, it’s the actual value.↩︎

  2. Because I deemed it the simplest, but I may be wrong.↩︎

  3. Which you should actually check, not trust me on.↩︎

  4. For some notion of better I’ll take care to define to my liking.↩︎