import Data.Array import Jam main = jam $ do [r, c] < getints a < listArray ((1, 1), (r, c)) . concat <$> getsn r let arrows = filter ((/= '.') . snd) $ assocs a bads = filter (uncurry edgy) arrows edgy (i, j) '>' = dotty [(i, y)  y < [j+1..c]] edgy (i, j) '<' = dotty [(i, y)  y < [1..j1]] edgy (i, j) '^' = dotty [(x, j)  x < [1..i1]] edgy (i, j) 'v' = dotty [(x, j)  x < [i+1..r]] dotty = all ((== '.') . (a!)) lone z = all (edgy z) "<>^v" pure $ if any lone $ fst <$> bads then "IMPOSSIBLE" else show $ length bads
2015 Round 2
Pegman
While brute force would work on the small input, I believe the time spent writing the corresponding code outweighs the time it takes to find a shortcut. Furthermore, the shortcut is easy enough that we’re comfortable without checking our results against those of brute force.
Pegman can never walk off the edge if and only if every arrow points to another arrow.
Thus for each arrow pointing off the board, we try to rotate it so it points to another arrow. This is impossible if and only if no arrows lie in all four directions.
Kiddie Pool
For one water source we can fill the pool if and only if the source temperature
equals the target temperature, in which case it will take v / r
time.
A similar computation applies if we have two or more water sources, all with
the same temperature.
For two water sources with distinct temperatures c0, c1
, we can solve
equations to determine the volume of water we need from each source:
v0 + v1 = v v0*c0 + v1*c1 = v*x
If both volumes are nonnegative, then we can fill the pool, and the minimum time
needed is the larger of v0/r0
and v1/r1
.
The above are the only cases needed for the small input:
import Control.Monad import Jam main = jam $ do (_n:_vx) < words <$> gets rcs < replicateM (read _n) getdbls let [v, x] = read <$> _vx f [[r, c]]  c == x = show $ v / r  otherwise = "IMPOSSIBLE" f [[r0, c0], [r1, c1]]  c0 == c1 = f [[r0 + r1, c0]]  v0 >= 0, v1 >= 0 = show $ max (v0 / r0) (v1 / r1)  otherwise = "IMPOSSIBLE" where v0 = v * (x  c1) / (c0  c1) v1 = v * (x  c0) / (c1  c0) pure $ f rcs
For the large input, perhaps it’s easiest to reframe the problem slightly. Instead of turning sources on and off at various times, we will first optionally reduce the rate of flow of any of the water sources, and then we will turn on all sources for the same amount of time.
For example, turning on a water source at the start then turning it off halfway through in the original problem is equivalent to leaving it on the whole time with a halved flow rate in our revised description.
Since all flows are active for the same amount of time, we seek the minimum total flow reduction.
Suppose there is no reduction, that is, we keep the original rates of flow.
Then if rs
are the rates of flow and cs
the corresponding source
temperatures, the temperature of the water after t
minutes is:
a = sum (zipWith (*) rs cs) / sum rs
That is, the temperature is independent of t
. If a
equals the target
temperature x
then this is the best we can do, for we fill the pool at the
maximum rate of flow.
Otherwise, we must reduce the rate of flow from at least one of the water sources.
Suppose a < x
, that is, the water will be too cold if we simply turn on
all water sources. We must reduce the rate of flow from at least one of
the sources that is colder than x
. But which ones?
Since c0 < c1
implies dr * c0 < dr * c1
, we gain the most by reducing the
flow of the coldest source. We first consider cutting off the coldest water
source completely. If the result is still too cold, then if there are no water
sources left, we declare the problem to be impossible; otherwise we remove
the coldest source from consideration and repeat.
Otherwise, cutting off the coldest water source yields water of at least
temperature x
, in which case we can solve an equation to find a flow rate r
for it that leads to the pool having the desired temperature.
A symmetric argument applies when a > x
.
import Control.Monad import Data.List import Data.Ratio import Jam agg rcs = sum (zipWith (*) rs cs) / sum rs where rs = fst <$> rcs cs = snd <$> rcs conv [r, c] = (approxRational r 0, approxRational c 0) main = jam $ do (_n:_vx) < words <$> gets rcs < sortOn snd . map conv <$> replicateM (read _n) getdbls let [v, x] = (`approxRational` 0) . read <$> _vx f rcs@(h:t)  a == x = Just $ v / sum (fst <$> rcs)  [_] < rcs = Nothing  a < x, agg t < x = f t  a < x = Just $ g h (sum $ fst <$> t, agg t)  agg i > x = f (init rcs)  otherwise = Just $ g l (sum $ fst <$> i, agg i) where a = agg rcs i = init rcs l = last rcs g (_, c0) (r1, c1) = v / (r1 + r1*(x  c1) / (c0  x)) pure $ maybe "IMPOSSIBLE" (show . fromRational) $ f rcs
We use Data.Ratio
to avoid floatingpoint woes. For example, the a == x
check is susceptible to errors from divisions. There are at most 100 water
sources, so working with rationals is tolerable. There are also other
inefficiences which would only matter for inputs beyond the given limits.
Bilingual
For the small input, brute force implies checking up to 2^18
subsets which
requries some care.
We remove the words common to the first two sentences from all sentences, as these must be words common to both languages. We’ll add their count back later, just before printing the final answer. After this, we only have to operate on sentences with at most ten words.
We replace each word with a unique integer identifier, a form of string interning.
We build the counts
map to store the occurrences of each word across both
English and French sentences. Thus we can find all bilingual words from a
given set of English sentences by comparing the number of times they appear in
English against their counts
value.
We could use subsequences
to enumerate all possible sets of English sentences,
but we’re better off writing our own recursion to generate them, because we can
incrementally update a map of word counts rather than creating them from
scratch for each subset:
import Jam import Data.List import Data.Maybe import qualified Data.Map as M main = jam $ do [n] < getints ss@(es:fs:_) < map (nub . words) <$> getsn n let comm = es `intersect` fs m = M.fromList $ zip (nub (concat ss) \\ comm) [(0 :: Int)..] as@(e:_:t) = mapMaybe (`M.lookup` m) <$> ss counts = M.fromListWith (+) . zip (concat as) $ repeat 1 best n [] = sum [fromEnum $ n M.! w /= counts M.! w  w < M.keys n] best n (x:xs) = min (best n xs) $ best (foldl' (\m k > M.insertWith (+) k 1 m) n x) xs pure $ show $ (length comm +) $ best (M.fromList $ zip e $ repeat 1) t
We explicitly declare an Int
to avoid the overhead incurred by Integer
.
The above takes under a minute on my laptop to solve the small input.
It turned out subsequences
is fast enough, taking about two minutes, but if
the worst case were exercised each time, it may have been a little too close
for comfort.
The large input was challenging. I thought it could be nicely reduced to set cover or some kind of boolean satisfiability before I eventually realized graph theory was the best fit.
But I still got it wrong. I initially created a node to represent each sentence, and joined two nodes with an edge of weight 1 for every unique word they have in common. Alternatively, we can replace multiple edges with a single edge whose weight is the number of unique words in common. Then I thought the answer was the maxflow or mincut between the first two nodes: the edges of a mincut correspond to the words that are members in both languages.
This is false because different edges can represent the same word. We actually need a hypergraph, that is, we must generalize edges so they can comprise of an arbitrary number of vertices. Each sentence corresponds to a node, and each word corresponds to an edge that links the nodes corresponding to the sentences in which it appears. Now the answer is the maximum flow between the first two nodes.
A search online revealed surprisingly little on hypergraph max flow. I found a simple global mincut algorithm for hypergraphs due to Klimnek and Wagner. I was skeptical it worked, because I thought it would imply a deterministic global mincut algorithm for graphs without using max flow. But then I came across the StoerWagner algorithm.
My textbooks from my undergraduate days predate these algorithms, and back then, mincut was solved with maxflow, and global mincut solved by trying mincut for all pairs of vertices. In graduate school, I learned of Karger’s algorithm but failed to realize its significance at the time.
These algorithms are worth remembering, but it looks difficult to adapt a global mincut algorithms to solve a particular st mincut problem. Searching further, I found an abstract about an efficient hypergraph max flow algorithm by Pistorius and Minoux, but I got the impression this is relatively esoteric research, since I was unable to find a summary of the algorithm on popular websites. Code Jam would hardly require contestants to know of it.
The abstract mentions that the conventional method to solve max flow on hypergraphs is to transform to a graph first. This seems like the approach the Code Jam wanted, so I gave up hoping for some offtheshelf hypergraph max flow library, and thought about transforming the hypergraph.
My first instinct was to create a node for each word as well as nodes for each sentence, and add an edge of weight 1 between a word and each sentence containing it. This fails because a max flow can involve more than one path going through a word node, while we want at most one path to go through a word node. (This transformation happens to work on the small input though!)
The trick is to use a directed graph, and represent a word with two nodes. For a given word, we call one of its nodes the entry node and the other the exit node. We add an edge from the entry node to the exit node, and for each sentence containing the word, we add an edge from the sentence to the entry node, and also an edge from the exit node node to the sentence node.
At last, the max flow from the first sentence to the second yields the answer.
The limits given in the problem description suggest this approach is feasible, provided we perform the same preprocessing as for the small input, namely, specially handling the words the first two sentences have in common.
import Data.Graph.Inductive.Graph import Data.Graph.Inductive.PatriciaTree import Data.Graph.Inductive.Query.MaxFlow import Data.List import Data.Maybe import qualified Data.Map as M import Jam main = jam $ do [n] < getints ss@(es:fs:_) < map (nub . words) <$> getsn n let comm = es `intersect` fs m = M.fromList $ zip (nub (concat ss) \\ comm) [n..] e2es = [(j, j + M.size m, 1)  j < M.elems m] edges = e2es ++ concat [[(i, j, 1), (j + M.size m, i, 1)]  i < [0..n  1], j < mapMaybe (`M.lookup` m) (ss!!i)] vn = n + 2 * M.size m gr = mkGraph (zip [0..vn1] $ repeat ()) edges :: Gr () Int pure $ show $ length comm + maxFlow gr 0 1
The Data.Graph.Inductive
hails from the fgl
package, which approaches
graph
theory from a functional programming perspective.
The above took over 4 minutes to complete the large input on my laptop.
Drum Decorator
A cell has at most 4 neighbours, so each number must lie in the range [1..4]
.
If a cell contains 4, then all its neighbours must also contain 4. This implies
that every cell of the drum contains 4, which is impossible because the cells
on the top and bottom only have 3 neighbours. Thus each number must lie in the
range [1..3]
.
Suppose at least one cell contains 3. Then consider one of the topmost cells containing 3. Since no cell above this cell contains a 3, its left, right, and bottom neighbours must all contain 3s. Repeating this argument on the left and right neighbours shows that we must have two rows of cells all consisting of 3s.
Two rows of 3s are valid if and only if no 3s appear directly above or below them, so we have deduced all possible ways for 3s to appear on a drum: they must appear in two consecutive rows consisting of 3s, and be nonadjacent to other rows of 3s.
This leaves 1s and 2s. The 1s are easy: they show up as isolated dominoes, because a 1 must appear next to exactly one other 1. Since C is at least 3, we never have 1s all around the drum.
It remains to describe 2s. Suppose a drum contains at least one 2, and consider one of the topmost 2s. One possiblity is that the whole topmost row consists of 2s, in which case the row below contains no 2s. From above, the only number that may appear directly above or below a band of 2s, is 3.
Otherwise suppose the row contains a digit other than 2, which must a 1. By a case analysis whose details we skip here, we find the only possbilities are repetitions of one of the following three patterns:
222112 112222 122 122 2122 2121 2221
As a sanity check, we can brute force search for valid patterns consisting of 1s and 2s for a given drum size. The following is tolerable provided the total number of cells is 20 or so:
import Data.Array import Jam dirs = [(0, 1), (0, 1), (1, 0), (1, 0)] main = jamLn $ do [r, c] < getints let valid a = all (\(ij, n) > (n ==) $ length $ filter (n ==) $ nbrs a ij) $ assocs a nbrs a ij = map (a!) $ filter (goodRow . fst) $ go ij <$> dirs go (x, y) (z, w) = (x + z, 1 + (y + w + c  1) `mod` c) goodRow i = i >= 1 && i <= r pr a = unlines [concatMap show [a!(i, j)  j < [1..c]]  i < [1..r]] pure $ unlines $ map pr $ filter valid $ listArray ((1, 1), (r, c)) <$> sequence (replicate (r * c) [1, 2])
We now have enough to count all possibilities with dynamic programming. Given an array of size (r, c), we can either try to fill the first two rows with 3s, and then fill the remaining rows starting with a non3 pattern, or we can try to start with a non3 pattern immediately.
A non3 pattern is one of:

A single row of 2s.

If c is a multiple of 6, then two rows of the first pattern above.

If c is a multiple of 3, then two rows of the second pattern above.

If c is a multiple of 4, then three rows of the third pattern above.
If there are remaining rows, then the next two must be all 3s, and after that we need to start with a non3 pattern. Thus we have outlined how to recursively count the number of ways of filling in an array starting with a non3 pattern.
However, there is a complication. I overlooked it initially, and it took me some time to realize my mistake. The following 6x3 drum:
122 122 333 333 122 122
differs from the following 6x3 drum:
122 122 333 333 212 212
but my original solution failed to distinguish between them.
To fix this, we introduce a parameter d to the recursion that, in
mathematical parlance, denotes the size of the orbit of the drum under
rotation, In other words, the number of different arrays that arise from
rotating the drum. Initially the drum is blank, so d
starts at 1.
Each pattern has an orbit size. For rows of all 3s or all 2s, this is 1, while those that involve 1s have orbit sizes of 6, 3, and 4.
Then when adding a pattern with orbit size p to a partially filled drum
with orbit size d, the new orbit size is lcm d p
and there are gcd d p
fundamentally different ways to add the pattern.
In Haskell:
import Jam main = jam $ do [r, c] < getints let f d 0 = 1 f d r = g d (r  1) + h 6 2 + h 3 2 + h 4 3 where h p q  c `mod` p > 0  r < q = 0  otherwise = gcd d p * g (lcm d p) (r  q) g _ 0 = 1  Done! g _ 1 = 0  Need 2+ rows for 3 pattern. g d r = f d (r  2) pure $ show $ f 1 r + f 1 (r  2)
This works for the small dataset. For the large dataset, we work modulo
10^9 + 7
and use Data.MemoTrie
to memoize, thus reducing the complexity
from exponential to polynomial.
A more traditional way is to write:
import Data.MemoTrie import Jam red = (`mod` (10^9 + 7)) main = jam $ do [r, c] < getints let mf d 0 = 1 mf d r = red $ g d (r  1) + h 6 2 + h 3 2 + h 4 3 where h p q  c `mod` p > 0  r < q = 0  otherwise = red $ gcd d p * g (lcm d p) (r  q) g _ 0 = 1 g _ 1 = 0 g d r = f d (r  2) f = memo2 mf pure $ show $ red $ f 1 r + f 1 (r  2)
However, this approach is terrifying. We only get one attempt at the large
dataset. If we forget calls to red
, then our solution is wrong. Furthermore,
there is no way to catch such a bug with the small input.
Perhaps a safer approach is to use Data.Modular
, which uses a GHC extension:
{# LANGUAGE DataKinds #} import Data.MemoTrie import Data.Modular import Jam main = jam $ do [r, c] < getints let mf :: Int > Int > Mod Integer 1000000007 mf d 0 = 1 mf d r = g d (r  1) + h 6 2 + h 3 2 + h 4 3 where h p q  c `mod` p > 0  r < q = 0  otherwise = fromIntegral (gcd d p) * g (lcm d p) (r  q) g _ 0 = 1 g _ 1 = 0 g d r = f d (r  2) f = memo2 mf pure $ show $ f 1 r + f 1 (r  2)
There’s a different hairraising aspect of this code. The modulus must be a
constant. Instead of 10^9 + 7
, we must write the number in full. Woe betide
us if we miss a zero! Fortunately, the problem also shows this constant in
full, and we can copyandpaste it to be on the safe side.