paizaの問題は書式の読み込みが一つの山になっている節もあるが、スルーする。

ランクD

文字の一致

問題

2 つの文字列 a, b が入力されます。文字列が一致していれば "OK" 、異なっていれば "NG" と出力してください。

solve :: String  -- a
      -> String  -- b
      -> String  -- 答え
solve a b = if a == b then "OK" else "NG"

一番小さい値

問題

5 つの正の整数が入力されるので、最も小さい数字を出力して下さい。

solve :: [Int]  -- n_i
      -> Int    -- 答え
solve ns = minimum ns

足し算

問題

２つの正の整数 a, b が半角スペース区切りで入力されるので a と b を足した数を出力してください。

solve :: Int -- a
      -> Int -- b
      -> Int -- 答え
solve a b = a + b

Eメールアドレス

問題

Eメールアドレスとはローカル部とドメインを「@」を繋いだ文字列で表されます。
ローカル部を s ,ドメインを t として、それぞれ長さ n の文字列が改行区切りで入力されます。
以下の構文に沿った文字列を出力してください。
s(ローカル部)@t(ドメイン)

solve :: String -- s
      -> String -- t
      -> String -- 答え
solve s t = s ++ '@' : t

N倍の文字列

問題

整数 N が入力されるので、N 個の * を繋げた文字列を出力するプログラムを作成しましょう。

solve :: Int    -- n
      -> String -- 答え
solve n = replicate n '*'

ランクC

宝くじ

問題

solve :: Int      -- b 当選番号
      -> Int      -- n 枚数
      -> [Int]    -- a_i 券の番号
      -> [String] -- 答え
solve b n as = map f as
  where
    b4 = mod b 10000
    b3 = mod b  1000
    f a
      | a == b = "first"
      | a == pred b || a == succ b = "adjacent"
      | mod a 10000 == b4 = "second"
      | mod a  1000 == b3 = "third"
      | otherwise = "blank"

2等3等は mod (a - b) 10000 == 0 としてもよかったか。

野球の審判

問題

状態を追跡する必要があるので面倒さがかなり上がる。

import Data.List

solve :: Int -- N
      -> [String] -- s_i
      -> [String] -- 答え
solve _n = snd . mapAccumL step (0,0)
  where
    step :: (Int,Int)  -- ストライク、ボールカウント
         -> String     -- s_i
         -> ((Int,Int) -- ストライク、ボールカウント
            , String)  -- 答え
    step (2,_) "strike" = ((0,0)     , "out!")
    step (s,b) "strike" = ((succ s,b), "strike!")
    step (_,3) "ball"   = ((0,0)     , "fourball!")
    step (s,b) "ball"   = ((s,succ b), "ball!")

でも mapAccumL がある、そう、Haskellならね。

みかんの仕分け

問題

ミカン箱は十分に種類があり、$N, 2N, \dots$ のラベルがついている。
$1 \leq w_i \leq N$ のミカンは問答無用で $N$ の箱に入れる。
$w_i \div N = q \dots r$ のとき、
- $qN$ の箱との差は $r$
- $(q+1)N$ の箱との差は $N-r$
- のうち、差が小さい方を選ぶ。ただし、等しいときは上の箱を選ぶ。
- 単純に、$r < N/2$ なら下、でいい。

solve :: Int   -- N
      -> Int   -- M
      -> [Int] -- w_i
      -> [Int] -- 答え
solve n _m = map f
  where
    n2 = div n 2
    f w
      | w <= n    = n
      | r < n2    = q * n
      | otherwise = succ q * n
      where
        (q,r) = divMod w n

$r < N/2$ なら下、ということは、この値で丸めるということで、

solve n _m = map f
  where
    ofs = div n 2
    f w = n * max 1 (div (w + ofs) n)

これで十分だった。

Fizz Buzz

問題

solve :: Int    -- N
      -> String -- 答え
solve n = unlines $ map fb [1 .. n]
  where
    fb i | mod i 15 == 0 = "Fizz Buzz"
         | mod i  3 == 0 = "Fizz"
         | mod i  5 == 0 = "Buzz"
         | otherwise     = show i

残り物の量

問題

$\displaystyle m \times \frac{100-p}{100} \times \frac{100-q}{100}$ を計算する。

