1
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 1 year has passed since last update.

ABC322 A~E をHaskellで

Last updated at Posted at 2023-10-02

残課題

  • D問題のコンパクトな解答例を分析 追記
  • F問題

A - First ABC 2

問題 ABC322A

シグネチャを決めている間に実装も終わってしまった。
Data.ListtailsisPrefixOfを使い、末尾に番兵として-1を置く。

import Data.List

abc322a :: String  -- S
        -> Int     -- 答え
abc322a s = fst $ head $ (++ [(-1, "")]) $ filter (isPrefixOf "ABC" . snd) $ zip [1..] $ tails s

反復計算を手書きすることもできる。

abc322a1 s = loop 1 s
  where
    loop k ('A':'B':'C':_) = k
    loop k (_:s) = loop (succ k) s
    loop _ "" = -1

B - Prefix and Suffix

問題 ABC322B

やはりData.ListisPrefixOfisSuffixOfを使えばすぐ終わってしまう。

import Data.List

abc322b :: Int     -- N
        -> Int     -- M
        -> String  -- S
        -> String  -- T
        -> Int     -- 答え
abc322b _n _m s t =
  case (isPrefixOf s t, isSuffixOf s t) of
    (True,  True) -> 0
    (True, False) -> 1
    (False, True) -> 2
    _             -> 3

出力の場合分けを減らす方法 by AngrySadEightを使って、二つの判定結果を二進数のビットに対応させることもできる。

abc322b _n _m s t =
  if isPrefixOf s t then 0 else 2 +
  if isSuffixOf s t then 0 else 1

isPrefixOfisSuffixOfの再実装は教科書レベルの練習問題だが、特に後者は与えられるリストの長さが欲しくなるので、$N, M$ が初めから与えて貰えるのはありがたい。(前者は再帰的に書けば長さを使わずに書ける。)

abc322b n m s t = if pre then 0 else 2 + if suf then 0 else 1
  where
    pre = s == take n t
    suf = s == drop (m - n) t

C - Festival

問題 ABC322C

シグネチャを決める。

abc322c :: Int   -- N
        -> Int   -- M
        -> [Int] -- Ai
        -> [Int] -- 答え

結果

期間中の全ての日について順に答える必要があるので、順に調べていけばよい。
つまり、$[A_i]$の先頭と今日の日付との差が当日に対する答えで、これが0であった場合は花火が終わったのでそれを取り払って続ける。

abc322c n m as = loop 1 as
  where
    loop k (a:as) | k == a    = 0     : loop (succ k) as
                  | otherwise = a - k : loop (succ k) (a:as)
    loop _ [] = []

公式とか

公式解説の二分探索は大げさすぎるし、累積和もどうして出てきたのか理解できない。
$A_i$を詰め込んだ配列を二分探索して、$k$ 以上の最小の $A_i$ を取り出したら、そこから $k$ を引くだけのことでは。
Haskellで似たようなことをするならこうなる。

import qualified Data.IntSet as IS

abc322c :: Int -> Int -> [Int] -> [Int]
abc322c n _m as = [ai - k | k <- [1..n], let Just ai = IS.lookupGE k is]
  where
    is = IS.fromAscList as

同じく公式解説の$O(N)$の解も、ひとつめの解答の流儀でやれば

#include <iostream>
using namespace std;

int main() {
  int n,m;
  cin >> n >> m;
  int a[m];
  for (int i = 0; i < m; i++) { cin >> a[i]; }
  int j = 0;
  for (int k = 1; k <= n; k++) {
    int ans = a[j] - k;
    cout << ans << endl;
    if (ans == 0) { j++; }
  }
}

これだけなんだが。
(ちなみに、a[]を作らずに、必要になるつど1つずつ読み込むというやり方でもできてしまう。)
アライさんもやはり、後ろから作らないと!という同じ考えに囚われてる。

Haskell版41msに対してC++版214mscinが遅いの?)

D - Polyomino

問題 ABC322D

シグネチャを決める。
何というか面倒なので入力を改行文字込みでまるごと受け取ることにする。

abc322d :: String  -- [Pijk]
        -> Bool    -- 答え

考える

二次元配列をちまちま塗りつぶしする問題は面倒だから嫌い…
$P_{i,j,k} = \texttt{'#'}$ であるような座標 $(i,j)$ の集合、とかで富豪的に対処することも選択肢にはあるが、よく見ると盤面はたかだか16マスなので、16ビットの二進数で表現してしまえばコンパクトで実行も速いだろう。

まず、ビットマップの情報であることを型に表現する。

import Data.Bits

type Bitmap = Int

16文字の #. の列を Bitmap に変換する。

s2i :: String -> Bitmap
s2i = foldl step 0
  where
    step acc '#' = shiftL acc 1 .|. 1
    step acc _   = shiftL acc 1

4x4の盤面を回転させたとき、ある位置のマスはどのビットに移動するかを算出しておく(rotMap)。
回転は、行列の転置と反転に等しい。
その対応付けを使って、ビットマップを回転させる関数を定義する。

