始めに

Haskell で AtCoder に取り組む際のお役立ち情報をノートしていきます。

1 年後には充実した内容になっている……はず!

内容は誤りを含むと思います 🙇

特にアルゴリズムの実装は 著しく質が低い かもしれません。お気をつけください。

書籍

良かった本の感想を述べます。

すごいHaskellたのしく学ぼう!

いわゆる『すごい H 本』です。文法を吸収できました。この本は『最も簡単』と言われますが、 Applicative などは十分難しいと思います。じっくりと、あるいは飛ばしながら読みました。

似た本の プログラミング Haskell 第2版 も好評です。

読後は AtCoder Beginners Selection が解けるようになりました。 ABC (AtCoder Beginner Contest) にも参加していきます。

【電子版単体】Haskellで戦う競技プログラミング 第2版

ABC の B 問題でリストを使うとしばしば TLE (実行時間超過) します。そこで本書で vector パッケージの使い方を押さえました。正確評価や boxing についても教えてくれて、非常に良かったです。

説明されていない内容としては、 Array の基本や遅延評価を生かした DP などがあります。

著者ブログも良くて、一部リンクすると:

競技プログラミングの鉄則 アルゴリズム力と思考力を高める77の技術

難度調整が絶妙な問題集です。手数を増やしつつ問題を解いていきます。つまづいた時は haskell-jp で質問できます。

余裕があれば、同著者の作成した 競プロ典型90問 などにも取り組んでみます。

環境構築

最低限、言語サーバが動いてテストケースを実行できる環境がほしいところです。

AtCoder ブラウザ拡張

Haskell のハイライトを直したり、問題の難度を視覚化できます。

Haskell のバージョンについて

Language Test 202001 で AtCoder で使われるシステムが確認できます:

  • GHC 8.8.3 (HLS 1.5.1)
  • lts-16.11 (repa-3.4.1.4 のみ lts-16.11 外のパッケージ)

Haskell のインストール

GHC (コンパイラ) と HLS (言語サーバ) は ghcup を使ってインストールします:

$ ghcup install ghc 8.8.3
$ ghcup install hls 1.5.1

他のパッケージ管理ツールや stackghc をインストールすると、 ghcup と干渉するらしいです。 ghcup 以外で入れた Haskell 関係のツールはアンインストールしておくのがおすすめです。

参考

CLI ツール

acc (atcoder-cli) で問題とテストケースの一括ダウンロードができます。またテンプレートを使ったファイル生成・テストケースの実行ができます。

acc の使い方

参考: 僕の ABC リポジトリ

問題のダウンロード

TODO

テストの実行

TODO

oj の使い方

テストケースを test-cases/ ディレクトリに入れる方法

TODO

プロジェクト構成

HLS が動く Stack プロジェクトを作ります。またすべての Main.hs は stack script です。

『正しい』構成ではない と思いますが、一応動くので載せておきます。

ファイル構成

僕は以下を使っています:

abc-hs/
├── .git/
├── abc278/
└── abc279/ # 参加コンテスト毎にディレクトリを作成
    ├── .projectile      # ※
    ├── abc279.cabal     # 自動生成
    ├── hie.yaml         # `gen-hie` で生成
    ├── package.yaml     # 編集対象
    ├── stack.yaml       # 編集対象
    └── stack.yaml.lock  # 自動生成

※ Emacs では LSP workspace のルートディレクトリが abc-hs/ になったため、仕方なく .projectile ファイルを作って abc279/ などがルートディレクトリであると Emacs に伝えています。

プロジェクト毎の GHC のバージョン切り替え

僕は stack.yamlsystem-ghc: true (後述) を設定し、 direnvPATH を書き換えて GHC / HLS のバージョンを切り替えています。間に合わせとしては十分なのではないでしょうか……。

stack.yaml

Stack にはプロジェクト下の .stack-work/ に GHC をインストールする機能がありますが、プロジェクトの数だけ GHC がインストールされるのは無駄です。 PATH 中の GHC を使用するように system-ghc: true を設定しています。また AtCoder で使用されるパッケージのバージョンを設定します:

