🍟
競プロ鉄則 Haskell AtCoder 振り返り8

2025/11/22に公開
 A8問題：

H×W のマス目があります

上から i 行目 左から j 列目にあるマス (i,j) には，整数 X_i,j が書かれています

これについて 以下の Q 個の質問に答えるプログラムを作成してください

i 個目の質問：左上 (A_i,B_i) 右下 (C_i,D_i) の長方形領域に書かれた整数の総和は？
制限時間 : 10000ms
制約：
1≤H,W≤1500
1≤Q≤100000

0≤X_{i,j}≤9
1≤ A_i ≤ C_i ≤H
1≤ B_i ≤ D_i ≤W
入力はすべて整数
入力：

H W

X_{1,1} X_{1,2} ⋯ X_{1,W}

⋮

X_{H,1} X_{H,2} ⋯ X_{H,W}

Q

A_1 B_1 C_1 D_1

⋮

A_Q B_Q C_Q D_Q

​

出力：

Q行にわたって出力してください

i行目には 質問iの答えを出力してください

 提出コードimport Control.Monad (replicateM)
import Data.Array (listArray, Array, (!))

inputIntList :: Int -> IO [[Int]]
inputIntList n = replicateM n $ getLine >>= return . map read .words

getSum :: Array Int (Array Int Int) -> [Int] -> Int
getSum arrs abcds =  case abcds of
    [a,b,c,d] -> foldl (\acc i -> acc + sumw i) 0 [a..c]
          where sumw i =  let ar = arrs!i in ar!d - if b>1 then ar!(b-1) else 0 
    _ -> 0

main :: IO ()
main = do
  [[h,w]] <- inputIntList 1
  xs <- inputIntList h
  [[q]] <- inputIntList 1
  abcds <- inputIntList q
  let arr = listArray (1,h) $ map (listArray (1,w) . scanl1 (+)) xs 
  let sums = map (getSum arr) abcds
  mapM_ print sums

 結果AC 6274ms 483284KiB

 考察これは去年の8月に提出したものだ

Arrayの中にArrayをぶちこんだ構造を使ってゐる

この當時は Arrayで多次元配列を直感的につくる方法を知らなかったのだと思ふ

listArray は 最初の引數に 配列の範囲を指定するのだが

((1,1),(3,3))のやうに指定すれば (1,1) から (3,3) までの二次元配列を定義できる

仮に [1,2,3,4,5,6,7,8,9] といふリストを listArray ((1,1),(3,3)) に適用すると

1 2 3

4 5 6

7 8 9

といふ 行列が作成できる

この場合 例へば インデックス (2,1) は 4 となる

このArrayの機能を使い InputもBytestringを使って 再提出してみた

 再提出import Control.Monad (replicateM)