solve :: Double -- m
      -> Double -- p
      -> Double -- q
      -> Double -- 答え
solve m p q = m * (100 - p) * (100 - q) / 10000

ランクB

3Dプリンタ

問題

Z枚の画像が、高さ方向のスライスをなす。逆順に、スライスごとに答えを求めて繋げればよい。
1枚の画像の横方向は、Y軸の向きである。出力の行のそれぞれの文字が対応する。
1枚の画像の縦方向は、空間の奥行き、X軸の向きである。ある列において、どこかに一つでもセルがあるなら、結果にはそれが見える。

import Data.List.Split

solve :: [Int]    -- X,Y,Z
      -> [String] -- Y文字の文字列XZ個
      -> [String] -- 答え
solve [x,y,z] css = reverse  -- 上から結果にするので逆順にする
  [ map f $ transpose cs     -- 列ごとに、'#'があれば'#'
  | cs <- chunksOf x css]    -- 画像ごとに区切る
  where
    f l = if elem '#' l then '#' else '.'

神経衰弱

問題

取り除かれ済みのチェックが不要なので、めくった結果が同じカードだったかをひたすら調べればよい。

import Data.Array
import Data.List

solve :: [Int] -- H,W,N
      -> [[Int]] -- t_ij
      -> Int  -- L
      -> [[Int]] -- a_i,b_i,A_i,B_i
      -> [Int] -- 答え
solve [h,w,n] tss l abcds = map sum $ transpose $ chunksOf n $ map f abcds
  where
    t = listArray ((1,1),(h,w)) $ concat tss
    f [a,b,c,d] = if t ! (a,b) == t ! (c,d) then 2 else 0

みんなでしりとり

問題

プレイヤーの順序は Data.Sequence でFIFOを作って並ばせる。
まだ使える語の Data.Set を管理する。
全員脱落という場合は考えなくてよい。
語を構成する文字の範囲が定義されていないと、制限なし状態の表現にもう1ビット余計に必要で困るんだが、まぁ . は出ないだろうと決めつける。

import qualified Data.Sequence as Q
import qualified Data.Set as S
import Data.Foldable
  
solve :: [Int] -- N,K,M
      -> [String] -- d_i
      -> [String] -- S_i
      -> [Int] -- 答え
solve [n,k,m] ds ss = toList ans
  where
    d0 = S.fromList $ filter (('z' /=) . last) ds -- 使える語の集合、zで終わるものは除く
    q0 = Q.fromList [1 .. n] -- プレイヤーの行列
    (_, qM, _) = foldl step (d0, q0, '.') ss -- ゲーム遂行
    step (dic, p Q.:<| ps, c) s
      | cond = (S.delete s dic, ps Q.|> p, last s)
      | otherwise = (dic, ps, '.') -- p は脱落
      where
        cond = and
          [ S.member s dic            -- 使ってよい語
          , c == '.' || c == head s ] -- しりとりになっているか、とらなくてよい場合
    ans = until justified rot qM -- 番号の最小の人が先頭にくるまで回す
    rot (p Q:<| q) = q Q.|> p
    justified q = p1 <= p2
      where
        p1 Q.:<| _ = q -- head
        _ Q.:|> p2 = q -- last

かなり長くなった。

長テーブルのうなぎ屋

問題

素直に状況をシミュレーションする。
人数やグループ数が多いと、区間更新セグメント木とか使うことになってくるけど。

solve :: Int -- n
      -> Int -- m
      -> [[Int]] -- ai, bi
      -> Int -- 答え
solve n _m abs = length $ filter id $ elems stM
  where
    st0 = accumArray (||) False (0, pred n) []
    stM = foldl step st0 abs
    step st (a:b:_)
      | or $ map (st !) is = st
      | otherwise = st // [(i, True) | i <- is]
      where
        is = [mod i n | i <- [b .. b + pred a]]

面倒なので immutable array の更新で済ませてしまった。

名刺バインダー管理

問題

見開きは無関係で、リフィル一枚、2n枚の名刺でひとまとまりで考える。
番号は内部的に0始まりで考える。すると、2nで割った余りが0～n-1の側と、n～2n-1の側に分かれる。

スロット	0	1	2	3	4
表	0	1	2	3	4
裏	9	8	7	6	5

