A8

問題：
$H\timesW$ のマス目があります
上から $i$ 行目左から $j$ 列目にあるマス $(i,j)$ には，整数 $X_i,j$ が書かれています
これについて以下の $Q$ 個の質問に答えるプログラムを作成してください

$i$ 個目の質問：左上 (A_i,B_i) 右下 (C_i,D_i) の長方形領域に書かれた整数の総和は？

制限時間 : 10000ms

制約：

$1\leqH,W\leq1500$
$1\leqQ\leq100000$
$0\leq$ $X_{i,j}$ $\leq9$
$1\leq A_i \leq C_i \leqH$
$1\leq B_i \leq D_i \leqW$
入力はすべて整数

入力：
$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
だった

話は全然變はるがこのAtCoderのシステムは
様々な面でものすごくすぐれた學習システムだと思ふ

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

おそらく AtCoderを運營する人々もそれを支持する人々も確固たる信念をもって取り組んでゐる
本當に素晴らしいことだと思ふ

B8

問題：
二次元平面上に $N$ 個の点があります
$i$ 個目の点の座標は $(X_i,Y_i)$ です
「 $x$ 座標が $a$ 以上 $c$ 以下であり $y$ 座標が $b$ 以上 $d$ 以下であるような点は何個あるか？」という形式の質問が $Q$ 個与えられるのでそれぞれの質問に答えるプログラムを実装してください
なお入力される値はすべて整数です

制限時間 : 5000ms

制約：

$1\leqN,Q\leq100000$
$1\leq X_i,Y_i \leq1500$
$1\leq a_i \leq c_i \leq1500$
$1\leq b_i \leq d_i \leq1500$
入力はすべて整数

入力：
$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 が一番分かりやすい

Discussion