2016 Round 1A

The Last Word

We must place the last occurrence of the largest letter in front, and all following letters on the back. Recursively applying this principle leads to the solution:

import Data.List
import Jam

main = jam $ f <$> gets

f "" = ""
f xs = (a:f (reverse as)) ++ reverse bs
  where (bs, a:as) = span (< maximum xs) $ reverse xs

The awkward reverse calls could be eliminated if spanEnd existed, though we would then call init and last instead of decomposing a list into its head and tail. By spanEnd we mean a function that is to span as dropWhileEnd is to dropWhile.

The first time I tried this problem I split the list at the first maximum instead of the last. Luckily the small input exposed my mistake, so I had a chance to redeem myself.

Rank and File

If we had all the papers, then each height appears twice: once for its row, and once for its column. Thus each number should appear an even number of times.

The missing numbers are distinct, so we can just look for the numbers that appear an odd number of times and sort them.

import Data.List
import Jam

main = jam $ do
  [n] <- getints
  ns <- concat <$> getintsn (2*n - 1)
  pure $ unwords $ map (show . head) $ filter (odd . length) $ group $ sort ns

BFFs

Data.List makes brute force a breeze:

import Data.List
import Jam

smallMain = jam $ do
  [n] <- getints
  ns <- getints
  pure $ show $ maximum $ map length $ filter (f ns) $
    concatMap permutations $ subsequences [1..n]

f _ [] = False
f _ [x] = True
f ns xs = and $ zipWith (||) (zipWith bff xs ys) (zipWith bff xs zs)
  where
    bff x y = ns!!(x - 1) == y
    ys = tail xs ++ [head xs]
    zs = last xs:init xs

The smarter approach is finicky to describe, so we’ll skim over details. We’ll use graph theory terminology. Let each node represent a kid, and draw a directed edge from A to B if A’s BFF is B.

Since no kid is their own BFF, the circle contains a cycle of length 2 or more.

We find if the circle contains a cycle of length 3 or greater, then the circle must consist of only that cycle.

Otherwise, all cycles in the circle have length 2, and not only can the circle contain an arbitrary number of 2-cycles, but it can also contain all nodes along a path to a node in a 2-cycle.

Thus the biggest circle is either the longest cycle of length 3 or more, or all the cycles of length 2 plus the nodes in the longest paths reaching these nodes, whichever is biggest.

import Data.List
import Data.Map ((!))
import qualified Data.Map as M
import Jam

main = jam $ do
  [n] <- getints
  ns <- getints
  let
    m = M.fromList $ zip [1..] ns
    rm = M.fromListWith (++) $ zip ns (map pure [1..]) ++ zip [1..n] (repeat [])
    f a = long [a] where
      long [] = 0
      long xs = 1 + maximum [long $ (rm!x) \\ [a, m!a] | x <- xs]

    -- Inefficient, but good enough.
    maxCycle = maximum $ cyc . pure <$> [1..n]
    cyc xs@(x:_)
      | y `notElem` xs = cyc (y:xs)
      | y == last xs   = length xs
      | otherwise      = 0
      where y = m!x

  pure $ show $ max maxCycle $ sum $ f <$> [x | x <- [1..n], m!(m!x) == x]

Above, m is a Data.Map that stores the edges, and rm is its inverse, so we can quickly follow the BFF relationships in either direction. Over all nodes in a 2-cycle, we sum a function that measures the longest path to that node, excluding nodes in its 2-cycle.

Unfortunately, I was so excited when I successfully characterized the largest circle that I stupidly downloaded the large input before optimizing my code enough to handle it. It’s trivial to generate a large test case to verify the program is sufficiently fast.


Ben Lynn blynn@cs.stanford.edu 💡