表な $a$ はスロット $a$ に属し、その裏には $2n - 1 - a$ がある。
裏な $b$ はスロット $2n - 1 - b$ に属し、その表には $2n - 1 - b$ がある。

場合分けをしたが、求める式は結局同じになった。
カード $m$ は、$(m - 1) \div 2n = q \dots r$ のとき、(0始まり) $q$ 番目の束の(0始まり) $r$ 番目のカードで、その裏は同じ束の $2n - 1 - r$ 番目のカード。
それはカード $q \cdot 2n + 2n - 1 - r + 1$ (1始まり)
$m - 1 = 2nq + r$ を代入すると $m - 1 + 2(n - r)$ となる。$q$ も不要になった。

solve :: Int -- n
      -> Int -- m
      -> Int -- 答え
solve n m = m1 + 2 * (n - mod m1 (n + n))
  where
    m1 = pred m

ランクA

本の整理

問題

反転数とは違うのね。
$N \leq 10^5$ と割と大きいけれど、最悪でも $N-1$ 回交換すれば終わり（例：5 1 2 3 4）なので、1ステップがO(1)で計算できるように命令型配列を使ってシミュレーションすれば解ける。
ただしそのためには、場所 $i$ のときには番号 $i$ の本のある位置 $j$ ($i \leq j$) を走査することなく見つける必要があるので、その逆引き表も維持する必要がある、

位置 $i$ を調べて、そこにある本が番号 $i$ なら何もしなくていい。
番号 $x \neq i$ のとき、逆引き表で本 $i$ のある位置 $j$ も調べる。
（位置jにあった）本iを位置iに、（位置iにあった）本xを位置jに動かす。

	位置i	位置j	本i	本x
操作前	本x	本i	位置j	位置i
操作後	本i	本x	位置i	位置j

この4箇所の更新をする。しかし位置 $i$ 本 $i$ はこれで正しい位置に納まり、二度と気に掛けられることはないので、位置 $j$ と本 $x$ についてだけ配列を更新すれば用は足りる。

import Data.Array.ST
import Control.Monad.ST
import Control.Monad

solve :: Int -- N
      -> [Int] -- a_i
      -> Int -- 答え
solve n as = runST $
  do
    loc2id <- newListArray (1,n) as  :: ST s (STUArray s Int Int) -- 位置iにある本の番号
    id2loc <- newArray_ (1,n)  :: ST s (STUArray s Int Int)
    forM_ (zip as [1..]) (uncurry (writeArray id2loc)) -- 番号iの本の位置
    foldM (\cnt i -> do
      x <- readArray loc2id i -- 位置iにある本
      if x == i then return cnt else do -- が本iなら何もしない
        j <- readArray id2loc i -- 番号iの本のある位置 ≠ i
        writeArray loc2id j x
        writeArray id2loc x j
        return (succ cnt) -- カウントアップ
      ) 0 [1 .. n] -- 本 i = 1 から n について、

山折り谷折り

問題

$N$ 回折りたたんで何回か開いたために、何本か折れ線のはいった紙が目の前にあるとする。
折れの状況を、谷折り False 山折り True のリスト bs で表す。
さて、これをもう一度開くと、左半分は bs と同じ折れ目、中央に谷折りが1つふえて、開かれた右半分には、折り方と向きの両方が逆になった折れ目が同じだけ続く。
つまり一度開くと bs ++ False : reverse (map not bs) になる。

折っただけで一度も開いていない紙は、折り目のない真っ平らな紙に見える。
bs0 = []から始めて、上のステップを $N$ 回繰り返した結果が答えである。

ただ、折り方がこの向きだとHaskellのリストと相性がよくないので、机の向こうから見た視点で考え、最後に全体を逆向きにする。

solve :: Int -- N
      -> String -- 答え
solve = map f . reverse . iter
  where
    f True  = '1'
    f False = '0'
    iter 0 = []
    iter n = reverse (map not bs) ++ False : bs
      where
        bs = iter (pred n)

ハノイの塔

問題

円盤の数に寄らず

は「依らず」かな。

円盤1を X から Y に動かすには、そうする。
円盤1からK(≧2) を X から Y に動かすには、
- 円盤1からK-1を X から Z に動かす
- 円盤Kを X から Y に動かす
- 円盤1からK-1を Z から Y に動かす
  を順にする。

