Contents

2009 Qualification Round

Alien Language

We already solved this recommended beginner problem.

Watersheds

We can employ a disjoint-set library to do the heavy lifting. For each cell, we determine the water flows to one of the neighbouring cells. If so, we put them in the same disjoint set.

Afterwards, we make another pass with mapAccumL from top to bottom, left to right, assigning the successive letters of the alphabet to disjoint sets and also emitting these letters. A map keeps track of the disjoint sets have already been given a letter.

Our code assumes minimumBy returns the first minimum of the input list.

import Data.Array
import Data.Ord
import Data.List
import Data.List.Split
import qualified Data.Map as M
import Data.Partition
import Jam

nwes = [(-1, 0), (0, -1), (0, 1), (1, 0)]
add (a, b) (c, d) = (a + c, b + d)

main = jam $ do
  [h, w] <- getints
  a <- listArray ((1, 1), (h, w)) . concat <$> getintsn h
  let
    flow p i | null nbrs = p
             | otherwise = joinElems i (minimumBy (comparing (a!)) nbrs) p
      where nbrs = [j | j <- add i <$> nwes, bounds a `inRange` j, a!j < a!i]
    p = foldl' flow empty $ indices a
    f (m, c:cs) r | r `M.member` m = ((m, c:cs), m M.! r)
                  | otherwise      = ((M.insert r c m, cs), c)
    s = snd $ mapAccumL f (M.empty, ['a'..]) $ rep p <$> indices a
  pure $ concatMap ('\n':) $ intersperse ' ' <$> chunksOf w s

As an exercise, we also solve the problem in a classic imperative style. We initialize an array consisting of "?" to represent yet-to-be-assigned letters, a list of the unassigned letters, which initially is the lowercase alphabet.

We iterate through the array, top to bottom, left to right, and each time we come across an unassigned cell, we simulate water flow according to the problem descriptions. If we reach a letter, then we fill all cells in the flow with that letter, If we reach a "?" we assign the next available letter of the alphabet to all cells in the flow.

Thus for each cell, we either know the corresponding letter beforehand, or we figure it out on the fly.

We need a cryptic type declaration for the mutable array.

import Control.Monad.ST
import Data.Array
import Data.Array.ST
import Data.Ord
import Data.List
import Data.STRef
import Jam

nwes = [(-1, 0), (0, -1), (0, 1), (1, 0)]
add (a, b) (c, d) = (a + c, b + d)

main = jam $ do
  [h, w] <- getints
  as <- listArray ((1, 1), (h, w)) . concat <$> getintsn h
  pure $ concatMap (('\n':) . intersperse ' ') $ runST $ do
    abc <- newSTRef ['a'..'z']
    t   <- newListArray ((1, 1), (h, w)) $ repeat '?'
      :: ST s (STUArray s (Int, Int) Char)
    let
      f i = readArray t i >>= g where
        nbrs = [j | j <- add i <$> nwes, bounds as `inRange` j, as!j < as!i]
        g '?' | null nbrs = do
                (x:xs) <- readSTRef abc
                writeSTRef abc xs
                writeArray t i x
                return x
              | otherwise = f $ minimumBy (comparing (as!)) nbrs
        g ch  = pure ch

    sequence [sequence [f (r, c) | c <- [1..w]] | r <- [1..h]]

Welcome to Code Jam

On reading this problem, the phrase "common subsequneces" comes to mind, which suggests we should seek a recursion for a solution using dynamic programming.

Let w be the string "welcome to code jam", and let s be the input string. We define f (n, k) to be the number of ways we can find the letters of drop k w as a subsequence of drop n s,

When k == length w, there is exactly one way to find no letters in drop n s. Otherwise, if n == length s then we have reached the end of s so there is no way to find the remaining letters.

Otherwise, we can look for drop k w in drop (n + 1) s, and if s!!n == w!!k, then we can also look for drop (k + 1) w in drop (n + 1) s:

We use Data.MemoTrie to memoize to make this efficient.

import Jam
import Data.MemoTrie
import Text.Printf

w = "welcome to code jam"

main = jam $ do
  s <- gets
  let
    f (n, k)
      | k == length w = 1 :: Int
      | n == length s = 0
      | s!!n /= w!!k  = g (n+1, k)
      | otherwise     = (g (n+1, k) + g (n+1, k+1)) `mod` 10000
    g = memo f

  return $ printf "%04d" $ f (0, 0)

The code is terser if we refer to lists instead of their indexes, but this interacts badly with the memoization.

Because we use printf, we need a type declaration somewhere to specify just which numeric type we want.

Contents
Ben Lynn blynn@cs.stanford.edu 💡