## Read Phone Number

The splitPlaces and group functions make short work of this problem.

import Jam import Data.Char import Data.List import Data.List.Split ns = words "zero one two three four five six seven eight nine" ms = "":"":"double":"triple":((++"uple") <$> words "quadr quint sext sept oct non dec") speak s@(c:_) | m == 1 || m > 10 = unwords $ replicate m d | otherwise = ms!!m ++ " " ++ d where d = ns!!digitToInt c m = length s main = jam $ do (n, f) <- (\[n, f] -> (n, map read $ splitOn "-" f)) . words <$> gets pure $ unwords $ map (unwords . map speak . group) $ splitPlaces f n

## Rational Number Tree

We solve question 1 by considering the binary expansion of n. The bits tell us whether to take the left or right path at each level.

For question 2, if the numerator exceeds the denominator, then we have just taken the right path, otherwise we have taken the left. We work backwards using this rule and build the index one bit at a time.

import Jam main = jam $ do (id:p:q) <- getintegers pure $ case id of 1 -> (\(p, q) -> show p ++ " " ++ show q) $ f p 2 -> show $ g p $ head q f 1 = (1, 1) f n | r == 1 = (a + b, b) | otherwise = (a, a + b) where (q, r) = divMod n 2 (a, b) = f q g p q | p > q = 1 + 2 * g (p - q) q | p < q = 2 * g p (q - p) | otherwise = 1

## Sorting

We use partition to separate odd and even numbers, sort them independently, then recursively put them back together, using the original list as a guide.

import Jam import Data.List import Data.Ord main = jam $ do gets ns <- getints let (as, bs) = partition odd ns pure $ unwords $ map show $ f [] (sort as) (sortBy (flip compare) bs) ns f acc [] [] [] = reverse acc f acc as bs (n:ns) | odd n = f (head as:acc) (tail as) bs ns | otherwise = f (head bs:acc) as (tail bs) ns

## Cross the maze

Tedious but straightforward.

If we start in the first row, facing east guarantees there will be a wall on our left, and similarly for facing west if we start in the last row.

If we start completely surrounded by walls, we immediately return Nothing, which represents failure. Otherwise we proceed with the left-hand rule; if we reach the exit within 10000 steps then we return Just the number of steps taken, otherwise we return Nothing.

import Jam import Data.Array import Data.Maybe main = jam $ do [n] <- getints as <- getsn n [sx, sy, ex, ey] <- getints let maze = listArray ((1, 1), (n, n)) $ concat as (dx, dy) | sx == 1 = (0, 1) | otherwise = (0, -1) f acc (x, y) (dx, dy) | (x, y) == (ex, ey) = Just $ reverse acc | length acc == 10000 = Nothing | not $ isWall (x + hx, y + hy) = go (hx, hy) | not $ isWall (x + dx, y + dy) = go (dx, dy) | otherwise = f acc (x, y) $ turnR (dx, dy) where (hx, hy) = turnL (dx, dy) go (dx, dy) = f (compass (dx, dy):acc) (x + dx, y + dy) (dx, dy) isWall (x, y) | x == 0 || y == 0 || x > n || y > n = True | otherwise = maze!(x, y) == '#' pure $ maybe "Edison ran out of energy." out $ if all (isWall . (\(dx, dy) -> (sx + dx, sy + dy))) [(0, 1), (1, 0), (0, -1), (-1, 0)] then Nothing else f "" (sx, sy) (dx, dy) compass ( 1, 0) = 'S' compass (-1, 0) = 'N' compass ( 0, 1) = 'E' compass ( 0, -1) = 'W' turnL (x, y) = (-y, x) turnR (x, y) = (y, -x) out s = show (length s) ++ "\n" ++ s

## Spaceship Defence

The inputs are obfuscated graphs. Each node is a colour, and each turbolift is an edge. When converting to a graph, we remove self-edges and only keep the edges of minimum weight.

Then we apply Dijkstra’s algorithm on each soldier to find the shortest paths.

import Jam import Data.Array import Data.List import Data.Ord import qualified Data.Map as M import qualified Data.Set as S main = jamLnCat $ do [n] <- getints cs <- getsn n [m] <- getints ts <- getintsn m [s] <- getints pqs <- getintsn s let aa = listArray (1, n) cs keepBest [x@(k, v)] ds = case lookup k ds of Nothing -> x:ds Just v' -> if v < v' then x:delete (k, v') ds else ds mm = M.fromListWith keepBest $ [(ca, [(cb, t)]) | [a, b, t] <- ts, let ca = aa!a, let cb = aa!b, ca /= cb] nbrs x = if x `M.notMember` mm then [] else mm M.! x shortest p q | p == q = 0 | otherwise = f S.empty (S.singleton p) q $ M.singleton p 0 f done todo q ds | null todo = -1 | x == q = c | otherwise = f (S.insert x done) (foldl' (flip S.insert) (S.delete x todo) (map fst u)) q $ foldl' (\ds (n,m) -> M.insertWith min n m ds) ds [(n, c + m) | (n, m) <- u] where x = minimumBy (comparing (ds M.!)) todo c = ds M.! x u = filter ((`S.notMember` done) . fst) $ nbrs x pure $ unlines $ map show $ [shortest (aa!p) (aa!q) | [p, q] <- pqs]

*blynn@cs.stanford.edu*💡