import Data.Array (listArray, Array, (!))
import qualified Data.ByteString.Char8 as B
import Data.List (unfoldr,foldl')

ints :: IO [Int]
ints = unfoldr (B.readInt . B.dropSpace) <$> B.getLine

main :: IO ()
main = do
  [h,w] <- ints 
  xs <- replicateM h ints 
  q <- readLn :: IO Int 
  abcds <- replicateM q ints 
  let arr = listArray ((1,1),(h,w)) $ concatMap (scanl1 (+)) xs 
  let sums = map (getSum arr) abcds
  mapM_ print sums
  
getSum :: Array (Int,Int) Int -> [Int] -> Int
getSum ar [a,b,c,d] = foldl' (\acc h -> acc + sumw h) 0 [a..c]
          where sumw h = ar!(h,d) - if b==1 then 0 else ar!(h,b-1) 

 結果AC 4406ms 211904KiB

 考察ただ やはり Bytestringを使はない場合も氣になったので やってみた

すると

7023ms 743512KiB

となり 最初の提出よりパフォーマンスが落ちた

一應 この最後の提出のArray定義を最初のものに變へてやってみたら

5778ms 483356KiB

となった

Arrayの範囲を ((1,1),(h,w))のやうに直感的に定義できるのは便利だが

Arrayの中にArrayを入れた方が パフォーマンスは良いやうだ

(いや さうとも言ひ切れないかもしれない

Arrayの定義のところで concatを使ったことで 速度が落ちてゐる可能性もある)

Bystringをインプットに使ひ Arrayの中にArrayを入れたものは

3237ms 170864KiB

だった

https://atcoder.jp/contests/tessoku-book/submissions/71091938
話は全然變はるが このAtCoderのシステムは

様々な面で ものすごく すぐれた學習システムだと思ふ
ブラウザを開ける環境があれば いつでも どこでも だれでも 無料で學習できる
現存するプログラミング言語の多くを網羅してゐる(ビジネスのニーズに特化したりしてゐない)
問題に對して 何回でも解答し 結果を確かめることができる
コンテストでは プログラム實行時間の制限があることで アルゴリズムの學びを得られるが いたづらにパフォーマンスを競うものでもない
多くの人に開かれてゐることで 自分の立ち位置 實力を知ることができるが それを氣にせず マイペースに學習することも可能である
おそらく AtCoderを運營する人々も それを支持する人々も 確固たる信念をもって取り組んでゐる

本當に素晴らしいことだと思ふ

 B8問題：

二次元平面上に N 個の点があります

i 個目の点の座標は (X_i,Y_i) です

「x 座標が a 以上 c 以下であり y 座標が b 以上 d 以下であるような点は何個あるか？」 という形式の質問が Q 個与えられるので それぞれの質問に答えるプログラムを実装してください

なお 入力される値はすべて整数です
制限時間 : 5000ms
制約：
1≤N,Q≤100000
1≤ X_i,Y_i ≤1500
1≤ a_i ≤ c_i ≤1500
1≤ b_i ≤ d_i ≤1500
入力はすべて整数
入力：

N

X_1 Y_1

⋮

X_N Y_N

Q

a_1 b_1 c_1 d_1

⋮

a_Q b_Q c_Q d_Q

​

出力：

Q行にわたって出力してください

i行目には i個目の質問の答えを出力してください

 提出コードimport Control.Monad (replicateM)
import Data.Array (listArray, elems, Array, accum, (!))
import Data.List (transpose)
import Data.List.Split (chunksOf)

getInts :: Int -> IO [[Int]]
getInts n = replicateM n $ getLine >>= return . map read .words

baseArray :: Int -> Int -> Array (Int,Int) Int 
baseArray w h = listArray ((0,0),(w,h)) $ repeat 0 
  
setOne :: Array (Int,Int) Int -> [(Int,Int)] -> Array (Int,Int) Int  
setOne arr xys = accum (+) arr $ map (\xy -> (xy,1)) xys 

calcSum :: Array (Int,Int) Int -> (Int,Int,Int,Int) -> Int
calcSum arr (a,b,c,d) = 
  let ul = arr!(a-1,b-1)
      ur = arr!(c,b-1)
      dl = arr!(a-1,d)
      dr = arr!(c,d)
   in ul+dr-ur-dl 
  
toList :: Int -> Array (Int,Int) Int -> [[Int]]
toList w arr = chunksOf (w+1) $ elems arr

scanPlus :: [[Int]] -> [[Int]]
scanPlus = transpose . map (scanl1 (+))

scanning :: [[Int]] -> [[Int]]
scanning = scanPlus . scanPlus

makePair :: [Int] -> (Int,Int)
makePair [a,b] = (a,b)
makePair _ = (0,0)

make4 :: [Int] -> (Int,Int,Int,Int)
make4 [a,b,c,d] = (a,b,c,d)
make4 _ = (0,0,0,0)

main :: IO ()
main = do
  let w = 1500; h = 1500
  n <- getLine >>= return . read
  xys <- getInts n >>= return . map makePair
  q <- getLine >>= return . read
  abcds <- getInts q >>= return . map make4
  let arr = listArray ((0,0),(w,h)) $ concat $ scanning $ toList h $ setOne (baseArray w h) xys 
  mapM_ print $ map (calcSum arr) abcds 

 結果AC 2817ms 625372KiB

 考察これを提出したのは 去年の11月 ちょうど一年前だ

ここに至るまで TLEに苦しみ 10回以上提出をくり返してゐる

途中 入力されたリストをわざわざタプルに變換してゐるが これは不必要だったと思ふ

baseArray で (0,0)から(w,h)をインデックスにもつArrayの要素をすべて0にし

setOne で そのArrayのうち 點(x,y)に對應する要素へ 1を加へてゐる

これを toList で (h+1)個の要素を持つリスト が(w+1)個含まれた 多次元リストに變換する

たとへば Array のインデックスが (0,0)から(2,3)までだった場合

[[0,1,1,0],[0,0,1,0],[1,0,0,0]]

といふやうなリストができあがる

座標の縦方向と横方向の累積和を求めたいわけだが そのためにscanningをしてゐる

上の例でいふと まづ

[[0,1,2,2],[0,0,1,1],[1,1,1,1]]

と 3つのリストで累積和をもとめ

これをtransposeした

[[0,0,1],[1,0,1],[2,1,1],[2,1,1]]

で 4つのリストにおいて累積和をもとめ

[[0,0,1],[1,1,2],[2,3,4],[2,3,4]]

これをtransposeする

[[0,1,2,2],[0,1,3,3],[1,2,4,4]]

このリストを再び Array にし calcSum で長方形内部の點の総和を求めてゐる

累積和から もともとの長方形内部の數の総和を求める方法は なかなか普通氣づけないと思ふ

私は 「競プロ」の本(p63)を見て 初めて知った

それによると たとへば



2次元の累積和が上のやうな状態であるとき

太線で囲まれた範囲にもともとあった數値の和は 赤い部分から青い部分を引いたものになる

この場合では 32+2-8-7 = 25 だ

これをそのまま實装しやうとしたのが calcSum である

 再提出import Control.Monad (replicateM)
import Data.Array (listArray, elems, Array, accum, (!))
import Data.List (transpose,unfoldr)
import Data.List.Split (chunksOf)
import qualified Data.ByteString.Char8 as B

type MA = Array (Int,Int) Int

ints :: IO [Int]
ints = unfoldr (B.readInt . B.dropSpace) <$> B.getLine

main :: IO ()
main = do
  let w = 1500; h = 1500
  n <- readLn :: IO Int 
  xys <- replicateM n ints
  q <- readLn :: IO Int 
  abcds <- replicateM q ints 
  let base = listArray ((0,0),(w,h)) $ repeat 0
  let ones = accum (+) base $ map (\[x,y]->((x,y),1)) xys
  let arr = listArray ((0,0),(w,h)) $ concat $ scanning $ toList h ones 
  mapM_ (print . calcSum arr) abcds 

calcSum :: MA -> [Int] -> Int
calcSum arr [a,b,c,d] = 
  let ul = arr!(a-1,b-1)
      ur = arr!(c,b-1)
      dl = arr!(a-1,d)
      dr = arr!(c,d)
   in ul+dr-ur-dl 
  
toList :: Int -> Array (Int,Int) Int -> [[Int]]
toList h arr = chunksOf (h+1) $ elems arr

scanning :: [[Int]] -> [[Int]]
scanning = scanPlus . scanPlus
  where scanPlus = transpose . map (scanl1 (+))

 結果AC 2065ms 521184KiB

 考察整理したのと 入力をBytestringにしたことで 多少パフォーマンスは上がったやうだ

ただ Arrayをつくり それを List にして それを transposeしたりして また Array にする

なんだか とても回りくどいやうに感じる

Array のなかで scan したり transpose したりできないものなのか

と思っていろいろ試してみたが うまくいかなかった

Matrix を使ふ もしくは Vector を使ふ など 試行錯誤はしてゐる

ただ 今のところ Array が一番分かりやすい

https://atcoder.jp/contests/tessoku-book/submissions/71105528
A8

提出コード

結果

考察

再提出

結果

考察

B8

提出コード

結果

考察

再提出

結果

考察

Discussion
