AtCoder Beginner Contest 356-357 振り返り

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

## 結果

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

## ABC356

### A問題

- [問題](https://atcoder.jp/contests/abc356/tasks/abc356_a)
- [回答](https://atcoder.jp/contests/abc356/submissions/54089529)

リストを繋げました

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

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

### B問題

- [問題文](https://atcoder.jp/contests/abc356/tasks/abc356_b)
- [自分の回答](https://atcoder.jp/contests/abc356/submissions/54106152)

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

```haskell
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)

- [問題文](https://atcoder.jp/contests/abc356/tasks/abc356_c)
- [回答1](https://atcoder.jp/contests/abc356/submissions/54139680)

`subsequences`からSetを作り、入力値と`intersection`して両方にあるkeyを取得します。ここからSetのsizeを取得すると答えが得られます。（[naoyaさんの回答](https://atcoder.jp/contests/abc356/submissions/54144974)を参考にしました）

```haskell
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](https://atcoder.jp/contests/abc356/submissions/54260245)

bit全探索で解きます。bitに変換して論理積を取り、1の数をカウントします。
[toyboot](https://atcoder.jp/contests/abc356/submissions/54095507)さんの回答を参考にしました。

```haskell
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問題

- [問題](https://atcoder.jp/contests/abc357/tasks/abc357_a)
- [回答](https://atcoder.jp/contests/abc357/submissions/54342566)

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

```haskell
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`した方がすっきり書けますね

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

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

### B問題

- [問題](https://atcoder.jp/contests/abc357/tasks/abc357_b)
- [回答](https://atcoder.jp/contests/abc357/submissions/54346173)

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

```haskell
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)

- [問題](https://atcoder.jp/contests/abc357/tasks/abc357_c)
- [回答](https://atcoder.jp/contests/abc357/submissions/54381474)

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

```haskell
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](https://atcoder.jp/contests/abc356/submissions/54263425)
  - [問題B](https://atcoder.jp/contests/abc356/submissions/54320642)
  - [問題C](https://atcoder.jp/contests/abc356/submissions/54390888)

- ABC357
  - [問題A](https://atcoder.jp/contests/abc357/submissions/54390880)
  - [問題B](https://atcoder.jp/contests/abc357/submissions/54390934)
  - [問題C](https://atcoder.jp/contests/abc357/submissions/54391110)