Contents

2012 Qualification Round

Speaking in Tongues

The lookup function of Data.List suffices for this simple problem.

import Jam
import Data.List
import Data.Maybe

s = "qzejp mysljylc kd kxveddknmc re jsicpdrysi rbcpc ypc rtcsra dkh wyfrepkym veddknkmkrkcd de kr kd eoya kw aej tysr re ujdr lkgc jv"

t = "zqour language is impossible to understand there are twenty six factorial possibilities so it is okay if you want to just give up"

main = jam $ map (fromMaybe '?' . (`lookup` nub (zip s t))) <$> gets

missing = ['a'..'z'] \\ nub s

Included are safety checks used during development. Evaluate missing to ensure we have handled all letters of the alphabet. In fact, this problem is sneaky in that the mapping of the letters "q" and "z" can only be determined from reading the description, and not the sample input and output.

Also, we print question marks for unhandled letters. There should be none in the output, which we can check before submitting our answer.

Dancing With the Googlers

When p is 0 or 1, the problem is trivial.

Otherwise, define m = 3*(p - 1). We have three cases:

  1. A total score exceeding m can be broken down into an unsurprising triple including at least one score that is at least p.

  2. A total score equalling m or m - 1 can be broken down into a triple including a score of at least p if and only if the triple is surprising.

  3. A total score below m - 1 cannot be broken down into a triple containing a score that is at least p, surprising or not.

This leads to the following solution:

import Jam

main = jam $ do
  (_:s:p:ts) <- getints
  let m = 3*(p - 1)
  pure $ show $ case p of
    0 -> length ts
    1 -> length (filter (> 0) ts)
    _ -> length (filter (> m) ts) +
         min s (length $ filter (`elem` [m, m - 1]) ts)

Recycled Numbers

Brute force works for the small input. We count all distinct pairs within [a..b], such that one is the rotation of the other.

import Data.List
import Jam

rot (x:xs) = xs ++ [x]

rots xs = take (length xs) $ iterate rot xs

main = jam $ do
  [a, b] <- getints
  pure $ show $ length [undefined |
    n <- [a..b], m <- [n+1..b], show n `elem` rots (show m)]

For the large input, the quadratic running time from enumerating all pairs is too steep. Instead, for each number n in [a..b], we compute all its unique rotations that lie within range, and count the number of ways to choose two of these rotations, provided n is the smallest of these rotations.

import Data.List
import Jam

rot (x:xs) = xs ++ [x]

rots xs = take (length xs) $ iterate rot xs

main = jam $ do
  [a, b] <- words <$> gets
  pure $ show $ sum $ f . nub .
    filter (b >=) . filter (a <=) .  rots . show <$> [read a..(read b :: Int)]

f ms@(m:_) | m == minimum ms = k * (k - 1) `div` 2
           | otherwise       = 0
           where k = length ms

This last condition ensures we count each case exactly once. An alternative is to replace this last condition with a division by the number of rotations.

f ms = k * (k - 1) / (2 * k) where k = length ms

This leads to the simplification:

import Data.List
import Jam

rot (x:xs) = xs ++ [x]

rots xs = take (length xs) $ iterate rot xs

main = jam $ do
  [a, b] <- words <$> gets
  pure $ show $ (`div` 2) $ sum $ (+(-1)) . length . nub .
    filter (b >=) . filter (a <=) .  rots . show <$> [read a..(read b :: Int)]

After reaching this point, I realized there is a simpler combinatorial argument for the above.