rot4 :: Bitmap -> [Bitmap]
rot4 = take 4 . iterate rot1
  where
    rot1 n = foldl' (.|.) 0 [b | (i,b) <- zip [0..] rotMap, testBit n i]
    rotMap = concat $ reverse $ transpose $ chunksOf 4 $ map bit [0..15]

最上行(ビット番号0~3)がオール0のとき、1行上に詰めることを繰り返して、上端を合わせる。
同様に最左列(ビット番号0,4,8,12)がオール0のとき、1列左に詰めることを繰り返して、左端を合わせる。
こうしてビットマップが正規化される。

regularize :: Bitmap -> Bitmap
regularize = reg m048C 1 . reg m0123 4
  where
    reg m k = until ((0 /=) . (m .&.)) (flip shiftR k)
    m0123 = 15
    m048C = foldl1 (.|.) $ map bit [0,4,8,12]

回転させて正規化させたポリオミノを、今度は最大16カ所の位置に平行移動したバリエーションを作りたい。
上のregとは逆に、マスクがオール0ではなくなるまで、指定した幅のシフトを行った結果を列挙する。

-- 指定方向にシフトしたバリエーションを作る
shiftVars :: Bitmap -> Int -> Bitmap -> [Bitmap]
shiftVars m k n = loop n
  where
    loop n
      | m .&. n /= 0 = [n]
      | otherwise = n : loop (shiftL n k)

-- 下と右にシフトしたバリエーション最大16種を作る
vhVars :: Bitmap -> [Bitmap]
vhVars x =
  [ z
  | y <- shiftVars m37BF 1 x
  , z <- shiftVars mCDEF 4 y
  ]
  where
    m37BF = foldl1 (.|.) $ map bit [3,7,11,15]
    mCDEF = foldl1 (.|.) $ map bit [12..15]

ここまで準備ができたら、3つのポリオミノの回転と並行移動の全てのバリエーションで組み合わせ、
重なりがなく、並べたら全てのマスを覆うような組み合わせがあるかを判定する。

abc322d :: String -> Bool
abc322d s = ans
  where
    [o1,o2,o3] = map (s2i . concat) $ chunksOf 4 $ lines s
    ans = or
      [ True
      | x1 <- rot4 o1, x1v <- vhVars $ regularize x1
      , x2 <- rot4 o2, x2v <- vhVars $ regularize x2
      , x1v .&. x2v == 0, let x12 = x1v .|. x2v
      , x3 <- rot4 o3, x3v <- vhVars $ regularize x3
      , xor x12 x3v == 2^16 - 1
      ]

公式とか

ビット演算による実装 by Kiri8128

横向きのときは2進法、縦向きのときは32進法と思って

とは?とコードを見た。
入力文字列の.0#1に置き換えた後、指定した基数で読み込む関数で一気に読み込む、
2進数を指定しておいて、1行4文字ずつ読み込んだ結果を4ビットシフトしてはORしていけば横向き、
16進数を指定して読み込むと4ビット間隔で読み取られるので、行ごとの結果を1ビットシフトしてはORしていけば縦向き、ということだった。
(解説は、あふれ検出用に1マス余計に使う設計なので32進数)

その解説の提出コードがかなりコンパクトなので、もうちょっと調べるべきか。
(追記しました。)

E - Product Development

問題 ABC322E

シグネチャを決める。$C_i, A_{i,j}$は手抜きする。

abc322e :: Int  -- N
        -> Int  -- K
        -> Int  -- P
        -> [[Int]]  -- Ci,Aij
        -> Int  -- 答え

問題設定にぎょっとするが、$K,P \leq 5$ と小さくて、パラメータが$P$を超えた状況は$P$にクランプしてしまえばよくて、状態数はたかだか $(P+1)^K = 7776$ である。
パラメータの状態をキーに、その状態に到達するための最小コストを持つ配列を作り、個々の開発案を実行したときの変化により修正するDPを行えばよい。

結果

状態の次元数 $K$ が変動するので、配列でなく IntMap でもない Map で直接実現した。

import qualified Data.Map as M

abc322e :: Int -> Int -> Int -> [[Int]] -> Int
abc322e n k p cas = M.findWithDefault (-1) (replicate k p) mN
  where
    m0 = M.singleton (replicate k 0) 0
    mN = foldl' step m0 cas

    step m (c:as) =
        M.unionWith min m $                   -- 安い方をそれぞれ選ぶ
        M.mapKeysWith min (zipWith add as) $  -- キーにAi1~AiKを足し込んで
        M.map (c +) m                         -- コストをCi増やして

    add x y = min p (x + y)             -- Pでクランプする加算

F - Vacation Query

嫌な気がして解説を見たら、案の定「F問題は遅延セグ木の練習問題なのだ!」と言われてしまった。だよねー。

これについては後日追記の宿題ということで…

追記

D問題(1)

ひとつめのポリオミノは回転させる必要はない。確かに。
1行差し替えることで時間を1/4にできる。

      | x1v <- vhVars $ regularize o1

D問題(2)

2進数解答のコンパクトなコードを読み解く。

def I():
# 行を読み込み、.#と01に置き換える、を4回やる、つまりポリオミノ入力をひとつ取り込む
    inp = [input().replace(".", "0").replace("#", "1") for _ in range(4)]
