AtCoder Beginner Contest 356-357 振り返り

ABC356-357の振り返りです。前回の分書いてなかったので、2回分書きます。

結果

ABC356-357どちらも2完でした。

ABC356

A問題

• 問題
• 回答

リストを繋げました

main :: IO ()
main = do
  [n, l, r] <- readInputInts

  putStrLn $ unwords $ map show $ [1 .. l - 1] ++ L.reverse [l .. r] ++ [r + 1 .. n]

B問題

• 問題文
• 自分の回答

accumArrayで目標から摂取量を引いて行き、0を超えていたらtrueとしました。

main :: IO ()
main = do
  [n, m] <- readInputInts
  an <- readInputInts
  xnm <- replicateM n readInputInts

  let an' = zip [0 ..] an
  let lst = L.concatMap (zip [0 ..]) (map negate an : xnm)

  let sums = elems $ accumArray @UArray (+) (0 :: Int) (0, m - 1) lst

  putStrLn if all (>= 0) sums then "Yes" else "No"

C問題(upsolved)

• 問題文
• 回答1

subsequencesからSetを作り、入力値とintersectionして両方にあるkeyを取得します。ここからSetのsizeを取得すると答えが得られます。（naoyaさんの回答を参考にしました）

main :: IO ()
main = do
  [n, m, k] <- readInputInts
  xss <- replicateM m $ do
    (_ : xs) <- words <$> getLine
    return (Set.fromList $ map (read @Int) (init xs), last xs)

  let res =
        [ and
            [ if result == "o" then size >= k else size < k
              | (s, result) <- xss,
                let size = Set.size $ Set.intersection keys s
            ]
          | keys <- Set.fromList <$> subsequences [1 .. n]
        ]

  print $ length $ filter id res

• 回答2

bit全探索で解きます。bitに変換して論理積を取り、1の数をカウントします。
toybootさんの回答を参考にしました。

main = do
  [n, m, k] <- readInputInts
  xss <- replicateM m $ do
    (_ : xs) <- words <$> getLine
    let mask = map read $ init xs
    let mask' = L.foldl' (\acc i -> acc .|. bit (i - 1)) (0 :: Int) mask
    return (mask', head $ last xs)

  let test set =
        L.all
          ( \(mask, r) ->
              if r == 'o'
                then popCount (set .&. mask) >= k
                else popCount (set .&. mask) < k
          )
          xss
  print $ L.length $ L.filter test [0 .. bit n - 1]

ABC357

A問題

• 問題
• 回答

mからhを引いて行き、その数をcountしました。

main :: IO ()
main =
  do
    [_, m] <- readInputInts
    hs <- readInputInts

    let res =
          L.foldl'
            ( \(m', count) h ->
                if m' >= h
                  then (m' - h, count + 1)
                  else (0, count)
            )
            (m, 0)
            hs

    print $ snd res

あとで知ったのですが、累積和してtakeWhileした方がすっきり書けますね

main :: IO ()
main = interact $ show . f . map read . words

f (_ : m : r) = length . takeWhile (<= m) $ scanl1 (+) r

B問題

• 問題
• 回答

isUpperとisLowerで大文字小文字の数をカウントし、比較して処理します。

main :: IO ()
main =
  do
    s <- getLine

    let u = length $ L.filter C.isUpper s
    let l = length $ L.filter C.isLower s

    putStrLn if u > l then L.map C.toUpper s else L.map C.toLower s

C問題(upsolved)

• 問題
• 回答

再帰でグリッドを広げて行きます。グリッドでしょりするのでIOUArrayを使いました。

main :: IO ()
main =
  do
    n <- readLn @Int
    grids <- newArray @IOUArray ((1, 1), (3 ^ n, 3 ^ n)) '.'

    let n' = 3 ^ n `div` 2 + 1
    solve n grids (n', n')

    ((lowerX, lowerY), (upperX, upperY)) <- getBounds grids
    forM_ [lowerX .. upperX] $ \i -> do
      forM_ [lowerY .. upperY] $ \j -> do
        v <- readArray grids (i, j)
        putChar v
      putStr "\n"

solve :: (MArray a Char m, Ix b, Integral b, Integral t) => t -> a (b, b) Char -> (b, b) -> m ()
solve n grids (x, y) = case n of
  0 -> do
    writeArray grids (x, y) '#'
  otherwise -> do
    let n' = n - 1
    let diff = 3 ^ n'
    solve n' grids (x - diff, y - diff)
    solve n' grids (x, y - diff)
    solve n' grids (x + diff, y - diff)
    solve n' grids (x - diff, y)
    solve n' grids (x + diff, y)
    solve n' grids (x - diff, y + diff)
    solve n' grids (x, y + diff)
    solve n' grids (x + diff, y + diff)

全体を振り返って

なかなか伸びないですが、諦めず精進します！

おまけ Rustの回答

• ABC356

  • 問題A
  • 問題B
  • 問題C

• ABC357

  • 問題A
  • 問題B
  • 問題C