Suppose n in [a..b] has k distinct valid rotations. This includes itself, so k - 1 of these rotations are distinct to to n. We tally them all, that is we count each pair (n, n') where n' is a distinct rotation of n.

Ultimately, we have counted each pair twice, once for each of the two orderings, so we halve the count.

Hall of Mirrors

The conditions for the small input imply the room is empty, and the only mirrors are on the walls.

In the first example input, with Cartesian coordinates, our location is (0.5, 0.5) and the room is the unit square centered on this location.

To avoid fractions, we scale everything by a factor of 2, so that our location is now (1, 1), our room measures 2x2 (and is centered on our location) and light travels at most 2 units. We perform this transformation after reading the input.

Normally the x-axis is horizontal and the y-axis is vertical. We flip this convention for this problem; alternatively, we fiip the room along the diagonal 'y = x' before running our code, and the answer is the same.

Let (r, c) be our coordinates, and let the room is defined by a diagonal from (0, 0) to (h, w). If (r, c) is the exact center of the room, as it is for the first two examples, then our image (or the original) appears at points whose first coordinate differs from ours by an integer multiple of h, and whose second coordinate differs from ours by an integer multiple of w. That is, for some integers a, b, their coordinates are translated by (w * a, h * b) from our location.

More generally, our location may be displaced from the center. Then for any integers (a, b), we see images of ourselves translated from our location by the four points:

[(2*w*a + i, 2*h*b + j) | i <- [0, -2*c], j <- [0, -2*r]]

We want the points in this list whose norm is at most d, and for any fixed angle, we want at most one point, because the images can block those directly behind.

To avoid square roots, we work with squared norms.

import Data.Array
import Data.List
import Data.Set (Set)
import qualified Data.Set as S
import Jam

main = jam $ do
  [h, w, d] <- getints
  a <- listArray ((1, 1), (h, w)) . concat <$> getsn h
  let
    Just (r, c) = fst <$> find ((== 'X') . snd) (assocs a)
  pure $ show $ f (2*r - 3, 2*c - 3) (2*h - 4, 2*w - 4) $ (2*d)^2

absSq (a, b) = a^2 + b^2
add (a, b) (c, d) = (a + c, b + d)
neg (a, b) = (-a, -b)
sub v w = add v $ neg w

f (r, c) (h, w) d = S.size $ foldl' g S.empty $ concat $ [yu, yd] <*> xl ++ xr
  where
    v    = takeWhile ((<= d) . absSq)
    xr   = v $ map (flip (,) 0)    $ (+) <$> [2*w, 4*w..] <*> [-2*c, 0]
    xl   = v $ map (flip (,) 0)    $ (+) <$> [0,  -2*w..] <*> [0, -2*c]
    yu p = v $ map (add p . (,) 0) $ (+) <$> [2*h, 4*h..] <*> [-2*r, 0]
    yd p = v $ map (add p . (,) 0) $ (+) <$> [0,  -2*h..] <*> [0, -2*r]

g s (r, c) | d == 0    = s
           | otherwise = S.insert (r `div` d, c `div` d) s
           where d = gcd r c

Above we begin by exploring the x-axis starting from our location until the norm exceeds d, once for the positive direction and once for the negative. Then for each point we found, we explore in the positive and negative y directions until the norm exceeds d.

We compute angles uniquely by dividing x- and y- coordinates by their greatest common divisor; there is no need for atan2.

For the large input, oddly shaped rooms prevent us from easily computing the locations of our images. Instead, we must consider every integer point lying within distance d of the origin, and compute its angle to the origin. We then trace a ray from us at each unique angle we find.

angs d = S.toList $ foldl' g S.empty $ concat $
  [[(x, y), (x, -y), (-x, y), (-x, -y)] | x <- [0..d],
    y <- takeWhile ((<= d^2 - x^2) . (^2)) [0..]]

g s (r, c) | d == 0    = s
           | otherwise = S.insert (r `div` d, c `div` d) s
           where d = gcd r c

Here’s one way to visualize why these are the only angles we need to check: Imagine the floor of the room is tiled with squares, and that mirrors must be placed on the edges of tiles. What do we see when we look at the reflections of the floor?

Unlike the small input, we keep the original scale. Each character of the input describes the contents of a 1x1 square of the room. A "#" character at (x, y) means the square defined by the diagonal (x, y) to (x + 1, y + 1) is a square mirror. If "X" appears at (x, y) in the array, then our coordinates are (x + 1%2, y + 1%2); we’re using Data.Ratio to handle fractions.

We simplify our code by reflecting the ray and the entire room horizontally or vertically so that both coordinates of our ray are positive.

We can transform arrays with ixmap:

xflip a = ixmap b (\(x, y) -> (h1 + h0 - x, y)) a
  where b@((h0, _), (h1, _)) = bounds a

yflip a = ixmap b (\(x, y) -> (x, w1 + w0 - y)) a
  where b@((_, w0), (_, w1)) = bounds a

However, my solution using this code wound up taking about three and a half minutes on my laptop. The running time halved when the above was replaced with a wrapper to handle the reflections:

data Flippy = Flippy Bool Bool (Array (Int, Int) Char)

xflip (Flippy xf yf a) = Flippy (not xf) yf       a
yflip (Flippy xf yf a) = Flippy xf       (not yf) a

get (Flippy xflip yflip a) (x, y) = a!(bool x (h0 + h1 - x) xflip,
                                       bool y (w0 + w1 - y) yflip)
  where ((h0, w0), (h1, w1)) = bounds a

Even though we can assume the ray (dx, dy) is in the first quadrant, the code is a little tricky. We opt to trace the ray square by square: we determine if the ray first hits the top edge, or the right edge, or both, look up the corresponding characters in the input array, and then reflect or destroy the ray if necessary.

Along the way, we maintain the distance traveled so far, in the form of a multiplier, and stop tracing if we exceed maximum visibility.

Checking to see if we’ve reached an image of ourselves is also tedious. We ensure we’ve traveled some distance to avoid counting ourselves as an image. Then if an "X" is present in the unit square where we are currently tracing the ray, we see if the ray will pass through the exact center of the square. If it does, we still need to check that the accumulated distance is at most the maximum visible distance.

import Data.Array
import Data.Bool
import Data.List
import Data.Ratio
import Data.Set (Set)
import qualified Data.Set as S
import Jam

absSq (a, b) = a^2 + b^2
add (a, b) (c, d) = (a + c, b + d)
fi (a, b) = (fromIntegral a, fromIntegral b)

data Flippy = Flippy Bool Bool (Array (Int, Int) Char)

get (Flippy xflip yflip a) (x, y) = a!(bool x (h0 + h1 - x) xflip,
                                       bool y (w0 + w1 - y) yflip)
  where ((h0, w0), (h1, w1)) = bounds a

xflip (Flippy xf yf a) = Flippy (not xf) yf       a
yflip (Flippy xf yf a) = Flippy xf       (not yf) a

main = jam $ do
  [h, w, d] <- getints
  a <- listArray ((0, 0), (h - 1, w - 1)) . concat <$> getsn h
  let
    Just (x, y) = add (1%2, 1%2) . fi . fst <$> find ((== 'X') . snd) (assocs a)
  pure $ show $ sum $ ray (Flippy False False a) d 0 (x, y) . fi <$> angs d

angs d = S.toList $ foldl' g S.empty $ concat $
  [[(x, y), (x, -y), (-x, y), (-x, -y)] | x <- [0..d],
    y <- takeWhile ((<= d^2 - x^2) . (^2)) [0..]]

g s (r, c) | d == 0    = s
           | otherwise = S.insert (r `div` d, c `div` d) s
           where d = gcd r c

ray a@(Flippy _ _ arr) lim acc (x, y) (dx, dy)
  | not $ visible acc = 0
  | dx < 0 = ray (xflip a) lim acc (h - x, y) (-dx, dy)
  | dy < 0 = ray (yflip a) lim acc (x, w - y) (dx, -dy)
  | acc > 0 && get a (qx, qy) == 'X' && (1%2 - rx) * dy == (1%2 - ry) * dx =
    fromEnum $ visible (acc + t / 2)
  | get a (floor px, floor py) /= '#' = ray a lim (acc + t) p (dx, dy)
  | get a (qx + 1, qy) /= '#' && get a (qx, qy + 1) /= '#' = 0
  | otherwise = ray a lim (acc + t) p
    (bool dx (-dx) $ floor px > qx && get a (qx + 1, qy) == '#',
     bool dy (-dy) $ floor py > qy && get a (qx, qy + 1) == '#')
  where
    (h, w) = add (1, 1) $ fi $ snd $ bounds arr
    (qx, rx) = properFraction x
    (qy, ry) = properFraction y
    p@(px, py) = (x + t * dx, y + t * dy)
    tx = (1 - rx) / dx
    ty = (1 - ry) / dy
    t | dx == 0   = ty
      | dy == 0   = tx
      | otherwise = min tx ty
    visible v = v^2 * (dx^2 + dy^2) <= fromIntegral lim^2

The fi helper function deals with type annoyances caused by the array being indexed by integers, but our calculations being done on rationals.

Contents
Ben Lynn blynn@cs.stanford.edu 💡