import Jam main = jam $ do [n] < getints (a:as) < getsn n let f a [] acc = acc f a (b:bs) acc  b > a = f b bs acc  otherwise = f a bs (acc + 1) return $ show $ f a as 0
EuroPython 2013
Let’s move on to EuroPython 2013.
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.
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 = jam $ do [v, d] < getdbls return $ 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 depthfirst 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 $ do [n] < getints es < map words <$> getsn n let names = nub $ concat es bnds = (0, length names  1) toEdges [v, w] = [(v, w), (w, v)] g = buildG bnds $ concatMap (toEdges . map (fromJust . (`elemIndex` names))) 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 return $ case all (fst . bi blank 0 . rootLabel) $ components g of True > "Yes" False > "No"
As usual, we should practice writing a bruteforce 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 mindblowing
Haskell trick to enumerate all subsets of a set
(filterM (const [True, False])
).
import Jam import Control.Monad import Data.List main = jam $ do [n] < getints es < map words <$> getsn n let names = nub $ concat es separates s = all (\[x, y] > elem x s /= elem y s) es return $ 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 $ do [m] < getints [n] < getints a < listArray ((1, 1), (m, n)) . concat <$> getintsn m return $ play 0 a