system-ghc: true
resolver: lts-16.11
packages:
- .
extra-deps:
- repa-3.4.1.4

主なパッケージは lts-16.11 に含まれますが、 repa-3.4.1.4 のみ例外です。

package.yaml

使用パッケージ、 (HLS で使用される) 警告のレベル、実行ファイルなどを設定します:

package.yaml
dependencies:
   - base >= 4.7 && < 5

   - QuickCheck
   - array
   - attoparsec
   - bytestring
   - containers
   - deepseq
   - extra
   - fgl
   - hashable
   - heaps
   - integer-logarithms
   - lens
   - massiv
   - mono-traversable
   - mtl
   - mutable-containers
   - mwc-random
   - parallel
   - parsec
   - primitive
   - psqueues
   - random
   - reflection
   - repa
   - template-haskell
   - text
   - tf-random
   - transformers
   - unboxing-vector
   - unordered-containers
   - utility-ht
   - vector
   - vector-algorithms
   - vector-th-unbox

# DRY for package.yaml executables:
# <https://www.reddit.com/r/haskell/comments/haeqin/dry_for_packageyaml_executables/>
_exe-defs: &exe-defaults
  # dependencies:
  # - abs
  ghc-options:
    - -threaded
    - -rtsopts
    - -with-rtsopts=-N
    - -Wall # all warnings
  other-modules: []

# REMARK: See `README` for the langauge server support.
executables:
  a-exe:
    <<: *exe-defaults
    source-dirs: a
    main:                Main.hs

  b-exe:
    <<: *exe-defaults
    source-dirs: b
    main:                Main.hs

  c-exe:
    <<: *exe-defaults
    source-dirs: c
    main:                Main.hs

  d-exe:
    <<: *exe-defaults
    source-dirs: d
    main:                Main.hs

  e-exe:
    <<: *exe-defaults
    source-dirs: e
    main:                Main.hs

  f-exe:
    <<: *exe-defaults
    source-dirs: f
    main:                Main.hs

  g-exe:
    <<: *exe-defaults
    source-dirs: g
    main:                Main.hs

  ex-exe:
    <<: *exe-defaults
    source-dirs: ex
    main:                Main.hs

executables を省くと HLS の動作が不安定になった (動いたり動かなかったりする) ため、省かず書くことにしています。

hie.yaml

package.yaml を書いた後、 gen-hie (implicit-hie) を使って hie.yaml を生成します。これが無いと HLS が正常に動きませんでした:

$ gen-hie > hie.yaml
hie.yaml
cradle:
  stack:
    - path: "./a/Main.hs"
      component: "abc279:exe:a-exe"

    - path: "./b/Main.hs"
      component: "abc279:exe:b-exe"

    - path: "./c/Main.hs"
      component: "abc279:exe:c-exe"

    - path: "./d/Main.hs"
      component: "abc279:exe:d-exe"

    - path: "./e/Main.hs"
      component: "abc279:exe:e-exe"

    - path: "./ex/Main.hs"
      component: "abc279:exe:ex-exe"

    - path: "./f/Main.hs"
      component: "abc279:exe:f-exe"

    - path: "./g/Main.hs"
      component: "abc279:exe:g-exe"

abc279 の部分は現在のディレクトリ名になります。

Haskell のテンプレート

Stack script

僕のテンプレートでは以下のようなファイルを使っています:

#!/usr/bin/env stack
{- stack script --resolver lts-16.11
--package array --package bytestring --package containers
--package vector --package vector-algorithms --package primitive --package transformers
-}

