EuroPython 2013
Let’s move on to EuroPython 2013. We’ll reuse our Jam module.
Moist
For each incoming element, if it is larger than our current maximum, it becomes the new maximum and requires no additional cost because it is already in the right location. Otherwise, we add one dollar to our running total cost.
import Jam main = jam $ \(_n:s) -> let n = read _n (a:as, s1) = splitAt n s f a [] acc = acc f a (b:bs) acc = if b > a then f b bs acc else f a bs (acc + 1) in (,) s1 $ show $ f a as 0
Captain Hammer
A little elementary physics shows the answer for each case is:
1/2 asin (9.8 D / V^2)
As asin returns its result in radians we multiply this by 180 / pi.
Some care is needed. Due to floating point rounding error, computing 9.8 * d then dividing by v^2 could lead to the wrong answer. Instead, we compute 98 * d / (10 * v^2), which postpones the rounding.
import Jam import Text.Printf main = jamLiner $ \s -> let [v, d] = mrw s :: [Double] in printf "%.7f" $ 180 / pi * asin (98 * d / (10 * v^2)) / 2
Bad Horse
If we strip away the cute setup, we see the problem is just asking whether the input is a bipartite graph.
Haskell has a Data.Graph module, but this seems to lack routines for bipartite graphs. This is just as well, as it means we get to practice graph algorithms in Haskell.
We use the standard depth-first search algorithm. Briefly, we alternately colour the nodes we encounter black and white. If we reach a visited node, then if its colour differs from the colour we would assign it if it were unvisited, then we know there is a cycle of odd length and hence the graph cannot be bipartite.
We use an array of type Maybe Int with inefficient updates to record the colours of the nodes: Nothing means the node is unvisited, otherwise the colour is 0 or 1.
Haskell provides components function, which we use for slightly simpler code.
import Jam
import Data.Array
import Data.List
import Data.Maybe
import Data.Graph
import Data.Tree
main = jam $ \(_n:s) -> let
(_es, s1) = splitAt (read _n) s
names = nub $ concatMap words _es
bnds = (0, length names - 1)
toEdges [v, w] = [(v, w), (w, v)]
g = buildG bnds $ concatMap
(toEdges . map (fromJust . (`elemIndex` names)) . words) _es
bi a c v = case a!v of
Nothing -> foldl' (\(b, a) w -> let (b', a') = bi a (1 - c) w
in (b && b', a')) (True, a // [(v, Just c)]) (g!v)
Just x -> (x == c, a)
blank = listArray bnds $ repeat Nothing
in (,) s1 $ case and $ map (fst . bi blank 0 . rootLabel) $ components g of
True -> "Yes"
False -> "No"
As usual, we should practice writing a brute-force solution for training purposes. For this, we simply iterate through all subsets of the league until we find a subset that contains exactly one vertex of each edge.
We use a mind-blowing Haskell trick to enumerate all subsets of a set (filterM (const [True, False])).
import Jam
import Control.Monad
import Data.List
main = jam $ \(_n:s) -> let
n = read _n
(_es, s1) = splitAt n s
es = map words _es
names = nub $ concat es
separates s = and $ map (\[x, y] -> elem x s /= elem y s) es
in (,) s1 $ case find separates (filterM (const [True, False]) names) of
Nothing -> "No"
_ -> "Yes"
For some reason, the practice page only provides small data sets so brute force is enough to achieve a full score.
Professor Normal
The inputs are far too large for a straightforward simulation of the game. We must think of something smarter.
Define the delta of a turn to be the MxN array that represents the change in the number of marbles each child possesses after that turn.
Suppose that after a turn, no child is eliminated. That is, each child still has at least 12 marbles. Then the next turn, each child will give and receive the same number of marbles they gave and received in the previous round, that is, the delta for the next turn is identical.
Thus until a child is eliminated, we can easily predict the number of marbles each child holds in dt turns: just add that child’s delta value multiplied by dt. By the same token, we can also easily determine which child, if any, is the next to be eliminated: for each negative delta value, a suitably crafted division tells us how many turns the child has left.
This suggests a simple algorithm:
-
Eliminate any children with less than 12 marbles or have no neighbours that have at least 12 marbles. If there are no children left, then print the number of elapsed turns.
-
Compute the delta array for the remaining children.
-
Examine the negative delta values to determine dt, the number of turns before a child must leave the game. If there are no negative delta values, then the remaining children play forever.
-
Adjust the marble counts by dt times delta, and go to step 1.
Because this is Haskell, we must take care with arrays. We use accumArray instead of updating an existing array one element at a time (which behind the scenes is equivalent to an array copy).
We also order the checks for the terminating conditions so we compute rem only when absolutely necessary.
import Jam
import Data.Array
import Data.List
neighbours a (i, j) = [(x, y) | (di, dj) <- [(-1, 0), (1, 0), (0, -1), (0, 1)],
let (x, y) = (i + di, j + dj), inRange (bounds a) (x, y), a!(x, y) >= 12]
cull a = a // [(i, 0) | i <- indices a, a!i < 12 || null (neighbours a i)]
play t a0 = let
bnds = bounds a0
a1 = cull a0
delta = accumArray (+) 0 bnds $ concat [(i, -12) : let ns = neighbours a1 i
in [(n, div 12 (length ns)) | n <- ns] | i <- range bnds, a1!i >= 12]
rem = length $ filter (> 0) (elems a1)
ttl = [1 + ((a1!i - 12) `div` (-delta!i)) | i <- range bnds, delta!i < 0]
dt = foldl1' min ttl
in if not $ null ttl then
play (t + dt) $ array bnds [(i, a1!i + dt * delta!i) | i <- range bnds]
else if rem == 0 then show t ++ " turns" else
show rem ++ " children will play forever"
main = jam $ \(_m:_n:s) -> let
m = read _m
n = read _n
(rows, s1) = splitAt m s
a = listArray ((1, 1), (m, n)) $ concatMap mrw rows
in (,) s1 $ play 0 a