この手順を t 個めまでベタにシミュレーションしても $n \leq 16$ なら間に合うだろう。
しかしもっと高速に答えに至るには、上の手続きで消費する手数を考慮して、もしその手続きは完了してしまうなら終了状態に、途中で止まるならさらに中に入る、とすればできそう。

円盤1～Kを動かす手続きのステップ数 $S_K$ は、
$S_1 = 1$
$S_K = 2 S_{K-1} + 1$
これは高校数学の問題で $S_K = 2^K -1$ とわかる。

solve :: Int -- n
      -> Int -- t
      -> String -- 答え
solve n t = unlines $ map f $ solve1 n t
  where
    f [] = "-"
    f ns = unwords $ map show $ reverse ns

solve1 :: Int -> Int -> [[Int]]
solve1 n t
  | t == count n = [[], [], [1 .. n]]
  | otherwise    = recur st0 n 0 2 1 t
  where
    st0 = [[1 .. n], [], []]
    count k = pred $ 2 ^ k
    recur :: [[Int]] -- 状況（前が上）
          -> Int     -- K
          -> Int     -- X 開始軸
          -> Int     -- Y 終了軸
          -> Int     -- Z 仮置き場軸
          -> Int     -- t (0 ≦ t ≦ count K)
          -> [[Int]] -- 答え
    recur st 0 _ _ _ 0 = st
    recur st k x y z t =
      case compare t (succ ck1) of
        LT -> recur st k1 x z y t
        EQ -> st1
        GT -> recur st1 k1 z y x (pred t - ck1)
      where
        k1 = pred k
        ck1 = count k1
        (dx1, w : dx2) = splitAt k1 $ st !! x
        dy = st !! y
        dz = st !! z
        st1 = map snd $ sort [(x, dx2), (y, w : dy), (z, dx1 ++ dz)]

じゃんけんの手の出し方

問題

相手が出す手が順に与えられるが、それは目くらましで、3つの手がそれぞれ何回なのかだけ気にすればよい。

自分の出す指の総数はMちょうどにしないといけないので、パーの回数とチョキの回数の可能なやり方、そして残りの手番は全てグーになる。その可能な全ての場合でもっともスコアがよいものを答える。

グーチョキパーそれぞれについて、自分の出す予定の数と、それに負ける手を相手が出す回数のうち、小さい方がその手で勝つ回数になる。負けとアイコは気にしなくていいので、余った手でどうなるかは気にしなくてよい。

solve :: Int    -- N
      -> Int    -- M
      -> String -- s
      -> Int    -- 答え
solve n m s = maximum
      [ min pa oppGu + min cho oppPa + min gu oppCho
      | pa <- [0 .. min n $ div m 5] -- パーを出す回数
      , (cho, 0) <- [divMod (m - 5 * pa) 2]-- チョキを出す回数、ただし割り切れること
      , pa + cho <= n -- 出し過ぎない
      , let gu = n - pa - cho -- グーを出す回数
      ]
  where
    count x = length $ filter (x ==) s
    oppPa = count 'P' -- 相手がパーを出す回数
    oppGu = count 'G'
    oppCho = n - oppPa - oppGu

お菓子の詰め合わせ

問題

選べるお菓子の種類はたかだか $N \leq 20$ なので、全ての場合を数え上げても $10^6$ 程度なので間に合うはず。（$2^{10} \fallingdotseq 10^3$)

買うお菓子の種類を最大にとりたいので、個々の場合について「買わない」種類の個数ごとに考える。これが小さい方がよい。
買わない種類最小の選択肢の中で、お釣りの金額を最小にしたい。

全ての場合を数え上げて accumArray で最小値を取り出す。

import Data.Array

solve :: Int   -- N
      -> Int   -- X
      -> [Int] -- x_i
      -> Int   -- 答え
solve n x xs = head $ filter (maxBound >) $ elems arr
  where
    arr = accumArray min maxBound (0, n) $
          foldr step [(n, x)] xs  -- (買わない個数、残額) の場合のリスト
    step xi mys = [(pred m, y - xi) | (m,y) <- mys, y >= xi] ++ mys

ランクS

ここではランクAまで。ランクSは個別の記事に。

終わりに

スキルチェックでHaskell使えるようにしてホスい…