Google Code Jam Qualification Round 2022

.gitignore

@@ -0,0 +1,3 @@
+a.out
+*.hi
+*.o

gcj/2022/2022qual/A.hs

@@ -0,0 +1,14 @@
+import Control.Monad
+import Text.Printf
+
+main :: IO ()
+main = do
+  re <- readLn :: IO Int
+  forM_ [1..re] $ \ri -> do
+    [r, c] <- fmap read . words <$> getLine
+    let
+      x = concat $ replicate (c - 1) "-+"
+      y = concat $ replicate (c - 1) ".|"
+    printf "Case #%d:\n..+%s\n..|%s\n+-+%s\n" ri x y x
+    forM_ [2..r] $ \_ -> do
+      printf "|.|%s\n+-+%s\n" y x

gcj/2022/2022qual/B.hs

@@ -0,0 +1,18 @@
+import Control.Monad
+import Data.Functor
+import qualified Data.ByteString.Char8 as C
+
+main :: IO ()
+main = do
+  re <- readInt <$> C.getLine
+  forM_ [1..re] $ \ri -> do
+    as <- replicateM 3 $ fmap readInt . C.words <$> C.getLine
+    let
+      b = foldl1 (zipWith min) as
+    putStrLn $ "Case #" <> show ri <> ": " <> case go 1000000 b of
+      Just ans -> unwords $ map show ans
+      Nothing -> "IMPOSSIBLE"
+  where
+    readInt s = let Just (i, _) = C.readInt s in i :: Int
+    go r [] = guard (r == 0) $> []
+    go r (x:xs) = let y = min r x in (y:) <$> go (r - y) xs

gcj/2022/2022qual/C.hs

@@ -0,0 +1,17 @@
+import Control.Monad
+import qualified Data.ByteString.Char8 as C
+import Data.List
+import Text.Printf
+
+main :: IO ()
+main = do
+  re <- readInt <$> C.getLine
+  forM_ [1..re] $ \ri -> do
+    _ <- C.getLine
+    ds <- fmap readInt . C.words <$> C.getLine
+    printf "Case #%d: %d\n" ri $ go 0 $ sort ds
+  where
+    readInt s = let Just (i, _) = C.readInt s in i :: Int
+    go n x = case dropWhile (<=n) x of
+      [] -> n
+      (_:y) -> go (n + 1) y

gcj/2022/2022qual/D.hs

@@ -0,0 +1,29 @@
+import Control.Monad
+import Data.Array
+import qualified Data.ByteString.Char8 as C
+import Text.Printf
+
+main :: IO ()
+main = do
+  re <- readInt <$> C.getLine
+  forM_ [1..re] $ \ri -> do
+    n <- readInt <$> C.getLine
+    f <- listArray (1, n) <$> readInts
+    p <- readInts
+    let
+      c = accumArray (flip (:)) [] (0, n) $ zip p [1..]
+      dfs v
+        | null ws = (fv, fv)
+        | m > fv = (s, m)
+        | otherwise = (s - m + fv, fv)
+        where
+          fv = f!v
+          ws = c!v
+          (ss, ms) = unzip $ map dfs ws
+          s = sum ss
+          m = minimum ms
+      ans = sum $ map (fst . dfs) $ c!0
+    printf "Case #%d: %d\n" ri ans
+  where
+    readInt s = let Just (i, _) = C.readInt s in i :: Int
+    readInts = fmap readInt . C.words <$> C.getLine

gcj/2022/2022qual/E.hs

@@ -0,0 +1,81 @@
+{-# LANGUAGE RecordWildCards #-}
+
+import Control.Monad
+import Control.Monad.IO.Class
+import Control.Monad.State.Lazy
+import qualified Data.IntMap.Strict as Map
+import Data.Maybe
+import qualified Data.Sequence as Seq
+import System.IO
+import System.Random
+
+getResp :: IO (Int, Int)
+getResp = do
+  (r:p:_) <- fmap read . words <$> getLine
+  return (r, p)
+
+shuffle :: RandomGen g => g -> [Int] -> [Int]
+shuffle g list = go (Seq.fromList list) `evalState` g
+  where
+  go s
+    | Seq.null s = return []
+    | otherwise = do
+      i <- state $ randomR (0, Seq.length s - 1)
+      case Seq.splitAt i s of
+        (l, m Seq.:<| r) -> (m:) <$> go (l <> r)
+        _ -> return []
+
+data S = S
+  { todo :: [Int]
+  , fromt :: Map.IntMap Int
+  , fromw :: Map.IntMap Int
+  } deriving Show
+
+solve :: Int -> Bool -> StateT S IO ()
+solve k w
+  | k == 0 = return ()
+  | w = do
+    liftIO $ putStrLn "W"
+    (r, p) <- liftIO getResp
+    modify' $ \s -> s
+      { fromw = Map.insert r p $ fromw s
+      }
+    solve (k - 1) False
+  | otherwise = do
+    m <- gets $ listToMaybe . todo
+    modify' $ \s -> s{ todo = tail $ todo s }
+    case m of
+      Nothing -> return ()
+      Just r -> do
+        visited <- gets $ Map.lookup r . fromw
+        (used, p) <- case visited of
+          Just p -> return (0, p)
+          Nothing -> do
+            liftIO $ putStrLn $ "T " <> show r
+            (_, p) <- liftIO getResp
+            return (1, p)
+        modify' $ \s -> s
+          { fromt = Map.insert r p $ fromt s
+          }
+        solve (k - used) (p == 1)
+
+main :: IO ()
+main = do
+  hSetBuffering stdout LineBuffering
+  re <- readLn
+  replicateM_ re $ do
+    (n, k) <- getResp
+    (r, p) <- getResp
+    g <- newStdGen
+    let
+      s0 = S
+        { todo = shuffle g $ filter (/=r) [1..n]
+        , fromt = Map.singleton r p
+        , fromw = Map.empty
+        }
+    S{..} <- solve k (p == 1) `execStateT` s0
+    let
+      ceil a b = (a + b - 1) `quot` b
+      fromtOnly = fromt `Map.difference` fromw
+      ans = ceil (sum fromw + ceil (sum fromtOnly * (n - length fromw)) (length fromtOnly)) 2
+    putStrLn $ "E " <> show ans