{- ORMOLU_DISABLE -}
{-# LANGUAGE BangPatterns, BlockArguments, LambdaCase, MultiWayIf, PatternGuards, TupleSections #-}
{-# LANGUAGE NumDecimals, NumericUnderscores #-}
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables, TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{- ORMOLU_ENABLE -}

-- 関数など

Main.hscabel script / stack script にすると、実行ファイルとして扱うことができます。環境構築が楽な反面、 stack script の実行速度は oj によると 1 秒を超えるため、実行時間の正確な見積もりができなくなるのが欠点です。

stack でビルド・実行する環境を作った方が良いとは思うのですが……

Stack script の関数を REPL から呼ぶ

デバッグのため、 Main.hs の関数を REPL から動作確認したい場合があります。

ghci から :load するとコメントが無視されるため、 Stackage のパッケージの import に失敗します。代わりに stack repl <file> で stack script をロードできます:

$ stack repl a/Main.hs
Package name not specified, inferred "abc279"
Using configuration for abc279:exe:a-exe to load /path/to/abc279/a/Main.hs
Using main module: 1. Package `abc279' component abc279:exe:a-exe with main-is file: /path/to/abc-hs/abc279/a/Main.hs
Building all executables for `abc279' once. After a successful build of all of them, only specified executables will be rebuilt.
abc279> initial-build-steps (exe)
The following GHC options are incompatible with GHCi and have not been passed to it: -threaded
Configuring GHCi with the following packages: abc279
GHCi, version 8.8.3: https://www.haskell.org/ghc/  :? for help
[1 of 1] Compiling Main             ( /path/to/abc-hs/abc279/a/Main.hs, interpreted )

<中略 警告など>

Ok, one module loaded.
Loaded GHCi configuration from /private/var/folders/w1/gylc7bkj22z1wxrwkdk6jg040000gr/T/haskell-stack-ghci/3a2d78e8/ghci-script
*Main>

あるいは stack repl とだけ打つと、起動時にロードするファイルを選択できます:

$ stack repl
Package name not specified, inferred "abc279"

* * * * * * * *
The main module to load is ambiguous. Candidates are:
1. Package `abc279' component abc279:exe:a-exe with main-is file: /path/to/abc-hs/abc279/a/Main.hs
2. Package `abc279' component abc279:exe:b-exe with main-is file: /path/to/abc-hs/abc279/b/Main.hs
3. Package `abc279' component abc279:exe:c-exe with main-is file: /path/to/abc-hs/abc279/c/Main.hs
4. Package `abc279' component abc279:exe:d-exe with main-is file: /path/to/abc-hs/abc279/d/Main.hs
5. Package `abc279' component abc279:exe:e-exe with main-is file: /path/to/abc-hs/abc279/e/Main.hs
6. Package `abc279' component abc279:exe:ex-exe with main-is file:/path/tos/abc-hs/abc279/ex/Main.hs
7. Package `abc279' component abc279:exe:f-exe with main-is file: /path/to/abc-hs/abc279/f/Main.hs
8. Package `abc279' component abc279:exe:g-exe with main-is file: /path/to/abc-hs/abc279/g/Main.hs
You can specify which one to pick by:
 * Specifying targets to stack ghci e.g. stack ghci abc279:exe:a-exe
 * Specifying what the main is e.g. stack ghci --main-is abc279:exe:a-exe
 * Choosing from the candidate above [1..8]
* * * * * * * *

Specify main module to use (press enter to load none): 1
Loading main module from candidate 1, --main-is /path/to/abc279/a/Main.hs

Building all executables for `abc279' once. After a successful build of all of them, only specified executables will be rebuilt.
abc279> initial-build-steps (exe)
The following GHC options are incompatible with GHCi and have not been passed to it: -threaded
Configuring GHCi with the following packages: abc279
GHCi, version 8.8.3: https://www.haskell.org/ghc/  :? for help
[1 of 1] Compiling Main             ( /path/to/abc279/a/Main.hs, interpreted )

<中略 警告など>

Ok, one module loaded.
Loaded GHCi configuration from /private/var/folders/w1/gylc7bkj22z1wxrwkdk6jg040000gr/T/haskell-stack-ghci/d02d2a00/ghci-script
*Main>

TODO: ファイルの更新があった場合、 :load では --resolver などのコメントの更新に対応できない気がしますが……

参考

ライブラリ

主なパッケージの立ち位置・使い方などをノートします。

バージョン

Language Test 202001 で AtCoder で使われるシステムが確認できます。再掲すると:

  • GHC 8.8.3 (HLS 1.5.1)
  • パッケージのバージョンは lts-16.11 (repa-3.4.1.4 のみ lts-16.11 外のパッケージ)

参考

array

Array は主に多次元配列の表現に利用します。

ArrayVector の使い分け

1 次元配列の場合は Vector を使うことが多いです (API がリッチため) 。 Array には添字アクセス以外の API がほぼありませんが、 accumArray がハマる場合は Array を使うこともあります。

2 次元配列の場合は Array を使うことが多いです:

  • 2 次元の可変配列は Array でしか表現できない気がします (?)
  • 2 次元の不変配列も Array の方が添字アクセスが綺麗になります:
    • arr ! (y, x)
    • vec VU.! (x + y * w)

class Ix

array の添字は Ix クラスで抽象されています。 Ix を知ることで Array の API が理解できるようになります。

IxIntChar などに対して実装されており、また n 次元に拡張されています。

Ix の使い方 (1 次元)

Ix を試してみます。まずは REPL を起動します:

$ ghci
Prelude> import Data.Ix
Prelude Data.Ix>

Ix クラスの index 関数は、添字範囲 \([x1, x2]\) に対する相対位置を返します:

Prelude Data.Ix> index (0, 4) 2
2
Prelude Data.Ix> index (2, 6) 2
0

Ix の使い方 (2 次元)

Ix は n 次元に拡張されており、 2 次元の添字も表現できます:

Prelude Data.Ix> index ((0, 0), (5, 5)) (0, 1)
1
Prelude Data.Ix> index ((0, 0), (5, 5)) (1, 0)
6
Prelude Data.Ix> index ((0, 0), (5, 5)) (5, 5)
36

注意すべきなのは、タプルの右端の値が 1 次元目を表すということです。 Row-major な行列の場合は、 Array 生成時のサイズは (h, w) であり、 Array への添字アクセスには (y, x) (すなわち (row, column) ) を使います。

Immutable array

accumArray で生成

accumArray は配列への畳み込みです。使い方はリンク先の通り:

Prelude> import Data.Array
Prelude Data.Array> accumArray (+) 0 (1, 3) [(1, -1), (2, 1), (2, 2), (3, 5)]
--                             ~~~ ~  ~~~~    ~~~~
--                             |   |  |       |
--                             |   |  |       +--- (添字 1, 添字 1 に対する入力 -1)
--                             |   |  +--- 添字範囲 = [1, 3]
--                             |   +--- 初期の蓄積値 = 0
--                             +--- (\蓄積値 入力 -> 新しい蓄積値)
array (1,3) [(1,-1),(2,3),(3,5)]

Mutable array

ST モナドを使った配列操作

TODO

IO モナドを使った配列操作

TODO

accumArray からの thaw (解凍)

TODO

注意点

タプルの array には boxed array を使わざるを得ない

TODO

bytestring

ByteString および ByteStringBuilder は高速なテキスト処理 (ASCII 限定) に利用します。

詳しくは 【電子版単体】Haskellで戦う競技プログラミング 第2版 第 1 章を参照してください。

主な API

  • 空文字: mzero @ BSB.Builder (だっけ?)
  • 連結: <>, mconcat
  • 変換: BSB.intDec, BSB.charUtf8, BSB.stringUtf8
  • 出力: hPutBuilder stdout bs

TODO: fold

containers

IntSet, IntMap は順序付けられた木です? メモリ使用量の削減で重宝します。検索が速い (\(O(log N)\)) のも非常に便利です。

Immutable データ構造で大丈夫?

更新に多少の時間 (\(O(log N)\)) が必要ですが、今のところ TLE するほどではありません。

レーティングが上がると、別の実装に切り替える必要があるかもしれません。

TODO: DFS?

vector

Vector は高効率な配列のパッケージです。 Array と比べて API が豊かなため、基本的には Vector が好まれますが、 2 次元配列の表現には弱いです。使い分けが必要となります。

主な使い方

基本的に添字アクセスが \(O(1)\) なリストのように扱えます。パタンマッチができなくて戸惑いますが、大半の操作は高階関数で実現できますし、高階関数を使った方が効率の良いコードになります。リスト内包表記に対応するコードも、高階関数や do 記法で表現できることが多いです。

詳しくは 【電子版単体】Haskellで戦う競技プログラミング 第2版 第 4 章を参照してください。

ノート

Stream fusion

TODO: リストとのパフォーマンス比較 (差は無い?)

PrimMonadINLINE 関数

TODO:

Vector で 2 次元配列を表現するには

不変配列なら V.Vector (VU.Vector a) が使えます。たまーに入力の処理で役立ちます。

可変配列なら Array を使います。

タプルに対する実装

なんと Vector (Int, Int) の内部実装は 2 本の配列です。

TODO: データ族?

Resizable な MVector

TODO: 実装例へのリンク?

vector-algorithms

vector-algorithms は可変配列に対するソートや検索を提供します。

不変配列に対しても適用できます:

  • VU.modify
    VU.Vector を一時的に VUM.Vector に変えて操作を適用し、再び VU.Vector に凍結します。

  • VU.thaw (解凍)
    VU.VectorVUM.Vector に変えます。

VU.modifyVUM.modify とはまったく別物です。

primitive

primitive パッケージの PrimMonad は、 IO および ST を抽象します。 vector の API ドキュメントを読む時などに役立ちます。

詳しくは 【電子版単体】Haskellで戦う競技プログラミング 第2版 第 4 章を参照してください。

TODO: Vector のソースを読む?

text

text は Unicode 文字 (?) が扱える文字列のパッケージです。競技プログラミングではあまり使う機会がありません。 bytestring が使えたら十分です。

なお AtCoder のバージョンでは text の内部実装には UTF-16 が使われていますが、最近の実装では UTF-8 に移行したようです。 AtCoder の外では text の天下……なのかもしれません。

主な API

  • T.pack, T.unpack
  • T.printf

transformers

TODO

モナド

TODO

IO

RealWorld

TODO

ST

State thread

runST

TODO

runST における制約

TODO: forall

runST と類似の関数

  • VU.create
  • runSTUArray
  • TODO

VU.create と似た関数を自作する

TODO

State

例: State モナドで mapAccumL

mapAccumL は状態を持った map 関数です。累積和を計算してみます:

#!/usr/bin/env stack

import Data.List

main :: IO ()
main = do
  -- 数列 → 累積和
  -- [1, 2, 3] -> (6, [1, 3, 6])
  print $ mapAccumL (\acc x -> (acc + x, acc + x)) (0 :: Int) [1, 2, 3]

  -- 累積和 → 数列
  -- [1, 3, 6] -> (6, [1, 2, 3])
  print $ mapAccumL (\lastX x -> (x, x - lastX)) (0 :: Int) [1, 3, 6]

累積和の計算には fold を使うことができます。しかし累積和を数列に戻す際には mapAccumL を使うしかないと思います。

同様の計算は mapMState モナドにより表現可能です:

#!/usr/bin/env stack

import Control.Monad.State
import Data.List

main :: IO ()
main = do
  -- 数列 → 累積和
  -- [1, 2, 3] -> ([1, 3, 6], 6)
  print $ runState (mapM (\x -> state $ \acc -> (x + acc, x + acc)) [1, 2, 3]) (0 :: Int)

  -- 累積和 → 数列
  -- [1, 3, 6] -> ([1, 2, 3], 0)
  print $ runState (mapM (\x -> state $ \lastX -> (x - lastX, x)) [1, 2, 3]) (0 :: Int)

mapAccumLTraversable なデータ型にしか適用できませんが、mapM なら Vector に対しても適用できます。

例: do 記法

TODO: ポイントフリースタイルの恩恵

TODO: パフォーマンスへの (悪) 影響

アルゴリズム

競技プログラミングの鉄則 を読んで実装したアルゴリズムをノートしていきます。

著しく低クオリティ の可能性が高いのでお気をつけください。

2 分探索

参考: AtCoder灰・茶・緑色の方必見!二分探索を絶対にバグらせないで書く方法│FORCIA CUBE│フォルシア株式会社

いわゆる『はねる式 2 分探索』です。

実装

-- {{{ Binary search

-- | Binary search for sorted items in an inclusive range (from left to right only)
-- |
-- | It returns an `(ok, ng)` index pair at the boundary.
-- |
-- | # Example
-- |
-- | With an OK predicate `(<= 5)`, list `[0..9]` can be seen as:
-- |
-- | > [0, 1, 2, 3, 4, 5, 6, 7, 8, 9]
-- | >  <-------------->  <-------->
-- | >         ok             ng
-- |
-- | In this case `bsearch` returns the `(ok, ng)` = `(5, 6)` pair:
-- |
-- | > > let xs = [0..9] in do
-- | > >   print $ bsearch (0, 9) (\i -> xs !! i <= 5)
-- | > (5, 6)
bsearch :: (Int, Int) -> (Int -> Bool) -> (Maybe Int, Maybe Int)
bsearch (low, high) isOk = bimap wrap wrap (loop (low - 1, high + 1) isOk)
  where
    loop (ok, ng) isOk
      | abs (ok - ng) == 1 = (ok, ng)
      | isOk m = loop (m, ng) isOk
      | otherwise = loop (ok, m) isOk
      where
        m = (ok + ng) `div` 2
    wrap :: Int -> Maybe Int
    wrap x
      | x == low - 1 || x == high + 1 = Nothing
      | otherwise = Just x

-- }}}

Union-Find

参考: Union-Find とは | アルゴ式

データの相互排他的なデータ分けができます。

実装 (MVector ベース)

MVector を使う都合上、添字の範囲が極端に広い場合はメモリ使用量が制限を超えてしまいますが、座標圧縮を使ってメモリ使用量を抑えることができます。

以下のコードでは PrimMonad を使っていますが、実質的には IO でしか利用できません。

-- {{{ Union-Find tree

-- | Union-find implementation (originally by `@pel`)
newtype UnionFind s = UnionFind (VM.MVector s UfNode)

type IOUnionFind = UnionFind RealWorld

type STUnionFind s = UnionFind s

-- | `Child parent | Root size`. Not `Unbox` :(
data UfNode = Child {-# UNPACK #-} !Int | Root {-# UNPACK #-} !Int

-- | Creates a new Union-Find tree of the given size.
{-# INLINE newUF #-}
newUF :: (PrimMonad m) => Int -> m (UnionFind (PrimState m))
newUF n = UnionFind <$> VM.replicate n (Root 1)

-- | Returns the root node index.
{-# INLINE root #-}
root :: (PrimMonad m) => UnionFind (PrimState m) -> Int -> m Int
root uf@(UnionFind vec) i = do
  node <- VM.read vec i
  case node of
    Root _ -> return i
    Child p -> do
      r <- root uf p
      -- NOTE(perf): path compression (move the queried node to just under the root, recursivelly)
      VM.write vec i (Child r)
      return r

-- | Checks if the two nodes are under the same root.
{-# INLINE same #-}
same :: (PrimMonad m) => UnionFind (PrimState m) -> Int -> Int -> m Bool
same uf x y = liftM2 (==) (root uf x) (root uf y)

-- | Just an internal helper.
unwrapRoot :: UfNode -> Int
unwrapRoot (Root s) = s
unwrapRoot (Child _) = undefined

-- | Unites two nodes.
{-# INLINE unite #-}
unite :: (PrimMonad m) => UnionFind (PrimState m) -> Int -> Int -> m ()
unite uf@(UnionFind vec) x y = do
  px <- root uf x
  py <- root uf y
  when (px /= py) $ do
    sx <- unwrapRoot <$> VM.read vec px
    sy <- unwrapRoot <$> VM.read vec py
    -- NOTE(perf): union by rank (choose smaller one for root)
    let (par, chld) = if sx < sy then (px, py) else (py, px)
    VM.write vec chld (Child par)
    VM.write vec par (Root (sx + sy))

-- | Returns the size of the root node, starting with `1`.
{-# INLINE size #-}
size :: (PrimMonad m) => UnionFind (PrimState m) -> Int -> m Int
size uf@(UnionFind vec) x = do
  px <- root uf x
  s <- unwrapRoot <$> VM.read vec px
  return s

-- }}}

TODO: ちゃんと PrimMonad を活かして ST モナドが活きるようにする?

実装 (IntMap ベース)

TODO

セグメント木

参考: 競技プログラミングの鉄則

セグメント木は畳み込みのキャッシュです。

実装

『鉄則本』では完全 2 分木をバックにした実装が紹介されていました。概要だけ読んで実装しました。

ヘルパー部分

-- {{{ Bits

-- | Log base of two or bit floor.
-- | <https://hackage.haskell.org/package/base-4.17.0.0/docs/Data-Bits.html#v:countLeadingZeros>
log2 :: (FiniteBits b) => b -> Int
log2 x = finiteBitSize x - 1 - countLeadingZeros x

-- | Ceiling of log base 2 of an `Int`.
-- |
-- | # Example
-- |
-- | ```hs
-- | > log2 3
-- | 1
-- | > log2CeilInt 3
-- | 2
-- | ```
log2CeilInt :: Int -> Int
log2CeilInt x = msb + ceiling
  where
    msb = log2 x
    ceiling = if (clearBit x msb) > 0 then 1 else 0

-- | Calculates the smallest integral power of two that is not smaller than `x`.
-- |
-- | # Example
-- |
-- | ```hs
-- | > bitCeil 3
-- | 4
-- | ```
bitCeil :: Int -> Int
bitCeil = bit . log2CeilInt

-- }}}

本実装

-- {{{ Segment tree

-- | A mutable segment tree backed by a complete binary tree.
-- |
-- | # Overview
-- |
-- | A segment tree is a cache of a folding function.
-- | Each node corresponds to a folding range and the node contains the folding result.
-- |
-- | A segment tree has a constant size and never be resized.
-- |
-- | # Operations
-- |
-- | Modification takes $O(log N)$, so creation takes $N(log N)$.
-- | Lookup takes $O(log N)$.
-- |
-- | # (Internal) Indices
-- |
-- | The complete binary tree has `2 ^ depth - 1` elements.
-- |
-- | - Child elements of a parent node `i` has index `2 * i + 1` and `2 * i + 2`.
-- | - The leaf indices start with `length / 2 - 1`.
-- |
-- | Example:
-- |
-- | ```
-- |            0
-- |      1           2
-- |   3     4     5     6
-- | 07 08 09 10 11 12 13 14
-- | ```
data MSegmentTree s a = MSegmentTree (a -> a -> a) (VUM.MVector s a)

-- TODO: Generic queries and immutable segment tree (with `Show` instance)

-- | Creates a new segment tree for `n` leaves.
{-# INLINE newTree #-}
newTree :: (VUM.Unbox a, PrimMonad m) => (a -> a -> a) -> Int -> a -> m (MSegmentTree (PrimState m) a)
newTree !f !n !value = MSegmentTree f <$> VUM.replicate n' value
  where
    !n' = shiftL (bitCeil n) 1

-- | Updates an `MSegmentTree` leaf value and their parents up to top root.
{-# INLINE updateLeaf #-}
updateLeaf :: (VU.Unbox a, PrimMonad m) => MSegmentTree (PrimState m) a -> Int -> a -> m ()
updateLeaf tree@(MSegmentTree _ vec) !i !value = _updateElement tree i' value
  where
    -- length == 2 * (the number of the leaves)
    !offset = (VUM.length vec) `div` 2 - 1
    !i' = i + offset

-- | (Internal) Updates an `MSegmentTree` element (node or leaf) value and their parents up to top root.
{-# INLINE _updateElement #-}
_updateElement :: (VU.Unbox a, PrimMonad m) => MSegmentTree (PrimState m) a -> Int -> a -> m ()
_updateElement tree@(MSegmentTree _ vec) !i !value = do
  VUM.write vec i value
  _updateParent tree ((i - 1) `div` 2)

-- | (Internal) Recursivelly updates the parent nodes.
{-# INLINE _updateParent #-}
_updateParent :: (VU.Unbox a, PrimMonad m) => MSegmentTree (PrimState m) a -> Int -> m ()
_updateParent _ (-1) = pure () -- REMARK: (-1) `div` 2 == -1
_updateParent _ 0 = pure ()
_updateParent tree@(MSegmentTree f vec) !iParent = do
  !c1 <- VUM.read vec (iParent * 2 + 1)
  !c2 <- VUM.read vec (iParent * 2 + 2)
  _updateElement tree iParent (f c1 c2)

-- | Retrieves the folding result over the inclusive range `[l, r]` from `MSegmentTree`.
{-# INLINE queryByRange #-}
queryByRange :: forall a m. (VU.Unbox a, PrimMonad m) => MSegmentTree (PrimState m) a -> (Int, Int) -> m a
queryByRange (MSegmentTree !f !vec) (!lo, !hi) = fromJust <$> loop 0 (0, initialHi)
  where
    !initialHi = (VUM.length vec) `div` 2 - 1
    loop :: Int -> (Int, Int) -> m (Maybe a)
    loop !i (!l, !h)
      | lo <= l && h <= hi = Just <$> VUM.read vec i
      | h < lo || hi < l = pure Nothing
      | otherwise = do
        let d = (h - l) `div` 2
        !ansL <- loop (2 * i + 1) (l, l + d)
        !ansH <- loop (2 * i + 2) (l + d + 1, h)
        pure . Just $ case (ansL, ansH) of
          (Just !a, Just !b) -> f a b
          (Just !a, _) -> a
          (_, Just !b) -> b
          (_, _) -> error "query error (segment tree)"

-- }}}

その他

言語拡張について

TODO: GHC の言語拡張とは

書き方

フォーマッタ (ormolu) は言語拡張を 1 行ずつに分けてしまいますから、拡張の数だけ行を占領します:

{-# LANGUAGE BangPatterns #-}
{-# BlockArguments #-}
{-# LambdaCase #-}
{-# MultiWayIf #-}
{-# PatternGuards #-}
{-# TupleSections #-}
-- ..

言語拡張の宣言をフォーマッタの適用外にすれば、コード行数を削減することもできます:

{- ORMOLU_DISABLE -}
{-# LANGUAGE BangPatterns, BlockArguments, LambdaCase, MultiWayIf, PatternGuards, TupleSections #-}
{-# LANGUAGE NumDecimals, NumericUnderscores #-}
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables, TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{- ORMOLU_ENABLE -}

おすすめしない言語拡張

NPlusKPatterns

パタンを n + 定数 と書けるようにする拡張です。この拡張を有効にして ghci を起動してみます:

$ ghci -XNPlusKPatterns
Prelude> 

一見 N + K パタンは問題なく動きます:

Prelude> let (n + 1) = 1
Prelude> n
0

しかし n が負の数になるパタンでは実行時エラーが発生します:

Prelude> let (n + 1) = 0
Prelude> n
*** Exception: <interactive>:3:5-15: Non-exhaustive patterns in n+1

このように罠がある以上、多少冗長でも letwhere を書こうと思いました。 詳細 (未確認)

カリー化について

参考: カリー化談義 - あどけない話

多変数関数の表現として

TODO: プログラミング言語の基礎概念

TODO: Applicative における (a -> b) の具体例に (a -> b' -> c) がある。

タプルの引数を個別の引数にバラすという意味で

TODO: curry, uncurry

部分適用について

TODO: 一般の部分適用は順不同、カリー化された関数の部分適用は 1 方向の順番

TODO: . 演算子、 $ 演算子、ポイントフリースタイルなどと絡めたい

ポイントフリースタイル

ポイントフリースタイルは関数合成に便利です。関数適用の評価順が最も高いというのも関係しています。

TODO: という趣旨であっている?

TODO:

小ネタ

Haskell

AtCoder