# 逆順にして、2進数で解釈しては、5ビットずつシフトして足し合わせる、つまり横に逆に見る
    a = sum([int(inp[i][::-1], 2) << 5 * i for i in range(4)])
# 正順のままで2進数に解釈し、シフト量を行の逆にして足し合わせる、つまりaの180度回転
    b = sum([int(inp[i], 2) << 5 * (3 - i) for i in range(4)])
# 正順のままで32進数に解釈し、1ビットずつシフトして足し合わせる、つまり縦に見る
    c = sum([int(inp[i], 32) << i for i in range(4)])
# 逆順にしてから、シフト量を行の逆にして足し合わせる、つまり c の180度回転
    d = sum([int(inp[i][::-1], 32) << 3 - i for i in range(4)])
# とやったa,b,c,dを順に
    for x in (a, b, c, d):
# 最も小さい1のビットの値で割ると、1の位を1にする横方向の正規化になる
# しかし行をまたいでズレた異常な場合も込みで富豪的にやるという。
# その判定が、余白ビットが必要だった理由。
        x //= x & -x
        for i in range(20):
# 余白込み20ビット分シフトした結果全てを吐き出す。追い出してしまっても気にしない。
# ラスタースクロールしてしまっても気にしない。
            yield x << i

A, B, C = list(I()), list(I()), list(I())
for a in A:
    for b in B:
        for c in C:
# 余白や、21ビットめ以上の様子も含めて、欲しいところだけがちょうどぴったり1になっていることを確認する。
# 二つ同士を & したら 0 で、3つを | したらその値。cのループをショートカットしたりもしない。
            if 0 == a & b == a & c == b & c and a | b | c == 507375:
                print("Yes")
                exit()
print("No")

文字列に [::-1] と書くと後ろから取り出すとか、奇妙な構文だなぁ。

それよりも、余白をとった理由が悪魔的。
4x4のパターンを4x5のビットマップに納めておく。
自分のコードでは、(くそまじめに)左端や上端にぴったりになるまでずらして正規化したり、右端や下端ぴったりになるまでのバリエーションを作ったりしたが、
そうする代わりに、ビットマップの整数の最下位ビットに1がくるまで右シフトしきった状態を最初とする。
図形の角が # になっていればいいけれど、そうでないと、シフトしすぎてラスタースクロールで同期がずれた形になる可能性もある。
しかしここで、ポリオミノは#が連結であることから、問題があるずらし方ならば必ず、余白に # がはみ出すことで検出できる、というカラクリ。何というずる賢さ。
そして、全ての平行移動パターンを作るために、最下位ビットにシフトさせたそれが20ビットめに移動するまで、シフト量0~19を全て行う。
これも同様に正しくない形を含むし、20ビットより上の桁に1がはみ出すが、それも気にしない。
どうして気にしないでいけるかというと、3つのポリオミノを重ねたときの結果を、「4x5のビットのうち、4x4のところだけが1で、他は20ビットより上も含めて全て0」という値 507375 と比較しているから。

これは写経せざるを得ないので、書いておく。
無効なパターンを除去するようにした。

abc322d :: String -> Bool
abc322d s = ans
  where
    [o1,o2,o3] = chunksOf 4 $ map (map zeroone) $ lines s -- 01の4x4列
    ans = or
      [ True
      | q1 <- q1s
      , q2 <- q2s, q1  .&. q2 == 0, let q12 = q1 .|. q2
      , q3 <- q3s, q12 .&. q3 == 0, q12 .|. q3 == all1
      ]
    q1s = [q1 | let p1:_ = mat2bms o1, q1 <- vars20 p1]
    q2s = [q2 | p2 <- mat2bms o2, q2 <- vars20 p2]
    q3s = [q3 | p3 <- mat2bms o3, q3 <- vars20 p3]

zeroone :: Char -> Int
zeroone '#' = 1
zeroone _   = 0

type Bitmap = Int

all1, all1c :: Bitmap
all1 = head $ mat2bms [[1,1,1,1],[1,1,1,1],[1,1,1,1],[1,1,1,1]]
all1c = complement all1

-- 01の4x4列を正順、逆順、縦、縦の逆順のBitmapに変換
mat2bms :: [[Int]] -> [Bitmap]
mat2bms dss =
  [ f 1 5 (reverse (map reverse dss))
  , f 1 5 dss
  , f 5 1 (reverse dss)
  , f 5 1 (map reverse dss)]
  where
    g i = foldl (\acc x -> shiftL acc i .|. x) 0
    f i j dss = g j $ map (g i) dss

-- シフト位置最大16パターンを生成、異常品は除去する
vars20 :: Bitmap -> [Bitmap]
vars20 x = filter ((0 ==) . (all1c .&.)) $ take 20 $ iterate (flip shiftL 1) $ div x (x .&. negate x)

chunksOf :: Int -> [a] -> [[a]]
chunksOf _ [] = []
chunksOf n xs = let (as,bs) = splitAt n xs in as : chunksOf n bs

1msで動いたので上出来なのでは。

1
1
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
1
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?