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..j-1]]
edgy (i, j) '^' = dotty [(x, j) | x <- [1..i-1]]
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 floating-point 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 max-flow or min-cut between the first two nodes: the edges of a min-cut 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 Stoer-Wagner algorithm.
My textbooks from my undergraduate days predate these algorithms, and back then, min-cut was solved with max-flow, and global min-cut solved by trying min-cut 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 min-cut algorithms to solve a particular s-t min-cut 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 off-the-shelf 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..vn-1] $ 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 non-adjacent 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 non-3 pattern, or we can try to start with a non-3 pattern immediately.
A non-3 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 non-3 pattern. Thus we have outlined how to recursively count the number of ways of filling in an array starting with a non-3 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 hair-raising 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 copy-and-paste it to be on the safe side.