All Your Base

We already solved this recommended beginner problem, but we’ll write it again using our Jam monad:

import Jam
import Data.List
import Data.Maybe

main = jam $ do
  w <- gets
  let
    dict = case nub w of [d]        -> ['?', d]
                         (d0:d1:ds) -> d1:d0:ds
  pure . show
    $ foldl (\n d -> n * length dict + fromJust (d `elemIndex` dict)) 0 w

Center of Mass

A little algebra shows the distance of the center of mass from the origin, is a quadratic equation in t, with a positive leading coefficient. Differentiating with respect to t, or just by completing the square, the minimum occurs when:

xs*vxs + ys*vys + zs*vzs  == (vxs^2 + vys^2 + vzs^2) t

where xs ys zs vxs vys vzs are the sum of each of the six numbers, that is the three position coordinates and the three velocity coordinates, across all fireflies.

We are only interested in t >= 0 so if the minimum is attained for a negative t value, we clip it to t = 0. The leading cofficient is positive, hence the parabola opens upward, which implies the distance is smallest when t = 0 for this case. Thus:

import Jam
import Control.Monad
import Data.List
import Text.Printf

main = jam $ do
  [n] <- getints
  (ps, vs) <- splitAt 3 . foldl1' (zipWith (+)) <$> replicateM n getdbls
  let
    t0 = max 0 $ -(sum $ zipWith (*) ps vs) / (sum $ (^2) <$> vs)
    d0 = sqrt $ sum $ map ((^2) . (/ fromIntegral n)) $
      zipWith (+) ps $ map (*t0) vs
  pure $ printf "%.7f %.7f" d0 t0

We have gratuitiously applied list functions like sum and zipWith to avoid explicitly mentioning the three coordinates.

Bribe the Prisoners

Suppose we release some prisoner first. Once done, the prisoners on one side can no longer communicate with those on the other.

Thus, the minimum total cost is the number of filled cells in a row on either side, plus the sum of the two solutions to smaller instances of the same problem, namely, the sum of the minimum costs to release the remaining prisoners on each side of the released prisoner considered independently.

We turn this observation into a dynamic programming solution. We use sentinel values 0 and p + 1 to remove special cases with the edges of the priosn. Then, we consder releasing each prisoner in turn, relying on a memoized recursion to solve the subproblems, and return the cheapest solution, or 0 if there is nothing to do.

import Jam
import Data.Array
import Data.Maybe
import Data.MemoTrie
import Safe

main = jam $ do
  [p, _] <- getints
  qs <- getints
  let
    a = listArray (0, length qs + 1) $ (0:qs) ++ [p+1]
    f(i, j) = fromMaybe 0 $ foldl1May' min
      [a!j - a!i - 2 + g(i, k) + g(k, j) | k <- [i+1..j-1]]
    g = memo f
  pure $ show $ g $ bounds a

Ben Lynn blynn@cs.stanford.edu 💡