From 744e3b88575621bee6b3b333bd1855a660ecaf1e Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Tue, 11 Jun 2019 20:13:36 +0900
Subject: [PATCH 001/148] Add codeforces/1176-a

---
 codeforces/1176-a/Main.hs | 23 +++++++++++++++++++++++
 1 file changed, 23 insertions(+)
 create mode 100644 codeforces/1176-a/Main.hs

diff --git a/codeforces/1176-a/Main.hs b/codeforces/1176-a/Main.hs
new file mode 100644
index 0000000..2b9f114
--- /dev/null
+++ b/codeforces/1176-a/Main.hs
@@ -0,0 +1,23 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Int
+import Control.Monad
+
+solve :: Int64 -> Int
+solve 0 = error "invalid input"
+solve n = let (e2, n') = factorMultiplicity 2 n
+              (e3, n'') = factorMultiplicity 3 n'
+              (e5, n''') = factorMultiplicity 5 n''
+          in if n''' == 1
+             then e2 + 2 * e3 + 3 * e5
+             else -1
+  where
+    factorMultiplicity :: Int64 -> Int64 -> (Int, Int64)
+    factorMultiplicity !p = loop 0
+      where loop !k !n = case n `quotRem` p of
+                           (q,0) -> loop (k + 1) q
+                           _ -> (k, n)
+
+main = do
+  q <- readLn
+  replicateM_ q (solve <$> readLn >>= print)

From d284161ba2f5a53b07ce18f86a475d836bd1e237 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Wed, 12 Jun 2019 14:30:03 +0000
Subject: [PATCH 002/148] DP-J

---
 README.md    |  1 +
 dp-j/Main.hs | 39 +++++++++++++++++++++++++++++++++++++++
 2 files changed, 40 insertions(+)
 create mode 100644 dp-j/Main.hs

diff --git a/README.md b/README.md
index ac30e5f..c0626a6 100644
--- a/README.md
+++ b/README.md
@@ -38,6 +38,7 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 * G - Longest Path
 * H - Grid 1
 * I - Coins
+* J - Sushi
 
 ## AtCoder Beginner Contest 032
 
diff --git a/dp-j/Main.hs b/dp-j/Main.hs
new file mode 100644
index 0000000..012d2ff
--- /dev/null
+++ b/dp-j/Main.hs
@@ -0,0 +1,39 @@
+{-# LANGUAGE BangPatterns #-}
+import Data.Char
+import Data.List
+import Control.Monad
+import qualified Data.Vector.Unboxed as U
+import qualified Data.ByteString.Char8 as BS
+import Control.Monad.ST
+import Data.Array.ST
+
+asSTUArray :: ST s (STUArray s i a) -> ST s (STUArray s i a)
+asSTUArray arr = arr
+
+solve :: Int -> Int -> Int -> Int -> Double
+solve !n !b !c !d = runST $ do
+  arr <- asSTUArray $ newArray ((-1,-1,-1),(n+1,n+1,n+1)) 0
+  writeArray arr (0,0,0) 0
+  forM_ [0..d] $ \k -> do
+    forM_ [0..c+d-k] $ \j -> do
+      -- j + k <= c + d
+      forM_ [0..b+c+d-j-k] $ \i -> do
+        -- i + j + k <= b + c + d
+        when (i + j + k > 0) $ do
+          x <- readArray arr (i-1,j,k)
+          y <- readArray arr (i+1,j-1,k)
+          z <- readArray arr (i,j+1,k-1)
+          let t = fromIntegral (i + j + k)
+          writeArray arr (i,j,k) $! (fromIntegral n + fromIntegral i * x + fromIntegral j * y + fromIntegral k * z) / t
+  readArray arr (b,c,d)
+
+main = do
+  n <- readLn
+  -- 1 <= n <= 300
+  xs <- U.unfoldrN n (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  -- 1 <= ai <= 3
+  let c1 = U.length (U.filter (== 1) xs)
+      c2 = U.length (U.filter (== 2) xs)
+      c3 = U.length (U.filter (== 3) xs)
+  -- c1 + c2 + c3 should be n
+  print $ solve n c1 c2 c3

From 88c08bb3165e613a937ad29b4319577b00ee80d2 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Thu, 13 Jun 2019 00:08:07 +0900
Subject: [PATCH 003/148] DP-K

---
 README.md    |  1 +
 dp-k/Main.hs | 28 ++++++++++++++++++++++++++++
 2 files changed, 29 insertions(+)
 create mode 100644 dp-k/Main.hs

diff --git a/README.md b/README.md
index c0626a6..cb9613b 100644
--- a/README.md
+++ b/README.md
@@ -39,6 +39,7 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 * H - Grid 1
 * I - Coins
 * J - Sushi
+* K - Stones
 
 ## AtCoder Beginner Contest 032
 
diff --git a/dp-k/Main.hs b/dp-k/Main.hs
new file mode 100644
index 0000000..4fcef62
--- /dev/null
+++ b/dp-k/Main.hs
@@ -0,0 +1,28 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+-- import Control.Monad (forM_)
+import qualified Data.Vector.Unboxed as U
+-- import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  [n,k] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  -- 1 <= n <= 300, 1 <= k <= 10^5
+  xs <- U.unfoldrN n (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  -- 1 <= a1 < a2 < ... < an <= k
+  {-
+  let vec = U.create $ do
+        vec <- UM.new (k + 1)
+        UM.write vec 0 False
+        forM_ [1..k] $ \i -> do
+          result <- not . U.and <$> U.mapM (\x -> UM.read vec (i - x)) (U.takeWhile (<= i) xs)
+          UM.write vec i result
+        return vec
+  -}
+  let vec = U.constructN (k + 1) $
+        \vec -> let !i = U.length vec
+                in not $ U.and $ U.map (\x -> vec U.! (i - x)) $ U.takeWhile (<= i) xs
+  -- vec ! i: 石が i 個ある状態で、双方が最善を尽くした時に現在の手番の人が勝つなら True
+  putStrLn (if U.last vec then "First" else "Second")

From ec5af9520a301b790cee4ebbe4e659fdea00d883 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Thu, 13 Jun 2019 00:10:31 +0900
Subject: [PATCH 004/148] Change URL of TDPC

---
 README.md | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/README.md b/README.md
index cb9613b..966aa9e 100644
--- a/README.md
+++ b/README.md
@@ -8,7 +8,7 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 
 ## Typical DP Contest
 
-<https://tdpc.contest.atcoder.jp/>
+<https://atcoder.jp/contests/tdpc>
 
 解いた問題：
 

From 9f4d336534365ec2d1871a1bd8193b51c1bdca78 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Fri, 14 Jun 2019 00:38:28 +0900
Subject: [PATCH 005/148] DP-L

---
 README.md    |  1 +
 dp-l/Main.hs | 37 +++++++++++++++++++++++++++++++++++++
 2 files changed, 38 insertions(+)
 create mode 100644 dp-l/Main.hs

diff --git a/README.md b/README.md
index 966aa9e..2294b2c 100644
--- a/README.md
+++ b/README.md
@@ -40,6 +40,7 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 * I - Coins
 * J - Sushi
 * K - Stones
+* L - Deque
 
 ## AtCoder Beginner Contest 032
 
diff --git a/dp-l/Main.hs b/dp-l/Main.hs
new file mode 100644
index 0000000..2ae4333
--- /dev/null
+++ b/dp-l/Main.hs
@@ -0,0 +1,37 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Char (isSpace)
+import Data.Int (Int64)
+import Control.Monad (forM_)
+import qualified Data.Vector.Unboxed as U
+import qualified Data.ByteString.Char8 as BS
+import Data.Array.ST
+import Control.Monad.ST
+
+asSTUArray :: ST s (STUArray s i e) -> ST s (STUArray s i e)
+asSTUArray = id
+
+main = do
+  n <- readLn
+  xs <- U.map fromIntegral . U.unfoldrN n (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  let result = runST $ do
+        arr <- asSTUArray $ newArray ((0,0),(n,n)) 0
+        -- arr!(i,j): 左から i 個、右から j 個取り除かれた状態から二人が最適に行動した場合の、 X-Y の値
+        -- i+j == n の場合は arr!(i,j) == 0
+        forM_ [n-1,n-2..0] $ \k ->
+          if even k
+          then -- 太郎くん： X-Y を最大化したい
+            forM_ [0..k] $ \i -> do
+              let j = k - i
+              -- i + j == k
+              a <- (+ xs U.! i) <$> readArray arr (i+1,j)
+              b <- (+ xs U.! (n - j - 1)) <$> readArray arr (i,j+1)
+              writeArray arr (i,j) $! max a b
+          else -- 次郎くん： X-Y を最小化したい
+            forM_ [0..k] $ \i -> do
+              let j = k - i
+              -- i + j == k
+              a <- subtract (xs U.! i) <$> readArray arr (i+1,j)
+              b <- subtract (xs U.! (n - j - 1)) <$> readArray arr (i,j+1)
+              writeArray arr (i,j) $! min a b
+        readArray arr (0,0)
+  print (result :: Int64)

From 9462311898be0f6ffbfc055980eddc8a97ff1a3f Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Sat, 15 Jun 2019 23:16:32 +0900
Subject: [PATCH 006/148] diverta 2019-2 - A, B, C, D

---
 README.md               | 13 +++++++++++++
 diverta2019-2-a/Main.hs |  8 ++++++++
 diverta2019-2-b/Main.hs | 25 ++++++++++++++++++++++++
 diverta2019-2-c/Main.hs | 43 +++++++++++++++++++++++++++++++++++++++++
 diverta2019-2-d/Main.hs | 40 ++++++++++++++++++++++++++++++++++++++
 5 files changed, 129 insertions(+)
 create mode 100644 diverta2019-2-a/Main.hs
 create mode 100644 diverta2019-2-b/Main.hs
 create mode 100644 diverta2019-2-c/Main.hs
 create mode 100644 diverta2019-2-d/Main.hs

diff --git a/README.md b/README.md
index 2294b2c..79c3b12 100644
--- a/README.md
+++ b/README.md
@@ -323,3 +323,16 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 * D - Lamp
 * E - Sum Equals Xor
 * F - Takahashi's Basics in Education and Learning
+
+## diverta 2019 Programming Contest 2
+
+<https://atcoder.jp/contests/diverta2019-2>
+
+解いた問題：
+
+* [x] A - Ball Distribution
+* [x] B - Picking Up
+* [x] C - Successive Subtraction
+* [x] D - Squirrel Merchant
+* [ ] E - Balanced Piles
+* [ ] F - Diverta City
diff --git a/diverta2019-2-a/Main.hs b/diverta2019-2-a/Main.hs
new file mode 100644
index 0000000..1b7ecf9
--- /dev/null
+++ b/diverta2019-2-a/Main.hs
@@ -0,0 +1,8 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  [n,k] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  print $ if k == 1 then 0 else n - k
diff --git a/diverta2019-2-b/Main.hs b/diverta2019-2-b/Main.hs
new file mode 100644
index 0000000..537e564
--- /dev/null
+++ b/diverta2019-2-b/Main.hs
@@ -0,0 +1,25 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Char (isSpace)
+import Data.List (unfoldr, tails)
+import Control.Monad (replicateM)
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.Map.Strict as Map
+
+main = do
+  n <- readLn
+  coords <- replicateM n $ do
+    [x,y] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+    return (x,y)
+  let m = Map.fromListWith (+)
+          [(c, 1) | (x,y):ts <- tails coords
+                  , (x',y') <- ts
+                  , let dx = x - x'
+                        dy = y - y'
+                        c | dx > 0 = (dx, dy)
+                          | dx < 0 = (-dx, -dy)
+                          | dy > 0 = (dx, dy)
+                          | otherwise = (-dx, -dy)
+                  ]
+  let k | Map.null m = 0 -- n == 1
+        | otherwise = maximum $ Map.elems m
+  print $ n - k
diff --git a/diverta2019-2-c/Main.hs b/diverta2019-2-c/Main.hs
new file mode 100644
index 0000000..a5c89db
--- /dev/null
+++ b/diverta2019-2-c/Main.hs
@@ -0,0 +1,43 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.List (unfoldr, sort)
+import Control.Monad (forM_)
+import qualified Data.Vector.Unboxed as U
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  n <- readLn
+  -- n >= 2
+  xs <- U.fromListN n . sort . unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  let (xs0, xs1) = U.span (< 0) xs
+  let (r, zs)
+        | U.length xs0 == 0 =
+            let xs10 = U.head xs1
+                xs11 = U.tail xs1
+                loop 0 !y = (U.head xs11, y) : []
+                loop i !y = let !z = xs11 U.! i
+                            in (y, z) : loop (i - 1) (y - z)
+            in (U.sum xs11 - xs10, loop (U.length xs11 - 1) xs10)
+        | U.length xs1 == 0 =
+            let xs00 = U.init xs0
+                xs01 = U.last xs0
+                loop i !y | i < 0 = []
+                          | otherwise = let !z = xs00 U.! i
+                                        in (y, z) : loop (i - 1) (y - z)
+            in (xs01 - U.sum xs00, loop (U.length xs00 - 1) xs01)
+        | otherwise =
+            let xs00 = U.init xs0
+                xs01 = U.last xs0
+                xs10 = U.head xs1
+                xs11 = U.tail xs1
+                loopP i !y | i < 0 = (xs10, y) : loopN (U.length xs00 - 1) (xs10 - y)
+                           | otherwise = let !z = xs11 U.! i
+                                         in (y, z) : loopP (i - 1) (y - z)
+                loopN i !y | i < 0 = []
+                           | otherwise = let !z = xs00 U.! i
+                                         in (y, z) : loopN (i - 1) (y - z)
+            in (U.sum xs1 - U.sum xs0, loopP (U.length xs11 - 1) xs01)
+  print r
+  forM_ zs $ \(x,y) ->
+    putStrLn $ concat [show x, " ", show y]
diff --git a/diverta2019-2-d/Main.hs b/diverta2019-2-d/Main.hs
new file mode 100644
index 0000000..555bd56
--- /dev/null
+++ b/diverta2019-2-d/Main.hs
@@ -0,0 +1,40 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.List (unfoldr, sort)
+import Control.Monad
+import qualified Data.ByteString.Char8 as BS
+import Data.Ord
+import Data.Coerce
+
+sortDown :: forall a. Ord a => [a] -> [a]
+sortDown = coerce (sort :: [Down a] -> [Down a])
+
+exchangeOne :: Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int
+exchangeOne !gA !sA !bA !gB !sB !bB !n =
+  let dg = gB - gA
+      ds = sB - sA
+      db = bB - bA
+      l = sortDown $ filter (\(d,x) -> d > 0) [(dg, gA), (ds, sA), (db, bA)]
+  in case l of
+       [] -> n
+       [(dx,xA)] -> let (qx,rx) = n `quotRem` xA
+                        -- A で qx * gA 個のどんぐりを売却し、金 qx グラムを得る。
+                        -- B で金 qx グラムを売却し、 qx * gB 個のどんぐりを得る。
+                    in n + qx * dx
+       [(dx,xA),(dy,yA)] -> maximum [ n + x * dx + y * dy
+                                    | x <- [0..n `quot` xA]
+                                    , let y = (n - x * xA) `quot` yA
+                                    ]
+       [(dx,xA),(dy,yA),(dz,zA)] -> maximum [ n + x * dx + y * dy + z * dz
+                                            | x <- [0..n `quot` xA]
+                                            , y <- [0..(n - x * xA) `quot` yA]
+                                            , let z = (n - x * xA - y * yA) `quot` zA
+                                            ]
+
+main = do
+  n <- readLn
+  [gA,sA,bA] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  [gB,sB,bB] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  print $ exchangeOne gB sB bB gA sA bA $ exchangeOne gA sA bA gB sB bB n

From 1cede9b6db8717b2552524494ed2c4922cab28c9 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Sun, 16 Jun 2019 00:47:04 +0900
Subject: [PATCH 007/148] diverta2019-2 - C: Use merge sort

---
 diverta2019-2-c/Main.hs | 32 +++++++++++++++++++++++++++++++-
 1 file changed, 31 insertions(+), 1 deletion(-)

diff --git a/diverta2019-2-c/Main.hs b/diverta2019-2-c/Main.hs
index a5c89db..e4c11d1 100644
--- a/diverta2019-2-c/Main.hs
+++ b/diverta2019-2-c/Main.hs
@@ -4,12 +4,14 @@ import Data.Char (isSpace)
 import Data.List (unfoldr, sort)
 import Control.Monad (forM_)
 import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
 import qualified Data.ByteString.Char8 as BS
 
 main = do
   n <- readLn
   -- n >= 2
-  xs <- U.fromListN n . sort . unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  -- xs <- U.fromListN n . sort . unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  xs <- mergeSortBy compare . U.unfoldrN n (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
   let (xs0, xs1) = U.span (< 0) xs
   let (r, zs)
         | U.length xs0 == 0 =
@@ -41,3 +43,31 @@ main = do
   print r
   forM_ zs $ \(x,y) ->
     putStrLn $ concat [show x, " ", show y]
+
+---
+
+mergeSortBy :: (U.Unbox a) => (a -> a -> Ordering) -> U.Vector a -> U.Vector a
+mergeSortBy !cmp !vec = doSort vec
+  where
+    doSort vec | U.length vec <= 1 = vec
+               | otherwise = let (xs, ys) = U.splitAt (U.length vec `quot` 2) vec
+                             in merge (doSort xs) (doSort ys)
+    merge xs ys = U.create $ do
+      let !n = U.length xs
+          !m = U.length ys
+      result <- UM.new (n + m)
+      let loop !i !j
+            | i == n = U.copy (UM.drop (i + j) result) (U.drop j ys)
+            | j == m = U.copy (UM.drop (i + j) result) (U.drop i xs)
+            | otherwise = let !x = xs U.! i
+                              !y = ys U.! j
+                          in case cmp x y of
+                               LT -> do UM.write result (i + j) x
+                                        loop (i + 1) j
+                               EQ -> do UM.write result (i + j) x
+                                        UM.write result (i + j + 1) y
+                                        loop (i + 1) (j + 1)
+                               GT -> do UM.write result (i + j) y
+                                        loop i (j + 1)
+      loop 0 0
+      return result

From 82e8a1a65fae6c0765f8f0afbf4a529c8b642571 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Sun, 16 Jun 2019 00:47:27 +0900
Subject: [PATCH 008/148] diverta2019-2 - D: Make a bit faster

---
 diverta2019-2-d/Main.hs | 31 ++++++++++++++++++-------------
 1 file changed, 18 insertions(+), 13 deletions(-)

diff --git a/diverta2019-2-d/Main.hs b/diverta2019-2-d/Main.hs
index 555bd56..3b0a211 100644
--- a/diverta2019-2-d/Main.hs
+++ b/diverta2019-2-d/Main.hs
@@ -19,19 +19,24 @@ exchangeOne !gA !sA !bA !gB !sB !bB !n =
       l = sortDown $ filter (\(d,x) -> d > 0) [(dg, gA), (ds, sA), (db, bA)]
   in case l of
        [] -> n
-       [(dx,xA)] -> let (qx,rx) = n `quotRem` xA
-                        -- A で qx * gA 個のどんぐりを売却し、金 qx グラムを得る。
-                        -- B で金 qx グラムを売却し、 qx * gB 個のどんぐりを得る。
-                    in n + qx * dx
-       [(dx,xA),(dy,yA)] -> maximum [ n + x * dx + y * dy
-                                    | x <- [0..n `quot` xA]
-                                    , let y = (n - x * xA) `quot` yA
-                                    ]
-       [(dx,xA),(dy,yA),(dz,zA)] -> maximum [ n + x * dx + y * dy + z * dz
-                                            | x <- [0..n `quot` xA]
-                                            , y <- [0..(n - x * xA) `quot` yA]
-                                            , let z = (n - x * xA - y * yA) `quot` zA
-                                            ]
+       [(!dx,!xA)] ->
+         let (qx,rx) = n `quotRem` xA
+             -- A で qx * gA 個のどんぐりを売却し、金 qx グラムを得る。
+             -- B で金 qx グラムを売却し、 qx * gB 個のどんぐりを得る。
+         in n + qx * dx
+       [(!dx,!xA),(!dy,!yA)] ->
+         n + maximum [ x * dx + y * dy
+                     | x <- [0..n `quot` xA]
+                     , let y = (n - x * xA) `quot` yA
+                     ]
+       [(!dx,!xA),(!dy,!yA),(!dz,!zA)] ->
+         n + maximum [ x * dx + maximum [ y * dy + z * dz
+                                        | y <- [0..n' `quot` yA]
+                                        , let z = (n' - y * yA) `quot` zA
+                                        ]
+                     | x <- [0..n `quot` xA]
+                     , let !n' = n - x * xA
+                     ]
 
 main = do
   n <- readLn

From 51bb90eb6c56b33b61ae5f37a2154d95fb15f917 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Mon, 17 Jun 2019 00:25:32 +0900
Subject: [PATCH 009/148] ABC130-A, B, C, D, E, F

---
 README.md        |  15 +++-
 abc130-a/Main.hs |   8 +++
 abc130-b/Main.hs |  11 +++
 abc130-c/Main.hs |  11 +++
 abc130-d/Main.hs |  32 +++++++++
 abc130-e/Main.hs |  76 +++++++++++++++++++++
 abc130-f/Main.hs | 174 +++++++++++++++++++++++++++++++++++++++++++++++
 7 files changed, 326 insertions(+), 1 deletion(-)
 create mode 100644 abc130-a/Main.hs
 create mode 100644 abc130-b/Main.hs
 create mode 100644 abc130-c/Main.hs
 create mode 100644 abc130-d/Main.hs
 create mode 100644 abc130-e/Main.hs
 create mode 100644 abc130-f/Main.hs

diff --git a/README.md b/README.md
index 79c3b12..9ffed0b 100644
--- a/README.md
+++ b/README.md
@@ -324,7 +324,7 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 * E - Sum Equals Xor
 * F - Takahashi's Basics in Education and Learning
 
-## diverta 2019 Programming Contest 2
+## diverta 2019 Programming Contest 2 (2019-06-15)
 
 <https://atcoder.jp/contests/diverta2019-2>
 
@@ -336,3 +336,16 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 * [x] D - Squirrel Merchant
 * [ ] E - Balanced Piles
 * [ ] F - Diverta City
+
+## AtCoder Beginner Contest 130 (2019-06-16)
+
+<https://atcoder.jp/contests/abc130>
+
+解いた問題：
+
+* [x] A - Rounding
+* [x] B - Bounding
+* [x] C - Rectangle Cutting
+* [x] D - Enough Array
+* [x] E - Common Subsequence
+* [x] F - Minimum Bounding Box
diff --git a/abc130-a/Main.hs b/abc130-a/Main.hs
new file mode 100644
index 0000000..a8f59aa
--- /dev/null
+++ b/abc130-a/Main.hs
@@ -0,0 +1,8 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  [x,a] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  print $ if x < a then 0 else 10
diff --git a/abc130-b/Main.hs b/abc130-b/Main.hs
new file mode 100644
index 0000000..9006f30
--- /dev/null
+++ b/abc130-b/Main.hs
@@ -0,0 +1,11 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import qualified Data.Vector.Unboxed as U
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  [n,x] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  ys <- U.unfoldrN n(BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  let zs = U.scanl' (+) 0 ys
+  print $ U.length $ U.takeWhile (<= x) zs
diff --git a/abc130-c/Main.hs b/abc130-c/Main.hs
new file mode 100644
index 0000000..16a4ebe
--- /dev/null
+++ b/abc130-c/Main.hs
@@ -0,0 +1,11 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  [w,h,x,y] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  let s = fromIntegral w * fromIntegral h / 2
+  let t | x * 2 == w && y * 2 == h = 1
+        | otherwise = 0
+  putStrLn $ unwords [show s, show t]
diff --git a/abc130-d/Main.hs b/abc130-d/Main.hs
new file mode 100644
index 0000000..afce6dd
--- /dev/null
+++ b/abc130-d/Main.hs
@@ -0,0 +1,32 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.Int
+import Data.List (unfoldr)
+import qualified Data.Vector.Unboxed as U
+import qualified Data.ByteString.Char8 as BS
+
+-- let k = search v f i j
+-- => (k < j || f k) && (k == i || not (f (k-1)))
+search :: (U.Unbox a) => U.Vector a -> (a -> Bool) -> Int -> Int -> Int
+search !v !f !i !j
+  | i >= j = error "bad input"
+  | f (v U.! i) = i
+  | otherwise = loop i j
+  where loop !i !j | j == i + 1 = j
+                   | f (v U.! k) = loop i k
+                   | otherwise = loop k j
+          where k = (i + j) `quot` 2
+
+
+main = do
+  [n,k] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  xs <- U.map fromIntegral . U.unfoldrN n (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  let ys :: U.Vector Int64
+      ys = U.scanl' (+) 0 xs
+      loop !acc !i | i >= U.length ys = acc
+                   | ys U.! i < fromIntegral k = loop acc (i+1)
+                   | otherwise = let y = ys U.! i
+                                     j = search ys (> y - fromIntegral k) 0 i
+                                 in loop (acc + fromIntegral j) (i+1)
+  print (loop 0 1 :: Int64)
diff --git a/abc130-e/Main.hs b/abc130-e/Main.hs
new file mode 100644
index 0000000..b51e487
--- /dev/null
+++ b/abc130-e/Main.hs
@@ -0,0 +1,76 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+import Data.Char (isSpace)
+import Data.Int
+import Data.List (unfoldr)
+import Control.Monad
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+import Data.Array.ST
+import Control.Monad.ST
+---
+import qualified Data.Array.Base
+import qualified Unsafe.Coerce
+import Data.Coerce
+
+main = do
+  [n,m] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  ss <- U.unfoldrN n (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  ts <- U.unfoldrN m (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  let result :: N
+      result = runST $ do
+        arr <- asSTUArray $ newArray ((-1,-1),(n-1,m-1)) 0
+        forM_ [-1..n-1] $ \i -> writeArray arr (i,-1) 1
+        forM_ [-1..m-1] $ \j -> writeArray arr (-1,j) 1
+        flip U.imapM_ ss $ \i s -> do
+          flip U.imapM_ ts $ \j t -> do
+            a <- readArray arr (i-1,j-1)
+            b <- readArray arr (i-1,j)
+            c <- readArray arr (i,j-1)
+            writeArray arr (i,j) $! if s == t
+                                    then b + c
+                                    else b + c - a
+        readArray arr (n-1,m-1)
+  print result
+
+---
+
+modulo :: Int64
+modulo = 10^9+7
+addMod, subMod, mulMod :: Int64 -> Int64 -> Int64
+addMod !x !y = (x + y) `rem` modulo
+subMod !x !y = (x - y) `mod` modulo
+mulMod !x !y = (x * y) `rem` modulo
+
+newtype N = N { unwrapN :: Int64 } deriving (Eq)
+instance Show N where
+  show (N x) = show x
+instance Num N where
+  N x + N y = N ((x + y) `rem` modulo)
+  N x - N y = N ((x - y) `mod` modulo)
+  N x * N y = N ((x * y) `rem` modulo)
+  fromInteger n = N (fromInteger (n `mod` fromIntegral modulo))
+  abs = undefined; signum = undefined
+
+---
+
+--- STUArray s i N
+
+unsafeCoerce_STUArray_N_Int :: STUArray s i N -> STUArray s i Int64
+unsafeCoerce_STUArray_N_Int = Unsafe.Coerce.unsafeCoerce
+unsafeCoerce_STUArray_Int_N :: STUArray s i Int64 -> STUArray s i N
+unsafeCoerce_STUArray_Int_N = Unsafe.Coerce.unsafeCoerce
+
+instance Data.Array.Base.MArray (STUArray s) N (ST s) where
+  getBounds arr = Data.Array.Base.getBounds (unsafeCoerce_STUArray_N_Int arr)
+  getNumElements arr = Data.Array.Base.getNumElements (unsafeCoerce_STUArray_N_Int arr)
+  newArray lu e = unsafeCoerce_STUArray_Int_N <$> Data.Array.Base.newArray lu (coerce e)
+  newArray_ lu = unsafeCoerce_STUArray_Int_N <$> Data.Array.Base.newArray_ lu
+  unsafeNewArray_ lu = unsafeCoerce_STUArray_Int_N <$> Data.Array.Base.unsafeNewArray_ lu
+  unsafeRead arr i = coerce <$> Data.Array.Base.unsafeRead (unsafeCoerce_STUArray_N_Int arr) i
+  unsafeWrite arr i e = Data.Array.Base.unsafeWrite (unsafeCoerce_STUArray_N_Int arr) i (coerce e)
+
+asSTUArray :: ST s (STUArray s i a) -> ST s (STUArray s i a)
+asSTUArray arr = arr
diff --git a/abc130-f/Main.hs b/abc130-f/Main.hs
new file mode 100644
index 0000000..d5240ce
--- /dev/null
+++ b/abc130-f/Main.hs
@@ -0,0 +1,174 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import Control.Monad
+import qualified Data.Vector.Unboxed as U
+import qualified Data.ByteString.Char8 as BS
+
+bounds :: U.Vector (Int,Int) -> (Int, Int, Int, Int)
+bounds = U.foldl' (\(!r,!l,!u,!d) (x,y) ->
+                     let !r' = max r x
+                         !l' = min l x
+                         !u' = max u y
+                         !d' = min d y
+                     in (r',l',u',d')) (minBound, maxBound, minBound, maxBound)
+
+data OrInfinity a = Finite a
+                  | Infinity
+                  deriving (Eq,Ord,Show)
+
+type Time = OrInfinity Rational
+
+-- 有理数の区間ごとに定義された関数を表す型。
+-- Piecewise (Rational, Rational) は区分的に1次（以下の）多項式。
+-- Piecewise (Rational, Rational, Rational) は区分的に2次（以下の）多項式。
+-- いずれも係数を降べきの順に持ったタプルで表す。
+type Piecewise a = [(Time,Time,a)]
+
+lift1 :: (Time -> Time -> a -> [(Time,Time,b)]) -> [(Time,Time,a)] -> [(Time,Time,b)]
+lift1 f xs = concat
+  [ f t0 t1 x
+  | (t0,t1,x) <- xs
+  ]
+
+lift2 :: (Time -> Time -> a -> a -> [(Time,Time,b)]) -> [(Time,Time,a)] -> [(Time,Time,a)] -> [(Time,Time,b)]
+lift2 f xs ys = concat
+  [ f s0 s1 x y
+  | (t0,t1,x) <- xs
+  , (u0,u1,y) <- ys
+  , t0 <= u1 && u0 <= t1
+  , let s0 = max t0 u0
+        s1 = min t1 u1
+  ]
+
+simple :: (a -> a -> b) -> [(Time,Time,a)] -> [(Time,Time,a)] -> [(Time,Time,b)]
+simple f xs ys =
+  [ (s0, s1, f x y)
+  | (t0,t1,x) <- xs
+  , (u0,u1,y) <- ys
+  , t0 <= u1 && u0 <= t1
+  , let s0 = max t0 u0
+        s1 = min t1 u1
+  ]
+
+maxFn :: Piecewise (Rational, Rational) -> Piecewise (Rational, Rational) -> Piecewise (Rational, Rational)
+maxFn = lift2 $ \t0 t1 (a,b) (a',b') ->
+                  if a == a'
+                  then [(t0,t1,(a, max b b'))]
+                  else let tx = (b' - b) / (a - a')
+                       in if t0 <= Finite tx && Finite tx <= t1
+                          then [(t0,Finite tx,min (a, b) (a', b'))
+                               ,(Finite tx,t1,max (a, b) (a', b'))
+                               ]
+                          else case t0 of
+                                 Finite t0' -> if (a * t0' + b) < (a' * t0' + b')
+                                               then [(t0,t1,(a',b'))]
+                                               else [(t0,t1,(a,b))]
+
+minFn :: Piecewise (Rational, Rational) -> Piecewise (Rational, Rational) -> Piecewise (Rational, Rational)
+minFn = lift2 $ \t0 t1 (a,b) (a',b') ->
+                  if a == a'
+                  then [(t0,t1,(a, min b b'))]
+                  else let tx = (b' - b) / (a - a')
+                       in if t0 <= Finite tx && Finite tx <= t1
+                          then [(t0,Finite tx,max (a, b) (a', b'))
+                               ,(Finite tx,t1,min (a, b) (a', b'))
+                               ]
+                          else case t0 of
+                                 Finite t0' -> if (a * t0' + b) < (a' * t0' + b')
+                                               then [(t0,t1,(a,b))]
+                                               else [(t0,t1,(a',b'))]
+
+addFn :: Piecewise (Rational, Rational) -> Piecewise (Rational, Rational) -> Piecewise (Rational, Rational)
+addFn = simple (\(a,b) (a',b') -> (a + a', b + b'))
+subFn :: Piecewise (Rational, Rational) -> Piecewise (Rational, Rational) -> Piecewise (Rational, Rational)
+subFn = simple (\(a,b) (a',b') -> (a - a', b - b'))
+mulFn :: Piecewise (Rational, Rational) -> Piecewise (Rational, Rational) -> Piecewise (Rational, Rational, Rational)
+mulFn = simple (\(a,b) (a',b') -> (a * a', a * b' + b * a', b * b'))
+
+-- 区間ごとの最小値と、それを実現する引数（デバッグ用）を返す
+minimalQ :: Piecewise (Rational, Rational, Rational) -> Piecewise (Rational, Rational)
+minimalQ = lift1 $ \t0 t1 (a,b,c) -> [(t0,t1,getMin t0 t1 (a,b,c))]
+  where
+    getMin (Finite t0) t1 (0,0,c) = (c, t0)
+    getMin (Finite t0) (Finite t1) (0,b,c) = min (b * t0 + c, t0) (b * t1 + c, t1)
+    getMin (Finite t0) Infinity (0,b,c) | b > 0 = (b * t0 + c, t0)
+    getMin _ _ (0,_,_) = error "no minimum"
+    getMin (Finite t0) (Finite t1) (a,b,c)
+      | a > 0 = let tx = -b/(2*a)
+                in (case () of
+                     _ | t0 <= tx, tx <= t1 -> ((a * tx + b) * tx + c, tx)
+                       | tx < t0            -> ((a * t0 + b) * t0 + c, t0)
+                       | otherwise          -> ((a * t1 + b) * t1 + c, t1)
+                   )
+      | a < 0 = min ((a * t0 + b) * t0 + c, t0)
+                    ((a * t1 + b) * t1 + c, t1)
+    getMin (Finite t0) Infinity (a,b,c)
+      | a > 0 = let tx = -b/(2*a)
+                in if t0 <= tx
+                   then ((a * tx + b) * tx + c, tx)
+                   else ((a * t0 + b) * t0 + c, t0)
+      | a < 0 = error "no minimum"
+
+simpleFn :: a -> Piecewise a
+simpleFn x = [(Finite 0,Infinity,x)]
+
+main = do
+  n <- readLn
+  points <- U.replicateM n $ do
+    [x',y',d'] <- BS.words <$> BS.getLine
+    let Just (x, _) = BS.readInt x'
+    let Just (y, _) = BS.readInt y'
+    return (x, y, BS.head d')
+  let rightwards = U.map (\(x,y,d) -> (x,y)) $ U.filter (\(x,y,d) -> d == 'R') points
+      leftwards = U.map (\(x,y,d) -> (x,y)) $ U.filter (\(x,y,d) -> d == 'L') points
+      upwards = U.map (\(x,y,d) -> (x,y)) $ U.filter (\(x,y,d) -> d == 'U') points
+      downwards = U.map (\(x,y,d) -> (x,y)) $ U.filter (\(x,y,d) -> d == 'D') points
+      (rR,lR,uR,dR) = bounds rightwards
+      (rL,lL,uL,dL) = bounds leftwards
+      (rU,lU,uU,dU) = bounds upwards
+      (rD,lD,uD,dD) = bounds downwards
+      rF = maxFn (simpleFn (1,fromIntegral rR)) $ maxFn (simpleFn (-1,fromIntegral rL)) (simpleFn (0,fromIntegral $ max rU rD))
+      lF = minFn (simpleFn (1,fromIntegral lR)) $ minFn (simpleFn (-1,fromIntegral lL)) (simpleFn (0,fromIntegral $ min lU lD))
+      wF = subFn rF lF
+      uF = maxFn (simpleFn (1,fromIntegral uU)) $ maxFn (simpleFn (-1,fromIntegral uD)) (simpleFn (0,fromIntegral $ max uR uL))
+      dF = minFn (simpleFn (1,fromIntegral dU)) $ minFn (simpleFn (-1,fromIntegral dD)) (simpleFn (0,fromIntegral $ min dR dL))
+      hF = subFn uF dF
+      targetFn = mulFn wF hF
+      (resultQ, tx) = minimum $ map (\(_,_,x) -> x) $ minimalQ targetFn
+      result :: Double
+      result = fromRational resultQ
+  print result
+
+-- 以下、デバッグ用
+
+valueAt :: Rational -> IO (Rational, Rational, Rational, Rational, Rational)
+valueAt t = do
+  n <- readLn
+  points <- replicateM n $ do
+    [x',y',d'] <- BS.words <$> BS.getLine
+    let Just (x, _) = BS.readInt x'
+    let Just (y, _) = BS.readInt y'
+    return (fromIntegral x, fromIntegral y, BS.head d')
+  let mp = map (\(x,y,d) -> case d of
+                     'R' -> (x+t,y)
+                     'L' -> (x-t,y)
+                     'U' -> (x,y+t)
+                     'D' -> (x,y-t)
+                 ) points
+      xmin = minimum $ map fst mp
+      xmax = maximum $ map fst mp
+      ymin = minimum $ map snd mp
+      ymax = maximum $ map snd mp
+  return $ ((xmax - xmin) * (ymax - ymin), xmin, xmax, ymin, ymax)
+
+at :: Rational -> Piecewise a -> a
+at x xs = head [ y
+               | (t0,t1,y) <- xs
+               , t0 <= Finite x && Finite x <= t1
+               ]
+
+atL :: Rational -> Piecewise (Rational, Rational) -> Rational
+atL x xs = case at x xs of
+             (a, b) -> a * x + b

From 909135616903867e880f7414c0cfcc758db7f9ff Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Mon, 17 Jun 2019 00:50:28 +0900
Subject: [PATCH 010/148] Update README

---
 README.md | 145 +++++++++++++++++++++++++++++++-----------------------
 1 file changed, 84 insertions(+), 61 deletions(-)

diff --git a/README.md b/README.md
index 9ffed0b..d8d513b 100644
--- a/README.md
+++ b/README.md
@@ -56,10 +56,12 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 
 解いた問題：
 
-* A - Colorful Subsequence
-* B - Reversi
-* C - Differ by 1 Bit
-* D - A Sequence of Permutations
+* [x] A - Colorful Subsequence
+* [x] B - Reversi
+* [x] C - Differ by 1 Bit
+* [x] D - A Sequence of Permutations
+* [ ] E - Snuke the Phantom Thief
+* [ ] F - Walk on Graph
 
 ## AtCoder Grand Contest 032 (2019-03-23)
 
@@ -67,8 +69,12 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 
 解いた問題：
 
-* A - Limited Insertion
-* B - Balanced Neighbors
+* [x] A - Limited Insertion
+* [x] B - Balanced Neighbors
+* [ ] C - Three Circuits
+* [ ] D - Rotation Sort
+* [ ] E - Modulo Pairing
+* [ ] F - One Third
 
 ## AtCoder Beginner Contest 122 (2019-03-24)
 
@@ -76,10 +82,10 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 
 解いた問題：
 
-* A - Double Helix
-* B - ATCoder
-* C - GeT AC
-* D - We Like AGC
+* [x] A - Double Helix
+* [x] B - ATCoder
+* [x] C - GeT AC
+* [x] D - We Like AGC
     * Fast: 5項間漸化式を立てた（配列を使わない）。ただし想定解法と同じく O(n)
     * Small: 想定解法
     * MatPow, PolyDiv: O(log n) の解法
@@ -91,10 +97,10 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 
 解いた問題：
 
-* A - White Cells
-* B - Can you solve this?
-* C - Energy Drink Collector
-* D - XOR World
+* [x] A - White Cells
+* [x] B - Can you solve this?
+* [x] C - Energy Drink Collector
+* [x] D - XOR World
 
 ## AtCoder Beginner Contest 120
 
@@ -102,10 +108,10 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 
 解いた問題：
 
-* A - Favorite Sound
-* B - K-th Common Divisor
-* C - Unification
-* D - Decayed Bridges
+* [x] A - Favorite Sound
+* [x] B - K-th Common Divisor
+* [x] C - Unification
+* [x] D - Decayed Bridges
 
 ## エクサウィザーズ 2019 (2019-03-30)
 
@@ -113,9 +119,12 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 
 解いた問題：
 
-* A - Regular Triangle
-* B - Red or Blue
-* E - Black or White
+* [x] A - Regular Triangle
+* [x] B - Red or Blue
+* [ ] C - Snuke the Wizard
+* [ ] D - Modulo Operations
+* [x] E - Black or White
+* [ ] F - More Realistic Manhattan Distance
 
 ## AtCoder Grand Contest 023
 
@@ -131,10 +140,10 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 
 解いた問題：
 
-* A - Buttons
-* B - Great Ocean View
-* C - Coloring Colorfully
-* D - Handstand
+* [x] A - Buttons
+* [x] B - Great Ocean View
+* [x] C - Coloring Colorfully
+* [x] D - Handstand
 
 ## Tenka1 Programmer Contest 2019 (2019-04-20)
 
@@ -142,8 +151,10 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 
 解いた問題：
 
-* C - Stones
-* E - Polynomial Divisors
+* [x] C - Stones
+* [ ] D - Three Colors
+* [x] E - Polynomial Divisors
+* [ ] F - Banned X
 
 ## AtCoder Beginner Contest 125 (2019-04-27)
 
@@ -151,10 +162,10 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 
 解いた問題：
 
-* A - Biscuit Generator
-* B - Resale
-* C - GCD on Blackboard
-* D - Flipping Signs
+* [x] A - Biscuit Generator
+* [x] B - Resale
+* [x] C - GCD on Blackboard
+* [x] D - Flipping Signs
 
 ## エイシングプログラミングコンテスト2019
 
@@ -251,10 +262,12 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 
 解いた問題：
 
-* A - Consecutive Integers
-* B - RGB Boxes
-* C - AB Substrings
-* D - DivRem Number
+* [x] A - Consecutive Integers
+* [x] B - RGB Boxes
+* [x] C - AB Substrings
+* [x] D - DivRem Number
+* [ ] E - XOR Partitioning
+* [ ] F - Edge Ordering
 
 ## AtCoder Beginner Contest 126 (2019-05-19)
 
@@ -262,12 +275,12 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 
 解いた問題：
 
-* A - Changing a Character
-* B - YYMM or MMYY
-* C - Dice and Coin
-* D - Even Relation
-* E - 1 or 2
-* F - XOR Matching
+* [x] A - Changing a Character
+* [x] B - YYMM or MMYY
+* [x] C - Dice and Coin
+* [x] D - Even Relation
+* [x] E - 1 or 2
+* [x] F - XOR Matching
 
 ## AtCoder Beginner Contest 127
 
@@ -275,10 +288,12 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 
 解いた問題：
 
-* A - Ferris Wheel
-* B - Algae
-* C - Prison
-* D - Integer Cards
+* [x] A - Ferris Wheel
+* [x] B - Algae
+* [x] C - Prison
+* [x] D - Integer Cards
+* [ ] E - Cell Distance
+* [ ] F - Absolute Minima
 
 ## AtCoder Beginner Contest 128 (2019-05-26)
 
@@ -286,11 +301,12 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 
 解いた問題：
 
-* A - Apple Pie
-* B - Guidebook
-* C - Switches
-* D - equeue
-* E - Roadwork
+* [x] A - Apple Pie
+* [x] B - Guidebook
+* [x] C - Switches
+* [x] D - equeue
+* [x] E - Roadwork
+* [ ] F - Frog Jump
 
 ## M-SOLUTIONS プロコンオープン (2019-06-01)
 
@@ -298,9 +314,12 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 
 解いた問題：
 
-* A - Sum of Interior Angles
-* B - Sumo
-* E - Product of Arithmetic Progression
+* [x] A - Sum of Interior Angles
+* [x] B - Sumo
+* [ ] C - Best-of-(2n-1)
+* [ ] D - Maximum Sum of Minimum
+* [x] E - Product of Arithmetic Progression
+* [ ] F - Random Tournament
 
 ## AtCoder Grand Contest 034 (2019-06-02)
 
@@ -308,8 +327,12 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 
 解いた問題：
 
-* A - Kenken Race
-* B - ABC
+* [x] A - Kenken Race
+* [x] B - ABC
+* [ ] C - Tests
+* [ ] D - Manhattan Max Matching
+* [ ] E - Complete Compress
+* [ ] F - RNG and XOR
 
 ## AtCoder Beginner Contest 129 (2019-06-09)
 
@@ -317,12 +340,12 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 
 解いた問題：
 
-* A - Airplane
-* B - Balance
-* C - Typical Stairs
-* D - Lamp
-* E - Sum Equals Xor
-* F - Takahashi's Basics in Education and Learning
+* [x] A - Airplane
+* [x] B - Balance
+* [x] C - Typical Stairs
+* [x] D - Lamp
+* [x] E - Sum Equals Xor
+* [x] F - Takahashi's Basics in Education and Learning
 
 ## diverta 2019 Programming Contest 2 (2019-06-15)
 

From cc60082761883992121c873a61f0f61e45fc1257 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Mon, 17 Jun 2019 16:59:49 +0900
Subject: [PATCH 011/148] ABC130-E: Add a version with
 Data.Vector.Unboxed.scanl

---
 abc130-e/Main.hs |   1 -
 abc130-e/Vec.hs  | 107 +++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 107 insertions(+), 1 deletion(-)
 create mode 100644 abc130-e/Vec.hs

diff --git a/abc130-e/Main.hs b/abc130-e/Main.hs
index b51e487..2c4963a 100644
--- a/abc130-e/Main.hs
+++ b/abc130-e/Main.hs
@@ -6,7 +6,6 @@ import Data.Int
 import Data.List (unfoldr)
 import Control.Monad
 import qualified Data.Vector.Unboxed as U
-import qualified Data.Vector.Unboxed.Mutable as UM
 import qualified Data.ByteString.Char8 as BS
 import Data.Array.ST
 import Control.Monad.ST
diff --git a/abc130-e/Vec.hs b/abc130-e/Vec.hs
new file mode 100644
index 0000000..734381f
--- /dev/null
+++ b/abc130-e/Vec.hs
@@ -0,0 +1,107 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+import Data.Char (isSpace)
+import Data.Int (Int64)
+import Data.List (unfoldr)
+import qualified Data.Vector.Unboxed as U
+import qualified Data.ByteString.Char8 as BS
+---
+import Data.Coerce
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.Vector.Generic
+import qualified Data.Vector.Generic.Mutable
+
+main = do
+  [n,m] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  ss <- U.unfoldrN n (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  ts <- U.unfoldrN m (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  let v0 :: U.Vector N
+      v0 = U.replicate (m + 1) 1
+      step :: U.Vector N -> Int -> U.Vector N
+      step v !s = U.scanl' (\c (t,a,b) -> if s == t then b + c else b + c - a) 1 $ U.zip3 ts v (U.tail v)
+  print $ U.last $ U.foldl' step v0 ss
+
+---
+
+modulo :: Int64
+modulo = 10^9+7
+
+addMod, subMod, mulMod :: Int64 -> Int64 -> Int64
+addMod !x !y | x + y >= modulo = x + y - modulo
+             | otherwise = x + y
+subMod !x !y | x >= y = x - y
+             | otherwise = x - y + modulo
+mulMod !x !y = (x * y) `rem` modulo
+{-# INLINE addMod #-}
+{-# INLINE subMod #-}
+
+newtype N = N { unwrapN :: Int64 } deriving (Eq)
+instance Show N where
+  show (N x) = show x
+instance Num N where
+  (+) = coerce addMod
+  (-) = coerce subMod
+  (*) = coerce mulMod
+  fromInteger n = N (fromInteger (n `mod` fromIntegral modulo))
+  abs = undefined; signum = undefined
+  {-# INLINE (+) #-}
+  {-# INLINE (-) #-}
+  {-# INLINE (*) #-}
+  {-# INLINE fromInteger #-}
+
+{-# RULES
+"^9/Int" forall x. x ^ (9 :: Int) = let u = x; v = u * u * u in v * v * v
+"^9/Integer" forall x. x ^ (9 :: Integer) = let u = x; v = u * u * u in v * v * v
+ #-}
+
+---
+
+newtype instance UM.MVector s N = MV_N (UM.MVector s Int64)
+newtype instance U.Vector N = V_N (U.Vector Int64)
+
+instance Data.Vector.Generic.Mutable.MVector UM.MVector N where -- needs MultiParamTypeClasses here
+  basicLength (MV_N mv) = Data.Vector.Generic.Mutable.basicLength mv
+  basicUnsafeSlice i l (MV_N mv) = MV_N (Data.Vector.Generic.Mutable.basicUnsafeSlice i l mv)
+  basicOverlaps (MV_N mv) (MV_N mv') = Data.Vector.Generic.Mutable.basicOverlaps mv mv'
+  basicUnsafeNew l = MV_N <$> Data.Vector.Generic.Mutable.basicUnsafeNew l
+  basicInitialize (MV_N mv) = Data.Vector.Generic.Mutable.basicInitialize mv
+  basicUnsafeReplicate i x = MV_N <$> Data.Vector.Generic.Mutable.basicUnsafeReplicate i (coerce x)
+  basicUnsafeRead (MV_N mv) i = coerce <$> Data.Vector.Generic.Mutable.basicUnsafeRead mv i
+  basicUnsafeWrite (MV_N mv) i x = Data.Vector.Generic.Mutable.basicUnsafeWrite mv i (coerce x)
+  basicClear (MV_N mv) = Data.Vector.Generic.Mutable.basicClear mv
+  basicSet (MV_N mv) x = Data.Vector.Generic.Mutable.basicSet mv (coerce x)
+  basicUnsafeCopy (MV_N mv) (MV_N mv') = Data.Vector.Generic.Mutable.basicUnsafeCopy mv mv'
+  basicUnsafeMove (MV_N mv) (MV_N mv') = Data.Vector.Generic.Mutable.basicUnsafeMove mv mv'
+  basicUnsafeGrow (MV_N mv) n = MV_N <$> Data.Vector.Generic.Mutable.basicUnsafeGrow mv n
+  {-# INLINE basicLength #-}
+  {-# INLINE basicUnsafeSlice #-}
+  {-# INLINE basicOverlaps #-}
+  {-# INLINE basicUnsafeNew #-}
+  {-# INLINE basicInitialize #-}
+  {-# INLINE basicUnsafeRead #-}
+  {-# INLINE basicUnsafeWrite #-}
+  {-# INLINE basicClear #-}
+  {-# INLINE basicSet #-}
+  {-# INLINE basicUnsafeCopy #-}
+  {-# INLINE basicUnsafeMove #-}
+  {-# INLINE basicUnsafeGrow #-}
+
+instance Data.Vector.Generic.Vector U.Vector N where -- needs MultiParamTypeClasses here
+  basicUnsafeFreeze (MV_N mv) = V_N <$> Data.Vector.Generic.basicUnsafeFreeze mv
+  basicUnsafeThaw (V_N v) = MV_N <$> Data.Vector.Generic.basicUnsafeThaw v
+  basicLength (V_N v) = Data.Vector.Generic.basicLength v
+  basicUnsafeSlice i l (V_N v) = V_N (Data.Vector.Generic.basicUnsafeSlice i l v)
+  basicUnsafeIndexM (V_N v) i = coerce <$> Data.Vector.Generic.basicUnsafeIndexM v i
+  basicUnsafeCopy (MV_N mv) (V_N v) = Data.Vector.Generic.basicUnsafeCopy mv v
+  elemseq (V_N v) x y = Data.Vector.Generic.elemseq v (coerce x) y
+  {-# INLINE basicUnsafeFreeze #-}
+  {-# INLINE basicUnsafeThaw #-}
+  {-# INLINE basicLength #-}
+  {-# INLINE basicUnsafeSlice #-}
+  {-# INLINE basicUnsafeIndexM #-}
+  {-# INLINE basicUnsafeCopy #-}
+  {-# INLINE elemseq #-}
+
+instance U.Unbox N

From 8ebc585f4acbfae9d92832f6a5fcde59055abc72 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Mon, 17 Jun 2019 08:00:06 +0000
Subject: [PATCH 012/148] Modular arithmetic: Make a bit faster

---
 lib/ModularArithmetic.hs | 28 +++++++++++++++++++++-------
 1 file changed, 21 insertions(+), 7 deletions(-)

diff --git a/lib/ModularArithmetic.hs b/lib/ModularArithmetic.hs
index 68e715c..a438272 100644
--- a/lib/ModularArithmetic.hs
+++ b/lib/ModularArithmetic.hs
@@ -3,23 +3,32 @@
 {-# LANGUAGE TypeFamilies #-}
 module ModularArithmetic where
 import Data.Int
+import Data.Coerce
 
 modulo :: Int64
 modulo = 10^9+7
 addMod, subMod, mulMod :: Int64 -> Int64 -> Int64
-addMod !x !y = (x + y) `rem` modulo
-subMod !x !y = (x - y) `mod` modulo
+addMod !x !y | x + y >= modulo = x + y - modulo
+             | otherwise = x + y
+subMod !x !y | x >= y = x - y
+             | otherwise = x - y + modulo
 mulMod !x !y = (x * y) `rem` modulo
+{-# INLINE addMod #-}
+{-# INLINE subMod #-}
 
 newtype N = N { unwrapN :: Int64 } deriving (Eq)
 instance Show N where
   show (N x) = show x
 instance Num N where
-  N x + N y = N ((x + y) `rem` modulo)
-  N x - N y = N ((x - y) `mod` modulo)
-  N x * N y = N ((x * y) `rem` modulo)
+  (+) = coerce addMod
+  (-) = coerce subMod
+  (*) = coerce mulMod
   fromInteger n = N (fromInteger (n `mod` fromIntegral modulo))
   abs = undefined; signum = undefined
+  {-# INLINE (+) #-}
+  {-# INLINE (-) #-}
+  {-# INLINE (*) #-}
+  {-# INLINE fromInteger #-}
 
 exEuclid :: (Eq a, Integral a) => a -> a -> (a, a, a)
 exEuclid !f !g = loop 1 0 0 1 f g
@@ -36,6 +45,11 @@ divM :: Int64 -> Int64 -> Int64
 divM !x !y = x `mulMod` recipM y
 
 instance Fractional N where
-  N x / N y = N (divM x y)
-  recip (N x) = N (recipM x)
+  (/) = coerce divM
+  recip = coerce recipM
   fromRational = undefined
+
+{-# RULES
+"^9/Int" forall x. x ^ (9 :: Int) = let u = x; v = u * u * u in v * v * v
+"^9/Integer" forall x. x ^ (9 :: Integer) = let u = x; v = u * u * u in v * v * v
+ #-}

From 121d58d8f8f3cf59fcd9d4b793dd7a694fa555ab Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Mon, 17 Jun 2019 17:24:00 +0900
Subject: [PATCH 013/148] =?UTF-8?q?=E3=80=8CHaskell=E3=81=A7=E7=AB=B6?=
 =?UTF-8?q?=E6=8A=80=E3=83=97=E3=83=AD=E3=82=B0=E3=83=A9=E3=83=9F=E3=83=B3?=
 =?UTF-8?q?=E3=82=B0=E3=82=92=E3=82=84=E3=82=8B=E3=80=8D=E3=82=92=E6=9B=B4?=
 =?UTF-8?q?=E6=96=B0?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 competitive-programming-with-haskell.md | 76 ++++++++++++++++++++++++-
 1 file changed, 75 insertions(+), 1 deletion(-)

diff --git a/competitive-programming-with-haskell.md b/competitive-programming-with-haskell.md
index 9a3192a..99e871c 100644
--- a/competitive-programming-with-haskell.md
+++ b/competitive-programming-with-haskell.md
@@ -30,6 +30,29 @@
     * 1次元ならVector, 2次元以上ならArrayを使う。ただ、2次元以上でもVectorを使う（Vectorを2段重ね）と良いことがある。Vectorには `scan` があったり、タプルのunboxed vectorを作れたりするので。
     * ランダムアクセスせず、fold系操作をするだけならリストでも良い。
     * 固定長整数や浮動小数点数からなる配列にはunboxed array / vector を使う。newtypeと相性が悪いので注意。unboxed vectorの要素型はタプルでも良い。
+    * unboxed arrayを使えば通るアルゴリズムが、boxed arrayだと（たとえ正格評価していても）TLEする場合がある。
+        * STUArray版 (AC): https://atcoder.jp/contests/dp/submissions/5890874
+        * STArray版 (TLE): https://atcoder.jp/contests/dp/submissions/5890929 `writeArray` 時に `$!` で正格評価しているにも関わらずTLEとなった。
+
+`newArray` を使うと型が曖昧になる恐れがある（`IOArray` vs `IOUArray`, `STArray` vs `STUArray`）。
+TypeApplications拡張が使えない今は
+
+```haskell
+asSTUArray :: ST s (STUArray s i e) -> ST s (STUArray s i e)
+asSTUArray = id
+```
+
+みたいな補助関数を作って
+
+```haskell
+arr <- asSTUArray $ newArray ((0,0),(n,n)) 0
+```
+
+という風にするのが精一杯か。
+
+## 全探索
+
+リスト内包表記やリストモナドを使うと、ネストが深くならずに済む。
 
 ## モジュラー計算
 
@@ -52,6 +75,53 @@ ABC129-Fのように法が実行時に与えられる場合は、reflectionパ
 
 に書いたようなテクニックを使うと良い。ただし、Zero/Succのみで自然数を表現すると値に比例する数のデータ構築子を使うことになってよろしくない。自然数の2進表現を使うと値の桁数に比例する数のデータ構築子で済む（元論文を参照）。
 
+### `rem` vs `mod`
+
+整数を割ったあまりを計算する方法としてHaskell標準には `rem` と `mod` があり、これらはオペランドの符号が異なる場合の挙動が違う。
+
+```haskell
+> 7 `mod` 5
+2
+> (-7) `mod` 5
+3
+> 7 `mod` (-5)
+-3
+> (-7) `mod` (-5)
+-2
+> 7 `rem` 5
+2
+> (-7) `rem` 5
+-2
+> 7 `rem` (-5)
+2
+> (-7) `rem` (-5)
+-2
+```
+
+実行速度で言うと、 **`rem`の方が速い** ので、どちらでも良い場合（両方のオペランドが非負であるとわかっている場合）は `rem` を使おう。
+
+### `10^9` の定数畳み込み
+
+ソースコードに `10^9` と書いた場合、GHCは `10^9` の定数畳み込みを行わない。
+素直にゼロを9個書くという手もあるのだが、ここでは可読性を重視してゼロを9個書かずに済ませる方法を考える。
+
+べき乗関数 `(^)` に関しては指数が小さい時にrewrite ruleによって単純な積へ書き換えられるが、現状は5乗までしか定義されていない。
+9乗に関するrewrite ruleを定義してやれば、 `10^9` の定数畳み込みが行われるようになる：
+
+```haskell
+{-# RULES
+"^9/Int" forall x. x ^ (9 :: Int) = let u = x; v = u * u * u in v * v * v
+"^9/Integer" forall x. x ^ (9 :: Integer) = let u = x; v = u * u * u in v * v * v
+ #-}
+```
+
+最後の行の `#-}` が行頭にあるのとGHC 7.10.3が文句を言うので、空白を開けておくこと。
+
+別の方法としては、NumDecimals拡張を有効にして `1e9` と書くという方法がある。
+こちらの方が手軽かもしれない。
+
+NumericUnderscores拡張を使うとゼロが多い整数リテラルを `1_000_000_000` という風に区切り文字を入れて書けるが、GHC 8.6以降というかなり新しいGHCが必要となる。
+
 ## 可変な変数
 
 `Int` 1個を保持するのに `IORef` や `STRef` はボックス化のコストがあって効率が悪い。
@@ -105,6 +175,8 @@ unsafeCoerce_UArray_Int_N = Unsafe.Coerce.unsafeCoerce
 
 を参照せよ。
 
+競技プログラミング外で自由にパッケージを使える環境の場合、unboxed vectorに関しては、筆者が作っている [unboxing-vectorパッケージ](https://hackage.haskell.org/package/unboxing-vector) を使うとnewtype時に記述量が少なくて済む。
+
 ## IntSet
 
 `IntSet` を舐める際にいちいちリストに変換するのがだるい、という場合は
@@ -133,7 +205,9 @@ foldMap_IntSet f set = go set
 
 ## ソート
 
-標準のリストのソートは遅い。
+標準のリストのソート (`Data.List.sort`) は遅い。
+
+標準のリストのソートを使ったせいでTLEとなったケースには筆者は（まだ）遭遇していないが、より高速な代替手段を用意しておくと精神的に楽である。
 
 vector-algorithmsパッケージの各種アルゴリズムが使えると良いのだが、現状使えないようなので自分でソートアルゴリズムを書こう。
 実装例は [abc127-d/Main.hs](abc127-d/Main.hs) を参照（この問題は標準のリストのソートでも十分ACできる）。

From 69ed77b86c03ca69a19359b498d96deef4b7e497 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Mon, 17 Jun 2019 17:35:51 +0900
Subject: [PATCH 014/148] =?UTF-8?q?=E3=80=8CHaskell=E3=81=A7=E7=AB=B6?=
 =?UTF-8?q?=E6=8A=80=E3=83=97=E3=83=AD=E3=82=B0=E3=83=A9=E3=83=9F=E3=83=B3?=
 =?UTF-8?q?=E3=82=B0=E3=82=92=E3=82=84=E3=82=8B=E3=80=8D=E3=82=92=E5=86=8D?=
 =?UTF-8?q?=E3=81=B3=E6=9B=B4=E6=96=B0?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 competitive-programming-with-haskell.md | 7 +++++--
 1 file changed, 5 insertions(+), 2 deletions(-)

diff --git a/competitive-programming-with-haskell.md b/competitive-programming-with-haskell.md
index 99e871c..a9e2586 100644
--- a/competitive-programming-with-haskell.md
+++ b/competitive-programming-with-haskell.md
@@ -1,5 +1,8 @@
 # Haskellで競技プログラミングをやる
 
+この文書ではHaskell (GHC)で競技プログラミングをやる上での泥臭い話をする。
+Haskellで競技プログラミングをやる上での一般論とかは「リンク集」の記事を参照。
+
 ## リンク集
 
 * @hsjoihs, [AtCoder に登録したら解くべき精選過去問 10 問を Haskell で解いてみた – Qiita](https://qiita.com/hsjoihs/items/25a08b426196ab2b9bb0), 2018年3月20日
@@ -115,7 +118,7 @@ ABC129-Fのように法が実行時に与えられる場合は、reflectionパ
  #-}
 ```
 
-最後の行の `#-}` が行頭にあるのとGHC 7.10.3が文句を言うので、空白を開けておくこと。
+最後の行の `#-}` が行頭にあるとGHC 7.10.3が文句を言うので、空白を開けておくこと。
 
 別の方法としては、NumDecimals拡張を有効にして `1e9` と書くという方法がある。
 こちらの方が手軽かもしれない。
@@ -227,7 +230,7 @@ vector-algorithmsパッケージの各種アルゴリズムが使えると良い
     * Vectorのscan系とかfold系とかの関数をうまく使うと自前で添字アクセスすることがなくなる。
 * INLINEやSPECIALIZE等のプラグマもあまり意味がなさそう。複数のモジュールからなるプログラムの場合はこれらのプラグマが意味を持つが、AtCoderに投げるHaskellコードは単一のモジュールからなるので。
 
-## AtCoderのGHCが古い問題
+## AtCoderのGHCが古い問題のSemigroup周り
 
 GHC 7.10にはSemigroup-Monoid Proposalはおろか、 `Data.Semigroup` が存在しない。
 モノイドを使う分には `Data.Monoid` をimportしておけばよいが、自分でモノイドを定義する場合には、最新のGHCではSemigroupがMonoidのスーパークラスとなっているため、GHC 7.10とGHC 8.6の両方で動作するコードを書くにはCPP拡張に頼る必要がある。

From d1bb5790bba9f7e8f81ad164de0ca6eaacea2352 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Mon, 17 Jun 2019 23:39:05 +0900
Subject: [PATCH 015/148] DP-M

---
 README.md    |   1 +
 dp-m/Main.hs | 110 +++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 111 insertions(+)
 create mode 100644 dp-m/Main.hs

diff --git a/README.md b/README.md
index d8d513b..6da8035 100644
--- a/README.md
+++ b/README.md
@@ -41,6 +41,7 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 * J - Sushi
 * K - Stones
 * L - Deque
+* M - Candies
 
 ## AtCoder Beginner Contest 032
 
diff --git a/dp-m/Main.hs b/dp-m/Main.hs
new file mode 100644
index 0000000..ff07118
--- /dev/null
+++ b/dp-m/Main.hs
@@ -0,0 +1,110 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+import Data.Char (isSpace)
+import Data.Int
+import Data.List (unfoldr)
+import Data.Coerce
+import Data.Monoid
+import Control.Monad
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+---
+import qualified Data.Vector.Generic
+import qualified Data.Vector.Generic.Mutable
+
+main = do
+  [n,k] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  xs <- U.unfoldrN n (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  {-
+  let naive :: N
+      naive = (U.! k) $ U.foldl' (\v a ->
+                                    -- v ! i: i 個の飴を分け合うやり方の数
+                                     U.generate (k + 1) (\l -> sum [v U.! i | i <- [max 0 (l - a)..l]]
+                                                              )
+                                  ) (U.generate (k + 1) (\i -> if i == 0 then 1 else 0)) xs
+  -}
+  let vec :: U.Vector N
+      vec = U.foldl' (\v a ->
+                        -- v ! i : i 個以下の飴を分け合うやり方の数
+                        U.postscanl' (+) 0 $ U.zipWith (-) v (U.replicate (a + 1) 0 <> v)
+                     ) (U.replicate (k + 1) 1) xs
+  print $ if k == 0 then 1 else vec U.! k - vec U.! (k - 1)
+
+---
+
+modulo :: Int64
+modulo = 10^9+7
+addMod, subMod, mulMod :: Int64 -> Int64 -> Int64
+addMod !x !y | x + y >= modulo = x + y - modulo
+             | otherwise = x + y
+subMod !x !y | x >= y = x - y
+             | otherwise = x - y + modulo
+mulMod !x !y = (x * y) `rem` modulo
+
+newtype N = N { unwrapN :: Int64 } deriving (Eq)
+instance Show N where
+  show (N x) = show x
+instance Num N where
+  (+) = coerce addMod
+  (-) = coerce subMod
+  (*) = coerce mulMod
+  fromInteger n = N (fromInteger (n `mod` fromIntegral modulo))
+  abs = undefined; signum = undefined
+
+exEuclid :: (Eq a, Integral a) => a -> a -> (a, a, a)
+exEuclid !f !g = loop 1 0 0 1 f g
+  where loop !u0 !u1 !v0 !v1 !f 0 = (f, u0, v0)
+        loop !u0 !u1 !v0 !v1 !f g =
+          case divMod f g of
+            (q,r) -> loop u1 (u0 - q * u1) v1 (v0 - q * v1) g r
+
+recipM :: Int64 -> Int64
+recipM !x = case exEuclid x modulo of
+             (1,a,_) -> a `mod` modulo
+             (-1,a,_) -> (-a) `mod` modulo
+divM :: Int64 -> Int64 -> Int64
+divM !x !y = x `mulMod` recipM y
+
+instance Fractional N where
+  (/) = coerce divM
+  recip = coerce recipM
+  fromRational = undefined
+
+{-# RULES
+"^9/Int" forall x. x ^ (9 :: Int) = let u = x; v = u * u * u in v * v * v
+"^9/Integer" forall x. x ^ (9 :: Integer) = let u = x; v = u * u * u in v * v * v
+ #-}
+
+---
+
+newtype instance UM.MVector s N = MV_N (UM.MVector s Int64)
+newtype instance U.Vector N = V_N (U.Vector Int64)
+
+instance Data.Vector.Generic.Mutable.MVector UM.MVector N where -- needs MultiParamTypeClasses here
+  basicLength (MV_N mv) = Data.Vector.Generic.Mutable.basicLength mv
+  basicUnsafeSlice i l (MV_N mv) = MV_N (Data.Vector.Generic.Mutable.basicUnsafeSlice i l mv)
+  basicOverlaps (MV_N mv) (MV_N mv') = Data.Vector.Generic.Mutable.basicOverlaps mv mv'
+  basicUnsafeNew l = MV_N <$> Data.Vector.Generic.Mutable.basicUnsafeNew l
+  basicInitialize (MV_N mv) = Data.Vector.Generic.Mutable.basicInitialize mv
+  basicUnsafeReplicate i x = MV_N <$> Data.Vector.Generic.Mutable.basicUnsafeReplicate i (coerce x)
+  basicUnsafeRead (MV_N mv) i = coerce <$> Data.Vector.Generic.Mutable.basicUnsafeRead mv i
+  basicUnsafeWrite (MV_N mv) i x = Data.Vector.Generic.Mutable.basicUnsafeWrite mv i (coerce x)
+  basicClear (MV_N mv) = Data.Vector.Generic.Mutable.basicClear mv
+  basicSet (MV_N mv) x = Data.Vector.Generic.Mutable.basicSet mv (coerce x)
+  basicUnsafeCopy (MV_N mv) (MV_N mv') = Data.Vector.Generic.Mutable.basicUnsafeCopy mv mv'
+  basicUnsafeMove (MV_N mv) (MV_N mv') = Data.Vector.Generic.Mutable.basicUnsafeMove mv mv'
+  basicUnsafeGrow (MV_N mv) n = MV_N <$> Data.Vector.Generic.Mutable.basicUnsafeGrow mv n
+
+instance Data.Vector.Generic.Vector U.Vector N where -- needs MultiParamTypeClasses here
+  basicUnsafeFreeze (MV_N mv) = V_N <$> Data.Vector.Generic.basicUnsafeFreeze mv
+  basicUnsafeThaw (V_N v) = MV_N <$> Data.Vector.Generic.basicUnsafeThaw v
+  basicLength (V_N v) = Data.Vector.Generic.basicLength v
+  basicUnsafeSlice i l (V_N v) = V_N (Data.Vector.Generic.basicUnsafeSlice i l v)
+  basicUnsafeIndexM (V_N v) i = coerce <$> Data.Vector.Generic.basicUnsafeIndexM v i
+  basicUnsafeCopy (MV_N mv) (V_N v) = Data.Vector.Generic.basicUnsafeCopy mv v
+  elemseq (V_N v) x y = Data.Vector.Generic.elemseq v (coerce x) y
+
+instance U.Unbox N

From dcb56a440495b6c45ff13b06d4c3a84019b696e1 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Mon, 17 Jun 2019 14:44:26 +0000
Subject: [PATCH 016/148] Improve DP-M

---
 dp-m/Main.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/dp-m/Main.hs b/dp-m/Main.hs
index ff07118..10a9bf4 100644
--- a/dp-m/Main.hs
+++ b/dp-m/Main.hs
@@ -22,15 +22,15 @@ main = do
   let naive :: N
       naive = (U.! k) $ U.foldl' (\v a ->
                                     -- v ! i: i 個の飴を分け合うやり方の数
-                                     U.generate (k + 1) (\l -> sum [v U.! i | i <- [max 0 (l - a)..l]]
-                                                              )
-                                  ) (U.generate (k + 1) (\i -> if i == 0 then 1 else 0)) xs
+                                     U.generate (k + 1) (\l -> sum [v U.! i | i <- [max 0 (l - a)..l]])
+                                 ) (U.generate (k + 1) (\i -> if i == 0 then 1 else 0)) xs
   -}
   let vec :: U.Vector N
       vec = U.foldl' (\v a ->
                         -- v ! i : i 個以下の飴を分け合うやり方の数
-                        U.postscanl' (+) 0 $ U.zipWith (-) v (U.replicate (a + 1) 0 <> v)
+                        U.postscanl' (+) 0 $ U.accumulate_ (-) v (U.enumFromN (a + 1) (k - a)) v
                      ) (U.replicate (k + 1) 1) xs
+      -- Note: `U.accumulate_ (-) v (U.enumFromN (a + 1) (k - a)) v` is equivalent to `U.zipWith (-) v (U.replicate (a + 1) 0 <> v)`
   print $ if k == 0 then 1 else vec U.! k - vec U.! (k - 1)
 
 ---

From 8ac55df567d78853c4b359e63b8824af8a585558 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Tue, 18 Jun 2019 21:00:25 +0900
Subject: [PATCH 017/148] DP-N

---
 README.md    |  1 +
 dp-n/Main.hs | 36 ++++++++++++++++++++++++++++++++++++
 2 files changed, 37 insertions(+)
 create mode 100644 dp-n/Main.hs

diff --git a/README.md b/README.md
index 6da8035..f7ad969 100644
--- a/README.md
+++ b/README.md
@@ -42,6 +42,7 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 * K - Stones
 * L - Deque
 * M - Candies
+* N - Slimes
 
 ## AtCoder Beginner Contest 032
 
diff --git a/dp-n/Main.hs b/dp-n/Main.hs
new file mode 100644
index 0000000..6cd8ab8
--- /dev/null
+++ b/dp-n/Main.hs
@@ -0,0 +1,36 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.Int (Int64)
+import Data.List (unfoldr)
+import Control.Monad (forM_, foldM)
+import qualified Data.Vector.Unboxed as U
+import qualified Data.ByteString.Char8 as BS
+import Data.Array.Unboxed
+import Data.Array.ST
+
+main = do
+  n <- readLn
+  xs <- U.map fromIntegral . U.unfoldrN n (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  let ys :: U.Vector Int64
+      ys = U.scanl (+) 0 xs
+  let arr :: UArray (Int,Int) Int64
+      arr = runSTUArray $ do
+        arr <- newArray ((0,0),(n,n)) 0
+        -- arr ! (i,j) : 半開区間 [i,j) にいるやつを全部合体させるために必要な最小のコスト
+        -- 1個のスライムから1個のスライムを得るのに合体は必要ないので arr ! (i,i+1) == 0
+        forM_ [2..n] $ \d -> do
+          forM_ [0..n-d] $ \i -> do
+            let !j = i + d -- 0 <= i < j <= d
+            -- c1: これまでの合体で払うコストの最小値
+            -- c1 <- minimum <$> sequence [(+) <$> readArray arr (i,k) <*> readArray arr (k,j) | k <- [i+1..j-1]]
+            c1 <- foldM (\x a -> min x <$> a) maxBound [(+) <$> readArray arr (i,k) <*> readArray arr (k,j) | k <- [i+1..j-1]]
+            let c2 = ys U.! j - ys U.! i -- 今回の合体の際に払うコスト
+            writeArray arr (i,j) $! c1 + c2
+        return arr
+  print $ arr ! (0,n)
+
+-- > minimum <$> sequence [...]
+-- よりも
+-- > foldM (\x a -> min x <$> a) maxBound
+-- の方が速そう（前者はfusionが効かない？）

From 635054f1e1c03d141aa2b7fb697641271682fa62 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Tue, 18 Jun 2019 21:02:02 +0900
Subject: [PATCH 018/148] Update .gitignore

---
 .gitignore | 7 +++++++
 1 file changed, 7 insertions(+)

diff --git a/.gitignore b/.gitignore
index 82f1dfc..3cebaff 100644
--- a/.gitignore
+++ b/.gitignore
@@ -4,3 +4,10 @@ atcoder.cabal
 abc032-d/dataset*.txt
 tdpc-h/dataset*.txt
 *.prof
+*.hi
+*.o
+*.dump-prep
+*.dump-simpl
+*.s
+*.out
+*.out.dSYM/

From a0c9c9dbd6c5bf6d6b655da1fd0ae5c757d45f39 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Tue, 18 Jun 2019 22:28:37 +0900
Subject: [PATCH 019/148] Improve DP-I

---
 dp-i/Main.hs | 58 +++++++++++++++++++++++++++++++++++++++++-----------
 1 file changed, 46 insertions(+), 12 deletions(-)

diff --git a/dp-i/Main.hs b/dp-i/Main.hs
index ae8efd1..0bf8aa3 100644
--- a/dp-i/Main.hs
+++ b/dp-i/Main.hs
@@ -1,25 +1,59 @@
 {-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE ScopedTypeVariables #-}
+import Data.Char (isSpace)
 import qualified Data.ByteString.Char8 as BS
 import qualified Data.Vector.Unboxed as U
+-- import qualified Data.Vector.Unboxed.Mutable as UM
 
 -- n := V.length v + 1
 -- v ! i = 表が i 枚、裏が n - i 枚出る確率
-solve :: [Double] -> U.Vector Double
-solve ps = go ps (U.singleton 1)
+solve :: U.Vector Double -> U.Vector Double
+solve ps = U.foldl' step (U.singleton 1) ps
   where
-    go [] !vec = vec
-    go (!p:ps) !vec = go ps $ U.generate (U.length vec + 1) $ \i ->
-      if i == 0
-      then (1 - p) * vec U.! i
-      else if i == U.length vec
-           then p * vec U.! (i - 1)
-           else p * vec U.! (i - 1) + (1 - p) * vec U.! i
+    step !vec !p = U.zipWith (\u v -> p * u + (1 - p) * v) (0 `U.cons` vec) (vec `U.snoc` 0)
+
+-- いくつか書き方を試したが、どれもそんなに変わらなさそう。（入力のサイズが比較的小さいから？）
+-- 強いて言えば U.generate を使うやつが気持ち速い。
+--
+-- > U.zipWith (\u v -> p * u + (1 - p) * v) (0 `U.cons` vec) (vec `U.snoc` 0)
+--
+-- > U.create $ do
+-- >   let !n = U.length vec
+-- >   vec2 <- UM.new (n + 1)
+-- >   UM.write vec2 0 $ (1 - p) * vec U.! 0
+-- >   U.copy (UM.init $ UM.tail vec2) $ U.zipWith (\u v -> p * u + (1 - p) * v) vec (U.tail vec)
+-- >   UM.write vec2 n $ p * vec U.! (n - 1)
+-- >   return vec2
+--
+-- > U.generate (U.length vec + 1) $ \i ->
+-- >   if i == 0
+-- >   then (1 - p) * vec U.! i
+-- >   else if i == U.length vec
+-- >        then p * vec U.! (i - 1)
+-- >        else p * vec U.! (i - 1) + (1 - p) * vec U.! i
+--
+-- 結局、
+-- > map (read . BS.unpack) . BS.words
+-- を
+-- > U.unfoldrN n (readDoubleBS . BS.dropWhile isSpace)
+-- に変えるのが一番効果があった (16ms程度）といういつものやつ
 
 main = do
-  n :: Int <- readLn
+  n <- readLn
   -- 1 <= n <= 2999, n is odd
-  ps :: [Double] <- map (read . BS.unpack) . BS.words <$> BS.getLine
+  ps <- U.unfoldrN n (readDoubleBS . BS.dropWhile isSpace) <$> BS.getLine
   let result = solve ps
   -- U.length result == n + 1
   print $ U.sum $ U.drop (n `quot` 2 + 1) result
+
+readDoubleBS :: BS.ByteString -> Maybe (Double, BS.ByteString)
+readDoubleBS s = case BS.readInt s of
+                   Just (ipart, s') -> case BS.uncons s' of
+                                         Just ('.', s'') -> case BS.readInt s'' of
+                                                              Just (fpart, s''') ->
+                                                                let !l = BS.length s'' - BS.length s'''
+                                                                    !x | ipart >= 0 = fromIntegral ipart + fromIntegral fpart / 10^l
+                                                                       | otherwise = fromIntegral ipart - fromIntegral fpart / 10^l
+                                                                in Just (x, s''')
+                                                              Nothing -> Just (fromIntegral ipart, s')
+                                         _ -> Just (fromIntegral ipart, s')
+                   Nothing -> Nothing

From 0714902508f3d77bac03760ba8950d3cffae4623 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Wed, 19 Jun 2019 20:33:33 +0900
Subject: [PATCH 020/148] practice-1 with Julia

---
 julia/practice-1.jl | 4 ++++
 1 file changed, 4 insertions(+)
 create mode 100644 julia/practice-1.jl

diff --git a/julia/practice-1.jl b/julia/practice-1.jl
new file mode 100644
index 0000000..326f626
--- /dev/null
+++ b/julia/practice-1.jl
@@ -0,0 +1,4 @@
+a = parse(Int, readline())
+b, c = parse.(split(readline())) # parse.(Int, split(readline()))
+s = chomp(readline())
+println(string(a + b + c) * " " * s)

From 5656b8322ea4df22ad030ee29590a044f8d17a02 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Fri, 21 Jun 2019 01:12:42 +0900
Subject: [PATCH 021/148] DP-O

---
 README.md    |   1 +
 dp-o/Main.hs | 107 +++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 108 insertions(+)
 create mode 100644 dp-o/Main.hs

diff --git a/README.md b/README.md
index f7ad969..bb4b5bf 100644
--- a/README.md
+++ b/README.md
@@ -43,6 +43,7 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 * L - Deque
 * M - Candies
 * N - Slimes
+* O - Matching
 
 ## AtCoder Beginner Contest 032
 
diff --git a/dp-o/Main.hs b/dp-o/Main.hs
new file mode 100644
index 0000000..fae999d
--- /dev/null
+++ b/dp-o/Main.hs
@@ -0,0 +1,107 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleContexts #-}
+import Data.Char (isSpace)
+import Data.Int (Int64)
+import Data.Bits
+import Data.List (unfoldr)
+import Data.Coerce
+import Control.Monad
+import qualified Data.Vector as V
+import qualified Data.Vector.Unboxed as U
+import qualified Data.ByteString.Char8 as BS
+import Data.Array.Unboxed
+import Data.Array.ST
+import Control.Monad.ST
+---
+import qualified Data.Array.Base
+import qualified Unsafe.Coerce
+
+main = do
+  n <- readLn -- 1 <= n <= 21
+  xs <- V.replicateM n $ do
+    U.unfoldrN n (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  let result :: UArray Int N
+      result = runSTUArray $ do
+        arr <- asSTUArray $ newArray (0,2^n-1) invalidN
+        writeArray arr 0 1
+        -- loop i y: i 番目以降の男性の集合と女性の集合 y に関して、組み合わせの数を計算する。
+        --           y に関しては、 Int をビットの集合とみなす。
+        -- Invariant: i + popCount y == n
+        -- loop :: Int -> Int -> ST s N
+        let loop !i !y | i == n = return 1
+            loop !i !y = do
+              -- x, y: 相手が決まっていない男性、女性の集合
+              z <- readArray arr y
+              if z /= invalidN
+                then return z
+                else do s <- foldM (\x a -> (x +) <$> a) 0
+                             [ loop (i + 1) (clearBit y j)
+                             | j <- [0..n-1]
+                             , testBit y j
+                             , (xs V.! i) U.! j == 1
+                             ]
+                        writeArray arr y s
+                        return s
+        loop 0 (2^n-1)
+        return arr
+  -- print result
+  print $ result ! (2^n-1)
+
+---
+
+modulo :: Int64
+modulo = 10^9+7
+addMod, subMod, mulMod :: Int64 -> Int64 -> Int64
+addMod !x !y | x + y >= modulo = x + y - modulo
+             | otherwise = x + y
+subMod !x !y | x >= y = x - y
+             | otherwise = x - y + modulo
+mulMod !x !y = (x * y) `rem` modulo
+
+newtype N = N { unwrapN :: Int64 } deriving (Eq)
+instance Show N where
+  show (N x) = show x
+instance Num N where
+  (+) = coerce addMod
+  (-) = coerce subMod
+  (*) = coerce mulMod
+  fromInteger n = N (fromInteger (n `mod` fromIntegral modulo))
+  abs = undefined; signum = undefined
+invalidN = N modulo
+
+--- UArray i N
+
+unsafeCoerce_UArray_N_Int :: UArray i N -> UArray i Int64
+unsafeCoerce_UArray_N_Int = Unsafe.Coerce.unsafeCoerce
+unsafeCoerce_UArray_Int_N :: UArray i Int64 -> UArray i N
+unsafeCoerce_UArray_Int_N = Unsafe.Coerce.unsafeCoerce
+
+instance Data.Array.Base.IArray UArray N where
+  bounds arr = Data.Array.Base.bounds (unsafeCoerce_UArray_N_Int arr)
+  numElements arr = Data.Array.Base.numElements (unsafeCoerce_UArray_N_Int arr)
+  unsafeArray lu ies = unsafeCoerce_UArray_Int_N $ Data.Array.Base.unsafeArray lu (coerce ies)
+  unsafeAt arr i = coerce (Data.Array.Base.unsafeAt (unsafeCoerce_UArray_N_Int arr) i)
+  unsafeReplace arr ies = unsafeCoerce_UArray_Int_N (Data.Array.Base.unsafeReplace (unsafeCoerce_UArray_N_Int arr) (coerce ies))
+  unsafeAccum f arr ies = unsafeCoerce_UArray_Int_N (Data.Array.Base.unsafeAccum (coerce f) (unsafeCoerce_UArray_N_Int arr) ies)
+  unsafeAccumArray f e lu ies = unsafeCoerce_UArray_Int_N (Data.Array.Base.unsafeAccumArray (coerce f) (coerce e) lu ies)
+
+--- STUArray s i N
+
+asSTUArray :: ST s (STUArray s i a) -> ST s (STUArray s i a)
+asSTUArray = id
+
+unsafeCoerce_STUArray_N_Int :: STUArray s i N -> STUArray s i Int64
+unsafeCoerce_STUArray_N_Int = Unsafe.Coerce.unsafeCoerce
+unsafeCoerce_STUArray_Int_N :: STUArray s i Int64 -> STUArray s i N
+unsafeCoerce_STUArray_Int_N = Unsafe.Coerce.unsafeCoerce
+
+instance Data.Array.Base.MArray (STUArray s) N (ST s) where
+  getBounds arr = Data.Array.Base.getBounds (unsafeCoerce_STUArray_N_Int arr)
+  getNumElements arr = Data.Array.Base.getNumElements (unsafeCoerce_STUArray_N_Int arr)
+  newArray lu e = unsafeCoerce_STUArray_Int_N <$> Data.Array.Base.newArray lu (coerce e)
+  newArray_ lu = unsafeCoerce_STUArray_Int_N <$> Data.Array.Base.newArray_ lu
+  unsafeNewArray_ lu = unsafeCoerce_STUArray_Int_N <$> Data.Array.Base.unsafeNewArray_ lu
+  unsafeRead arr i = coerce <$> Data.Array.Base.unsafeRead (unsafeCoerce_STUArray_N_Int arr) i
+  unsafeWrite arr i e = Data.Array.Base.unsafeWrite (unsafeCoerce_STUArray_N_Int arr) i (coerce e)

From a7be9189c64072191cee1c672d2c74f77b1e4249 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Fri, 21 Jun 2019 17:34:00 +0900
Subject: [PATCH 022/148] DP-O: Add Vector version

---
 dp-o/Vector.hs | 100 +++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 100 insertions(+)
 create mode 100644 dp-o/Vector.hs

diff --git a/dp-o/Vector.hs b/dp-o/Vector.hs
new file mode 100644
index 0000000..620f0b7
--- /dev/null
+++ b/dp-o/Vector.hs
@@ -0,0 +1,100 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+import Data.Char (isSpace)
+import Data.Int (Int64)
+import Data.Bits
+import Data.List (unfoldr)
+import Data.Coerce
+import Control.Monad
+import qualified Data.Vector as V
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+---
+import qualified Data.Vector.Generic
+import qualified Data.Vector.Generic.Mutable
+
+main = do
+  n <- readLn -- 1 <= n <= 21
+  xs <- V.replicateM n $ do
+    U.toList . U.map fst . U.filter (\(_,v) -> v == 1) . U.indexed . U.unfoldrN n (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  let result :: U.Vector N
+      result = U.create $ do
+        vec <- UM.replicate (2^n) invalidN
+        UM.write vec 0 1
+        -- loop i y: i 番目以降の男性の集合と女性の集合 y に関して、組み合わせの数を計算する。
+        --           y に関しては、 Int をビットの集合とみなす。
+        -- Invariant: i + popCount y == n
+        -- loop :: Int -> Int -> ST s N
+        let loop !i !y | i == n = return 1
+            loop !i !y = do
+              -- x, y: 相手が決まっていない男性、女性の集合
+              z <- UM.read vec y
+              if z /= invalidN
+                then return z
+                else do s <- foldM (\x a -> (x +) <$> a) 0
+                             [ loop (i + 1) (clearBit y j)
+                             | j <- xs V.! i
+                             , testBit y j
+                             ]
+                        UM.write vec y s
+                        return s
+        loop 0 (2^n-1)
+        return vec
+  -- print result
+  print $ result U.! (2^n-1)
+
+---
+
+modulo :: Int64
+modulo = 10^9+7
+addMod, subMod, mulMod :: Int64 -> Int64 -> Int64
+addMod !x !y | x + y >= modulo = x + y - modulo
+             | otherwise = x + y
+subMod !x !y | x >= y = x - y
+             | otherwise = x - y + modulo
+mulMod !x !y = (x * y) `rem` modulo
+
+newtype N = N { unwrapN :: Int64 } deriving (Eq)
+instance Show N where
+  show (N x) = show x
+instance Num N where
+  (+) = coerce addMod
+  (-) = coerce subMod
+  (*) = coerce mulMod
+  fromInteger n = N (fromInteger (n `mod` fromIntegral modulo))
+  abs = undefined; signum = undefined
+invalidN = N modulo
+
+---
+
+newtype instance UM.MVector s N = MV_N (UM.MVector s Int64)
+newtype instance U.Vector N = V_N (U.Vector Int64)
+
+instance Data.Vector.Generic.Mutable.MVector UM.MVector N where -- needs MultiParamTypeClasses here
+  basicLength (MV_N mv) = Data.Vector.Generic.Mutable.basicLength mv
+  basicUnsafeSlice i l (MV_N mv) = MV_N (Data.Vector.Generic.Mutable.basicUnsafeSlice i l mv)
+  basicOverlaps (MV_N mv) (MV_N mv') = Data.Vector.Generic.Mutable.basicOverlaps mv mv'
+  basicUnsafeNew l = MV_N <$> Data.Vector.Generic.Mutable.basicUnsafeNew l
+  basicInitialize (MV_N mv) = Data.Vector.Generic.Mutable.basicInitialize mv
+  basicUnsafeReplicate i x = MV_N <$> Data.Vector.Generic.Mutable.basicUnsafeReplicate i (coerce x)
+  basicUnsafeRead (MV_N mv) i = coerce <$> Data.Vector.Generic.Mutable.basicUnsafeRead mv i
+  basicUnsafeWrite (MV_N mv) i x = Data.Vector.Generic.Mutable.basicUnsafeWrite mv i (coerce x)
+  basicClear (MV_N mv) = Data.Vector.Generic.Mutable.basicClear mv
+  basicSet (MV_N mv) x = Data.Vector.Generic.Mutable.basicSet mv (coerce x)
+  basicUnsafeCopy (MV_N mv) (MV_N mv') = Data.Vector.Generic.Mutable.basicUnsafeCopy mv mv'
+  basicUnsafeMove (MV_N mv) (MV_N mv') = Data.Vector.Generic.Mutable.basicUnsafeMove mv mv'
+  basicUnsafeGrow (MV_N mv) n = MV_N <$> Data.Vector.Generic.Mutable.basicUnsafeGrow mv n
+
+instance Data.Vector.Generic.Vector U.Vector N where -- needs MultiParamTypeClasses here
+  basicUnsafeFreeze (MV_N mv) = V_N <$> Data.Vector.Generic.basicUnsafeFreeze mv
+  basicUnsafeThaw (V_N v) = MV_N <$> Data.Vector.Generic.basicUnsafeThaw v
+  basicLength (V_N v) = Data.Vector.Generic.basicLength v
+  basicUnsafeSlice i l (V_N v) = V_N (Data.Vector.Generic.basicUnsafeSlice i l v)
+  basicUnsafeIndexM (V_N v) i = coerce <$> Data.Vector.Generic.basicUnsafeIndexM v i
+  basicUnsafeCopy (MV_N mv) (V_N v) = Data.Vector.Generic.basicUnsafeCopy mv v
+  elemseq (V_N v) x y = Data.Vector.Generic.elemseq v (coerce x) y
+
+instance U.Unbox N

From 284f2b0ed6edad2d99eb94e4bd339e752e164217 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Sat, 22 Jun 2019 20:47:39 +0900
Subject: [PATCH 023/148] DP-P

---
 README.md    |   1 +
 dp-p/Main.hs | 111 +++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 112 insertions(+)
 create mode 100644 dp-p/Main.hs

diff --git a/README.md b/README.md
index bb4b5bf..0d63b59 100644
--- a/README.md
+++ b/README.md
@@ -44,6 +44,7 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 * M - Candies
 * N - Slimes
 * O - Matching
+* P - Independent Set
 
 ## AtCoder Beginner Contest 032
 
diff --git a/dp-p/Main.hs b/dp-p/Main.hs
new file mode 100644
index 0000000..3e69f46
--- /dev/null
+++ b/dp-p/Main.hs
@@ -0,0 +1,111 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+import Data.Char (isSpace)
+import Data.Int
+import Data.List (unfoldr)
+import Data.Coerce
+import Control.Monad
+import qualified Data.Vector as V
+import qualified Data.Vector.Mutable as VM
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+---
+import qualified Data.Vector.Generic
+import qualified Data.Vector.Generic.Mutable
+
+main = do
+  n <- readLn
+  edges <- U.replicateM (n-1) $ do
+    [x,y] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+    return (x-1,y-1)
+  let edges' :: V.Vector [Int]
+      edges' = V.create $ do
+        vec <- VM.replicate n []
+        U.forM_ edges $ \(i,j) -> do
+          VM.modify vec (j :) i
+          VM.modify vec (i :) j
+        return vec
+  let resultVec :: U.Vector N
+      resultVec = U.create $ do
+        vec <- UM.replicate n invalidN
+        let go !i !j = do
+              x <- UM.read vec j
+              if x /= invalidN
+                then return x
+                else do x <- if null (edges' V.! j)
+                             then pure 2
+                             else liftM2 (+) (productM [ go j k | k <- edges' V.! j, k /= i ])
+                                             (productM [ go k l | k <- edges' V.! j, k /= i, l <- edges' V.! k, l /= j ])
+                        UM.write vec j x
+                        return x
+        go (-1) 0
+        return vec
+  print $ resultVec U.! 0
+
+sumM :: (Monad m, Num a) => [m a] -> m a
+sumM = foldM (\x m -> (x +) <$> m) 0
+
+productM :: (Monad m, Num a) => [m a] -> m a
+productM = foldM (\x m -> (x *) <$> m) 1
+
+---
+
+modulo :: Int64
+modulo = 10^9+7
+addMod, subMod, mulMod :: Int64 -> Int64 -> Int64
+addMod !x !y | x + y >= modulo = x + y - modulo
+             | otherwise = x + y
+subMod !x !y | x >= y = x - y
+             | otherwise = x - y + modulo
+mulMod !x !y = (x * y) `rem` modulo
+
+newtype N = N { unwrapN :: Int64 } deriving (Eq)
+instance Show N where
+  show (N x) = show x
+instance Num N where
+  (+) = coerce addMod
+  (-) = coerce subMod
+  (*) = coerce mulMod
+  fromInteger n = N (fromInteger (n `mod` fromIntegral modulo))
+  abs = undefined; signum = undefined
+
+invalidN = N (-1)
+
+{-# RULES
+"^9/Int" forall x. x ^ (9 :: Int) = let u = x; v = u * u * u in v * v * v
+"^9/Integer" forall x. x ^ (9 :: Integer) = let u = x; v = u * u * u in v * v * v
+ #-}
+
+---
+
+newtype instance UM.MVector s N = MV_N (UM.MVector s Int64)
+newtype instance U.Vector N = V_N (U.Vector Int64)
+
+instance Data.Vector.Generic.Mutable.MVector UM.MVector N where -- needs MultiParamTypeClasses here
+  basicLength (MV_N mv) = Data.Vector.Generic.Mutable.basicLength mv
+  basicUnsafeSlice i l (MV_N mv) = MV_N (Data.Vector.Generic.Mutable.basicUnsafeSlice i l mv)
+  basicOverlaps (MV_N mv) (MV_N mv') = Data.Vector.Generic.Mutable.basicOverlaps mv mv'
+  basicUnsafeNew l = MV_N <$> Data.Vector.Generic.Mutable.basicUnsafeNew l
+  basicInitialize (MV_N mv) = Data.Vector.Generic.Mutable.basicInitialize mv
+  basicUnsafeReplicate i x = MV_N <$> Data.Vector.Generic.Mutable.basicUnsafeReplicate i (coerce x)
+  basicUnsafeRead (MV_N mv) i = coerce <$> Data.Vector.Generic.Mutable.basicUnsafeRead mv i
+  basicUnsafeWrite (MV_N mv) i x = Data.Vector.Generic.Mutable.basicUnsafeWrite mv i (coerce x)
+  basicClear (MV_N mv) = Data.Vector.Generic.Mutable.basicClear mv
+  basicSet (MV_N mv) x = Data.Vector.Generic.Mutable.basicSet mv (coerce x)
+  basicUnsafeCopy (MV_N mv) (MV_N mv') = Data.Vector.Generic.Mutable.basicUnsafeCopy mv mv'
+  basicUnsafeMove (MV_N mv) (MV_N mv') = Data.Vector.Generic.Mutable.basicUnsafeMove mv mv'
+  basicUnsafeGrow (MV_N mv) n = MV_N <$> Data.Vector.Generic.Mutable.basicUnsafeGrow mv n
+
+instance Data.Vector.Generic.Vector U.Vector N where -- needs MultiParamTypeClasses here
+  basicUnsafeFreeze (MV_N mv) = V_N <$> Data.Vector.Generic.basicUnsafeFreeze mv
+  basicUnsafeThaw (V_N v) = MV_N <$> Data.Vector.Generic.basicUnsafeThaw v
+  basicLength (V_N v) = Data.Vector.Generic.basicLength v
+  basicUnsafeSlice i l (V_N v) = V_N (Data.Vector.Generic.basicUnsafeSlice i l v)
+  basicUnsafeIndexM (V_N v) i = coerce <$> Data.Vector.Generic.basicUnsafeIndexM v i
+  basicUnsafeCopy (MV_N mv) (V_N v) = Data.Vector.Generic.basicUnsafeCopy mv v
+  elemseq (V_N v) x y = Data.Vector.Generic.elemseq v (coerce x) y
+
+instance U.Unbox N

From eabc7cca11d12a7854cf2d41b3a673f6857a5805 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Sat, 22 Jun 2019 23:12:37 +0900
Subject: [PATCH 024/148] ABC131-A, B, C, D, F

---
 README.md        | 13 +++++++++++
 abc131-a/Main.hs |  7 ++++++
 abc131-b/Main.hs |  9 +++++++
 abc131-c/Main.hs |  9 +++++++
 abc131-d/Main.hs | 16 +++++++++++++
 abc131-f/Main.hs | 61 ++++++++++++++++++++++++++++++++++++++++++++++++
 6 files changed, 115 insertions(+)
 create mode 100644 abc131-a/Main.hs
 create mode 100644 abc131-b/Main.hs
 create mode 100644 abc131-c/Main.hs
 create mode 100644 abc131-d/Main.hs
 create mode 100644 abc131-f/Main.hs

diff --git a/README.md b/README.md
index 0d63b59..c33566b 100644
--- a/README.md
+++ b/README.md
@@ -376,3 +376,16 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 * [x] D - Enough Array
 * [x] E - Common Subsequence
 * [x] F - Minimum Bounding Box
+
+## AtCoder Beginner Contest 131 (2019-06-22)
+
+<https://atcoder.jp/contests/abc131>
+
+解いた問題：
+
+* [x] A - Security
+* [x] B - Bite Eating
+* [x] C - Anti-Division
+* [x] D - Megalomania
+* [ ] E - Friendships
+* [x] F - Must Be Rectangular!
diff --git a/abc131-a/Main.hs b/abc131-a/Main.hs
new file mode 100644
index 0000000..f8dd6db
--- /dev/null
+++ b/abc131-a/Main.hs
@@ -0,0 +1,7 @@
+-- https://github.com/minoki/my-atcoder-solutions
+
+main = do
+  [a,b,c,d] <- getLine
+  putStrLn $ if a == b || b == c || c == d
+             then "Bad"
+             else "Good"
diff --git a/abc131-b/Main.hs b/abc131-b/Main.hs
new file mode 100644
index 0000000..f5150d9
--- /dev/null
+++ b/abc131-b/Main.hs
@@ -0,0 +1,9 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Char (isSpace)
+import Data.List (unfoldr, minimumBy)
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  [n,l] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  let xs = [l+i-1 | i <- [1..n]]
+  print $ sum xs - minimumBy (\x y -> compare (abs x) (abs y)) xs
diff --git a/abc131-c/Main.hs b/abc131-c/Main.hs
new file mode 100644
index 0000000..a674618
--- /dev/null
+++ b/abc131-c/Main.hs
@@ -0,0 +1,9 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  [a,b,c,d] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  let f n = n - n `quot` c - n `quot` d + n `quot` lcm c d
+  print $ f b - f (a - 1)
diff --git a/abc131-d/Main.hs b/abc131-d/Main.hs
new file mode 100644
index 0000000..011cf12
--- /dev/null
+++ b/abc131-d/Main.hs
@@ -0,0 +1,16 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Char (isSpace)
+import Data.List
+import Data.Monoid
+import Control.Monad
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  n <- readLn
+  tasks <- fmap (sortBy (\(a,b) (a',b') -> compare b b' <> compare a a')) $ replicateM n $ do
+    [a,b] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+    return (a,b)
+  let xs = tail $ scanl' (+) 0 $ map fst tasks
+  putStrLn $ if and $ zipWith (<=) xs (map snd tasks)
+             then "Yes"
+             else "No"
diff --git a/abc131-f/Main.hs b/abc131-f/Main.hs
new file mode 100644
index 0000000..cd16d8c
--- /dev/null
+++ b/abc131-f/Main.hs
@@ -0,0 +1,61 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import Control.Monad
+import qualified Data.Vector as V
+import qualified Data.Vector.Mutable as VM
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.IntMap as IntMap
+import qualified Data.IntSet as IntSet
+import Control.Monad.ST
+
+main = do
+  n <- readLn
+  points <- U.replicateM n $ do
+    [x,y] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+    return (x,y)
+  let b = 1 + (U.maximum $ U.map fst points)
+  let m0 :: IntMap.IntMap IntSet.IntSet
+      m0 = U.foldr' (\(x,y) -> IntMap.insertWith IntSet.union x (IntSet.singleton y)) IntMap.empty points
+      m1 :: IntMap.IntMap IntSet.IntSet
+      m1 = U.foldr' (\(x,y) -> IntMap.insertWith IntSet.union y (IntSet.singleton x)) IntMap.empty points
+      resultR :: U.Vector Int
+      resultS :: V.Vector IntSet.IntSet
+      resultN :: U.Vector Int
+      (resultR, resultS, resultN) = runST $ do
+        root <- U.thaw $ U.enumFromN 0 b
+        ss <- VM.replicate b IntSet.empty
+        forM_ (IntMap.assocs m0) $ \(k,v) -> VM.write ss k v
+        numberOfElements <- UM.replicate b 1
+        let getRoot !i = do
+              !j <- UM.read root i
+              if i == j
+                then return i
+                else do k <- getRoot j
+                        UM.write root i k
+                        return k
+            unify !i !j = do
+              !i' <- getRoot i -- []
+              !j' <- getRoot j -- []
+              if i' == j'
+                then return ()
+                else do
+                let !k = min i' j'
+                UM.write root i' k
+                UM.write root j' k
+                s1 <- VM.read ss i'
+                s2 <- VM.read ss j'
+                VM.write ss k $! IntSet.union s1 s2
+                n1 <- UM.read numberOfElements i'
+                n2 <- UM.read numberOfElements j'
+                UM.write numberOfElements k (n1 + n2)
+        forM_ (IntMap.elems m1) $ \t -> do
+          let t0:ts = IntSet.toList t
+          forM_ ts $ \j ->
+            unify t0 j
+        liftM3 (,,) (U.freeze root) (V.freeze ss) (U.freeze numberOfElements)
+  let l = sum [IntSet.size (resultS V.! i) * resultN U.! i | i <- [0..b-1], resultR U.! i == i]
+  print $ l - n

From cc794e4bf526ee8d2edf0703ebb5cfe58a4bb926 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Sun, 23 Jun 2019 01:30:23 +0900
Subject: [PATCH 025/148] ABC131-E

---
 README.md        |  2 +-
 abc131-e/Main.hs | 21 +++++++++++++++++++++
 2 files changed, 22 insertions(+), 1 deletion(-)
 create mode 100644 abc131-e/Main.hs

diff --git a/README.md b/README.md
index c33566b..44671df 100644
--- a/README.md
+++ b/README.md
@@ -387,5 +387,5 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 * [x] B - Bite Eating
 * [x] C - Anti-Division
 * [x] D - Megalomania
-* [ ] E - Friendships
+* [x] E - Friendships
 * [x] F - Must Be Rectangular!
diff --git a/abc131-e/Main.hs b/abc131-e/Main.hs
new file mode 100644
index 0000000..0e7b40f
--- /dev/null
+++ b/abc131-e/Main.hs
@@ -0,0 +1,21 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import Control.Monad (forM_)
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  [n,k] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  let m = (n - 1) * (n - 2) `quot` 2
+  if k > m
+    then putStrLn "-1"
+    else do let l = m - k
+            print $ n - 1 + l
+            forM_ [2..n] $ \i -> do
+              putStrLn $ unwords ["1", show i]
+            let loop 0 !i !j = return ()
+                loop l !i !j | j > n = loop l (i+1) (i+2)
+                           | otherwise = do putStrLn $ unwords [show i, show j]
+                                            loop (l - 1) i (j + 1)
+            loop l 2 3

From 1c644ed466153e2ccd2e66fbb1a31eb24647fe83 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Sun, 23 Jun 2019 15:24:48 +0900
Subject: [PATCH 026/148] ABC131-D: Add a version with merge sort

---
 abc131-d/VectorSort.hs | 48 ++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 48 insertions(+)
 create mode 100644 abc131-d/VectorSort.hs

diff --git a/abc131-d/VectorSort.hs b/abc131-d/VectorSort.hs
new file mode 100644
index 0000000..f10a97f
--- /dev/null
+++ b/abc131-d/VectorSort.hs
@@ -0,0 +1,48 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import Data.Monoid
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  n <- readLn
+  tasks <- fmap (mergeSortBy (\(a,b) (a',b') -> compare b b' <> compare a a')) $ U.replicateM n $ do
+    [a,b] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+    -- [a,b] <- map read . words <$> getLine
+    return (a,b :: Int)
+  let (as,bs) = U.unzip tasks
+  let xs = U.tail $ U.scanl' (+) 0 as
+  putStrLn $ if U.and $ U.zipWith (<=) xs bs
+             then "Yes"
+             else "No"
+
+---
+
+mergeSortBy :: (U.Unbox a) => (a -> a -> Ordering) -> U.Vector a -> U.Vector a
+mergeSortBy !cmp !vec = doSort vec
+  where
+    doSort vec | U.length vec <= 1 = vec
+               | otherwise = let (xs, ys) = U.splitAt (U.length vec `quot` 2) vec
+                             in merge (doSort xs) (doSort ys)
+    merge xs ys = U.create $ do
+      let !n = U.length xs
+          !m = U.length ys
+      result <- UM.new (n + m)
+      let loop !i !j
+            | i == n = U.copy (UM.drop (i + j) result) (U.drop j ys)
+            | j == m = U.copy (UM.drop (i + j) result) (U.drop i xs)
+            | otherwise = let !x = xs U.! i
+                              !y = ys U.! j
+                          in case cmp x y of
+                               LT -> do UM.write result (i + j) x
+                                        loop (i + 1) j
+                               EQ -> do UM.write result (i + j) x
+                                        UM.write result (i + j + 1) y
+                                        loop (i + 1) (j + 1)
+                               GT -> do UM.write result (i + j) y
+                                        loop i (j + 1)
+      loop 0 0
+      return result

From 203fa130f837921a6665c098e530c92033627a3b Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Mon, 24 Jun 2019 19:49:50 +0900
Subject: [PATCH 027/148] DP-Q: Slow solution

---
 dp-q/Main.hs | 53 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 53 insertions(+)
 create mode 100644 dp-q/Main.hs

diff --git a/dp-q/Main.hs b/dp-q/Main.hs
new file mode 100644
index 0000000..1076b86
--- /dev/null
+++ b/dp-q/Main.hs
@@ -0,0 +1,53 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.Int (Int64)
+import Data.List (unfoldr)
+import Data.Bifunctor (first)
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.IntMap.Strict as IntMap
+
+main = do
+  n <- readLn
+  hs <- U.unfoldrN n (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  as <- U.unfoldrN n (readInt64 . BS.dropWhile isSpace) <$> BS.getLine
+  let -- v ! i は j < i かつ hs ! j < hs ! i となるような j のうち、 hs ! j が最大のもの
+      -- そのような j が存在しなければ -1
+      v :: U.Vector Int
+      v = U.create $ do
+        vec <- UM.new n
+        let loop !i !m
+              | i == n = return ()
+              | otherwise = do
+                  let hs_i = hs U.! i
+                  case IntMap.lookupLT hs_i m of
+                    Just (hs_j, j) -> do
+                      UM.write vec i j
+                      loop (i+1) (IntMap.insert hs_i i m)
+                    Nothing -> do
+                      UM.write vec i (-1)
+                      loop (i+1) (IntMap.insert hs_i i m)
+        loop 0 IntMap.empty
+        return vec
+      -- resultV ! i は、入力の先頭から i+1 本のうち高さが hs ! i 以下のものを選んだ部分列に関する問題の答え
+      resultV :: U.Vector Int64
+      resultV = U.create $ do
+        vec <- UM.new n
+        let loop !i !m
+              | i == n = return ()
+              | otherwise = do
+                  let h = hs U.! i
+                  let a = as U.! i
+                  let (left, right) = IntMap.split h m
+                  let s' = maximum (0 : IntMap.elems left)
+                  let s'' = a + s'
+                  UM.write vec i s''
+                  loop (i+1) $ IntMap.insert h s'' $ IntMap.union left $ IntMap.filter (> s'') right
+        loop 0 IntMap.empty
+        return vec
+  print $ U.maximum $ resultV
+
+readInt64 :: BS.ByteString -> Maybe (Int64, BS.ByteString)
+readInt64 s = first fromIntegral <$> BS.readInt s

From 652d91455024067fa7f66b1bc590d21e55a2fc75 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Tue, 25 Jun 2019 22:12:15 +0900
Subject: [PATCH 028/148] ABC128-F

---
 README.md        |  2 +-
 abc128-f/Main.hs | 24 ++++++++++++++++++++++++
 2 files changed, 25 insertions(+), 1 deletion(-)
 create mode 100644 abc128-f/Main.hs

diff --git a/README.md b/README.md
index 44671df..d479180 100644
--- a/README.md
+++ b/README.md
@@ -310,7 +310,7 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 * [x] C - Switches
 * [x] D - equeue
 * [x] E - Roadwork
-* [ ] F - Frog Jump
+* [x] F - Frog Jump
 
 ## M-SOLUTIONS プロコンオープン (2019-06-01)
 
diff --git a/abc128-f/Main.hs b/abc128-f/Main.hs
new file mode 100644
index 0000000..4d6c962
--- /dev/null
+++ b/abc128-f/Main.hs
@@ -0,0 +1,24 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.Int (Int64)
+import Data.Bifunctor (first)
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.Vector.Unboxed as U
+
+-- skipping 3 (U.fromList [0,1,2,3,4,5]) = [0,3]
+skipping :: (U.Unbox a) => Int -> U.Vector a -> U.Vector a
+skipping !d !v = U.generate ((U.length v + d - 1) `quot` d) $ \i -> v U.! (i * d)
+
+main = do
+  n <- readLn
+  ss <- U.unfoldrN n (readInt64 . BS.dropWhile isSpace) <$> BS.getLine
+  let ts = U.zipWith (+) ss (U.reverse ss)
+  print $ maximum $ [ U.maximum $ U.scanl (+) 0 (skipping d $ U.take l ts)
+                    | d <- [1..n-2]
+                    , let l | (n - 1) `rem` d == 0 = min (n `quot` 2) (n - 1 - d)
+                            | otherwise = n - 1 - d
+                    ]
+
+readInt64 :: BS.ByteString -> Maybe (Int64, BS.ByteString)
+readInt64 s = first fromIntegral <$> BS.readInt s

From a532c7bcd16da879b19b16cdea078856c0d03edc Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Wed, 26 Jun 2019 17:23:03 +0900
Subject: [PATCH 029/148] ABC128-F: Use if-then-else rather than guard clauses

---
 abc128-f/Main.hs | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/abc128-f/Main.hs b/abc128-f/Main.hs
index 4d6c962..d824e2f 100644
--- a/abc128-f/Main.hs
+++ b/abc128-f/Main.hs
@@ -16,8 +16,9 @@ main = do
   let ts = U.zipWith (+) ss (U.reverse ss)
   print $ maximum $ [ U.maximum $ U.scanl (+) 0 (skipping d $ U.take l ts)
                     | d <- [1..n-2]
-                    , let l | (n - 1) `rem` d == 0 = min (n `quot` 2) (n - 1 - d)
-                            | otherwise = n - 1 - d
+                    , let l = if (n - 1) `rem` d == 0
+                              then min (n `quot` 2) (n - 1 - d)
+                              else n - 1 - d
                     ]
 
 readInt64 :: BS.ByteString -> Maybe (Int64, BS.ByteString)

From 1b84585032f4e6b6ddd5baeb7a392a99a434d16b Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Thu, 27 Jun 2019 01:16:59 +0900
Subject: [PATCH 030/148] ABC128-F: List version

---
 abc128-f/List.hs | 26 ++++++++++++++++++++++++++
 1 file changed, 26 insertions(+)
 create mode 100644 abc128-f/List.hs

diff --git a/abc128-f/List.hs b/abc128-f/List.hs
new file mode 100644
index 0000000..df43cbc
--- /dev/null
+++ b/abc128-f/List.hs
@@ -0,0 +1,26 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.Int (Int64)
+import Data.Bifunctor (first)
+import Data.List
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.Vector.Unboxed as U
+
+-- skipping 3 (U.fromList [0,1,2,3,4,5]) = [0,3]
+skipping :: (U.Unbox a) => Int -> U.Vector a -> [a]
+skipping !d !v = [ v U.! i | i <- [0,d..U.length v - 1] ]
+
+main = do
+  n <- readLn
+  ss <- U.unfoldrN n (readInt64 . BS.dropWhile isSpace) <$> BS.getLine
+  let ts = U.zipWith (+) ss (U.reverse ss)
+  print $ maximum $ [ maximum $ scanl' (+) 0 (skipping d $ U.take l ts)
+                    | d <- [1..n-2]
+                    , let l = if (n - 1) `rem` d == 0
+                              then min (n `quot` 2) (n - 1 - d)
+                              else n - 1 - d
+                    ]
+
+readInt64 :: BS.ByteString -> Maybe (Int64, BS.ByteString)
+readInt64 s = first fromIntegral <$> BS.readInt s

From b91ed50700051903e936851dd3ce14bca719e465 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Thu, 27 Jun 2019 01:21:44 +0900
Subject: [PATCH 031/148] ABC128-E: Use merge sort

---
 abc128-e/Main.hs | 37 ++++++++++++++++++++++++++++++++++---
 1 file changed, 34 insertions(+), 3 deletions(-)

diff --git a/abc128-e/Main.hs b/abc128-e/Main.hs
index 790561a..bb00d25 100644
--- a/abc128-e/Main.hs
+++ b/abc128-e/Main.hs
@@ -41,10 +41,10 @@ fill !i !j !x !depth vec | i < j = doFill 0 depth i j
 main = do
   [n,q] <- map (read . BS.unpack) . BS.words <$> BS.getLine
   -- 1 <= n <= 2*10^5, 1 <= q <= 2*10^5
-  works <- replicateM n $ do
+  works <- U.replicateM n $ do
     [s,t,x] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
     return (s,t,x)
-  let works' = sortBy (\(s,t,x) (s',t',x') -> compare x' x <> compare s s' <> compare t t') works
+  let works' = mergeSortBy (\(s,t,x) (s',t',x') -> compare x' x <> compare s s' <> compare t t') works
   ds <- U.replicateM q $ do
     Just (d, _) <- BS.readInt <$> BS.getLine
     return d
@@ -52,7 +52,7 @@ main = do
   let depth = ceiling (logBase 2 (fromIntegral q) :: Double) :: Int
   let result = U.create $ do
         vec <- UM.replicate (2^(depth+1)-1) (10^9+1)
-        forM_ works' $ \(s,t,x) -> do
+        U.forM_ works' $ \(s,t,x) -> do
           let !s' = s - x
               !t' = t - x
               i0 = search ds (\d -> s' <= d) 0 q
@@ -65,3 +65,34 @@ main = do
     if v == 10^9+1
       then putStrLn "-1"
       else print v
+
+---
+
+mergeSortBy :: (U.Unbox a) => (a -> a -> Ordering) -> U.Vector a -> U.Vector a
+mergeSortBy !cmp !vec = doSort vec
+  where
+    doSort vec | U.length vec <= 1 = vec
+               | otherwise = let (xs, ys) = U.splitAt (U.length vec `quot` 2) vec
+                             in merge (doSort xs) (doSort ys)
+    merge xs ys = U.create $ do
+      let !n = U.length xs
+          !m = U.length ys
+      result <- UM.new (n + m)
+      let loop !i !j
+            | i == n = U.copy (UM.drop (i + j) result) (U.drop j ys)
+            | j == m = U.copy (UM.drop (i + j) result) (U.drop i xs)
+            | otherwise = let !x = xs U.! i
+                              !y = ys U.! j
+                          in case cmp x y of
+                               LT -> do UM.write result (i + j) x
+                                        loop (i + 1) j
+                               EQ -> do UM.write result (i + j) x
+                                        UM.write result (i + j + 1) y
+                                        loop (i + 1) (j + 1)
+                               GT -> do UM.write result (i + j) y
+                                        loop i (j + 1)
+      loop 0 0
+      return result
+
+mergeSort :: (U.Unbox a, Ord a) => U.Vector a -> U.Vector a
+mergeSort = mergeSortBy compare

From 9375d06fe80ba25d942f95f37bf30dc6b0ddfb98 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Thu, 27 Jun 2019 01:23:03 +0900
Subject: [PATCH 032/148] lib/ModularArithmetic: Remove INLINE pragma

---
 lib/ModularArithmetic.hs | 18 +++++++-----------
 1 file changed, 7 insertions(+), 11 deletions(-)

diff --git a/lib/ModularArithmetic.hs b/lib/ModularArithmetic.hs
index a438272..6a5b209 100644
--- a/lib/ModularArithmetic.hs
+++ b/lib/ModularArithmetic.hs
@@ -13,8 +13,6 @@ addMod !x !y | x + y >= modulo = x + y - modulo
 subMod !x !y | x >= y = x - y
              | otherwise = x - y + modulo
 mulMod !x !y = (x * y) `rem` modulo
-{-# INLINE addMod #-}
-{-# INLINE subMod #-}
 
 newtype N = N { unwrapN :: Int64 } deriving (Eq)
 instance Show N where
@@ -25,10 +23,13 @@ instance Num N where
   (*) = coerce mulMod
   fromInteger n = N (fromInteger (n `mod` fromIntegral modulo))
   abs = undefined; signum = undefined
-  {-# INLINE (+) #-}
-  {-# INLINE (-) #-}
-  {-# INLINE (*) #-}
-  {-# INLINE fromInteger #-}
+
+{-# RULES
+"^9/Int" forall x. x ^ (9 :: Int) = let u = x; v = u * u * u in v * v * v
+"^9/Integer" forall x. x ^ (9 :: Integer) = let u = x; v = u * u * u in v * v * v
+ #-}
+
+---
 
 exEuclid :: (Eq a, Integral a) => a -> a -> (a, a, a)
 exEuclid !f !g = loop 1 0 0 1 f g
@@ -48,8 +49,3 @@ instance Fractional N where
   (/) = coerce divM
   recip = coerce recipM
   fromRational = undefined
-
-{-# RULES
-"^9/Int" forall x. x ^ (9 :: Int) = let u = x; v = u * u * u in v * v * v
-"^9/Integer" forall x. x ^ (9 :: Integer) = let u = x; v = u * u * u in v * v * v
- #-}

From be49431c8bb6ae37fa6772ecac3b7688f5f083b3 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Thu, 27 Jun 2019 01:23:21 +0900
Subject: [PATCH 033/148] lib/UnboxedModularArray: Add asSTUArray

---
 lib/UnboxedModularArray.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/lib/UnboxedModularArray.hs b/lib/UnboxedModularArray.hs
index 2f1663b..159205f 100644
--- a/lib/UnboxedModularArray.hs
+++ b/lib/UnboxedModularArray.hs
@@ -13,6 +13,9 @@ import Data.Array.ST (STUArray)
 import qualified Data.Array.Base
 import qualified Unsafe.Coerce
 
+asSTUArray :: ST s (STUArray s i a) -> ST s (STUArray s i a)
+asSTUArray = id
+
 --- UArray i N
 
 unsafeCoerce_UArray_N_Int :: UArray i N -> UArray i Int64

From 2806de557d93d30c5f41f94928b911e6e552a814 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Thu, 27 Jun 2019 01:27:39 +0900
Subject: [PATCH 034/148] Exawizards2019-D: Use merge sort (still slow)

---
 exawizards2019-d/Main.hs | 40 +++++++++++++++++++++++++++++++++++-----
 1 file changed, 35 insertions(+), 5 deletions(-)

diff --git a/exawizards2019-d/Main.hs b/exawizards2019-d/Main.hs
index 432db2f..f93dfa7 100644
--- a/exawizards2019-d/Main.hs
+++ b/exawizards2019-d/Main.hs
@@ -1,11 +1,13 @@
+-- https://github.com/minoki/my-atcoder-solutions
 {-# LANGUAGE BangPatterns #-}
 import Control.Monad
+import Data.Char (isSpace)
 import Data.Int
 import Data.List
-import qualified Data.Vector.Unboxed as V
-import qualified Data.Vector.Unboxed.Mutable as VM
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
 import qualified Data.ByteString.Char8 as BS
-import Debug.Trace
+-- import Debug.Trace
 
 newtype N = N Int64 deriving (Eq, Show)
 modulo = 10^9+7 :: Int64
@@ -27,9 +29,37 @@ solve !x !n ss !c = sum $ do
 -- n == length ss
 
 main = do
-  [n,x] <- map (read . BS.unpack) . BS.words <$> BS.getLine
+  [n,x] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
   -- n <= 200, x <= 10^5
-  ss <- {- V.fromListN n . -} sortBy (\x y -> compare y x) . map (read . BS.unpack) . BS.words <$> BS.getLine
+  ss <- U.toList . mergeSortBy (\x y -> compare y x) . U.unfoldrN n (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
   -- si <= 10^5
   let N result = solve x n ss 1
   print result
+
+---
+
+mergeSortBy :: (U.Unbox a) => (a -> a -> Ordering) -> U.Vector a -> U.Vector a
+mergeSortBy !cmp !vec = doSort vec
+  where
+    doSort vec | U.length vec <= 1 = vec
+               | otherwise = let (xs, ys) = U.splitAt (U.length vec `quot` 2) vec
+                             in merge (doSort xs) (doSort ys)
+    merge xs ys = U.create $ do
+      let !n = U.length xs
+          !m = U.length ys
+      result <- UM.new (n + m)
+      let loop !i !j
+            | i == n = U.copy (UM.drop (i + j) result) (U.drop j ys)
+            | j == m = U.copy (UM.drop (i + j) result) (U.drop i xs)
+            | otherwise = let !x = xs U.! i
+                              !y = ys U.! j
+                          in case cmp x y of
+                               LT -> do UM.write result (i + j) x
+                                        loop (i + 1) j
+                               EQ -> do UM.write result (i + j) x
+                                        UM.write result (i + j + 1) y
+                                        loop (i + 1) (j + 1)
+                               GT -> do UM.write result (i + j) y
+                                        loop i (j + 1)
+      loop 0 0
+      return result

From 08615173d9d8df34c814f47ff069e92947261dd4 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Thu, 27 Jun 2019 01:28:07 +0900
Subject: [PATCH 035/148] gen.lua: import Data.Int (Int64)

---
 gen.lua | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/gen.lua b/gen.lua
index c72c46b..a6677c4 100755
--- a/gen.lua
+++ b/gen.lua
@@ -22,7 +22,7 @@ fh:write([[
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE BangPatterns #-}
 import Data.Char (isSpace)
-import Data.Int
+import Data.Int (Int64)
 import Data.List (unfoldr)
 import Control.Monad
 import qualified Data.Vector.Unboxed as U

From e40e9d72089bac740aa9c2ec78ca1c3295435260 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Thu, 27 Jun 2019 02:47:15 +0900
Subject: [PATCH 036/148] Exawizards2019-D: Some improvement (still slow)

---
 exawizards2019-d/Main.hs | 119 +++++++++++++++++++++++++++++++++------
 1 file changed, 101 insertions(+), 18 deletions(-)

diff --git a/exawizards2019-d/Main.hs b/exawizards2019-d/Main.hs
index f93dfa7..262116a 100644
--- a/exawizards2019-d/Main.hs
+++ b/exawizards2019-d/Main.hs
@@ -1,31 +1,34 @@
 -- https://github.com/minoki/my-atcoder-solutions
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
 import Control.Monad
 import Data.Char (isSpace)
-import Data.Int
+import Data.Int (Int64)
 import Data.List
 import qualified Data.Vector.Unboxed as U
 import qualified Data.Vector.Unboxed.Mutable as UM
 import qualified Data.ByteString.Char8 as BS
--- import Debug.Trace
-
-newtype N = N Int64 deriving (Eq, Show)
-modulo = 10^9+7 :: Int64
-instance Num N where
-  N x + N y = N ((x + y) `rem` modulo)
-  N x - N y = N ((x - y) `mod` modulo)
-  N x * N y = N ((x * y) `rem` modulo)
-  fromInteger n = N (fromInteger (n `mod` fromIntegral modulo))
-  abs = undefined; signum = undefined
+--
+import Data.Coerce
+import qualified Data.Vector.Generic
+import qualified Data.Vector.Generic.Mutable
+import Debug.Trace
 
 solve :: Int -> Int -> [Int] -> N -> N
 solve !x 0 [] !c = c * fromIntegral x
 -- solve !x 1 [y] c bc = c * (traceShow (c,bc,x) $ fromIntegral (x `rem` y))
-solve !x !n ss !c = sum $ do
-  (k, t:ts) <- zip [0..] $ tails ss
-  -- k + length ts + 1 == n
-  -- k : t より大きいやつ
-  return $ solve (x `rem` t) (n - k - 1) ts (product (map fromIntegral [n-1,n-2..n-k]) * c)
+solve !x !n ss !c =
+  let (ss0,ss1) = span (> x) ss
+  in if null ss1
+     then factV U.! n * c * fromIntegral x
+     else let !m = length ss0
+              !q = factV U.! n / factV U.! (n-m)
+          in sum $ do (k, t:ts) <- zip [m..] $ tails ss1
+                      -- k + length ts + 1 == n
+                      -- k : t より大きいやつ
+                      let !p = factV U.! (n-m-1) / factV U.! (n-k-1)
+                      return $ solve (x `rem` t) (n - k - 1) ts (q * p * c)
 -- n == length ss
 
 main = do
@@ -33,8 +36,57 @@ main = do
   -- n <= 200, x <= 10^5
   ss <- U.toList . mergeSortBy (\x y -> compare y x) . U.unfoldrN n (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
   -- si <= 10^5
-  let N result = solve x n ss 1
-  print result
+  print $ solve x n ss 1
+
+factV :: U.Vector N
+factV = U.scanl' (*) 1 (U.enumFromN 1 200)
+
+---
+
+modulo :: Int64
+modulo = 10^9+7
+addMod, subMod, mulMod :: Int64 -> Int64 -> Int64
+addMod !x !y | x + y >= modulo = x + y - modulo
+             | otherwise = x + y
+subMod !x !y | x >= y = x - y
+             | otherwise = x - y + modulo
+mulMod !x !y = (x * y) `rem` modulo
+
+newtype N = N { unwrapN :: Int64 } deriving (Eq)
+instance Show N where
+  show (N x) = show x
+instance Num N where
+  (+) = coerce addMod
+  (-) = coerce subMod
+  (*) = coerce mulMod
+  fromInteger n = N (fromInteger (n `mod` fromIntegral modulo))
+  abs = undefined; signum = undefined
+
+{-# RULES
+"^9/Int" forall x. x ^ (9 :: Int) = let u = x; v = u * u * u in v * v * v
+"^9/Integer" forall x. x ^ (9 :: Integer) = let u = x; v = u * u * u in v * v * v
+ #-}
+
+---
+
+exEuclid :: (Eq a, Integral a) => a -> a -> (a, a, a)
+exEuclid !f !g = loop 1 0 0 1 f g
+  where loop !u0 !u1 !v0 !v1 !f 0 = (f, u0, v0)
+        loop !u0 !u1 !v0 !v1 !f g =
+          case divMod f g of
+            (q,r) -> loop u1 (u0 - q * u1) v1 (v0 - q * v1) g r
+
+recipM :: Int64 -> Int64
+recipM !x = case exEuclid x modulo of
+             (1,a,_) -> a `mod` modulo
+             (-1,a,_) -> (-a) `mod` modulo
+divM :: Int64 -> Int64 -> Int64
+divM !x !y = x `mulMod` recipM y
+
+instance Fractional N where
+  (/) = coerce divM
+  recip = coerce recipM
+  fromRational = undefined
 
 ---
 
@@ -63,3 +115,34 @@ mergeSortBy !cmp !vec = doSort vec
                                         loop i (j + 1)
       loop 0 0
       return result
+
+---
+
+newtype instance UM.MVector s N = MV_N (UM.MVector s Int64)
+newtype instance U.Vector N = V_N (U.Vector Int64)
+
+instance Data.Vector.Generic.Mutable.MVector UM.MVector N where -- needs MultiParamTypeClasses here
+  basicLength (MV_N mv) = Data.Vector.Generic.Mutable.basicLength mv
+  basicUnsafeSlice i l (MV_N mv) = MV_N (Data.Vector.Generic.Mutable.basicUnsafeSlice i l mv)
+  basicOverlaps (MV_N mv) (MV_N mv') = Data.Vector.Generic.Mutable.basicOverlaps mv mv'
+  basicUnsafeNew l = MV_N <$> Data.Vector.Generic.Mutable.basicUnsafeNew l
+  basicInitialize (MV_N mv) = Data.Vector.Generic.Mutable.basicInitialize mv
+  basicUnsafeReplicate i x = MV_N <$> Data.Vector.Generic.Mutable.basicUnsafeReplicate i (coerce x)
+  basicUnsafeRead (MV_N mv) i = coerce <$> Data.Vector.Generic.Mutable.basicUnsafeRead mv i
+  basicUnsafeWrite (MV_N mv) i x = Data.Vector.Generic.Mutable.basicUnsafeWrite mv i (coerce x)
+  basicClear (MV_N mv) = Data.Vector.Generic.Mutable.basicClear mv
+  basicSet (MV_N mv) x = Data.Vector.Generic.Mutable.basicSet mv (coerce x)
+  basicUnsafeCopy (MV_N mv) (MV_N mv') = Data.Vector.Generic.Mutable.basicUnsafeCopy mv mv'
+  basicUnsafeMove (MV_N mv) (MV_N mv') = Data.Vector.Generic.Mutable.basicUnsafeMove mv mv'
+  basicUnsafeGrow (MV_N mv) n = MV_N <$> Data.Vector.Generic.Mutable.basicUnsafeGrow mv n
+
+instance Data.Vector.Generic.Vector U.Vector N where -- needs MultiParamTypeClasses here
+  basicUnsafeFreeze (MV_N mv) = V_N <$> Data.Vector.Generic.basicUnsafeFreeze mv
+  basicUnsafeThaw (V_N v) = MV_N <$> Data.Vector.Generic.basicUnsafeThaw v
+  basicLength (V_N v) = Data.Vector.Generic.basicLength v
+  basicUnsafeSlice i l (V_N v) = V_N (Data.Vector.Generic.basicUnsafeSlice i l v)
+  basicUnsafeIndexM (V_N v) i = coerce <$> Data.Vector.Generic.basicUnsafeIndexM v i
+  basicUnsafeCopy (MV_N mv) (V_N v) = Data.Vector.Generic.basicUnsafeCopy mv v
+  elemseq (V_N v) x y = Data.Vector.Generic.elemseq v (coerce x) y
+
+instance U.Unbox N

From 18a9b6bcacdf19b81c63a25b1f2d9e858151f80f Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Thu, 27 Jun 2019 03:08:00 +0900
Subject: [PATCH 037/148] Exawizards2019-D: Memoization (still slow)

---
 exawizards2019-d/Main.hs | 76 +++++++++++++++++++++++++++++++---------
 1 file changed, 59 insertions(+), 17 deletions(-)

diff --git a/exawizards2019-d/Main.hs b/exawizards2019-d/Main.hs
index 262116a..ff7c74b 100644
--- a/exawizards2019-d/Main.hs
+++ b/exawizards2019-d/Main.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE RankNTypes #-}
 import Control.Monad
 import Data.Char (isSpace)
 import Data.Int (Int64)
@@ -9,26 +10,45 @@ import Data.List
 import qualified Data.Vector.Unboxed as U
 import qualified Data.Vector.Unboxed.Mutable as UM
 import qualified Data.ByteString.Char8 as BS
+import Control.Monad.ST
+import Data.Array.ST
+import Control.Monad.Reader
 --
 import Data.Coerce
 import qualified Data.Vector.Generic
 import qualified Data.Vector.Generic.Mutable
-import Debug.Trace
-
-solve :: Int -> Int -> [Int] -> N -> N
-solve !x 0 [] !c = c * fromIntegral x
--- solve !x 1 [y] c bc = c * (traceShow (c,bc,x) $ fromIntegral (x `rem` y))
-solve !x !n ss !c =
-  let (ss0,ss1) = span (> x) ss
-  in if null ss1
-     then factV U.! n * c * fromIntegral x
-     else let !m = length ss0
-              !q = factV U.! n / factV U.! (n-m)
-          in sum $ do (k, t:ts) <- zip [m..] $ tails ss1
-                      -- k + length ts + 1 == n
-                      -- k : t より大きいやつ
-                      let !p = factV U.! (n-m-1) / factV U.! (n-k-1)
-                      return $ solve (x `rem` t) (n - k - 1) ts (q * p * c)
+import qualified Data.Array.Base
+import qualified Unsafe.Coerce
+
+type Memo s a = ReaderT (STUArray s (Int,Int) N) (ST s) a
+
+runMemo :: Int -> Int -> (forall s. Memo s a) -> a
+runMemo x n action = runST $ do
+  arr <- newArray ((0,0),(x,n)) invalidN
+  runReaderT action arr
+
+solve :: Int -> Int -> [Int] -> N -> Memo s N
+solve !x 0 [] !c = pure $ c * fromIntegral x
+solve !x !n ss !c = do
+  arr <- ask
+  val <- lift $ readArray arr (x,n)
+  if val == invalidN
+    then do val <- doCalc x n ss
+            lift $ writeArray arr (x,n) val
+            return $ c * val
+    else return $ c * val
+  where
+    doCalc !x !n ss = case span (> x) ss of
+      (ss0,[]) -> pure $ factV U.! n * fromIntegral x
+      (ss0,ss1) -> do
+        let !m = length ss0
+            !q = factV U.! n / factV U.! (n-m)
+        s <- sumM [ solve (x `rem` t) (n - k - 1) ts (factV U.! (n-m-1) / factV U.! (n-k-1))
+                  | (k, t:ts) <- zip [m..] $ tails ss1
+                    -- k + length ts + 1 == n
+                    -- k : t より大きいやつ
+                  ]
+        return (q * s)
 -- n == length ss
 
 main = do
@@ -36,11 +56,14 @@ main = do
   -- n <= 200, x <= 10^5
   ss <- U.toList . mergeSortBy (\x y -> compare y x) . U.unfoldrN n (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
   -- si <= 10^5
-  print $ solve x n ss 1
+  print $ runMemo x n $ solve x n ss 1
 
 factV :: U.Vector N
 factV = U.scanl' (*) 1 (U.enumFromN 1 200)
 
+sumM :: (Monad m, Num a) => [m a] -> m a
+sumM = foldM (\s a -> (s +) <$> a) 0
+
 ---
 
 modulo :: Int64
@@ -62,6 +85,9 @@ instance Num N where
   fromInteger n = N (fromInteger (n `mod` fromIntegral modulo))
   abs = undefined; signum = undefined
 
+invalidN :: N
+invalidN = N (-1)
+
 {-# RULES
 "^9/Int" forall x. x ^ (9 :: Int) = let u = x; v = u * u * u in v * v * v
 "^9/Integer" forall x. x ^ (9 :: Integer) = let u = x; v = u * u * u in v * v * v
@@ -146,3 +172,19 @@ instance Data.Vector.Generic.Vector U.Vector N where -- needs MultiParamTypeClas
   elemseq (V_N v) x y = Data.Vector.Generic.elemseq v (coerce x) y
 
 instance U.Unbox N
+
+--- STUArray s i N
+
+unsafeCoerce_STUArray_N_Int :: STUArray s i N -> STUArray s i Int64
+unsafeCoerce_STUArray_N_Int = Unsafe.Coerce.unsafeCoerce
+unsafeCoerce_STUArray_Int_N :: STUArray s i Int64 -> STUArray s i N
+unsafeCoerce_STUArray_Int_N = Unsafe.Coerce.unsafeCoerce
+
+instance Data.Array.Base.MArray (STUArray s) N (ST s) where
+  getBounds arr = Data.Array.Base.getBounds (unsafeCoerce_STUArray_N_Int arr)
+  getNumElements arr = Data.Array.Base.getNumElements (unsafeCoerce_STUArray_N_Int arr)
+  newArray lu e = unsafeCoerce_STUArray_Int_N <$> Data.Array.Base.newArray lu (coerce e)
+  newArray_ lu = unsafeCoerce_STUArray_Int_N <$> Data.Array.Base.newArray_ lu
+  unsafeNewArray_ lu = unsafeCoerce_STUArray_Int_N <$> Data.Array.Base.unsafeNewArray_ lu
+  unsafeRead arr i = coerce <$> Data.Array.Base.unsafeRead (unsafeCoerce_STUArray_N_Int arr) i
+  unsafeWrite arr i e = Data.Array.Base.unsafeWrite (unsafeCoerce_STUArray_N_Int arr) i (coerce e)

From dc38ec15c58a96a65da0cc60f88489fc525f8138 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Thu, 27 Jun 2019 03:21:03 +0900
Subject: [PATCH 038/148] Exawizards2019-D: Strictness annotations

---
 exawizards2019-d/Main.hs | 36 ++++++++++++++++++++++--------------
 1 file changed, 22 insertions(+), 14 deletions(-)

diff --git a/exawizards2019-d/Main.hs b/exawizards2019-d/Main.hs
index ff7c74b..c46ea4c 100644
--- a/exawizards2019-d/Main.hs
+++ b/exawizards2019-d/Main.hs
@@ -28,27 +28,26 @@ runMemo x n action = runST $ do
   runReaderT action arr
 
 solve :: Int -> Int -> [Int] -> N -> Memo s N
-solve !x 0 [] !c = pure $ c * fromIntegral x
+solve !x 0 [] !c = pure $! c * fromIntegral x
 solve !x !n ss !c = do
   arr <- ask
   val <- lift $ readArray arr (x,n)
   if val == invalidN
     then do val <- doCalc x n ss
             lift $ writeArray arr (x,n) val
-            return $ c * val
-    else return $ c * val
+            return $! c * val
+    else return $! c * val
   where
-    doCalc !x !n ss = case span (> x) ss of
-      (ss0,[]) -> pure $ factV U.! n * fromIntegral x
-      (ss0,ss1) -> do
-        let !m = length ss0
-            !q = factV U.! n / factV U.! (n-m)
-        s <- sumM [ solve (x `rem` t) (n - k - 1) ts (factV U.! (n-m-1) / factV U.! (n-k-1))
-                  | (k, t:ts) <- zip [m..] $ tails ss1
-                    -- k + length ts + 1 == n
-                    -- k : t より大きいやつ
-                  ]
-        return (q * s)
+    doCalc !x !n ss = case spanN (> x) ss of
+      (_,[]) -> pure $! factV U.! n * fromIntegral x
+      (!m,ss1) -> do
+        let !q = factV U.! n / factV U.! (n-m)
+        !s <- sumM [ solve (x `rem` t) (n-k-1) ts (factV U.! (n-m-1) / factV U.! (n-k-1))
+                   | (k, t:ts) <- zip [m..] $ tails ss1
+                     -- k + length ts + 1 == n
+                     -- k : t より大きいやつ
+                   ]
+        return $! q * s
 -- n == length ss
 
 main = do
@@ -64,6 +63,15 @@ factV = U.scanl' (*) 1 (U.enumFromN 1 200)
 sumM :: (Monad m, Num a) => [m a] -> m a
 sumM = foldM (\s a -> (s +) <$> a) 0
 
+-- spanN f xs == first length (span f xs)
+spanN :: (a -> Bool) -> [a] -> (Int, [a])
+spanN f = go 0
+  where
+    go !n [] = (n, [])
+    go !n xs@(x:xss) = if f x
+                       then go (n+1) xss
+                       else (n, xs)
+
 ---
 
 modulo :: Int64

From 440e0e8ed3d6508a75ebbef3f837d6c0c664d473 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Wed, 26 Jun 2019 18:30:28 +0000
Subject: [PATCH 039/148] Exawizards2019-D: More memoization (AC; 1226ms)

---
 README.md                |  2 +-
 exawizards2019-d/Main.hs | 40 +++++++++++++++++++++-------------------
 2 files changed, 22 insertions(+), 20 deletions(-)

diff --git a/README.md b/README.md
index d479180..a45bd87 100644
--- a/README.md
+++ b/README.md
@@ -126,7 +126,7 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 * [x] A - Regular Triangle
 * [x] B - Red or Blue
 * [ ] C - Snuke the Wizard
-* [ ] D - Modulo Operations
+* [x] D - Modulo Operations
 * [x] E - Black or White
 * [ ] F - More Realistic Manhattan Distance
 
diff --git a/exawizards2019-d/Main.hs b/exawizards2019-d/Main.hs
index c46ea4c..faee0a9 100644
--- a/exawizards2019-d/Main.hs
+++ b/exawizards2019-d/Main.hs
@@ -27,27 +27,29 @@ runMemo x n action = runST $ do
   arr <- newArray ((0,0),(x,n)) invalidN
   runReaderT action arr
 
-solve :: Int -> Int -> [Int] -> N -> Memo s N
-solve !x 0 [] !c = pure $! c * fromIntegral x
-solve !x !n ss !c = do
+memo :: (Int,Int) -> Memo s N -> Memo s N
+memo x action = do
   arr <- ask
-  val <- lift $ readArray arr (x,n)
+  val <- lift $ readArray arr x
   if val == invalidN
-    then do val <- doCalc x n ss
-            lift $ writeArray arr (x,n) val
-            return $! c * val
-    else return $! c * val
-  where
-    doCalc !x !n ss = case spanN (> x) ss of
-      (_,[]) -> pure $! factV U.! n * fromIntegral x
-      (!m,ss1) -> do
-        let !q = factV U.! n / factV U.! (n-m)
-        !s <- sumM [ solve (x `rem` t) (n-k-1) ts (factV U.! (n-m-1) / factV U.! (n-k-1))
-                   | (k, t:ts) <- zip [m..] $ tails ss1
-                     -- k + length ts + 1 == n
-                     -- k : t より大きいやつ
-                   ]
-        return $! q * s
+    then do !val <- action
+            lift $ writeArray arr x val
+            return val
+    else return val
+
+solve :: Int -> Int -> [Int] -> N -> Memo s N
+solve !x 0 [] !c = pure $! c * fromIntegral x
+solve !x !n ss !c = fmap (c *) $ memo (x,n) $ case spanN (> x) ss of
+  (_,[]) -> pure $! factV U.! n * fromIntegral x
+  (!m,ss1) -> do
+    let !q = factV U.! n / factV U.! (n-m)
+    let n' = n - m
+    !s <- memo (x,n') $ sumM [ solve (x `rem` t) (n'-k-1) ts (factV U.! (n'-1) / factV U.! (n'-k-1))
+                             | (k, t:ts) <- zip [0..] $ tails ss1
+                               -- k + length ts + 1 == n
+                               -- k : t より大きいやつ
+                             ]
+    return $! q * s
 -- n == length ss
 
 main = do

From 593dc67ec7759c4feba45491a9decb6eb9a673de Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Thu, 27 Jun 2019 13:31:21 +0900
Subject: [PATCH 040/148] DP-R

---
 README.md    | 42 +++++++++++++++---------
 dp-r/Main.hs | 91 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 117 insertions(+), 16 deletions(-)
 create mode 100644 dp-r/Main.hs

diff --git a/README.md b/README.md
index a45bd87..50c71a3 100644
--- a/README.md
+++ b/README.md
@@ -29,22 +29,32 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 
 解いた問題：
 
-* A - Frog 1
-* B - Frog 2
-* C - Vacation
-* D - Knapsack 1
-* E - Knapsack 2
-* F - LCS
-* G - Longest Path
-* H - Grid 1
-* I - Coins
-* J - Sushi
-* K - Stones
-* L - Deque
-* M - Candies
-* N - Slimes
-* O - Matching
-* P - Independent Set
+* [x] A - Frog 1
+* [x] B - Frog 2
+* [x] C - Vacation
+* [x] D - Knapsack 1
+* [x] E - Knapsack 2
+* [x] F - LCS
+* [x] G - Longest Path
+* [x] H - Grid 1
+* [x] I - Coins
+* [x] J - Sushi
+* [x] K - Stones
+* [x] L - Deque
+* [x] M - Candies
+* [x] N - Slimes
+* [x] O - Matching
+* [x] P - Independent Set
+* [ ] Q - Flowers
+* [x] R - Walk
+* [ ] S - Digit Sum
+* [ ] T - Permutation
+* [ ] U - Grouping
+* [ ] V - Subtree
+* [ ] W - Intervals
+* [ ] X - Tower
+* [ ] Y - Grid 2
+* [ ] Z - Frog 3
 
 ## AtCoder Beginner Contest 032
 
diff --git a/dp-r/Main.hs b/dp-r/Main.hs
new file mode 100644
index 0000000..60339e9
--- /dev/null
+++ b/dp-r/Main.hs
@@ -0,0 +1,91 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+import Data.Char (isSpace)
+import Data.Int (Int64)
+import Data.List (unfoldr)
+import Control.Monad
+import qualified Data.ByteString.Char8 as BS
+import Data.Array.Unboxed
+import Data.Coerce
+---
+import qualified Data.Array.Base
+import qualified Unsafe.Coerce
+
+main = do
+  [n',k'] <- unfoldr (BS.readInteger . BS.dropWhile isSpace) <$> BS.getLine
+  let n :: Int
+      n = fromInteger n'
+      k :: Int64
+      k = fromInteger k'
+  elements <- replicateM n $ map fromIntegral . unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  let mat :: UArray (Int,Int) N
+      mat = array ((1,1),(n,n))
+            [ ((i,j),a) | (i,e) <- zip [1..n] elements, (j,a) <- zip [1..n] e ]
+  print $ sum $ elems $ matPow n mat k
+
+---
+
+matMul :: UArray (Int,Int) N -> UArray (Int,Int) N -> UArray (Int,Int) N
+matMul a b = let ((i0,j0),(ix,jx)) = bounds a
+                 ((j'0,k0),(j'x,kx)) = bounds b
+             in if jx - j0 == j'x - j'0
+                   then array ((i0,k0),(ix,kx))
+                        [ ((i,k), sum [a!(i,j) * b!(j',k) | (j,j') <- zip (range (j0,jx)) (range (j'0,j'x))])
+                        | i <- range (i0,ix)
+                        , k <- range (k0,kx)
+                        ]
+                else error "Matrix size mismatch"
+
+matPow :: Int -> UArray (Int,Int) N -> Int64 -> UArray (Int,Int) N
+matPow k m 0 = array ((1,1),(k,k)) $
+               [((i,j), if i == j then 1 else 0) | i <- [1..k], j <- [1..k]]
+matPow _ m i = loop (i-1) m m
+  where
+    loop 0 !_ acc = acc
+    loop 1 m acc = m `matMul` acc
+    loop i m acc = case i `quotRem` 2 of
+                     (j,0) -> loop j (m `matMul` m) acc
+                     (j,_) -> loop j (m `matMul` m) (acc `matMul` m)
+
+---
+
+modulo :: Int64
+modulo = 10^9+7
+addMod, subMod, mulMod :: Int64 -> Int64 -> Int64
+addMod !x !y | x + y >= modulo = x + y - modulo
+             | otherwise = x + y
+subMod !x !y | x >= y = x - y
+             | otherwise = x - y + modulo
+mulMod !x !y = (x * y) `rem` modulo
+
+newtype N = N { unwrapN :: Int64 } deriving (Eq)
+instance Show N where
+  show (N x) = show x
+instance Num N where
+  (+) = coerce addMod
+  (-) = coerce subMod
+  (*) = coerce mulMod
+  fromInteger n = N (fromInteger (n `mod` fromIntegral modulo))
+  abs = undefined; signum = undefined
+
+{-# RULES
+"^9/Int" forall x. x ^ (9 :: Int) = let u = x; v = u * u * u in v * v * v
+"^9/Integer" forall x. x ^ (9 :: Integer) = let u = x; v = u * u * u in v * v * v
+ #-}
+
+--- UArray i N
+
+unsafeCoerce_UArray_N_Int :: UArray i N -> UArray i Int64
+unsafeCoerce_UArray_N_Int = Unsafe.Coerce.unsafeCoerce
+unsafeCoerce_UArray_Int_N :: UArray i Int64 -> UArray i N
+unsafeCoerce_UArray_Int_N = Unsafe.Coerce.unsafeCoerce
+
+instance Data.Array.Base.IArray UArray N where
+  bounds arr = Data.Array.Base.bounds (unsafeCoerce_UArray_N_Int arr)
+  numElements arr = Data.Array.Base.numElements (unsafeCoerce_UArray_N_Int arr)
+  unsafeArray lu ies = unsafeCoerce_UArray_Int_N $ Data.Array.Base.unsafeArray lu (coerce ies)
+  unsafeAt arr i = coerce (Data.Array.Base.unsafeAt (unsafeCoerce_UArray_N_Int arr) i)
+  unsafeReplace arr ies = unsafeCoerce_UArray_Int_N (Data.Array.Base.unsafeReplace (unsafeCoerce_UArray_N_Int arr) (coerce ies))
+  unsafeAccum f arr ies = unsafeCoerce_UArray_Int_N (Data.Array.Base.unsafeAccum (coerce f) (unsafeCoerce_UArray_N_Int arr) ies)
+  unsafeAccumArray f e lu ies = unsafeCoerce_UArray_Int_N (Data.Array.Base.unsafeAccumArray (coerce f) (coerce e) lu ies)

From 211da844b88eec9b45c6aace8fc90fb8460db164 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Thu, 27 Jun 2019 23:10:07 +0900
Subject: [PATCH 041/148] DP-R: Indent

---
 dp-r/Main.hs | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/dp-r/Main.hs b/dp-r/Main.hs
index 60339e9..1c5f75a 100644
--- a/dp-r/Main.hs
+++ b/dp-r/Main.hs
@@ -30,11 +30,11 @@ matMul :: UArray (Int,Int) N -> UArray (Int,Int) N -> UArray (Int,Int) N
 matMul a b = let ((i0,j0),(ix,jx)) = bounds a
                  ((j'0,k0),(j'x,kx)) = bounds b
              in if jx - j0 == j'x - j'0
-                   then array ((i0,k0),(ix,kx))
-                        [ ((i,k), sum [a!(i,j) * b!(j',k) | (j,j') <- zip (range (j0,jx)) (range (j'0,j'x))])
-                        | i <- range (i0,ix)
-                        , k <- range (k0,kx)
-                        ]
+                then array ((i0,k0),(ix,kx))
+                     [ ((i,k), sum [a!(i,j) * b!(j',k) | (j,j') <- zip (range (j0,jx)) (range (j'0,j'x))])
+                     | i <- range (i0,ix)
+                     , k <- range (k0,kx)
+                     ]
                 else error "Matrix size mismatch"
 
 matPow :: Int -> UArray (Int,Int) N -> Int64 -> UArray (Int,Int) N

From 2c7a470e3995999be01088ee6704314180c9d04e Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Thu, 27 Jun 2019 23:10:30 +0900
Subject: [PATCH 042/148] DP-Q

---
 README.md    |  2 +-
 dp-q/Main.hs | 92 ++++++++++++++++++++++++++++++++--------------------
 2 files changed, 58 insertions(+), 36 deletions(-)

diff --git a/README.md b/README.md
index 50c71a3..15d0dcf 100644
--- a/README.md
+++ b/README.md
@@ -45,7 +45,7 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 * [x] N - Slimes
 * [x] O - Matching
 * [x] P - Independent Set
-* [ ] Q - Flowers
+* [x] Q - Flowers
 * [x] R - Walk
 * [ ] S - Digit Sum
 * [ ] T - Permutation
diff --git a/dp-q/Main.hs b/dp-q/Main.hs
index 1076b86..ba147cd 100644
--- a/dp-q/Main.hs
+++ b/dp-q/Main.hs
@@ -4,50 +4,72 @@ import Data.Char (isSpace)
 import Data.Int (Int64)
 import Data.List (unfoldr)
 import Data.Bifunctor (first)
+import Control.Monad
+import Control.Monad.ST
 import qualified Data.Vector.Unboxed as U
 import qualified Data.Vector.Unboxed.Mutable as UM
 import qualified Data.ByteString.Char8 as BS
-import qualified Data.IntMap.Strict as IntMap
+import Data.Bits
+
+type SegTree a = (Int, U.Vector a)
+type MSegTree s a = (Int, U.MVector s a)
+
+queryM :: Int -> MSegTree s Int64 -> ST s Int64
+queryM !i (!depth, vec) = UM.read vec (2^depth - 1 + i)
+
+-- queryRangeM i j st == maximum <$> sequence [query k st | k <- [i..j-1]]
+queryRangeM :: Int -> Int -> MSegTree s Int64 -> ST s Int64
+queryRangeM !i !j (!depth, vec) | i < j = doQuery 0 depth i j
+                                | otherwise = return minBound
+  where
+    -- Invariant: 0 <= k*2^l <= i < j <= (k+1)*2^l <= 2^depth
+    doQuery !k 0 !i !j | i == k, j == k+1 = UM.read vec (2^depth - 1 + k)
+                       | otherwise = error "query"
+    doQuery !k l !i !j | i == (k `shiftL` l), j == (k+1) `shiftL` l = UM.read vec (2^(depth-l) - 1 + k)
+                       | m <= i = doQuery (2*k+1) (l-1) i j
+                       | j <= m = doQuery (2*k) (l-1) i j
+                       | otherwise = max <$> doQuery (2*k) (l-1) i m <*> doQuery (2*k+1) (l-1) m j
+      where m = (2*k+1) `shiftL` (l-1)
+
+set :: Int -> MSegTree s Int64 -> Int64 -> ST s ()
+set !i (!depth, vec) !x = forM_ [0..depth] $ \k ->
+  UM.modify vec (max x) (2^k - 1 + (i `shiftR` (depth - k)))
 
 main = do
   n <- readLn
   hs <- U.unfoldrN n (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
   as <- U.unfoldrN n (readInt64 . BS.dropWhile isSpace) <$> BS.getLine
-  let -- v ! i は j < i かつ hs ! j < hs ! i となるような j のうち、 hs ! j が最大のもの
-      -- そのような j が存在しなければ -1
-      v :: U.Vector Int
-      v = U.create $ do
-        vec <- UM.new n
-        let loop !i !m
-              | i == n = return ()
-              | otherwise = do
-                  let hs_i = hs U.! i
-                  case IntMap.lookupLT hs_i m of
-                    Just (hs_j, j) -> do
-                      UM.write vec i j
-                      loop (i+1) (IntMap.insert hs_i i m)
-                    Nothing -> do
-                      UM.write vec i (-1)
-                      loop (i+1) (IntMap.insert hs_i i m)
-        loop 0 IntMap.empty
-        return vec
-      -- resultV ! i は、入力の先頭から i+1 本のうち高さが hs ! i 以下のものを選んだ部分列に関する問題の答え
-      resultV :: U.Vector Int64
-      resultV = U.create $ do
-        vec <- UM.new n
-        let loop !i !m
-              | i == n = return ()
-              | otherwise = do
-                  let h = hs U.! i
-                  let a = as U.! i
-                  let (left, right) = IntMap.split h m
-                  let s' = maximum (0 : IntMap.elems left)
-                  let s'' = a + s'
-                  UM.write vec i s''
-                  loop (i+1) $ IntMap.insert h s'' $ IntMap.union left $ IntMap.filter (> s'') right
-        loop 0 IntMap.empty
+  let ht = U.create $ do
+        ht <- UM.new n
+        flip U.imapM_ hs $ \i h -> do
+          UM.write ht (h - 1) i
+        return ht
+  let (h2i,m) = runST $ do
+        h2i <- UM.new n
+        let loop !i !j !k | i == n = return k
+                          | otherwise = do
+                              let j' = ht U.! i
+                                  k' = if j < j' then k else k+1
+                              UM.write h2i i k'
+                              loop (i+1) j' k'
+        k <- loop 0 0 0
+        h2i <- U.unsafeFreeze h2i
+        return (h2i,k+1)
+  let depth = ceiling (logBase 2 (fromIntegral m) :: Double) :: Int
+  let result = U.create $ do
+        vec <- UM.replicate (2^(depth+1)-1) 0
+        let st = (depth, vec)
+        forM_ [0..n-1] $ \i -> do
+          let h = hs U.! i
+              k = h2i U.! (h-1)
+          x <- queryRangeM 0 (k+1) st
+          set k st (x + as U.! i)
+          {-
+          x <- foldM (\x a -> max x <$> a) 0 [ UM.read vec j | j <- [0..k] ]
+          UM.write vec k (x + as U.! i)
+          -}
         return vec
-  print $ U.maximum $ resultV
+  print $ U.head result
 
 readInt64 :: BS.ByteString -> Maybe (Int64, BS.ByteString)
 readInt64 s = first fromIntegral <$> BS.readInt s

From 586e3d4b9974b3ad39418e944e60756844d19496 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Sat, 29 Jun 2019 23:47:36 +0900
Subject: [PATCH 043/148] ABC132-A, B, C, D

---
 README.md        |  13 ++++++
 abc132-a/Main.hs |   8 ++++
 abc132-b/Main.hs |  10 +++++
 abc132-c/Main.hs |  13 ++++++
 abc132-d/Main.hs | 104 +++++++++++++++++++++++++++++++++++++++++++++++
 5 files changed, 148 insertions(+)
 create mode 100644 abc132-a/Main.hs
 create mode 100644 abc132-b/Main.hs
 create mode 100644 abc132-c/Main.hs
 create mode 100644 abc132-d/Main.hs

diff --git a/README.md b/README.md
index 15d0dcf..f431b87 100644
--- a/README.md
+++ b/README.md
@@ -399,3 +399,16 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 * [x] D - Megalomania
 * [x] E - Friendships
 * [x] F - Must Be Rectangular!
+
+## AtCoder Beginner Contest 132 (2019-06-29)
+
+<https://atcoder.jp/contests/abc132>
+
+解いた問題：
+
+* [x] A - Fifty-Fifty
+* [x] B - Ordinary Number
+* [x] C - Divide the Problems
+* [x] D - Blue and Red Balls
+* [ ] E - Hopscotch Addict
+* [ ] F - Small Products
diff --git a/abc132-a/Main.hs b/abc132-a/Main.hs
new file mode 100644
index 0000000..5e61561
--- /dev/null
+++ b/abc132-a/Main.hs
@@ -0,0 +1,8 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.List
+
+main = do
+  [a,b,c,d] <- sort <$> getLine
+  putStrLn $ if a == b && b /= c && c == d
+             then "Yes"
+             else "No"
diff --git a/abc132-b/Main.hs b/abc132-b/Main.hs
new file mode 100644
index 0000000..ed067bf
--- /dev/null
+++ b/abc132-b/Main.hs
@@ -0,0 +1,10 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE ScopedTypeVariables #-}
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  n :: Int <- readLn
+  xs <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  print $ length $ filter id $ zipWith3 (\x y z -> min x z < y && y < max x z) xs (tail xs) (drop 2 xs)
diff --git a/abc132-c/Main.hs b/abc132-c/Main.hs
new file mode 100644
index 0000000..5e0ecb7
--- /dev/null
+++ b/abc132-c/Main.hs
@@ -0,0 +1,13 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Char (isSpace)
+import Data.List (unfoldr, sort)
+import qualified Data.Vector.Unboxed as U
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  n <- readLn
+  xs <- U.fromListN n . sort . unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  let (ys,zs) = U.splitAt (n `quot` 2) xs
+      y = U.last ys
+      z = U.head zs
+  print $ z - y
diff --git a/abc132-d/Main.hs b/abc132-d/Main.hs
new file mode 100644
index 0000000..915ae82
--- /dev/null
+++ b/abc132-d/Main.hs
@@ -0,0 +1,104 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE MultiParamTypeClasses, TypeFamilies #-}
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.Int (Int64)
+import Data.List (unfoldr)
+import Data.Coerce
+import Control.Monad
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+---
+import qualified Data.Vector.Generic
+import qualified Data.Vector.Generic.Mutable
+
+main = do
+  [n,k] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  forM_ [1..k] $ \i ->
+    print $ binom (n - k + 1) i * binom (k - 1) (i - 1)
+
+fact :: U.Vector N
+fact = U.scanl' (*) 1 (U.enumFromN 1 2000)
+
+binom :: Int -> Int -> N
+binom n k | k < 0 || n < k = 0
+          | otherwise = fact U.! n / (fact U.! k * fact U.! (n - k))
+
+---
+
+modulo :: Int64
+modulo = 10^9+7
+addMod, subMod, mulMod :: Int64 -> Int64 -> Int64
+addMod !x !y | x + y >= modulo = x + y - modulo
+             | otherwise = x + y
+subMod !x !y | x >= y = x - y
+             | otherwise = x - y + modulo
+mulMod !x !y = (x * y) `rem` modulo
+
+newtype N = N { unwrapN :: Int64 } deriving (Eq)
+instance Show N where
+  show (N x) = show x
+instance Num N where
+  (+) = coerce addMod
+  (-) = coerce subMod
+  (*) = coerce mulMod
+  fromInteger n = N (fromInteger (n `mod` fromIntegral modulo))
+  abs = undefined; signum = undefined
+
+{-# RULES
+"^9/Int" forall x. x ^ (9 :: Int) = let u = x; v = u * u * u in v * v * v
+"^9/Integer" forall x. x ^ (9 :: Integer) = let u = x; v = u * u * u in v * v * v
+ #-}
+
+---
+
+exEuclid :: (Eq a, Integral a) => a -> a -> (a, a, a)
+exEuclid !f !g = loop 1 0 0 1 f g
+  where loop !u0 !u1 !v0 !v1 !f 0 = (f, u0, v0)
+        loop !u0 !u1 !v0 !v1 !f g =
+          case divMod f g of
+            (q,r) -> loop u1 (u0 - q * u1) v1 (v0 - q * v1) g r
+
+recipM :: Int64 -> Int64
+recipM !x = case exEuclid x modulo of
+             (1,a,_) -> a `mod` modulo
+             (-1,a,_) -> (-a) `mod` modulo
+divM :: Int64 -> Int64 -> Int64
+divM !x !y = x `mulMod` recipM y
+
+instance Fractional N where
+  (/) = coerce divM
+  recip = coerce recipM
+  fromRational = undefined
+
+---
+
+newtype instance UM.MVector s N = MV_N (UM.MVector s Int64)
+newtype instance U.Vector N = V_N (U.Vector Int64)
+
+instance Data.Vector.Generic.Mutable.MVector UM.MVector N where -- needs MultiParamTypeClasses here
+  basicLength (MV_N mv) = Data.Vector.Generic.Mutable.basicLength mv
+  basicUnsafeSlice i l (MV_N mv) = MV_N (Data.Vector.Generic.Mutable.basicUnsafeSlice i l mv)
+  basicOverlaps (MV_N mv) (MV_N mv') = Data.Vector.Generic.Mutable.basicOverlaps mv mv'
+  basicUnsafeNew l = MV_N <$> Data.Vector.Generic.Mutable.basicUnsafeNew l
+  basicInitialize (MV_N mv) = Data.Vector.Generic.Mutable.basicInitialize mv
+  basicUnsafeReplicate i x = MV_N <$> Data.Vector.Generic.Mutable.basicUnsafeReplicate i (coerce x)
+  basicUnsafeRead (MV_N mv) i = coerce <$> Data.Vector.Generic.Mutable.basicUnsafeRead mv i
+  basicUnsafeWrite (MV_N mv) i x = Data.Vector.Generic.Mutable.basicUnsafeWrite mv i (coerce x)
+  basicClear (MV_N mv) = Data.Vector.Generic.Mutable.basicClear mv
+  basicSet (MV_N mv) x = Data.Vector.Generic.Mutable.basicSet mv (coerce x)
+  basicUnsafeCopy (MV_N mv) (MV_N mv') = Data.Vector.Generic.Mutable.basicUnsafeCopy mv mv'
+  basicUnsafeMove (MV_N mv) (MV_N mv') = Data.Vector.Generic.Mutable.basicUnsafeMove mv mv'
+  basicUnsafeGrow (MV_N mv) n = MV_N <$> Data.Vector.Generic.Mutable.basicUnsafeGrow mv n
+
+instance Data.Vector.Generic.Vector U.Vector N where -- needs MultiParamTypeClasses here
+  basicUnsafeFreeze (MV_N mv) = V_N <$> Data.Vector.Generic.basicUnsafeFreeze mv
+  basicUnsafeThaw (V_N v) = MV_N <$> Data.Vector.Generic.basicUnsafeThaw v
+  basicLength (V_N v) = Data.Vector.Generic.basicLength v
+  basicUnsafeSlice i l (V_N v) = V_N (Data.Vector.Generic.basicUnsafeSlice i l v)
+  basicUnsafeIndexM (V_N v) i = coerce <$> Data.Vector.Generic.basicUnsafeIndexM v i
+  basicUnsafeCopy (MV_N mv) (V_N v) = Data.Vector.Generic.basicUnsafeCopy mv v
+  elemseq (V_N v) x y = Data.Vector.Generic.elemseq v (coerce x) y
+
+instance U.Unbox N

From f8bc3f8d937d5a998a025a39cfad3b71ae6b132f Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Sat, 29 Jun 2019 23:47:45 +0900
Subject: [PATCH 044/148] ABC132-E: Slow solution

---
 abc132-e/Main.hs | 110 +++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 110 insertions(+)
 create mode 100644 abc132-e/Main.hs

diff --git a/abc132-e/Main.hs b/abc132-e/Main.hs
new file mode 100644
index 0000000..b250232
--- /dev/null
+++ b/abc132-e/Main.hs
@@ -0,0 +1,110 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import Control.Monad
+import qualified Data.Vector as V
+import qualified Data.Vector.Mutable as VM
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.IntMap.Strict as IntMap
+import qualified Data.IntSet as IntSet
+import Data.Foldable
+import Control.Monad.ST
+import Debug.Trace
+
+main = do
+  [n,m] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  edges <- U.replicateM m $ do
+    [u,v] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+    return (u-1,v-1)
+  [s,t] <- map (subtract 1) . unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  let {-
+      graph1 :: V.Vector IntSet.IntSet
+      graph1 = V.create $ do
+        vec <- VM.replicate n IntSet.empty
+        U.forM_ edges $ \(u,v) -> do
+          s <- VM.read vec u
+          VM.write vec u $! IntSet.insert v s
+        return vec
+      -}
+      graph1 :: IntMap.IntMap IntSet.IntSet
+      graph1 = U.foldl' (\m (u,v) -> IntMap.insertWith IntSet.union u (IntSet.singleton v) m) IntMap.empty edges
+      graph2 :: IntMap.IntMap IntSet.IntSet
+      graph2 = IntMap.map (foldMap_IntSet (go 2)) graph1
+        where go 0 !u = IntSet.singleton u
+              go 1 !u = IntMap.findWithDefault IntSet.empty u graph1
+              go i !u = foldMap_IntSet (go (i - 1)) $ IntMap.findWithDefault IntSet.empty u graph1
+      {-
+      graph2 :: V.Vector IntSet.IntSet
+      graph2 = V.create $ do
+        vec <- VM.new n
+        let go 0 !u = IntSet.singleton u
+            go 1 !u = graph1 V.! u
+            go i !u = foldMap_IntSet (go (i - 1)) $ graph1 V.! u
+        forM_ [0..n-1] $ \u -> do
+          VM.write vec u $! go 3 u
+        return vec
+      -}
+      result = runST $ do
+        visited <- UM.replicate n False
+        {-
+        -- bfs :: IntSet -> ST s (Maybe Int)
+        let bfs !depth ss = do
+              forM_IntSet ss $ \u ->
+                UM.write visited u True
+              let ts = foldMap_IntSet (graph2 V.!) ss
+              ts' <- foldMapM_IntSet (\v -> do
+                                         d <- UM.read visited v
+                                         pure $ if d then IntSet.empty else IntSet.singleton v
+                                     ) ts
+              if t `IntSet.member` ts'
+                then return (Just depth)
+                else if IntSet.null ts'
+                     then return Nothing
+                     else bfs (depth+1) ts'
+        bfs 1 (IntSet.singleton s)
+        -}
+        -- bfs :: [Int] -> ST s (Maybe Int)
+        let bfs !depth ss = do
+              forM_ ss $ \u ->
+                UM.write visited u True
+              --let ts = foldMap (graph2 V.!) ss
+              let ts = foldMap (\u -> IntMap.findWithDefault IntSet.empty u graph2) ss
+              if t `IntSet.member` ts
+                then return (Just depth)
+                else do ts' <- filterM (\v -> not <$> UM.read visited v) (IntSet.toList ts)
+                        if null ts'
+                          then return Nothing
+                          else bfs (depth+1) ts'
+        bfs 1 [s]
+  -- print graph1
+  -- print graph2
+  case result of
+    Nothing -> putStrLn "-1"
+    Just d -> print d
+
+foldMap_IntSet :: (Monoid n) => (Int -> n) -> IntSet.IntSet -> n
+foldMap_IntSet f set = go set
+  where
+    go set = case IntSet.splitRoot set of
+               [] -> mempty
+               [x] -> foldMap f (IntSet.toList x)
+               xs -> foldMap go xs
+
+forM_IntSet :: Monad m => IntSet.IntSet -> (Int -> m ()) -> m ()
+forM_IntSet set f = go set
+  where
+    go set = case IntSet.splitRoot set of
+               [] -> return ()
+               [x] -> forM_ (IntSet.toList x) f
+               xs -> forM_ xs go
+
+foldMapM_IntSet :: (Monoid n, Monad m) => (Int -> m n) -> IntSet.IntSet -> m n
+foldMapM_IntSet f set = go set
+  where
+    go set = case IntSet.splitRoot set of
+               [] -> return mempty
+               [x] -> foldlM (\x v -> mappend x <$> f v) mempty (IntSet.toList x)
+               xs -> foldlM (\x set' -> mappend x <$> go set') mempty xs

From ccaafe1b44e75bf9793d648ae1c663d242017eaa Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Wed, 3 Jul 2019 18:35:55 +0900
Subject: [PATCH 045/148] ABC132-E

---
 README.md                     |  2 +-
 abc132-e/IntMap.hs            | 89 ++++++++++++++++++++++++++++++++++
 abc132-e/{Main.hs => Slow.hs} |  0
 abc132-e/Vec.hs               | 91 +++++++++++++++++++++++++++++++++++
 4 files changed, 181 insertions(+), 1 deletion(-)
 create mode 100644 abc132-e/IntMap.hs
 rename abc132-e/{Main.hs => Slow.hs} (100%)
 create mode 100644 abc132-e/Vec.hs

diff --git a/README.md b/README.md
index f431b87..a9fcf94 100644
--- a/README.md
+++ b/README.md
@@ -410,5 +410,5 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 * [x] B - Ordinary Number
 * [x] C - Divide the Problems
 * [x] D - Blue and Red Balls
-* [ ] E - Hopscotch Addict
+* [x] E - Hopscotch Addict
 * [ ] F - Small Products
diff --git a/abc132-e/IntMap.hs b/abc132-e/IntMap.hs
new file mode 100644
index 0000000..5981631
--- /dev/null
+++ b/abc132-e/IntMap.hs
@@ -0,0 +1,89 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import Control.Monad
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.IntMap.Strict as IntMap
+import qualified Data.IntSet as IntSet
+import Data.Foldable
+import Control.Monad.ST
+
+main = do
+  [n,m] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  edges <- U.replicateM m $ do
+    [u,v] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+    return (u-1,v-1)
+  [s,t] <- map (subtract 1) . unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  let graph :: IntMap.IntMap IntSet.IntSet
+      graph = U.foldl' (\m (u,v) -> insertGraph (3 * u) (3 * v + 1)
+                                    $ insertGraph (3 * u + 1) (3 * v + 2)
+                                    $ insertGraph (3 * u + 2) (3 * v)
+                                    $ m) IntMap.empty edges
+      result = runST $ do
+        visited <- UM.replicate (3 * n) False
+        let !target = 3 * t
+        {-
+        -- bfs :: Int -> IntSet -> ST s (Maybe Int)
+        let bfs !depth ss = do
+              forM_IntSet ss $ \u ->
+                UM.write visited u True
+              let ts = foldMap_IntSet (\u -> IntMap.findWithDefault IntSet.empty u graph) ss
+              ts' <- foldMapM_IntSet (\v -> do
+                                         d <- UM.read visited v
+                                         pure $ if d then IntSet.empty else IntSet.singleton v
+                                     ) ts
+              if target `IntSet.member` ts'
+                then return $ Just (depth `quot` 3)
+                else if IntSet.null ts'
+                     then return Nothing
+                     else bfs (depth+1) ts'
+        bfs 1 (IntSet.singleton (3 * s))
+        -}
+        -- bfs :: Int -> [Int] -> ST s (Maybe Int)
+        let bfs !depth ss = do
+              forM_ ss $ \u ->
+                UM.write visited u True
+              let ts = foldMap (\u -> IntMap.findWithDefault IntSet.empty u graph) ss
+              if target `IntSet.member` ts
+                then return $ Just (depth `quot` 3)
+                else do ts' <- filterM (\v -> not <$> UM.read visited v) (IntSet.toList ts)
+                        if null ts'
+                          then return Nothing
+                          else bfs (depth+1) ts'
+        bfs 1 [3 * s]
+  case result of
+    Nothing -> putStrLn "-1"
+    Just d -> print d
+
+-- insertGraph key val == IntMap.insertWith IntSet.union key (IntSet.singleton val)
+insertGraph :: Int -> Int -> IntMap.IntMap IntSet.IntSet -> IntMap.IntMap IntSet.IntSet
+insertGraph !key !val = IntMap.alter (Just . f) key
+  where f Nothing = IntSet.singleton val
+        f (Just set) = IntSet.insert val set
+
+foldMap_IntSet :: (Monoid n) => (Int -> n) -> IntSet.IntSet -> n
+foldMap_IntSet f set = go set
+  where
+    go set = case IntSet.splitRoot set of
+               [] -> mempty
+               [x] -> foldMap f (IntSet.toList x)
+               xs -> foldMap go xs
+
+forM_IntSet :: Monad m => IntSet.IntSet -> (Int -> m ()) -> m ()
+forM_IntSet set f = go set
+  where
+    go set = case IntSet.splitRoot set of
+               [] -> return ()
+               [x] -> forM_ (IntSet.toList x) f
+               xs -> forM_ xs go
+
+foldMapM_IntSet :: (Monoid n, Monad m) => (Int -> m n) -> IntSet.IntSet -> m n
+foldMapM_IntSet f set = go set
+  where
+    go set = case IntSet.splitRoot set of
+               [] -> return mempty
+               [x] -> foldlM (\x v -> mappend x <$> f v) mempty (IntSet.toList x)
+               xs -> foldlM (\x set' -> mappend x <$> go set') mempty xs
diff --git a/abc132-e/Main.hs b/abc132-e/Slow.hs
similarity index 100%
rename from abc132-e/Main.hs
rename to abc132-e/Slow.hs
diff --git a/abc132-e/Vec.hs b/abc132-e/Vec.hs
new file mode 100644
index 0000000..546278e
--- /dev/null
+++ b/abc132-e/Vec.hs
@@ -0,0 +1,91 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import Control.Monad
+import qualified Data.Vector as V
+import qualified Data.Vector.Mutable as VM
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.IntSet as IntSet
+import Data.Foldable
+import Control.Monad.ST
+
+main = do
+  [n,m] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  edges <- U.replicateM m $ do
+    [u,v] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+    return (u-1,v-1)
+  [s,t] <- map (subtract 1) . unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  let graph :: V.Vector IntSet.IntSet
+      graph = V.create $ do
+        vec <- VM.replicate (3 * n) IntSet.empty
+        U.forM_ edges $ \(u,v) -> do
+          modify' vec (IntSet.insert (3 * v + 1)) (3 * u)
+          modify' vec (IntSet.insert (3 * v + 2)) (3 * u + 1)
+          modify' vec (IntSet.insert (3 * v)) (3 * u + 2)
+        return vec
+      result = runST $ do
+        visited <- UM.replicate (3 * n) False
+        let !target = 3 * t
+        {-
+        -- bfs :: Int -> IntSet -> ST s (Maybe Int)
+        let bfs !depth ss = do
+              forM_IntSet ss $ \u ->
+                UM.write visited u True
+              let ts = foldMap_IntSet (graph V.!) ss
+              ts' <- foldMapM_IntSet (\v -> do
+                                         d <- UM.read visited v
+                                         pure $ if d then IntSet.empty else IntSet.singleton v
+                                     ) ts
+              if target `IntSet.member` ts'
+                then return $ Just (depth `quot` 3)
+                else if IntSet.null ts'
+                     then return Nothing
+                     else bfs (depth+1) ts'
+        bfs 1 (IntSet.singleton (3 * s))
+-}
+        -- bfs :: Int -> [Int] -> ST s (Maybe Int)
+        let bfs !depth ss = do
+              forM_ ss $ \u ->
+                UM.write visited u True
+              let ts = foldMap (graph V.!) ss
+              if target `IntSet.member` ts
+                then return $ Just (depth `quot` 3)
+                else do ts' <- filterM (\v -> not <$> UM.read visited v) (IntSet.toList ts)
+                        if null ts'
+                          then return Nothing
+                          else bfs (depth+1) ts'
+        bfs 1 [3 * s]
+  case result of
+    Nothing -> putStrLn "-1"
+    Just d -> print d
+
+modify' :: VM.MVector s a -> (a -> a) -> Int -> ST s ()
+modify' vec f !i = do x <- VM.read vec i
+                      VM.write vec i $! f x
+
+foldMap_IntSet :: (Monoid n) => (Int -> n) -> IntSet.IntSet -> n
+foldMap_IntSet f set = go set
+  where
+    go set = case IntSet.splitRoot set of
+               [] -> mempty
+               [x] -> foldMap f (IntSet.toList x)
+               xs -> foldMap go xs
+
+forM_IntSet :: Monad m => IntSet.IntSet -> (Int -> m ()) -> m ()
+forM_IntSet set f = go set
+  where
+    go set = case IntSet.splitRoot set of
+               [] -> return ()
+               [x] -> forM_ (IntSet.toList x) f
+               xs -> forM_ xs go
+
+foldMapM_IntSet :: (Monoid n, Monad m) => (Int -> m n) -> IntSet.IntSet -> m n
+foldMapM_IntSet f set = go set
+  where
+    go set = case IntSet.splitRoot set of
+               [] -> return mempty
+               [x] -> foldlM (\x v -> mappend x <$> f v) mempty (IntSet.toList x)
+               xs -> foldlM (\x set' -> mappend x <$> go set') mempty xs

From 04443d087469ebea64c9da2ed3ac4e0da05bd8a7 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Sun, 7 Jul 2019 22:51:19 +0900
Subject: [PATCH 046/148] ABC133-A, B, C, D, E

---
 README.md        | 13 +++++++
 abc133-a/Main.hs |  8 ++++
 abc133-b/Main.hs | 17 +++++++++
 abc133-c/Main.hs | 10 +++++
 abc133-d/Main.hs | 16 ++++++++
 abc133-e/Main.hs | 97 ++++++++++++++++++++++++++++++++++++++++++++++++
 6 files changed, 161 insertions(+)
 create mode 100644 abc133-a/Main.hs
 create mode 100644 abc133-b/Main.hs
 create mode 100644 abc133-c/Main.hs
 create mode 100644 abc133-d/Main.hs
 create mode 100644 abc133-e/Main.hs

diff --git a/README.md b/README.md
index a9fcf94..c0cd36f 100644
--- a/README.md
+++ b/README.md
@@ -412,3 +412,16 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 * [x] D - Blue and Red Balls
 * [x] E - Hopscotch Addict
 * [ ] F - Small Products
+
+## AtCoder Beginner Contest 133 (2019-07-07)
+
+<https://atcoder.jp/contests/abc133>
+
+解いた問題：
+
+* [x] A - T or T
+* [x] B - Good Distance
+* [x] C - Remainder Minimization 2019
+* [x] D - Rain Flows into Dams
+* [x] E - Virus Tree 2
+* [ ] F - Colorful Tree
diff --git a/abc133-a/Main.hs b/abc133-a/Main.hs
new file mode 100644
index 0000000..d024a2f
--- /dev/null
+++ b/abc133-a/Main.hs
@@ -0,0 +1,8 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  [n,a,b] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  print $ min b (a * n)
diff --git a/abc133-b/Main.hs b/abc133-b/Main.hs
new file mode 100644
index 0000000..7e5b8e0
--- /dev/null
+++ b/abc133-b/Main.hs
@@ -0,0 +1,17 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Char (isSpace)
+import Data.List (unfoldr, tails)
+import Control.Monad
+import qualified Data.Vector.Unboxed as U
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  [n,d] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  points <- replicateM n $ do
+    U.unfoldrN d (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  print $ sum [ 1
+              | x:ys <- tails points
+              , y <- ys
+              , let distance = U.sum $ U.map (^2) (U.zipWith (-) x y)
+              , distance == (floor $ sqrt $ fromIntegral distance)^2
+              ]
diff --git a/abc133-c/Main.hs b/abc133-c/Main.hs
new file mode 100644
index 0000000..81a79cc
--- /dev/null
+++ b/abc133-c/Main.hs
@@ -0,0 +1,10 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  [l,r] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  print $ if r - l >= 2018
+          then 0
+          else minimum [ (i * j) `mod` 2019 | i <- [l..r-1], j <- [i+1..r] ]
diff --git a/abc133-d/Main.hs b/abc133-d/Main.hs
new file mode 100644
index 0000000..309426a
--- /dev/null
+++ b/abc133-d/Main.hs
@@ -0,0 +1,16 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Char (isSpace)
+import Data.Int (Int64)
+import Data.Bifunctor (first)
+import qualified Data.Vector.Unboxed as U
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  n <- readLn
+  as <- U.unfoldrN n (readInt64 . BS.dropWhile isSpace) <$> BS.getLine
+  let x0 = (U.sum as - 2 * sum [as U.! i | i <- [1,3..n-1]]) `quot` 2
+  let xs = U.scanl' subtract x0 as
+  putStrLn $ unwords $ map show $ U.toList $ U.map (* 2) $ U.init xs
+
+readInt64 :: BS.ByteString -> Maybe (Int64, BS.ByteString)
+readInt64 s = first fromIntegral <$> BS.readInt s
diff --git a/abc133-e/Main.hs b/abc133-e/Main.hs
new file mode 100644
index 0000000..0fe13c1
--- /dev/null
+++ b/abc133-e/Main.hs
@@ -0,0 +1,97 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+import Data.Char (isSpace)
+import Data.Int (Int64)
+import Data.List (unfoldr)
+import Control.Monad
+import Data.Coerce
+import qualified Data.Vector as V
+import qualified Data.Vector.Mutable as VM
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+---
+import qualified Data.Vector.Generic
+import qualified Data.Vector.Generic.Mutable
+
+main = do
+  [n,k] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  edges <- U.replicateM (n-1) $ do
+    [a,b] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+    return (a-1,b-1)
+  let edges' :: V.Vector [Int]
+      edges' = V.create $ do
+        vec <- VM.replicate n []
+        U.forM_ edges $ \(i,j) -> do
+          VM.modify vec (j :) i
+          VM.modify vec (i :) j
+        return vec
+  let result :: U.Vector N
+      result = U.create $ do
+        vec <- UM.replicate n 0
+        let go !i0 !i !s !d = do
+              UM.write vec i (fromIntegral (k - s))
+              forM_ (zip [d..] $ filter (/= i0) $ edges' V.! i) $ \(t,j) -> do
+                go i j t (min 2 (d + 1))
+        go (-1) 0 0 1
+        return vec
+  print $ U.product result
+
+---
+
+modulo :: Int64
+modulo = 10^9+7
+addMod, subMod, mulMod :: Int64 -> Int64 -> Int64
+addMod !x !y | x + y >= modulo = x + y - modulo
+             | otherwise = x + y
+subMod !x !y | x >= y = x - y
+             | otherwise = x - y + modulo
+mulMod !x !y = (x * y) `rem` modulo
+
+newtype N = N { unwrapN :: Int64 } deriving (Eq)
+instance Show N where
+  show (N x) = show x
+instance Num N where
+  (+) = coerce addMod
+  (-) = coerce subMod
+  (*) = coerce mulMod
+  fromInteger n = N (fromInteger (n `mod` fromIntegral modulo))
+  abs = undefined; signum = undefined
+
+{-# RULES
+"^9/Int" forall x. x ^ (9 :: Int) = let u = x; v = u * u * u in v * v * v
+"^9/Integer" forall x. x ^ (9 :: Integer) = let u = x; v = u * u * u in v * v * v
+ #-}
+
+---
+
+newtype instance UM.MVector s N = MV_N (UM.MVector s Int64)
+newtype instance U.Vector N = V_N (U.Vector Int64)
+
+instance Data.Vector.Generic.Mutable.MVector UM.MVector N where -- needs MultiParamTypeClasses here
+  basicLength (MV_N mv) = Data.Vector.Generic.Mutable.basicLength mv
+  basicUnsafeSlice i l (MV_N mv) = MV_N (Data.Vector.Generic.Mutable.basicUnsafeSlice i l mv)
+  basicOverlaps (MV_N mv) (MV_N mv') = Data.Vector.Generic.Mutable.basicOverlaps mv mv'
+  basicUnsafeNew l = MV_N <$> Data.Vector.Generic.Mutable.basicUnsafeNew l
+  basicInitialize (MV_N mv) = Data.Vector.Generic.Mutable.basicInitialize mv
+  basicUnsafeReplicate i x = MV_N <$> Data.Vector.Generic.Mutable.basicUnsafeReplicate i (coerce x)
+  basicUnsafeRead (MV_N mv) i = coerce <$> Data.Vector.Generic.Mutable.basicUnsafeRead mv i
+  basicUnsafeWrite (MV_N mv) i x = Data.Vector.Generic.Mutable.basicUnsafeWrite mv i (coerce x)
+  basicClear (MV_N mv) = Data.Vector.Generic.Mutable.basicClear mv
+  basicSet (MV_N mv) x = Data.Vector.Generic.Mutable.basicSet mv (coerce x)
+  basicUnsafeCopy (MV_N mv) (MV_N mv') = Data.Vector.Generic.Mutable.basicUnsafeCopy mv mv'
+  basicUnsafeMove (MV_N mv) (MV_N mv') = Data.Vector.Generic.Mutable.basicUnsafeMove mv mv'
+  basicUnsafeGrow (MV_N mv) n = MV_N <$> Data.Vector.Generic.Mutable.basicUnsafeGrow mv n
+
+instance Data.Vector.Generic.Vector U.Vector N where -- needs MultiParamTypeClasses here
+  basicUnsafeFreeze (MV_N mv) = V_N <$> Data.Vector.Generic.basicUnsafeFreeze mv
+  basicUnsafeThaw (V_N v) = MV_N <$> Data.Vector.Generic.basicUnsafeThaw v
+  basicLength (V_N v) = Data.Vector.Generic.basicLength v
+  basicUnsafeSlice i l (V_N v) = V_N (Data.Vector.Generic.basicUnsafeSlice i l v)
+  basicUnsafeIndexM (V_N v) i = coerce <$> Data.Vector.Generic.basicUnsafeIndexM v i
+  basicUnsafeCopy (MV_N mv) (V_N v) = Data.Vector.Generic.basicUnsafeCopy mv v
+  elemseq (V_N v) x y = Data.Vector.Generic.elemseq v (coerce x) y
+
+instance U.Unbox N

From 7953f1e0f164254d9203840c5367073644d547e6 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Sun, 7 Jul 2019 22:51:33 +0900
Subject: [PATCH 047/148] ABC133-F: Slow solution

---
 abc133-f/Main.hs | 85 ++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 85 insertions(+)
 create mode 100644 abc133-f/Main.hs

diff --git a/abc133-f/Main.hs b/abc133-f/Main.hs
new file mode 100644
index 0000000..d1b5d4c
--- /dev/null
+++ b/abc133-f/Main.hs
@@ -0,0 +1,85 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import Control.Monad
+import Control.Monad.ST
+import qualified Data.Vector as V
+import qualified Data.Vector.Mutable as VM
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.IntMap.Strict as IntMap
+
+main = do
+  [n,q] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  edges <- U.replicateM (n-1) $ do
+    [a,b,c,d] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+    return (a-1,b-1,c,d)
+  let edges' :: V.Vector [(Int,Int,Int)]
+      edges' = V.create $ do
+        vec <- VM.replicate n []
+        U.forM_ edges $ \(i,j,c,d) -> do
+          VM.modify vec ((j,c,d) :) i
+          VM.modify vec ((i,c,d) :) j
+        return vec
+  let depthMap :: U.Vector Int
+      parentMap :: U.Vector (Int,Int,Int)
+      (depthMap, parentMap) = runST $ do
+        depthVec <- UM.new n
+        toParent <- UM.new n
+        let go !i0 !i !d !col !dist = do
+              UM.write depthVec i d
+              UM.write toParent i (i0,col,dist)
+              forM_ (edges' V.! i) $ \(j,col,dist) -> do
+                when (j /= i0) $ do
+                  go i j (d+1) col dist
+        go (-1) 0 0 (-1) 0
+        liftM2 (,) (U.unsafeFreeze depthVec) (U.unsafeFreeze toParent)
+        {-
+      commonRoot :: Int -> Int -> Int
+      commonRoot u v | u == v = u
+                     | otherwise =
+        let ud = depthMap U.! u
+            vd = depthMap U.! v
+            fst3 (a,_,_) = a
+        in case compare ud vd of
+             LT -> commonRoot u (fst3 $ parentMap U.! v)
+             EQ -> commonRoot (fst3 $ parentMap U.! u) (fst3 $ parentMap U.! v)
+             GT -> commonRoot (fst3 $ parentMap U.! u) v
+      distanceFromRoot :: U.Vector Int
+      colorsOnPath :: V.Vector (IntMap.IntMap Int)
+      (distanceFromRoot, colorsOnPath) = runST $ do
+        dist <- UM.new n
+        col <- VM.new n
+        let go !i0 !i !d !c = do
+              UM.write dist i d
+              VM.write col i c
+              forM_ (edges' V.! i) $ \(j,c',d') -> do
+                when (j /= i0) $ do
+                  go i j (d+d') (IntMap.insertWith (+) c' 1 c)
+        go (-1) 0 0 IntMap.empty
+        liftM2 (,) (U.unsafeFreeze dist) (V.unsafeFreeze col)
+-}
+  forM_ [0..q-1] $ \_ -> do
+    [x,y,up1,vp1] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+    let u = up1 - 1
+        v = vp1 - 1
+        modifiedDistance :: Int -> Int -> Int
+        modifiedDistance !color !originalDistance | color == x = y
+                                                  | otherwise = originalDistance
+    let go :: Int -> Int -> Int -> Int
+        go !i !j !acc
+          | i == j = acc
+          | otherwise =
+              let di = depthMap U.! i
+                  dj = depthMap U.! j
+              in case compare di dj of
+                   LT -> let (j',cj,dj) = parentMap U.! j
+                         in go i j' (acc + modifiedDistance cj dj)
+                   EQ -> let (i',ci,di) = parentMap U.! i
+                             (j',cj,dj) = parentMap U.! j
+                         in go i' j' (acc + modifiedDistance ci di + modifiedDistance cj dj)
+                   GT -> let (i',ci,di) = parentMap U.! i
+                         in go i' j (acc + modifiedDistance ci di)
+    print (go u v 0)

From ef8508f1550ae02c21cd40e471b439dfcfaebe3b Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Mon, 8 Jul 2019 15:26:07 +0900
Subject: [PATCH 048/148] ABC133-F

---
 README.md            |  2 +-
 abc133-f/Main.hs     | 93 +++++++++++++++++++-------------------------
 abc133-f/Slow.hs     | 59 ++++++++++++++++++++++++++++
 abc133-f/mkinput.lua | 35 +++++++++++++++++
 4 files changed, 134 insertions(+), 55 deletions(-)
 create mode 100644 abc133-f/Slow.hs
 create mode 100644 abc133-f/mkinput.lua

diff --git a/README.md b/README.md
index c0cd36f..2abdb25 100644
--- a/README.md
+++ b/README.md
@@ -424,4 +424,4 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 * [x] C - Remainder Minimization 2019
 * [x] D - Rain Flows into Dams
 * [x] E - Virus Tree 2
-* [ ] F - Colorful Tree
+* [x] F - Colorful Tree
diff --git a/abc133-f/Main.hs b/abc133-f/Main.hs
index d1b5d4c..7bed8f1 100644
--- a/abc133-f/Main.hs
+++ b/abc133-f/Main.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE BangPatterns #-}
 import Data.Char (isSpace)
 import Data.List (unfoldr)
+import Data.Monoid
 import Control.Monad
 import Control.Monad.ST
 import qualified Data.Vector as V
@@ -10,6 +11,12 @@ import qualified Data.Vector.Unboxed as U
 import qualified Data.Vector.Unboxed.Mutable as UM
 import qualified Data.ByteString.Char8 as BS
 import qualified Data.IntMap.Strict as IntMap
+import qualified Data.Sequence as Seq
+
+strictAppend :: (Monoid a, Monoid b) => (a, b) -> (a, b) -> (a, b)
+strictAppend (x, y) (x', y') = let !xx = x <> x'
+                                   !yy = y <> y'
+                               in (xx, yy)
 
 main = do
   [n,q] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
@@ -23,63 +30,41 @@ main = do
           VM.modify vec ((j,c,d) :) i
           VM.modify vec ((i,c,d) :) j
         return vec
-  let depthMap :: U.Vector Int
-      parentMap :: U.Vector (Int,Int,Int)
-      (depthMap, parentMap) = runST $ do
-        depthVec <- UM.new n
-        toParent <- UM.new n
-        let go !i0 !i !d !col !dist = do
-              UM.write depthVec i d
-              UM.write toParent i (i0,col,dist)
+  let routes :: V.Vector (Seq.Seq Int)
+      distances :: U.Vector Int
+      distancesMap :: V.Vector (IntMap.IntMap (Sum Int, Sum Int))
+      (routes, distances, distancesMap) = runST $ do
+        routes <- VM.new n
+        distances <- UM.new n
+        distancesMap <- VM.new n
+        let go !i0 !i route !dt dtm = do
+              VM.write routes i route
+              UM.write distances i dt
+              VM.write distancesMap i dtm
               forM_ (edges' V.! i) $ \(j,col,dist) -> do
                 when (j /= i0) $ do
-                  go i j (d+1) col dist
-        go (-1) 0 0 (-1) 0
-        liftM2 (,) (U.unsafeFreeze depthVec) (U.unsafeFreeze toParent)
-        {-
-      commonRoot :: Int -> Int -> Int
-      commonRoot u v | u == v = u
-                     | otherwise =
-        let ud = depthMap U.! u
-            vd = depthMap U.! v
-            fst3 (a,_,_) = a
-        in case compare ud vd of
-             LT -> commonRoot u (fst3 $ parentMap U.! v)
-             EQ -> commonRoot (fst3 $ parentMap U.! u) (fst3 $ parentMap U.! v)
-             GT -> commonRoot (fst3 $ parentMap U.! u) v
-      distanceFromRoot :: U.Vector Int
-      colorsOnPath :: V.Vector (IntMap.IntMap Int)
-      (distanceFromRoot, colorsOnPath) = runST $ do
-        dist <- UM.new n
-        col <- VM.new n
-        let go !i0 !i !d !c = do
-              UM.write dist i d
-              VM.write col i c
-              forM_ (edges' V.! i) $ \(j,c',d') -> do
-                when (j /= i0) $ do
-                  go i j (d+d') (IntMap.insertWith (+) c' 1 c)
-        go (-1) 0 0 IntMap.empty
-        liftM2 (,) (U.unsafeFreeze dist) (V.unsafeFreeze col)
--}
+                  go i j (route Seq.|> j) (dt + dist) (IntMap.insertWith strictAppend col (Sum 1, Sum dist) dtm)
+        go (-1) 0 (Seq.singleton 0) 0 IntMap.empty
+        liftM3 (,,) (V.unsafeFreeze routes) (U.unsafeFreeze distances) (V.unsafeFreeze distancesMap)
+      lowestCommonAncestor :: Int -> Int -> Int
+      lowestCommonAncestor !i !j =
+        let ri = routes V.! i
+            rj = routes V.! j
+            search !l !u | l + 1 == u = ri `Seq.index` l
+            search !l !u = let d = (l + u) `quot` 2 -- l < d < u
+                               pi = ri `Seq.index` d
+                               pj = rj `Seq.index` d
+                           in if pi == pj
+                              then search d u
+                              else search l d
+        in search 0 (min (Seq.length ri) (Seq.length rj))
   forM_ [0..q-1] $ \_ -> do
     [x,y,up1,vp1] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
     let u = up1 - 1
         v = vp1 - 1
-        modifiedDistance :: Int -> Int -> Int
-        modifiedDistance !color !originalDistance | color == x = y
-                                                  | otherwise = originalDistance
-    let go :: Int -> Int -> Int -> Int
-        go !i !j !acc
-          | i == j = acc
-          | otherwise =
-              let di = depthMap U.! i
-                  dj = depthMap U.! j
-              in case compare di dj of
-                   LT -> let (j',cj,dj) = parentMap U.! j
-                         in go i j' (acc + modifiedDistance cj dj)
-                   EQ -> let (i',ci,di) = parentMap U.! i
-                             (j',cj,dj) = parentMap U.! j
-                         in go i' j' (acc + modifiedDistance ci di + modifiedDistance cj dj)
-                   GT -> let (i',ci,di) = parentMap U.! i
-                         in go i' j (acc + modifiedDistance ci di)
-    print (go u v 0)
+        w = lowestCommonAncestor u v
+        modifiedDistanceFromRoot :: Int -> Int
+        modifiedDistanceFromRoot !i = distances U.! i + case IntMap.lookup x (distancesMap V.! i) of
+                                                          Just (Sum n, Sum origDist) -> y * n - origDist
+                                                          Nothing -> 0
+    print $ modifiedDistanceFromRoot u + modifiedDistanceFromRoot v - 2 * modifiedDistanceFromRoot w
diff --git a/abc133-f/Slow.hs b/abc133-f/Slow.hs
new file mode 100644
index 0000000..25a1272
--- /dev/null
+++ b/abc133-f/Slow.hs
@@ -0,0 +1,59 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import Control.Monad
+import Control.Monad.ST
+import qualified Data.Vector as V
+import qualified Data.Vector.Mutable as VM
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  [n,q] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  edges <- U.replicateM (n-1) $ do
+    [a,b,c,d] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+    return (a-1,b-1,c,d)
+  let edges' :: V.Vector [(Int,Int,Int)]
+      edges' = V.create $ do
+        vec <- VM.replicate n []
+        U.forM_ edges $ \(i,j,c,d) -> do
+          VM.modify vec ((j,c,d) :) i
+          VM.modify vec ((i,c,d) :) j
+        return vec
+  let depthMap :: U.Vector Int
+      parentMap :: U.Vector (Int,Int,Int)
+      (depthMap, parentMap) = runST $ do
+        depthVec <- UM.new n
+        parentMap <- UM.new n
+        let go !i0 !i !d !color !dist = do
+              UM.write depthVec i d
+              UM.write parentMap i (i0,color,dist)
+              forM_ (edges' V.! i) $ \(j,color,dist) -> do
+                when (j /= i0) $ do
+                  go i j (d+1) color dist
+        go (-1) 0 0 (-1) 0
+        liftM2 (,) (U.unsafeFreeze depthVec) (U.unsafeFreeze parentMap)
+  forM_ [0..q-1] $ \_ -> do
+    [x,y,up1,vp1] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+    let u = up1 - 1
+        v = vp1 - 1
+        modifiedDistance :: Int -> Int -> Int
+        modifiedDistance !color !originalDistance | color == x = y
+                                                  | otherwise = originalDistance
+    let go :: Int -> Int -> Int -> Int
+        go !i !j !acc
+          | i == j = acc
+          | otherwise =
+              let di = depthMap U.! i
+                  dj = depthMap U.! j
+              in case compare di dj of
+                   LT -> let (j',cj,dj) = parentMap U.! j
+                         in go i j' (acc + modifiedDistance cj dj)
+                   EQ -> let (i',ci,di) = parentMap U.! i
+                             (j',cj,dj) = parentMap U.! j
+                         in go i' j' (acc + modifiedDistance ci di + modifiedDistance cj dj)
+                   GT -> let (i',ci,di) = parentMap U.! i
+                         in go i' j (acc + modifiedDistance ci di)
+    print (go u v 0)
diff --git a/abc133-f/mkinput.lua b/abc133-f/mkinput.lua
new file mode 100644
index 0000000..397c027
--- /dev/null
+++ b/abc133-f/mkinput.lua
@@ -0,0 +1,35 @@
+io.output("input1.txt")
+do
+  local n = 10
+  local q = 5
+  io.write(string.format("%d %d\n", n, q))
+  for i = 1, n-1 do
+    io.write(string.format("%d %d %d %d\n", i, i+1, math.random(1, 5), math.random(10, 100)))
+  end
+  for i = 1, q do
+    local u = math.random(1, n-1)
+    local v = math.random(u+1, n)
+    io.write(string.format("%d %d %d %d\n", math.random(1, 5), math.random(10, 100), u, v))
+  end
+end
+
+io.output("input2.txt")
+do
+  local left = 5
+  local right = 5
+  local n = left + right - 1
+  local q = 5
+  io.write(string.format("%d %d\n", n, q))
+  for i = 1, left-1 do
+    io.write(string.format("%d %d %d %d\n", i, i+1, math.random(1, 5), math.random(10, 100)))
+  end
+  for i = 1, right-1 do
+    local a = i == 1 and i or i + left - 1
+    io.write(string.format("%d %d %d %d\n", a, i + left, math.random(1, 5), math.random(10, 100)))
+  end
+  for i = 1, q do
+    local u = math.random(1, n-1)
+    local v = math.random(u+1, n)
+    io.write(string.format("%d %d %d %d\n", math.random(1, 5), math.random(10, 100), u, v))
+  end
+end

From c2d087e6ffc0a063c2c4357068244cb6419499e5 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Mon, 8 Jul 2019 17:48:36 +0900
Subject: [PATCH 049/148] Add library for Binary Indexed Tree

---
 lib/BinaryIndexedTree.hs |  76 ++++++++++++++++++++++++++
 lib/MonoidEx.hs          | 112 +++++++++++++++++++++++++++++++++++++++
 2 files changed, 188 insertions(+)
 create mode 100644 lib/BinaryIndexedTree.hs
 create mode 100644 lib/MonoidEx.hs

diff --git a/lib/BinaryIndexedTree.hs b/lib/BinaryIndexedTree.hs
new file mode 100644
index 0000000..9608de1
--- /dev/null
+++ b/lib/BinaryIndexedTree.hs
@@ -0,0 +1,76 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE ConstraintKinds #-}
+module BinaryIndexedTree where
+import Data.Monoid
+import Data.Bits
+import qualified Data.Vector.Generic as G
+import qualified Data.Vector.Generic.Mutable as GM
+import Control.Monad.Primitive
+-- For testing:
+import qualified Data.Vector as V
+import qualified Data.Vector.Mutable as VM
+import qualified Data.Vector.Unboxed.Mutable as UM
+
+--
+-- Binary Indexed Tree (BIT)
+--
+
+type CommutativeMonoid a = Monoid a
+
+newtype BIT mvec s a = BIT (mvec s a)
+
+-- index: 1-based
+-- property: forall vec i. fromVector_BIT vec >>= flip queryM_BIT i == pure (G.scanl (<>) mempty vec G.! i)
+queryM_BIT :: (Monoid a, GM.MVector mvec a, PrimMonad m) => BIT mvec (PrimState m) a -> Int -> m a
+queryM_BIT (BIT vec) !i = doQuery i mempty
+  where
+    doQuery 0 !acc = return acc
+    doQuery i !acc = do y <- GM.read vec (i - 1)
+                        let !j = (i - 1) .&. i
+                        doQuery j (y <> acc)
+
+-- index: zero-based
+-- property: forall vec i x. do { tree <- fromVector_BIT vec; add_BIT tree i x; return tree } == fromVector_BIT (G.accum (<>) vec [(i,x)])
+add_BIT :: (CommutativeMonoid a, GM.MVector mvec a, PrimMonad m) => BIT mvec (PrimState m) a -> Int -> a -> m ()
+add_BIT (BIT vec) !i !y = loop (i + 1)
+  where
+    loop !k | k > GM.length vec = return ()
+    loop !k = do x <- GM.read vec (k - 1)
+                 GM.write vec (k - 1) $! x <> y
+                 loop (k + (k .&. (-k)))
+
+new_BIT :: (Monoid a, GM.MVector mvec a, PrimMonad m) => Int -> m (BIT mvec (PrimState m) a)
+new_BIT n = BIT <$> GM.replicate n mempty
+
+asBoxedBIT :: (PrimMonad m) => m (BIT VM.MVector (PrimState m) a) -> m (BIT VM.MVector (PrimState m) a)
+asBoxedBIT = id
+
+asUnboxedBIT :: (PrimMonad m) => m (BIT UM.MVector (PrimState m) a) -> m (BIT UM.MVector (PrimState m) a)
+asUnboxedBIT = id
+
+--
+-- Tests
+--
+
+fromVector_BIT :: (CommutativeMonoid a, PrimMonad m, G.Vector vec a) => vec a -> m (BIT (G.Mutable vec) (PrimState m) a)
+fromVector_BIT vec = do
+  mvec <- GM.replicate (G.length vec) mempty
+  G.imapM_ (add_BIT (BIT mvec)) vec
+  return (BIT mvec)
+
+toVector_BIT :: (Monoid a, PrimMonad m, G.Vector vec a) => BIT (G.Mutable vec) (PrimState m) a -> m (vec a)
+toVector_BIT tree@(BIT mvec) = G.generateM (GM.length mvec + 1) (queryM_BIT tree)
+
+test :: (Eq a, Monoid a, G.Vector vec a) => vec a -> IO Bool
+test vec = do
+  tree <- fromVector_BIT vec
+  acc <- toVector_BIT tree
+  return (acc `G.eq` G.scanl (<>) mempty vec)
+
+test1 :: IO Bool
+test1 = test (V.fromList [Sum 1, Sum 4, Sum (-1), Sum 5, Sum 7, Sum 0, Sum (-2)])
+
+{-
+test2 :: IO Bool
+test2 = test (V.fromList ["H", "e", "ll", "o", "w", "o", "rl", "d", "!"])
+-}
diff --git a/lib/MonoidEx.hs b/lib/MonoidEx.hs
new file mode 100644
index 0000000..e1104df
--- /dev/null
+++ b/lib/MonoidEx.hs
@@ -0,0 +1,112 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleContexts #-}
+module MonoidEx where
+import Data.Monoid
+import Data.Coerce
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.Vector.Generic
+import qualified Data.Vector.Generic.Mutable
+#ifdef MIN_VERSION_base
+#if MIN_VERSION_base(4,9,0)
+import Data.Semigroup hiding ((<>),Max(..),Min(..))
+#endif
+#endif
+
+--
+-- Max monoid (from Data.Semigroup)
+--
+
+newtype Max a = Max { getMax :: a }
+#ifdef MIN_VERSION_base
+#if MIN_VERSION_base(4,9,0)
+instance (Ord a) => Semigroup (Max a) where
+  Max x <> Max y = Max (x `max` y)
+#endif
+#endif
+instance (Bounded a, Ord a) => Monoid (Max a) where
+  mempty = Max minBound
+  Max x `mappend` Max y = Max (x `max` y)
+
+--
+-- Min monoid (from Data.Semigroup)
+--
+
+newtype Min a = Min { getMin :: a }
+#ifdef MIN_VERSION_base
+#if MIN_VERSION_base(4,9,0)
+instance (Ord a) => Semigroup (Min a) where
+  Min x <> Min y = Min (x `min` y)
+#endif
+#endif
+instance (Bounded a, Ord a) => Monoid (Min a) where
+  mempty = Min maxBound
+  Min x `mappend` Min y = Min (x `min` y)
+
+--
+-- instance U.Unbox (Max a)
+--
+
+newtype instance UM.MVector s (Max a) = MV_Max (UM.MVector s a)
+newtype instance U.Vector (Max a) = V_Max (U.Vector a)
+
+instance Data.Vector.Generic.Mutable.MVector UM.MVector a => Data.Vector.Generic.Mutable.MVector UM.MVector (Max a) where
+  basicLength (MV_Max mv) = Data.Vector.Generic.Mutable.basicLength mv
+  basicUnsafeSlice i l (MV_Max mv) = MV_Max (Data.Vector.Generic.Mutable.basicUnsafeSlice i l mv)
+  basicOverlaps (MV_Max mv) (MV_Max mv') = Data.Vector.Generic.Mutable.basicOverlaps mv mv'
+  basicUnsafeNew l = MV_Max <$> Data.Vector.Generic.Mutable.basicUnsafeNew l
+  basicInitialize (MV_Max mv) = Data.Vector.Generic.Mutable.basicInitialize mv
+  basicUnsafeReplicate i x = MV_Max <$> Data.Vector.Generic.Mutable.basicUnsafeReplicate i (coerce x)
+  basicUnsafeRead (MV_Max mv) i = coerce <$> Data.Vector.Generic.Mutable.basicUnsafeRead mv i
+  basicUnsafeWrite (MV_Max mv) i x = Data.Vector.Generic.Mutable.basicUnsafeWrite mv i (coerce x)
+  basicClear (MV_Max mv) = Data.Vector.Generic.Mutable.basicClear mv
+  basicSet (MV_Max mv) x = Data.Vector.Generic.Mutable.basicSet mv (coerce x)
+  basicUnsafeCopy (MV_Max mv) (MV_Max mv') = Data.Vector.Generic.Mutable.basicUnsafeCopy mv mv'
+  basicUnsafeMove (MV_Max mv) (MV_Max mv') = Data.Vector.Generic.Mutable.basicUnsafeMove mv mv'
+  basicUnsafeGrow (MV_Max mv) n = MV_Max <$> Data.Vector.Generic.Mutable.basicUnsafeGrow mv n
+
+instance Data.Vector.Generic.Vector U.Vector a => Data.Vector.Generic.Vector U.Vector (Max a) where
+  basicUnsafeFreeze (MV_Max mv) = V_Max <$> Data.Vector.Generic.basicUnsafeFreeze mv
+  basicUnsafeThaw (V_Max v) = MV_Max <$> Data.Vector.Generic.basicUnsafeThaw v
+  basicLength (V_Max v) = Data.Vector.Generic.basicLength v
+  basicUnsafeSlice i l (V_Max v) = V_Max (Data.Vector.Generic.basicUnsafeSlice i l v)
+  basicUnsafeIndexM (V_Max v) i = coerce <$> Data.Vector.Generic.basicUnsafeIndexM v i
+  basicUnsafeCopy (MV_Max mv) (V_Max v) = Data.Vector.Generic.basicUnsafeCopy mv v
+  elemseq (V_Max v) x y = Data.Vector.Generic.elemseq v (coerce x) y
+
+instance U.Unbox a => U.Unbox (Max a)
+
+--
+-- instance U.Unbox (Min a)
+--
+
+newtype instance UM.MVector s (Min a) = MV_Min (UM.MVector s a)
+newtype instance U.Vector (Min a) = V_Min (U.Vector a)
+
+instance Data.Vector.Generic.Mutable.MVector UM.MVector a => Data.Vector.Generic.Mutable.MVector UM.MVector (Min a) where
+  basicLength (MV_Min mv) = Data.Vector.Generic.Mutable.basicLength mv
+  basicUnsafeSlice i l (MV_Min mv) = MV_Min (Data.Vector.Generic.Mutable.basicUnsafeSlice i l mv)
+  basicOverlaps (MV_Min mv) (MV_Min mv') = Data.Vector.Generic.Mutable.basicOverlaps mv mv'
+  basicUnsafeNew l = MV_Min <$> Data.Vector.Generic.Mutable.basicUnsafeNew l
+  basicInitialize (MV_Min mv) = Data.Vector.Generic.Mutable.basicInitialize mv
+  basicUnsafeReplicate i x = MV_Min <$> Data.Vector.Generic.Mutable.basicUnsafeReplicate i (coerce x)
+  basicUnsafeRead (MV_Min mv) i = coerce <$> Data.Vector.Generic.Mutable.basicUnsafeRead mv i
+  basicUnsafeWrite (MV_Min mv) i x = Data.Vector.Generic.Mutable.basicUnsafeWrite mv i (coerce x)
+  basicClear (MV_Min mv) = Data.Vector.Generic.Mutable.basicClear mv
+  basicSet (MV_Min mv) x = Data.Vector.Generic.Mutable.basicSet mv (coerce x)
+  basicUnsafeCopy (MV_Min mv) (MV_Min mv') = Data.Vector.Generic.Mutable.basicUnsafeCopy mv mv'
+  basicUnsafeMove (MV_Min mv) (MV_Min mv') = Data.Vector.Generic.Mutable.basicUnsafeMove mv mv'
+  basicUnsafeGrow (MV_Min mv) n = MV_Min <$> Data.Vector.Generic.Mutable.basicUnsafeGrow mv n
+
+instance Data.Vector.Generic.Vector U.Vector a => Data.Vector.Generic.Vector U.Vector (Min a) where
+  basicUnsafeFreeze (MV_Min mv) = V_Min <$> Data.Vector.Generic.basicUnsafeFreeze mv
+  basicUnsafeThaw (V_Min v) = MV_Min <$> Data.Vector.Generic.basicUnsafeThaw v
+  basicLength (V_Min v) = Data.Vector.Generic.basicLength v
+  basicUnsafeSlice i l (V_Min v) = V_Min (Data.Vector.Generic.basicUnsafeSlice i l v)
+  basicUnsafeIndexM (V_Min v) i = coerce <$> Data.Vector.Generic.basicUnsafeIndexM v i
+  basicUnsafeCopy (MV_Min mv) (V_Min v) = Data.Vector.Generic.basicUnsafeCopy mv v
+  elemseq (V_Min v) x y = Data.Vector.Generic.elemseq v (coerce x) y
+
+instance U.Unbox a => U.Unbox (Min a)

From c0314ea5d9541d9985453d5040bf3c9a83f0b684 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Mon, 8 Jul 2019 17:49:02 +0900
Subject: [PATCH 050/148] DP-Q: Use Binary Indexed Tree

---
 dp-q/BIT.hs | 126 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 126 insertions(+)
 create mode 100644 dp-q/BIT.hs

diff --git a/dp-q/BIT.hs b/dp-q/BIT.hs
new file mode 100644
index 0000000..a8f8bde
--- /dev/null
+++ b/dp-q/BIT.hs
@@ -0,0 +1,126 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleContexts #-}
+import Data.Char (isSpace)
+import Data.Int (Int64)
+import Data.List (unfoldr)
+import Data.Bifunctor (first)
+import Control.Monad
+import Control.Monad.ST
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+import Data.Bits
+import Data.Coerce
+import qualified Data.Vector.Generic as G
+import qualified Data.Vector.Generic.Mutable as GM
+import Control.Monad.Primitive
+import Data.Monoid
+#ifdef MIN_VERSION_base
+#if MIN_VERSION_base(4,9,0)
+import Data.Semigroup hiding ((<>),Max(..),Min(..))
+#endif
+#endif
+
+main = do
+  n <- readLn
+  hs <- U.unfoldrN n (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  as <- U.unfoldrN n (readInt64 . BS.dropWhile isSpace) <$> BS.getLine
+  let result = runST $ do
+        tree <- asUnboxedBIT $ new_BIT n
+        add_BIT tree 0 (Max 0)
+        forM_ [0..n-1] $ \i -> do
+          let h = hs U.! i
+          Max x <- queryM_BIT tree h
+          add_BIT tree (h - 1) (Max (x + as U.! i))
+        getMax <$> queryM_BIT tree n
+  print result
+
+readInt64 :: BS.ByteString -> Maybe (Int64, BS.ByteString)
+readInt64 s = first fromIntegral <$> BS.readInt s
+
+--
+-- Binary Indexed Tree (BIT)
+--
+
+type CommutativeMonoid a = Monoid a
+
+newtype BIT mvec s a = BIT (mvec s a)
+
+-- index: 1-based
+-- property: forall vec i. fromVector_BIT vec >>= flip queryM_BIT i == pure (G.scanl (<>) mempty vec G.! i)
+queryM_BIT :: (Monoid a, GM.MVector mvec a, PrimMonad m) => BIT mvec (PrimState m) a -> Int -> m a
+queryM_BIT (BIT vec) !i = doQuery i mempty
+  where
+    doQuery 0 !acc = return acc
+    doQuery i !acc = do y <- GM.read vec (i - 1)
+                        let !j = (i - 1) .&. i
+                        doQuery j (y <> acc)
+
+-- index: zero-based
+-- property: forall vec i x. do { tree <- fromVector_BIT vec; add_BIT tree i x; return tree } == fromVector_BIT (G.accum (<>) vec [(i,x)])
+add_BIT :: (CommutativeMonoid a, GM.MVector mvec a, PrimMonad m) => BIT mvec (PrimState m) a -> Int -> a -> m ()
+add_BIT (BIT vec) !i !y = loop (i + 1)
+  where
+    loop !k | k > GM.length vec = return ()
+    loop !k = do x <- GM.read vec (k - 1)
+                 GM.write vec (k - 1) $! x <> y
+                 loop (k + (k .&. (-k)))
+
+new_BIT :: (Monoid a, GM.MVector mvec a, PrimMonad m) => Int -> m (BIT mvec (PrimState m) a)
+new_BIT n = BIT <$> GM.replicate n mempty
+
+asUnboxedBIT :: (PrimMonad m) => m (BIT UM.MVector (PrimState m) a) -> m (BIT UM.MVector (PrimState m) a)
+asUnboxedBIT = id
+
+--
+-- Max monoid (from Data.Semigroup)
+--
+
+newtype Max a = Max { getMax :: a }
+#ifdef MIN_VERSION_base
+#if MIN_VERSION_base(4,9,0)
+instance (Ord a) => Semigroup (Max a) where
+  Max x <> Max y = Max (x `max` y)
+#endif
+#endif
+instance (Bounded a, Ord a) => Monoid (Max a) where
+  mempty = Max minBound
+  Max x `mappend` Max y = Max (x `max` y)
+
+--
+-- instance U.Unbox (Max a)
+--
+
+newtype instance UM.MVector s (Max a) = MV_Max (UM.MVector s a)
+newtype instance U.Vector (Max a) = V_Max (U.Vector a)
+
+instance GM.MVector UM.MVector a => GM.MVector UM.MVector (Max a) where
+  basicLength (MV_Max mv) = GM.basicLength mv
+  basicUnsafeSlice i l (MV_Max mv) = MV_Max (GM.basicUnsafeSlice i l mv)
+  basicOverlaps (MV_Max mv) (MV_Max mv') = GM.basicOverlaps mv mv'
+  basicUnsafeNew l = MV_Max <$> GM.basicUnsafeNew l
+  basicInitialize (MV_Max mv) = GM.basicInitialize mv
+  basicUnsafeReplicate i x = MV_Max <$> GM.basicUnsafeReplicate i (coerce x)
+  basicUnsafeRead (MV_Max mv) i = coerce <$> GM.basicUnsafeRead mv i
+  basicUnsafeWrite (MV_Max mv) i x = GM.basicUnsafeWrite mv i (coerce x)
+  basicClear (MV_Max mv) = GM.basicClear mv
+  basicSet (MV_Max mv) x = GM.basicSet mv (coerce x)
+  basicUnsafeCopy (MV_Max mv) (MV_Max mv') = GM.basicUnsafeCopy mv mv'
+  basicUnsafeMove (MV_Max mv) (MV_Max mv') = GM.basicUnsafeMove mv mv'
+  basicUnsafeGrow (MV_Max mv) n = MV_Max <$> GM.basicUnsafeGrow mv n
+
+instance G.Vector U.Vector a => G.Vector U.Vector (Max a) where
+  basicUnsafeFreeze (MV_Max mv) = V_Max <$> G.basicUnsafeFreeze mv
+  basicUnsafeThaw (V_Max v) = MV_Max <$> G.basicUnsafeThaw v
+  basicLength (V_Max v) = G.basicLength v
+  basicUnsafeSlice i l (V_Max v) = V_Max (G.basicUnsafeSlice i l v)
+  basicUnsafeIndexM (V_Max v) i = coerce <$> G.basicUnsafeIndexM v i
+  basicUnsafeCopy (MV_Max mv) (V_Max v) = G.basicUnsafeCopy mv v
+  elemseq (V_Max v) x y = G.elemseq v (coerce x) y
+
+instance U.Unbox a => U.Unbox (Max a)

From df3e4e901df31c0551f6ae692327d160c5f1905f Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Mon, 8 Jul 2019 18:15:51 +0900
Subject: [PATCH 051/148] BIT: Use INLINE pragma

---
 dp-q/BIT.hs              | 2 ++
 lib/BinaryIndexedTree.hs | 2 ++
 2 files changed, 4 insertions(+)

diff --git a/dp-q/BIT.hs b/dp-q/BIT.hs
index a8f8bde..bddb89f 100644
--- a/dp-q/BIT.hs
+++ b/dp-q/BIT.hs
@@ -60,6 +60,7 @@ queryM_BIT (BIT vec) !i = doQuery i mempty
     doQuery i !acc = do y <- GM.read vec (i - 1)
                         let !j = (i - 1) .&. i
                         doQuery j (y <> acc)
+{-# INLINE queryM_BIT #-}
 
 -- index: zero-based
 -- property: forall vec i x. do { tree <- fromVector_BIT vec; add_BIT tree i x; return tree } == fromVector_BIT (G.accum (<>) vec [(i,x)])
@@ -70,6 +71,7 @@ add_BIT (BIT vec) !i !y = loop (i + 1)
     loop !k = do x <- GM.read vec (k - 1)
                  GM.write vec (k - 1) $! x <> y
                  loop (k + (k .&. (-k)))
+{-# INLINE add_BIT #-}
 
 new_BIT :: (Monoid a, GM.MVector mvec a, PrimMonad m) => Int -> m (BIT mvec (PrimState m) a)
 new_BIT n = BIT <$> GM.replicate n mempty
diff --git a/lib/BinaryIndexedTree.hs b/lib/BinaryIndexedTree.hs
index 9608de1..f25f8bf 100644
--- a/lib/BinaryIndexedTree.hs
+++ b/lib/BinaryIndexedTree.hs
@@ -28,6 +28,7 @@ queryM_BIT (BIT vec) !i = doQuery i mempty
     doQuery i !acc = do y <- GM.read vec (i - 1)
                         let !j = (i - 1) .&. i
                         doQuery j (y <> acc)
+{-# INLINE queryM_BIT #-}
 
 -- index: zero-based
 -- property: forall vec i x. do { tree <- fromVector_BIT vec; add_BIT tree i x; return tree } == fromVector_BIT (G.accum (<>) vec [(i,x)])
@@ -38,6 +39,7 @@ add_BIT (BIT vec) !i !y = loop (i + 1)
     loop !k = do x <- GM.read vec (k - 1)
                  GM.write vec (k - 1) $! x <> y
                  loop (k + (k .&. (-k)))
+{-# INLINE add_BIT #-}
 
 new_BIT :: (Monoid a, GM.MVector mvec a, PrimMonad m) => Int -> m (BIT mvec (PrimState m) a)
 new_BIT n = BIT <$> GM.replicate n mempty

From 5e928f46effd7c95ccca1884ea9c47924a2f9512 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Mon, 8 Jul 2019 19:27:29 +0900
Subject: [PATCH 052/148] Add library for Segment Tree

---
 lib/SegmentTree.hs | 58 ++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 58 insertions(+)
 create mode 100644 lib/SegmentTree.hs

diff --git a/lib/SegmentTree.hs b/lib/SegmentTree.hs
new file mode 100644
index 0000000..5725e45
--- /dev/null
+++ b/lib/SegmentTree.hs
@@ -0,0 +1,58 @@
+{-# LANGUAGE BangPatterns #-}
+module SegmentTree where
+import Data.Monoid
+import Data.Bits
+import Control.Applicative (liftA2)
+import qualified Data.Vector.Generic.Mutable as GM
+import Control.Monad.Primitive
+import qualified Data.Vector.Mutable as VM
+import qualified Data.Vector.Unboxed.Mutable as UM
+
+--
+-- Segment Tree
+--
+
+data SegTree mvec s a = SegTree {-# UNPACK #-} !Int !(mvec s a)
+
+queryAt_SegTree :: (GM.MVector mvec a, PrimMonad m) => SegTree mvec (PrimState m) a -> Int -> m a
+queryAt_SegTree (SegTree depth vec) !i = GM.read vec ((1 `shiftL` depth) - 1 + i)
+{-# INLINE queryAt_SegTree #-}
+
+-- queryRange_SegTree i j tree == mconcat <$> sequence [queryAt_SegTree tree k | k <- [i..j-1]]
+queryRange_SegTree :: (Monoid a, GM.MVector mvec a, PrimMonad m) => SegTree mvec (PrimState m) a -> Int -> Int -> m a
+queryRange_SegTree (SegTree depth vec) !i !j | i < j = doQuery 0 depth i j
+                                             | otherwise = return mempty
+  where
+    -- Invariant: 0 <= k*2^l <= i < j <= (k+1)*2^l <= 2^depth
+    doQuery !k 0 !i !j | i == k, j == k+1 = GM.read vec ((1 `shiftL` depth) - 1 + k)
+                       | otherwise = error "queryRange"
+    doQuery !k l !i !j | i == k `shiftL` l, j == (k+1) `shiftL` l = GM.read vec ((1 `shiftL` (depth-l)) - 1 + k)
+                       | m <= i = doQuery (2*k+1) (l-1) i j
+                       | j <= m = doQuery (2*k) (l-1) i j
+                       | otherwise = liftA2 (<>) (doQuery (2*k) (l-1) i m) (doQuery (2*k+1) (l-1) m j)
+      where m = (2*k+1) `shiftL` (l-1)
+{-# INLINE queryRange_SegTree #-}
+
+update_SegTree :: (Monoid a, GM.MVector mvec a, PrimMonad m) => SegTree mvec (PrimState m) a -> Int -> a -> m ()
+update_SegTree (SegTree depth vec) !i !x = loop ((1 `shiftL` depth) + i) x
+  where
+    loop 1 !x = GM.write vec 0 x
+    loop !j !x = do
+      GM.write vec (j - 1) x
+      y <- if even j
+           then (x <>) <$> GM.read vec j
+           else (<> x) <$> GM.read vec (j - 2)
+      loop (j `shiftR` 1) y
+{-# INLINE update_SegTree #-}
+
+new_SegTree :: (Monoid a, GM.MVector mvec a, PrimMonad m) => Int -> m (SegTree mvec (PrimState m) a)
+new_SegTree n = do let depth = ceiling (logBase 2 (fromIntegral n) :: Double) :: Int
+                   vec <- GM.replicate ((1 `shiftL` (depth + 1)) - 1) mempty
+                   return (SegTree depth vec)
+{-# INLINE new_SegTree #-}
+
+asBoxedSegTree :: (PrimMonad m) => m (SegTree VM.MVector (PrimState m) a) -> m (SegTree VM.MVector (PrimState m) a)
+asBoxedSegTree = id
+
+asUnboxedSegTree :: (PrimMonad m) => m (SegTree UM.MVector (PrimState m) a) -> m (SegTree UM.MVector (PrimState m) a)
+asUnboxedSegTree = id

From 1625676cb36604c412b10cbb76d6f0bc20b59f81 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Mon, 8 Jul 2019 19:28:06 +0900
Subject: [PATCH 053/148] DP-Q: Add another version with Segment Tree

---
 dp-q/SegTree.hs | 140 ++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 140 insertions(+)
 create mode 100644 dp-q/SegTree.hs

diff --git a/dp-q/SegTree.hs b/dp-q/SegTree.hs
new file mode 100644
index 0000000..b942828
--- /dev/null
+++ b/dp-q/SegTree.hs
@@ -0,0 +1,140 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleContexts #-}
+import Data.Char (isSpace)
+import Data.Int (Int64)
+import Data.List (unfoldr)
+import Data.Bifunctor (first)
+import Control.Monad
+import Control.Monad.ST
+import Control.Applicative (liftA2)
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+import Data.Bits
+import Data.Coerce
+import qualified Data.Vector.Generic as G
+import qualified Data.Vector.Generic.Mutable as GM
+import Control.Monad.Primitive
+import Data.Monoid
+#ifdef MIN_VERSION_base
+#if MIN_VERSION_base(4,9,0)
+import Data.Semigroup hiding ((<>),Max(..),Min(..))
+#endif
+#endif
+import Debug.Trace
+
+main = do
+  n <- readLn
+  hs <- U.unfoldrN n (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  as <- U.unfoldrN n (readInt64 . BS.dropWhile isSpace) <$> BS.getLine
+  let result = runST $ do
+        tree <- asUnboxedSegTree $ new_SegTree n
+        update_SegTree tree 0 (Max 0)
+        forM_ [0..n-1] $ \i -> do
+          let h = hs U.! i
+          Max x <- queryRange_SegTree tree 0 h
+          update_SegTree tree (h - 1) (Max (x + as U.! i))
+        getMax <$> queryRange_SegTree tree 0 n
+  print result
+
+readInt64 :: BS.ByteString -> Maybe (Int64, BS.ByteString)
+readInt64 s = first fromIntegral <$> BS.readInt s
+
+--
+-- Segment Tree
+--
+
+data SegTree mvec s a = SegTree {-# UNPACK #-} !Int !(mvec s a)
+
+queryAt_SegTree :: (GM.MVector mvec a, PrimMonad m) => SegTree mvec (PrimState m) a -> Int -> m a
+queryAt_SegTree (SegTree depth vec) !i = GM.read vec ((1 `shiftL` depth) - 1 + i)
+{-# INLINE queryAt_SegTree #-}
+
+-- queryRange_SegTree i j tree == mconcat <$> sequence [queryAt_SegTree tree k | k <- [i..j-1]]
+queryRange_SegTree :: (Monoid a, GM.MVector mvec a, PrimMonad m) => SegTree mvec (PrimState m) a -> Int -> Int -> m a
+queryRange_SegTree (SegTree depth vec) !i !j | i < j = doQuery 0 depth i j
+                                             | otherwise = return mempty
+  where
+    -- Invariant: 0 <= k*2^l <= i < j <= (k+1)*2^l <= 2^depth
+    doQuery !k 0 !i !j | i == k, j == k+1 = GM.read vec ((1 `shiftL` depth) - 1 + k)
+                       | otherwise = error "queryRange"
+    doQuery !k l !i !j | i == k `shiftL` l, j == (k+1) `shiftL` l = GM.read vec ((1 `shiftL` (depth-l)) - 1 + k)
+                       | m <= i = doQuery (2*k+1) (l-1) i j
+                       | j <= m = doQuery (2*k) (l-1) i j
+                       | otherwise = liftA2 (<>) (doQuery (2*k) (l-1) i m) (doQuery (2*k+1) (l-1) m j)
+      where m = (2*k+1) `shiftL` (l-1)
+{-# INLINE queryRange_SegTree #-}
+
+update_SegTree :: (Monoid a, GM.MVector mvec a, PrimMonad m) => SegTree mvec (PrimState m) a -> Int -> a -> m ()
+update_SegTree (SegTree depth vec) !i !x = loop ((1 `shiftL` depth) + i) x
+  where
+    loop 1 !x = GM.write vec 0 x
+    loop !j !x = do
+      GM.write vec (j - 1) x
+      y <- if even j
+           then (x <>) <$> GM.read vec j
+           else (<> x) <$> GM.read vec (j - 2)
+      loop (j `shiftR` 1) y
+{-# INLINE update_SegTree #-}
+
+new_SegTree :: (Monoid a, GM.MVector mvec a, PrimMonad m) => Int -> m (SegTree mvec (PrimState m) a)
+new_SegTree n = do let depth = ceiling (logBase 2 (fromIntegral n) :: Double) :: Int
+                   vec <- GM.replicate ((1 `shiftL` (depth + 1)) - 1) mempty
+                   return (SegTree depth vec)
+{-# INLINE new_SegTree #-}
+
+asUnboxedSegTree :: (PrimMonad m) => m (SegTree UM.MVector (PrimState m) a) -> m (SegTree UM.MVector (PrimState m) a)
+asUnboxedSegTree = id
+
+--
+-- Max monoid (from Data.Semigroup)
+--
+
+newtype Max a = Max { getMax :: a }
+#ifdef MIN_VERSION_base
+#if MIN_VERSION_base(4,9,0)
+instance (Ord a) => Semigroup (Max a) where
+  Max x <> Max y = Max (x `max` y)
+#endif
+#endif
+instance (Bounded a, Ord a) => Monoid (Max a) where
+  mempty = Max minBound
+  Max x `mappend` Max y = Max (x `max` y)
+
+--
+-- instance U.Unbox (Max a)
+--
+
+newtype instance UM.MVector s (Max a) = MV_Max (UM.MVector s a)
+newtype instance U.Vector (Max a) = V_Max (U.Vector a)
+
+instance GM.MVector UM.MVector a => GM.MVector UM.MVector (Max a) where
+  basicLength (MV_Max mv) = GM.basicLength mv
+  basicUnsafeSlice i l (MV_Max mv) = MV_Max (GM.basicUnsafeSlice i l mv)
+  basicOverlaps (MV_Max mv) (MV_Max mv') = GM.basicOverlaps mv mv'
+  basicUnsafeNew l = MV_Max <$> GM.basicUnsafeNew l
+  basicInitialize (MV_Max mv) = GM.basicInitialize mv
+  basicUnsafeReplicate i x = MV_Max <$> GM.basicUnsafeReplicate i (coerce x)
+  basicUnsafeRead (MV_Max mv) i = coerce <$> GM.basicUnsafeRead mv i
+  basicUnsafeWrite (MV_Max mv) i x = GM.basicUnsafeWrite mv i (coerce x)
+  basicClear (MV_Max mv) = GM.basicClear mv
+  basicSet (MV_Max mv) x = GM.basicSet mv (coerce x)
+  basicUnsafeCopy (MV_Max mv) (MV_Max mv') = GM.basicUnsafeCopy mv mv'
+  basicUnsafeMove (MV_Max mv) (MV_Max mv') = GM.basicUnsafeMove mv mv'
+  basicUnsafeGrow (MV_Max mv) n = MV_Max <$> GM.basicUnsafeGrow mv n
+
+instance G.Vector U.Vector a => G.Vector U.Vector (Max a) where
+  basicUnsafeFreeze (MV_Max mv) = V_Max <$> G.basicUnsafeFreeze mv
+  basicUnsafeThaw (V_Max v) = MV_Max <$> G.basicUnsafeThaw v
+  basicLength (V_Max v) = G.basicLength v
+  basicUnsafeSlice i l (V_Max v) = V_Max (G.basicUnsafeSlice i l v)
+  basicUnsafeIndexM (V_Max v) i = coerce <$> G.basicUnsafeIndexM v i
+  basicUnsafeCopy (MV_Max mv) (V_Max v) = G.basicUnsafeCopy mv v
+  elemseq (V_Max v) x y = G.elemseq v (coerce x) y
+
+instance U.Unbox a => U.Unbox (Max a)

From 1a1287c584f50ae55056a332153833b3b269a947 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Mon, 8 Jul 2019 19:29:07 +0900
Subject: [PATCH 054/148] Library: Add readInt64

---
 lib/Input.hs | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/lib/Input.hs b/lib/Input.hs
index 3e7f5ec..6afdac2 100644
--- a/lib/Input.hs
+++ b/lib/Input.hs
@@ -5,6 +5,7 @@ import Data.Char (isSpace)
 import qualified Data.Vector.Unboxed as U
 import qualified Data.Vector.Unboxed.Mutable as UM
 import qualified Data.ByteString.Char8 as BS
+import Data.Bifunctor (first)
 
 main = do
   _ :: [Int] <- map (read . BS.unpack) . BS.words <$> BS.getLine
@@ -13,3 +14,6 @@ main = do
     [x,y,z] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
     return (x-1,y-1,z)
   return ()
+
+readInt64 :: BS.ByteString -> Maybe (Int64, BS.ByteString)
+readInt64 s = first fromIntegral <$> BS.readInt s

From c406d307a8651246372669dacaab31d8fc73b276 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Tue, 9 Jul 2019 18:34:42 +0900
Subject: [PATCH 055/148] DP-S

---
 README.md    |  2 +-
 dp-s/Main.hs | 89 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 90 insertions(+), 1 deletion(-)
 create mode 100644 dp-s/Main.hs

diff --git a/README.md b/README.md
index 2abdb25..84e12ea 100644
--- a/README.md
+++ b/README.md
@@ -47,7 +47,7 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 * [x] P - Independent Set
 * [x] Q - Flowers
 * [x] R - Walk
-* [ ] S - Digit Sum
+* [x] S - Digit Sum
 * [ ] T - Permutation
 * [ ] U - Grouping
 * [ ] V - Subtree
diff --git a/dp-s/Main.hs b/dp-s/Main.hs
new file mode 100644
index 0000000..24f3f16
--- /dev/null
+++ b/dp-s/Main.hs
@@ -0,0 +1,89 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+import Data.Char (isSpace, digitToInt)
+import Data.Int (Int64)
+import Data.List (unfoldr)
+import Control.Monad
+import qualified Data.Vector as V
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+import Data.Coerce
+---
+import qualified Data.Vector.Generic
+import qualified Data.Vector.Generic.Mutable
+
+main = do
+  k <- BS.getLine
+  d <- readLn
+  let v :: V.Vector (U.Vector N)
+      v = V.iterateN (BS.length k) (\u -> U.generate d (\i -> sum [u U.! ((i - k) `mod` d) | k <- [0..9]])) (U.generate d (\i -> if i == 0 then 1 else 0))
+      f :: BS.ByteString -> Int -> N
+      f !s !j = case BS.uncons s of
+                  Nothing -> if j == 0 then 1 else 0
+                  Just (c, s') -> let kn = digitToInt c
+                                  in f (BS.tail s) ((j - kn) `mod` d) + sum [(v V.! BS.length s') U.! ((j - l) `mod` d) | l <- [0..kn-1]]
+  print $ f k 0 - 1
+
+--
+-- Modular Arithmetic
+--
+
+modulo :: Int64
+modulo = 10^9+7
+addMod, subMod, mulMod :: Int64 -> Int64 -> Int64
+addMod !x !y | x + y >= modulo = x + y - modulo
+             | otherwise = x + y
+subMod !x !y | x >= y = x - y
+             | otherwise = x - y + modulo
+mulMod !x !y = (x * y) `rem` modulo
+
+newtype N = N { unwrapN :: Int64 } deriving (Eq)
+instance Show N where
+  show (N x) = show x
+instance Num N where
+  (+) = coerce addMod
+  (-) = coerce subMod
+  (*) = coerce mulMod
+  fromInteger n = N (fromInteger (n `mod` fromIntegral modulo))
+  abs = undefined; signum = undefined
+
+{-# RULES
+"^9/Int" forall x. x ^ (9 :: Int) = let u = x; v = u * u * u in v * v * v
+"^9/Integer" forall x. x ^ (9 :: Integer) = let u = x; v = u * u * u in v * v * v
+ #-}
+
+--
+-- instance Unbox N
+--
+
+newtype instance UM.MVector s N = MV_N (UM.MVector s Int64)
+newtype instance U.Vector N = V_N (U.Vector Int64)
+
+instance Data.Vector.Generic.Mutable.MVector UM.MVector N where -- needs MultiParamTypeClasses here
+  basicLength (MV_N mv) = Data.Vector.Generic.Mutable.basicLength mv
+  basicUnsafeSlice i l (MV_N mv) = MV_N (Data.Vector.Generic.Mutable.basicUnsafeSlice i l mv)
+  basicOverlaps (MV_N mv) (MV_N mv') = Data.Vector.Generic.Mutable.basicOverlaps mv mv'
+  basicUnsafeNew l = MV_N <$> Data.Vector.Generic.Mutable.basicUnsafeNew l
+  basicInitialize (MV_N mv) = Data.Vector.Generic.Mutable.basicInitialize mv
+  basicUnsafeReplicate i x = MV_N <$> Data.Vector.Generic.Mutable.basicUnsafeReplicate i (coerce x)
+  basicUnsafeRead (MV_N mv) i = coerce <$> Data.Vector.Generic.Mutable.basicUnsafeRead mv i
+  basicUnsafeWrite (MV_N mv) i x = Data.Vector.Generic.Mutable.basicUnsafeWrite mv i (coerce x)
+  basicClear (MV_N mv) = Data.Vector.Generic.Mutable.basicClear mv
+  basicSet (MV_N mv) x = Data.Vector.Generic.Mutable.basicSet mv (coerce x)
+  basicUnsafeCopy (MV_N mv) (MV_N mv') = Data.Vector.Generic.Mutable.basicUnsafeCopy mv mv'
+  basicUnsafeMove (MV_N mv) (MV_N mv') = Data.Vector.Generic.Mutable.basicUnsafeMove mv mv'
+  basicUnsafeGrow (MV_N mv) n = MV_N <$> Data.Vector.Generic.Mutable.basicUnsafeGrow mv n
+
+instance Data.Vector.Generic.Vector U.Vector N where -- needs MultiParamTypeClasses here
+  basicUnsafeFreeze (MV_N mv) = V_N <$> Data.Vector.Generic.basicUnsafeFreeze mv
+  basicUnsafeThaw (V_N v) = MV_N <$> Data.Vector.Generic.basicUnsafeThaw v
+  basicLength (V_N v) = Data.Vector.Generic.basicLength v
+  basicUnsafeSlice i l (V_N v) = V_N (Data.Vector.Generic.basicUnsafeSlice i l v)
+  basicUnsafeIndexM (V_N v) i = coerce <$> Data.Vector.Generic.basicUnsafeIndexM v i
+  basicUnsafeCopy (MV_N mv) (V_N v) = Data.Vector.Generic.basicUnsafeCopy mv v
+  elemseq (V_N v) x y = Data.Vector.Generic.elemseq v (coerce x) y
+
+instance U.Unbox N

From 02e625ba7348346a6067b97ac01a177251607227 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Tue, 9 Jul 2019 18:41:39 +0900
Subject: [PATCH 056/148] DP-S: Use accumulator

---
 dp-s/Main.hs | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/dp-s/Main.hs b/dp-s/Main.hs
index 24f3f16..f4012c8 100644
--- a/dp-s/Main.hs
+++ b/dp-s/Main.hs
@@ -20,12 +20,12 @@ main = do
   d <- readLn
   let v :: V.Vector (U.Vector N)
       v = V.iterateN (BS.length k) (\u -> U.generate d (\i -> sum [u U.! ((i - k) `mod` d) | k <- [0..9]])) (U.generate d (\i -> if i == 0 then 1 else 0))
-      f :: BS.ByteString -> Int -> N
-      f !s !j = case BS.uncons s of
-                  Nothing -> if j == 0 then 1 else 0
+      f :: BS.ByteString -> Int -> N -> N
+      f !s !j !acc = case BS.uncons s of
+                  Nothing -> if j == 0 then acc + 1 else acc
                   Just (c, s') -> let kn = digitToInt c
-                                  in f (BS.tail s) ((j - kn) `mod` d) + sum [(v V.! BS.length s') U.! ((j - l) `mod` d) | l <- [0..kn-1]]
-  print $ f k 0 - 1
+                                  in f (BS.tail s) ((j - kn) `mod` d) (acc + sum [(v V.! BS.length s') U.! ((j - l) `mod` d) | l <- [0..kn-1]])
+  print $ f k 0 0 - 1
 
 --
 -- Modular Arithmetic

From 16408c85047d6c5df7b6e7df5cdb3787c9bf703a Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Mon, 15 Jul 2019 00:12:10 +0900
Subject: [PATCH 057/148] AGC035-A, B, C

---
 README.md        |  11 +++++
 agc035-a/Main.hs |  19 +++++++++
 agc035-b/Main.hs | 103 +++++++++++++++++++++++++++++++++++++++++++++++
 agc035-c/Main.hs |  37 +++++++++++++++++
 4 files changed, 170 insertions(+)
 create mode 100644 agc035-a/Main.hs
 create mode 100644 agc035-b/Main.hs
 create mode 100644 agc035-c/Main.hs

diff --git a/README.md b/README.md
index 84e12ea..d998548 100644
--- a/README.md
+++ b/README.md
@@ -425,3 +425,14 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 * [x] D - Rain Flows into Dams
 * [x] E - Virus Tree 2
 * [x] F - Colorful Tree
+
+## AtCoder Grand Contest 035 (2019-07-14)
+
+<https://atcoder.jp/contests/agc035>
+
+* [x] A - XOR Circle
+* [x] B - Even Degrees
+* [x] C - Skolem XOR Tree
+* [ ] D - Add and Remove
+* [ ] E - Develop
+* [ ] F - Two Histograms
diff --git a/agc035-a/Main.hs b/agc035-a/Main.hs
new file mode 100644
index 0000000..c651c28
--- /dev/null
+++ b/agc035-a/Main.hs
@@ -0,0 +1,19 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Char (isSpace)
+import Data.Bits
+import qualified Data.Vector.Unboxed as U
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.IntMap.Strict as IntMap
+
+main = do
+  n <- readLn
+  xs <- U.unfoldrN n (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  let m = IntMap.fromListWith (+) $ U.toList $ U.map (\x -> (x, 1 :: Int)) xs
+  let result | IntMap.size m <= 3 = case IntMap.toList m of
+                                      [(a0,_)] -> a0 == 0
+                                      [(a0,n0),(a1,n1)] | n0 == 2 * n1 -> a1 == 0
+                                                        | n1 == 2 * n0 -> a0 == 0
+                                                        | otherwise -> False
+                                      [(a0,n0),(a1,n1),(a2,n2)] -> n0 == n1 && n1 == n2 && a0 == a1 `xor` a2
+             | otherwise = False
+  putStrLn $ if result then "Yes" else "No"
diff --git a/agc035-b/Main.hs b/agc035-b/Main.hs
new file mode 100644
index 0000000..1d3b512
--- /dev/null
+++ b/agc035-b/Main.hs
@@ -0,0 +1,103 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import Control.Monad
+import Control.Monad.ST
+import qualified Data.Vector as V
+import qualified Data.Vector.Mutable as VM
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+import System.Exit
+import qualified Data.IntSet as IntSet
+import Data.Monoid
+import Data.Foldable
+
+solve :: Int -> Int -> U.Vector (Int,Int) -> IO ()
+solve !n !m !edges = do
+  let graph :: V.Vector [Int]
+      graph = V.create $ do
+        vec <- VM.replicate n []
+        U.forM_ edges $ \(a,b) -> do
+          p <- VM.read vec a
+          VM.write vec a $! b : p
+          q <- VM.read vec b
+          VM.write vec b $! a : q
+        return vec
+  let graphS :: V.Vector IntSet.IntSet
+      graphS = V.create $ do
+        vec <- VM.replicate n IntSet.empty
+        U.forM_ edges $ \(a,b) -> do
+          p <- VM.read vec a
+          VM.write vec a $! IntSet.insert b p
+          q <- VM.read vec b
+          VM.write vec b $! IntSet.insert a q
+        return vec
+  let treeParent :: U.Vector Int
+      treeDepth :: U.Vector Int
+      treeSorted :: U.Vector Int
+      (treeParent, treeDepth, treeSorted) = runST $ do
+        parentVec <- UM.replicate n (-1)
+        depthVec <- UM.replicate n (-1)
+        sorted <- UM.new n
+        iRef <- UM.replicate 1 n
+        let pushfront x = do i <- UM.read iRef 0
+                             UM.write sorted (i-1) x
+                             UM.write iRef 0 (i-1)
+        let dfs !d !i = do
+              forM_ (graph V.! i) $ \j -> do
+                p <- UM.read parentVec j
+                when (p == -1) $ do
+                  UM.write parentVec j i
+                  UM.write depthVec j d
+                  dfs (d+1) j
+              pushfront i
+        UM.write parentVec 0 0
+        UM.write depthVec 0 0
+        dfs 0 0
+        liftM3 (,,) (U.unsafeFreeze parentVec) (U.unsafeFreeze depthVec) (U.unsafeFreeze sorted)
+  graphM <- V.thaw graphS
+  U.forM_ (U.reverse treeSorted) $ \i -> do
+    e <- VM.read graphM i
+    if even (IntSet.size e)
+      then do forM_IntSet e $ \j -> do
+                putStrLn (show (i+1) ++ " " ++ show (j+1))
+                VM.modify graphM (IntSet.delete i) j
+      else do let p = treeParent U.! i
+              forM_IntSet (IntSet.delete p e) $ \j -> do
+                putStrLn (show (i+1) ++ " " ++ show (j+1))
+                VM.modify graphM (IntSet.delete i) j
+
+
+main = do
+  [n,m] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  edges <- U.replicateM m $ do
+    [a,b] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+    return (a-1,b-1)
+  if even m then solve n m edges else putStrLn "-1"
+
+foldMap_IntSet :: (Monoid n) => (Int -> n) -> IntSet.IntSet -> n
+foldMap_IntSet f set = go set
+  where
+    go set = case IntSet.splitRoot set of
+               [] -> mempty
+               [x] -> foldMap f (IntSet.toList x)
+               xs -> foldMap go xs
+
+forM_IntSet :: Monad m => IntSet.IntSet -> (Int -> m ()) -> m ()
+forM_IntSet set f = go set
+  where
+    go set = case IntSet.splitRoot set of
+               [] -> return ()
+               [x] -> forM_ (IntSet.toList x) f
+               xs -> forM_ xs go
+
+foldMapM_IntSet :: (Monoid n, Monad m) => (Int -> m n) -> IntSet.IntSet -> m n
+foldMapM_IntSet f set = go set
+  where
+    go set = case IntSet.splitRoot set of
+               [] -> return mempty
+               [x] -> foldlM (\x v -> mappend x <$> f v) mempty (IntSet.toList x)
+               xs -> foldlM (\x set' -> mappend x <$> go set') mempty xs
diff --git a/agc035-c/Main.hs b/agc035-c/Main.hs
new file mode 100644
index 0000000..81a505f
--- /dev/null
+++ b/agc035-c/Main.hs
@@ -0,0 +1,37 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE BangPatterns #-}
+import Control.Monad
+import Data.Bits
+
+printEdge :: Int -> Int -> IO ()
+printEdge !i !j = putStrLn $ show i ++ " " ++ show j
+
+main = do
+  n :: Int <- readLn
+  if n .&. (n-1) == 0 -- n = 2^k for some k
+    then putStrLn "No"
+    else do putStrLn "Yes"
+            let m = bit (floor (logBase 2 (fromIntegral (n+1))))
+            forM_ [1..m-2] $ \i -> do
+              printEdge i (i+1)
+            printEdge (m-1) (n+1)
+            forM_ [1..m-2] $ \i -> do
+              printEdge (n+i) (n+i+1)
+            when (n >= m + 1) $ do
+              printEdge 1 m
+              printEdge m (m+1)
+              printEdge 1 (n+m+1)
+              printEdge (n+m+1) (n+m)
+              when (n >= m + 2) $ do
+                printEdge 2 (m+2)
+                printEdge (n+m+1) (n+m+2)
+                when (n >= m + 3) $ do
+                  printEdge m (m+3)
+                  printEdge 2 (n+m+3)
+                  when (n >= m + 4) $ do
+                    printEdge m (n+m+4)
+                    printEdge 4 (m+4)
+                    forM_ [m+5..n] $ \i -> do
+                      printEdge (i-1) (n+i)
+                      printEdge (i-m) i

From b8a09dc5cb86b7c541c339cca7c8238a5edacc27 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Mon, 15 Jul 2019 14:52:28 +0900
Subject: [PATCH 058/148] AGC035-B, C: Some clean up and use
 Data.ByteString.Builder

---
 agc035-b/Main.hs | 53 ++++++++++++++++++++++--------------------------
 agc035-c/Main.hs |  6 +++++-
 2 files changed, 29 insertions(+), 30 deletions(-)

diff --git a/agc035-b/Main.hs b/agc035-b/Main.hs
index 1d3b512..978047f 100644
--- a/agc035-b/Main.hs
+++ b/agc035-b/Main.hs
@@ -5,71 +5,61 @@ import Data.Char (isSpace)
 import Data.List (unfoldr)
 import Control.Monad
 import Control.Monad.ST
+import Control.Monad.Primitive (PrimMonad, PrimState)
 import qualified Data.Vector as V
 import qualified Data.Vector.Mutable as VM
 import qualified Data.Vector.Unboxed as U
 import qualified Data.Vector.Unboxed.Mutable as UM
 import qualified Data.ByteString.Char8 as BS
-import System.Exit
 import qualified Data.IntSet as IntSet
 import Data.Monoid
 import Data.Foldable
+import qualified Data.ByteString.Builder as BSB
+import System.IO (stdout)
+
+printEdge :: Int -> Int -> IO ()
+-- printEdge !i !j = putStrLn $ show i ++ " " ++ show j
+printEdge !i !j = BSB.hPutBuilder stdout $ BSB.intDec i <> BSB.char7 ' ' <> BSB.intDec j <> BSB.char7 '\n'
 
 solve :: Int -> Int -> U.Vector (Int,Int) -> IO ()
 solve !n !m !edges = do
-  let graph :: V.Vector [Int]
-      graph = V.create $ do
-        vec <- VM.replicate n []
-        U.forM_ edges $ \(a,b) -> do
-          p <- VM.read vec a
-          VM.write vec a $! b : p
-          q <- VM.read vec b
-          VM.write vec b $! a : q
-        return vec
   let graphS :: V.Vector IntSet.IntSet
       graphS = V.create $ do
         vec <- VM.replicate n IntSet.empty
         U.forM_ edges $ \(a,b) -> do
-          p <- VM.read vec a
-          VM.write vec a $! IntSet.insert b p
-          q <- VM.read vec b
-          VM.write vec b $! IntSet.insert a q
+          modify'_MV vec (IntSet.insert b) a
+          modify'_MV vec (IntSet.insert a) b
         return vec
   let treeParent :: U.Vector Int
-      treeDepth :: U.Vector Int
       treeSorted :: U.Vector Int
-      (treeParent, treeDepth, treeSorted) = runST $ do
+      (treeParent, treeSorted) = runST $ do
         parentVec <- UM.replicate n (-1)
-        depthVec <- UM.replicate n (-1)
         sorted <- UM.new n
         iRef <- UM.replicate 1 n
         let pushfront x = do i <- UM.read iRef 0
                              UM.write sorted (i-1) x
                              UM.write iRef 0 (i-1)
-        let dfs !d !i = do
-              forM_ (graph V.! i) $ \j -> do
+        let dfs !i = do
+              forM_IntSet (graphS V.! i) $ \j -> do
                 p <- UM.read parentVec j
                 when (p == -1) $ do
                   UM.write parentVec j i
-                  UM.write depthVec j d
-                  dfs (d+1) j
+                  dfs j
               pushfront i
         UM.write parentVec 0 0
-        UM.write depthVec 0 0
-        dfs 0 0
-        liftM3 (,,) (U.unsafeFreeze parentVec) (U.unsafeFreeze depthVec) (U.unsafeFreeze sorted)
+        dfs 0
+        liftM2 (,) (U.unsafeFreeze parentVec) (U.unsafeFreeze sorted)
   graphM <- V.thaw graphS
   U.forM_ (U.reverse treeSorted) $ \i -> do
     e <- VM.read graphM i
     if even (IntSet.size e)
       then do forM_IntSet e $ \j -> do
-                putStrLn (show (i+1) ++ " " ++ show (j+1))
-                VM.modify graphM (IntSet.delete i) j
+                printEdge (i+1) (j+1)
+                modify'_MV graphM (IntSet.delete i) j
       else do let p = treeParent U.! i
               forM_IntSet (IntSet.delete p e) $ \j -> do
-                putStrLn (show (i+1) ++ " " ++ show (j+1))
-                VM.modify graphM (IntSet.delete i) j
-
+                printEdge (i+1) (j+1)
+                modify'_MV graphM (IntSet.delete i) j
 
 main = do
   [n,m] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
@@ -78,6 +68,11 @@ main = do
     return (a-1,b-1)
   if even m then solve n m edges else putStrLn "-1"
 
+-- strict version of VM.modify
+modify'_MV :: PrimMonad m => VM.MVector (PrimState m) a -> (a -> a) -> Int -> m ()
+modify'_MV mvec f !i = do x <- VM.read mvec i
+                          VM.write mvec i $! f x
+
 foldMap_IntSet :: (Monoid n) => (Int -> n) -> IntSet.IntSet -> n
 foldMap_IntSet f set = go set
   where
diff --git a/agc035-c/Main.hs b/agc035-c/Main.hs
index 81a505f..4b77b4c 100644
--- a/agc035-c/Main.hs
+++ b/agc035-c/Main.hs
@@ -3,9 +3,13 @@
 {-# LANGUAGE BangPatterns #-}
 import Control.Monad
 import Data.Bits
+import Data.Monoid
+import qualified Data.ByteString.Builder as BSB
+import System.IO
 
 printEdge :: Int -> Int -> IO ()
-printEdge !i !j = putStrLn $ show i ++ " " ++ show j
+-- printEdge !i !j = putStrLn $ show i ++ " " ++ show j
+printEdge !i !j = BSB.hPutBuilder stdout $ BSB.intDec i <> BSB.char7 ' ' <> BSB.intDec j <> BSB.char7 '\n'
 
 main = do
   n :: Int <- readLn

From 87994b20cbe028c303bc79f94496d7f4cc26e193 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Thu, 18 Jul 2019 23:40:06 +0900
Subject: [PATCH 059/148] DP-T

---
 README.md    |  2 +-
 dp-t/Main.hs | 85 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 86 insertions(+), 1 deletion(-)
 create mode 100644 dp-t/Main.hs

diff --git a/README.md b/README.md
index d998548..92669ef 100644
--- a/README.md
+++ b/README.md
@@ -48,7 +48,7 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 * [x] Q - Flowers
 * [x] R - Walk
 * [x] S - Digit Sum
-* [ ] T - Permutation
+* [x] T - Permutation
 * [ ] U - Grouping
 * [ ] V - Subtree
 * [ ] W - Intervals
diff --git a/dp-t/Main.hs b/dp-t/Main.hs
new file mode 100644
index 0000000..f383766
--- /dev/null
+++ b/dp-t/Main.hs
@@ -0,0 +1,85 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+import Data.Int (Int64)
+import Data.Coerce
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.Vector.Generic
+import qualified Data.Vector.Generic.Mutable
+
+solve :: Int -> BS.ByteString -> U.Vector N
+solve 1 _ = U.fromList [0,1]
+solve n s = let !v = solve (n-1) (BS.tail s)
+            in case BS.head s of
+                 '<' -> let !w = U.last v
+                        in U.scanl' (\x y -> x + w - y) 0 v
+                 '>' -> U.scanl' (+) 0 v
+
+main = do
+  n <- readLn
+  s <- BS.getLine
+  print $ U.last $ solve n s
+
+--
+-- Modular Arithmetic
+--
+
+modulo :: Int64
+modulo = 10^9+7
+addMod, subMod, mulMod :: Int64 -> Int64 -> Int64
+addMod !x !y | x + y >= modulo = x + y - modulo
+             | otherwise = x + y
+subMod !x !y | x >= y = x - y
+             | otherwise = x - y + modulo
+mulMod !x !y = (x * y) `rem` modulo
+
+newtype N = N { unwrapN :: Int64 } deriving (Eq)
+instance Show N where
+  show (N x) = show x
+instance Num N where
+  (+) = coerce addMod
+  (-) = coerce subMod
+  (*) = coerce mulMod
+  fromInteger n = N (fromInteger (n `mod` fromIntegral modulo))
+  abs = undefined; signum = undefined
+
+{-# RULES
+"^9/Int" forall x. x ^ (9 :: Int) = let u = x; v = u * u * u in v * v * v
+"^9/Integer" forall x. x ^ (9 :: Integer) = let u = x; v = u * u * u in v * v * v
+ #-}
+
+--
+-- instance U.Unbox N
+--
+
+newtype instance UM.MVector s N = MV_N (UM.MVector s Int64)
+newtype instance U.Vector N = V_N (U.Vector Int64)
+
+instance Data.Vector.Generic.Mutable.MVector UM.MVector N where -- needs MultiParamTypeClasses here
+  basicLength (MV_N mv) = Data.Vector.Generic.Mutable.basicLength mv
+  basicUnsafeSlice i l (MV_N mv) = MV_N (Data.Vector.Generic.Mutable.basicUnsafeSlice i l mv)
+  basicOverlaps (MV_N mv) (MV_N mv') = Data.Vector.Generic.Mutable.basicOverlaps mv mv'
+  basicUnsafeNew l = MV_N <$> Data.Vector.Generic.Mutable.basicUnsafeNew l
+  basicInitialize (MV_N mv) = Data.Vector.Generic.Mutable.basicInitialize mv
+  basicUnsafeReplicate i x = MV_N <$> Data.Vector.Generic.Mutable.basicUnsafeReplicate i (coerce x)
+  basicUnsafeRead (MV_N mv) i = coerce <$> Data.Vector.Generic.Mutable.basicUnsafeRead mv i
+  basicUnsafeWrite (MV_N mv) i x = Data.Vector.Generic.Mutable.basicUnsafeWrite mv i (coerce x)
+  basicClear (MV_N mv) = Data.Vector.Generic.Mutable.basicClear mv
+  basicSet (MV_N mv) x = Data.Vector.Generic.Mutable.basicSet mv (coerce x)
+  basicUnsafeCopy (MV_N mv) (MV_N mv') = Data.Vector.Generic.Mutable.basicUnsafeCopy mv mv'
+  basicUnsafeMove (MV_N mv) (MV_N mv') = Data.Vector.Generic.Mutable.basicUnsafeMove mv mv'
+  basicUnsafeGrow (MV_N mv) n = MV_N <$> Data.Vector.Generic.Mutable.basicUnsafeGrow mv n
+
+instance Data.Vector.Generic.Vector U.Vector N where -- needs MultiParamTypeClasses here
+  basicUnsafeFreeze (MV_N mv) = V_N <$> Data.Vector.Generic.basicUnsafeFreeze mv
+  basicUnsafeThaw (V_N v) = MV_N <$> Data.Vector.Generic.basicUnsafeThaw v
+  basicLength (V_N v) = Data.Vector.Generic.basicLength v
+  basicUnsafeSlice i l (V_N v) = V_N (Data.Vector.Generic.basicUnsafeSlice i l v)
+  basicUnsafeIndexM (V_N v) i = coerce <$> Data.Vector.Generic.basicUnsafeIndexM v i
+  basicUnsafeCopy (MV_N mv) (V_N v) = Data.Vector.Generic.basicUnsafeCopy mv v
+  elemseq (V_N v) x y = Data.Vector.Generic.elemseq v (coerce x) y
+
+instance U.Unbox N

From acb2b5384174c18d5b2b162d0ee89707b28481bf Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Sat, 20 Jul 2019 22:58:51 +0900
Subject: [PATCH 060/148] ABC134-A, B, C, D, E

---
 README.md        | 11 +++++++++++
 abc134-a/Main.hs |  5 +++++
 abc134-b/Main.hs |  9 +++++++++
 abc134-c/Main.hs | 11 +++++++++++
 abc134-d/Main.hs | 26 ++++++++++++++++++++++++++
 abc134-e/Main.hs | 20 ++++++++++++++++++++
 6 files changed, 82 insertions(+)
 create mode 100644 abc134-a/Main.hs
 create mode 100644 abc134-b/Main.hs
 create mode 100644 abc134-c/Main.hs
 create mode 100644 abc134-d/Main.hs
 create mode 100644 abc134-e/Main.hs

diff --git a/README.md b/README.md
index 92669ef..99dd571 100644
--- a/README.md
+++ b/README.md
@@ -436,3 +436,14 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 * [ ] D - Add and Remove
 * [ ] E - Develop
 * [ ] F - Two Histograms
+
+## AtCoder Beginner Contest 134 (2019-07-20)
+
+<https://atcoder.jp/contests/abc134>
+
+* [x] A - Dodecagon
+* [x] B - Golden Apple
+* [x] C - Exception Handling
+* [x] D - Preparing Boxes
+* [x] E - Sequence Decomposing
+* [ ] F - Permutation Oddness
diff --git a/abc134-a/Main.hs b/abc134-a/Main.hs
new file mode 100644
index 0000000..b01743c
--- /dev/null
+++ b/abc134-a/Main.hs
@@ -0,0 +1,5 @@
+-- https://github.com/minoki/my-atcoder-solutions
+
+main = do
+  r <- readLn
+  print (3 * r^2 :: Int)
diff --git a/abc134-b/Main.hs b/abc134-b/Main.hs
new file mode 100644
index 0000000..a6b34ee
--- /dev/null
+++ b/abc134-b/Main.hs
@@ -0,0 +1,9 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  [n,d] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  let m = 2 * d + 1
+  print $ (n + m - 1) `quot` m
diff --git a/abc134-c/Main.hs b/abc134-c/Main.hs
new file mode 100644
index 0000000..ac54d6e
--- /dev/null
+++ b/abc134-c/Main.hs
@@ -0,0 +1,11 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import qualified Data.Vector.Unboxed as U
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  n <- readLn
+  xs <- U.replicateM n $ do
+    Just (x, _) <- BS.readInt <$> BS.getLine
+    return x
+  let v = U.zipWith max (U.scanl' max 0 xs) (U.tail $ U.scanr' max 0 xs)
+  U.forM_ v print
diff --git a/abc134-d/Main.hs b/abc134-d/Main.hs
new file mode 100644
index 0000000..678833a
--- /dev/null
+++ b/abc134-d/Main.hs
@@ -0,0 +1,26 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import Control.Monad
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+
+solve :: Int -> U.Vector Int -> U.Vector Int
+solve !n v = U.create $ do
+  result <- UM.replicate (n + 1) 0
+  forM_ [n,n-1..1] $ \i -> do
+    s <- sumM [ UM.read result j | j <- [2*i,3*i..n] ]
+    UM.write result i ((s + v U.! (i-1)) `rem` 2)
+  return result
+
+main = do
+  n <- readLn
+  xs <- U.unfoldrN n (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  let result = U.filter (\(i,v) -> v > 0) $ U.indexed $ solve n xs
+  print $ U.length result
+  U.forM_ result $ \(i,_) -> print i
+
+sumM :: (Monad m, Num a) => [m a] -> m a
+sumM = foldM (\s a -> (s +) <$> a) 0
diff --git a/abc134-e/Main.hs b/abc134-e/Main.hs
new file mode 100644
index 0000000..1168fe3
--- /dev/null
+++ b/abc134-e/Main.hs
@@ -0,0 +1,20 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import qualified Data.Vector.Unboxed as U
+import qualified Data.ByteString.Char8 as BS
+import Data.Monoid
+import qualified Data.IntMap.Strict as IntMap
+
+main = do
+  n <- readLn
+  xs <- U.replicateM n $ do
+    Just (x, _) <- BS.readInt <$> BS.getLine
+    return x
+  let s = U.foldl (\ !s !y ->
+                     case IntMap.lookupLT y s of
+                       Nothing -> IntMap.insertWith (+) y 1 s
+                       Just (x,k) -> if k == 1 then IntMap.insertWith (+) y 1 $ IntMap.delete x s else IntMap.insertWith (+) y 1 $ IntMap.insert x (k-1) s
+                  ) IntMap.empty xs
+  print $ getSum $ IntMap.foldMapWithKey (\_ -> Sum) s

From 31c084dadd2b64a976f4fa1d9befa4ebe743da08 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Mon, 22 Jul 2019 10:24:33 +0900
Subject: [PATCH 061/148] AGC036-A, B

---
 README.md        | 11 ++++++
 agc036-a/Main.hs | 31 ++++++++++++++++
 agc036-b/Main.hs | 94 ++++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 136 insertions(+)
 create mode 100644 agc036-a/Main.hs
 create mode 100644 agc036-b/Main.hs

diff --git a/README.md b/README.md
index 99dd571..853ae71 100644
--- a/README.md
+++ b/README.md
@@ -447,3 +447,14 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 * [x] D - Preparing Boxes
 * [x] E - Sequence Decomposing
 * [ ] F - Permutation Oddness
+
+## AtCoder Grand Contest 036 (2019-07-21)
+
+<https://atcoder.jp/contests/agc036/tasks>
+
+* [x] A - Triangle
+* [x] B - Do Not Duplicate
+* [ ] C - GP 2
+* [ ] D - Negative Cycle
+* [ ] E - ABC String
+* [ ] F - Square Constraints
diff --git a/agc036-a/Main.hs b/agc036-a/Main.hs
new file mode 100644
index 0000000..5255799
--- /dev/null
+++ b/agc036-a/Main.hs
@@ -0,0 +1,31 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Int (Int64)
+
+check :: (Int64, Int64, Int64, Int64, Int64, Int64) -> Maybe Int64
+check (x1,y1,x2,y2,x3,y3)
+  | 0 <= x1 && x1 <= 10^9
+  , 0 <= y1 && y1 <= 10^9
+  , 0 <= x2 && x2 <= 10^9
+  , 0 <= y2 && y2 <= 10^9
+  , 0 <= x3 && x3 <= 10^9
+  , 0 <= y3 && y3 <= 10^9 = let x2' = x2 - x1
+                                y2' = y2 - y1
+                                x3' = x3 - x1
+                                y3' = y3 - y1
+                            in Just (x2' * y3' - y2' * x3')
+  | otherwise = Nothing
+
+solve :: Int64 -> (Int64, Int64, Int64, Int64, Int64, Int64)
+solve s | s == 10^18 = (0,0,10^9,0,0,10^9)
+        | otherwise = let (a,b) = s `quotRem` (10^9)
+                      in (0,0,10^9,1,10^9-b,a+1)
+
+main = do
+  s <- readLn
+  let (x1,y1,x2,y2,x3,y3) = solve s
+  putStrLn $ unwords $ map show [x1,y1,x2,y2,x3,y3]
+
+{-# RULES
+"^9/Int" forall x. x ^ (9 :: Int) = let u = x; v = u * u * u in v * v * v
+"^9/Integer" forall x. x ^ (9 :: Integer) = let u = x; v = u * u * u in v * v * v
+ #-}
diff --git a/agc036-b/Main.hs b/agc036-b/Main.hs
new file mode 100644
index 0000000..1d0be3e
--- /dev/null
+++ b/agc036-b/Main.hs
@@ -0,0 +1,94 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.Int (Int64)
+import Data.List (unfoldr)
+import Control.Monad
+import Control.Monad.ST
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.IntMap.Strict as IntMap
+import Data.Foldable
+
+nextOccurrenceTable :: U.Vector Int -> (U.Vector Int, IntMap.IntMap Int)
+nextOccurrenceTable v = runST $ do
+  let n = U.length v
+  w <- UM.new n
+  let go p !i = do let a = v U.! i
+                   case IntMap.lookup a p of
+                     Nothing -> UM.write w i (-1)
+                     Just j -> UM.write w i j
+                   return $! IntMap.insert a i p
+  p <- foldlM go IntMap.empty [n-1,n-2..0]
+  result <- U.unsafeFreeze w
+  return (result, p)
+
+stepI :: U.Vector Int -> (U.Vector Int, IntMap.IntMap Int) -> Int -> Int
+stepI v (nt,m) a | a == 0 = go 0
+                 | otherwise = go (m IntMap.! a + 1)
+  where
+    go !i | i >= U.length v = 0
+          | otherwise = let j = nt U.! i
+                        in if j == -1
+                           then v U.! i
+                           else go (j + 1)
+
+period :: U.Vector Int -> (U.Vector Int, IntMap.IntMap Int) -> Int
+period v nt = 1 + (length $ takeWhile (/= 0) $ tail $ iterate (stepI v nt) 0)
+
+lastStep :: U.Vector Int -> (U.Vector Int, IntMap.IntMap Int) -> Int -> U.Vector Int
+lastStep v (nt,m) a = U.create $ do
+  mv <- UM.new (U.length v)
+  let go !i !l | i >= U.length v = return (UM.take l mv)
+               | otherwise = let j = nt U.! i
+                             in if j == -1
+                                then do UM.write mv l (v U.! i)
+                                        go (i + 1) (l + 1)
+                                else go (j + 1) l
+  go (if a == 0 then 0 else m IntMap.! a + 1) 0
+
+solve :: Int -> Int64 -> U.Vector Int -> U.Vector Int
+solve !n !k xs = let nt = nextOccurrenceTable xs
+                     p = period xs nt
+                     r = fromIntegral (k `rem` fromIntegral p)
+                 in if r == 0
+                    then U.empty
+                    else let s = iterate (stepI xs nt) 0 !! (r - 1)
+                         in lastStep xs nt s
+
+main = do
+  [n',k'] <- unfoldr (BS.readInteger . BS.dropWhile isSpace) <$> BS.getLine
+  let n = fromIntegral n' :: Int
+      k = fromIntegral k' :: Int64
+  xs <- U.unfoldrN n (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  -- let result = naiveSolution n k xs
+  let result = solve n k xs
+  putStrLn $ unwords $ map show (U.toList result)
+
+--
+
+naiveSolution :: Int -> Int64 -> U.Vector Int -> U.Vector Int
+naiveSolution !n !k xs = U.create $ do
+  mv <- UM.new (2 * n)
+  n <- foldlM (\n _ -> naiveStepV mv n xs) 0 [1..k]
+  return $ UM.take n mv
+
+naiveStep :: UM.MVector s Int -> Int -> Int -> ST s Int
+naiveStep mv !n !x = do
+  let loop !i | i >= n = return Nothing
+              | otherwise = do
+                  y <- UM.read mv i
+                  if x == y
+                    then return (Just i)
+                    else loop (i+1)
+  found <- loop 0
+  case found of
+    Nothing -> UM.write mv n x >> return (n+1)
+    Just i -> return i
+
+naiveStepV :: UM.MVector s Int -> Int -> U.Vector Int -> ST s Int
+naiveStepV mv !n v = foldlM_UV (\n' x -> naiveStep mv n' x) n v
+
+foldlM_UV :: (U.Unbox a, Monad m) => (b -> a -> m b) -> b -> U.Vector a -> m b
+foldlM_UV f a = U.foldl (\m x -> m >>= \b -> f b x) (pure a)

From b18bfa031c2c67d82c35448978b73ac0699bc738 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Mon, 22 Jul 2019 10:31:33 +0900
Subject: [PATCH 062/148] Move ABC into its own directory

---
 README.md                                   | 249 +-------------------
 abc/README.md                               | 246 +++++++++++++++++++
 {abc120-a => abc/abc120-a}/Main.hs          |   0
 {abc120-b => abc/abc120-b}/Main.hs          |   0
 {abc120-c => abc/abc120-c}/Main.hs          |   0
 {abc120-d => abc/abc120-d}/Main.hs          |   0
 {abc121-a => abc/abc121-a}/Main.hs          |   0
 {abc121-b => abc/abc121-b}/Main.hs          |   0
 {abc121-c => abc/abc121-c}/Main.hs          |   0
 {abc121-d => abc/abc121-d}/Main.hs          |   0
 {abc122-a => abc/abc122-a}/Main.hs          |   0
 {abc122-b => abc/abc122-b}/Main.hs          |   0
 {abc122-c => abc/abc122-c}/Main.hs          |   0
 {abc122-d => abc/abc122-d}/Fast.hs          |   0
 {abc122-d => abc/abc122-d}/Main.hs          |   0
 {abc122-d => abc/abc122-d}/MatPow.hs        |   0
 {abc122-d => abc/abc122-d}/PolyDiv.hs       |   0
 {abc122-d => abc/abc122-d}/Small.hs         |   0
 {abc123-a => abc/abc123-a}/Main.hs          |   0
 {abc123-b => abc/abc123-b}/Main.hs          |   0
 {abc123-c => abc/abc123-c}/Main.hs          |   0
 {abc123-d => abc/abc123-d}/Main.hs          |   0
 {abc123-d => abc/abc123-d}/mkrandinput.lua  |   0
 {abc124-a => abc/abc124-a}/Main.hs          |   0
 {abc124-b => abc/abc124-b}/Main.hs          |   0
 {abc124-c => abc/abc124-c}/Main.hs          |   0
 {abc124-d => abc/abc124-d}/Main.hs          |   0
 {abc125-a => abc/abc125-a}/Main.hs          |   0
 {abc125-b => abc/abc125-b}/Main.hs          |   0
 {abc125-c => abc/abc125-c}/Main.hs          |   0
 {abc125-d => abc/abc125-d}/Main.hs          |   0
 {abc126-a => abc/abc126-a}/Main.hs          |   0
 {abc126-b => abc/abc126-b}/Main.hs          |   0
 {abc126-c => abc/abc126-c}/Main.hs          |   0
 {abc126-d => abc/abc126-d}/Main.hs          |   0
 {abc126-e => abc/abc126-e}/Main.hs          |   0
 {abc126-f => abc/abc126-f}/Main.hs          |   0
 {abc127-a => abc/abc127-a}/Main.hs          |   0
 {abc127-b => abc/abc127-b}/Main.hs          |   0
 {abc127-c => abc/abc127-c}/Main.hs          |   0
 {abc127-d => abc/abc127-d}/Main.hs          |   0
 {abc128-a => abc/abc128-a}/Main.hs          |   0
 {abc128-b => abc/abc128-b}/Main.hs          |   0
 {abc128-c => abc/abc128-c}/Main.hs          |   0
 {abc128-d => abc/abc128-d}/Main.hs          |   0
 {abc128-e => abc/abc128-e}/Main.hs          |   0
 {abc128-e => abc/abc128-e}/MainNaive.hs     |   0
 {abc128-e => abc/abc128-e}/MainTree.hs      |   0
 {abc128-e => abc/abc128-e}/main.cpp         |   0
 {abc128-e => abc/abc128-e}/mklargeinput.lua |   0
 {abc128-f => abc/abc128-f}/List.hs          |   0
 {abc128-f => abc/abc128-f}/Main.hs          |   0
 {abc129-a => abc/abc129-a}/Main.hs          |   0
 {abc129-b => abc/abc129-b}/Main.hs          |   0
 {abc129-c => abc/abc129-c}/Main.hs          |   0
 {abc129-d => abc/abc129-d}/Main.hs          |   0
 {abc129-e => abc/abc129-e}/Main.hs          |   0
 {abc129-f => abc/abc129-f}/Main.hs          |   0
 {abc130-a => abc/abc130-a}/Main.hs          |   0
 {abc130-b => abc/abc130-b}/Main.hs          |   0
 {abc130-c => abc/abc130-c}/Main.hs          |   0
 {abc130-d => abc/abc130-d}/Main.hs          |   0
 {abc130-e => abc/abc130-e}/Main.hs          |   0
 {abc130-e => abc/abc130-e}/Vec.hs           |   0
 {abc130-f => abc/abc130-f}/Main.hs          |   0
 {abc131-a => abc/abc131-a}/Main.hs          |   0
 {abc131-b => abc/abc131-b}/Main.hs          |   0
 {abc131-c => abc/abc131-c}/Main.hs          |   0
 {abc131-d => abc/abc131-d}/Main.hs          |   0
 {abc131-d => abc/abc131-d}/VectorSort.hs    |   0
 {abc131-e => abc/abc131-e}/Main.hs          |   0
 {abc131-f => abc/abc131-f}/Main.hs          |   0
 {abc132-a => abc/abc132-a}/Main.hs          |   0
 {abc132-b => abc/abc132-b}/Main.hs          |   0
 {abc132-c => abc/abc132-c}/Main.hs          |   0
 {abc132-d => abc/abc132-d}/Main.hs          |   0
 {abc132-e => abc/abc132-e}/IntMap.hs        |   0
 {abc132-e => abc/abc132-e}/Slow.hs          |   0
 {abc132-e => abc/abc132-e}/Vec.hs           |   0
 {abc133-a => abc/abc133-a}/Main.hs          |   0
 {abc133-b => abc/abc133-b}/Main.hs          |   0
 {abc133-c => abc/abc133-c}/Main.hs          |   0
 {abc133-d => abc/abc133-d}/Main.hs          |   0
 {abc133-e => abc/abc133-e}/Main.hs          |   0
 {abc133-f => abc/abc133-f}/Main.hs          |   0
 {abc133-f => abc/abc133-f}/Slow.hs          |   0
 {abc133-f => abc/abc133-f}/mkinput.lua      |   0
 {abc134-a => abc/abc134-a}/Main.hs          |   0
 {abc134-b => abc/abc134-b}/Main.hs          |   0
 {abc134-c => abc/abc134-c}/Main.hs          |   0
 {abc134-d => abc/abc134-d}/Main.hs          |   0
 {abc134-e => abc/abc134-e}/Main.hs          |   0
 92 files changed, 250 insertions(+), 245 deletions(-)
 create mode 100644 abc/README.md
 rename {abc120-a => abc/abc120-a}/Main.hs (100%)
 rename {abc120-b => abc/abc120-b}/Main.hs (100%)
 rename {abc120-c => abc/abc120-c}/Main.hs (100%)
 rename {abc120-d => abc/abc120-d}/Main.hs (100%)
 rename {abc121-a => abc/abc121-a}/Main.hs (100%)
 rename {abc121-b => abc/abc121-b}/Main.hs (100%)
 rename {abc121-c => abc/abc121-c}/Main.hs (100%)
 rename {abc121-d => abc/abc121-d}/Main.hs (100%)
 rename {abc122-a => abc/abc122-a}/Main.hs (100%)
 rename {abc122-b => abc/abc122-b}/Main.hs (100%)
 rename {abc122-c => abc/abc122-c}/Main.hs (100%)
 rename {abc122-d => abc/abc122-d}/Fast.hs (100%)
 rename {abc122-d => abc/abc122-d}/Main.hs (100%)
 rename {abc122-d => abc/abc122-d}/MatPow.hs (100%)
 rename {abc122-d => abc/abc122-d}/PolyDiv.hs (100%)
 rename {abc122-d => abc/abc122-d}/Small.hs (100%)
 rename {abc123-a => abc/abc123-a}/Main.hs (100%)
 rename {abc123-b => abc/abc123-b}/Main.hs (100%)
 rename {abc123-c => abc/abc123-c}/Main.hs (100%)
 rename {abc123-d => abc/abc123-d}/Main.hs (100%)
 rename {abc123-d => abc/abc123-d}/mkrandinput.lua (100%)
 rename {abc124-a => abc/abc124-a}/Main.hs (100%)
 rename {abc124-b => abc/abc124-b}/Main.hs (100%)
 rename {abc124-c => abc/abc124-c}/Main.hs (100%)
 rename {abc124-d => abc/abc124-d}/Main.hs (100%)
 rename {abc125-a => abc/abc125-a}/Main.hs (100%)
 rename {abc125-b => abc/abc125-b}/Main.hs (100%)
 rename {abc125-c => abc/abc125-c}/Main.hs (100%)
 rename {abc125-d => abc/abc125-d}/Main.hs (100%)
 rename {abc126-a => abc/abc126-a}/Main.hs (100%)
 rename {abc126-b => abc/abc126-b}/Main.hs (100%)
 rename {abc126-c => abc/abc126-c}/Main.hs (100%)
 rename {abc126-d => abc/abc126-d}/Main.hs (100%)
 rename {abc126-e => abc/abc126-e}/Main.hs (100%)
 rename {abc126-f => abc/abc126-f}/Main.hs (100%)
 rename {abc127-a => abc/abc127-a}/Main.hs (100%)
 rename {abc127-b => abc/abc127-b}/Main.hs (100%)
 rename {abc127-c => abc/abc127-c}/Main.hs (100%)
 rename {abc127-d => abc/abc127-d}/Main.hs (100%)
 rename {abc128-a => abc/abc128-a}/Main.hs (100%)
 rename {abc128-b => abc/abc128-b}/Main.hs (100%)
 rename {abc128-c => abc/abc128-c}/Main.hs (100%)
 rename {abc128-d => abc/abc128-d}/Main.hs (100%)
 rename {abc128-e => abc/abc128-e}/Main.hs (100%)
 rename {abc128-e => abc/abc128-e}/MainNaive.hs (100%)
 rename {abc128-e => abc/abc128-e}/MainTree.hs (100%)
 rename {abc128-e => abc/abc128-e}/main.cpp (100%)
 rename {abc128-e => abc/abc128-e}/mklargeinput.lua (100%)
 rename {abc128-f => abc/abc128-f}/List.hs (100%)
 rename {abc128-f => abc/abc128-f}/Main.hs (100%)
 rename {abc129-a => abc/abc129-a}/Main.hs (100%)
 rename {abc129-b => abc/abc129-b}/Main.hs (100%)
 rename {abc129-c => abc/abc129-c}/Main.hs (100%)
 rename {abc129-d => abc/abc129-d}/Main.hs (100%)
 rename {abc129-e => abc/abc129-e}/Main.hs (100%)
 rename {abc129-f => abc/abc129-f}/Main.hs (100%)
 rename {abc130-a => abc/abc130-a}/Main.hs (100%)
 rename {abc130-b => abc/abc130-b}/Main.hs (100%)
 rename {abc130-c => abc/abc130-c}/Main.hs (100%)
 rename {abc130-d => abc/abc130-d}/Main.hs (100%)
 rename {abc130-e => abc/abc130-e}/Main.hs (100%)
 rename {abc130-e => abc/abc130-e}/Vec.hs (100%)
 rename {abc130-f => abc/abc130-f}/Main.hs (100%)
 rename {abc131-a => abc/abc131-a}/Main.hs (100%)
 rename {abc131-b => abc/abc131-b}/Main.hs (100%)
 rename {abc131-c => abc/abc131-c}/Main.hs (100%)
 rename {abc131-d => abc/abc131-d}/Main.hs (100%)
 rename {abc131-d => abc/abc131-d}/VectorSort.hs (100%)
 rename {abc131-e => abc/abc131-e}/Main.hs (100%)
 rename {abc131-f => abc/abc131-f}/Main.hs (100%)
 rename {abc132-a => abc/abc132-a}/Main.hs (100%)
 rename {abc132-b => abc/abc132-b}/Main.hs (100%)
 rename {abc132-c => abc/abc132-c}/Main.hs (100%)
 rename {abc132-d => abc/abc132-d}/Main.hs (100%)
 rename {abc132-e => abc/abc132-e}/IntMap.hs (100%)
 rename {abc132-e => abc/abc132-e}/Slow.hs (100%)
 rename {abc132-e => abc/abc132-e}/Vec.hs (100%)
 rename {abc133-a => abc/abc133-a}/Main.hs (100%)
 rename {abc133-b => abc/abc133-b}/Main.hs (100%)
 rename {abc133-c => abc/abc133-c}/Main.hs (100%)
 rename {abc133-d => abc/abc133-d}/Main.hs (100%)
 rename {abc133-e => abc/abc133-e}/Main.hs (100%)
 rename {abc133-f => abc/abc133-f}/Main.hs (100%)
 rename {abc133-f => abc/abc133-f}/Slow.hs (100%)
 rename {abc133-f => abc/abc133-f}/mkinput.lua (100%)
 rename {abc134-a => abc/abc134-a}/Main.hs (100%)
 rename {abc134-b => abc/abc134-b}/Main.hs (100%)
 rename {abc134-c => abc/abc134-c}/Main.hs (100%)
 rename {abc134-d => abc/abc134-d}/Main.hs (100%)
 rename {abc134-e => abc/abc134-e}/Main.hs (100%)

diff --git a/README.md b/README.md
index 853ae71..9f147b9 100644
--- a/README.md
+++ b/README.md
@@ -6,6 +6,10 @@ Haskellを主に使用。
 
 Haskellで競技プログラミングをやるテクニックは「[Haskellで競技プログラミングをやる](competitive-programming-with-haskell.md)」を参照。
 
+## AtCoder Beginner Contest
+
+<abc/README.md> を参照。
+
 ## Typical DP Contest
 
 <https://atcoder.jp/contests/tdpc>
@@ -56,14 +60,6 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 * [ ] Y - Grid 2
 * [ ] Z - Frog 3
 
-## AtCoder Beginner Contest 032
-
-<https://atcoder.jp/contests/abc032>
-
-解いた問題：
-
-* D ナップサック問題
-
 ## AtCoder Grand Contest 031
 
 <https://atcoder.jp/contests/agc031>
@@ -90,43 +86,6 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 * [ ] E - Modulo Pairing
 * [ ] F - One Third
 
-## AtCoder Beginner Contest 122 (2019-03-24)
-
-<https://atcoder.jp/contests/abc122>
-
-解いた問題：
-
-* [x] A - Double Helix
-* [x] B - ATCoder
-* [x] C - GeT AC
-* [x] D - We Like AGC
-    * Fast: 5項間漸化式を立てた（配列を使わない）。ただし想定解法と同じく O(n)
-    * Small: 想定解法
-    * MatPow, PolyDiv: O(log n) の解法
-    * 解説記事：[AtCoder Beginners Contest 122 の D の別解 (ABC122-D)](https://blog.miz-ar.info/2019/03/abc122-d/)
-
-## AtCoder Beginner Contest 121
-
-<https://atcoder.jp/contests/abc121>
-
-解いた問題：
-
-* [x] A - White Cells
-* [x] B - Can you solve this?
-* [x] C - Energy Drink Collector
-* [x] D - XOR World
-
-## AtCoder Beginner Contest 120
-
-<https://atcoder.jp/contests/abc120>
-
-解いた問題：
-
-* [x] A - Favorite Sound
-* [x] B - K-th Common Divisor
-* [x] C - Unification
-* [x] D - Decayed Bridges
-
 ## エクサウィザーズ 2019 (2019-03-30)
 
 <https://atcoder.jp/contests/exawizards2019>
@@ -148,17 +107,6 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 
 * A - Zero Sum Ranges
 
-## AtCoder Beginner Contest 124 (2019-04-13)
-
-<https://atcoder.jp/contests/abc124>
-
-解いた問題：
-
-* [x] A - Buttons
-* [x] B - Great Ocean View
-* [x] C - Coloring Colorfully
-* [x] D - Handstand
-
 ## Tenka1 Programmer Contest 2019 (2019-04-20)
 
 <https://atcoder.jp/contests/tenka1-2019>
@@ -170,17 +118,6 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 * [x] E - Polynomial Divisors
 * [ ] F - Banned X
 
-## AtCoder Beginner Contest 125 (2019-04-27)
-
-<https://atcoder.jp/contests/abc125>
-
-解いた問題：
-
-* [x] A - Biscuit Generator
-* [x] B - Resale
-* [x] C - GCD on Blackboard
-* [x] D - Flipping Signs
-
 ## エイシングプログラミングコンテスト2019
 
 <https://atcoder.jp/contests/aising2019>
@@ -207,69 +144,6 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 
 * A - 素数、コンテスト、素数
 
-## AtCoder Beginner Contest 086
-
-<https://atcoder.jp/contests/abc086/>
-
-解いた問題：
-
-* A - Product
-    * [AtCoderに登録したら解くべき精選過去問10問](https://qiita.com/drken/items/fd4e5e3630d0f5859067) 1問目
-* C - Traveling
-    * AtCoderに登録したら解くべき精選過去問10問 10問目
-
-## AtCoder Beginner Contest 081
-
-<https://atcoder.jp/contests/abc081/>
-
-解いた問題：
-
-* A - Placing Marbles
-    * AtCoderに登録したら解くべき精選過去問10問 2問目
-* B - Shift only
-    * AtCoderに登録したら解くべき精選過去問10問 3問目
-
-## AtCoder Beginner Contest 087
-
-<https://atcoder.jp/contests/abc087/>
-
-解いた問題：
-
-* B - Coins
-    * AtCoderに登録したら解くべき精選過去問10問 4問目
-
-## AtCoder Beginner Contest 083
-
-<https://atcoder.jp/contests/abc083/>
-
-解いた問題：
-
-* B - Some Sums
-    * AtCoderに登録したら解くべき精選過去問10問 5問目
-
-## AtCoder Beginner Contest 088
-
-<https://atcoder.jp/contests/abc088/>
-
-* B - Card Game for Two
-    * AtCoderに登録したら解くべき精選過去問10問 6問目
-
-## AtCoder Beginner Contest 085
-
-<https://atcoder.jp/contests/abc085/>
-
-* B - Kagami Mochi
-    * AtCoderに登録したら解くべき精選過去問10問 7問目
-* C - Otoshidama
-    * AtCoderに登録したら解くべき精選過去問10問 8問目
-
-## AtCoder Beginner Contest 049
-
-<https://atcoder.jp/contests/abc049/>
-
-* C - 白昼夢 / Daydream
-    * AtCoderに登録したら解くべき精選過去問10問 9問目
-
 ## diverta 2019 Programming Contest (2019-05-11)
 
 <https://atcoder.jp/contests/diverta2019>
@@ -283,45 +157,6 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 * [ ] E - XOR Partitioning
 * [ ] F - Edge Ordering
 
-## AtCoder Beginner Contest 126 (2019-05-19)
-
-<https://atcoder.jp/contests/abc126>
-
-解いた問題：
-
-* [x] A - Changing a Character
-* [x] B - YYMM or MMYY
-* [x] C - Dice and Coin
-* [x] D - Even Relation
-* [x] E - 1 or 2
-* [x] F - XOR Matching
-
-## AtCoder Beginner Contest 127
-
-<https://atcoder.jp/contests/abc127>
-
-解いた問題：
-
-* [x] A - Ferris Wheel
-* [x] B - Algae
-* [x] C - Prison
-* [x] D - Integer Cards
-* [ ] E - Cell Distance
-* [ ] F - Absolute Minima
-
-## AtCoder Beginner Contest 128 (2019-05-26)
-
-<https://atcoder.jp/contests/abc128>
-
-解いた問題：
-
-* [x] A - Apple Pie
-* [x] B - Guidebook
-* [x] C - Switches
-* [x] D - equeue
-* [x] E - Roadwork
-* [x] F - Frog Jump
-
 ## M-SOLUTIONS プロコンオープン (2019-06-01)
 
 <https://atcoder.jp/contests/m-solutions2019>
@@ -348,19 +183,6 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 * [ ] E - Complete Compress
 * [ ] F - RNG and XOR
 
-## AtCoder Beginner Contest 129 (2019-06-09)
-
-<https://atcoder.jp/contests/abc129>
-
-解いた問題：
-
-* [x] A - Airplane
-* [x] B - Balance
-* [x] C - Typical Stairs
-* [x] D - Lamp
-* [x] E - Sum Equals Xor
-* [x] F - Takahashi's Basics in Education and Learning
-
 ## diverta 2019 Programming Contest 2 (2019-06-15)
 
 <https://atcoder.jp/contests/diverta2019-2>
@@ -374,58 +196,6 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 * [ ] E - Balanced Piles
 * [ ] F - Diverta City
 
-## AtCoder Beginner Contest 130 (2019-06-16)
-
-<https://atcoder.jp/contests/abc130>
-
-解いた問題：
-
-* [x] A - Rounding
-* [x] B - Bounding
-* [x] C - Rectangle Cutting
-* [x] D - Enough Array
-* [x] E - Common Subsequence
-* [x] F - Minimum Bounding Box
-
-## AtCoder Beginner Contest 131 (2019-06-22)
-
-<https://atcoder.jp/contests/abc131>
-
-解いた問題：
-
-* [x] A - Security
-* [x] B - Bite Eating
-* [x] C - Anti-Division
-* [x] D - Megalomania
-* [x] E - Friendships
-* [x] F - Must Be Rectangular!
-
-## AtCoder Beginner Contest 132 (2019-06-29)
-
-<https://atcoder.jp/contests/abc132>
-
-解いた問題：
-
-* [x] A - Fifty-Fifty
-* [x] B - Ordinary Number
-* [x] C - Divide the Problems
-* [x] D - Blue and Red Balls
-* [x] E - Hopscotch Addict
-* [ ] F - Small Products
-
-## AtCoder Beginner Contest 133 (2019-07-07)
-
-<https://atcoder.jp/contests/abc133>
-
-解いた問題：
-
-* [x] A - T or T
-* [x] B - Good Distance
-* [x] C - Remainder Minimization 2019
-* [x] D - Rain Flows into Dams
-* [x] E - Virus Tree 2
-* [x] F - Colorful Tree
-
 ## AtCoder Grand Contest 035 (2019-07-14)
 
 <https://atcoder.jp/contests/agc035>
@@ -437,17 +207,6 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 * [ ] E - Develop
 * [ ] F - Two Histograms
 
-## AtCoder Beginner Contest 134 (2019-07-20)
-
-<https://atcoder.jp/contests/abc134>
-
-* [x] A - Dodecagon
-* [x] B - Golden Apple
-* [x] C - Exception Handling
-* [x] D - Preparing Boxes
-* [x] E - Sequence Decomposing
-* [ ] F - Permutation Oddness
-
 ## AtCoder Grand Contest 036 (2019-07-21)
 
 <https://atcoder.jp/contests/agc036/tasks>
diff --git a/abc/README.md b/abc/README.md
new file mode 100644
index 0000000..250779a
--- /dev/null
+++ b/abc/README.md
@@ -0,0 +1,246 @@
+# AtCoder Beginner Contestのオレオレ解答集 by @mod_poppo
+
+## AtCoder Beginner Contest 032
+
+<https://atcoder.jp/contests/abc032>
+
+解いた問題：
+
+* D ナップサック問題
+
+## AtCoder Beginner Contest 122 (2019-03-24)
+
+<https://atcoder.jp/contests/abc122>
+
+解いた問題：
+
+* [x] A - Double Helix
+* [x] B - ATCoder
+* [x] C - GeT AC
+* [x] D - We Like AGC
+    * Fast: 5項間漸化式を立てた（配列を使わない）。ただし想定解法と同じく O(n)
+    * Small: 想定解法
+    * MatPow, PolyDiv: O(log n) の解法
+    * 解説記事：[AtCoder Beginners Contest 122 の D の別解 (ABC122-D)](https://blog.miz-ar.info/2019/03/abc122-d/)
+
+## AtCoder Beginner Contest 121
+
+<https://atcoder.jp/contests/abc121>
+
+解いた問題：
+
+* [x] A - White Cells
+* [x] B - Can you solve this?
+* [x] C - Energy Drink Collector
+* [x] D - XOR World
+
+## AtCoder Beginner Contest 120
+
+<https://atcoder.jp/contests/abc120>
+
+解いた問題：
+
+* [x] A - Favorite Sound
+* [x] B - K-th Common Divisor
+* [x] C - Unification
+* [x] D - Decayed Bridges
+
+## AtCoder Beginner Contest 124 (2019-04-13)
+
+<https://atcoder.jp/contests/abc124>
+
+解いた問題：
+
+* [x] A - Buttons
+* [x] B - Great Ocean View
+* [x] C - Coloring Colorfully
+* [x] D - Handstand
+
+## AtCoder Beginner Contest 125 (2019-04-27)
+
+<https://atcoder.jp/contests/abc125>
+
+解いた問題：
+
+* [x] A - Biscuit Generator
+* [x] B - Resale
+* [x] C - GCD on Blackboard
+* [x] D - Flipping Signs
+
+## AtCoder Beginner Contest 086
+
+<https://atcoder.jp/contests/abc086/>
+
+解いた問題：
+
+* A - Product
+    * [AtCoderに登録したら解くべき精選過去問10問](https://qiita.com/drken/items/fd4e5e3630d0f5859067) 1問目
+* C - Traveling
+    * AtCoderに登録したら解くべき精選過去問10問 10問目
+
+## AtCoder Beginner Contest 081
+
+<https://atcoder.jp/contests/abc081/>
+
+解いた問題：
+
+* A - Placing Marbles
+    * AtCoderに登録したら解くべき精選過去問10問 2問目
+* B - Shift only
+    * AtCoderに登録したら解くべき精選過去問10問 3問目
+
+## AtCoder Beginner Contest 087
+
+<https://atcoder.jp/contests/abc087/>
+
+解いた問題：
+
+* B - Coins
+    * AtCoderに登録したら解くべき精選過去問10問 4問目
+
+## AtCoder Beginner Contest 083
+
+<https://atcoder.jp/contests/abc083/>
+
+解いた問題：
+
+* B - Some Sums
+    * AtCoderに登録したら解くべき精選過去問10問 5問目
+
+## AtCoder Beginner Contest 088
+
+<https://atcoder.jp/contests/abc088/>
+
+* B - Card Game for Two
+    * AtCoderに登録したら解くべき精選過去問10問 6問目
+
+## AtCoder Beginner Contest 085
+
+<https://atcoder.jp/contests/abc085/>
+
+* B - Kagami Mochi
+    * AtCoderに登録したら解くべき精選過去問10問 7問目
+* C - Otoshidama
+    * AtCoderに登録したら解くべき精選過去問10問 8問目
+
+## AtCoder Beginner Contest 049
+
+<https://atcoder.jp/contests/abc049/>
+
+* C - 白昼夢 / Daydream
+    * AtCoderに登録したら解くべき精選過去問10問 9問目
+
+## AtCoder Beginner Contest 126 (2019-05-19)
+
+<https://atcoder.jp/contests/abc126>
+
+解いた問題：
+
+* [x] A - Changing a Character
+* [x] B - YYMM or MMYY
+* [x] C - Dice and Coin
+* [x] D - Even Relation
+* [x] E - 1 or 2
+* [x] F - XOR Matching
+
+## AtCoder Beginner Contest 127
+
+<https://atcoder.jp/contests/abc127>
+
+解いた問題：
+
+* [x] A - Ferris Wheel
+* [x] B - Algae
+* [x] C - Prison
+* [x] D - Integer Cards
+* [ ] E - Cell Distance
+* [ ] F - Absolute Minima
+
+## AtCoder Beginner Contest 128 (2019-05-26)
+
+<https://atcoder.jp/contests/abc128>
+
+解いた問題：
+
+* [x] A - Apple Pie
+* [x] B - Guidebook
+* [x] C - Switches
+* [x] D - equeue
+* [x] E - Roadwork
+* [x] F - Frog Jump
+
+## AtCoder Beginner Contest 129 (2019-06-09)
+
+<https://atcoder.jp/contests/abc129>
+
+解いた問題：
+
+* [x] A - Airplane
+* [x] B - Balance
+* [x] C - Typical Stairs
+* [x] D - Lamp
+* [x] E - Sum Equals Xor
+* [x] F - Takahashi's Basics in Education and Learning
+
+## AtCoder Beginner Contest 130 (2019-06-16)
+
+<https://atcoder.jp/contests/abc130>
+
+解いた問題：
+
+* [x] A - Rounding
+* [x] B - Bounding
+* [x] C - Rectangle Cutting
+* [x] D - Enough Array
+* [x] E - Common Subsequence
+* [x] F - Minimum Bounding Box
+
+## AtCoder Beginner Contest 131 (2019-06-22)
+
+<https://atcoder.jp/contests/abc131>
+
+解いた問題：
+
+* [x] A - Security
+* [x] B - Bite Eating
+* [x] C - Anti-Division
+* [x] D - Megalomania
+* [x] E - Friendships
+* [x] F - Must Be Rectangular!
+
+## AtCoder Beginner Contest 132 (2019-06-29)
+
+<https://atcoder.jp/contests/abc132>
+
+解いた問題：
+
+* [x] A - Fifty-Fifty
+* [x] B - Ordinary Number
+* [x] C - Divide the Problems
+* [x] D - Blue and Red Balls
+* [x] E - Hopscotch Addict
+* [ ] F - Small Products
+
+## AtCoder Beginner Contest 133 (2019-07-07)
+
+<https://atcoder.jp/contests/abc133>
+
+解いた問題：
+
+* [x] A - T or T
+* [x] B - Good Distance
+* [x] C - Remainder Minimization 2019
+* [x] D - Rain Flows into Dams
+* [x] E - Virus Tree 2
+* [x] F - Colorful Tree
+
+## AtCoder Beginner Contest 134 (2019-07-20)
+
+<https://atcoder.jp/contests/abc134>
+
+* [x] A - Dodecagon
+* [x] B - Golden Apple
+* [x] C - Exception Handling
+* [x] D - Preparing Boxes
+* [x] E - Sequence Decomposing
+* [ ] F - Permutation Oddness
diff --git a/abc120-a/Main.hs b/abc/abc120-a/Main.hs
similarity index 100%
rename from abc120-a/Main.hs
rename to abc/abc120-a/Main.hs
diff --git a/abc120-b/Main.hs b/abc/abc120-b/Main.hs
similarity index 100%
rename from abc120-b/Main.hs
rename to abc/abc120-b/Main.hs
diff --git a/abc120-c/Main.hs b/abc/abc120-c/Main.hs
similarity index 100%
rename from abc120-c/Main.hs
rename to abc/abc120-c/Main.hs
diff --git a/abc120-d/Main.hs b/abc/abc120-d/Main.hs
similarity index 100%
rename from abc120-d/Main.hs
rename to abc/abc120-d/Main.hs
diff --git a/abc121-a/Main.hs b/abc/abc121-a/Main.hs
similarity index 100%
rename from abc121-a/Main.hs
rename to abc/abc121-a/Main.hs
diff --git a/abc121-b/Main.hs b/abc/abc121-b/Main.hs
similarity index 100%
rename from abc121-b/Main.hs
rename to abc/abc121-b/Main.hs
diff --git a/abc121-c/Main.hs b/abc/abc121-c/Main.hs
similarity index 100%
rename from abc121-c/Main.hs
rename to abc/abc121-c/Main.hs
diff --git a/abc121-d/Main.hs b/abc/abc121-d/Main.hs
similarity index 100%
rename from abc121-d/Main.hs
rename to abc/abc121-d/Main.hs
diff --git a/abc122-a/Main.hs b/abc/abc122-a/Main.hs
similarity index 100%
rename from abc122-a/Main.hs
rename to abc/abc122-a/Main.hs
diff --git a/abc122-b/Main.hs b/abc/abc122-b/Main.hs
similarity index 100%
rename from abc122-b/Main.hs
rename to abc/abc122-b/Main.hs
diff --git a/abc122-c/Main.hs b/abc/abc122-c/Main.hs
similarity index 100%
rename from abc122-c/Main.hs
rename to abc/abc122-c/Main.hs
diff --git a/abc122-d/Fast.hs b/abc/abc122-d/Fast.hs
similarity index 100%
rename from abc122-d/Fast.hs
rename to abc/abc122-d/Fast.hs
diff --git a/abc122-d/Main.hs b/abc/abc122-d/Main.hs
similarity index 100%
rename from abc122-d/Main.hs
rename to abc/abc122-d/Main.hs
diff --git a/abc122-d/MatPow.hs b/abc/abc122-d/MatPow.hs
similarity index 100%
rename from abc122-d/MatPow.hs
rename to abc/abc122-d/MatPow.hs
diff --git a/abc122-d/PolyDiv.hs b/abc/abc122-d/PolyDiv.hs
similarity index 100%
rename from abc122-d/PolyDiv.hs
rename to abc/abc122-d/PolyDiv.hs
diff --git a/abc122-d/Small.hs b/abc/abc122-d/Small.hs
similarity index 100%
rename from abc122-d/Small.hs
rename to abc/abc122-d/Small.hs
diff --git a/abc123-a/Main.hs b/abc/abc123-a/Main.hs
similarity index 100%
rename from abc123-a/Main.hs
rename to abc/abc123-a/Main.hs
diff --git a/abc123-b/Main.hs b/abc/abc123-b/Main.hs
similarity index 100%
rename from abc123-b/Main.hs
rename to abc/abc123-b/Main.hs
diff --git a/abc123-c/Main.hs b/abc/abc123-c/Main.hs
similarity index 100%
rename from abc123-c/Main.hs
rename to abc/abc123-c/Main.hs
diff --git a/abc123-d/Main.hs b/abc/abc123-d/Main.hs
similarity index 100%
rename from abc123-d/Main.hs
rename to abc/abc123-d/Main.hs
diff --git a/abc123-d/mkrandinput.lua b/abc/abc123-d/mkrandinput.lua
similarity index 100%
rename from abc123-d/mkrandinput.lua
rename to abc/abc123-d/mkrandinput.lua
diff --git a/abc124-a/Main.hs b/abc/abc124-a/Main.hs
similarity index 100%
rename from abc124-a/Main.hs
rename to abc/abc124-a/Main.hs
diff --git a/abc124-b/Main.hs b/abc/abc124-b/Main.hs
similarity index 100%
rename from abc124-b/Main.hs
rename to abc/abc124-b/Main.hs
diff --git a/abc124-c/Main.hs b/abc/abc124-c/Main.hs
similarity index 100%
rename from abc124-c/Main.hs
rename to abc/abc124-c/Main.hs
diff --git a/abc124-d/Main.hs b/abc/abc124-d/Main.hs
similarity index 100%
rename from abc124-d/Main.hs
rename to abc/abc124-d/Main.hs
diff --git a/abc125-a/Main.hs b/abc/abc125-a/Main.hs
similarity index 100%
rename from abc125-a/Main.hs
rename to abc/abc125-a/Main.hs
diff --git a/abc125-b/Main.hs b/abc/abc125-b/Main.hs
similarity index 100%
rename from abc125-b/Main.hs
rename to abc/abc125-b/Main.hs
diff --git a/abc125-c/Main.hs b/abc/abc125-c/Main.hs
similarity index 100%
rename from abc125-c/Main.hs
rename to abc/abc125-c/Main.hs
diff --git a/abc125-d/Main.hs b/abc/abc125-d/Main.hs
similarity index 100%
rename from abc125-d/Main.hs
rename to abc/abc125-d/Main.hs
diff --git a/abc126-a/Main.hs b/abc/abc126-a/Main.hs
similarity index 100%
rename from abc126-a/Main.hs
rename to abc/abc126-a/Main.hs
diff --git a/abc126-b/Main.hs b/abc/abc126-b/Main.hs
similarity index 100%
rename from abc126-b/Main.hs
rename to abc/abc126-b/Main.hs
diff --git a/abc126-c/Main.hs b/abc/abc126-c/Main.hs
similarity index 100%
rename from abc126-c/Main.hs
rename to abc/abc126-c/Main.hs
diff --git a/abc126-d/Main.hs b/abc/abc126-d/Main.hs
similarity index 100%
rename from abc126-d/Main.hs
rename to abc/abc126-d/Main.hs
diff --git a/abc126-e/Main.hs b/abc/abc126-e/Main.hs
similarity index 100%
rename from abc126-e/Main.hs
rename to abc/abc126-e/Main.hs
diff --git a/abc126-f/Main.hs b/abc/abc126-f/Main.hs
similarity index 100%
rename from abc126-f/Main.hs
rename to abc/abc126-f/Main.hs
diff --git a/abc127-a/Main.hs b/abc/abc127-a/Main.hs
similarity index 100%
rename from abc127-a/Main.hs
rename to abc/abc127-a/Main.hs
diff --git a/abc127-b/Main.hs b/abc/abc127-b/Main.hs
similarity index 100%
rename from abc127-b/Main.hs
rename to abc/abc127-b/Main.hs
diff --git a/abc127-c/Main.hs b/abc/abc127-c/Main.hs
similarity index 100%
rename from abc127-c/Main.hs
rename to abc/abc127-c/Main.hs
diff --git a/abc127-d/Main.hs b/abc/abc127-d/Main.hs
similarity index 100%
rename from abc127-d/Main.hs
rename to abc/abc127-d/Main.hs
diff --git a/abc128-a/Main.hs b/abc/abc128-a/Main.hs
similarity index 100%
rename from abc128-a/Main.hs
rename to abc/abc128-a/Main.hs
diff --git a/abc128-b/Main.hs b/abc/abc128-b/Main.hs
similarity index 100%
rename from abc128-b/Main.hs
rename to abc/abc128-b/Main.hs
diff --git a/abc128-c/Main.hs b/abc/abc128-c/Main.hs
similarity index 100%
rename from abc128-c/Main.hs
rename to abc/abc128-c/Main.hs
diff --git a/abc128-d/Main.hs b/abc/abc128-d/Main.hs
similarity index 100%
rename from abc128-d/Main.hs
rename to abc/abc128-d/Main.hs
diff --git a/abc128-e/Main.hs b/abc/abc128-e/Main.hs
similarity index 100%
rename from abc128-e/Main.hs
rename to abc/abc128-e/Main.hs
diff --git a/abc128-e/MainNaive.hs b/abc/abc128-e/MainNaive.hs
similarity index 100%
rename from abc128-e/MainNaive.hs
rename to abc/abc128-e/MainNaive.hs
diff --git a/abc128-e/MainTree.hs b/abc/abc128-e/MainTree.hs
similarity index 100%
rename from abc128-e/MainTree.hs
rename to abc/abc128-e/MainTree.hs
diff --git a/abc128-e/main.cpp b/abc/abc128-e/main.cpp
similarity index 100%
rename from abc128-e/main.cpp
rename to abc/abc128-e/main.cpp
diff --git a/abc128-e/mklargeinput.lua b/abc/abc128-e/mklargeinput.lua
similarity index 100%
rename from abc128-e/mklargeinput.lua
rename to abc/abc128-e/mklargeinput.lua
diff --git a/abc128-f/List.hs b/abc/abc128-f/List.hs
similarity index 100%
rename from abc128-f/List.hs
rename to abc/abc128-f/List.hs
diff --git a/abc128-f/Main.hs b/abc/abc128-f/Main.hs
similarity index 100%
rename from abc128-f/Main.hs
rename to abc/abc128-f/Main.hs
diff --git a/abc129-a/Main.hs b/abc/abc129-a/Main.hs
similarity index 100%
rename from abc129-a/Main.hs
rename to abc/abc129-a/Main.hs
diff --git a/abc129-b/Main.hs b/abc/abc129-b/Main.hs
similarity index 100%
rename from abc129-b/Main.hs
rename to abc/abc129-b/Main.hs
diff --git a/abc129-c/Main.hs b/abc/abc129-c/Main.hs
similarity index 100%
rename from abc129-c/Main.hs
rename to abc/abc129-c/Main.hs
diff --git a/abc129-d/Main.hs b/abc/abc129-d/Main.hs
similarity index 100%
rename from abc129-d/Main.hs
rename to abc/abc129-d/Main.hs
diff --git a/abc129-e/Main.hs b/abc/abc129-e/Main.hs
similarity index 100%
rename from abc129-e/Main.hs
rename to abc/abc129-e/Main.hs
diff --git a/abc129-f/Main.hs b/abc/abc129-f/Main.hs
similarity index 100%
rename from abc129-f/Main.hs
rename to abc/abc129-f/Main.hs
diff --git a/abc130-a/Main.hs b/abc/abc130-a/Main.hs
similarity index 100%
rename from abc130-a/Main.hs
rename to abc/abc130-a/Main.hs
diff --git a/abc130-b/Main.hs b/abc/abc130-b/Main.hs
similarity index 100%
rename from abc130-b/Main.hs
rename to abc/abc130-b/Main.hs
diff --git a/abc130-c/Main.hs b/abc/abc130-c/Main.hs
similarity index 100%
rename from abc130-c/Main.hs
rename to abc/abc130-c/Main.hs
diff --git a/abc130-d/Main.hs b/abc/abc130-d/Main.hs
similarity index 100%
rename from abc130-d/Main.hs
rename to abc/abc130-d/Main.hs
diff --git a/abc130-e/Main.hs b/abc/abc130-e/Main.hs
similarity index 100%
rename from abc130-e/Main.hs
rename to abc/abc130-e/Main.hs
diff --git a/abc130-e/Vec.hs b/abc/abc130-e/Vec.hs
similarity index 100%
rename from abc130-e/Vec.hs
rename to abc/abc130-e/Vec.hs
diff --git a/abc130-f/Main.hs b/abc/abc130-f/Main.hs
similarity index 100%
rename from abc130-f/Main.hs
rename to abc/abc130-f/Main.hs
diff --git a/abc131-a/Main.hs b/abc/abc131-a/Main.hs
similarity index 100%
rename from abc131-a/Main.hs
rename to abc/abc131-a/Main.hs
diff --git a/abc131-b/Main.hs b/abc/abc131-b/Main.hs
similarity index 100%
rename from abc131-b/Main.hs
rename to abc/abc131-b/Main.hs
diff --git a/abc131-c/Main.hs b/abc/abc131-c/Main.hs
similarity index 100%
rename from abc131-c/Main.hs
rename to abc/abc131-c/Main.hs
diff --git a/abc131-d/Main.hs b/abc/abc131-d/Main.hs
similarity index 100%
rename from abc131-d/Main.hs
rename to abc/abc131-d/Main.hs
diff --git a/abc131-d/VectorSort.hs b/abc/abc131-d/VectorSort.hs
similarity index 100%
rename from abc131-d/VectorSort.hs
rename to abc/abc131-d/VectorSort.hs
diff --git a/abc131-e/Main.hs b/abc/abc131-e/Main.hs
similarity index 100%
rename from abc131-e/Main.hs
rename to abc/abc131-e/Main.hs
diff --git a/abc131-f/Main.hs b/abc/abc131-f/Main.hs
similarity index 100%
rename from abc131-f/Main.hs
rename to abc/abc131-f/Main.hs
diff --git a/abc132-a/Main.hs b/abc/abc132-a/Main.hs
similarity index 100%
rename from abc132-a/Main.hs
rename to abc/abc132-a/Main.hs
diff --git a/abc132-b/Main.hs b/abc/abc132-b/Main.hs
similarity index 100%
rename from abc132-b/Main.hs
rename to abc/abc132-b/Main.hs
diff --git a/abc132-c/Main.hs b/abc/abc132-c/Main.hs
similarity index 100%
rename from abc132-c/Main.hs
rename to abc/abc132-c/Main.hs
diff --git a/abc132-d/Main.hs b/abc/abc132-d/Main.hs
similarity index 100%
rename from abc132-d/Main.hs
rename to abc/abc132-d/Main.hs
diff --git a/abc132-e/IntMap.hs b/abc/abc132-e/IntMap.hs
similarity index 100%
rename from abc132-e/IntMap.hs
rename to abc/abc132-e/IntMap.hs
diff --git a/abc132-e/Slow.hs b/abc/abc132-e/Slow.hs
similarity index 100%
rename from abc132-e/Slow.hs
rename to abc/abc132-e/Slow.hs
diff --git a/abc132-e/Vec.hs b/abc/abc132-e/Vec.hs
similarity index 100%
rename from abc132-e/Vec.hs
rename to abc/abc132-e/Vec.hs
diff --git a/abc133-a/Main.hs b/abc/abc133-a/Main.hs
similarity index 100%
rename from abc133-a/Main.hs
rename to abc/abc133-a/Main.hs
diff --git a/abc133-b/Main.hs b/abc/abc133-b/Main.hs
similarity index 100%
rename from abc133-b/Main.hs
rename to abc/abc133-b/Main.hs
diff --git a/abc133-c/Main.hs b/abc/abc133-c/Main.hs
similarity index 100%
rename from abc133-c/Main.hs
rename to abc/abc133-c/Main.hs
diff --git a/abc133-d/Main.hs b/abc/abc133-d/Main.hs
similarity index 100%
rename from abc133-d/Main.hs
rename to abc/abc133-d/Main.hs
diff --git a/abc133-e/Main.hs b/abc/abc133-e/Main.hs
similarity index 100%
rename from abc133-e/Main.hs
rename to abc/abc133-e/Main.hs
diff --git a/abc133-f/Main.hs b/abc/abc133-f/Main.hs
similarity index 100%
rename from abc133-f/Main.hs
rename to abc/abc133-f/Main.hs
diff --git a/abc133-f/Slow.hs b/abc/abc133-f/Slow.hs
similarity index 100%
rename from abc133-f/Slow.hs
rename to abc/abc133-f/Slow.hs
diff --git a/abc133-f/mkinput.lua b/abc/abc133-f/mkinput.lua
similarity index 100%
rename from abc133-f/mkinput.lua
rename to abc/abc133-f/mkinput.lua
diff --git a/abc134-a/Main.hs b/abc/abc134-a/Main.hs
similarity index 100%
rename from abc134-a/Main.hs
rename to abc/abc134-a/Main.hs
diff --git a/abc134-b/Main.hs b/abc/abc134-b/Main.hs
similarity index 100%
rename from abc134-b/Main.hs
rename to abc/abc134-b/Main.hs
diff --git a/abc134-c/Main.hs b/abc/abc134-c/Main.hs
similarity index 100%
rename from abc134-c/Main.hs
rename to abc/abc134-c/Main.hs
diff --git a/abc134-d/Main.hs b/abc/abc134-d/Main.hs
similarity index 100%
rename from abc134-d/Main.hs
rename to abc/abc134-d/Main.hs
diff --git a/abc134-e/Main.hs b/abc/abc134-e/Main.hs
similarity index 100%
rename from abc134-e/Main.hs
rename to abc/abc134-e/Main.hs

From e2fd3594154203c345b97b8575e72277dfb4786e Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Mon, 22 Jul 2019 17:07:26 +0900
Subject: [PATCH 063/148] AGC036-C

---
 agc036-c/Main.hs | 113 +++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 113 insertions(+)
 create mode 100644 agc036-c/Main.hs

diff --git a/agc036-c/Main.hs b/agc036-c/Main.hs
new file mode 100644
index 0000000..3fbf862
--- /dev/null
+++ b/agc036-c/Main.hs
@@ -0,0 +1,113 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+import Data.Char (isSpace)
+import Data.Int (Int64)
+import Data.List (unfoldr)
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+import Data.Coerce
+import qualified Data.Vector.Generic
+import qualified Data.Vector.Generic.Mutable
+
+solve :: Int -> Int -> N
+solve !n !m = let mk = (3*m) `quot` 2
+                  ts = U.scanl' (+) 0 $ U.map (\l -> binom (l+n-2) (n-2)) $ U.enumFromN 0 (mk-m)
+              in sum [ binom (k+n-1) (n-1) * binom n (3*m-2*k) - fromIntegral n * (binom n (3*m-2*k) * ts U.! (k-m) + binom (k-m+n-2) (n-2) * binom (n-1) (3*m-2*k-1))
+                     | k <- [m..mk]
+                     , let t | k-m >= 0 = ts U.! (k-m)
+                             | otherwise = 0
+                     ]
+
+main = do
+  [n,m] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  print $ solve n m
+
+factV :: U.Vector N
+factV = U.scanl' (*) 1 (U.enumFromN 1 (25*10^5))
+
+binom :: Int -> Int -> N
+binom n k | k < 0 || k > n = 0
+          | otherwise = factV U.! n / (factV U.! (n-k) * factV U.! k)
+
+--
+-- Modular Arithmetic
+--
+
+modulo :: Int64
+modulo = 998244353
+addMod, subMod, mulMod :: Int64 -> Int64 -> Int64
+addMod !x !y | x + y >= modulo = x + y - modulo
+             | otherwise = x + y
+subMod !x !y | x >= y = x - y
+             | otherwise = x - y + modulo
+mulMod !x !y = (x * y) `rem` modulo
+
+newtype N = N { unwrapN :: Int64 } deriving (Eq)
+instance Show N where
+  show (N x) = show x
+instance Num N where
+  (+) = coerce addMod
+  (-) = coerce subMod
+  (*) = coerce mulMod
+  fromInteger n = N (fromInteger (n `mod` fromIntegral modulo))
+  abs = undefined; signum = undefined
+
+{-# RULES
+"^9/Int" forall x. x ^ (9 :: Int) = let u = x; v = u * u * u in v * v * v
+"^9/Integer" forall x. x ^ (9 :: Integer) = let u = x; v = u * u * u in v * v * v
+ #-}
+
+---
+
+exEuclid :: (Eq a, Integral a) => a -> a -> (a, a, a)
+exEuclid !f !g = loop 1 0 0 1 f g
+  where loop !u0 !u1 !v0 !v1 !f 0 = (f, u0, v0)
+        loop !u0 !u1 !v0 !v1 !f g =
+          case divMod f g of
+            (q,r) -> loop u1 (u0 - q * u1) v1 (v0 - q * v1) g r
+
+recipM :: Int64 -> Int64
+recipM !x = case exEuclid x modulo of
+             (1,a,_) -> a `mod` modulo
+             (-1,a,_) -> (-a) `mod` modulo
+divM :: Int64 -> Int64 -> Int64
+divM !x !y = x `mulMod` recipM y
+
+instance Fractional N where
+  (/) = coerce divM
+  recip = coerce recipM
+  fromRational = undefined
+
+---
+
+newtype instance UM.MVector s N = MV_N (UM.MVector s Int64)
+newtype instance U.Vector N = V_N (U.Vector Int64)
+
+instance Data.Vector.Generic.Mutable.MVector UM.MVector N where -- needs MultiParamTypeClasses here
+  basicLength (MV_N mv) = Data.Vector.Generic.Mutable.basicLength mv
+  basicUnsafeSlice i l (MV_N mv) = MV_N (Data.Vector.Generic.Mutable.basicUnsafeSlice i l mv)
+  basicOverlaps (MV_N mv) (MV_N mv') = Data.Vector.Generic.Mutable.basicOverlaps mv mv'
+  basicUnsafeNew l = MV_N <$> Data.Vector.Generic.Mutable.basicUnsafeNew l
+  basicInitialize (MV_N mv) = Data.Vector.Generic.Mutable.basicInitialize mv
+  basicUnsafeReplicate i x = MV_N <$> Data.Vector.Generic.Mutable.basicUnsafeReplicate i (coerce x)
+  basicUnsafeRead (MV_N mv) i = coerce <$> Data.Vector.Generic.Mutable.basicUnsafeRead mv i
+  basicUnsafeWrite (MV_N mv) i x = Data.Vector.Generic.Mutable.basicUnsafeWrite mv i (coerce x)
+  basicClear (MV_N mv) = Data.Vector.Generic.Mutable.basicClear mv
+  basicSet (MV_N mv) x = Data.Vector.Generic.Mutable.basicSet mv (coerce x)
+  basicUnsafeCopy (MV_N mv) (MV_N mv') = Data.Vector.Generic.Mutable.basicUnsafeCopy mv mv'
+  basicUnsafeMove (MV_N mv) (MV_N mv') = Data.Vector.Generic.Mutable.basicUnsafeMove mv mv'
+  basicUnsafeGrow (MV_N mv) n = MV_N <$> Data.Vector.Generic.Mutable.basicUnsafeGrow mv n
+
+instance Data.Vector.Generic.Vector U.Vector N where -- needs MultiParamTypeClasses here
+  basicUnsafeFreeze (MV_N mv) = V_N <$> Data.Vector.Generic.basicUnsafeFreeze mv
+  basicUnsafeThaw (V_N v) = MV_N <$> Data.Vector.Generic.basicUnsafeThaw v
+  basicLength (V_N v) = Data.Vector.Generic.basicLength v
+  basicUnsafeSlice i l (V_N v) = V_N (Data.Vector.Generic.basicUnsafeSlice i l v)
+  basicUnsafeIndexM (V_N v) i = coerce <$> Data.Vector.Generic.basicUnsafeIndexM v i
+  basicUnsafeCopy (MV_N mv) (V_N v) = Data.Vector.Generic.basicUnsafeCopy mv v
+  elemseq (V_N v) x y = Data.Vector.Generic.elemseq v (coerce x) y
+
+instance U.Unbox N

From 692d11a7b96c4aae835c3392c2573c4647e7769e Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Mon, 22 Jul 2019 17:09:48 +0900
Subject: [PATCH 064/148] Move ABC (2)

---
 README.md                                  | 2 +-
 {abc032-d => abc/abc032-d}/Main.hs         | 0
 {abc032-d => abc/abc032-d}/mkrandinput.lua | 0
 {abc049-a => abc/abc049-a}/Main.hs         | 0
 {abc081-a => abc/abc081-a}/Main.hs         | 0
 {abc081-b => abc/abc081-b}/Main.hs         | 0
 {abc083-b => abc/abc083-b}/Main.hs         | 0
 {abc085-b => abc/abc085-b}/Main.hs         | 0
 {abc085-c => abc/abc085-c}/Main.hs         | 0
 {abc086-a => abc/abc086-a}/Main.hs         | 0
 {abc086-c => abc/abc086-c}/Main.hs         | 0
 {abc087-b => abc/abc087-b}/Main.hs         | 0
 {abc088-b => abc/abc088-b}/Main.hs         | 0
 13 files changed, 1 insertion(+), 1 deletion(-)
 rename {abc032-d => abc/abc032-d}/Main.hs (100%)
 rename {abc032-d => abc/abc032-d}/mkrandinput.lua (100%)
 rename {abc049-a => abc/abc049-a}/Main.hs (100%)
 rename {abc081-a => abc/abc081-a}/Main.hs (100%)
 rename {abc081-b => abc/abc081-b}/Main.hs (100%)
 rename {abc083-b => abc/abc083-b}/Main.hs (100%)
 rename {abc085-b => abc/abc085-b}/Main.hs (100%)
 rename {abc085-c => abc/abc085-c}/Main.hs (100%)
 rename {abc086-a => abc/abc086-a}/Main.hs (100%)
 rename {abc086-c => abc/abc086-c}/Main.hs (100%)
 rename {abc087-b => abc/abc087-b}/Main.hs (100%)
 rename {abc088-b => abc/abc088-b}/Main.hs (100%)

diff --git a/README.md b/README.md
index 9f147b9..b9166da 100644
--- a/README.md
+++ b/README.md
@@ -8,7 +8,7 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 
 ## AtCoder Beginner Contest
 
-<abc/README.md> を参照。
+[abc/README.md](abc/README.md) を参照。
 
 ## Typical DP Contest
 
diff --git a/abc032-d/Main.hs b/abc/abc032-d/Main.hs
similarity index 100%
rename from abc032-d/Main.hs
rename to abc/abc032-d/Main.hs
diff --git a/abc032-d/mkrandinput.lua b/abc/abc032-d/mkrandinput.lua
similarity index 100%
rename from abc032-d/mkrandinput.lua
rename to abc/abc032-d/mkrandinput.lua
diff --git a/abc049-a/Main.hs b/abc/abc049-a/Main.hs
similarity index 100%
rename from abc049-a/Main.hs
rename to abc/abc049-a/Main.hs
diff --git a/abc081-a/Main.hs b/abc/abc081-a/Main.hs
similarity index 100%
rename from abc081-a/Main.hs
rename to abc/abc081-a/Main.hs
diff --git a/abc081-b/Main.hs b/abc/abc081-b/Main.hs
similarity index 100%
rename from abc081-b/Main.hs
rename to abc/abc081-b/Main.hs
diff --git a/abc083-b/Main.hs b/abc/abc083-b/Main.hs
similarity index 100%
rename from abc083-b/Main.hs
rename to abc/abc083-b/Main.hs
diff --git a/abc085-b/Main.hs b/abc/abc085-b/Main.hs
similarity index 100%
rename from abc085-b/Main.hs
rename to abc/abc085-b/Main.hs
diff --git a/abc085-c/Main.hs b/abc/abc085-c/Main.hs
similarity index 100%
rename from abc085-c/Main.hs
rename to abc/abc085-c/Main.hs
diff --git a/abc086-a/Main.hs b/abc/abc086-a/Main.hs
similarity index 100%
rename from abc086-a/Main.hs
rename to abc/abc086-a/Main.hs
diff --git a/abc086-c/Main.hs b/abc/abc086-c/Main.hs
similarity index 100%
rename from abc086-c/Main.hs
rename to abc/abc086-c/Main.hs
diff --git a/abc087-b/Main.hs b/abc/abc087-b/Main.hs
similarity index 100%
rename from abc087-b/Main.hs
rename to abc/abc087-b/Main.hs
diff --git a/abc088-b/Main.hs b/abc/abc088-b/Main.hs
similarity index 100%
rename from abc088-b/Main.hs
rename to abc/abc088-b/Main.hs

From 43d8ecc6f9197d703cb215e33a44fb629b190af7 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Mon, 22 Jul 2019 08:10:08 +0000
Subject: [PATCH 065/148] Clean package.yaml

---
 package.yaml | 337 +--------------------------------------------------
 1 file changed, 5 insertions(+), 332 deletions(-)

diff --git a/package.yaml b/package.yaml
index c3b36e2..1cdaab7 100644
--- a/package.yaml
+++ b/package.yaml
@@ -27,6 +27,7 @@ dependencies:
 - mtl
 - bytestring
 - text
+- primitive
 
 ghc-options:
 # Maximum heap size: 1GiB
@@ -42,335 +43,7 @@ tests:
     dependencies:
     - doctest
 
-executables:
-#  tdpc-a:
-#    main:                Main.hs
-#    source-dirs:         tdpc-a
-
-#  tdpc-b:
-#    main:                Main.hs
-#    source-dirs:         tdpc-b
-
-#  tdpc-c:
-#    main:                Main.hs
-#    source-dirs:         tdpc-c
-
-#  tdpc-d:
-#    main:                Main.hs
-#    source-dirs:         tdpc-d
-
-#  tdpc-e:
-#    main:                Main.hs
-#    source-dirs:         tdpc-e
-
-#  tdpc-f:
-#    main:                Main.hs
-#    source-dirs:         tdpc-f
-
-#  tdpc-g:
-#    main:                Main.hs
-#    source-dirs:         tdpc-g
-
-#  tdpc-h:
-#    main:                Main.hs
-#    source-dirs:         tdpc-h
-
-#  abc032-d:
-#    main:                Main.hs
-#    source-dirs:         abc032-d
-
-#  agc031-a:
-#    main:                Main.hs
-#    source-dirs:         agc031-a
-
-#  agc031-b:
-#    main:                Main.hs
-#    source-dirs:         agc031-b
-
-#  agc031-c:
-#    main:                Main.hs
-#    source-dirs:         agc031-c
-
-#  agc031-d:
-#    main:                Main.hs
-#    source-dirs:         agc031-d
-
-#  caddi2019-a:
-#    main:                Main.hs
-#    source-dirs:         caddi2019-a
-
-#  agc032-a:
-#    main:                Main.hs
-#    source-dirs:         agc032-a
-
-#  agc032-b:
-#    main:                Main.hs
-#    source-dirs:         agc032-b
-
-#  abc122-a:
-#    main:                Main.hs
-#    source-dirs:         abc122-a
-
-#  abc122-b:
-#    main:                Main.hs
-#    source-dirs:         abc122-b
-
-#  abc122-c:
-#    main:                Main.hs
-#    source-dirs:         abc122-c
-
-#  abc122-d:
-#    main:                Main.hs
-#    source-dirs:         abc122-d
-
-#  abc121-a:
-#    main:                Main.hs
-#    source-dirs:         abc121-a
-
-#  abc121-b:
-#    main:                Main.hs
-#    source-dirs:         abc121-b
-
-#  abc121-c:
-#    main:                Main.hs
-#    source-dirs:         abc121-c
-
-#  abc121-d:
-#    main:                Main.hs
-#    source-dirs:         abc121-d
-
-#  abc120-a:
-#    main:                Main.hs
-#    source-dirs:         abc120-a
-
-#  abc120-b:
-#    main:                Main.hs
-#    source-dirs:         abc120-b
-
-#  abc120-c:
-#    main:                Main.hs
-#    source-dirs:         abc120-c
-
-#  abc120-d:
-#    main:                Main.hs
-#    source-dirs:         abc120-d
-
-#  dp-a:
-#    main:                Main.hs
-#    source-dirs:         dp-a
-
-#  dp-b:
-#    main:                Main.hs
-#    source-dirs:         dp-b
-
-#  dp-c:
-#    main:                Main.hs
-#    source-dirs:         dp-c
-
-#  dp-d:
-#    main:                Main.hs
-#    source-dirs:         dp-d
-
-#  dp-e:
-#    main:                Main.hs
-#    source-dirs:         dp-e
-
-#  dp-f:
-#    main:                Main.hs
-#    source-dirs:         dp-f
-
-#  dp-g:
-#    main:                Main.hs
-#    source-dirs:         dp-g
-
-  dp-h:
-    main:                Main.hs
-    source-dirs:         dp-h
-
-  dp-i:
-    main:                Main.hs
-    source-dirs:         dp-i
-
-#  exawizards2019-a:
-#    main:                Main.hs
-#    source-dirs:         exawizards2019-a
-
-#  exawizards2019-b:
-#    main:                Main.hs
-#    source-dirs:         exawizards2019-b
-
-#  exawizards2019-c:
-#    main:                Main.hs
-#    source-dirs:         exawizards2019-c
-
-#  exawizards2019-d:
-#    main:                Main.hs
-#    source-dirs:         exawizards2019-d
-
-#  exawizards2019-e:
-#    main:                Main.hs
-#    source-dirs:         exawizards2019-e
-
-  agc023-a:
-    main:                Main.hs
-    source-dirs:         agc023-a
-
-  abc123-a:
-    main:                Main.hs
-    source-dirs:         abc123-a
-
-  abc123-b:
-    main:                Main.hs
-    source-dirs:         abc123-b
-
-  abc123-c:
-    main:                Main.hs
-    source-dirs:         abc123-c
-
-  abc123-d:
-    main:                Main.hs
-    source-dirs:         abc123-d
-
-  abc124-a:
-    main:                Main.hs
-    source-dirs:         abc124-a
-
-  abc124-b:
-    main:                Main.hs
-    source-dirs:         abc124-b
-
-  abc124-c:
-    main:                Main.hs
-    source-dirs:         abc124-c
-
-  abc124-d:
-    main:                Main.hs
-    source-dirs:         abc124-d
-
-  aising2019-a:
-    main:                Main.hs
-    source-dirs:         aising2019-a
-
-  aising2019-b:
-    main:                Main.hs
-    source-dirs:         aising2019-b
-
-  aising2019-c:
-    main:                Main.hs
-    source-dirs:         aising2019-c
-
-  xmascon18-j:
-    main:                Main.hs
-    source-dirs:         xmascon18-j
-
-  tenka1-2019-c:
-    main: Main.hs
-    source-dirs: tenka1-2019-c
-
-  tenka1-2019-e:
-    main: Main.hs
-    source-dirs: tenka1-2019-e
-
-  arc017-a:
-    main: Main.hs
-    source-dirs: arc017-a
-
-  abc086-a:
-    main: Main.hs
-    source-dirs: abc086-a
-
-  abc081-a:
-    main: Main.hs
-    source-dirs: abc081-a
-
-  abc081-b:
-    main: Main.hs
-    source-dirs: abc081-b
-
-  abc087-b:
-    main: Main.hs
-    source-dirs: abc087-b
-
-  abc125-a:
-    main: Main.hs
-    source-dirs: abc125-a
-
-  abc125-b:
-    main: Main.hs
-    source-dirs: abc125-b
-
-  abc125-c:
-    main: Main.hs
-    source-dirs: abc125-c
-
-  abc125-d:
-    main: Main.hs
-    source-dirs: abc125-d
-
-  agc033-a:
-    main: Main.hs
-    source-dirs: agc033-a
-
-  diverta2019-a:
-    main: Main.hs
-    source-dirs: diverta2019-a
-
-  diverta2019-b:
-    main: Main.hs
-    source-dirs: diverta2019-b
-
-  diverta2019-c:
-    main: Main.hs
-    source-dirs: diverta2019-c
-
-  diverta2019-d:
-    main: Main.hs
-    source-dirs: diverta2019-d
-
-  diverta2019-e:
-    main: Main.hs
-    source-dirs: diverta2019-e
-
-  abc126-a:
-    main: Main.hs
-    source-dirs: abc126-a
-
-  abc126-b:
-    main: Main.hs
-    source-dirs: abc126-b
-
-  abc126-c:
-    main: Main.hs
-    source-dirs: abc126-c
-
-  abc126-d:
-    main: Main.hs
-    source-dirs: abc126-d
-
-  abc126-e:
-    main: Main.hs
-    source-dirs: abc126-e
-
-  abc126-f:
-    main: Main.hs
-    source-dirs: abc126-f
-
-  abc128-a:
-    main: Main.hs
-    source-dirs: abc128-a
-
-  abc128-b:
-    main: Main.hs
-    source-dirs: abc128-b
-
-  abc128-c:
-    main: Main.hs
-    source-dirs: abc128-c
-
-  abc128-d:
-    main: Main.hs
-    source-dirs: abc128-d
-
-  abc128-e:
-    main: Main.hs
-    source-dirs: abc128-e
+# executables:
+#   foo:
+#     main : Main.hs
+#     source-dirs: foo

From 12d7e0f67514443dc1cd6de60da519d9d8468ebe Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Tue, 23 Jul 2019 19:13:01 +0900
Subject: [PATCH 066/148] Update README

---
 README.md | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/README.md b/README.md
index b9166da..dc08fd3 100644
--- a/README.md
+++ b/README.md
@@ -213,7 +213,7 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 
 * [x] A - Triangle
 * [x] B - Do Not Duplicate
-* [ ] C - GP 2
+* [x] C - GP 2
 * [ ] D - Negative Cycle
 * [ ] E - ABC String
 * [ ] F - Square Constraints

From 22fa7d41cb447b0fa9e3bde18a88aeecddf196d5 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Tue, 23 Jul 2019 19:13:26 +0900
Subject: [PATCH 067/148] DP-U

---
 README.md    |  2 +-
 dp-u/Main.hs | 70 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 71 insertions(+), 1 deletion(-)
 create mode 100644 dp-u/Main.hs

diff --git a/README.md b/README.md
index dc08fd3..dd576ab 100644
--- a/README.md
+++ b/README.md
@@ -53,7 +53,7 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 * [x] R - Walk
 * [x] S - Digit Sum
 * [x] T - Permutation
-* [ ] U - Grouping
+* [x] U - Grouping
 * [ ] V - Subtree
 * [ ] W - Intervals
 * [ ] X - Tower
diff --git a/dp-u/Main.hs b/dp-u/Main.hs
new file mode 100644
index 0000000..ee9c479
--- /dev/null
+++ b/dp-u/Main.hs
@@ -0,0 +1,70 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.Int (Int64)
+import Data.List
+import Control.Monad
+import Control.Monad.ST
+import qualified Data.Vector as V
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+import Data.Bifunctor (first)
+import Data.Bits
+
+type Mat = V.Vector (U.Vector Int64)
+type BitSet = Int
+
+{-
+scoreOne :: Int -> Mat -> BitSet -> Int64
+scoreOne !n !mat !set = go 0 [i | i <- [0..n-1], testBit set i]
+  where
+    go !acc [] = acc
+    go !acc (x:xs) = let !r = mat V.! x
+                     in go (acc + sum [r U.! y | y <- xs]) xs
+-}
+
+main = do
+  n <- readLn
+  mat <- V.replicateM n $ do
+    U.unfoldrN n (readInt64 . BS.dropWhile isSpace) <$> BS.getLine
+  let -- scoreOneV == U.generate (2^n) (scoreOne n mat)
+      scoreOneV :: U.Vector Int64
+      scoreOneV = U.create $ do
+        vec <- UM.replicate (2^n) minBound
+        UM.write vec 0 0
+        let go !set = do
+              v <- UM.read vec set
+              if v == minBound
+                then do let !i = countTrailingZeros set
+                        let !set' = clearBit set i
+                        v0 <- go set'
+                        let !v = v0 + sum [(mat V.! i) U.! j | j <- [i+1..n-1], testBit set' j]
+                        UM.write vec set v
+                        return v
+                else return v
+        mapM_ go [1..2^n-1]
+        return vec
+  let result :: Int64
+      result = runST $ do
+        vec <- UM.replicate (2^n) minBound
+        UM.write vec 0 0
+        forM_ [0..n-1] $ \i -> do
+          UM.write vec (bit i) 0
+        let go !set = do
+              v <- UM.read vec set
+              if v == minBound
+                then do let v0 = scoreOneV U.! set
+                        let x0:xs = [i | i <- [0..n-1], testBit set i]
+                        v <- foldM (\x a -> max x <$> a) v0 [ (+) (scoreOneV U.! set') <$> (go (set `xor` set'))
+                                                            | set' <- map (foldl' (.|.) (bit x0)) $ sequence $ map (\i -> [0,bit i]) xs
+                                                            , set' /= set
+                                                            ]
+                        UM.write vec set v
+                        return v
+                else return v
+        go (2^n-1)
+  print result
+
+readInt64 :: BS.ByteString -> Maybe (Int64, BS.ByteString)
+readInt64 s = first fromIntegral <$> BS.readInt s

From 5b458a7dbadf9cf5fca53fbc21dca7bdacc11357 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Tue, 23 Jul 2019 19:13:39 +0900
Subject: [PATCH 068/148] Add lib/IntSet.hs

---
 lib/IntSet.hs | 29 +++++++++++++++++++++++++++++
 1 file changed, 29 insertions(+)
 create mode 100644 lib/IntSet.hs

diff --git a/lib/IntSet.hs b/lib/IntSet.hs
new file mode 100644
index 0000000..1af7f44
--- /dev/null
+++ b/lib/IntSet.hs
@@ -0,0 +1,29 @@
+module IntSet where
+import Data.Foldable (foldlM)
+import Data.Monoid
+import qualified Data.IntSet as IntSet
+import Control.Monad
+
+foldMap_IntSet :: (Monoid n) => (Int -> n) -> IntSet.IntSet -> n
+foldMap_IntSet f set = go set
+  where
+    go set = case IntSet.splitRoot set of
+               [] -> mempty
+               [x] -> foldMap f (IntSet.toList x)
+               xs -> foldMap go xs
+
+forM_IntSet :: Monad m => IntSet.IntSet -> (Int -> m ()) -> m ()
+forM_IntSet set f = go set
+  where
+    go set = case IntSet.splitRoot set of
+               [] -> return ()
+               [x] -> forM_ (IntSet.toList x) f
+               xs -> forM_ xs go
+
+foldMapM_IntSet :: (Monoid n, Monad m) => (Int -> m n) -> IntSet.IntSet -> m n
+foldMapM_IntSet f set = go set
+  where
+    go set = case IntSet.splitRoot set of
+               [] -> return mempty
+               [x] -> foldlM (\x v -> mappend x <$> f v) mempty (IntSet.toList x)
+               xs -> foldlM (\x set' -> mappend x <$> go set') mempty xs

From c8cd6070b1c7f9d1835cd2ea9b6cf9e5bd849dc7 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Tue, 23 Jul 2019 19:13:52 +0900
Subject: [PATCH 069/148] Add lib/MergeSort.hs

---
 lib/MergeSort.hs | 33 +++++++++++++++++++++++++++++++++
 1 file changed, 33 insertions(+)
 create mode 100644 lib/MergeSort.hs

diff --git a/lib/MergeSort.hs b/lib/MergeSort.hs
new file mode 100644
index 0000000..b492e01
--- /dev/null
+++ b/lib/MergeSort.hs
@@ -0,0 +1,33 @@
+{-# LANGUAGE BangPatterns #-}
+module MergeSort where
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+
+mergeSortBy :: (U.Unbox a) => (a -> a -> Ordering) -> U.Vector a -> U.Vector a
+mergeSortBy !cmp !vec = doSort vec
+  where
+    doSort vec | U.length vec <= 1 = vec
+               | otherwise = let (xs, ys) = U.splitAt (U.length vec `quot` 2) vec
+                             in merge (doSort xs) (doSort ys)
+    merge xs ys = U.create $ do
+      let !n = U.length xs
+          !m = U.length ys
+      result <- UM.new (n + m)
+      let loop !i !j
+            | i == n = U.copy (UM.drop (i + j) result) (U.drop j ys)
+            | j == m = U.copy (UM.drop (i + j) result) (U.drop i xs)
+            | otherwise = let !x = xs U.! i
+                              !y = ys U.! j
+                          in case cmp x y of
+                               LT -> do UM.write result (i + j) x
+                                        loop (i + 1) j
+                               EQ -> do UM.write result (i + j) x
+                                        UM.write result (i + j + 1) y
+                                        loop (i + 1) (j + 1)
+                               GT -> do UM.write result (i + j) y
+                                        loop i (j + 1)
+      loop 0 0
+      return result
+
+mergeSort :: (U.Unbox a, Ord a) => U.Vector a -> U.Vector a
+mergeSort = mergeSortBy compare

From f8536bf83e983e039238df8fe283742e0465e9b0 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Tue, 23 Jul 2019 20:20:03 +0900
Subject: [PATCH 070/148] DP-U: Make faster

---
 dp-u/Main.hs | 34 ++++++++++++++++++++++++++++------
 1 file changed, 28 insertions(+), 6 deletions(-)

diff --git a/dp-u/Main.hs b/dp-u/Main.hs
index ee9c479..0b7d936 100644
--- a/dp-u/Main.hs
+++ b/dp-u/Main.hs
@@ -16,6 +16,7 @@ type Mat = V.Vector (U.Vector Int64)
 type BitSet = Int
 
 {-
+-- set に入っているウサギを全て同じグループに入れた時に得られる得点
 scoreOne :: Int -> Mat -> BitSet -> Int64
 scoreOne !n !mat !set = go 0 [i | i <- [0..n-1], testBit set i]
   where
@@ -24,11 +25,29 @@ scoreOne !n !mat !set = go 0 [i | i <- [0..n-1], testBit set i]
                      in go (acc + sum [r U.! y | y <- xs]) xs
 -}
 
+-- ビット列を集合と見立てた時の部分集合の全体（冪集合）
+-- sort (bitSubsets x) == sort (map (foldl' (.|.) 0) $ sequence [[0,bit i] | i <- [0..finiteBitSize set - 1], testBit set i])
+bitSubsets :: Int -> [Int]
+bitSubsets 0 = [0]
+bitSubsets set = let !i = countTrailingZeros set
+                     set' = clearBit set i
+                     ss = bitSubsets set'
+                 in map (.|. bit i) ss ++ ss
+
+-- sort (bitSubsetsA acc set xs) = sort (map (.|. acc) (bitSubsets set) ++ xs)
+bitSubsetsA :: Int -> Int -> [Int] -> [Int]
+bitSubsetsA !acc 0 xs = acc : xs
+bitSubsetsA !acc set xs = let i = countTrailingZeros set
+                              set' = clearBit set i
+                          in bitSubsetsA acc set' $ bitSubsetsA (acc .|. bit i) set' xs
+
 main = do
   n <- readLn
   mat <- V.replicateM n $ do
     U.unfoldrN n (readInt64 . BS.dropWhile isSpace) <$> BS.getLine
+
   let -- scoreOneV == U.generate (2^n) (scoreOne n mat)
+      -- scoreOneV U.! set : set に入っているウサギを全て同じグループに入れた時に得られる得点
       scoreOneV :: U.Vector Int64
       scoreOneV = U.create $ do
         vec <- UM.replicate (2^n) minBound
@@ -45,21 +64,24 @@ main = do
                 else return v
         mapM_ go [1..2^n-1]
         return vec
+
   let result :: Int64
       result = runST $ do
         vec <- UM.replicate (2^n) minBound
         UM.write vec 0 0
         forM_ [0..n-1] $ \i -> do
           UM.write vec (bit i) 0
-        let go !set = do
+        let -- go set : set に入っているウサギを使って得られる最大の得点
+            go !set = do
               v <- UM.read vec set
               if v == minBound
                 then do let v0 = scoreOneV U.! set
-                        let x0:xs = [i | i <- [0..n-1], testBit set i]
-                        v <- foldM (\x a -> max x <$> a) v0 [ (+) (scoreOneV U.! set') <$> (go (set `xor` set'))
-                                                            | set' <- map (foldl' (.|.) (bit x0)) $ sequence $ map (\i -> [0,bit i]) xs
-                                                            , set' /= set
-                                                            ]
+                        let !i0 = countTrailingZeros set
+                        v <- foldM (\ !x a -> max x <$> a) v0
+                             [ (scoreOneV U.! set' +) <$> go (set `xor` set')
+                             | set' <- bitSubsetsA (bit i0) (clearBit set i0) []
+                             , set' /= set
+                             ]
                         UM.write vec set v
                         return v
                 else return v

From b2bbd88c901d986681dd3d1495860680b58dee19 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Tue, 23 Jul 2019 21:18:15 +0900
Subject: [PATCH 071/148] DP-V

---
 README.md    |   2 +-
 dp-v/Main.hs | 126 +++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 127 insertions(+), 1 deletion(-)
 create mode 100644 dp-v/Main.hs

diff --git a/README.md b/README.md
index dd576ab..e647d30 100644
--- a/README.md
+++ b/README.md
@@ -54,7 +54,7 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 * [x] S - Digit Sum
 * [x] T - Permutation
 * [x] U - Grouping
-* [ ] V - Subtree
+* [x] V - Subtree
 * [ ] W - Intervals
 * [ ] X - Tower
 * [ ] Y - Grid 2
diff --git a/dp-v/Main.hs b/dp-v/Main.hs
new file mode 100644
index 0000000..912cf9e
--- /dev/null
+++ b/dp-v/Main.hs
@@ -0,0 +1,126 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE RankNTypes #-}
+import Data.Char (isSpace)
+import Data.Int (Int64)
+import Data.List
+import Control.Monad
+import qualified Data.Vector as V
+import qualified Data.Vector.Mutable as VM
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+import Data.Proxy
+import Data.Coerce
+import Unsafe.Coerce
+import qualified Data.Vector.Generic
+import qualified Data.Vector.Generic.Mutable
+
+buildGraph :: Int -> U.Vector (Int, Int) -> V.Vector [Int]
+buildGraph !n edges = V.create $ do
+  vec <- VM.replicate n []
+  U.forM_ edges $ \(i,j) -> do
+    VM.modify vec (j :) i
+    VM.modify vec (i :) j
+  return vec
+
+solve :: forall m. IsInt64 m => Proxy m -> Int -> U.Vector (Int, Int) -> U.Vector (IntMod m)
+solve _proxy !n edges =
+  let graph = buildGraph n edges
+      dp1 :: U.Vector (IntMod m)
+      dp1 = U.create $ do
+        vec <- UM.replicate n 0
+        let go !parent !i = do
+              v <- foldM (\ !x a -> (x *) <$> a) 1 [go i j | j <- graph V.! i, j /= parent]
+              let !w = 1 + v
+              UM.write vec i w
+              return w
+        go (-1) 0
+        return vec
+  in U.create $ do
+    vec <- UM.replicate n 0
+    let go !a !parent !i = do
+          let children = filter (/= parent) $ graph V.! i
+          let xs = scanl' (\ !x !i -> x * dp1 U.! i) 1 children
+          let ys = scanr (\ !i !x -> dp1 U.! i * x) a children
+          UM.write vec i (head ys)
+          forM_ (zip3 children xs (tail ys)) $ \(j,s,t) -> do
+            go (1 + s * t) i j
+    go 1 (-1) 0
+    return vec
+
+main = do
+  [n,m] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  edges <- U.replicateM (n-1) $ do
+    [x,y] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+    return (x-1,y-1)
+  let result = reifyInt64 (fromIntegral m) (\proxy -> case solve proxy n edges of V_IntMod v -> v)
+  U.mapM_ print result
+
+--
+-- Modular Arithmetic
+--
+
+newtype IntMod m = IntMod { getIntMod :: Int64 } deriving Eq
+instance Show (IntMod m) where
+  show (IntMod x) = show x
+instance IsInt64 m => Num (IntMod m) where
+  t@(IntMod x) + IntMod y = IntMod ((x + y) `rem` int64Val t)
+  t@(IntMod x) - IntMod y = IntMod ((x - y) `mod` int64Val t)
+  t@(IntMod x) * IntMod y = IntMod ((x * y) `rem` int64Val t)
+  negate t@(IntMod x) = let m = int64Val t in IntMod ((m - x) `rem` m)
+  fromInteger n = IntMod $ fromInteger $ n `mod` fromIntegral (int64Val (Proxy :: Proxy m))
+  abs = undefined; signum = undefined
+
+---
+
+newtype Tagged tag a = Tagged { getTagged :: a }
+
+class IsInt64 tag where
+  taggedInt64Val :: Tagged tag Int64
+
+int64Val :: forall proxy tag. IsInt64 tag => proxy tag -> Int64
+int64Val _ = getTagged (taggedInt64Val :: Tagged tag Int64)
+
+---
+
+-- See Data.Reflection
+newtype MagicInt64 a = MagicInt64 (forall tag. IsInt64 tag => Proxy tag -> a)
+reifyInt64 :: forall a. Int64 -> (forall tag. IsInt64 tag => Proxy tag -> a) -> a
+reifyInt64 x f = unsafeCoerce (MagicInt64 f :: MagicInt64 a) x Proxy
+
+--
+-- instance U.Unbox (IntMod m)
+--
+
+newtype instance UM.MVector s (IntMod m) = MV_IntMod (UM.MVector s Int64)
+newtype instance U.Vector (IntMod m) = V_IntMod (U.Vector Int64)
+
+instance Data.Vector.Generic.Mutable.MVector UM.MVector (IntMod m) where -- needs MultiParamTypeClasses here
+  basicLength (MV_IntMod mv) = Data.Vector.Generic.Mutable.basicLength mv
+  basicUnsafeSlice i l (MV_IntMod mv) = MV_IntMod (Data.Vector.Generic.Mutable.basicUnsafeSlice i l mv)
+  basicOverlaps (MV_IntMod mv) (MV_IntMod mv') = Data.Vector.Generic.Mutable.basicOverlaps mv mv'
+  basicUnsafeNew l = MV_IntMod <$> Data.Vector.Generic.Mutable.basicUnsafeNew l
+  basicInitialize (MV_IntMod mv) = Data.Vector.Generic.Mutable.basicInitialize mv
+  basicUnsafeReplicate i x = MV_IntMod <$> Data.Vector.Generic.Mutable.basicUnsafeReplicate i (coerce x)
+  basicUnsafeRead (MV_IntMod mv) i = coerce <$> Data.Vector.Generic.Mutable.basicUnsafeRead mv i
+  basicUnsafeWrite (MV_IntMod mv) i x = Data.Vector.Generic.Mutable.basicUnsafeWrite mv i (coerce x)
+  basicClear (MV_IntMod mv) = Data.Vector.Generic.Mutable.basicClear mv
+  basicSet (MV_IntMod mv) x = Data.Vector.Generic.Mutable.basicSet mv (coerce x)
+  basicUnsafeCopy (MV_IntMod mv) (MV_IntMod mv') = Data.Vector.Generic.Mutable.basicUnsafeCopy mv mv'
+  basicUnsafeMove (MV_IntMod mv) (MV_IntMod mv') = Data.Vector.Generic.Mutable.basicUnsafeMove mv mv'
+  basicUnsafeGrow (MV_IntMod mv) n = MV_IntMod <$> Data.Vector.Generic.Mutable.basicUnsafeGrow mv n
+
+instance Data.Vector.Generic.Vector U.Vector (IntMod m) where -- needs MultiParamTypeClasses here
+  basicUnsafeFreeze (MV_IntMod mv) = V_IntMod <$> Data.Vector.Generic.basicUnsafeFreeze mv
+  basicUnsafeThaw (V_IntMod v) = MV_IntMod <$> Data.Vector.Generic.basicUnsafeThaw v
+  basicLength (V_IntMod v) = Data.Vector.Generic.basicLength v
+  basicUnsafeSlice i l (V_IntMod v) = V_IntMod (Data.Vector.Generic.basicUnsafeSlice i l v)
+  basicUnsafeIndexM (V_IntMod v) i = coerce <$> Data.Vector.Generic.basicUnsafeIndexM v i
+  basicUnsafeCopy (MV_IntMod  mv) (V_IntMod v) = Data.Vector.Generic.basicUnsafeCopy mv v
+  elemseq (V_IntMod v) x y = Data.Vector.Generic.elemseq v (coerce x) y
+
+instance U.Unbox (IntMod m)

From a9511991e14d84ca291fbe2259bff1c49ccde805 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Tue, 23 Jul 2019 21:27:45 +0900
Subject: [PATCH 072/148] Update README

---
 README.md | 50 ++++++++++++++++++++++++++++++++++++--------------
 1 file changed, 36 insertions(+), 14 deletions(-)

diff --git a/README.md b/README.md
index e647d30..3aec040 100644
--- a/README.md
+++ b/README.md
@@ -16,15 +16,26 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 
 解いた問題：
 
-* A コンテスト
-* B ゲーム
-* C トーナメント
-* D サイコロ
-* E 数
-* F 準急
-* G 辞書順
-* H ナップザック
-* T フィボナッチ <https://github.com/minoki/typical-dp-contest-t-fibonacci>
+* [x] A - コンテスト
+* [x] B - ゲーム
+* [x] C - トーナメント
+* [x] D - サイコロ
+* [x] E - 数
+* [x] F - 準急
+* [x] G - 辞書順
+* [x] H - ナップザック
+* [ ] I - イウィ
+* [ ] J - ボール
+* [ ] K - ターゲット
+* [ ] L - 猫
+* [ ] M - 家
+* [ ] N - 木
+* [ ] O - 文字列
+* [ ] P - うなぎ
+* [ ] Q - 連結
+* [ ] R - グラフ
+* [ ] S - マス目
+* [x] T - フィボナッチ <https://github.com/minoki/typical-dp-contest-t-fibonacci>
     * 解説記事：[フィボナッチ数絡みの競プロの問題を解いてみた（Typical DP Contest T）](https://blog.miz-ar.info/2019/02/typical-dp-contest-t/)
 
 ## Educational DP Contest
@@ -105,7 +116,13 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 
 解いた問題：
 
-* A - Zero Sum Ranges
+* [x] A - Zero Sum Ranges
+    * 令和記念に解いた（2019年4月1日）
+* [ ] B - Find Symmetries
+* [ ] C - Painting Machines
+* [ ] D - Go Home
+* [ ] E - Inversions
+* [ ] F - 01 on Tree
 
 ## Tenka1 Programmer Contest 2019 (2019-04-20)
 
@@ -124,9 +141,11 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 
 解いた問題：
 
-* A - Bulletin Board
-* B - Contests
-* C - Alternating Path
+* [x] A - Bulletin Board
+* [x] B - Contests
+* [x] C - Alternating Path
+* [ ] D - Nearest Card Game
+* [ ] E - Attack to a Tree
 
 ## Xmas Contest 2018
 
@@ -142,7 +161,10 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 
 解いた問題：
 
-* A - 素数、コンテスト、素数
+* [x] A - 素数、コンテスト、素数
+* [ ] B - 解像度が低い。
+* [ ] C - 無駄なものが嫌いな人
+* [ ] D - ARCたんクッキー
 
 ## diverta 2019 Programming Contest (2019-05-11)
 

From 0c95ce17110f3964563d133a255650936d76ebf8 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Wed, 24 Jul 2019 14:46:50 +0900
Subject: [PATCH 073/148] TDPC-I
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

多分想定解ではない
---
 README.md            |  2 +-
 tdpc-i/Main.hs       | 32 ++++++++++++++++++++++++++++++++
 tdpc-i/makeinput.lua | 10 ++++++++++
 3 files changed, 43 insertions(+), 1 deletion(-)
 create mode 100644 tdpc-i/Main.hs
 create mode 100644 tdpc-i/makeinput.lua

diff --git a/README.md b/README.md
index 3aec040..297602f 100644
--- a/README.md
+++ b/README.md
@@ -24,7 +24,7 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 * [x] F - 準急
 * [x] G - 辞書順
 * [x] H - ナップザック
-* [ ] I - イウィ
+* [x] I - イウィ
 * [ ] J - ボール
 * [ ] K - ターゲット
 * [ ] L - 猫
diff --git a/tdpc-i/Main.hs b/tdpc-i/Main.hs
new file mode 100644
index 0000000..e162c28
--- /dev/null
+++ b/tdpc-i/Main.hs
@@ -0,0 +1,32 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import qualified Data.ByteString.Char8 as BS
+
+splitBy :: Char -> BS.ByteString -> [BS.ByteString]
+splitBy !c s = go 0
+  where
+    go !i | i == BS.length s = [s]
+          | BS.index s i == c = BS.take i s : splitBy c (BS.drop (i+1) s)
+          | otherwise = go (i+1)
+
+nonZeroSpans :: [Int] -> [[Int]]
+nonZeroSpans [] = []
+nonZeroSpans (0:xs) = nonZeroSpans xs
+nonZeroSpans xs = let (ys,zs) = span (/= 0) xs
+                  in ys : nonZeroSpans zs
+
+solveOne :: Int -> Int -> [Int] -> Int
+solveOne !n !m [] = n + (m+1) `quot` 2
+solveOne !n !m (x0:x1:xs)
+  | x0 >= 1 && x1 >= 1 && x0+x1 >= 3 = let !x = x0+x1-2
+                                       in solveOne (n+1) m (x:xs)
+  | otherwise = solveOne n (m+1) (x1:xs)
+solveOne !n !m [x] = if m <= x
+                     then n + m
+                     else n + (m-x) `quot` 2 + x
+
+main = do
+  s <- BS.getLine
+  let xs = map BS.length $ splitBy 'w' s
+  let result = sum $ map (solveOne 0 0) $ nonZeroSpans xs
+  print result
diff --git a/tdpc-i/makeinput.lua b/tdpc-i/makeinput.lua
new file mode 100644
index 0000000..a7767ac
--- /dev/null
+++ b/tdpc-i/makeinput.lua
@@ -0,0 +1,10 @@
+local n = arg[1] and tonumber(arg[1]) or 5
+
+local t = {}
+for i = 1, n do
+  local j = math.random(1, #t+1)
+  table.insert(t, j, "i")
+  table.insert(t, j, "w")
+  table.insert(t, j, "i")
+end
+print(table.concat(t, ""))

From 7df3eb57369743cb1feca635a6e5263a8e7a695e Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Wed, 24 Jul 2019 15:13:52 +0900
Subject: [PATCH 074/148] TDPC-A: Rewrite

---
 tdpc-a/Main.hs   | 11 +++--------
 tdpc-a/Vector.hs | 14 ++++++++++++++
 2 files changed, 17 insertions(+), 8 deletions(-)
 create mode 100644 tdpc-a/Vector.hs

diff --git a/tdpc-a/Main.hs b/tdpc-a/Main.hs
index 273123a..4773ddd 100644
--- a/tdpc-a/Main.hs
+++ b/tdpc-a/Main.hs
@@ -1,14 +1,9 @@
-{-# LANGUAGE BangPatterns #-}
-import System.Exit
-import Control.Monad
+import Data.Char
 import Data.List
 import Data.Bits
+import qualified Data.ByteString.Char8 as BS
 
 main = do
   n <- readLn :: IO Int
-  let parseInts s = case reads s of
-                      [(x,t)] -> x : parseInts t
-                      _ -> []
-  ps <- (parseInts <$> getLine) :: IO [Int]
-  when (length ps /= n) exitFailure
+  ps <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
   print $ popCount (foldl' (\xs p -> (xs .|. (xs `shiftL` p))) 1 ps :: Integer)
diff --git a/tdpc-a/Vector.hs b/tdpc-a/Vector.hs
new file mode 100644
index 0000000..9144bb6
--- /dev/null
+++ b/tdpc-a/Vector.hs
@@ -0,0 +1,14 @@
+import Data.Char
+import Data.List
+import Data.Monoid
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.Vector.Unboxed as U
+
+step :: Int -> U.Vector Bool -> U.Vector Bool
+step p xs = U.accumulate (||) (xs <> U.replicate p False)
+            $ U.zip (U.enumFromN p $ U.length xs) xs
+
+main = do
+  n <- readLn :: IO Int
+  ps <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  print $ U.length $ U.filter id $ foldr step (U.singleton True) ps

From c390ffe0ae6f0d9cdb89757b9a0fb6b12fddb1e3 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Sun, 28 Jul 2019 00:32:11 +0900
Subject: [PATCH 075/148] ABC135-A, B, C, D

---
 abc/README.md        | 11 ++++++
 abc/abc135-a/Main.hs | 10 ++++++
 abc/abc135-b/Main.hs | 13 +++++++
 abc/abc135-c/Main.hs | 20 +++++++++++
 abc/abc135-d/Main.hs | 85 ++++++++++++++++++++++++++++++++++++++++++++
 5 files changed, 139 insertions(+)
 create mode 100644 abc/abc135-a/Main.hs
 create mode 100644 abc/abc135-b/Main.hs
 create mode 100644 abc/abc135-c/Main.hs
 create mode 100644 abc/abc135-d/Main.hs

diff --git a/abc/README.md b/abc/README.md
index 250779a..73e75d7 100644
--- a/abc/README.md
+++ b/abc/README.md
@@ -244,3 +244,14 @@
 * [x] D - Preparing Boxes
 * [x] E - Sequence Decomposing
 * [ ] F - Permutation Oddness
+
+## AtCoder Beginner Contest 135 (2019-07-27)
+
+<https://atcoder.jp/contests/abc135>
+
+* [x] A - Harmony
+* [x] B - 0 or 1 Swap
+* [x] C - City Savers
+* [x] D - Digits Parade
+* [ ] E - Golf
+* [ ] F - Strings of Eternity
diff --git a/abc/abc135-a/Main.hs b/abc/abc135-a/Main.hs
new file mode 100644
index 0000000..1bf5a6c
--- /dev/null
+++ b/abc/abc135-a/Main.hs
@@ -0,0 +1,10 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  [a,b] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  if even (a - b)
+    then print $ (a + b) `quot` 2
+    else putStrLn "IMPOSSIBLE"
diff --git a/abc/abc135-b/Main.hs b/abc/abc135-b/Main.hs
new file mode 100644
index 0000000..8400298
--- /dev/null
+++ b/abc/abc135-b/Main.hs
@@ -0,0 +1,13 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Char (isSpace)
+import Data.Int (Int64)
+import Data.List (unfoldr, sort)
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  n <- readLn :: IO Int
+  xs <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  let r = length $ filter id $ zipWith (/=) xs $ sort xs
+  if r <= 2
+    then putStrLn "YES"
+    else putStrLn "NO"
diff --git a/abc/abc135-c/Main.hs b/abc/abc135-c/Main.hs
new file mode 100644
index 0000000..dcaf689
--- /dev/null
+++ b/abc/abc135-c/Main.hs
@@ -0,0 +1,20 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.Int (Int64)
+import Data.List (unfoldr)
+import qualified Data.ByteString.Char8 as BS
+
+solve :: [Int64] -> [Int64] -> Int64
+solve [x0,x1] [y0] = min (x0 + x1) y0
+solve (x0:x1:xs) (y0:ys) = let !c = min (x0 + x1) y0
+                               !d = if c <= x0
+                                    then x1
+                                    else x1 + x0 - c
+                           in c + solve (d:xs) ys
+
+main = do
+  n <- readLn :: IO Int
+  xs <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  ys <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  print $ solve (map fromIntegral xs) (map fromIntegral ys)
diff --git a/abc/abc135-d/Main.hs b/abc/abc135-d/Main.hs
new file mode 100644
index 0000000..0babc21
--- /dev/null
+++ b/abc/abc135-d/Main.hs
@@ -0,0 +1,85 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+import Data.Char (isSpace, isDigit, digitToInt)
+import Data.Int (Int64)
+import Data.List (unfoldr)
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+import Data.Coerce
+import qualified Data.Vector.Generic
+import qualified Data.Vector.Generic.Mutable
+
+solve :: U.Vector Char -> U.Vector N
+solve xs = U.foldl' go (U.generate 13 $ \i -> if i == 0 then 1 else 0) xs
+  where
+    go v '?' = U.generate 13 $ \i -> sum [v U.! ((i - j) * 4 `mod` 13) | j <- [0..9]]
+    go v c | isDigit c = let d = digitToInt c
+                         in U.generate 13 $ \i -> v U.! ((i - d) * 4 `mod` 13)
+
+main = do
+  s <- BS.getLine
+  print $ (U.! 5) $ solve $ U.generate (BS.length s) $ BS.index s
+
+--
+-- Modular Arithmetic
+--
+
+modulo :: Int64
+modulo = 10^9+7
+addMod, subMod, mulMod :: Int64 -> Int64 -> Int64
+addMod !x !y | x + y >= modulo = x + y - modulo
+             | otherwise = x + y
+subMod !x !y | x >= y = x - y
+             | otherwise = x - y + modulo
+mulMod !x !y = (x * y) `rem` modulo
+
+newtype N = N { unwrapN :: Int64 } deriving (Eq)
+instance Show N where
+  show (N x) = show x
+instance Num N where
+  (+) = coerce addMod
+  (-) = coerce subMod
+  (*) = coerce mulMod
+  fromInteger n = N (fromInteger (n `mod` fromIntegral modulo))
+  abs = undefined; signum = undefined
+
+{-# RULES
+"^9/Int" forall x. x ^ (9 :: Int) = let u = x; v = u * u * u in v * v * v
+"^9/Integer" forall x. x ^ (9 :: Integer) = let u = x; v = u * u * u in v * v * v
+ #-}
+
+--
+-- instance U.Unbox N
+--
+
+newtype instance UM.MVector s N = MV_N (UM.MVector s Int64)
+newtype instance U.Vector N = V_N (U.Vector Int64)
+
+instance Data.Vector.Generic.Mutable.MVector UM.MVector N where -- needs MultiParamTypeClasses here
+  basicLength (MV_N mv) = Data.Vector.Generic.Mutable.basicLength mv
+  basicUnsafeSlice i l (MV_N mv) = MV_N (Data.Vector.Generic.Mutable.basicUnsafeSlice i l mv)
+  basicOverlaps (MV_N mv) (MV_N mv') = Data.Vector.Generic.Mutable.basicOverlaps mv mv'
+  basicUnsafeNew l = MV_N <$> Data.Vector.Generic.Mutable.basicUnsafeNew l
+  basicInitialize (MV_N mv) = Data.Vector.Generic.Mutable.basicInitialize mv
+  basicUnsafeReplicate i x = MV_N <$> Data.Vector.Generic.Mutable.basicUnsafeReplicate i (coerce x)
+  basicUnsafeRead (MV_N mv) i = coerce <$> Data.Vector.Generic.Mutable.basicUnsafeRead mv i
+  basicUnsafeWrite (MV_N mv) i x = Data.Vector.Generic.Mutable.basicUnsafeWrite mv i (coerce x)
+  basicClear (MV_N mv) = Data.Vector.Generic.Mutable.basicClear mv
+  basicSet (MV_N mv) x = Data.Vector.Generic.Mutable.basicSet mv (coerce x)
+  basicUnsafeCopy (MV_N mv) (MV_N mv') = Data.Vector.Generic.Mutable.basicUnsafeCopy mv mv'
+  basicUnsafeMove (MV_N mv) (MV_N mv') = Data.Vector.Generic.Mutable.basicUnsafeMove mv mv'
+  basicUnsafeGrow (MV_N mv) n = MV_N <$> Data.Vector.Generic.Mutable.basicUnsafeGrow mv n
+
+instance Data.Vector.Generic.Vector U.Vector N where -- needs MultiParamTypeClasses here
+  basicUnsafeFreeze (MV_N mv) = V_N <$> Data.Vector.Generic.basicUnsafeFreeze mv
+  basicUnsafeThaw (V_N v) = MV_N <$> Data.Vector.Generic.basicUnsafeThaw v
+  basicLength (V_N v) = Data.Vector.Generic.basicLength v
+  basicUnsafeSlice i l (V_N v) = V_N (Data.Vector.Generic.basicUnsafeSlice i l v)
+  basicUnsafeIndexM (V_N v) i = coerce <$> Data.Vector.Generic.basicUnsafeIndexM v i
+  basicUnsafeCopy (MV_N mv) (V_N v) = Data.Vector.Generic.basicUnsafeCopy mv v
+  elemseq (V_N v) x y = Data.Vector.Generic.elemseq v (coerce x) y
+
+instance U.Unbox N

From c6d2c6a80a5b95cc0588b48537d6e28c19e01fba Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Sun, 28 Jul 2019 02:45:20 +0900
Subject: [PATCH 076/148] ABC135-E

---
 abc/README.md        |  2 +-
 abc/abc135-e/Main.hs | 74 ++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 75 insertions(+), 1 deletion(-)
 create mode 100644 abc/abc135-e/Main.hs

diff --git a/abc/README.md b/abc/README.md
index 73e75d7..0074e88 100644
--- a/abc/README.md
+++ b/abc/README.md
@@ -253,5 +253,5 @@
 * [x] B - 0 or 1 Swap
 * [x] C - City Savers
 * [x] D - Digits Parade
-* [ ] E - Golf
+* [x] E - Golf
 * [ ] F - Strings of Eternity
diff --git a/abc/abc135-e/Main.hs b/abc/abc135-e/Main.hs
new file mode 100644
index 0000000..6aa8a65
--- /dev/null
+++ b/abc/abc135-e/Main.hs
@@ -0,0 +1,74 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import Control.Monad
+import qualified Data.Vector.Unboxed as U
+import qualified Data.ByteString.Char8 as BS
+import Data.Bifunctor
+import Control.Exception
+
+-- d <= 2 * k && x >= 0 && y >= 0 && (even (x + y) || odd k)
+solveSmall :: Int -> Int -> Int -> [(Int,Int)]
+solveSmall !k !x !y
+  | assert (x >= 0 && y >= 0 && d <= 2 * k) False = undefined
+  | d == 0 = []
+  | d == k = [(x,y)]
+  | odd (x + y) && d < k =
+    let !x1 = -1
+        !y1 = 1-k
+    in (x1,y1) : map (bimap (+ x1) (+ y1)) (solveSmall k (x-x1) (y-y1))
+  | odd (x + y) {- k < d < 2*k -} =
+    let (x1,y1) | x >= k = (k,0)
+                | y >= k = (0,k)
+                | otherwise = (x,k-x) -- k < x + y && x < k && y < k
+    in (x1,y1) : map (bimap (+ x1) (+ y1)) (solveSmall k (x-x1) (y-y1))
+  | otherwise {- even (x + y) -} =
+    if x >= y
+    then let !x1 = (x + y) `quot` 2
+             !y1 = x1 - k
+         in [(x1,y1), (x,y)]
+    else let !y1 = (x + y) `quot` 2
+             !x1 = y1 - k
+         in [(x1,y1), (x,y)]
+  where d = abs x + abs y -- <= 2 * k
+
+-- x >= 0 && y >= 0
+solve :: Int -> Int -> Int -> [(Int,Int)]
+solve !k !x !y
+  | d < 2 * k = solveSmall k x y
+  -- Now x + y >= 2 * k holds, which implies x >= k || y >= k
+  | otherwise =
+    let (q,r) = x `quotRem` k -- 0 <= r < k
+        (q',r') = y `quotRem` k -- 0 <= r' < k
+        -- abs (q*k - x) + abs (q'*k - y)
+        --   = r + r' < 2*k-1
+        (m,n) | 0 < r + r' && r + r' < k =
+                -- 2*k <= x + y = (q+q')*k + r+r'
+                -- k < 2*k - (r+r') <= (q+q')*k
+                -- Therefore, 1 < q+q'
+                if q > q'
+                then (q-1,q')
+                else (q,q'-1)
+              | otherwise {- k <= r+r' -} = (q,q')
+        !x1 = m*k
+        !y1 = n*k
+    in [(i*k,0) | i <- [1..m]] ++ [(x1,j*k) | j <- [1..n]] ++ map (bimap (+ x1) (+ y1)) (solveSmall k (x-x1) (y-y1))
+  where d = abs x + abs y
+
+main = do
+  k <- readLn
+  [x,y] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  if k >= 2 && even k && odd (x + y)
+    then putStrLn "-1"
+    else do let xs = solve k (abs x) (abs y)
+                ys | x < 0 && y < 0 = map (bimap negate negate) xs
+                   | x < 0 = map (first negate) xs
+                   | y < 0 = map (second negate) xs
+                   | otherwise = xs
+            -- print $ check k ys
+            print $ length ys
+            forM_ ys $ \(x',y') -> putStrLn $ unwords [show x', show y']
+
+check :: Int -> [(Int,Int)] -> Bool
+check !k xs = and $ zipWith (\(x0,y0) (x1,y1) -> abs (x0-x1) + abs (y0-y1) == k) ((0,0) : xs) xs

From 47c8c29c1c68ef2d7163fa03c727f0c4baeadb5b Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Sun, 28 Jul 2019 02:52:16 +0900
Subject: [PATCH 077/148] ABC135-E: Use ByteString.Builder for output

---
 abc/abc135-e/Main.hs | 6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/abc/abc135-e/Main.hs b/abc/abc135-e/Main.hs
index 6aa8a65..9278d27 100644
--- a/abc/abc135-e/Main.hs
+++ b/abc/abc135-e/Main.hs
@@ -5,8 +5,11 @@ import Data.List (unfoldr)
 import Control.Monad
 import qualified Data.Vector.Unboxed as U
 import qualified Data.ByteString.Char8 as BS
+import qualified Data.ByteString.Builder as BSB
 import Data.Bifunctor
 import Control.Exception
+import System.IO
+import Data.Monoid
 
 -- d <= 2 * k && x >= 0 && y >= 0 && (even (x + y) || odd k)
 solveSmall :: Int -> Int -> Int -> [(Int,Int)]
@@ -68,7 +71,8 @@ main = do
                    | otherwise = xs
             -- print $ check k ys
             print $ length ys
-            forM_ ys $ \(x',y') -> putStrLn $ unwords [show x', show y']
+            -- forM_ ys $ \(x',y') -> putStrLn $ unwords [show x', show y']
+            BSB.hPutBuilder stdout $ mconcat $ map (\(x',y') -> BSB.intDec x' <> BSB.char7 ' ' <> BSB.intDec y' <> BSB.char7 '\n') ys
 
 check :: Int -> [(Int,Int)] -> Bool
 check !k xs = and $ zipWith (\(x0,y0) (x1,y1) -> abs (x0-x1) + abs (y0-y1) == k) ((0,0) : xs) xs

From e550e1487887ade44e55378c24cebe2bc2d32de0 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Sun, 4 Aug 2019 22:42:13 +0900
Subject: [PATCH 078/148] ABC136

---
 abc/README.md        |  11 ++++
 abc/abc136-a/Main.hs |   8 +++
 abc/abc136-b/Main.hs |   5 ++
 abc/abc136-c/Main.hs |  17 ++++++
 abc/abc136-d/Main.hs |  38 +++++++++++++
 abc/abc136-e/Main.hs | 125 +++++++++++++++++++++++++++++++++++++++++++
 6 files changed, 204 insertions(+)
 create mode 100644 abc/abc136-a/Main.hs
 create mode 100644 abc/abc136-b/Main.hs
 create mode 100644 abc/abc136-c/Main.hs
 create mode 100644 abc/abc136-d/Main.hs
 create mode 100644 abc/abc136-e/Main.hs

diff --git a/abc/README.md b/abc/README.md
index 0074e88..d8b0ceb 100644
--- a/abc/README.md
+++ b/abc/README.md
@@ -255,3 +255,14 @@
 * [x] D - Digits Parade
 * [x] E - Golf
 * [ ] F - Strings of Eternity
+
+## AtCoder Beginner Contest 136 (2019-08-04)
+
+<https://atcoder.jp/contests/abc136>
+
+* [x] A - Transfer
+* [x] B - Uneven Numbers
+* [x] C - Build Stairs
+* [x] D - Gathering Children
+* [x] E - Max GCD
+* [ ] F - Enclosed Points
diff --git a/abc/abc136-a/Main.hs b/abc/abc136-a/Main.hs
new file mode 100644
index 0000000..4e76cb9
--- /dev/null
+++ b/abc/abc136-a/Main.hs
@@ -0,0 +1,8 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  [a,b,c] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  print $ max 0 (c-a+b)
diff --git a/abc/abc136-b/Main.hs b/abc/abc136-b/Main.hs
new file mode 100644
index 0000000..9cd4004
--- /dev/null
+++ b/abc/abc136-b/Main.hs
@@ -0,0 +1,5 @@
+-- https://github.com/minoki/my-atcoder-solutions
+
+main = do
+  n <- readLn
+  print $ length [() | i <- [1..n], odd $ length $ show (i :: Int)]
diff --git a/abc/abc136-c/Main.hs b/abc/abc136-c/Main.hs
new file mode 100644
index 0000000..2615f84
--- /dev/null
+++ b/abc/abc136-c/Main.hs
@@ -0,0 +1,17 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import qualified Data.Vector.Unboxed as U
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  n <- readLn
+  xs <- U.unfoldrN n (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  let result = U.foldr' (\x h -> case h of
+                            Just h' | x <= h'+1 -> Just $! min h' x
+                            _ -> Nothing
+                        ) (Just $ 10^9) xs
+  case result of
+    Just _ -> putStrLn "Yes"
+    Nothing -> putStrLn "No"
diff --git a/abc/abc136-d/Main.hs b/abc/abc136-d/Main.hs
new file mode 100644
index 0000000..2912855
--- /dev/null
+++ b/abc/abc136-d/Main.hs
@@ -0,0 +1,38 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.Int (Int64)
+import Data.List (unfoldr, intersperse)
+import Control.Monad
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.ByteString.Builder as BSB
+import System.IO
+import Data.Monoid
+
+type Map = U.Vector Int
+
+compose :: Int -> Map -> Map -> Map
+compose !n xs ys = U.generate n (\i -> xs U.! (ys U.! i))
+
+powMap :: Int -> Map -> Integer -> Map
+powMap !n xs 0 = U.generate n id
+powMap !n xs m = loop xs xs (m-1)
+  where
+    loop !acc !ys 0 = acc
+    loop !acc !ys 1 = compose n acc ys
+    loop !acc !ys m = case m `quotRem` 2 of
+                        (m',0) -> loop acc (compose n ys ys) m'
+                        (m',_) -> loop (compose n acc ys) (compose n ys ys) m'
+
+main = do
+  s <- BS.getLine
+  let n = BS.length s
+  let xs = U.generate n (\i -> if BS.index s i == 'R' then i + 1 else i - 1)
+  let zs = powMap n xs (10^100)
+  let result = U.create $ do
+        vec <- UM.replicate n 0
+        U.forM_ zs $ \i -> UM.modify vec (+1) i
+        return vec
+  BSB.hPutBuilder stdout $ (mconcat $ intersperse (BSB.char7 ' ') $ map BSB.intDec $ U.toList result) <> BSB.char7 '\n'
diff --git a/abc/abc136-e/Main.hs b/abc/abc136-e/Main.hs
new file mode 100644
index 0000000..9291b80
--- /dev/null
+++ b/abc/abc136-e/Main.hs
@@ -0,0 +1,125 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.Int (Int64)
+import Data.List
+import Control.Monad
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+import Data.Maybe
+
+main = do
+  [n,k] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  xs <- U.unfoldrN n (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  let s = U.sum xs
+      ss = floor (sqrt (fromIntegral s)) :: Int
+  let factors = sortBy (flip compare) $ concat [[i,s `quot` i] | i <- [1..ss], s `rem` i == 0]
+  let try g = do
+        let ys = mergeSort $ U.filter (/= (0,0)) $ U.map (\x -> let (q,r) = x `quotRem` g
+                                                                in if r == 0
+                                                                   then (0,0)
+                                                                   else (r,g-r)
+                                                         ) xs
+        let zs0 = U.map (<= k) $ U.scanl' (+) 0 $ U.map fst ys
+        let zs1 = U.map (<= k) $ U.scanr' (+) 0 $ U.map snd ys
+        U.or $ U.zipWith (&&) zs0 zs1
+  let result = head $ filter try factors
+  print result
+  {-
+  if s - U.maximum xs <= k
+    then print s
+    else putStrLn "???"
+  -}
+
+--
+-- Prime numbers
+--
+
+infixr 5 !:
+(!:) :: a -> [a] -> [a]
+(!x) !: xs = x : xs
+
+-- | エラトステネスの篩により、 max 以下の素数の一覧を構築して返す
+-- >>> sieve 100
+-- [2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97]
+sieve :: Int -> [Int64]
+sieve !max = 2 : U.ifoldr (\i isPrime xs -> if isPrime then fromIntegral (2 * i + 1) !: xs else xs) [] vec
+  where
+    vec = U.create $ do
+      vec <- UM.replicate ((max - 1) `quot` 2 + 1) True
+      UM.write vec 0 False -- 1 is not a prime
+      -- vec ! i : is (2 * i + 1) prime?
+      let clear !p = forM_ [3*p,5*p..max] $ \n -> UM.write vec (n `quot` 2) False
+          factorBound = floor (sqrt (fromIntegral max) :: Double)
+          loop !i | 2 * i + 1 > factorBound = return ()
+                  | otherwise = do b <- UM.read vec i
+                                   when b $ clear (2 * i + 1)
+                                   loop (i + 1)
+      loop 1
+      return vec
+
+-- |
+-- >>> takeWhile (< 100) primes
+-- [2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97]
+primes :: [Int64]
+primes = sieve 31622
+-- floor (sqrt (10^9+9)) == 31622
+-- length primes == 3401
+
+-- x <= 10^9+9
+-- |
+-- >>> factor 100
+-- [(2,2),(5,2)]
+-- >>> factor 144
+-- [(2,4),(3,2)]
+-- >>> factor (10^9+6)
+-- [(2,1),(500000003,1)]
+-- >>> factor (10^9+7)
+-- [(1000000007,1)]
+factor :: Int64 -> [(Int64, Int)]
+factor 0 = error "factor 0"
+factor x | x > 10^9+9 = error "factor: too large"
+factor x = loop x primes
+  where
+    loop 1 _ = []
+    loop x (p:ps) = case factorOut 0 x p of
+                      (0,y) -> loop x ps
+                      (n,y) -> (p,n) : loop y ps
+    loop x [] = [(x,1)]
+    factorOut !n !x !p | (q,0) <- x `quotRem` p = factorOut (n+1) q p
+                       | otherwise = (n, x)
+
+--
+-- Merge Sort
+--
+
+mergeSortBy :: (U.Unbox a) => (a -> a -> Ordering) -> U.Vector a -> U.Vector a
+mergeSortBy !cmp !vec = doSort vec
+  where
+    doSort vec | U.length vec <= 1 = vec
+               | otherwise = let (xs, ys) = U.splitAt (U.length vec `quot` 2) vec
+                             in merge (doSort xs) (doSort ys)
+    merge xs ys = U.create $ do
+      let !n = U.length xs
+          !m = U.length ys
+      result <- UM.new (n + m)
+      let loop !i !j
+            | i == n = U.copy (UM.drop (i + j) result) (U.drop j ys)
+            | j == m = U.copy (UM.drop (i + j) result) (U.drop i xs)
+            | otherwise = let !x = xs U.! i
+                              !y = ys U.! j
+                          in case cmp x y of
+                               LT -> do UM.write result (i + j) x
+                                        loop (i + 1) j
+                               EQ -> do UM.write result (i + j) x
+                                        UM.write result (i + j + 1) y
+                                        loop (i + 1) (j + 1)
+                               GT -> do UM.write result (i + j) y
+                                        loop i (j + 1)
+      loop 0 0
+      return result
+
+mergeSort :: (U.Unbox a, Ord a) => U.Vector a -> U.Vector a
+mergeSort = mergeSortBy compare

From 8af31f46dd142a2a39d921fed10a3813ac8588e5 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Thu, 8 Aug 2019 20:59:17 +0900
Subject: [PATCH 079/148] Move solutions for Educational DP Contests under
 educational-dp/

---
 {dp-a => educational-dp/dp-a}/Main.hs         | 0
 {dp-b => educational-dp/dp-b}/Main.hs         | 0
 {dp-c => educational-dp/dp-c}/Main.hs         | 0
 {dp-d => educational-dp/dp-d}/Main.hs         | 0
 {dp-e => educational-dp/dp-e}/Main.hs         | 0
 {dp-f => educational-dp/dp-f}/Main.hs         | 0
 {dp-f => educational-dp/dp-f}/mkrandinput.lua | 0
 {dp-g => educational-dp/dp-g}/Main.hs         | 0
 {dp-g => educational-dp/dp-g}/Simple.hs       | 0
 {dp-h => educational-dp/dp-h}/Main.hs         | 0
 {dp-i => educational-dp/dp-i}/Main.hs         | 0
 {dp-j => educational-dp/dp-j}/Main.hs         | 0
 {dp-k => educational-dp/dp-k}/Main.hs         | 0
 {dp-l => educational-dp/dp-l}/Main.hs         | 0
 {dp-m => educational-dp/dp-m}/Main.hs         | 0
 {dp-n => educational-dp/dp-n}/Main.hs         | 0
 {dp-o => educational-dp/dp-o}/Main.hs         | 0
 {dp-o => educational-dp/dp-o}/Vector.hs       | 0
 {dp-p => educational-dp/dp-p}/Main.hs         | 0
 {dp-q => educational-dp/dp-q}/BIT.hs          | 0
 {dp-q => educational-dp/dp-q}/Main.hs         | 0
 {dp-q => educational-dp/dp-q}/SegTree.hs      | 0
 {dp-r => educational-dp/dp-r}/Main.hs         | 0
 {dp-s => educational-dp/dp-s}/Main.hs         | 0
 {dp-t => educational-dp/dp-t}/Main.hs         | 0
 {dp-u => educational-dp/dp-u}/Main.hs         | 0
 {dp-v => educational-dp/dp-v}/Main.hs         | 0
 27 files changed, 0 insertions(+), 0 deletions(-)
 rename {dp-a => educational-dp/dp-a}/Main.hs (100%)
 rename {dp-b => educational-dp/dp-b}/Main.hs (100%)
 rename {dp-c => educational-dp/dp-c}/Main.hs (100%)
 rename {dp-d => educational-dp/dp-d}/Main.hs (100%)
 rename {dp-e => educational-dp/dp-e}/Main.hs (100%)
 rename {dp-f => educational-dp/dp-f}/Main.hs (100%)
 rename {dp-f => educational-dp/dp-f}/mkrandinput.lua (100%)
 rename {dp-g => educational-dp/dp-g}/Main.hs (100%)
 rename {dp-g => educational-dp/dp-g}/Simple.hs (100%)
 rename {dp-h => educational-dp/dp-h}/Main.hs (100%)
 rename {dp-i => educational-dp/dp-i}/Main.hs (100%)
 rename {dp-j => educational-dp/dp-j}/Main.hs (100%)
 rename {dp-k => educational-dp/dp-k}/Main.hs (100%)
 rename {dp-l => educational-dp/dp-l}/Main.hs (100%)
 rename {dp-m => educational-dp/dp-m}/Main.hs (100%)
 rename {dp-n => educational-dp/dp-n}/Main.hs (100%)
 rename {dp-o => educational-dp/dp-o}/Main.hs (100%)
 rename {dp-o => educational-dp/dp-o}/Vector.hs (100%)
 rename {dp-p => educational-dp/dp-p}/Main.hs (100%)
 rename {dp-q => educational-dp/dp-q}/BIT.hs (100%)
 rename {dp-q => educational-dp/dp-q}/Main.hs (100%)
 rename {dp-q => educational-dp/dp-q}/SegTree.hs (100%)
 rename {dp-r => educational-dp/dp-r}/Main.hs (100%)
 rename {dp-s => educational-dp/dp-s}/Main.hs (100%)
 rename {dp-t => educational-dp/dp-t}/Main.hs (100%)
 rename {dp-u => educational-dp/dp-u}/Main.hs (100%)
 rename {dp-v => educational-dp/dp-v}/Main.hs (100%)

diff --git a/dp-a/Main.hs b/educational-dp/dp-a/Main.hs
similarity index 100%
rename from dp-a/Main.hs
rename to educational-dp/dp-a/Main.hs
diff --git a/dp-b/Main.hs b/educational-dp/dp-b/Main.hs
similarity index 100%
rename from dp-b/Main.hs
rename to educational-dp/dp-b/Main.hs
diff --git a/dp-c/Main.hs b/educational-dp/dp-c/Main.hs
similarity index 100%
rename from dp-c/Main.hs
rename to educational-dp/dp-c/Main.hs
diff --git a/dp-d/Main.hs b/educational-dp/dp-d/Main.hs
similarity index 100%
rename from dp-d/Main.hs
rename to educational-dp/dp-d/Main.hs
diff --git a/dp-e/Main.hs b/educational-dp/dp-e/Main.hs
similarity index 100%
rename from dp-e/Main.hs
rename to educational-dp/dp-e/Main.hs
diff --git a/dp-f/Main.hs b/educational-dp/dp-f/Main.hs
similarity index 100%
rename from dp-f/Main.hs
rename to educational-dp/dp-f/Main.hs
diff --git a/dp-f/mkrandinput.lua b/educational-dp/dp-f/mkrandinput.lua
similarity index 100%
rename from dp-f/mkrandinput.lua
rename to educational-dp/dp-f/mkrandinput.lua
diff --git a/dp-g/Main.hs b/educational-dp/dp-g/Main.hs
similarity index 100%
rename from dp-g/Main.hs
rename to educational-dp/dp-g/Main.hs
diff --git a/dp-g/Simple.hs b/educational-dp/dp-g/Simple.hs
similarity index 100%
rename from dp-g/Simple.hs
rename to educational-dp/dp-g/Simple.hs
diff --git a/dp-h/Main.hs b/educational-dp/dp-h/Main.hs
similarity index 100%
rename from dp-h/Main.hs
rename to educational-dp/dp-h/Main.hs
diff --git a/dp-i/Main.hs b/educational-dp/dp-i/Main.hs
similarity index 100%
rename from dp-i/Main.hs
rename to educational-dp/dp-i/Main.hs
diff --git a/dp-j/Main.hs b/educational-dp/dp-j/Main.hs
similarity index 100%
rename from dp-j/Main.hs
rename to educational-dp/dp-j/Main.hs
diff --git a/dp-k/Main.hs b/educational-dp/dp-k/Main.hs
similarity index 100%
rename from dp-k/Main.hs
rename to educational-dp/dp-k/Main.hs
diff --git a/dp-l/Main.hs b/educational-dp/dp-l/Main.hs
similarity index 100%
rename from dp-l/Main.hs
rename to educational-dp/dp-l/Main.hs
diff --git a/dp-m/Main.hs b/educational-dp/dp-m/Main.hs
similarity index 100%
rename from dp-m/Main.hs
rename to educational-dp/dp-m/Main.hs
diff --git a/dp-n/Main.hs b/educational-dp/dp-n/Main.hs
similarity index 100%
rename from dp-n/Main.hs
rename to educational-dp/dp-n/Main.hs
diff --git a/dp-o/Main.hs b/educational-dp/dp-o/Main.hs
similarity index 100%
rename from dp-o/Main.hs
rename to educational-dp/dp-o/Main.hs
diff --git a/dp-o/Vector.hs b/educational-dp/dp-o/Vector.hs
similarity index 100%
rename from dp-o/Vector.hs
rename to educational-dp/dp-o/Vector.hs
diff --git a/dp-p/Main.hs b/educational-dp/dp-p/Main.hs
similarity index 100%
rename from dp-p/Main.hs
rename to educational-dp/dp-p/Main.hs
diff --git a/dp-q/BIT.hs b/educational-dp/dp-q/BIT.hs
similarity index 100%
rename from dp-q/BIT.hs
rename to educational-dp/dp-q/BIT.hs
diff --git a/dp-q/Main.hs b/educational-dp/dp-q/Main.hs
similarity index 100%
rename from dp-q/Main.hs
rename to educational-dp/dp-q/Main.hs
diff --git a/dp-q/SegTree.hs b/educational-dp/dp-q/SegTree.hs
similarity index 100%
rename from dp-q/SegTree.hs
rename to educational-dp/dp-q/SegTree.hs
diff --git a/dp-r/Main.hs b/educational-dp/dp-r/Main.hs
similarity index 100%
rename from dp-r/Main.hs
rename to educational-dp/dp-r/Main.hs
diff --git a/dp-s/Main.hs b/educational-dp/dp-s/Main.hs
similarity index 100%
rename from dp-s/Main.hs
rename to educational-dp/dp-s/Main.hs
diff --git a/dp-t/Main.hs b/educational-dp/dp-t/Main.hs
similarity index 100%
rename from dp-t/Main.hs
rename to educational-dp/dp-t/Main.hs
diff --git a/dp-u/Main.hs b/educational-dp/dp-u/Main.hs
similarity index 100%
rename from dp-u/Main.hs
rename to educational-dp/dp-u/Main.hs
diff --git a/dp-v/Main.hs b/educational-dp/dp-v/Main.hs
similarity index 100%
rename from dp-v/Main.hs
rename to educational-dp/dp-v/Main.hs

From b28776274e00605cde1e1ab005909460044da48a Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Sat, 10 Aug 2019 23:17:27 +0900
Subject: [PATCH 080/148] ABC137

---
 abc/README.md        | 11 +++++++++++
 abc/abc137-a/Main.hs |  8 ++++++++
 abc/abc137-b/Main.hs |  8 ++++++++
 abc/abc137-c/Main.hs | 13 +++++++++++++
 abc/abc137-d/Main.hs | 31 +++++++++++++++++++++++++++++++
 5 files changed, 71 insertions(+)
 create mode 100644 abc/abc137-a/Main.hs
 create mode 100644 abc/abc137-b/Main.hs
 create mode 100644 abc/abc137-c/Main.hs
 create mode 100644 abc/abc137-d/Main.hs

diff --git a/abc/README.md b/abc/README.md
index d8b0ceb..8d61ae7 100644
--- a/abc/README.md
+++ b/abc/README.md
@@ -266,3 +266,14 @@
 * [x] D - Gathering Children
 * [x] E - Max GCD
 * [ ] F - Enclosed Points
+
+## AtCoder Beginner Contest 137 (2019-08-10)
+
+<https://atcoder.jp/contests/abc137>
+
+* [x] A - +-x
+* [x] B - One Clue
+* [x] C - Green Bin
+* [x] D - Summer Vacation
+* [ ] E - Coins Respawn
+* [ ] F - Polynomial Construction
diff --git a/abc/abc137-a/Main.hs b/abc/abc137-a/Main.hs
new file mode 100644
index 0000000..d32e630
--- /dev/null
+++ b/abc/abc137-a/Main.hs
@@ -0,0 +1,8 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  [a,b] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  print $ maximum [a+b,a-b,a*b]
diff --git a/abc/abc137-b/Main.hs b/abc/abc137-b/Main.hs
new file mode 100644
index 0000000..6e8abc1
--- /dev/null
+++ b/abc/abc137-b/Main.hs
@@ -0,0 +1,8 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  [k,x] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  putStrLn $ unwords $ map show [x-k+1..x+k-1]
diff --git a/abc/abc137-c/Main.hs b/abc/abc137-c/Main.hs
new file mode 100644
index 0000000..30996cc
--- /dev/null
+++ b/abc/abc137-c/Main.hs
@@ -0,0 +1,13 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Char (isSpace)
+import Data.Int (Int64)
+import Data.List (unfoldr, group, sort)
+import Control.Monad
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  n <- readLn
+  ss <- replicateM n $ do
+    BS.sort <$> BS.getLine
+  let xs = map (fromIntegral . length) $ group $ sort ss
+  print (sum [x*(x-1) `quot` 2 | x <- xs] :: Int64)
diff --git a/abc/abc137-d/Main.hs b/abc/abc137-d/Main.hs
new file mode 100644
index 0000000..bc4a25b
--- /dev/null
+++ b/abc/abc137-d/Main.hs
@@ -0,0 +1,31 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import Control.Monad
+import qualified Data.Vector as V
+import qualified Data.Vector.Mutable as VM
+import qualified Data.Vector.Unboxed as U
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.IntMap.Strict as IntMap
+
+main = do
+  [n,m] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  xs <- U.replicateM n $ do
+    [a,b] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+    return (a,b)
+  let ys = V.create $ do
+        vec <- VM.replicate (m+1) IntMap.empty
+        U.forM_ xs $ \(a,b) -> do
+          when (a <= m) $ do
+            VM.modify vec (IntMap.insertWith (+) b 1) a
+        return vec
+  let loop !acc w !i
+        | i > m = acc
+        | otherwise = let w' = (IntMap.unionWith (+) w (ys V.! i))
+                      in if IntMap.null w'
+                         then loop acc w' (i+1)
+                         else let (b,_) = IntMap.findMax w'
+                                  w'' = IntMap.updateMax (\x -> if x == 1 then Nothing else Just (x-1)) w'
+                              in loop (acc + b) w'' (i+1)
+  print $ loop 0 IntMap.empty 0

From 30a2d0c40a1b0ca04dacd073f2505e479db63406 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Sat, 10 Aug 2019 23:17:44 +0900
Subject: [PATCH 081/148] ABC137-F: Slow solution

---
 abc/abc137-f/Main.hs     | 204 +++++++++++++++++++++++++++++++++++++++
 abc/abc137-f/mkinput.lua |   8 ++
 2 files changed, 212 insertions(+)
 create mode 100644 abc/abc137-f/Main.hs
 create mode 100644 abc/abc137-f/mkinput.lua

diff --git a/abc/abc137-f/Main.hs b/abc/abc137-f/Main.hs
new file mode 100644
index 0000000..2da1d2f
--- /dev/null
+++ b/abc/abc137-f/Main.hs
@@ -0,0 +1,204 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.Int (Int64)
+import Data.List (unfoldr, intersperse)
+import Control.Monad
+import qualified Data.Vector as V
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.Vector.Generic
+import qualified Data.Vector.Generic.Mutable
+import qualified Data.ByteString.Char8 as BS
+import Data.Proxy
+import Data.Coerce
+import Data.Monoid
+import qualified Data.ByteString.Builder as BSB
+import System.IO
+import Data.Bits
+---
+import Unsafe.Coerce
+
+type Poly p = U.Vector (IntMod p)
+
+normalize :: IsInt64 p => Poly p -> Poly p
+normalize p | U.null p || U.last p /= 0 = p
+            | otherwise = normalize (U.init p)
+
+addP :: IsInt64 p => Poly p -> Poly p -> Poly p
+addP v w | n <= m = normalize $ U.accumulate (+) w (U.indexed v)
+         | otherwise = normalize $ U.accumulate (+) v (U.indexed w)
+  where n = U.length v
+        m = U.length w
+
+subP :: IsInt64 p => Poly p -> Poly p -> Poly p
+subP v w | n <= m = normalize $ U.accumulate subtract w (U.indexed v)
+         | otherwise = normalize $ U.accumulate (-) v (U.indexed w)
+  where n = U.length v
+        m = U.length w
+
+naiveMulP :: IsInt64 p => Poly p -> Poly p -> Poly p
+naiveMulP v w = U.generate (n + m - 1) $
+           \i -> sum [(v U.! (i-j)) * (w U.! j) | j <- [max (i-n+1) 0..min i (m-1)]]
+  where n = U.length v
+        m = U.length w
+
+mul1 :: IsInt64 p => IntMod p -> Poly p -> Poly p
+-- mul1 k v = mulP (U.fromList [-k, 1]) v
+mul1 k v = U.generate (U.length v + 1) $ \i -> if i == 0
+                                               then -k * v U.! 0
+                                               else if i == U.length v
+                                                    then v U.! (i-1)
+                                                    else v U.! (i-1) - k * (v U.! i)
+
+doMulP :: forall p. IsInt64 p => Int -> Poly p -> Poly p -> Poly p
+doMulP n !v !w | n <= 16 = naiveMulP v w
+doMulP n !v !w
+  | U.null v = v
+  | U.null w = w
+  | U.length v < n2 = let (w0, w1) = U.splitAt n2 w
+                          u0 = doMulP n2 v w0
+                          u1 = doMulP n2 v w1
+                      in U.generate (U.length v + U.length w - 1)
+                         $ \i -> case () of
+                                   _ | i < n2     ->  u0 `at` i
+                                     | i < n      -> (u0 `at` i) + (u1 `at` (i - n2))
+                                     | i < n + n2 -> (u1 `at` (i - n2))
+  | U.length w < n2 = let (v0, v1) = U.splitAt n2 v
+                          u0 = doMulP n2 v0 w
+                          u1 = doMulP n2 v1 w
+                      in U.generate (U.length v + U.length w - 1)
+                         $ \i -> case () of
+                                   _ | i < n2     ->  u0 `at` i
+                                     | i < n      -> (u0 `at` i) + (u1 `at` (i - n2))
+                                     | i < n + n2 -> (u1 `at` (i - n2))
+  | otherwise = let (v0, v1) = U.splitAt n2 v
+                    (w0, w1) = U.splitAt n2 w
+                    v0_1 = v0 `addP` v1
+                    w0_1 = w0 `addP` w1
+                    p = doMulP n2 v0_1 w0_1
+                    q = doMulP n2 v0 w0
+                    r = doMulP n2 v1 w1
+                    -- s = (p `subP` q) `subP` r -- p - q - r
+                    -- q + s*X^n2 + r*X^n
+                in U.generate (U.length v + U.length w - 1)
+                   $ \i -> case () of
+                             _ | i < n2     ->   q `at` i
+                               | i < n      -> ((q `at` i) + (p `at` (i - n2))) - ((q `at` (i - n2)) + (r `at` (i - n2)))
+                               | i < n + n2 -> ((r `at` (i - n)) + (p `at` (i - n2))) - ((q `at` (i - n2)) + (r `at` (i - n2)))
+                               | otherwise  ->   r `at` (i - n)
+  where n2 = n `quot` 2
+        at :: Poly p -> Int -> IntMod p
+        at v i = if i < U.length v then v U.! i else 0
+
+mulP :: IsInt64 p => Poly p -> Poly p -> Poly p
+mulP !v !w = U.create $ do
+  let !vl = U.length v
+      !wl = U.length w
+      n = ceiling ((log (fromIntegral (vl .|. wl)) :: Double) / log 2) :: Int
+  U.thaw (doMulP (2^n) v w)
+
+solve :: forall p. IsInt64 p => U.Vector Int -> Proxy p -> IO ()
+solve a proxy = let p :: Int
+                    p = fromIntegral (int64Val proxy)
+                    xs :: V.Vector (Poly p)
+                    xs = V.generate p $ \i -> U.fromList [fromIntegral (-i), 1]
+                    ls, rs :: V.Vector (Poly p)
+                    ls = V.scanl (\p k -> mul1 k p) (U.singleton 1) $ V.enumFromN 0 p
+                    rs = V.scanr (\k p -> mul1 k p) (U.singleton 1) $ V.enumFromN 0 p
+                    {-
+                    ls = V.scanl' mulP (U.singleton 1) xs
+                    rs = V.scanr' mulP (U.singleton 1) xs
+                    -}
+                    ps = V.zipWith mulP ls (V.tail rs)
+                    aa = U.length $ U.filter (== 0) a
+                    result | 2 * aa >= U.length a = U.map negate $ U.create $ do
+                               vec <- UM.new p
+                               V.forM_ (V.zip ps (V.convert a)) $ \(p,a) -> do
+                                 when (a == 1) $ do
+                                   U.imapM_ (\i x -> UM.modify vec (+ x) i) p
+                               return vec
+                               -- V.foldl' (\s (p,a) -> if a == 1 then s `addP` p else s) U.empty (V.zip ps (V.convert a))
+                           | otherwise = U.singleton 1 `addP` (U.create $ do
+                               vec <- UM.new p
+                               V.forM_ (V.zip ps (V.convert a)) $ \(p,a) -> do
+                                 when (a == 0) $ do
+                                   U.imapM_ (\i x -> UM.modify vec (+ x) i) p
+                               return vec
+                                                              )
+                in BSB.hPutBuilder stdout $ (mconcat $ intersperse (BSB.char7 ' ') $ map (BSB.int64Dec . getIntMod) $ U.toList (result <> U.replicate (p - U.length result) 0)) <> BSB.char7 '\n'
+
+main = do
+  p <- readLn -- 2 <= p <= 2999
+  xs <- U.unfoldrN p (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  reifyInt64 (fromIntegral p) (solve xs)
+
+---
+
+newtype IntMod m = IntMod { getIntMod :: Int64 } deriving Eq
+instance Show (IntMod m) where
+  show (IntMod x) = show x
+instance IsInt64 m => Num (IntMod m) where
+  t@(IntMod x) + IntMod y = IntMod $ let !p = int64Val t
+                                         !s = x + y
+                                     in if s >= p then s - p else s
+                                     -- ((x + y) `rem` int64Val t)
+  t@(IntMod x) - IntMod y = IntMod ((x - y) `mod` int64Val t)
+  t@(IntMod x) * IntMod y = IntMod ((x * y) `rem` int64Val t)
+  negate t@(IntMod x) = let m = int64Val t in IntMod ((m - x) `rem` m)
+  fromInteger n = IntMod $ fromInteger $ n `mod` fromIntegral (int64Val (Proxy :: Proxy m))
+  abs = undefined; signum = undefined
+
+---
+
+newtype Tagged tag a = Tagged { getTagged :: a }
+
+class IsInt64 tag where
+  taggedInt64Val :: Tagged tag Int64
+
+int64Val :: forall proxy tag. IsInt64 tag => proxy tag -> Int64
+int64Val _ = getTagged (taggedInt64Val :: Tagged tag Int64)
+
+---
+
+-- See Data.Reflection
+newtype MagicInt64 a = MagicInt64 (forall tag. IsInt64 tag => Proxy tag -> a)
+reifyInt64 :: forall a. Int64 -> (forall tag. IsInt64 tag => Proxy tag -> a) -> a
+reifyInt64 x f = unsafeCoerce (MagicInt64 f :: MagicInt64 a) x Proxy
+
+--
+-- instance U.Unbox (IntMod m)
+--
+
+newtype instance UM.MVector s (IntMod m) = MV_IntMod (UM.MVector s Int64)
+newtype instance U.Vector (IntMod m) = V_IntMod (U.Vector Int64)
+
+instance Data.Vector.Generic.Mutable.MVector UM.MVector (IntMod m) where -- needs MultiParamTypeClasses here
+  basicLength (MV_IntMod mv) = Data.Vector.Generic.Mutable.basicLength mv
+  basicUnsafeSlice i l (MV_IntMod mv) = MV_IntMod (Data.Vector.Generic.Mutable.basicUnsafeSlice i l mv)
+  basicOverlaps (MV_IntMod mv) (MV_IntMod mv') = Data.Vector.Generic.Mutable.basicOverlaps mv mv'
+  basicUnsafeNew l = MV_IntMod <$> Data.Vector.Generic.Mutable.basicUnsafeNew l
+  basicInitialize (MV_IntMod mv) = Data.Vector.Generic.Mutable.basicInitialize mv
+  basicUnsafeReplicate i x = MV_IntMod <$> Data.Vector.Generic.Mutable.basicUnsafeReplicate i (coerce x)
+  basicUnsafeRead (MV_IntMod mv) i = coerce <$> Data.Vector.Generic.Mutable.basicUnsafeRead mv i
+  basicUnsafeWrite (MV_IntMod mv) i x = Data.Vector.Generic.Mutable.basicUnsafeWrite mv i (coerce x)
+  basicClear (MV_IntMod mv) = Data.Vector.Generic.Mutable.basicClear mv
+  basicSet (MV_IntMod mv) x = Data.Vector.Generic.Mutable.basicSet mv (coerce x)
+  basicUnsafeCopy (MV_IntMod mv) (MV_IntMod mv') = Data.Vector.Generic.Mutable.basicUnsafeCopy mv mv'
+  basicUnsafeMove (MV_IntMod mv) (MV_IntMod mv') = Data.Vector.Generic.Mutable.basicUnsafeMove mv mv'
+  basicUnsafeGrow (MV_IntMod mv) n = MV_IntMod <$> Data.Vector.Generic.Mutable.basicUnsafeGrow mv n
+
+instance Data.Vector.Generic.Vector U.Vector (IntMod m) where -- needs MultiParamTypeClasses here
+  basicUnsafeFreeze (MV_IntMod mv) = V_IntMod <$> Data.Vector.Generic.basicUnsafeFreeze mv
+  basicUnsafeThaw (V_IntMod v) = MV_IntMod <$> Data.Vector.Generic.basicUnsafeThaw v
+  basicLength (V_IntMod v) = Data.Vector.Generic.basicLength v
+  basicUnsafeSlice i l (V_IntMod v) = V_IntMod (Data.Vector.Generic.basicUnsafeSlice i l v)
+  basicUnsafeIndexM (V_IntMod v) i = coerce <$> Data.Vector.Generic.basicUnsafeIndexM v i
+  basicUnsafeCopy (MV_IntMod  mv) (V_IntMod v) = Data.Vector.Generic.basicUnsafeCopy mv v
+  elemseq (V_IntMod v) x y = Data.Vector.Generic.elemseq v (coerce x) y
+
+instance U.Unbox (IntMod m)
diff --git a/abc/abc137-f/mkinput.lua b/abc/abc137-f/mkinput.lua
new file mode 100644
index 0000000..40e6039
--- /dev/null
+++ b/abc/abc137-f/mkinput.lua
@@ -0,0 +1,8 @@
+local p = 1051 -- 2999
+io.output(string.format("input%d.txt", p))
+io.write(tostring(p), "\n")
+local t = {}
+for i = 0, p-1 do
+  table.insert(t, "1")
+end
+io.write(table.concat(t, " "), "\n")

From a2a652bf054d2a36f3cd06f94bc7d2a9800015d2 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Sat, 10 Aug 2019 16:07:22 +0000
Subject: [PATCH 082/148] ABC137-F

---
 abc/README.md            |   2 +-
 abc/abc137-f/Main.hs     | 345 +++++++++++++++++++++++----------------
 abc/abc137-f/mkinput.lua |   2 +-
 3 files changed, 210 insertions(+), 139 deletions(-)

diff --git a/abc/README.md b/abc/README.md
index 8d61ae7..132f5bc 100644
--- a/abc/README.md
+++ b/abc/README.md
@@ -276,4 +276,4 @@
 * [x] C - Green Bin
 * [x] D - Summer Vacation
 * [ ] E - Coins Respawn
-* [ ] F - Polynomial Construction
+* [x] F - Polynomial Construction
diff --git a/abc/abc137-f/Main.hs b/abc/abc137-f/Main.hs
index 2da1d2f..7c367e7 100644
--- a/abc/abc137-f/Main.hs
+++ b/abc/abc137-f/Main.hs
@@ -1,136 +1,41 @@
 -- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE BangPatterns #-}
 import Data.Char (isSpace)
 import Data.Int (Int64)
-import Data.List (unfoldr, intersperse)
+import Data.List (intersperse)
 import Control.Monad
-import qualified Data.Vector as V
 import qualified Data.Vector.Unboxed as U
 import qualified Data.Vector.Unboxed.Mutable as UM
-import qualified Data.Vector.Generic
-import qualified Data.Vector.Generic.Mutable
+import qualified Data.Vector.Generic as G
+import qualified Data.Vector.Generic.Mutable as GM
 import qualified Data.ByteString.Char8 as BS
 import Data.Proxy
 import Data.Coerce
 import Data.Monoid
 import qualified Data.ByteString.Builder as BSB
 import System.IO
-import Data.Bits
 ---
 import Unsafe.Coerce
 
-type Poly p = U.Vector (IntMod p)
-
-normalize :: IsInt64 p => Poly p -> Poly p
-normalize p | U.null p || U.last p /= 0 = p
-            | otherwise = normalize (U.init p)
-
-addP :: IsInt64 p => Poly p -> Poly p -> Poly p
-addP v w | n <= m = normalize $ U.accumulate (+) w (U.indexed v)
-         | otherwise = normalize $ U.accumulate (+) v (U.indexed w)
-  where n = U.length v
-        m = U.length w
-
-subP :: IsInt64 p => Poly p -> Poly p -> Poly p
-subP v w | n <= m = normalize $ U.accumulate subtract w (U.indexed v)
-         | otherwise = normalize $ U.accumulate (-) v (U.indexed w)
-  where n = U.length v
-        m = U.length w
-
-naiveMulP :: IsInt64 p => Poly p -> Poly p -> Poly p
-naiveMulP v w = U.generate (n + m - 1) $
-           \i -> sum [(v U.! (i-j)) * (w U.! j) | j <- [max (i-n+1) 0..min i (m-1)]]
-  where n = U.length v
-        m = U.length w
-
-mul1 :: IsInt64 p => IntMod p -> Poly p -> Poly p
--- mul1 k v = mulP (U.fromList [-k, 1]) v
-mul1 k v = U.generate (U.length v + 1) $ \i -> if i == 0
-                                               then -k * v U.! 0
-                                               else if i == U.length v
-                                                    then v U.! (i-1)
-                                                    else v U.! (i-1) - k * (v U.! i)
-
-doMulP :: forall p. IsInt64 p => Int -> Poly p -> Poly p -> Poly p
-doMulP n !v !w | n <= 16 = naiveMulP v w
-doMulP n !v !w
-  | U.null v = v
-  | U.null w = w
-  | U.length v < n2 = let (w0, w1) = U.splitAt n2 w
-                          u0 = doMulP n2 v w0
-                          u1 = doMulP n2 v w1
-                      in U.generate (U.length v + U.length w - 1)
-                         $ \i -> case () of
-                                   _ | i < n2     ->  u0 `at` i
-                                     | i < n      -> (u0 `at` i) + (u1 `at` (i - n2))
-                                     | i < n + n2 -> (u1 `at` (i - n2))
-  | U.length w < n2 = let (v0, v1) = U.splitAt n2 v
-                          u0 = doMulP n2 v0 w
-                          u1 = doMulP n2 v1 w
-                      in U.generate (U.length v + U.length w - 1)
-                         $ \i -> case () of
-                                   _ | i < n2     ->  u0 `at` i
-                                     | i < n      -> (u0 `at` i) + (u1 `at` (i - n2))
-                                     | i < n + n2 -> (u1 `at` (i - n2))
-  | otherwise = let (v0, v1) = U.splitAt n2 v
-                    (w0, w1) = U.splitAt n2 w
-                    v0_1 = v0 `addP` v1
-                    w0_1 = w0 `addP` w1
-                    p = doMulP n2 v0_1 w0_1
-                    q = doMulP n2 v0 w0
-                    r = doMulP n2 v1 w1
-                    -- s = (p `subP` q) `subP` r -- p - q - r
-                    -- q + s*X^n2 + r*X^n
-                in U.generate (U.length v + U.length w - 1)
-                   $ \i -> case () of
-                             _ | i < n2     ->   q `at` i
-                               | i < n      -> ((q `at` i) + (p `at` (i - n2))) - ((q `at` (i - n2)) + (r `at` (i - n2)))
-                               | i < n + n2 -> ((r `at` (i - n)) + (p `at` (i - n2))) - ((q `at` (i - n2)) + (r `at` (i - n2)))
-                               | otherwise  ->   r `at` (i - n)
-  where n2 = n `quot` 2
-        at :: Poly p -> Int -> IntMod p
-        at v i = if i < U.length v then v U.! i else 0
-
-mulP :: IsInt64 p => Poly p -> Poly p -> Poly p
-mulP !v !w = U.create $ do
-  let !vl = U.length v
-      !wl = U.length w
-      n = ceiling ((log (fromIntegral (vl .|. wl)) :: Double) / log 2) :: Int
-  U.thaw (doMulP (2^n) v w)
-
 solve :: forall p. IsInt64 p => U.Vector Int -> Proxy p -> IO ()
-solve a proxy = let p :: Int
-                    p = fromIntegral (int64Val proxy)
-                    xs :: V.Vector (Poly p)
-                    xs = V.generate p $ \i -> U.fromList [fromIntegral (-i), 1]
-                    ls, rs :: V.Vector (Poly p)
-                    ls = V.scanl (\p k -> mul1 k p) (U.singleton 1) $ V.enumFromN 0 p
-                    rs = V.scanr (\k p -> mul1 k p) (U.singleton 1) $ V.enumFromN 0 p
-                    {-
-                    ls = V.scanl' mulP (U.singleton 1) xs
-                    rs = V.scanr' mulP (U.singleton 1) xs
-                    -}
-                    ps = V.zipWith mulP ls (V.tail rs)
-                    aa = U.length $ U.filter (== 0) a
-                    result | 2 * aa >= U.length a = U.map negate $ U.create $ do
-                               vec <- UM.new p
-                               V.forM_ (V.zip ps (V.convert a)) $ \(p,a) -> do
-                                 when (a == 1) $ do
-                                   U.imapM_ (\i x -> UM.modify vec (+ x) i) p
-                               return vec
-                               -- V.foldl' (\s (p,a) -> if a == 1 then s `addP` p else s) U.empty (V.zip ps (V.convert a))
-                           | otherwise = U.singleton 1 `addP` (U.create $ do
-                               vec <- UM.new p
-                               V.forM_ (V.zip ps (V.convert a)) $ \(p,a) -> do
-                                 when (a == 0) $ do
-                                   U.imapM_ (\i x -> UM.modify vec (+ x) i) p
-                               return vec
-                                                              )
-                in BSB.hPutBuilder stdout $ (mconcat $ intersperse (BSB.char7 ' ') $ map (BSB.int64Dec . getIntMod) $ U.toList (result <> U.replicate (p - U.length result) 0)) <> BSB.char7 '\n'
+solve as proxy = let p :: Int
+                     p = fromIntegral (int64Val proxy)
+                     -- f = x^p - x
+                     f :: Poly U.Vector (IntMod p)
+                     f = Poly $ U.generate (p+1) $ \i -> if i == p then 1 else if i == 1 then -1 else 0
+                     result = U.map negate $ U.create $ do
+                       vec <- UM.replicate p 0
+                       U.forM_ (U.indexed as) $ \(i,a) -> do
+                         when (a == 1) $ do
+                           -- let (p, 0) = f `divModPoly` Poly (U.fromList [fromIntegral (-i), 1])
+                           let (p, 0) = f `divModByDeg1` fromIntegral i
+                           U.imapM_ (\i x -> UM.modify vec (+ x) i) (coeffAsc p)
+                       return vec
+                 in BSB.hPutBuilder stdout $ (mconcat $ intersperse (BSB.char7 ' ') $ map (BSB.int64Dec . getIntMod) $ U.toList (result <> U.replicate (p - U.length result) 0)) <> BSB.char7 '\n'
 
 main = do
   p <- readLn -- 2 <= p <= 2999
@@ -155,6 +60,23 @@ instance IsInt64 m => Num (IntMod m) where
 
 ---
 
+exEuclid :: (Eq a, Integral a) => a -> a -> (a, a, a)
+exEuclid !f !g = loop 1 0 0 1 f g
+  where loop !u0 !u1 !v0 !v1 !f 0 = (f, u0, v0)
+        loop !u0 !u1 !v0 !v1 !f g =
+          case divMod f g of
+            (q,r) -> loop u1 (u0 - q * u1) v1 (v0 - q * v1) g r
+
+instance IsInt64 p => Fractional (IntMod p) where
+  recip (IntMod x) = let modulo = int64Val (Proxy :: Proxy p)
+                     in IntMod $ case exEuclid x modulo of
+                                   (1,a,_) -> a `mod` modulo
+                                   (-1,a,_) -> (-a) `mod` modulo
+  fromRational = undefined
+
+
+---
+
 newtype Tagged tag a = Tagged { getTagged :: a }
 
 class IsInt64 tag where
@@ -177,28 +99,177 @@ reifyInt64 x f = unsafeCoerce (MagicInt64 f :: MagicInt64 a) x Proxy
 newtype instance UM.MVector s (IntMod m) = MV_IntMod (UM.MVector s Int64)
 newtype instance U.Vector (IntMod m) = V_IntMod (U.Vector Int64)
 
-instance Data.Vector.Generic.Mutable.MVector UM.MVector (IntMod m) where -- needs MultiParamTypeClasses here
-  basicLength (MV_IntMod mv) = Data.Vector.Generic.Mutable.basicLength mv
-  basicUnsafeSlice i l (MV_IntMod mv) = MV_IntMod (Data.Vector.Generic.Mutable.basicUnsafeSlice i l mv)
-  basicOverlaps (MV_IntMod mv) (MV_IntMod mv') = Data.Vector.Generic.Mutable.basicOverlaps mv mv'
-  basicUnsafeNew l = MV_IntMod <$> Data.Vector.Generic.Mutable.basicUnsafeNew l
-  basicInitialize (MV_IntMod mv) = Data.Vector.Generic.Mutable.basicInitialize mv
-  basicUnsafeReplicate i x = MV_IntMod <$> Data.Vector.Generic.Mutable.basicUnsafeReplicate i (coerce x)
-  basicUnsafeRead (MV_IntMod mv) i = coerce <$> Data.Vector.Generic.Mutable.basicUnsafeRead mv i
-  basicUnsafeWrite (MV_IntMod mv) i x = Data.Vector.Generic.Mutable.basicUnsafeWrite mv i (coerce x)
-  basicClear (MV_IntMod mv) = Data.Vector.Generic.Mutable.basicClear mv
-  basicSet (MV_IntMod mv) x = Data.Vector.Generic.Mutable.basicSet mv (coerce x)
-  basicUnsafeCopy (MV_IntMod mv) (MV_IntMod mv') = Data.Vector.Generic.Mutable.basicUnsafeCopy mv mv'
-  basicUnsafeMove (MV_IntMod mv) (MV_IntMod mv') = Data.Vector.Generic.Mutable.basicUnsafeMove mv mv'
-  basicUnsafeGrow (MV_IntMod mv) n = MV_IntMod <$> Data.Vector.Generic.Mutable.basicUnsafeGrow mv n
-
-instance Data.Vector.Generic.Vector U.Vector (IntMod m) where -- needs MultiParamTypeClasses here
-  basicUnsafeFreeze (MV_IntMod mv) = V_IntMod <$> Data.Vector.Generic.basicUnsafeFreeze mv
-  basicUnsafeThaw (V_IntMod v) = MV_IntMod <$> Data.Vector.Generic.basicUnsafeThaw v
-  basicLength (V_IntMod v) = Data.Vector.Generic.basicLength v
-  basicUnsafeSlice i l (V_IntMod v) = V_IntMod (Data.Vector.Generic.basicUnsafeSlice i l v)
-  basicUnsafeIndexM (V_IntMod v) i = coerce <$> Data.Vector.Generic.basicUnsafeIndexM v i
-  basicUnsafeCopy (MV_IntMod  mv) (V_IntMod v) = Data.Vector.Generic.basicUnsafeCopy mv v
-  elemseq (V_IntMod v) x y = Data.Vector.Generic.elemseq v (coerce x) y
+instance GM.MVector UM.MVector (IntMod m) where -- needs MultiParamTypeClasses here
+  basicLength (MV_IntMod mv) = GM.basicLength mv
+  basicUnsafeSlice i l (MV_IntMod mv) = MV_IntMod (GM.basicUnsafeSlice i l mv)
+  basicOverlaps (MV_IntMod mv) (MV_IntMod mv') = GM.basicOverlaps mv mv'
+  basicUnsafeNew l = MV_IntMod <$> GM.basicUnsafeNew l
+  basicInitialize (MV_IntMod mv) = GM.basicInitialize mv
+  basicUnsafeReplicate i x = MV_IntMod <$> GM.basicUnsafeReplicate i (coerce x)
+  basicUnsafeRead (MV_IntMod mv) i = coerce <$> GM.basicUnsafeRead mv i
+  basicUnsafeWrite (MV_IntMod mv) i x = GM.basicUnsafeWrite mv i (coerce x)
+  basicClear (MV_IntMod mv) = GM.basicClear mv
+  basicSet (MV_IntMod mv) x = GM.basicSet mv (coerce x)
+  basicUnsafeCopy (MV_IntMod mv) (MV_IntMod mv') = GM.basicUnsafeCopy mv mv'
+  basicUnsafeMove (MV_IntMod mv) (MV_IntMod mv') = GM.basicUnsafeMove mv mv'
+  basicUnsafeGrow (MV_IntMod mv) n = MV_IntMod <$> GM.basicUnsafeGrow mv n
+
+instance G.Vector U.Vector (IntMod m) where -- needs MultiParamTypeClasses here
+  basicUnsafeFreeze (MV_IntMod mv) = V_IntMod <$> G.basicUnsafeFreeze mv
+  basicUnsafeThaw (V_IntMod v) = MV_IntMod <$> G.basicUnsafeThaw v
+  basicLength (V_IntMod v) = G.basicLength v
+  basicUnsafeSlice i l (V_IntMod v) = V_IntMod (G.basicUnsafeSlice i l v)
+  basicUnsafeIndexM (V_IntMod v) i = coerce <$> G.basicUnsafeIndexM v i
+  basicUnsafeCopy (MV_IntMod  mv) (V_IntMod v) = G.basicUnsafeCopy mv v
+  elemseq (V_IntMod v) x y = G.elemseq v (coerce x) y
 
 instance U.Unbox (IntMod m)
+
+--
+-- Univariate polynomial
+--
+
+newtype Poly vec a = Poly { coeffAsc :: vec a } deriving Eq
+
+normalizePoly :: (Eq a, Num a, G.Vector vec a) => vec a -> vec a
+normalizePoly v | G.null v || G.last v /= 0 = v
+                | otherwise = normalizePoly (G.init v)
+
+addPoly :: (Eq a, Num a, G.Vector vec a) => vec a -> vec a -> vec a
+addPoly v w = case compare n m of
+                LT -> G.generate m $ \i -> if i < n
+                                           then v G.! i + w G.! i
+                                           else w G.! i
+                GT -> G.generate n $ \i -> if i < m
+                                           then v G.! i + w G.! i
+                                           else v G.! i
+                EQ -> normalizePoly $ G.zipWith (+) v w
+  where n = G.length v
+        m = G.length w
+
+subPoly :: (Eq a, Num a, G.Vector vec a) => vec a -> vec a -> vec a
+subPoly v w = case compare n m of
+                LT -> G.generate m $ \i -> if i < n
+                                           then v G.! i - w G.! i
+                                           else negate (w G.! i)
+                GT -> G.generate n $ \i -> if i < m
+                                           then v G.! i - w G.! i
+                                           else v G.! i
+                EQ -> normalizePoly $ G.zipWith (-) v w
+  where n = G.length v
+        m = G.length w
+
+naiveMulPoly :: (Num a, G.Vector vec a) => vec a -> vec a -> vec a
+naiveMulPoly v w = G.generate (n + m - 1) $
+                   \i -> sum [(v G.! (i-j)) * (w G.! j) | j <- [max (i-n+1) 0..min i (m-1)]]
+  where n = G.length v
+        m = G.length w
+
+doMulP :: (Eq a, Num a, G.Vector vec a) => Int -> vec a -> vec a -> vec a
+doMulP n !v !w | n <= 16 = naiveMulPoly v w
+doMulP n !v !w
+  | G.null v = v
+  | G.null w = w
+  | G.length v < n2 = let (w0, w1) = G.splitAt n2 w
+                          u0 = doMulP n2 v w0
+                          u1 = doMulP n2 v w1
+                      in G.generate (G.length v + G.length w - 1)
+                         $ \i -> case () of
+                                   _ | i < n2     ->  u0 `at` i
+                                     | i < n      -> (u0 `at` i) + (u1 `at` (i - n2))
+                                     | i < n + n2 -> (u1 `at` (i - n2))
+  | G.length w < n2 = let (v0, v1) = G.splitAt n2 v
+                          u0 = doMulP n2 v0 w
+                          u1 = doMulP n2 v1 w
+                      in G.generate (G.length v + G.length w - 1)
+                         $ \i -> case () of
+                                   _ | i < n2     ->  u0 `at` i
+                                     | i < n      -> (u0 `at` i) + (u1 `at` (i - n2))
+                                     | i < n + n2 -> (u1 `at` (i - n2))
+  | otherwise = let (v0, v1) = G.splitAt n2 v
+                    (w0, w1) = G.splitAt n2 w
+                    v0_1 = v0 `addPoly` v1
+                    w0_1 = w0 `addPoly` w1
+                    p = doMulP n2 v0_1 w0_1
+                    q = doMulP n2 v0 w0
+                    r = doMulP n2 v1 w1
+                    -- s = (p `subPoly` q) `subPoly` r -- p - q - r
+                    -- q + s*X^n2 + r*X^n
+                in G.generate (G.length v + G.length w - 1)
+                   $ \i -> case () of
+                             _ | i < n2     ->   q `at` i
+                               | i < n      -> ((q `at` i) + (p `at` (i - n2))) - ((q `at` (i - n2)) + (r `at` (i - n2)))
+                               | i < n + n2 -> ((r `at` (i - n)) + (p `at` (i - n2))) - ((q `at` (i - n2)) + (r `at` (i - n2)))
+                               | otherwise  ->   r `at` (i - n)
+  where n2 = n `quot` 2
+        at :: (Num a, G.Vector vec a) => vec a -> Int -> a
+        at v i = if i < G.length v then v G.! i else 0
+{-# INLINE doMulP #-}
+
+mulPoly :: (Eq a, Num a, G.Vector vec a) => vec a -> vec a -> vec a
+mulPoly !v !w = let k = ceiling ((log (fromIntegral (max n m)) :: Double) / log 2) :: Int
+                in doMulP (2^k) v w
+  where n = G.length v
+        m = G.length w
+{-# INLINE mulPoly #-}
+
+zeroPoly :: (G.Vector vec a) => Poly vec a
+zeroPoly = Poly G.empty
+
+constPoly :: (Eq a, Num a, G.Vector vec a) => a -> Poly vec a
+constPoly 0 = Poly G.empty
+constPoly x = Poly (G.singleton x)
+
+scalePoly :: (Eq a, Num a, G.Vector vec a) => a -> Poly vec a -> Poly vec a
+scalePoly a (Poly xs)
+  | a == 0 = zeroPoly
+  | otherwise = Poly $ G.map (* a) xs
+
+valueAtPoly :: (Num a, G.Vector vec a) => Poly vec a -> a -> a
+valueAtPoly (Poly xs) t = G.foldr' (\a b -> a + t * b) 0 xs
+
+instance (Eq a, Num a, G.Vector vec a) => Num (Poly vec a) where
+  (+) = coerce (addPoly :: vec a -> vec a -> vec a)
+  (-) = coerce (subPoly :: vec a -> vec a -> vec a)
+  negate (Poly v) = Poly (G.map negate v)
+  (*) = coerce (mulPoly :: vec a -> vec a -> vec a)
+  fromInteger = constPoly . fromInteger
+  abs = undefined; signum = undefined
+
+divModPoly :: (Eq a, Fractional a, G.Vector vec a) => Poly vec a -> Poly vec a -> (Poly vec a, Poly vec a)
+divModPoly f g@(Poly w)
+  | G.null w = error "divModPoly: divide by zero"
+  | degree f < degree g = (zeroPoly, f)
+  | otherwise = loop zeroPoly (scalePoly (recip b) f)
+  where
+    g' = toMonic g
+    b = leadingCoefficient g
+    -- invariant: f == q * g + scalePoly b p
+    loop q p | degree p < degree g = (q, scalePoly b p)
+             | otherwise = let q' = Poly (G.drop (degree' g) (coeffAsc p))
+                           in loop (q + q') (p - q' * g')
+
+    toMonic :: (Fractional a, G.Vector vec a) => Poly vec a -> Poly vec a
+    toMonic f@(Poly xs)
+      | G.null xs = zeroPoly
+      | otherwise = Poly $ G.map (* recip (leadingCoefficient f)) xs
+
+    leadingCoefficient :: (Num a, G.Vector vec a) => Poly vec a -> a
+    leadingCoefficient (Poly xs)
+      | G.null xs = 0
+      | otherwise = G.last xs
+
+    degree :: G.Vector vec a => Poly vec a -> Maybe Int
+    degree (Poly xs) = case G.length xs - 1 of
+      -1 -> Nothing
+      n -> Just n
+
+    degree' :: G.Vector vec a => Poly vec a -> Int
+    degree' (Poly xs) = case G.length xs of
+      0 -> error "degree': zero polynomial"
+      n -> n - 1
+
+-- second constPoly (divModByDeg1 f t) = divMod f (Poly (G.fromList [-t, 1]))
+divModByDeg1 :: (Eq a, Num a, G.Vector vec a) => Poly vec a -> a -> (Poly vec a, a)
+divModByDeg1 f t = let w = G.postscanr (\a b -> a + b * t) 0 $ coeffAsc f
+                   in (Poly (G.tail w), G.head w)
diff --git a/abc/abc137-f/mkinput.lua b/abc/abc137-f/mkinput.lua
index 40e6039..d70a0d9 100644
--- a/abc/abc137-f/mkinput.lua
+++ b/abc/abc137-f/mkinput.lua
@@ -1,4 +1,4 @@
-local p = 1051 -- 2999
+local p = arg[1] and tonumber(arg[1]) or 2999
 io.output(string.format("input%d.txt", p))
 io.write(tostring(p), "\n")
 local t = {}

From 605d463040158c7cf5d126e9a1b3e0aca625f0af Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Sun, 11 Aug 2019 01:07:57 +0900
Subject: [PATCH 083/148] Add lib/Polynomial

---
 lib/Polynomial.hs | 156 ++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 156 insertions(+)
 create mode 100644 lib/Polynomial.hs

diff --git a/lib/Polynomial.hs b/lib/Polynomial.hs
new file mode 100644
index 0000000..4c9dae9
--- /dev/null
+++ b/lib/Polynomial.hs
@@ -0,0 +1,156 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+module Polynomial where
+import qualified Data.Vector.Generic as G
+import Data.Coerce
+
+--
+-- Univariate polynomial
+--
+
+newtype Poly vec a = Poly { coeffAsc :: vec a } deriving Eq
+
+normalizePoly :: (Eq a, Num a, G.Vector vec a) => vec a -> vec a
+normalizePoly v | G.null v || G.last v /= 0 = v
+                | otherwise = normalizePoly (G.init v)
+
+addPoly :: (Eq a, Num a, G.Vector vec a) => vec a -> vec a -> vec a
+addPoly v w = case compare n m of
+                LT -> G.generate m $ \i -> if i < n
+                                           then v G.! i + w G.! i
+                                           else w G.! i
+                GT -> G.generate n $ \i -> if i < m
+                                           then v G.! i + w G.! i
+                                           else v G.! i
+                EQ -> normalizePoly $ G.zipWith (+) v w
+  where n = G.length v
+        m = G.length w
+
+subPoly :: (Eq a, Num a, G.Vector vec a) => vec a -> vec a -> vec a
+subPoly v w = case compare n m of
+                LT -> G.generate m $ \i -> if i < n
+                                           then v G.! i - w G.! i
+                                           else negate (w G.! i)
+                GT -> G.generate n $ \i -> if i < m
+                                           then v G.! i - w G.! i
+                                           else v G.! i
+                EQ -> normalizePoly $ G.zipWith (-) v w
+  where n = G.length v
+        m = G.length w
+
+naiveMulPoly :: (Num a, G.Vector vec a) => vec a -> vec a -> vec a
+naiveMulPoly v w = G.generate (n + m - 1) $
+                   \i -> sum [(v G.! (i-j)) * (w G.! j) | j <- [max (i-n+1) 0..min i (m-1)]]
+  where n = G.length v
+        m = G.length w
+
+doMulP :: (Eq a, Num a, G.Vector vec a) => Int -> vec a -> vec a -> vec a
+doMulP n !v !w | n <= 16 = naiveMulPoly v w
+doMulP n !v !w
+  | G.null v = v
+  | G.null w = w
+  | G.length v < n2 = let (w0, w1) = G.splitAt n2 w
+                          u0 = doMulP n2 v w0
+                          u1 = doMulP n2 v w1
+                      in G.generate (G.length v + G.length w - 1)
+                         $ \i -> case () of
+                                   _ | i < n2     ->  u0 `at` i
+                                     | i < n      -> (u0 `at` i) + (u1 `at` (i - n2))
+                                     | i < n + n2 -> (u1 `at` (i - n2))
+  | G.length w < n2 = let (v0, v1) = G.splitAt n2 v
+                          u0 = doMulP n2 v0 w
+                          u1 = doMulP n2 v1 w
+                      in G.generate (G.length v + G.length w - 1)
+                         $ \i -> case () of
+                                   _ | i < n2     ->  u0 `at` i
+                                     | i < n      -> (u0 `at` i) + (u1 `at` (i - n2))
+                                     | i < n + n2 -> (u1 `at` (i - n2))
+  | otherwise = let (v0, v1) = G.splitAt n2 v
+                    (w0, w1) = G.splitAt n2 w
+                    v0_1 = v0 `addPoly` v1
+                    w0_1 = w0 `addPoly` w1
+                    p = doMulP n2 v0_1 w0_1
+                    q = doMulP n2 v0 w0
+                    r = doMulP n2 v1 w1
+                    -- s = (p `subPoly` q) `subPoly` r -- p - q - r
+                    -- q + s*X^n2 + r*X^n
+                in G.generate (G.length v + G.length w - 1)
+                   $ \i -> case () of
+                             _ | i < n2     ->   q `at` i
+                               | i < n      -> ((q `at` i) + (p `at` (i - n2))) - ((q `at` (i - n2)) + (r `at` (i - n2)))
+                               | i < n + n2 -> ((r `at` (i - n)) + (p `at` (i - n2))) - ((q `at` (i - n2)) + (r `at` (i - n2)))
+                               | otherwise  ->   r `at` (i - n)
+  where n2 = n `quot` 2
+        at :: (Num a, G.Vector vec a) => vec a -> Int -> a
+        at v i = if i < G.length v then v G.! i else 0
+{-# INLINE doMulP #-}
+
+mulPoly :: (Eq a, Num a, G.Vector vec a) => vec a -> vec a -> vec a
+mulPoly !v !w = let k = ceiling ((log (fromIntegral (max n m)) :: Double) / log 2) :: Int
+                in doMulP (2^k) v w
+  where n = G.length v
+        m = G.length w
+{-# INLINE mulPoly #-}
+
+zeroPoly :: (G.Vector vec a) => Poly vec a
+zeroPoly = Poly G.empty
+
+constPoly :: (Eq a, Num a, G.Vector vec a) => a -> Poly vec a
+constPoly 0 = Poly G.empty
+constPoly x = Poly (G.singleton x)
+
+scalePoly :: (Eq a, Num a, G.Vector vec a) => a -> Poly vec a -> Poly vec a
+scalePoly a (Poly xs)
+  | a == 0 = zeroPoly
+  | otherwise = Poly $ G.map (* a) xs
+
+valueAtPoly :: (Num a, G.Vector vec a) => Poly vec a -> a -> a
+valueAtPoly (Poly xs) t = G.foldr' (\a b -> a + t * b) 0 xs
+
+instance (Eq a, Num a, G.Vector vec a) => Num (Poly vec a) where
+  (+) = coerce (addPoly :: vec a -> vec a -> vec a)
+  (-) = coerce (subPoly :: vec a -> vec a -> vec a)
+  negate (Poly v) = Poly (G.map negate v)
+  (*) = coerce (mulPoly :: vec a -> vec a -> vec a)
+  fromInteger = constPoly . fromInteger
+  abs = undefined; signum = undefined
+
+divModPoly :: (Eq a, Fractional a, G.Vector vec a) => Poly vec a -> Poly vec a -> (Poly vec a, Poly vec a)
+divModPoly f g@(Poly w)
+  | G.null w = error "divModPoly: divide by zero"
+  | degree f < degree g = (zeroPoly, f)
+  | otherwise = loop zeroPoly (scalePoly (recip b) f)
+  where
+    g' = toMonic g
+    b = leadingCoefficient g
+    -- invariant: f == q * g + scalePoly b p
+    loop q p | degree p < degree g = (q, scalePoly b p)
+             | otherwise = let q' = Poly (G.drop (degree' g) (coeffAsc p))
+                           in loop (q + q') (p - q' * g')
+
+    toMonic :: (Fractional a, G.Vector vec a) => Poly vec a -> Poly vec a
+    toMonic f@(Poly xs)
+      | G.null xs = zeroPoly
+      | otherwise = Poly $ G.map (* recip (leadingCoefficient f)) xs
+
+    leadingCoefficient :: (Num a, G.Vector vec a) => Poly vec a -> a
+    leadingCoefficient (Poly xs)
+      | G.null xs = 0
+      | otherwise = G.last xs
+
+    degree :: G.Vector vec a => Poly vec a -> Maybe Int
+    degree (Poly xs) = case G.length xs - 1 of
+      -1 -> Nothing
+      n -> Just n
+
+    degree' :: G.Vector vec a => Poly vec a -> Int
+    degree' (Poly xs) = case G.length xs of
+      0 -> error "degree': zero polynomial"
+      n -> n - 1
+
+-- 組立除法
+-- second constPoly (divModByDeg1 f t) = divMod f (Poly (G.fromList [-t, 1]))
+divModByDeg1 :: (Eq a, Num a, G.Vector vec a) => Poly vec a -> a -> (Poly vec a, a)
+divModByDeg1 f t = let w = G.postscanr (\a b -> a + b * t) 0 $ coeffAsc f
+                   in (Poly (G.tail w), G.head w)

From c045fd8a9b3b31d8cdce18a91b7b9e5233e8ffef Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Tue, 13 Aug 2019 09:52:02 +0900
Subject: [PATCH 084/148] ABC137-F: Some refactoring

---
 abc/abc137-f/Main.hs | 29 +++++++++++++++++------------
 1 file changed, 17 insertions(+), 12 deletions(-)

diff --git a/abc/abc137-f/Main.hs b/abc/abc137-f/Main.hs
index 7c367e7..df8acc8 100644
--- a/abc/abc137-f/Main.hs
+++ b/abc/abc137-f/Main.hs
@@ -18,29 +18,34 @@ import Data.Coerce
 import Data.Monoid
 import qualified Data.ByteString.Builder as BSB
 import System.IO
----
 import Unsafe.Coerce
 
-solve :: forall p. IsInt64 p => U.Vector Int -> Proxy p -> IO ()
+sumVectors :: (Num a, G.Vector vec a) => Int -> [vec a] -> vec a
+sumVectors len vs = G.create $ do
+  vec <- GM.replicate len 0
+  forM_ vs $ \v -> do
+    G.imapM_ (\i x -> GM.modify vec (+ x) i) v
+  return vec
+
+solve :: forall p. IsInt64 p => U.Vector Int -> Proxy p -> U.Vector (IntMod p)
 solve as proxy = let p :: Int
                      p = fromIntegral (int64Val proxy)
                      -- f = x^p - x
                      f :: Poly U.Vector (IntMod p)
                      f = Poly $ U.generate (p+1) $ \i -> if i == p then 1 else if i == 1 then -1 else 0
-                     result = U.map negate $ U.create $ do
-                       vec <- UM.replicate p 0
-                       U.forM_ (U.indexed as) $ \(i,a) -> do
-                         when (a == 1) $ do
-                           -- let (p, 0) = f `divModPoly` Poly (U.fromList [fromIntegral (-i), 1])
-                           let (p, 0) = f `divModByDeg1` fromIntegral i
-                           U.imapM_ (\i x -> UM.modify vec (+ x) i) (coeffAsc p)
-                       return vec
-                 in BSB.hPutBuilder stdout $ (mconcat $ intersperse (BSB.char7 ' ') $ map (BSB.int64Dec . getIntMod) $ U.toList (result <> U.replicate (p - U.length result) 0)) <> BSB.char7 '\n'
+                 in U.map negate $ sumVectors p [ coeffAsc p
+                                                | (i,a) <- zip [0..] (U.toList as)
+                                                , a == 1
+                                                -- let (p, 0) = f `divModPoly` Poly (U.fromList [fromIntegral (-i), 1])
+                                                , let (p, 0) = f `divModByDeg1` fromIntegral i
+                                                ]
 
 main = do
   p <- readLn -- 2 <= p <= 2999
   xs <- U.unfoldrN p (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
-  reifyInt64 (fromIntegral p) (solve xs)
+  reifyInt64 (fromIntegral p) (\proxy -> let result = solve xs proxy
+                                         in BSB.hPutBuilder stdout $ (mconcat $ intersperse (BSB.char7 ' ') $ map (BSB.int64Dec . getIntMod) $ U.toList (result <> U.replicate (p - U.length result) 0)) <> BSB.char7 '\n'
+                              )
 
 ---
 

From 52662e74d4fe86c9cc82c0ca03305e06fe6c16e3 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Wed, 21 Aug 2019 00:38:34 +0900
Subject: [PATCH 085/148] ABC138-A, B, C, D

---
 abc/README.md        | 11 +++++++++++
 abc/abc138-a/Main.hs |  9 +++++++++
 abc/abc138-b/Main.hs |  9 +++++++++
 abc/abc138-c/Main.hs | 13 ++++++++++++
 abc/abc138-d/Main.hs | 47 ++++++++++++++++++++++++++++++++++++++++++++
 5 files changed, 89 insertions(+)
 create mode 100644 abc/abc138-a/Main.hs
 create mode 100644 abc/abc138-b/Main.hs
 create mode 100644 abc/abc138-c/Main.hs
 create mode 100644 abc/abc138-d/Main.hs

diff --git a/abc/README.md b/abc/README.md
index 132f5bc..f4b53f2 100644
--- a/abc/README.md
+++ b/abc/README.md
@@ -277,3 +277,14 @@
 * [x] D - Summer Vacation
 * [ ] E - Coins Respawn
 * [x] F - Polynomial Construction
+
+## AtCoder Beginner Contest 138
+
+<https://atcoder.jp/contests/abc138>
+
+* [x] A - Red or Not
+* [x] B - Resistors in Parallel
+* [x] C - Alchemist
+* [x] D - Ki
+* [ ] E - Strings of Impurity
+* [ ] F - Coincidence
diff --git a/abc/abc138-a/Main.hs b/abc/abc138-a/Main.hs
new file mode 100644
index 0000000..c667421
--- /dev/null
+++ b/abc/abc138-a/Main.hs
@@ -0,0 +1,9 @@
+-- https://github.com/minoki/my-atcoder-solutions
+
+main = do
+  a <- readLn :: IO Int
+  s <- getLine
+  if a >= 3200 then
+    putStrLn s
+  else
+    putStrLn "red"
diff --git a/abc/abc138-b/Main.hs b/abc/abc138-b/Main.hs
new file mode 100644
index 0000000..d4c14dd
--- /dev/null
+++ b/abc/abc138-b/Main.hs
@@ -0,0 +1,9 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  n <- readLn :: IO Int
+  xs <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  print ((recip $ sum $ map (recip . fromIntegral) xs) :: Double)
diff --git a/abc/abc138-c/Main.hs b/abc/abc138-c/Main.hs
new file mode 100644
index 0000000..3dc662d
--- /dev/null
+++ b/abc/abc138-c/Main.hs
@@ -0,0 +1,13 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.List (unfoldr, sort, foldl1')
+import Control.Monad
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  n <- readLn :: IO Int
+  xs <- sort . unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  let result :: Double
+      result = foldl1' (\x y -> (x + y) / 2) $ map fromIntegral xs
+  print result
diff --git a/abc/abc138-d/Main.hs b/abc/abc138-d/Main.hs
new file mode 100644
index 0000000..968f130
--- /dev/null
+++ b/abc/abc138-d/Main.hs
@@ -0,0 +1,47 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.List (unfoldr, intersperse)
+import Data.Monoid
+import Control.Monad
+import qualified Data.Vector as V
+import qualified Data.Vector.Mutable as VM
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.ByteString.Builder as BSB
+import System.IO (stdout)
+
+main = do
+  [n,q] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  edges <- U.replicateM (n-1) $ do
+    [a,b] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+    return (a-1,b-1)
+  operations <- U.replicateM q $ do
+    [p,x] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+    return (p-1,x)
+  let neighbors :: V.Vector [Int]
+      neighbors = V.create $ do
+        vec <- VM.replicate n []
+        U.forM_ edges $ \(a,b) -> do
+          VM.modify vec (b:) a
+          VM.modify vec (a:) b
+        return vec
+      values :: U.Vector Int
+      values = U.create $ do
+        vec <- UM.replicate n 0
+        U.forM_ operations $ \(p,x) -> do
+          UM.modify vec (+ x) p
+        return vec
+      result :: U.Vector Int
+      result = U.create $ do
+        vec <- UM.new n
+        let dfs !parent !q !acc = do
+              let !acc' = acc + values U.! q
+              UM.write vec q acc'
+              forM_ (neighbors V.! q) $ \i -> do
+                when (i /= parent) $ do
+                  dfs q i acc'
+        dfs (-1) 0 0
+        return vec
+  BSB.hPutBuilder stdout $ (mconcat $ intersperse (BSB.char7 ' ') $ map BSB.intDec $ U.toList result) <> BSB.char7 '\n'

From 55b0de0436c3a31655a3a63a0f919e07ebcecf9c Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Fri, 23 Aug 2019 16:55:22 +0900
Subject: [PATCH 086/148] ABC138-E

---
 abc/README.md        |  2 +-
 abc/abc138-e/Main.hs | 27 +++++++++++++++++++++++++++
 2 files changed, 28 insertions(+), 1 deletion(-)
 create mode 100644 abc/abc138-e/Main.hs

diff --git a/abc/README.md b/abc/README.md
index f4b53f2..5120577 100644
--- a/abc/README.md
+++ b/abc/README.md
@@ -286,5 +286,5 @@
 * [x] B - Resistors in Parallel
 * [x] C - Alchemist
 * [x] D - Ki
-* [ ] E - Strings of Impurity
+* [x] E - Strings of Impurity
 * [ ] F - Coincidence
diff --git a/abc/abc138-e/Main.hs b/abc/abc138-e/Main.hs
new file mode 100644
index 0000000..ef1fb1b
--- /dev/null
+++ b/abc/abc138-e/Main.hs
@@ -0,0 +1,27 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Int (Int64)
+import qualified Data.Vector as V
+import qualified Data.ByteString.Char8 as BS
+import Data.Array.Unboxed
+
+buildTable :: BS.ByteString -> V.Vector (UArray Char Int)
+buildTable s = let s' = V.generate (BS.length s) $ \i -> BS.index s i
+               in V.scanr (\(i,c) a -> a // [(c,i)]) (array ('a','z') [(c,-1) | c <- ['a'..'z']]) (V.indexed s')
+
+main = do
+  s <- BS.getLine
+  t <- BS.getLine
+  let s_table = buildTable s
+  let loop :: Int64 -> Int -> BS.ByteString -> Int64
+      loop !i !j t = case BS.uncons t of
+                       Nothing -> i
+                       Just (c, t') ->
+                         let k = (s_table V.! j) ! c
+                         in if k == -1
+                            then let l = V.head s_table ! c
+                                 in if l == -1
+                                    then -1
+                                    else loop (i + fromIntegral (l + BS.length s - j) + 1) (l+1) t'
+                            else loop (i + fromIntegral (k - j) + 1) (k+1) t'
+  print $ loop 0 0 t

From 2fb3a548ca9659256a1b3bf0154f55fb3ae3b885 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Fri, 23 Aug 2019 17:01:40 +0900
Subject: [PATCH 087/148] ABC138-E: Add Seq version

---
 abc/abc138-e/Seq.hs | 28 ++++++++++++++++++++++++++++
 1 file changed, 28 insertions(+)
 create mode 100644 abc/abc138-e/Seq.hs

diff --git a/abc/abc138-e/Seq.hs b/abc/abc138-e/Seq.hs
new file mode 100644
index 0000000..a5f3798
--- /dev/null
+++ b/abc/abc138-e/Seq.hs
@@ -0,0 +1,28 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (ord)
+import Data.Int (Int64)
+import qualified Data.Vector as V
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.Sequence as Seq
+
+buildTable :: BS.ByteString -> V.Vector (Seq.Seq Int)
+buildTable s = let s' = V.generate (BS.length s) $ \i -> BS.index s i
+               in V.scanr (\(i,c) a -> Seq.update (ord c - ord 'a') i a) (Seq.replicate 26 (-1)) (V.indexed s')
+
+main = do
+  s <- BS.getLine
+  t <- BS.getLine
+  let s_table = buildTable s
+  let loop :: Int64 -> Int -> BS.ByteString -> Int64
+      loop !i !j t = case BS.uncons t of
+                       Nothing -> i
+                       Just (c, t') ->
+                         let k = (s_table V.! j) `Seq.index` (ord c - ord 'a')
+                         in if k == -1
+                            then let l = V.head s_table `Seq.index` (ord c - ord 'a')
+                                 in if l == -1
+                                    then -1
+                                    else loop (i + fromIntegral (l + BS.length s - j) + 1) (l+1) t'
+                            else loop (i + fromIntegral (k - j) + 1) (k+1) t'
+  print $ loop 0 0 t

From 15052d88a77bfc7078a67770f08495b21c1cd54a Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Fri, 23 Aug 2019 23:34:20 +0900
Subject: [PATCH 088/148] ABC138-F

---
 abc/README.md        |  2 +-
 abc/abc138-f/Main.hs | 77 ++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 78 insertions(+), 1 deletion(-)
 create mode 100644 abc/abc138-f/Main.hs

diff --git a/abc/README.md b/abc/README.md
index 5120577..da80ec9 100644
--- a/abc/README.md
+++ b/abc/README.md
@@ -287,4 +287,4 @@
 * [x] C - Alchemist
 * [x] D - Ki
 * [x] E - Strings of Impurity
-* [ ] F - Coincidence
+* [x] F - Coincidence
diff --git a/abc/abc138-f/Main.hs b/abc/abc138-f/Main.hs
new file mode 100644
index 0000000..e4f297d
--- /dev/null
+++ b/abc/abc138-f/Main.hs
@@ -0,0 +1,77 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.Int (Int64)
+import Data.List (unfoldr)
+import Data.Bits
+import Data.Coerce
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+
+int64Log2 :: Int64 -> Int
+int64Log2 x = finiteBitSize x - countLeadingZeros x - 1
+
+naive :: Int64 -> Int64 -> [(Int64, Int64)]
+naive l r = [(x,y) | x <- [l..r], y <- [x..r], y `rem` x == y `xor` x]
+
+solve :: Int64 -> Int64 -> N
+solve l r | l > r  = 0
+          | l == r = 1
+          | log2l == log2r = solve2 l r log2l
+          | otherwise = solveL l log2l + solveR r log2r + sum [3^i | i <- [log2l+1 .. log2r-1]]
+  where
+    log2l = int64Log2 l
+    log2r = int64Log2 r
+    solve2 l r i | int64Log2 l /= i || int64Log2 r /= i = error ("invalid " ++ show (l,r,i))
+                 -- Precondition: l < r, int64Log2 l == int64Log2 r
+                 | otherwise = loop i
+      where loop i | i < 0 = 1
+                   | otherwise = case (testBit l i, testBit r i) of
+                                   (False, False) -> loop (i-1)
+                                   (False, True) -> solveL l (i-1) + solveR r (i-1) + loop (i-1)
+                                   (True, True) -> loop (i-1)
+                                   (True, False) -> 0
+
+solveL l i | i < 0 = 1
+           | otherwise = if testBit l i
+                         then solveL l (i-1)
+                         else 2 * solveL l (i-1) + 3^i
+
+solveR r i | i < 0 = 1
+           | i == int64Log2 r = solveR r (i-1)
+           | otherwise = if testBit r i
+                         then 2 * solveR r (i-1) + 3^i
+                         else solveR r (i-1)
+
+main = do
+  [l,r] <- map fromInteger . unfoldr (BS.readInteger . BS.dropWhile isSpace) <$> BS.getLine
+  print $ solve l r
+
+--
+-- Modular Arithmetic
+--
+
+modulo :: Int64
+modulo = 10^9+7
+addMod, subMod, mulMod :: Int64 -> Int64 -> Int64
+addMod !x !y | x + y >= modulo = x + y - modulo
+             | otherwise = x + y
+subMod !x !y | x >= y = x - y
+             | otherwise = x - y + modulo
+mulMod !x !y = (x * y) `rem` modulo
+
+newtype N = N { unwrapN :: Int64 } deriving (Eq)
+instance Show N where
+  show (N x) = show x
+instance Num N where
+  (+) = coerce addMod
+  (-) = coerce subMod
+  (*) = coerce mulMod
+  fromInteger n = N (fromInteger (n `mod` fromIntegral modulo))
+  abs = undefined; signum = undefined
+
+{-# RULES
+"^9/Int" forall x. x ^ (9 :: Int) = let u = x; v = u * u * u in v * v * v
+"^9/Integer" forall x. x ^ (9 :: Integer) = let u = x; v = u * u * u in v * v * v
+ #-}

From 5c097e917ba27723878908323062e60953ecd74c Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Sat, 24 Aug 2019 01:36:17 +0900
Subject: [PATCH 089/148] ABC137-E

---
 abc/README.md        |  2 +-
 abc/abc137-e/Main.hs | 56 ++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 57 insertions(+), 1 deletion(-)
 create mode 100644 abc/abc137-e/Main.hs

diff --git a/abc/README.md b/abc/README.md
index da80ec9..685fef5 100644
--- a/abc/README.md
+++ b/abc/README.md
@@ -275,7 +275,7 @@
 * [x] B - One Clue
 * [x] C - Green Bin
 * [x] D - Summer Vacation
-* [ ] E - Coins Respawn
+* [x] E - Coins Respawn
 * [x] F - Polynomial Construction
 
 ## AtCoder Beginner Contest 138
diff --git a/abc/abc137-e/Main.hs b/abc/abc137-e/Main.hs
new file mode 100644
index 0000000..e70904f
--- /dev/null
+++ b/abc/abc137-e/Main.hs
@@ -0,0 +1,56 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import Control.Monad
+import Control.Monad.ST
+import Control.Monad.State.Strict
+import qualified Data.Vector as V
+import qualified Data.Vector.Mutable as VM
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  [n,m,p] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  edges <- U.replicateM m $ do
+    [a,b,c] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+    return (a-1,b-1,p-c)
+  let edges_to :: V.Vector [Int]
+      edges_to = V.create $ do
+        vec <- VM.replicate n []
+        U.forM_ edges $ \(a,b,_) -> do
+          VM.modify vec (a :) b
+        return vec
+  let reachable_from_end :: U.Vector Bool
+      reachable_from_end = U.create $ do
+        vec <- UM.replicate n False
+        let dfs !i = do
+              b <- UM.read vec i
+              unless b $ do
+                UM.write vec i True
+                forM_ (edges_to V.! i) dfs
+        dfs (n-1)
+        return vec
+  let edges' = U.filter (\(a,b,c) -> reachable_from_end U.! b) edges
+  let result :: Maybe (U.Vector Int)
+      result = runST $ do
+        d <- UM.replicate n maxBound
+        UM.write d 0 0
+        let loop !i
+              | i >= n = return Nothing
+              | otherwise = do
+                  update <- execStateT (U.forM_ edges' $ \(a,b,c) -> do
+                                           a' <- UM.read d a
+                                           b' <- UM.read d b
+                                           when (a' /= maxBound && b' > a' + c) $ do
+                                             UM.write d b (a' + c)
+                                             put True
+                                       ) False
+                  if update
+                    then loop (i + 1)
+                    else Just <$> U.unsafeFreeze d
+        loop 0
+  case result of
+    Nothing -> putStrLn "-1"
+    Just d -> print $ max 0 (negate (d U.! (n - 1)))

From 98426f814c978e6d3966188a092796c640db4fab Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Sat, 24 Aug 2019 02:24:08 +0900
Subject: [PATCH 090/148] AGC037-A

---
 README.md        | 13 ++++++++++++-
 agc037-a/Main.hs | 25 +++++++++++++++++++++++++
 2 files changed, 37 insertions(+), 1 deletion(-)
 create mode 100644 agc037-a/Main.hs

diff --git a/README.md b/README.md
index 297602f..239d3b9 100644
--- a/README.md
+++ b/README.md
@@ -231,7 +231,7 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 
 ## AtCoder Grand Contest 036 (2019-07-21)
 
-<https://atcoder.jp/contests/agc036/tasks>
+<https://atcoder.jp/contests/agc036>
 
 * [x] A - Triangle
 * [x] B - Do Not Duplicate
@@ -239,3 +239,14 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 * [ ] D - Negative Cycle
 * [ ] E - ABC String
 * [ ] F - Square Constraints
+
+## AtCoder Grand Contest 037
+
+<https://atcoder.jp/contests/agc037>
+
+* [x] A - Dividing a String
+* [ ] B - RGB Balls
+* [ ] C - Numbers on a Circle
+* [ ] D - Sorting a Grid
+* [ ] E - Reversing and Concatenating
+* [ ] F - Counting of Subarrays
diff --git a/agc037-a/Main.hs b/agc037-a/Main.hs
new file mode 100644
index 0000000..6cb9732
--- /dev/null
+++ b/agc037-a/Main.hs
@@ -0,0 +1,25 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Control.Monad
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  s <- BS.getLine
+  let n = BS.length s
+  let result :: U.Vector (Int, Int)
+      result = U.create $ do
+        v <- UM.new (n+1)
+        UM.write v 0 (0, 0)
+        UM.write v 1 (1, 0)
+        forM_ [2..n] $ \i -> do
+          (a1, b1) <- UM.read v (i-1)
+          (a2, b2) <- UM.read v (i-2)
+          let a | BS.index s (i-2) == BS.index s (i-1) = b1 + 1
+                | otherwise = max a1 b1 + 1
+              b | i >= 4 && BS.index s (i-4) == BS.index s (i-2) && BS.index s (i-3) == BS.index s (i-1) = a2 + 1
+                | otherwise = max a2 b2 + 1
+          UM.write v i (a, b)
+        return v
+      (a, b) = result U.! n
+  print (max a b)

From 3c2c4e0614b4724ff49c7b4adf5c2f2e2e54e7b4 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Sat, 24 Aug 2019 22:56:28 +0900
Subject: [PATCH 091/148] =?UTF-8?q?=E7=AC=AC=E4=B8=80=E5=9B=9E=E6=97=A5?=
 =?UTF-8?q?=E6=9C=AC=E6=9C=80=E5=BC=B7=E3=83=97=E3=83=AD=E3=82=B0=E3=83=A9?=
 =?UTF-8?q?=E3=83=9E=E3=83=BC=E5=AD=A6=E7=94=9F=E9=81=B8=E6=89=8B=E6=A8=A9?=
 =?UTF-8?q?=20-=E4=BA=88=E9=81=B8-=20A,=20B,=20C,=20D?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 README.md              |  11 ++++
 jsc2019-qual-a/Main.hs |   8 +++
 jsc2019-qual-b/Main.hs | 120 +++++++++++++++++++++++++++++++++++++++++
 jsc2019-qual-c/Main.hs |  51 ++++++++++++++++++
 jsc2019-qual-d/Main.hs |  42 +++++++++++++++
 5 files changed, 232 insertions(+)
 create mode 100644 jsc2019-qual-a/Main.hs
 create mode 100644 jsc2019-qual-b/Main.hs
 create mode 100644 jsc2019-qual-c/Main.hs
 create mode 100644 jsc2019-qual-d/Main.hs

diff --git a/README.md b/README.md
index 239d3b9..e8c833d 100644
--- a/README.md
+++ b/README.md
@@ -250,3 +250,14 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 * [ ] D - Sorting a Grid
 * [ ] E - Reversing and Concatenating
 * [ ] F - Counting of Subarrays
+
+## 第一回日本最強プログラマー学生選手権 -予選- (2019-08-24)
+
+<https://atcoder.jp/contests/jsc2019-qual>
+
+* [x] A - Takahashi Calendar
+* [x] B - Kleene Inversion
+* [x] C - Cell Inversion
+* [x] D - Classified
+* [ ] E - Card Collector
+* [ ] F - Candy Retribution
diff --git a/jsc2019-qual-a/Main.hs b/jsc2019-qual-a/Main.hs
new file mode 100644
index 0000000..85cbdab
--- /dev/null
+++ b/jsc2019-qual-a/Main.hs
@@ -0,0 +1,8 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  [m,d] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  print $ length [(i,j) | i <- [1..m], j <- [10..d], let (d2,d1) = j `quotRem` 10, d1 >= 2, d2 >= 2, i == d1 * d2]
diff --git a/jsc2019-qual-b/Main.hs b/jsc2019-qual-b/Main.hs
new file mode 100644
index 0000000..ec6bc1d
--- /dev/null
+++ b/jsc2019-qual-b/Main.hs
@@ -0,0 +1,120 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+import Data.Char (isSpace)
+import Data.Int (Int64)
+import Data.List (unfoldr)
+import Control.Monad
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+import Data.Coerce
+import qualified Data.Vector.Generic
+import qualified Data.Vector.Generic.Mutable
+
+inversion :: U.Vector Int -> N
+inversion v = loop 0 0
+  where
+    loop !acc !i | i >= U.length v = acc
+                 | otherwise = let x = v U.! i
+                                   k = U.length $ U.filter (< x) $ U.drop (i+1) v
+                               in loop (acc + fromIntegral k) (i + 1)
+
+count1to2000 :: U.Vector Int -> U.Vector N
+count1to2000 v = U.create $ do
+  a <- UM.replicate 2001 0
+  U.forM_ v $ \x -> UM.modify a (+ 1) x
+  return a
+
+main = do
+  [n,k] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  xs <- U.unfoldrN n (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  let k' = fromIntegral k :: N
+  let i1 = k' * inversion xs
+  let ys = U.scanl (+) 0 $ U.tail $ count1to2000 xs
+  let f = k' * (k' - 1) / 2
+  let i2 = f * (U.sum $ U.map (\x -> ys U.! (x - 1)) xs)
+  print $ i1 + i2
+  return ()
+
+--
+-- Modular Arithmetic
+--
+
+modulo :: Int64
+modulo = 10^9+7
+addMod, subMod, mulMod :: Int64 -> Int64 -> Int64
+addMod !x !y | x + y >= modulo = x + y - modulo
+             | otherwise = x + y
+subMod !x !y | x >= y = x - y
+             | otherwise = x - y + modulo
+mulMod !x !y = (x * y) `rem` modulo
+
+newtype N = N { unwrapN :: Int64 } deriving (Eq)
+instance Show N where
+  show (N x) = show x
+instance Num N where
+  (+) = coerce addMod
+  (-) = coerce subMod
+  (*) = coerce mulMod
+  fromInteger n = N (fromInteger (n `mod` fromIntegral modulo))
+  abs = undefined; signum = undefined
+
+{-# RULES
+"^9/Int" forall x. x ^ (9 :: Int) = let u = x; v = u * u * u in v * v * v
+"^9/Integer" forall x. x ^ (9 :: Integer) = let u = x; v = u * u * u in v * v * v
+ #-}
+
+---
+
+exEuclid :: (Eq a, Integral a) => a -> a -> (a, a, a)
+exEuclid !f !g = loop 1 0 0 1 f g
+  where loop !u0 !u1 !v0 !v1 !f 0 = (f, u0, v0)
+        loop !u0 !u1 !v0 !v1 !f g =
+          case divMod f g of
+            (q,r) -> loop u1 (u0 - q * u1) v1 (v0 - q * v1) g r
+
+recipM :: Int64 -> Int64
+recipM !x = case exEuclid x modulo of
+             (1,a,_) -> a `mod` modulo
+             (-1,a,_) -> (-a) `mod` modulo
+divM :: Int64 -> Int64 -> Int64
+divM !x !y = x `mulMod` recipM y
+
+instance Fractional N where
+  (/) = coerce divM
+  recip = coerce recipM
+  fromRational = undefined
+
+---
+
+newtype instance UM.MVector s N = MV_N (UM.MVector s Int64)
+newtype instance U.Vector N = V_N (U.Vector Int64)
+
+instance Data.Vector.Generic.Mutable.MVector UM.MVector N where -- needs MultiParamTypeClasses here
+  basicLength (MV_N mv) = Data.Vector.Generic.Mutable.basicLength mv
+  basicUnsafeSlice i l (MV_N mv) = MV_N (Data.Vector.Generic.Mutable.basicUnsafeSlice i l mv)
+  basicOverlaps (MV_N mv) (MV_N mv') = Data.Vector.Generic.Mutable.basicOverlaps mv mv'
+  basicUnsafeNew l = MV_N <$> Data.Vector.Generic.Mutable.basicUnsafeNew l
+  basicInitialize (MV_N mv) = Data.Vector.Generic.Mutable.basicInitialize mv
+  basicUnsafeReplicate i x = MV_N <$> Data.Vector.Generic.Mutable.basicUnsafeReplicate i (coerce x)
+  basicUnsafeRead (MV_N mv) i = coerce <$> Data.Vector.Generic.Mutable.basicUnsafeRead mv i
+  basicUnsafeWrite (MV_N mv) i x = Data.Vector.Generic.Mutable.basicUnsafeWrite mv i (coerce x)
+  basicClear (MV_N mv) = Data.Vector.Generic.Mutable.basicClear mv
+  basicSet (MV_N mv) x = Data.Vector.Generic.Mutable.basicSet mv (coerce x)
+  basicUnsafeCopy (MV_N mv) (MV_N mv') = Data.Vector.Generic.Mutable.basicUnsafeCopy mv mv'
+  basicUnsafeMove (MV_N mv) (MV_N mv') = Data.Vector.Generic.Mutable.basicUnsafeMove mv mv'
+  basicUnsafeGrow (MV_N mv) n = MV_N <$> Data.Vector.Generic.Mutable.basicUnsafeGrow mv n
+
+instance Data.Vector.Generic.Vector U.Vector N where -- needs MultiParamTypeClasses here
+  basicUnsafeFreeze (MV_N mv) = V_N <$> Data.Vector.Generic.basicUnsafeFreeze mv
+  basicUnsafeThaw (V_N v) = MV_N <$> Data.Vector.Generic.basicUnsafeThaw v
+  basicLength (V_N v) = Data.Vector.Generic.basicLength v
+  basicUnsafeSlice i l (V_N v) = V_N (Data.Vector.Generic.basicUnsafeSlice i l v)
+  basicUnsafeIndexM (V_N v) i = coerce <$> Data.Vector.Generic.basicUnsafeIndexM v i
+  basicUnsafeCopy (MV_N mv) (V_N v) = Data.Vector.Generic.basicUnsafeCopy mv v
+  elemseq (V_N v) x y = Data.Vector.Generic.elemseq v (coerce x) y
+
+instance U.Unbox N
diff --git a/jsc2019-qual-c/Main.hs b/jsc2019-qual-c/Main.hs
new file mode 100644
index 0000000..aef32e9
--- /dev/null
+++ b/jsc2019-qual-c/Main.hs
@@ -0,0 +1,51 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE BangPatterns #-}
+import Data.Int (Int64)
+import qualified Data.ByteString.Char8 as BS
+import Data.Coerce
+
+main = do
+  n :: Int <- readLn
+  s <- BS.getLine
+  let loop :: Int -> Int -> Int -> N
+      loop !t !k !i | BS.length s == i = if k == 0 then 1 else 0
+                    | BS.index s i == 'W' = if k == 0
+                                            then 0
+                                            else if even k
+                                                 then fromIntegral k * loop t (k-1) (i+1)
+                                                 else fromIntegral (t+1) * loop (t+1) (k+1) (i+1)
+                    | otherwise = if k == 0
+                                  then fromIntegral (t+1) * loop (t+1) 1 (i+1)
+                                  else if even k
+                                       then fromIntegral (t+1) * loop (t+1) (k+1) (i+1)
+                                       else fromIntegral k * loop t (k-1) (i+1)
+  print $ loop 0 0 0
+
+--
+-- Modular Arithmetic
+--
+
+modulo :: Int64
+modulo = 10^9+7
+addMod, subMod, mulMod :: Int64 -> Int64 -> Int64
+addMod !x !y | x + y >= modulo = x + y - modulo
+             | otherwise = x + y
+subMod !x !y | x >= y = x - y
+             | otherwise = x - y + modulo
+mulMod !x !y = (x * y) `rem` modulo
+
+newtype N = N { unwrapN :: Int64 } deriving (Eq)
+instance Show N where
+  show (N x) = show x
+instance Num N where
+  (+) = coerce addMod
+  (-) = coerce subMod
+  (*) = coerce mulMod
+  fromInteger n = N (fromInteger (n `mod` fromIntegral modulo))
+  abs = undefined; signum = undefined
+
+{-# RULES
+"^9/Int" forall x. x ^ (9 :: Int) = let u = x; v = u * u * u in v * v * v
+"^9/Integer" forall x. x ^ (9 :: Integer) = let u = x; v = u * u * u in v * v * v
+ #-}
diff --git a/jsc2019-qual-d/Main.hs b/jsc2019-qual-d/Main.hs
new file mode 100644
index 0000000..d480af5
--- /dev/null
+++ b/jsc2019-qual-d/Main.hs
@@ -0,0 +1,42 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.List
+import Control.Monad
+import qualified Data.Vector.Unboxed as U
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.ByteString.Builder as BSB
+import System.IO
+import Data.Monoid
+import Data.Array.Unboxed
+import Data.Array.ST
+import Control.Monad.ST
+
+words_BSB :: [BSB.Builder] -> BSB.Builder
+words_BSB xs = mconcat $ intersperse (BSB.char7 ' ') xs
+
+lines_BSB :: [BSB.Builder] -> BSB.Builder
+lines_BSB xs = mconcat $ map (<> BSB.char7 '\n') xs
+
+solveRec :: STUArray s (Int, Int) Int -> Int -> Int -> U.Vector Int -> ST s Int
+solveRec table !s 2 xs = do let [i,j] = U.toList xs
+                            writeArray table (i,j) s
+                            return (s+1)
+solveRec table !s 3 xs = do let [i,j,k] = U.toList xs
+                            writeArray table (i,j) s
+                            writeArray table (i,k) s
+                            writeArray table (j,k) (s+1)
+                            return (s+2)
+solveRec table !s n xs = do forM_ [1,3..n-1] $ \d -> do
+                              forM_ [0..n-1-d] $ \i -> do
+                                writeArray table (xs U.! i,xs U.! (i+d)) s
+                            let m = n `quot` 2
+                            solveRec table (s+1) (n - m) $ U.map (xs U.!) (U.fromList [0,2..n-1])
+                            solveRec table (s+1) m $ U.map (xs U.!) (U.fromList [1,3..n-1])
+
+main = do
+  n <- readLn
+  let result = runSTUArray $ do
+        table <- newArray ((1,1),(n,n)) 0
+        solveRec table 1 n $ U.enumFromN 1 n
+        return table
+  BSB.hPutBuilder stdout $ lines_BSB [words_BSB $ [ BSB.intDec (result ! (i,j)) | j <- [i+1..n]] | i <- [1..n-1]]

From db2b2f6512c02ffa7bdbe37b0dcdad8a3597b48a Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Sat, 24 Aug 2019 18:33:11 +0000
Subject: [PATCH 092/148] =?UTF-8?q?=E7=AC=AC=E4=B8=80=E5=9B=9E=E6=97=A5?=
 =?UTF-8?q?=E6=9C=AC=E6=9C=80=E5=BC=B7=E3=83=97=E3=83=AD=E3=82=B0=E3=83=A9?=
 =?UTF-8?q?=E3=83=9E=E3=83=BC=E5=AD=A6=E7=94=9F=E9=81=B8=E6=89=8B=E6=A8=A9?=
 =?UTF-8?q?=20-=E4=BA=88=E9=81=B8-=20C:=20Clean=20up?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 jsc2019-qual-c/Main.hs | 29 +++++++++++++----------------
 1 file changed, 13 insertions(+), 16 deletions(-)

diff --git a/jsc2019-qual-c/Main.hs b/jsc2019-qual-c/Main.hs
index aef32e9..83aea59 100644
--- a/jsc2019-qual-c/Main.hs
+++ b/jsc2019-qual-c/Main.hs
@@ -1,26 +1,23 @@
 -- https://github.com/minoki/my-atcoder-solutions
-{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE BangPatterns #-}
 import Data.Int (Int64)
-import qualified Data.ByteString.Char8 as BS
 import Data.Coerce
+import qualified Data.ByteString.Char8 as BS
+import Control.Exception (assert)
 
 main = do
-  n :: Int <- readLn
+  n <- readLn
   s <- BS.getLine
-  let loop :: Int -> Int -> Int -> N
-      loop !t !k !i | BS.length s == i = if k == 0 then 1 else 0
-                    | BS.index s i == 'W' = if k == 0
-                                            then 0
-                                            else if even k
-                                                 then fromIntegral k * loop t (k-1) (i+1)
-                                                 else fromIntegral (t+1) * loop (t+1) (k+1) (i+1)
-                    | otherwise = if k == 0
-                                  then fromIntegral (t+1) * loop (t+1) 1 (i+1)
-                                  else if even k
-                                       then fromIntegral (t+1) * loop (t+1) (k+1) (i+1)
-                                       else fromIntegral k * loop t (k-1) (i+1)
-  print $ loop 0 0 0
+  assert (BS.length s == 2 * n) $ return ()
+  let loop :: N -> Int -> Int -> N
+      loop !acc !k !i | BS.length s == i = if k == 0 then acc else 0
+                      | BS.index s i == 'W' = if even k
+                                              then loop (acc * fromIntegral k) (k-1) (i+1)
+                                              else loop acc (k+1) (i+1)
+                      | otherwise = if even k
+                                    then loop acc (k+1) (i+1)
+                                    else loop (acc * fromIntegral k) (k-1) (i+1)
+  print $ loop (product $ map fromIntegral [1..n]) 0 0
 
 --
 -- Modular Arithmetic

From e782c4e5cbae82b7108de6c43b6b0808d97ec589 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Sun, 25 Aug 2019 03:35:03 +0900
Subject: [PATCH 093/148] Modular Arithmetic: Rewrite rule for fromIntegral ::
 Int(64) -> N

---
 jsc2019-qual-b/Main.hs   |  9 +++++++++
 jsc2019-qual-c/Main.hs   |  9 +++++++++
 lib/ModularArithmetic.hs | 13 +++++++++++++
 3 files changed, 31 insertions(+)

diff --git a/jsc2019-qual-b/Main.hs b/jsc2019-qual-b/Main.hs
index ec6bc1d..957e42b 100644
--- a/jsc2019-qual-b/Main.hs
+++ b/jsc2019-qual-b/Main.hs
@@ -67,6 +67,15 @@ instance Num N where
 "^9/Integer" forall x. x ^ (9 :: Integer) = let u = x; v = u * u * u in v * v * v
  #-}
 
+fromIntegral_Int64_N :: Int64 -> N
+fromIntegral_Int64_N n | 0 <= n && n < modulo = N n
+                       | otherwise = N (n `mod` modulo)
+
+{-# RULES
+"fromIntegral/Int->N" fromIntegral = fromIntegral_Int64_N . fromIntegral
+"fromIntegral/Int64->N" fromIntegral = fromIntegral_Int64_N
+ #-}
+
 ---
 
 exEuclid :: (Eq a, Integral a) => a -> a -> (a, a, a)
diff --git a/jsc2019-qual-c/Main.hs b/jsc2019-qual-c/Main.hs
index 83aea59..95c30a3 100644
--- a/jsc2019-qual-c/Main.hs
+++ b/jsc2019-qual-c/Main.hs
@@ -46,3 +46,12 @@ instance Num N where
 "^9/Int" forall x. x ^ (9 :: Int) = let u = x; v = u * u * u in v * v * v
 "^9/Integer" forall x. x ^ (9 :: Integer) = let u = x; v = u * u * u in v * v * v
  #-}
+
+fromIntegral_Int64_N :: Int64 -> N
+fromIntegral_Int64_N n | 0 <= n && n < modulo = N n
+                       | otherwise = N (n `mod` modulo)
+
+{-# RULES
+"fromIntegral/Int->N" fromIntegral = fromIntegral_Int64_N . (fromIntegral :: Int -> Int64)
+"fromIntegral/Int64->N" fromIntegral = fromIntegral_Int64_N
+ #-}
diff --git a/lib/ModularArithmetic.hs b/lib/ModularArithmetic.hs
index 6a5b209..64614aa 100644
--- a/lib/ModularArithmetic.hs
+++ b/lib/ModularArithmetic.hs
@@ -5,6 +5,10 @@ module ModularArithmetic where
 import Data.Int
 import Data.Coerce
 
+--
+-- Modular Arithmetic
+--
+
 modulo :: Int64
 modulo = 10^9+7
 addMod, subMod, mulMod :: Int64 -> Int64 -> Int64
@@ -29,6 +33,15 @@ instance Num N where
 "^9/Integer" forall x. x ^ (9 :: Integer) = let u = x; v = u * u * u in v * v * v
  #-}
 
+fromIntegral_Int64_N :: Int64 -> N
+fromIntegral_Int64_N n | 0 <= n && n < modulo = N n
+                       | otherwise = N (n `mod` modulo)
+
+{-# RULES
+"fromIntegral/Int->N" fromIntegral = fromIntegral_Int64_N . fromIntegral
+"fromIntegral/Int64->N" fromIntegral = fromIntegral_Int64_N
+ #-}
+
 ---
 
 exEuclid :: (Eq a, Integral a) => a -> a -> (a, a, a)

From edf04d2302a846a26dd9421b60f945c5a04441b7 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Sun, 1 Sep 2019 18:31:53 +0900
Subject: [PATCH 094/148] =?UTF-8?q?=E3=81=84=E3=81=8F=E3=81=A4=E3=81=8B?=
 =?UTF-8?q?=E3=81=AE=E5=95=8F=E9=A1=8C=E3=81=AB=E4=B8=80=E8=A8=80=E3=82=B3?=
 =?UTF-8?q?=E3=83=A1=E3=83=B3=E3=83=88=E3=82=92=E8=BF=BD=E5=8A=A0?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 README.md     | 24 ++++++++++++++++++++++++
 abc/README.md |  2 ++
 2 files changed, 26 insertions(+)

diff --git a/README.md b/README.md
index e8c833d..5e4268a 100644
--- a/README.md
+++ b/README.md
@@ -18,13 +18,17 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 
 * [x] A - コンテスト
 * [x] B - ゲーム
+    * ゲーム
 * [x] C - トーナメント
 * [x] D - サイコロ
 * [x] E - 数
+    * 桁DP
 * [x] F - 準急
 * [x] G - 辞書順
 * [x] H - ナップザック
+    * 重さの他に色の制約がある
 * [x] I - イウィ
+    * 貪欲法で解けてしまった（`iiwi` や `iwii` という形に遭遇したらその `iwi` は取り除いて良い）
 * [ ] J - ボール
 * [ ] K - ターゲット
 * [ ] L - 猫
@@ -37,6 +41,7 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 * [ ] S - マス目
 * [x] T - フィボナッチ <https://github.com/minoki/typical-dp-contest-t-fibonacci>
     * 解説記事：[フィボナッチ数絡みの競プロの問題を解いてみた（Typical DP Contest T）](https://blog.miz-ar.info/2019/02/typical-dp-contest-t/)
+    * 行列の固有多項式が既知なので多項式除算を使って高速に行列累乗ができる
 
 ## Educational DP Contest
 
@@ -48,24 +53,40 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 * [x] B - Frog 2
 * [x] C - Vacation
 * [x] D - Knapsack 1
+    * 01ナップサック問題。重さは比較的小さく（〜10<sup>5</sup>）、価値は大きい（〜10<sup>9</sup>）
 * [x] E - Knapsack 2
+    * 01ナップサック問題。重さは大きく（〜10<sup>9</sup>）、価値は小さい（〜10<sup>3</sup>）
 * [x] F - LCS
+    * Longest Common Subsequence
 * [x] G - Longest Path
+    * 有向閉路を含まない有向グラフ
 * [x] H - Grid 1
+    * 2次元DP
 * [x] I - Coins
+    * 確率
 * [x] J - Sushi
+    * 期待値
 * [x] K - Stones
+    * ゲーム
 * [x] L - Deque
+    * ゲーム
 * [x] M - Candies
+    * 飴の分配方法
 * [x] N - Slimes
 * [x] O - Matching
 * [x] P - Independent Set
 * [x] Q - Flowers
+    * Binary Indexed TreeかSegment Treeを使う
 * [x] R - Walk
+    * 頂点数が少ない（〜50）ので行列累乗
 * [x] S - Digit Sum
+    * 桁DP
 * [x] T - Permutation
+    * 桁DPの類似？
 * [x] U - Grouping
+    * ビットDP
 * [x] V - Subtree
+    * 全方位木DP
 * [ ] W - Intervals
 * [ ] X - Tower
 * [ ] Y - Grid 2
@@ -133,6 +154,8 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 * [x] C - Stones
 * [ ] D - Three Colors
 * [x] E - Polynomial Divisors
+    * 素数と多項式
+    * 有限体 F<sub>p</sub> 上で関数として恒等的に0になるような多項式は x<sup>p</sup>-x で割り切れる
 * [ ] F - Banned X
 
 ## エイシングプログラミングコンテスト2019
@@ -190,6 +213,7 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 * [ ] C - Best-of-(2n-1)
 * [ ] D - Maximum Sum of Minimum
 * [x] E - Product of Arithmetic Progression
+    * mod N での逆元や階乗の計算に帰着させる。
 * [ ] F - Random Tournament
 
 ## AtCoder Grand Contest 034 (2019-06-02)
diff --git a/abc/README.md b/abc/README.md
index 685fef5..0e844cf 100644
--- a/abc/README.md
+++ b/abc/README.md
@@ -277,6 +277,8 @@
 * [x] D - Summer Vacation
 * [x] E - Coins Respawn
 * [x] F - Polynomial Construction
+    * 有限体上の多項式を構築する
+    * 多項式補間っぽいが……？
 
 ## AtCoder Beginner Contest 138
 

From aab5747ecdb8c8847837ca36a799d0155ba84f7c Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Sun, 1 Sep 2019 22:40:24 +0900
Subject: [PATCH 095/148] ABC139

---
 abc/README.md        | 11 ++++++
 abc/abc139-a/Main.hs |  6 ++++
 abc/abc139-b/Main.hs | 10 ++++++
 abc/abc139-c/Main.hs | 11 ++++++
 abc/abc139-d/Main.hs |  6 ++++
 abc/abc139-e/Main.hs | 83 ++++++++++++++++++++++++++++++++++++++++++++
 abc/abc139-f/Main.hs | 25 +++++++++++++
 7 files changed, 152 insertions(+)
 create mode 100644 abc/abc139-a/Main.hs
 create mode 100644 abc/abc139-b/Main.hs
 create mode 100644 abc/abc139-c/Main.hs
 create mode 100644 abc/abc139-d/Main.hs
 create mode 100644 abc/abc139-e/Main.hs
 create mode 100644 abc/abc139-f/Main.hs

diff --git a/abc/README.md b/abc/README.md
index 0e844cf..434f20c 100644
--- a/abc/README.md
+++ b/abc/README.md
@@ -290,3 +290,14 @@
 * [x] D - Ki
 * [x] E - Strings of Impurity
 * [x] F - Coincidence
+
+## AtCoder Beginner Contest 139 (2019-09-01)
+
+<https://atcoder.jp/contests/abc139>
+
+* [x] A - Tenki
+* [x] B - Power Socket
+* [x] C - Lower
+* [x] D - ModSum
+* [x] E - League
+* [x] F - Engines
diff --git a/abc/abc139-a/Main.hs b/abc/abc139-a/Main.hs
new file mode 100644
index 0000000..440091b
--- /dev/null
+++ b/abc/abc139-a/Main.hs
@@ -0,0 +1,6 @@
+-- https://github.com/minoki/my-atcoder-solutions
+
+main = do
+  s <- getLine
+  t <- getLine
+  print $ length $ filter id $ zipWith (==) s t
diff --git a/abc/abc139-b/Main.hs b/abc/abc139-b/Main.hs
new file mode 100644
index 0000000..19be75a
--- /dev/null
+++ b/abc/abc139-b/Main.hs
@@ -0,0 +1,10 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  [a,b] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  if b == 1
+    then putStrLn "0"
+    else print $ (b+a-3) `quot` (a-1)
diff --git a/abc/abc139-c/Main.hs b/abc/abc139-c/Main.hs
new file mode 100644
index 0000000..8d2f611
--- /dev/null
+++ b/abc/abc139-c/Main.hs
@@ -0,0 +1,11 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Char (isSpace)
+import qualified Data.Vector.Unboxed as U
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  n <- readLn
+  xs <- U.unfoldrN n (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  let result :: Int
+      result = U.maximum $ U.scanl' (\k (a,b) -> if a >= b then k + 1 else 0) 0 $ U.zip xs (U.tail xs)
+  print result
diff --git a/abc/abc139-d/Main.hs b/abc/abc139-d/Main.hs
new file mode 100644
index 0000000..e0a912b
--- /dev/null
+++ b/abc/abc139-d/Main.hs
@@ -0,0 +1,6 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Int (Int64)
+
+main = do
+  n <- readLn
+  print (n * (n - 1) `quot` 2 :: Int64)
diff --git a/abc/abc139-e/Main.hs b/abc/abc139-e/Main.hs
new file mode 100644
index 0000000..2484fca
--- /dev/null
+++ b/abc/abc139-e/Main.hs
@@ -0,0 +1,83 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.Int (Int64)
+import Data.List (unfoldr)
+import Control.Monad
+import Control.Monad.ST
+import Control.Monad.Trans.Maybe
+import qualified Data.Vector as V
+import qualified Data.Vector.Mutable as VM
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+
+topologicalSort :: V.Vector [Int] -> Maybe (U.Vector Int)
+topologicalSort edges_from = runST $ runMaybeT $ do
+  let !n = V.length edges_from -- 頂点の個数
+  vec <- UM.new n
+  seen <- UM.replicate n False
+  iref <- UM.replicate 1 (n - 1)
+  seen <- UM.replicate n (0 :: Int) -- 0: new, 1: active, 2: finished
+  let dfs x = do
+        UM.write seen x 1
+        forM_ (edges_from V.! x) $ \y -> do
+          -- 辺 (x,y) が存在
+          s <- UM.read seen y
+          case s of
+            0 -> dfs y
+            1 -> mzero
+            _ -> return ()
+        UM.write seen x 2
+        i <- UM.read iref 0
+        UM.write vec i x
+        UM.write iref 0 (i - 1)
+  forM_ [0..n-1] $ \x -> do
+    s <- UM.read seen x
+    when (s == 0) $ dfs x
+  U.unsafeFreeze vec
+
+longest :: Int -> V.Vector [Int] -> Int
+longest !n edges = U.maximum $ U.create $ do
+  vec <- UM.replicate n (-1 :: Int)
+  let dfs x = do
+        v <- UM.read vec x
+        if v == -1
+          then do ys <- mapM dfs (edges V.! x)
+                  let !v = 1 + maximum (0 : ys)
+                  UM.write vec x v
+                  return v
+          else return v
+  forM_ [0..n-1] $ \i -> dfs i
+  return vec
+
+main = do
+  n <- readLn
+  xs <- V.replicateM n $ do
+    U.map (subtract 1) . U.unfoldrN (n-1) (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  let makePair i j | i < j = n * i - (i + 1) * i `quot` 2 + j - i - 1
+                   | otherwise = undefined
+  let edges :: V.Vector [Int]
+      edges = V.create $ do
+        e <- VM.replicate (n * (n - 1) `quot` 2) []
+        V.forM_ (V.indexed xs) $ \(i,ys) -> do
+          U.forM_ (U.zip ys (U.tail ys)) $ \(a,b) -> do
+            -- (i,a) -> (i,b)
+            let !b' = makePair (min i b) (max i b)
+            VM.modify e (b' :) (makePair (min i a) (max i a))
+        return e
+
+  let p :: U.Vector (Int, Int)
+      p = U.create $ do
+        vec <- UM.new (n * (n - 1) `quot` 2)
+        forM_ [0..n-1] $ \i -> do
+          forM_ [i+1..n-1] $ \j -> do
+            UM.write vec (makePair i j) (i,j)
+        return vec
+
+  let sorted = topologicalSort edges
+  case sorted of
+    Nothing -> putStrLn "-1"
+    Just sorted -> do
+      print $ longest (n * (n - 1) `quot` 2) edges
diff --git a/abc/abc139-f/Main.hs b/abc/abc139-f/Main.hs
new file mode 100644
index 0000000..efe8805
--- /dev/null
+++ b/abc/abc139-f/Main.hs
@@ -0,0 +1,25 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.Int (Int64)
+import Data.List (unfoldr, sort)
+import Control.Monad
+import qualified Data.Vector.Unboxed as U
+import qualified Data.ByteString.Char8 as BS
+import Data.Monoid
+
+sub :: (Int, Int) -> (Int, Int) -> (Int, Int)
+sub (x,y) (x',y') = (x-x',y-y')
+
+main = do
+  n <- readLn
+  xs <- fmap sort $ replicateM n $ do
+    [x,y] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+    return (atan2 (fromIntegral y) (fromIntegral x) :: Double, x, y)
+  let xs' = U.fromListN n xs
+  let (neg, pos) = U.span (\(a,_,_) -> a <= 0) xs'
+  let xs'' = xs' <> U.map (\(a,x,y) -> (a + 2 * pi, x, y)) neg
+  let ys = U.scanl' (\(sx,sy) (_,x,y) -> (sx+x,sy+y)) (0,0) xs''
+  let result = [ (ys U.! (j+1)) `sub` (ys U.! i) | i <- [0..n-1], j <- [i..min (i+n-1) (U.length xs''-1)]]
+  print $ maximum $ map (\(x,y) -> sqrt ((fromIntegral x)^2 + (fromIntegral y)^2)) result

From 3320673be926dd459753e94befe9087f320996d1 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Sun, 1 Sep 2019 23:22:30 +0900
Subject: [PATCH 096/148] ABC139-E, F: Clean up

---
 abc/README.md        |  1 +
 abc/abc139-e/Main.hs | 65 ++++++++++++++++++--------------------------
 abc/abc139-f/Main.hs | 17 ++++++------
 3 files changed, 36 insertions(+), 47 deletions(-)

diff --git a/abc/README.md b/abc/README.md
index 434f20c..4e8ee43 100644
--- a/abc/README.md
+++ b/abc/README.md
@@ -300,4 +300,5 @@
 * [x] C - Lower
 * [x] D - ModSum
 * [x] E - League
+    * 有向グラフの閉路判定と、DAGの最長路
 * [x] F - Engines
diff --git a/abc/abc139-e/Main.hs b/abc/abc139-e/Main.hs
index 2484fca..f103944 100644
--- a/abc/abc139-e/Main.hs
+++ b/abc/abc139-e/Main.hs
@@ -1,8 +1,7 @@
 -- https://github.com/minoki/my-atcoder-solutions
-{-# LANGUAGE ScopedTypeVariables #-}
+-- {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE BangPatterns #-}
 import Data.Char (isSpace)
-import Data.Int (Int64)
 import Data.List (unfoldr)
 import Control.Monad
 import Control.Monad.ST
@@ -13,35 +12,32 @@ import qualified Data.Vector.Unboxed as U
 import qualified Data.Vector.Unboxed.Mutable as UM
 import qualified Data.ByteString.Char8 as BS
 
-topologicalSort :: V.Vector [Int] -> Maybe (U.Vector Int)
-topologicalSort edges_from = runST $ runMaybeT $ do
-  let !n = V.length edges_from -- 頂点の個数
-  vec <- UM.new n
-  seen <- UM.replicate n False
-  iref <- UM.replicate 1 (n - 1)
-  seen <- UM.replicate n (0 :: Int) -- 0: new, 1: active, 2: finished
-  let dfs x = do
+-- 有向グラフに閉路があるか判定する
+hasCycle :: V.Vector [Int] -> Bool
+hasCycle edges = (== Nothing) $ runST $ runMaybeT $ do
+  let !n = V.length edges  -- 頂点の個数
+  seen <- UM.replicate n (0 :: Int) -- 0: new, 1: DFSの最中, 2: チェック済み
+  let dfs !x = do
+        -- x を通る閉路があるかチェックする
         UM.write seen x 1
-        forM_ (edges_from V.! x) $ \y -> do
+        forM_ (edges V.! x) $ \y -> do
           -- 辺 (x,y) が存在
           s <- UM.read seen y
-          case s of
-            0 -> dfs y
-            1 -> mzero
-            _ -> return ()
+          case s of 0 -> dfs y
+                    1 -> mzero -- コールスタックのどこかで dfs y が呼ばれている。閉路
+                    _ -> return ()
         UM.write seen x 2
-        i <- UM.read iref 0
-        UM.write vec i x
-        UM.write iref 0 (i - 1)
   forM_ [0..n-1] $ \x -> do
     s <- UM.read seen x
     when (s == 0) $ dfs x
-  U.unsafeFreeze vec
+  return ()
 
-longest :: Int -> V.Vector [Int] -> Int
-longest !n edges = U.maximum $ U.create $ do
+-- DAGの最長路の長さを返す
+longest :: V.Vector [Int] -> Int
+longest edges = U.maximum $ U.create $ do
+  let n = V.length edges
   vec <- UM.replicate n (-1 :: Int)
-  let dfs x = do
+  let dfs !x = do
         v <- UM.read vec x
         if v == -1
           then do ys <- mapM dfs (edges V.! x)
@@ -56,28 +52,21 @@ main = do
   n <- readLn
   xs <- V.replicateM n $ do
     U.map (subtract 1) . U.unfoldrN (n-1) (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
-  let makePair i j | i < j = n * i - (i + 1) * i `quot` 2 + j - i - 1
+  let m = n * (n - 1) `quot` 2  -- グラフの頂点数
+  let -- (i,j) (0 <= i < j < n) を 0 以上 m 未満の整数値にコードする
+      makePair :: Int -> Int -> Int
+      makePair i j | i < j = n * i - (i + 1) * i `quot` 2 + j - i - 1
                    | otherwise = undefined
+  -- 「試合 (i,j) よりも試合 (i',j') の方を後に行う場合に辺 makePair i j → makePair i' j' が存在する」ようなグラフを作る
   let edges :: V.Vector [Int]
       edges = V.create $ do
-        e <- VM.replicate (n * (n - 1) `quot` 2) []
+        e <- VM.replicate m []
         V.forM_ (V.indexed xs) $ \(i,ys) -> do
           U.forM_ (U.zip ys (U.tail ys)) $ \(a,b) -> do
             -- (i,a) -> (i,b)
             let !b' = makePair (min i b) (max i b)
             VM.modify e (b' :) (makePair (min i a) (max i a))
         return e
-
-  let p :: U.Vector (Int, Int)
-      p = U.create $ do
-        vec <- UM.new (n * (n - 1) `quot` 2)
-        forM_ [0..n-1] $ \i -> do
-          forM_ [i+1..n-1] $ \j -> do
-            UM.write vec (makePair i j) (i,j)
-        return vec
-
-  let sorted = topologicalSort edges
-  case sorted of
-    Nothing -> putStrLn "-1"
-    Just sorted -> do
-      print $ longest (n * (n - 1) `quot` 2) edges
+  print $ if hasCycle edges
+          then -1
+          else longest edges
diff --git a/abc/abc139-f/Main.hs b/abc/abc139-f/Main.hs
index efe8805..33256cf 100644
--- a/abc/abc139-f/Main.hs
+++ b/abc/abc139-f/Main.hs
@@ -1,8 +1,6 @@
 -- https://github.com/minoki/my-atcoder-solutions
-{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE BangPatterns #-}
 import Data.Char (isSpace)
-import Data.Int (Int64)
 import Data.List (unfoldr, sort)
 import Control.Monad
 import qualified Data.Vector.Unboxed as U
@@ -14,12 +12,13 @@ sub (x,y) (x',y') = (x-x',y-y')
 
 main = do
   n <- readLn
-  xs <- fmap sort $ replicateM n $ do
+  -- n <= 100 なのでリストの sort を使うのでも十分速い
+  -- (x,y) == (0,0) の場合は atan2 はよくわからない値になるかもしれないが、エラーにさえならなければソート結果のどこに入っていても問題ない
+  xs <- fmap (U.fromListN n . sort) $ replicateM n $ do
     [x,y] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
     return (atan2 (fromIntegral y) (fromIntegral x) :: Double, x, y)
-  let xs' = U.fromListN n xs
-  let (neg, pos) = U.span (\(a,_,_) -> a <= 0) xs'
-  let xs'' = xs' <> U.map (\(a,x,y) -> (a + 2 * pi, x, y)) neg
-  let ys = U.scanl' (\(sx,sy) (_,x,y) -> (sx+x,sy+y)) (0,0) xs''
-  let result = [ (ys U.! (j+1)) `sub` (ys U.! i) | i <- [0..n-1], j <- [i..min (i+n-1) (U.length xs''-1)]]
-  print $ maximum $ map (\(x,y) -> sqrt ((fromIntegral x)^2 + (fromIntegral y)^2)) result
+  let neg = U.takeWhile (\(a,_,_) -> a <= 0) xs -- x軸の下にある部分
+  let xs' = xs <> U.map (\(a,x,y) -> (a + 2 * pi, x, y)) neg -- 1週半させる
+  let ys = U.scanl' (\(!sx,!sy) (_,x,y) -> (sx+x,sy+y)) (0,0) xs'
+  let zs = [ (ys U.! (j+1)) `sub` (ys U.! i) | i <- [0..n-1], j <- [i..min (i+n-1) (U.length xs' - 1)]]
+  print $ maximum $ map (\(x,y) -> sqrt ((fromIntegral x)^2 + (fromIntegral y)^2)) zs

From f65fefd2c9fa152c8d0af5f5d569055d68945492 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Mon, 2 Sep 2019 14:50:01 +0900
Subject: [PATCH 097/148] =?UTF-8?q?ABC139-E:=20=E9=96=89=E8=B7=AF=E5=88=A4?=
 =?UTF-8?q?=E5=AE=9A=E3=81=A8=E6=9C=80=E9=95=B7=E8=B7=AF=E3=81=AE=E8=A8=88?=
 =?UTF-8?q?=E7=AE=97=E3=82=92=E3=81=BE=E3=81=A8=E3=82=81=E3=81=9F=E3=83=90?=
 =?UTF-8?q?=E3=83=BC=E3=82=B8=E3=83=A7=E3=83=B3=E3=82=92=E8=BF=BD=E5=8A=A0?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 abc/abc139-e/OnePass.hs | 57 +++++++++++++++++++++++++++++++++++++++++
 1 file changed, 57 insertions(+)
 create mode 100644 abc/abc139-e/OnePass.hs

diff --git a/abc/abc139-e/OnePass.hs b/abc/abc139-e/OnePass.hs
new file mode 100644
index 0000000..8f7a5da
--- /dev/null
+++ b/abc/abc139-e/OnePass.hs
@@ -0,0 +1,57 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import Data.Maybe (fromMaybe)
+import Control.Monad
+import Control.Monad.ST
+import Control.Monad.Trans.Maybe
+import Control.Monad.Trans.Class (lift)
+import qualified Data.Vector as V
+import qualified Data.Vector.Mutable as VM
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+
+-- 有向グラフに閉路があるか判定し、閉路があれば Nothing を返す。
+-- 閉路がなければ最長路の長さを返す。
+solve :: V.Vector [Int] -> Maybe Int
+solve !edges = runST $ runMaybeT $ do
+  let !n = V.length edges  -- 頂点の個数
+  !vec <- UM.replicate n (-2 :: Int) -- -2: new, -1: DFSの最中, 正: チェック済み
+  let dfs !x = do
+        s <- UM.read vec x
+        case s of
+          -2 -> do
+            -- x を通る閉路があるかチェックする
+            UM.write vec x (-1)
+            !v <- foldM (\ !a y -> max a <$> dfs y) 0 (edges V.! x)
+            let !v' = v + 1
+            UM.write vec x v'
+            return v'
+          -1 -> mzero  -- コールスタックのどこかで dfs x が呼ばれている。閉路
+          v -> return v
+  mapM_ dfs [0..n-1]
+  lift (U.maximum <$> U.unsafeFreeze vec)
+
+main = do
+  n <- readLn
+  xs <- V.replicateM n $ do
+    U.map (subtract 1) . U.unfoldrN (n-1) (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  let m = n * (n - 1) `quot` 2  -- グラフの頂点数
+  let -- (i,j) (0 <= i < j < n) を 0 以上 m 未満の整数値にコードする
+      makePair :: Int -> Int -> Int
+      makePair !i !j | i' < j' = n * i' - (i' + 1) * i' `quot` 2 + j' - i' - 1
+                     | otherwise = undefined
+        where !i' = min i j; !j' = max i j
+  -- 「試合 (i,j) よりも試合 (i',j') の方を後に行う場合に辺 makePair i j → makePair i' j' が存在する」ようなグラフを作る
+  let edges :: V.Vector [Int]
+      edges = V.create $ do
+        !e <- VM.replicate m []
+        V.forM_ (V.indexed xs) $ \(!i,ys) -> do
+          U.forM_ (U.zip ys (U.tail ys)) $ \(!a,!b) -> do
+            -- (i,a) -> (i,b)
+            let !b' = makePair i b
+            VM.modify e (b' :) (makePair i a)
+        return e
+  print $ fromMaybe (-1) $ solve edges

From b6138bc6ed80ea9527bce05ca6f827eded4bd11a Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Sat, 7 Sep 2019 22:55:28 +0900
Subject: [PATCH 098/148] ABC140-A, B, C, D, F

---
 abc/README.md        | 14 +++++++++++++-
 abc/abc140-a/Main.hs |  5 +++++
 abc/abc140-b/Main.hs | 13 +++++++++++++
 abc/abc140-c/Main.hs |  9 +++++++++
 abc/abc140-d/Main.hs | 12 ++++++++++++
 abc/abc140-f/Main.hs | 35 +++++++++++++++++++++++++++++++++++
 6 files changed, 87 insertions(+), 1 deletion(-)
 create mode 100644 abc/abc140-a/Main.hs
 create mode 100644 abc/abc140-b/Main.hs
 create mode 100644 abc/abc140-c/Main.hs
 create mode 100644 abc/abc140-d/Main.hs
 create mode 100644 abc/abc140-f/Main.hs

diff --git a/abc/README.md b/abc/README.md
index 4e8ee43..66f5a4e 100644
--- a/abc/README.md
+++ b/abc/README.md
@@ -6,7 +6,8 @@
 
 解いた問題：
 
-* D ナップサック問題
+* D - ナップサック問題
+    * 0/1ナップサック問題。Nが小さいデータセット、重さが比較的小さいデータセット、価値が比較的小さいデータセットの3種類がある。
 
 ## AtCoder Beginner Contest 122 (2019-03-24)
 
@@ -302,3 +303,14 @@
 * [x] E - League
     * 有向グラフの閉路判定と、DAGの最長路
 * [x] F - Engines
+
+## AtCoder Beginner Contest 140 (2019-09-07)
+
+<https://atcoder.jp/contests/abc140>
+
+* [x] A - Password
+* [x] B - Buffet
+* [x] C - Maximal Value
+* [x] D - Face Produces Unhappiness
+* [ ] E - Second Sum
+* [x] F - Many Slimes
diff --git a/abc/abc140-a/Main.hs b/abc/abc140-a/Main.hs
new file mode 100644
index 0000000..edd83eb
--- /dev/null
+++ b/abc/abc140-a/Main.hs
@@ -0,0 +1,5 @@
+-- https://github.com/minoki/my-atcoder-solutions
+
+main = do
+  n <- readLn :: IO Int
+  print $ n^3
diff --git a/abc/abc140-b/Main.hs b/abc/abc140-b/Main.hs
new file mode 100644
index 0000000..fd907db
--- /dev/null
+++ b/abc/abc140-b/Main.hs
@@ -0,0 +1,13 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Char (isSpace)
+import qualified Data.Vector.Unboxed as U
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  n <- readLn
+  xs <- U.unfoldrN n (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  ys <- U.unfoldrN n (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  zs <- U.unfoldrN (n-1) (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  let y = U.sum ys
+  let z = U.sum $ U.zipWith (\i j -> if j == i + 1 then zs U.! (i-1) else 0) xs (U.tail xs)
+  print $ y + z
diff --git a/abc/abc140-c/Main.hs b/abc/abc140-c/Main.hs
new file mode 100644
index 0000000..d74472d
--- /dev/null
+++ b/abc/abc140-c/Main.hs
@@ -0,0 +1,9 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Char (isSpace)
+import qualified Data.Vector.Unboxed as U
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  n <- readLn
+  xs <- U.unfoldrN (n-1) (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  print $ U.head xs + U.sum (U.zipWith min xs (U.tail xs)) + U.last xs
diff --git a/abc/abc140-d/Main.hs b/abc/abc140-d/Main.hs
new file mode 100644
index 0000000..38e5dcb
--- /dev/null
+++ b/abc/abc140-d/Main.hs
@@ -0,0 +1,12 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import qualified Data.Vector.Unboxed as U
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  [n,k] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  s <- BS.getLine
+  let xs = U.generate (BS.length s) (BS.index s)
+  let m = U.length $ U.filter id $ U.zipWith (==) xs (U.tail xs)
+  print $ min (m + 2 * k) (n - 1)
diff --git a/abc/abc140-f/Main.hs b/abc/abc140-f/Main.hs
new file mode 100644
index 0000000..bbc4cf7
--- /dev/null
+++ b/abc/abc140-f/Main.hs
@@ -0,0 +1,35 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.IntMap.Strict as IntMap
+import Data.List
+
+takeLT :: Int -> IntMap.IntMap Int -> Maybe (Int, IntMap.IntMap Int)
+takeLT k m = case IntMap.lookupLT k m of
+               Just (l, a) | a == 1 -> Just (l, IntMap.delete l m)
+                           | otherwise -> Just (l, IntMap.update (const $! Just $! a-1) l m)
+               Nothing -> Nothing
+
+check :: IntMap.IntMap Int -> IntMap.IntMap Int -> Bool
+check m m' | IntMap.null m' = True
+           | otherwise = case IntMap.foldrWithKey (\ !k !a acc -> case acc of Just (_,_) -> iterate (f k) acc !! a; Nothing -> Nothing) (Just (m, m')) m of
+                           Just (m2, m'2) -> check m2 m'2
+                           Nothing -> False
+  where f :: Int -> Maybe (IntMap.IntMap Int, IntMap.IntMap Int) -> Maybe (IntMap.IntMap Int, IntMap.IntMap Int)
+        f !k (Just (!m, !m')) = case takeLT k m' of
+                                  Just (l, !m'2) -> let !m2 = IntMap.insertWith (+) l 1 m
+                                                    in Just (m2, m'2)
+                                  Nothing -> Nothing
+        f k Nothing = Nothing
+
+main = do
+  n <- readLn :: IO Int -- 1 <= n <= 18
+  xs <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  let m = foldl' (\m x -> IntMap.insertWith (+) x 1 m) IntMap.empty xs
+  let result = case IntMap.deleteFindMax m of
+                 ((x, a), m') | a == 1 -> check (IntMap.singleton x 1) m'
+                              | otherwise -> False
+  if result
+    then putStrLn "Yes"
+    else putStrLn "No"

From 02986f9cfa46227961265ec5c093f21fd1ee60b6 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Tue, 10 Sep 2019 18:01:51 +0900
Subject: [PATCH 099/148] EDPC-F: Other implementations

---
 educational-dp/dp-f/Array.hs        | 41 ++++++++++++++++++++++++++++
 educational-dp/dp-f/MutableArray.hs | 42 +++++++++++++++++++++++++++++
 educational-dp/dp-f/Vector.hs       | 40 +++++++++++++++++++++++++++
 3 files changed, 123 insertions(+)
 create mode 100644 educational-dp/dp-f/Array.hs
 create mode 100644 educational-dp/dp-f/MutableArray.hs
 create mode 100644 educational-dp/dp-f/Vector.hs

diff --git a/educational-dp/dp-f/Array.hs b/educational-dp/dp-f/Array.hs
new file mode 100644
index 0000000..17551cc
--- /dev/null
+++ b/educational-dp/dp-f/Array.hs
@@ -0,0 +1,41 @@
+{-# LANGUAGE BangPatterns #-}
+import qualified Data.ByteString.Char8 as BS
+import Data.Array
+
+-- Input: s t
+-- Output: arr
+--   arr!(i,j) == length of lcs of (take i s, take j t)
+lcsTable :: BS.ByteString -> BS.ByteString -> Array (Int, Int) Int
+lcsTable xs ys  = let arr :: Array (Int, Int) Int
+                      arr = array ((0,0), (n,m)) $
+                        [ ((i,0),0) | i <- [0..n] ] ++
+                        [ ((0,j),0) | j <- [1..m] ] ++
+                        [ ((i1,j1),a) | i <- [0..n-1]
+                                      , let !x = BS.index xs i
+                                      , j <- [0..m-1]
+                                      , let !y = BS.index ys j
+                                      , let !i1 = i+1; !j1 = j+1
+                                      , let a | x == y = 1 + arr!(i,j)
+                                              | otherwise = max (arr!(i1,j)) (arr!(i,j1))
+                                      ]
+               in arr
+  where !n = BS.length xs
+        !m = BS.length ys
+
+solve :: BS.ByteString -> BS.ByteString -> String
+solve !xs !ys = let !table = lcsTable xs ys
+                    !n = BS.length xs
+                    !m = BS.length ys
+                    recon !i !j acc | i == 0 || j == 0 = acc
+                                    | x == y = recon (i-1) (j-1) (x : acc)
+                                    | table!(i-1,j) >= table!(i,j-1) = recon (i-1) j acc
+                                    | otherwise = recon i (j-1) acc
+                      where x = BS.index xs (i-1)
+                            y = BS.index ys (j-1)
+                in recon n m []
+
+main = do
+  xs <- BS.getLine
+  ys <- BS.getLine
+  -- BS.length s <= 3000, BS.length t <= 3000, BS.all isAsciiLower s, BS.all isAsciiLower t
+  putStrLn $ solve xs ys
diff --git a/educational-dp/dp-f/MutableArray.hs b/educational-dp/dp-f/MutableArray.hs
new file mode 100644
index 0000000..451a110
--- /dev/null
+++ b/educational-dp/dp-f/MutableArray.hs
@@ -0,0 +1,42 @@
+{-# LANGUAGE BangPatterns #-}
+import qualified Data.ByteString.Char8 as BS
+import Data.Array.Unboxed
+-- import Data.Array
+import Data.Array.ST
+import Control.Monad
+
+-- Input: s t
+-- Output: arr
+--   arr!(i,j) == length of lcs of (take i s, take j t)
+lcsTable :: BS.ByteString -> BS.ByteString -> UArray (Int, Int) Int
+lcsTable xs ys = runSTUArray $ do
+  arr <- newArray ((0,0), (n,m)) 0
+  forM_ [0..n-1] $ \i -> do
+    forM_ [0..m-1] $ \j -> do
+      if xs `BS.index` i == ys `BS.index` j then do
+        a <- readArray arr (i, j)
+        writeArray arr (i+1, j+1) $! a+1
+      else do
+        a <- readArray arr (i+1, j)
+        b <- readArray arr (i, j+1)
+        writeArray arr (i+1, j+1) $! max a b
+  return arr
+ where n = BS.length xs; m = BS.length ys
+
+solve :: BS.ByteString -> BS.ByteString -> String
+solve !s !t = let !table = lcsTable s t
+                  !n = BS.length s
+                  !m = BS.length t
+                  recon !i !j acc | i == 0 || j == 0 = acc
+                                  | x == y = recon (i-1) (j-1) (x : acc)
+                                  | table!(i-1,j) >= table!(i,j-1) = recon (i-1) j acc
+                                  | otherwise = recon i (j-1) acc
+                    where x = BS.index s (i-1)
+                          y = BS.index t (j-1)
+              in recon n m []
+
+main = do
+  s <- BS.getLine
+  t <- BS.getLine
+  -- BS.length s <= 3000, BS.length t <= 3000, BS.all isAsciiLower s, BS.all isAsciiLower t
+  putStrLn (solve s t)
diff --git a/educational-dp/dp-f/Vector.hs b/educational-dp/dp-f/Vector.hs
new file mode 100644
index 0000000..5614a8d
--- /dev/null
+++ b/educational-dp/dp-f/Vector.hs
@@ -0,0 +1,40 @@
+{-# LANGUAGE BangPatterns #-}
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.Vector as V
+import qualified Data.Vector.Unboxed as VU
+
+-- Input: s t
+-- Output: arr
+--   arr!(i,j) == length of lcs of (take i s, take j t)
+lcsTable :: BS.ByteString -> BS.ByteString
+         -> V.Vector (VU.Vector Int)
+lcsTable xs ys = V.scanl step (VU.replicate (m+1) 0) xs'
+  where
+    n = BS.length xs; m = BS.length ys
+    xs' = V.generate n $ BS.index xs :: V.Vector Char
+    ys' = VU.generate m $ BS.index ys :: VU.Vector Char
+    step :: VU.Vector Int -> Char -> VU.Vector Int
+    step v x
+      = VU.scanl innerStep 0 (VU.zip3 v (VU.tail v) ys')
+      where
+        innerStep :: Int -> (Int, Int, Char) -> Int
+        innerStep a (b,c,y) | x == y    = 1 + b
+                            | otherwise = max a c
+
+solve :: BS.ByteString -> BS.ByteString -> String
+solve !s !t = let !table = lcsTable s t
+                  !n = BS.length s
+                  !m = BS.length t
+                  recon !i !j acc | i == 0 || j == 0 = acc
+                                  | x == y = recon (i-1) (j-1) (x : acc)
+                                  | table V.! (i-1) VU.! j >= table V.! i VU.! (j-1) = recon (i-1) j acc
+                                  | otherwise = recon i (j-1) acc
+                    where x = BS.index s (i-1)
+                          y = BS.index t (j-1)
+              in recon n m []
+
+main = do
+  s <- BS.getLine
+  t <- BS.getLine
+  -- BS.length s <= 3000, BS.length t <= 3000, BS.all isAsciiLower s, BS.all isAsciiLower t
+  putStrLn (solve s t)

From 34e34541b9c963f0c92f2b9761bf9d894f5b13fc Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Tue, 10 Sep 2019 18:02:18 +0900
Subject: [PATCH 100/148] ABC140-E: Naive solution

---
 abc/abc140-e/Naive.hs | 23 +++++++++++++++++++++++
 1 file changed, 23 insertions(+)
 create mode 100644 abc/abc140-e/Naive.hs

diff --git a/abc/abc140-e/Naive.hs b/abc/abc140-e/Naive.hs
new file mode 100644
index 0000000..58b4bcd
--- /dev/null
+++ b/abc/abc140-e/Naive.hs
@@ -0,0 +1,23 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.List
+import qualified Data.ByteString.Char8 as BS
+
+data SecondMaxInt = SecondMaxInt { getMaxS :: !Int, getSecondMax :: !Int }
+
+-- Semigroup
+cat :: SecondMaxInt -> SecondMaxInt -> SecondMaxInt
+cat (SecondMaxInt a b) (SecondMaxInt c d)
+  = case compare a c of
+      LT -> SecondMaxInt c (max a d)
+      EQ -> SecondMaxInt a (max b d)
+      GT -> SecondMaxInt a (max b c)
+
+singleton :: Int -> SecondMaxInt
+singleton a = SecondMaxInt a minBound
+
+main = do
+  n <- readLn :: IO Int
+  xs <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  print $ sum [getSecondMax y | ys <- tails xs, not (null ys), y <- tail $ scanl1 cat $ map singleton ys]

From 6e7206e394f046cf689fc6076711da5ae9e3957a Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Sun, 15 Sep 2019 23:04:52 +0900
Subject: [PATCH 101/148] ABC141

---
 abc/README.md         | 11 +++++++++++
 abc/abc141-a/Main.hs  |  8 ++++++++
 abc/abc141-b/Main.hs  |  6 ++++++
 abc/abc141-c/Main.hs  | 22 ++++++++++++++++++++++
 abc/abc141-d/Main.hs  | 22 ++++++++++++++++++++++
 abc/abc141-e/Main.hs  | 40 ++++++++++++++++++++++++++++++++++++++++
 abc/abc141-f/Naive.hs | 17 +++++++++++++++++
 7 files changed, 126 insertions(+)
 create mode 100644 abc/abc141-a/Main.hs
 create mode 100644 abc/abc141-b/Main.hs
 create mode 100644 abc/abc141-c/Main.hs
 create mode 100644 abc/abc141-d/Main.hs
 create mode 100644 abc/abc141-e/Main.hs
 create mode 100644 abc/abc141-f/Naive.hs

diff --git a/abc/README.md b/abc/README.md
index 66f5a4e..5a45b43 100644
--- a/abc/README.md
+++ b/abc/README.md
@@ -314,3 +314,14 @@
 * [x] D - Face Produces Unhappiness
 * [ ] E - Second Sum
 * [x] F - Many Slimes
+
+## AtCoder Beginner Contest 141 (2019-09-15)
+
+<https://atcoder.jp/contests/abc141>
+
+* [x] A - Weather Prediction
+* [x] B - Tap Dance
+* [x] C - Attack Survival
+* [x] D - Powerful Discount Tickets
+* [x] E - Who Says a Pun?
+* [ ] F - Xor Sum 3
diff --git a/abc/abc141-a/Main.hs b/abc/abc141-a/Main.hs
new file mode 100644
index 0000000..19b9287
--- /dev/null
+++ b/abc/abc141-a/Main.hs
@@ -0,0 +1,8 @@
+-- https://github.com/minoki/my-atcoder-solutions
+
+main = do
+  s <- getLine
+  putStrLn $ case s of
+               "Sunny" -> "Cloudy"
+               "Cloudy" -> "Rainy"
+               "Rainy" -> "Sunny"
diff --git a/abc/abc141-b/Main.hs b/abc/abc141-b/Main.hs
new file mode 100644
index 0000000..adf1629
--- /dev/null
+++ b/abc/abc141-b/Main.hs
@@ -0,0 +1,6 @@
+-- https://github.com/minoki/my-atcoder-solutions
+
+main = do
+  s <- getLine
+  let result = and $ zipWith elem s (cycle ["RUD","LUD"])
+  putStrLn $ if result then "Yes" else "No"
diff --git a/abc/abc141-c/Main.hs b/abc/abc141-c/Main.hs
new file mode 100644
index 0000000..82321bf
--- /dev/null
+++ b/abc/abc141-c/Main.hs
@@ -0,0 +1,22 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  [n,k,q] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  xs <- U.replicateM q $ do
+    [a] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+    return (a-1)
+  let vec = U.create $ do
+        vec <- UM.replicate n (k-q)
+        U.forM_ xs $ \i -> do
+          UM.modify vec (+ 1) i
+        return vec
+  U.forM_ vec $ \s -> do
+    if s <= 0 then
+      putStrLn "No"
+    else
+      putStrLn "Yes"
diff --git a/abc/abc141-d/Main.hs b/abc/abc141-d/Main.hs
new file mode 100644
index 0000000..f75bac2
--- /dev/null
+++ b/abc/abc141-d/Main.hs
@@ -0,0 +1,22 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Char (isSpace)
+import Data.Int (Int64)
+import Data.List (unfoldr)
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.IntMap.Strict as IntMap
+import Data.Monoid
+
+discount :: Int -> IntMap.IntMap Int -> IntMap.IntMap Int
+discount 0 p = p
+discount m p = case IntMap.maxViewWithKey p of
+                  Nothing -> p
+                  Just ((k, l), p')
+                    | m < l -> IntMap.insertWith (+) (k `quot` 2) m $ IntMap.insert k (l - m) p'
+                    | otherwise -> discount (m - l) $ IntMap.insertWith (+) (k `quot` 2) l p'
+
+main = do
+  [n,m] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  p <- IntMap.fromListWith (+) . map (\x -> (x,1)) . unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  let result :: Int64
+      result = getSum $ IntMap.foldMapWithKey (\k l -> Sum $! fromIntegral k * fromIntegral l) $ discount m p
+  print result
diff --git a/abc/abc141-e/Main.hs b/abc/abc141-e/Main.hs
new file mode 100644
index 0000000..1c5747a
--- /dev/null
+++ b/abc/abc141-e/Main.hs
@@ -0,0 +1,40 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Control.Monad
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+{-
+import Data.Array.Unboxed
+import Data.Array.ST
+-}
+
+{-
+
+count :: Int -> Int -> BS.ByteString -> Int
+count !i !j !s | j >= BS.length s = 0
+               | s `BS.index` i == s `BS.index` j = 1 + count (i+1) (j+1) s
+               | otherwise = 0
+-}
+
+solve :: U.Vector Char -> Int -> Int
+solve !s !d = min d $ U.maximum $ U.scanr' (\(c1,c2) !x -> if c1 == c2 then x + 1 else 0) 0 $ U.zip s (U.drop d s)
+
+main = do
+  n <- readLn :: IO Int
+  s <- BS.getLine
+  let s' = U.generate (BS.length s) $ BS.index s
+  print $ maximum [solve s' d | d <- [1..n `quot` 2]]
+  {-
+  let u :: UArray (Int,Int) Int
+      u = runSTUArray $ do
+        arr <- newArray ((0,0),(n,n)) 0
+        forM_ [n-1,n-2..0] $ \i -> do
+          let !x = s `BS.index` i
+          forM_ [n-1,n-2..i+1] $ \j -> do
+            when (x == s `BS.index` j) $ do
+              v <- readArray arr (i+1,j+1)
+              writeArray arr (i,j) $! min (1 + v) (j - i)
+        return arr
+  print $ maximum $ elems u
+  -}
diff --git a/abc/abc141-f/Naive.hs b/abc/abc141-f/Naive.hs
new file mode 100644
index 0000000..b4b3c6b
--- /dev/null
+++ b/abc/abc141-f/Naive.hs
@@ -0,0 +1,17 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Char (isSpace)
+import Data.Int (Int64)
+import Data.List (unfoldr, foldl')
+import Control.Monad (mapM)
+import qualified Data.ByteString.Char8 as BS
+import Data.Bits (xor)
+import Data.Maybe (catMaybes)
+
+main = do
+  n <- readLn :: IO Int
+  xs <- map fromIntegral . unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  -- assume Int is 64-bit
+  let s :: Int64
+      s = foldl' xor 0 xs
+  print $ maximum $ do t <- foldl' xor 0 . catMaybes <$> mapM (\x -> [Nothing, Just x]) xs
+                       return $ t + (s `xor` t)

From 8cf44b9fa3a397de690baa715ba2b0af026a2d36 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Sat, 28 Sep 2019 22:46:59 +0900
Subject: [PATCH 102/148] ABC124

---
 abc/README.md        |  11 +++++
 abc/abc142-a/Main.hs |   5 ++
 abc/abc142-b/Main.hs |   9 ++++
 abc/abc142-c/Main.hs |  10 ++++
 abc/abc142-d/Main.hs |  60 ++++++++++++++++++++++++
 abc/abc142-e/Main.hs |  23 ++++++++++
 abc/abc142-f/Main.hs | 106 +++++++++++++++++++++++++++++++++++++++++++
 7 files changed, 224 insertions(+)
 create mode 100644 abc/abc142-a/Main.hs
 create mode 100644 abc/abc142-b/Main.hs
 create mode 100644 abc/abc142-c/Main.hs
 create mode 100644 abc/abc142-d/Main.hs
 create mode 100644 abc/abc142-e/Main.hs
 create mode 100644 abc/abc142-f/Main.hs

diff --git a/abc/README.md b/abc/README.md
index 5a45b43..7413f8f 100644
--- a/abc/README.md
+++ b/abc/README.md
@@ -325,3 +325,14 @@
 * [x] D - Powerful Discount Tickets
 * [x] E - Who Says a Pun?
 * [ ] F - Xor Sum 3
+
+## AtCoder Beginner Contest 142 (2019-09-28)
+
+<https://atcoder.jp/contests/abc142>
+
+* [x] A - Odds of Oddness
+* [x] B - Roller Coaster
+* [x] C - Go to School
+* [x] D - Disjoint Set of Common Divisors
+* [x] E - Get Everything
+* [x] F - Pure
diff --git a/abc/abc142-a/Main.hs b/abc/abc142-a/Main.hs
new file mode 100644
index 0000000..8e04e27
--- /dev/null
+++ b/abc/abc142-a/Main.hs
@@ -0,0 +1,5 @@
+-- https://github.com/minoki/my-atcoder-solutions
+
+main = do
+  n <- readLn
+  print (fromInteger ((n + 1) `quot` 2) / fromInteger n :: Double)
diff --git a/abc/abc142-b/Main.hs b/abc/abc142-b/Main.hs
new file mode 100644
index 0000000..249b6b4
--- /dev/null
+++ b/abc/abc142-b/Main.hs
@@ -0,0 +1,9 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  [n,k] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  xs <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  print $ length $ filter (>= k) xs
diff --git a/abc/abc142-c/Main.hs b/abc/abc142-c/Main.hs
new file mode 100644
index 0000000..6ec8fd1
--- /dev/null
+++ b/abc/abc142-c/Main.hs
@@ -0,0 +1,10 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Char (isSpace)
+import Data.List (unfoldr, sort)
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  n <- readLn
+  xs <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  let result = map snd $ sort $ zip xs [1..n]
+  putStrLn $ unwords $ map show result
diff --git a/abc/abc142-d/Main.hs b/abc/abc142-d/Main.hs
new file mode 100644
index 0000000..0a463ff
--- /dev/null
+++ b/abc/abc142-d/Main.hs
@@ -0,0 +1,60 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.Int (Int64)
+import Data.List (unfoldr)
+import Control.Monad
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  [a,b] <- map fromIntegral . unfoldr (BS.readInteger . BS.dropWhile isSpace) <$> BS.getLine
+  let x = gcd a b :: Int64
+  print $ 1 + length (factor x)
+
+--
+-- Prime numbers
+--
+
+infixr 5 !:
+(!:) :: a -> [a] -> [a]
+(!x) !: xs = x : xs
+
+-- | エラトステネスの篩により、 max 以下の素数の一覧を構築して返す
+-- >>> sieve 100
+-- [2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97]
+sieve :: Int -> [Int64]
+sieve !max = 2 : U.ifoldr (\i isPrime xs -> if isPrime then fromIntegral (2 * i + 1) !: xs else xs) [] vec
+  where
+    vec = U.create $ do
+      vec <- UM.replicate ((max - 1) `quot` 2 + 1) True
+      UM.write vec 0 False -- 1 is not a prime
+      -- vec ! i : is (2 * i + 1) prime?
+      let clear !p = forM_ [3*p,5*p..max] $ \n -> UM.write vec (n `quot` 2) False
+          factorBound = floor (sqrt (fromIntegral max) :: Double)
+          loop !i | 2 * i + 1 > factorBound = return ()
+                  | otherwise = do b <- UM.read vec i
+                                   when b $ clear (2 * i + 1)
+                                   loop (i + 1)
+      loop 1
+      return vec
+
+-- |
+-- >>> takeWhile (< 100) primes
+-- [2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97]
+primes :: [Int64]
+primes = sieve (10^6)
+
+factor :: Int64 -> [(Int64, Int)]
+factor 0 = error "factor 0"
+factor x | x > 10^12 = error "factor: too large"
+factor x = loop x primes
+  where
+    loop 1 _ = []
+    loop x (p:ps) = case factorOut 0 x p of
+                      (0,y) -> loop x ps
+                      (n,y) -> (p,n) : loop y ps
+    loop x [] = [(x,1)]
+    factorOut !n !x !p | (q,0) <- x `quotRem` p = factorOut (n+1) q p
+                       | otherwise = (n, x)
diff --git a/abc/abc142-e/Main.hs b/abc/abc142-e/Main.hs
new file mode 100644
index 0000000..092408c
--- /dev/null
+++ b/abc/abc142-e/Main.hs
@@ -0,0 +1,23 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import qualified Data.Vector as V
+import qualified Data.Vector.Unboxed as U
+import qualified Data.ByteString.Char8 as BS
+import Data.Bits
+
+main = do
+  [n,m] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  keys <- V.replicateM m $ do
+    [a,b] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+    c <- U.unfoldrN b (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+    return (a,c)
+  let v0 :: U.Vector Int
+      v0 = U.generate (2^n) (\x -> if x == 0 then 0 else 10^9)
+      result = V.foldl' (\v (a,c) -> U.generate (2^n) $ \x ->
+                            if x == 0
+                            then 0
+                            else min (v U.! x) $ let cc = U.foldl' (\y i -> y .|. bit (i-1)) 0 c
+                                                 in (v U.! (x .&. complement cc)) + a
+                        ) v0 keys
+  print $ if result U.! (2^n - 1) >= 10^9 then -1 else result U.! (2^n - 1)
diff --git a/abc/abc142-f/Main.hs b/abc/abc142-f/Main.hs
new file mode 100644
index 0000000..1299943
--- /dev/null
+++ b/abc/abc142-f/Main.hs
@@ -0,0 +1,106 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.Int (Int64)
+import Data.List (unfoldr)
+import Control.Monad
+import Control.Monad.ST
+import Control.Monad.Except
+import qualified Data.Vector as V
+import qualified Data.Vector.Mutable as VM
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.IntSet as IntSet
+import Data.Monoid
+import Data.Foldable
+import Debug.Trace
+
+checkCycle :: Monad m => V.Vector IntSet.IntSet -> V.Vector IntSet.IntSet -> [Int] -> ExceptT [Int] m ()
+checkCycle edges_from edges_to revPath = do
+  let m = IntSet.fromList revPath
+  let checkEdge i j | IntSet.size ((edges_from V.! i) `IntSet.intersection` m) > 1 = False
+                    | IntSet.size ((edges_to V.! j) `IntSet.intersection` m) > 1 = False
+                    | otherwise = True
+  let ok1 = and (zipWith checkEdge (tail revPath) revPath)
+  if ok1
+    then let path = reverse revPath
+         in if checkEdge (head path) (head revPath)
+            then throwError path
+            else return ()
+    else return ()
+
+findCycle :: V.Vector IntSet.IntSet -> V.Vector IntSet.IntSet -> Either [Int] ()
+findCycle edges edges_to = runST $ runExceptT $ do
+  let !n = V.length edges  -- 頂点の個数
+  seen <- UM.replicate n (0 :: Int) -- 0: new, 1: DFSの最中, 2: チェック済み
+  let dfs !x path = do
+        -- x を通る閉路があるかチェックする
+        UM.write seen x 1
+        forM_ (IntSet.toList $ edges V.! x) $ \y -> do
+          -- 辺 (x,y) が存在
+          s <- UM.read seen y
+          case s of 0 -> dfs y (y : path)
+                    1 -> throwError (y : reverse (y : takeWhile (/= y) path)) -- コールスタックのどこかで dfs y が呼ばれている。閉路
+                    _ -> return ()
+        UM.write seen x 2
+  forM_ [0..n-1] $ \x -> do
+    s <- UM.read seen x
+    when (s == 0) $ dfs x [x]
+  return ()
+
+reduceCycle ::  V.Vector IntSet.IntSet -> V.Vector IntSet.IntSet -> [Int] -> [Int]
+reduceCycle edges_from edges_to path = do
+  let loop :: IntSet.IntSet -> [Int] -> IntSet.IntSet -> [Int] -> [Int]
+      loop m (i:ys@(j:_)) seen revAcc = do
+        let s1 = IntSet.delete j ((edges_from V.! i) `IntSet.intersection` m)
+        case IntSet.maxView s1 of
+          Nothing -> loop m ys (IntSet.insert i seen) (i : revAcc)
+          Just (j',_) | j' `IntSet.member` seen -> loopX (j' : reverse (j' : i : takeWhile (/= j') revAcc))
+                      | otherwise -> case dropWhile (/= j') ys of
+                                       [] -> error $ show (i,j',ys,seen,revAcc)
+                                       ys' -> loop m ys' (IntSet.insert i seen) (i : revAcc)
+      loop m [i] seen revAcc = reverse revAcc
+      loopX path = loop (IntSet.fromList path) path IntSet.empty []
+  loopX path
+
+main = do
+  [n,m] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  edges <- U.replicateM m $ do
+    [x,y] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+    return (x-1,y-1)
+  let edges_from :: V.Vector IntSet.IntSet
+      edges_from = V.create $ do
+        vec <- VM.replicate n IntSet.empty
+        U.forM_ edges $ \(a,b) ->
+          VM.modify vec (IntSet.insert b) a
+        return vec
+  let edges_to :: V.Vector IntSet.IntSet
+      edges_to = V.create $ do
+        vec <- VM.replicate n IntSet.empty
+        U.forM_ edges $ \(a,b) ->
+          VM.modify vec (IntSet.insert a) b
+        return vec
+  case findCycle edges_from edges_to of
+    Right _ -> putStrLn "-1"
+    Left path -> do
+      let path' = reduceCycle edges_from edges_to path
+      print $ length path'
+      forM_ path' $ \i -> do
+        print (i+1)
+
+foldMap_IntSet :: (Monoid n) => (Int -> n) -> IntSet.IntSet -> n
+foldMap_IntSet f set = go set
+  where
+    go set = case IntSet.splitRoot set of
+               [] -> mempty
+               [x] -> foldMap f (IntSet.toList x)
+               xs -> foldMap go xs
+
+foldMapM_IntSet :: (Monoid n, Monad m) => (Int -> m n) -> IntSet.IntSet -> m n
+foldMapM_IntSet f set = go set
+  where
+    go set = case IntSet.splitRoot set of
+               [] -> return mempty
+               [x] -> foldlM (\x v -> mappend x <$> f v) mempty (IntSet.toList x)
+               xs -> foldlM (\x set' -> mappend x <$> go set') mempty xs

From 3054e6f57e9a9ea1b3ab8d3179cb877e9df2585a Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Sat, 28 Sep 2019 23:03:37 +0900
Subject: [PATCH 103/148] ABC142-F: Clean up

---
 abc/abc142-f/Main.hs | 77 +++++++++++---------------------------------
 1 file changed, 19 insertions(+), 58 deletions(-)

diff --git a/abc/abc142-f/Main.hs b/abc/abc142-f/Main.hs
index 1299943..c3ffc9c 100644
--- a/abc/abc142-f/Main.hs
+++ b/abc/abc142-f/Main.hs
@@ -1,7 +1,6 @@
 -- https://github.com/minoki/my-atcoder-solutions
 {-# LANGUAGE BangPatterns #-}
 import Data.Char (isSpace)
-import Data.Int (Int64)
 import Data.List (unfoldr)
 import Control.Monad
 import Control.Monad.ST
@@ -12,26 +11,10 @@ import qualified Data.Vector.Unboxed as U
 import qualified Data.Vector.Unboxed.Mutable as UM
 import qualified Data.ByteString.Char8 as BS
 import qualified Data.IntSet as IntSet
-import Data.Monoid
-import Data.Foldable
-import Debug.Trace
 
-checkCycle :: Monad m => V.Vector IntSet.IntSet -> V.Vector IntSet.IntSet -> [Int] -> ExceptT [Int] m ()
-checkCycle edges_from edges_to revPath = do
-  let m = IntSet.fromList revPath
-  let checkEdge i j | IntSet.size ((edges_from V.! i) `IntSet.intersection` m) > 1 = False
-                    | IntSet.size ((edges_to V.! j) `IntSet.intersection` m) > 1 = False
-                    | otherwise = True
-  let ok1 = and (zipWith checkEdge (tail revPath) revPath)
-  if ok1
-    then let path = reverse revPath
-         in if checkEdge (head path) (head revPath)
-            then throwError path
-            else return ()
-    else return ()
-
-findCycle :: V.Vector IntSet.IntSet -> V.Vector IntSet.IntSet -> Either [Int] ()
-findCycle edges edges_to = runST $ runExceptT $ do
+-- 閉路を見つける
+findCycle :: V.Vector IntSet.IntSet -> Either [Int] ()
+findCycle edges = runST $ runExceptT $ do
   let !n = V.length edges  -- 頂点の個数
   seen <- UM.replicate n (0 :: Int) -- 0: new, 1: DFSの最中, 2: チェック済み
   let dfs !x path = do
@@ -49,20 +32,20 @@ findCycle edges edges_to = runST $ runExceptT $ do
     when (s == 0) $ dfs x [x]
   return ()
 
-reduceCycle ::  V.Vector IntSet.IntSet -> V.Vector IntSet.IntSet -> [Int] -> [Int]
-reduceCycle edges_from edges_to path = do
-  let loop :: IntSet.IntSet -> [Int] -> IntSet.IntSet -> [Int] -> [Int]
-      loop m (i:ys@(j:_)) seen revAcc = do
-        let s1 = IntSet.delete j ((edges_from V.! i) `IntSet.intersection` m)
-        case IntSet.maxView s1 of
-          Nothing -> loop m ys (IntSet.insert i seen) (i : revAcc)
-          Just (j',_) | j' `IntSet.member` seen -> loopX (j' : reverse (j' : i : takeWhile (/= j') revAcc))
-                      | otherwise -> case dropWhile (/= j') ys of
-                                       [] -> error $ show (i,j',ys,seen,revAcc)
-                                       ys' -> loop m ys' (IntSet.insert i seen) (i : revAcc)
-      loop m [i] seen revAcc = reverse revAcc
-      loopX path = loop (IntSet.fromList path) path IntSet.empty []
-  loopX path
+reduceCycle ::  V.Vector IntSet.IntSet -> [Int] -> [Int]
+reduceCycle edges_from = reduce1
+  where
+    -- 閉路の一部をショートカットする経路があったらそっちに繋ぎかえる、という操作を繰り返す
+    loop :: IntSet.IntSet -> IntSet.IntSet -> [Int] -> [Int] -> [Int]
+    loop m seen revAcc (i:ys@(j:_)) =
+      case IntSet.maxView $ IntSet.delete j $ edges_from V.! i `IntSet.intersection` m of
+        Nothing -> loop m (IntSet.insert i seen) (i : revAcc) ys
+        Just (j',_) | j' `IntSet.member` seen -> reduce1 (j' : reverse (j' : i : takeWhile (/= j') revAcc))
+                    | otherwise -> loop m (IntSet.insert i seen) (i : revAcc) (dropWhile (/= j') ys)
+    loop m seen revAcc [i] = reverse revAcc -- ショートカットできる経路はもうない
+    loop _ _ _ [] = error "something is wrong"
+    reduce1 :: [Int] -> [Int]
+    reduce1 path = loop (IntSet.fromList path) IntSet.empty [] path
 
 main = do
   [n,m] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
@@ -75,32 +58,10 @@ main = do
         U.forM_ edges $ \(a,b) ->
           VM.modify vec (IntSet.insert b) a
         return vec
-  let edges_to :: V.Vector IntSet.IntSet
-      edges_to = V.create $ do
-        vec <- VM.replicate n IntSet.empty
-        U.forM_ edges $ \(a,b) ->
-          VM.modify vec (IntSet.insert a) b
-        return vec
-  case findCycle edges_from edges_to of
+  case findCycle edges_from of
     Right _ -> putStrLn "-1"
     Left path -> do
-      let path' = reduceCycle edges_from edges_to path
+      let path' = reduceCycle edges_from path
       print $ length path'
       forM_ path' $ \i -> do
         print (i+1)
-
-foldMap_IntSet :: (Monoid n) => (Int -> n) -> IntSet.IntSet -> n
-foldMap_IntSet f set = go set
-  where
-    go set = case IntSet.splitRoot set of
-               [] -> mempty
-               [x] -> foldMap f (IntSet.toList x)
-               xs -> foldMap go xs
-
-foldMapM_IntSet :: (Monoid n, Monad m) => (Int -> m n) -> IntSet.IntSet -> m n
-foldMapM_IntSet f set = go set
-  where
-    go set = case IntSet.splitRoot set of
-               [] -> return mempty
-               [x] -> foldlM (\x v -> mappend x <$> f v) mempty (IntSet.toList x)
-               xs -> foldlM (\x set' -> mappend x <$> go set') mempty xs

From e61927cca1bcb895eb2bc03faf9d2c18a334bf0b Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Sat, 5 Oct 2019 23:48:47 +0900
Subject: [PATCH 104/148] AGC039

---
 README.md        | 23 +++++++++++++++
 agc039-a/Main.hs | 15 ++++++++++
 agc039-b/Main.hs | 75 ++++++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 113 insertions(+)
 create mode 100644 agc039-a/Main.hs
 create mode 100644 agc039-b/Main.hs

diff --git a/README.md b/README.md
index 5e4268a..1f3f726 100644
--- a/README.md
+++ b/README.md
@@ -285,3 +285,26 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 * [x] D - Classified
 * [ ] E - Card Collector
 * [ ] F - Candy Retribution
+
+## AtCoder Grand Contest 038
+
+<https://atcoder.jp/contests/agc038>
+
+* [ ] A - 01 Matrix
+* [ ] B - Sorting a Segment
+* [ ] C - LCMs
+* [ ] D - Unique Path
+* [ ] E - Gachapon
+* [ ] F - Two Permutations
+
+## AtCoder Grand Contest 039 (2019-10-05)
+
+<https://atcoder.jp/contests/agc039>
+
+* [x] A - Connection and Disconnection
+* [x] B - Graph Partition
+    * 2部グラフの判定と、無向グラフの直径
+* [ ] C - Division by Two with Something
+* [ ] D - Incenters
+* [ ] E - Pairing Points
+* [ ] F - Min Product Sum
diff --git a/agc039-a/Main.hs b/agc039-a/Main.hs
new file mode 100644
index 0000000..1cd2d46
--- /dev/null
+++ b/agc039-a/Main.hs
@@ -0,0 +1,15 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Int (Int64)
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  s <- BS.getLine
+  k <- readLn :: IO Int64
+  let ss = BS.group s
+  let l = length ss
+  let result | l == 1 = k * fromIntegral (BS.length s) `quot` 2
+             | BS.head s == BS.last s = let ss0 = head ss
+                                            ssz = last ss
+                                        in fromIntegral (BS.length ss0 `quot` 2) + k * fromIntegral (sum $ map (\t -> BS.length t `quot` 2) $ init $ tail ss) + fromIntegral (BS.length ssz `quot` 2) + (k-1) * fromIntegral ((BS.length ss0 + BS.length ssz) `quot` 2)
+             | otherwise = k * fromIntegral (sum $ map (\t -> BS.length t `quot` 2) ss)
+  print result
diff --git a/agc039-b/Main.hs b/agc039-b/Main.hs
new file mode 100644
index 0000000..3785d4a
--- /dev/null
+++ b/agc039-b/Main.hs
@@ -0,0 +1,75 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Maybe
+import Data.Monoid
+import Data.Foldable
+import Control.Monad
+import Control.Monad.ST
+import Control.Monad.Trans.Maybe
+import qualified Data.Vector as V
+import qualified Data.Vector.Mutable as VM
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.IntSet as IntSet
+
+farthest :: V.Vector IntSet.IntSet -> Int -> Int
+farthest graph !origin = U.maximum d
+  where
+    d = U.create $ do
+      let n = V.length graph
+      vec <- UM.replicate n (-1 :: Int)
+      let bfs !depth !seen !set
+            | IntSet.null set = return ()
+            | otherwise = do
+                forM_ (IntSet.toList set) $ \i -> do
+                  UM.write vec i depth
+                let seen' = set `IntSet.union` seen
+                let next = foldMap_IntSet (graph V.!) set `IntSet.difference` seen'
+                bfs (depth + 1) seen' next
+      bfs 0 IntSet.empty (IntSet.singleton origin)
+      return vec
+
+solve :: V.Vector IntSet.IntSet -> Bool
+solve graph = fromMaybe False $ runST $ runMaybeT $ do
+  let n = V.length graph
+  result <- UM.replicate n (0 :: Int)
+  let dfs !p !i !c = do
+        c' <- UM.read result i
+        case c' of
+          0 -> do
+            UM.write result i c
+            forM_ (IntSet.toList $ graph V.! i) $ \j -> do
+              when (j /= p) $ do
+                dfs i j (-c)
+          _ | c' == c -> return ()
+            | otherwise -> mzero
+  dfs (-1) 0 1
+  return True
+
+main = do
+  n <- readLn
+  s <- V.replicateM n BS.getLine
+  -- s V.! i `BS.index` j
+  let graph :: V.Vector IntSet.IntSet
+      graph = V.create $ do
+        g <- VM.replicate n IntSet.empty
+        V.forM_ (V.indexed s) $ \(i,r) -> do
+          forM_ [0..n-1] $ \j -> do
+            let c = r `BS.index` j
+            when (c == '1') $ do
+              VM.modify g (IntSet.insert j) i
+        return g
+  if solve graph then do
+    let y = maximum $ map (farthest graph) [0..n-1]
+    print (y + 1)
+  else
+    putStrLn "-1"
+
+foldMap_IntSet :: (Monoid n) => (Int -> n) -> IntSet.IntSet -> n
+foldMap_IntSet f set = go set
+  where
+    go set = case IntSet.splitRoot set of
+               [] -> mempty
+               [x] -> foldMap f (IntSet.toList x)
+               xs -> foldMap go xs

From a7ee25f05920229a2ccfdf6ae088de3aeab2bd87 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Sun, 6 Oct 2019 18:03:21 +0900
Subject: [PATCH 105/148] AGC039-C: Buggy one

---
 agc039-c/Main.hs | 192 +++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 192 insertions(+)
 create mode 100644 agc039-c/Main.hs

diff --git a/agc039-c/Main.hs b/agc039-c/Main.hs
new file mode 100644
index 0000000..fe6b069
--- /dev/null
+++ b/agc039-c/Main.hs
@@ -0,0 +1,192 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (digitToInt, intToDigit)
+import Data.Int (Int64)
+import Data.Bits
+import Data.Coerce
+import Data.Foldable
+import Data.Monoid
+import Control.Monad
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.IntSet as IntSet
+import qualified Data.IntMap.Lazy as IntMap
+import Numeric
+
+oneAction :: Int -> Int -> Int
+oneAction !n x | even x = bit (n-1) + (x `shiftR` 1)
+               | otherwise = x `shiftR` 1
+
+naiveCount :: Int -> U.Vector Int
+naiveCount !n = U.create $ do
+  vec <- UM.replicate (2^n) (-1)
+  let loop !m !set !i
+        | i `IntSet.member` set = forM_ (IntSet.toList set) $ \j -> UM.write vec j m
+        | otherwise = loop (m+1) (IntSet.insert i set) (oneAction n i)
+  forM_ [0..2^n-1] $ \i -> do
+    v <- UM.read vec i
+    when (v == -1) $ do
+      loop 0 IntSet.empty i
+  return vec
+
+naive :: Int -> Int -> Int
+naive n x = U.sum $ U.take (x+1) $ naiveCount n
+
+naiveS :: Int -> BS.ByteString -> Int
+naiveS n x = naive n (readBinBS x)
+
+---
+
+readBinBS :: Num a => BS.ByteString -> a
+readBinBS = BS.foldl' (\a c -> 2 * a + fromIntegral (digitToInt c)) 0
+
+flipS :: BS.ByteString -> BS.ByteString
+flipS = BS.map (\c -> if c == '0' then '1' else '0')
+
+solve :: Int -> BS.ByteString -> N
+solve !n !x = sum [ 2 * fromIntegral (n `quot` m * p) * a | (p,a) <- IntMap.toList d ]
+  where
+    countOne :: Int -> N
+    countOne p = let q = n `quot` p
+                     x0 = BS.take q x
+                     y = BS.concat $ x0 : concat (replicate (p `quot` 2) [flipS x0, x0])
+                 in readBinBS (BS.take q x) + (if y <= x then 1 else 0)
+    factors :: [(Int, Int)]
+    factors = filter (\(p,_) -> odd p) $ factor n
+    cc :: IntMap.IntMap N
+    cc = foldl' go (IntMap.singleton 1 (countOne 1)) factors
+      where
+        go t (!p,!k) = t `IntMap.union`
+                       IntMap.fromList [ (a*p^i, countOne (a*p^i)) | (a,b) <- IntMap.toList t, i <- [1..k] ]
+    m = product [ p^l | (p,l) <- factors ]
+    mm = cc IntMap.! m
+    d :: IntMap.IntMap N
+    d = foldl' go (IntMap.singleton 1 mm) factors
+      where
+        go t (!p,!k) = t `IntMap.union`
+                       IntMap.fromList [ (a*p^i, value)
+                                       | (a,b) <- IntMap.toList t, i <- [1..k]
+                                       , let value | a /= 1    = cc IntMap.! (m `div` (a*p^i)) - cc IntMap.! (m `div` a) - cc IntMap.! (m `div` (p^i)) + mm
+                                                   | otherwise = cc IntMap.! (m `div` (a*p^i)) - cc IntMap.! (m `div` (p^(i-1)))
+                                       ]
+
+main = do
+  n <- readLn :: IO Int
+  x <- BS.getLine
+  print $ solve n x
+  -- print $ naiveS n x
+
+showBin :: (Integral a, Show a) => a -> ShowS
+showBin = showIntAtBase 2 intToDigit
+
+showBinBS :: (Integral a, Show a) => a -> BS.ByteString
+showBinBS x = BS.pack $ showBin x ""
+
+padZeroBS :: Int -> BS.ByteString -> BS.ByteString
+padZeroBS n s = BS.replicate (n - BS.length s) '0' <> s
+
+checkBS :: Int -> BS.ByteString -> (Int, N)
+checkBS n x = (naiveS n x, solve n x)
+
+checkI :: Int -> Int -> (Int, N)
+checkI n x = checkBS n $ padZeroBS n (showBinBS x)
+
+checkBatch :: Int -> [(Int,Int,N)]
+checkBatch n = let s = U.tail $ U.scanl' (+) 0 $ naiveCount n
+               in [(x,y,z) | x <- [0..2^n-1], let y = s U.! x ; z = solve n (padZeroBS n (showBinBS x)), fromIntegral y /= z]
+
+--
+-- Modular Arithmetic
+--
+
+modulo :: Int64
+modulo = 998244353
+addMod, subMod, mulMod :: Int64 -> Int64 -> Int64
+addMod !x !y | x + y >= modulo = x + y - modulo
+             | otherwise = x + y
+subMod !x !y | x >= y = x - y
+             | otherwise = x - y + modulo
+mulMod !x !y = (x * y) `rem` modulo
+
+newtype N = N { unwrapN :: Int64 } deriving (Eq)
+instance Show N where
+  show (N x) = show x
+instance Num N where
+  (+) = coerce addMod
+  (-) = coerce subMod
+  (*) = coerce mulMod
+  fromInteger n = N (fromInteger (n `mod` fromIntegral modulo))
+  abs = undefined; signum = undefined
+
+{-# RULES
+"^9/Int" forall x. x ^ (9 :: Int) = let u = x; v = u * u * u in v * v * v
+"^9/Integer" forall x. x ^ (9 :: Integer) = let u = x; v = u * u * u in v * v * v
+ #-}
+
+fromIntegral_Int64_N :: Int64 -> N
+fromIntegral_Int64_N n | 0 <= n && n < modulo = N n
+                       | otherwise = N (n `mod` modulo)
+
+{-# RULES
+"fromIntegral/Int->N" fromIntegral = fromIntegral_Int64_N . (fromIntegral :: Int -> Int64)
+"fromIntegral/Int64->N" fromIntegral = fromIntegral_Int64_N
+ #-}
+
+--
+-- Sieve of Eratosthenes
+--
+
+infixr 5 !:
+(!:) :: a -> [a] -> [a]
+(!x) !: xs = x : xs
+
+-- | エラトステネスの篩により、 max 以下の素数の一覧を構築して返す
+-- >>> sieve 100
+-- [2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97]
+sieve :: Int -> [Int]
+sieve !max = 2 : U.ifoldr (\i isPrime xs -> if isPrime then (2 * i + 1) !: xs else xs) [] vec
+  where
+    vec = U.create $ do
+      vec <- UM.replicate ((max - 1) `quot` 2 + 1) True
+      UM.write vec 0 False -- 1 is not a prime
+      -- vec ! i : is (2 * i + 1) prime?
+      let clear !p = forM_ [3*p,5*p..max] $ \n -> UM.write vec (n `quot` 2) False
+          factorBound = floor (sqrt (fromIntegral max) :: Double)
+          loop !i | 2 * i + 1 > factorBound = return ()
+                  | otherwise = do b <- UM.read vec i
+                                   when b $ clear (2 * i + 1)
+                                   loop (i + 1)
+      loop 1
+      return vec
+
+-- |
+-- >>> takeWhile (< 100) primes
+-- [2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97]
+primes :: [Int]
+primes = sieve 31622
+-- floor (sqrt (10^9+9)) == 31622
+-- length primes == 3401
+
+-- x <= 10^9+9
+-- |
+-- >>> factor 100
+-- [(2,2),(5,2)]
+-- >>> factor 144
+-- [(2,4),(3,2)]
+-- >>> factor (10^9+6)
+-- [(2,1),(500000003,1)]
+-- >>> factor (10^9+7)
+-- [(1000000007,1)]
+factor :: Int -> [(Int, Int)]
+factor 0 = error "factor 0"
+factor x | x > 10^9+9 = error "factor: too large"
+factor x = loop x primes
+  where
+    loop 1 _ = []
+    loop x (p:ps) = case factorOut 0 x p of
+                      (0,y) -> loop x ps
+                      (n,y) -> (p,n) : loop y ps
+    loop x [] = [(x,1)]
+    factorOut !n !x !p | (q,0) <- x `quotRem` p = factorOut (n+1) q p
+                       | otherwise = (n, x)

From f9aa26e6d2fa8179488ca6de69a43bd9a3ca13f6 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Tue, 8 Oct 2019 15:26:58 +0900
Subject: [PATCH 106/148] AGC039-C: Still buggy

---
 agc039-c/Main.hs | 78 ++++++++++++++++++++++++++++--------------------
 1 file changed, 45 insertions(+), 33 deletions(-)

diff --git a/agc039-c/Main.hs b/agc039-c/Main.hs
index fe6b069..8531c1e 100644
--- a/agc039-c/Main.hs
+++ b/agc039-c/Main.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE BangPatterns #-}
 import Data.Char (digitToInt, intToDigit)
 import Data.Int (Int64)
+import Data.List (tails)
 import Data.Bits
 import Data.Coerce
 import Data.Foldable
@@ -13,6 +14,7 @@ import qualified Data.ByteString.Char8 as BS
 import qualified Data.IntSet as IntSet
 import qualified Data.IntMap.Lazy as IntMap
 import Numeric
+import System.Environment
 
 oneAction :: Int -> Int -> Int
 oneAction !n x | even x = bit (n-1) + (x `shiftR` 1)
@@ -45,37 +47,37 @@ flipS :: BS.ByteString -> BS.ByteString
 flipS = BS.map (\c -> if c == '0' then '1' else '0')
 
 solve :: Int -> BS.ByteString -> N
-solve !n !x = sum [ 2 * fromIntegral (n `quot` m * p) * a | (p,a) <- IntMap.toList d ]
+solve !n !x = sum [ 2 * fromIntegral (n `quot` m) * fromIntegral p * a | (p,a) <- IntMap.toList d ]
   where
     countOne :: Int -> N
-    countOne p = let q = n `quot` p
-                     x0 = BS.take q x
-                     y = BS.concat $ x0 : concat (replicate (p `quot` 2) [flipS x0, x0])
-                 in readBinBS (BS.take q x) + (if y <= x then 1 else 0)
-    factors :: [(Int, Int)]
-    factors = filter (\(p,_) -> odd p) $ factor n
+    countOne p | odd p = let q = n `quot` p
+                             x0 = BS.take q x
+                             y = BS.concat $ x0 : concat (replicate (p `quot` 2) [flipS x0, x0])
+                         in readBinBS (BS.take q x) + (if y <= x then 1 else 0)
+               | otherwise = error "countOne: argument must be odd"
+
+    oddFactors :: [(Int, Int)]
+    oddFactors = filter (\(p,_) -> odd p) $ factor n
+    m = product [ p^l | (p,l) <- oddFactors ]
+    divisorLattice = buildDivisorLattice m
     cc :: IntMap.IntMap N
-    cc = foldl' go (IntMap.singleton 1 (countOne 1)) factors
-      where
-        go t (!p,!k) = t `IntMap.union`
-                       IntMap.fromList [ (a*p^i, countOne (a*p^i)) | (a,b) <- IntMap.toList t, i <- [1..k] ]
-    m = product [ p^l | (p,l) <- factors ]
-    mm = cc IntMap.! m
+    cc = IntMap.mapWithKey (\a _ -> countOne $ m `div` a) divisorLattice
     d :: IntMap.IntMap N
-    d = foldl' go (IntMap.singleton 1 mm) factors
-      where
-        go t (!p,!k) = t `IntMap.union`
-                       IntMap.fromList [ (a*p^i, value)
-                                       | (a,b) <- IntMap.toList t, i <- [1..k]
-                                       , let value | a /= 1    = cc IntMap.! (m `div` (a*p^i)) - cc IntMap.! (m `div` a) - cc IntMap.! (m `div` (p^i)) + mm
-                                                   | otherwise = cc IntMap.! (m `div` (a*p^i)) - cc IntMap.! (m `div` (p^(i-1)))
-                                       ]
+    d = IntMap.mapWithKey (\a v -> let dv = IntSet.toList v
+                                   in cc IntMap.! a
+                                      - sum [ cc IntMap.! d | d <- dv ]
+                                      + sum [ cc IntMap.! gcd d1 d2 | d1:dv' <- tails dv, d2 <- dv' ]
+                          ) divisorLattice
 
 main = do
-  n <- readLn :: IO Int
-  x <- BS.getLine
-  print $ solve n x
-  -- print $ naiveS n x
+  args <- getArgs
+  case args of
+    [a] | [(n,"")] <- reads a -> print $ checkBatch n
+    _ -> do
+      n <- readLn :: IO Int
+      x <- BS.getLine
+      print $ solve n x
+      -- print $ naiveS n x
 
 showBin :: (Integral a, Show a) => a -> ShowS
 showBin = showIntAtBase 2 intToDigit
@@ -100,14 +102,14 @@ checkBatch n = let s = U.tail $ U.scanl' (+) 0 $ naiveCount n
 -- Modular Arithmetic
 --
 
-modulo :: Int64
-modulo = 998244353
+modulus :: Int64
+modulus = 998244353
 addMod, subMod, mulMod :: Int64 -> Int64 -> Int64
-addMod !x !y | x + y >= modulo = x + y - modulo
+addMod !x !y | x + y >= modulus = x + y - modulus
              | otherwise = x + y
 subMod !x !y | x >= y = x - y
-             | otherwise = x - y + modulo
-mulMod !x !y = (x * y) `rem` modulo
+             | otherwise = x - y + modulus
+mulMod !x !y = (x * y) `rem` modulus
 
 newtype N = N { unwrapN :: Int64 } deriving (Eq)
 instance Show N where
@@ -116,7 +118,7 @@ instance Num N where
   (+) = coerce addMod
   (-) = coerce subMod
   (*) = coerce mulMod
-  fromInteger n = N (fromInteger (n `mod` fromIntegral modulo))
+  fromInteger n = N (fromInteger (n `mod` fromIntegral modulus))
   abs = undefined; signum = undefined
 
 {-# RULES
@@ -125,8 +127,8 @@ instance Num N where
  #-}
 
 fromIntegral_Int64_N :: Int64 -> N
-fromIntegral_Int64_N n | 0 <= n && n < modulo = N n
-                       | otherwise = N (n `mod` modulo)
+fromIntegral_Int64_N n | 0 <= n && n < modulus = N n
+                       | otherwise = N (n `mod` modulus)
 
 {-# RULES
 "fromIntegral/Int->N" fromIntegral = fromIntegral_Int64_N . (fromIntegral :: Int -> Int64)
@@ -190,3 +192,13 @@ factor x = loop x primes
     loop x [] = [(x,1)]
     factorOut !n !x !p | (q,0) <- x `quotRem` p = factorOut (n+1) q p
                        | otherwise = (n, x)
+
+-- |
+-- >>> buildDivisorLattice 30
+-- fromList [(1,fromList []),(2,fromList [1]),(3,fromList [1]),(5,fromList [1]),(6,fromList [2,3]),(10,fromList [2,5]),(15,fromList [3,5]),(30,fromList [6,10,15])]
+buildDivisorLattice :: Int -> IntMap.IntMap IntSet.IntSet
+buildDivisorLattice x
+  = let xs = factor x
+    in IntMap.fromList $ do f <- filter (\(_,i) -> i > 0) <$> mapM (\(p,k) -> [(p,i) | i <- [0..k]]) xs
+                            let !a = product [p^i | (p,i) <- f]
+                            return (a, IntSet.fromList [ a `div` p | (p,_) <- f ])

From e8814994b05bd9c5c1fc8626e2cf1fcb1ca9068c Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Sat, 9 Nov 2019 20:54:59 +0900
Subject: [PATCH 107/148] AGC040-A

---
 README.md        | 11 +++++++++++
 agc040-a/Main.hs | 16 ++++++++++++++++
 2 files changed, 27 insertions(+)
 create mode 100644 agc040-a/Main.hs

diff --git a/README.md b/README.md
index 1f3f726..851eb1b 100644
--- a/README.md
+++ b/README.md
@@ -308,3 +308,14 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 * [ ] D - Incenters
 * [ ] E - Pairing Points
 * [ ] F - Min Product Sum
+
+## AtCoder Grand Contest 040 (2019-11-04)
+
+<https://atcoder.jp/contests/agc040>
+
+* [x] A - \>\<
+* [ ] B - Two Contests
+* [ ] C - Neither AB nor BA
+* [ ] D - Balance Beam
+* [ ] E - Prefix Suffix Addition
+* [ ] F - Two Pieces
diff --git a/agc040-a/Main.hs b/agc040-a/Main.hs
new file mode 100644
index 0000000..a5f9fe0
--- /dev/null
+++ b/agc040-a/Main.hs
@@ -0,0 +1,16 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Int (Int64)
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  s <- BS.getLine
+  let gg = map (\t -> (BS.head t, fromIntegral $ BS.length t)) $ BS.group s
+      g = case gg of
+            ('>',_):_ -> ('<',0) : gg
+            _ -> gg
+      loop :: Int64 -> [(Char,Int64)] -> Int64
+      loop !acc [] = acc
+      loop !acc (('<',a):('>',b):xs) = loop (acc + a * (a-1) `quot` 2 + b * (b-1) `quot` 2 + max a b)xs
+      loop !acc [('<',a)] = acc + a * (a+1) `quot` 2
+  print $ loop 0 g

From f5289ef082e268814324d584e3f5f6a1ffbff102 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Sat, 9 Nov 2019 20:57:29 +0900
Subject: [PATCH 108/148] ABC143

---
 abc/README.md                | 11 ++++++
 abc/abc143-a/Main.hs         |  8 ++++
 abc/abc143-b/Main.hs         |  9 +++++
 abc/abc143-c/Main.hs         |  7 ++++
 abc/abc143-d/Cached.hs       | 73 ++++++++++++++++++++++++++++++++++++
 abc/abc143-d/Main.hs         | 73 ++++++++++++++++++++++++++++++++++++
 abc/abc143-e/Main.hs         | 61 ++++++++++++++++++++++++++++++
 abc/abc143-e/Vector.hs       | 67 +++++++++++++++++++++++++++++++++
 abc/abc143-e/Vector2.hs      | 58 ++++++++++++++++++++++++++++
 abc/abc143-e/VectorUnsafe.hs | 65 ++++++++++++++++++++++++++++++++
 10 files changed, 432 insertions(+)
 create mode 100644 abc/abc143-a/Main.hs
 create mode 100644 abc/abc143-b/Main.hs
 create mode 100644 abc/abc143-c/Main.hs
 create mode 100644 abc/abc143-d/Cached.hs
 create mode 100644 abc/abc143-d/Main.hs
 create mode 100644 abc/abc143-e/Main.hs
 create mode 100644 abc/abc143-e/Vector.hs
 create mode 100644 abc/abc143-e/Vector2.hs
 create mode 100644 abc/abc143-e/VectorUnsafe.hs

diff --git a/abc/README.md b/abc/README.md
index 7413f8f..700a90e 100644
--- a/abc/README.md
+++ b/abc/README.md
@@ -336,3 +336,14 @@
 * [x] D - Disjoint Set of Common Divisors
 * [x] E - Get Everything
 * [x] F - Pure
+
+## AtCoder Beginner Contest 143
+
+<https://atcoder.jp/contests/abc143>
+
+* [x] A - Curtain
+* [x] B - TAKOYAKI FESTIVAL 2019
+* [x] C - Slimes
+* [x] D - Triangles
+* [x] E - Travel by Car
+* [ ] F - Distinct Numbers
diff --git a/abc/abc143-a/Main.hs b/abc/abc143-a/Main.hs
new file mode 100644
index 0000000..fd0764d
--- /dev/null
+++ b/abc/abc143-a/Main.hs
@@ -0,0 +1,8 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  [a,b] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  print $ a - min a (2 * b)
diff --git a/abc/abc143-b/Main.hs b/abc/abc143-b/Main.hs
new file mode 100644
index 0000000..7e1c352
--- /dev/null
+++ b/abc/abc143-b/Main.hs
@@ -0,0 +1,9 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Char (isSpace)
+import Data.List (unfoldr, tails)
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  n <- readLn :: IO Int
+  d <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  print $ sum [ x * y | x:xs <- tails d, y <- xs ]
diff --git a/abc/abc143-c/Main.hs b/abc/abc143-c/Main.hs
new file mode 100644
index 0000000..07cd2c0
--- /dev/null
+++ b/abc/abc143-c/Main.hs
@@ -0,0 +1,7 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  n <- readLn :: IO Int
+  s <- BS.getLine
+  print $ length $ BS.group s
diff --git a/abc/abc143-d/Cached.hs b/abc/abc143-d/Cached.hs
new file mode 100644
index 0000000..2fab186
--- /dev/null
+++ b/abc/abc143-d/Cached.hs
@@ -0,0 +1,73 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.List (unfoldr, tails, sort)
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+
+isTriangle :: Int -> Int -> Int -> Bool
+isTriangle a b c = a < b + c && b < c + a && c < a + b
+
+naive = do
+  n <- readLn :: IO Int
+  xs <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  print $ length [ (a,b,c) | a:xss <- tails xs, b:xsss <- tails xss, c <- xsss, isTriangle a b c ]
+
+-- v は昇順にソートされているとする。
+-- countGE a v は a 以上の要素の個数を数える。
+countGE :: Int -> U.Vector Int -> Int
+countGE !a = loop 0
+  where
+    loop !s !v | U.null v = s
+               | U.length v == 1 = if a <= U.head v then
+                                     s + 1
+                                   else
+                                     s
+               | otherwise = let n = U.length v
+                                 n2 = n `quot` 2
+                             in if a <= v U.! n2 then
+                                  loop (n - n2 + s) (U.take n2 v)
+                                else
+                                  loop s (U.drop n2 v)
+
+main = do
+  n <- readLn :: IO Int
+  xs <- mergeSort . U.unfoldrN n (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  let c = U.generate (2*10^3+1) $ \c_max -> countGE c_max xs
+  print $ sum [ n - (j+1) - min (n - (j+1)) (c U.! c_max)
+              | i <- [0..n-1]
+              , let a = xs U.! i
+              , j <- [i+1..n-1]
+              , let b = xs U.! j
+              , let c_max = a + b {- c < a + b, b - a < c, a - b < c -}
+              ]
+
+mergeSortBy :: (U.Unbox a) => (a -> a -> Ordering) -> U.Vector a -> U.Vector a
+mergeSortBy !cmp !vec = doSort vec
+  where
+    doSort vec | U.length vec <= 1 = vec
+               | otherwise = let (xs, ys) = U.splitAt (U.length vec `quot` 2) vec
+                             in merge (doSort xs) (doSort ys)
+    merge xs ys = U.create $ do
+      let !n = U.length xs
+          !m = U.length ys
+      result <- UM.new (n + m)
+      let loop !i !j
+            | i == n = U.copy (UM.drop (i + j) result) (U.drop j ys)
+            | j == m = U.copy (UM.drop (i + j) result) (U.drop i xs)
+            | otherwise = let !x = xs U.! i
+                              !y = ys U.! j
+                          in case cmp x y of
+                               LT -> do UM.write result (i + j) x
+                                        loop (i + 1) j
+                               EQ -> do UM.write result (i + j) x
+                                        UM.write result (i + j + 1) y
+                                        loop (i + 1) (j + 1)
+                               GT -> do UM.write result (i + j) y
+                                        loop i (j + 1)
+      loop 0 0
+      return result
+
+mergeSort :: (U.Unbox a, Ord a) => U.Vector a -> U.Vector a
+mergeSort = mergeSortBy compare
diff --git a/abc/abc143-d/Main.hs b/abc/abc143-d/Main.hs
new file mode 100644
index 0000000..41778ff
--- /dev/null
+++ b/abc/abc143-d/Main.hs
@@ -0,0 +1,73 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.List (unfoldr, tails, sort)
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+
+isTriangle :: Int -> Int -> Int -> Bool
+isTriangle a b c = a < b + c && b < c + a && c < a + b
+
+naive = do
+  n <- readLn :: IO Int
+  xs <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  print $ length [ (a,b,c) | a:xss <- tails xs, b:xsss <- tails xss, c <- xsss, isTriangle a b c ]
+
+-- v は昇順にソートされているとする。
+-- countGE a v は a 以上の要素の個数を数える。
+countGE :: Int -> U.Vector Int -> Int
+countGE !a = loop 0
+  where
+    loop !s !v | U.null v = s
+               | U.length v == 1 = if a <= U.head v then
+                                     s + 1
+                                   else
+                                     s
+               | otherwise = let n = U.length v
+                                 n2 = n `quot` 2
+                             in if a <= v U.! n2 then
+                                  loop (n - n2 + s) (U.take n2 v)
+                                else
+                                  loop s (U.drop n2 v)
+
+main = do
+  n <- readLn :: IO Int
+  xs <- mergeSort . U.unfoldrN n (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  print $ sum [ n - (j+1) - min (n - (j+1)) (countGE c_max xs)
+              | i <- [0..n-1]
+              , let a = xs U.! i
+              , j <- [i+1..n-1]
+              , let b = xs U.! j
+              , let c_max = a + b {- c < a + b, b - a < c, a - b < c -}
+              , let ys = U.drop (j+1) xs
+              ]
+
+mergeSortBy :: (U.Unbox a) => (a -> a -> Ordering) -> U.Vector a -> U.Vector a
+mergeSortBy !cmp !vec = doSort vec
+  where
+    doSort vec | U.length vec <= 1 = vec
+               | otherwise = let (xs, ys) = U.splitAt (U.length vec `quot` 2) vec
+                             in merge (doSort xs) (doSort ys)
+    merge xs ys = U.create $ do
+      let !n = U.length xs
+          !m = U.length ys
+      result <- UM.new (n + m)
+      let loop !i !j
+            | i == n = U.copy (UM.drop (i + j) result) (U.drop j ys)
+            | j == m = U.copy (UM.drop (i + j) result) (U.drop i xs)
+            | otherwise = let !x = xs U.! i
+                              !y = ys U.! j
+                          in case cmp x y of
+                               LT -> do UM.write result (i + j) x
+                                        loop (i + 1) j
+                               EQ -> do UM.write result (i + j) x
+                                        UM.write result (i + j + 1) y
+                                        loop (i + 1) (j + 1)
+                               GT -> do UM.write result (i + j) y
+                                        loop i (j + 1)
+      loop 0 0
+      return result
+
+mergeSort :: (U.Unbox a, Ord a) => U.Vector a -> U.Vector a
+mergeSort = mergeSortBy compare
diff --git a/abc/abc143-e/Main.hs b/abc/abc143-e/Main.hs
new file mode 100644
index 0000000..4f4097d
--- /dev/null
+++ b/abc/abc143-e/Main.hs
@@ -0,0 +1,61 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.Int (Int64)
+import Data.List (unfoldr)
+import Control.Monad
+import qualified Data.Vector.Unboxed as U
+import qualified Data.ByteString.Char8 as BS
+import Data.Array.Unboxed
+import Data.Array.ST
+
+warshallFloyd1 :: Int -> U.Vector (Int, Int, Int64) -> UArray (Int, Int) Int64
+warshallFloyd1 !n !edges = runSTUArray $ do
+  !arr <- newArray ((0,0),(n-1,n-1)) (10^9+1)
+  U.forM_ edges $ \(a,b,c) -> do
+    writeArray arr (a,b) c
+    writeArray arr (b,a) c
+  forM_ [0..n-1] $ \a -> do
+    writeArray arr (a,a) 0
+  forM_ [0..n-1] $ \k -> do
+    forM_ [0..n-1] $ \i -> do
+      forM_ [0..n-1] $ \j -> do
+        a_ik <- readArray arr (i,k)
+        a_kj <- readArray arr (k,j)
+        a_ij <- readArray arr (i,j)
+        writeArray arr (i,j) $! min a_ij (a_ik + a_kj)
+  return arr
+
+warshallFloyd2 :: Int -> Int -> UArray (Int, Int) Int64 -> UArray (Int, Int) Int
+warshallFloyd2 !n !l !graph = runSTUArray $ do
+  !arr <- newArray ((0,0),(n-1,n-1)) (10^9+1)
+  forM_ [0..n-1] $ \a -> do
+    forM_ [0..n-1] $ \b -> do
+      let v = graph ! (a,b)
+      when (v <= fromIntegral l) $ do
+        writeArray arr (a,b) 1
+  forM_ [0..n-1] $ \a -> do
+    writeArray arr (a,a) 0
+  forM_ [0..n-1] $ \k -> do
+    forM_ [0..n-1] $ \i -> do
+      forM_ [0..n-1] $ \j -> do
+        a_ik <- readArray arr (i,k)
+        a_kj <- readArray arr (k,j)
+        a_ij <- readArray arr (i,j)
+        writeArray arr (i,j) $! min a_ij (a_ik + a_kj)
+  return arr
+
+main = do
+  [n,m,l] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  edges <- U.replicateM m $ do
+    [a,b,c] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+    return (a-1,b-1,fromIntegral c)
+  let w1 = warshallFloyd1 n edges
+      w2 = warshallFloyd2 n l w1
+  q <- readLn
+  queries <- U.replicateM q $ do
+    [s,t] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+    return (s,t)
+  U.forM_ queries $ \(s,t) -> do
+    let d = w2 ! (s-1,t-1)
+    print $ if d > 10^9 then -1 else d - 1
diff --git a/abc/abc143-e/Vector.hs b/abc/abc143-e/Vector.hs
new file mode 100644
index 0000000..af0d3d2
--- /dev/null
+++ b/abc/abc143-e/Vector.hs
@@ -0,0 +1,67 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import Control.Monad
+import Control.Monad.ST
+import qualified Data.Vector as V
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.ByteString.Builder as BSB
+import System.IO (stdout)
+import Data.Monoid
+
+warshallFloyd1 :: Int -> U.Vector (Int, Int, Int) -> V.Vector (U.Vector Int)
+warshallFloyd1 !n !edges = runST $ do
+  !arr <- V.replicateM n (UM.replicate n (10^9+1))
+  U.forM_ edges $ \(a,b,c) -> do
+    UM.write (arr V.! a) b c
+    UM.write (arr V.! b) a c
+  forM_ [0..n-1] $ \a -> do
+    UM.write (arr V.! a) a 0
+  flip V.imapM_ arr $ \ !k !a_k -> do
+    V.forM_ arr $ \ !a_i -> do
+      !a_ik <- UM.read a_i k
+      forM_ [0..n-1] $ \j -> do
+        a_kj <- UM.read a_k j
+        UM.modify a_i (min (a_ik + a_kj)) j
+  V.mapM U.unsafeFreeze arr
+
+warshallFloyd2 :: Int -> Int -> V.Vector (U.Vector Int) -> V.Vector (U.Vector Int)
+warshallFloyd2 !n !l !graph = runST $ do
+  !arr <- V.replicateM n (UM.replicate n (10^9+1))
+  flip V.imapM_ (V.zip graph arr) $ \ !a (!g_a,!a_a) -> do
+    flip U.imapM_ g_a $ \ !b !v -> do
+      when (v <= fromIntegral l) $ do
+        UM.write a_a b 1
+    UM.write a_a a 0
+  flip V.imapM_ arr $ \ !k !a_k -> do
+    V.forM_ arr $ \ !a_i -> do
+      !a_ik <- UM.read a_i k
+      forM_ [0..n-1] $ \j -> do
+        a_kj <- UM.read a_k j
+        UM.modify a_i (min (a_ik + a_kj)) j
+  V.mapM U.unsafeFreeze arr
+
+main = do
+  [n,m,l] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  edges <- U.replicateM m $ do
+    [a,b,c] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+    return (a-1,b-1,c)
+  let !w1 = warshallFloyd1 n edges
+      !w2 = warshallFloyd2 n l w1
+  q <- readLn
+  queries <- U.replicateM q $ do
+    [s,t] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+    return (s,t)
+  {-
+  U.forM_ queries $ \(s,t) -> do
+    let d = w2 V.! (s-1) U.! (t-1)
+    print $ if d > 10^9 then -1 else d - 1
+  -}
+  BSB.hPutBuilder stdout $ mconcat
+    [ BSB.intDec (if d > 10^9 then -1 else d - 1) <> BSB.char7 '\n'
+    | (s,t) <- U.toList queries
+    , let d = w2 V.! (s-1) U.! (t-1)
+    ]
diff --git a/abc/abc143-e/Vector2.hs b/abc/abc143-e/Vector2.hs
new file mode 100644
index 0000000..7918d62
--- /dev/null
+++ b/abc/abc143-e/Vector2.hs
@@ -0,0 +1,58 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import Control.Monad
+import Control.Monad.ST
+import qualified Data.Vector as V
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.ByteString.Builder as BSB
+import System.IO (stdout)
+import Data.Monoid
+
+warshallFloyd1 :: Int -> U.Vector (Int, Int, Int) -> V.Vector (U.Vector Int)
+warshallFloyd1 !n !edges = runST $ do
+  !arr <- V.replicateM n (UM.replicate n (10^9+1))
+  U.forM_ edges $ \(a,b,c) -> do
+    UM.write (arr V.! a) b c
+    UM.write (arr V.! b) a c
+  forM_ [0..n-1] $ \a -> do
+    UM.write (arr V.! a) a 0
+  flip V.imapM_ arr $ \ !k !a_k -> do
+    V.forM_ arr $ \ !a_i -> do
+      !a_ik <- UM.read a_i k
+      forM_ [0..n-1] $ \j -> do
+        a_kj <- UM.read a_k j
+        UM.modify a_i (min (a_ik + a_kj)) j
+  V.mapM U.unsafeFreeze arr
+
+warshallFloyd2 :: Int -> Int -> V.Vector (U.Vector Int) -> V.Vector (U.Vector Int)
+warshallFloyd2 !n !l !graph = runST $ do
+  !arr <- V.replicateM n (UM.replicate n (10^9+1))
+  flip V.imapM_ (V.zip arr graph) $ \ !a (!a_a,!g_a)-> do
+    flip U.imapM_ g_a $ \b v -> do
+      when (v <= fromIntegral l) $ do
+        UM.write a_a b 1
+    UM.write a_a a 0
+  flip V.imapM_ arr $ \ !k !a_k -> do
+    V.forM_ arr $ \ !a_i -> do
+      !a_ik <- UM.read a_i k
+      forM_ [0..n-1] $ \j -> do
+        a_kj <- UM.read a_k j
+        UM.modify a_i (min (a_ik + a_kj)) j
+  V.mapM U.unsafeFreeze arr
+
+main = do
+  [n,m,l] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  edges <- U.replicateM m $ do
+    [a,b,c] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+    return (a-1,b-1,c)
+  let !w1 = warshallFloyd1 n edges
+      !w2 = warshallFloyd2 n l w1
+  q <- readLn
+  queries <- U.replicateM q $ do
+    [s,t] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+    return (s,t)
+  BSB.hPutBuilder stdout $ mconcat [ BSB.intDec (if d > 10^9 then -1 else d - 1) <> BSB.char7 '\n' | (s,t) <- U.toList queries, let d = w2 V.! (s-1) U.! (t-1) ]
diff --git a/abc/abc143-e/VectorUnsafe.hs b/abc/abc143-e/VectorUnsafe.hs
new file mode 100644
index 0000000..cb68fc7
--- /dev/null
+++ b/abc/abc143-e/VectorUnsafe.hs
@@ -0,0 +1,65 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import Control.Monad
+import Control.Monad.ST
+import qualified Data.Vector as V
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.ByteString.Builder as BSB
+import System.IO (stdout)
+import Data.Monoid
+
+warshallFloyd1 :: Int -> U.Vector (Int, Int, Int) -> V.Vector (U.Vector Int)
+warshallFloyd1 !n !edges = runST $ do
+  !arr <- V.replicateM n (UM.replicate n (10^9+1))
+  U.forM_ edges $ \(a,b,c) -> do
+    UM.unsafeWrite (arr `V.unsafeIndex` a) b c
+    UM.unsafeWrite (arr `V.unsafeIndex` b) a c
+  forM_ [0..n-1] $ \a -> do
+    UM.unsafeWrite (arr `V.unsafeIndex` a) a 0
+  forM_ [0..n-1] $ \k -> do
+    let !a_k = arr `V.unsafeIndex` k
+    forM_ [0..n-1] $ \i -> do
+      let !a_i = arr `V.unsafeIndex` i
+      a_ik <- UM.unsafeRead a_i k
+      forM_ [0..n-1] $ \j -> do
+        a_kj <- UM.unsafeRead a_k j
+        UM.unsafeModify a_i (min (a_ik + a_kj)) j
+  V.mapM U.unsafeFreeze arr
+
+warshallFloyd2 :: Int -> Int -> V.Vector (U.Vector Int) -> V.Vector (U.Vector Int)
+warshallFloyd2 !n !l !graph = runST $ do
+  !arr <- V.replicateM n (UM.replicate n (10^9+1))
+  forM_ [0..n-1] $ \a -> do
+    let !a_a = arr `V.unsafeIndex` a
+    let !g_a = graph `V.unsafeIndex` a
+    forM_ [0..n-1] $ \b -> do
+      let v = g_a `U.unsafeIndex` b
+      when (v <= fromIntegral l) $ do
+        UM.unsafeWrite a_a b 1
+    UM.unsafeWrite a_a a 0
+  forM_ [0..n-1] $ \k -> do
+    let !a_k = arr `V.unsafeIndex` k
+    forM_ [0..n-1] $ \i -> do
+      let !a_i = arr `V.unsafeIndex` i
+      a_ik <- UM.unsafeRead a_i k
+      forM_ [0..n-1] $ \j -> do
+        a_kj <- UM.unsafeRead a_k j
+        UM.unsafeModify a_i (min (a_ik + a_kj)) j
+  V.mapM U.unsafeFreeze arr
+
+main = do
+  [n,m,l] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  edges <- U.replicateM m $ do
+    [a,b,c] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+    return (a-1,b-1,c)
+  let !w1 = warshallFloyd1 n edges
+      !w2 = warshallFloyd2 n l w1
+  q <- readLn
+  queries <- U.replicateM q $ do
+    [s,t] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+    return (s,t)
+  BSB.hPutBuilder stdout $ mconcat [ BSB.intDec (if d > 10^9 then -1 else d - 1) <> BSB.char7 '\n' | (s,t) <- U.toList queries, let d = w2 `V.unsafeIndex` (s-1) `U.unsafeIndex` (t-1) ]

From 90eccd8222fa04ffe335edeead7f0f6987551c83 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Sat, 9 Nov 2019 20:58:02 +0900
Subject: [PATCH 109/148] ABC144

---
 abc/README.md        | 11 +++++++++++
 abc/abc144-a/Main.hs | 11 +++++++++++
 abc/abc144-b/Main.hs |  8 ++++++++
 abc/abc144-c/Main.hs | 10 ++++++++++
 abc/abc144-d/Main.hs | 11 +++++++++++
 5 files changed, 51 insertions(+)
 create mode 100644 abc/abc144-a/Main.hs
 create mode 100644 abc/abc144-b/Main.hs
 create mode 100644 abc/abc144-c/Main.hs
 create mode 100644 abc/abc144-d/Main.hs

diff --git a/abc/README.md b/abc/README.md
index 700a90e..da272e0 100644
--- a/abc/README.md
+++ b/abc/README.md
@@ -347,3 +347,14 @@
 * [x] D - Triangles
 * [x] E - Travel by Car
 * [ ] F - Distinct Numbers
+
+## AtCoder Beginner Contest 144 (2019-10-27)
+
+<https://atcoder.jp/contests/abc144>
+
+* [x] A - 9x9
+* [x] B - 81
+* [x] C - Walk on Multiplication Table
+* [x] D - Water Bottle
+* [ ] E - Gluttony
+* [ ] F - Fork in the Road
diff --git a/abc/abc144-a/Main.hs b/abc/abc144-a/Main.hs
new file mode 100644
index 0000000..0f2b069
--- /dev/null
+++ b/abc/abc144-a/Main.hs
@@ -0,0 +1,11 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  [a,b] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  if a <= 9 && b <= 9 then
+    print (a * b)
+  else
+    print (-1)
diff --git a/abc/abc144-b/Main.hs b/abc/abc144-b/Main.hs
new file mode 100644
index 0000000..d2a3b14
--- /dev/null
+++ b/abc/abc144-b/Main.hs
@@ -0,0 +1,8 @@
+-- https://github.com/minoki/my-atcoder-solutions
+
+main = do
+  n <- readLn :: IO Int
+  if or [ n == a * b | a <- [1..9], b <- [1..9] ] then
+    putStrLn "Yes"
+  else
+    putStrLn "No"
diff --git a/abc/abc144-c/Main.hs b/abc/abc144-c/Main.hs
new file mode 100644
index 0000000..cb3db0f
--- /dev/null
+++ b/abc/abc144-c/Main.hs
@@ -0,0 +1,10 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Int (Int64)
+
+main = do
+  n <- readLn :: IO Int64
+  print $ minimum [ a + b - 2
+                  | d <- [1..floor (sqrt (fromIntegral n) :: Double)]
+                  , n `rem` d == 0
+                  , let a = d; b = n `quot` d
+                  ]
diff --git a/abc/abc144-d/Main.hs b/abc/abc144-d/Main.hs
new file mode 100644
index 0000000..4ee7a6d
--- /dev/null
+++ b/abc/abc144-d/Main.hs
@@ -0,0 +1,11 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  [a,b,x] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  if fromIntegral x <= (fromIntegral (a^2 * b) / 2 :: Double) then
+    print $ (pi / 2 - atan (2 * fromIntegral x / fromIntegral (a * b^2))) / pi * 180
+  else
+    print $ atan (2 * fromIntegral (a^2 * b - x) / fromIntegral (a^3)) / pi * 180

From 23b016a21e8ab80d954639742d5a17793131f822 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Sun, 24 Nov 2019 23:09:58 +0900
Subject: [PATCH 110/148] nikkei2019-2-qual

---
 README.md                   | 11 +++++
 nikkei2019-2-qual-a/Main.hs |  5 ++
 nikkei2019-2-qual-b/Main.hs | 58 ++++++++++++++++++++++
 nikkei2019-2-qual-d/Main.hs | 97 +++++++++++++++++++++++++++++++++++++
 4 files changed, 171 insertions(+)
 create mode 100644 nikkei2019-2-qual-a/Main.hs
 create mode 100644 nikkei2019-2-qual-b/Main.hs
 create mode 100644 nikkei2019-2-qual-d/Main.hs

diff --git a/README.md b/README.md
index 851eb1b..4bda9c5 100644
--- a/README.md
+++ b/README.md
@@ -319,3 +319,14 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 * [ ] D - Balance Beam
 * [ ] E - Prefix Suffix Addition
 * [ ] F - Two Pieces
+
+## 第二回全国統一プログラミング王決定戦予選 (2019-11-09)
+
+<https://atcoder.jp/contests/nikkei2019-2-qual>
+
+* [x] A - Sum of Two Integers
+* [x] B - Counting of Trees
+* [ ] C - Swaps
+* [x] D - Shortest Path on a Line
+* [ ] E - Non-triangular Triplets
+* [ ] F - Mirror Frame
diff --git a/nikkei2019-2-qual-a/Main.hs b/nikkei2019-2-qual-a/Main.hs
new file mode 100644
index 0000000..0ccb152
--- /dev/null
+++ b/nikkei2019-2-qual-a/Main.hs
@@ -0,0 +1,5 @@
+-- https://github.com/minoki/my-atcoder-solutions
+
+main = do
+  n <- readLn :: IO Int
+  print $ (n - 1) `quot` 2
diff --git a/nikkei2019-2-qual-b/Main.hs b/nikkei2019-2-qual-b/Main.hs
new file mode 100644
index 0000000..551fd20
--- /dev/null
+++ b/nikkei2019-2-qual-b/Main.hs
@@ -0,0 +1,58 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.Int (Int64)
+import Data.List
+import Control.Monad
+import qualified Data.ByteString.Char8 as BS
+import Data.Coerce
+
+main = do
+  n <- readLn :: IO Int
+  x0:xs <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  let loop acc prev prevN (x:xs) | prev + 1 == x = let (x',xss) = span (== x) xs
+                                                       m = length x' + 1
+                                                   in loop (acc * prevN ^ m) x (fromIntegral m) xss
+                                 | otherwise = 0
+      loop acc _ _ [] = acc
+  if x0 == 0 then
+    print (loop 1 0 1 (sort xs) :: N)
+  else
+    print 0
+
+--
+-- Modular Arithmetic
+--
+
+modulo :: Int64
+modulo = 998244353
+addMod, subMod, mulMod :: Int64 -> Int64 -> Int64
+addMod !x !y | x + y >= modulo = x + y - modulo
+             | otherwise = x + y
+subMod !x !y | x >= y = x - y
+             | otherwise = x - y + modulo
+mulMod !x !y = (x * y) `rem` modulo
+
+newtype N = N { unwrapN :: Int64 } deriving (Eq)
+instance Show N where
+  show (N x) = show x
+instance Num N where
+  (+) = coerce addMod
+  (-) = coerce subMod
+  (*) = coerce mulMod
+  fromInteger n = N (fromInteger (n `mod` fromIntegral modulo))
+  abs = undefined; signum = undefined
+
+{-# RULES
+"^9/Int" forall x. x ^ (9 :: Int) = let u = x; v = u * u * u in v * v * v
+"^9/Integer" forall x. x ^ (9 :: Integer) = let u = x; v = u * u * u in v * v * v
+ #-}
+
+fromIntegral_Int64_N :: Int64 -> N
+fromIntegral_Int64_N n | 0 <= n && n < modulo = N n
+                       | otherwise = N (n `mod` modulo)
+
+{-# RULES
+"fromIntegral/Int->N" fromIntegral = fromIntegral_Int64_N . (fromIntegral :: Int -> Int64)
+"fromIntegral/Int64->N" fromIntegral = fromIntegral_Int64_N
+ #-}
diff --git a/nikkei2019-2-qual-d/Main.hs b/nikkei2019-2-qual-d/Main.hs
new file mode 100644
index 0000000..b4c5dcf
--- /dev/null
+++ b/nikkei2019-2-qual-d/Main.hs
@@ -0,0 +1,97 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.Int (Int64)
+import Data.List (unfoldr, tails)
+import Control.Monad
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+import Control.Monad.ST
+import Data.Bits
+
+query :: Int -> Int -> U.Vector Int64 -> Int64
+query !i !depth vec = minimum [vec U.! (2^k - 1 + (i `shiftR` (depth - k))) | k <- [0..depth]]
+
+queryM :: Int -> Int -> UM.MVector s Int64 -> ST s Int64
+queryM !i !depth vec = minimum <$> sequence [UM.read vec (2^k - 1 + (i `shiftR` (depth - k))) | k <- [0..depth]]
+
+fill :: Int -> Int -> Int64 -> Int -> UM.MVector s Int64 -> ST s ()
+fill !i !j !x !depth vec | i < j = doFill 0 depth i j
+                         | otherwise = return ()
+  where
+    -- Invariant: 0 <= k*2^l <= i < j <= (k+1)*2^l <= 2^depth
+    doFill !k 0 !i !j | i == k, j == k+1 = UM.modify vec (min x) (2^depth - 1 + k)
+                      | otherwise = error "fill"
+    doFill !k l !i !j | i == (k `shiftL` l) && j == ((k+1) `shiftL` l) = UM.modify vec (min x) (2^(depth-l) - 1 + k)
+                      | m <= i = doFill (2*k+1) (l-1) i j
+                      | j <= m = doFill (2*k) (l-1) i j
+                      | otherwise = doFill (2*k) (l-1) i m >> doFill (2*k+1) (l-1) m j
+      where m = (2*k+1) `shiftL` (l-1)
+
+main = do
+  [n,m] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  specs <- fmap mergeSort $ U.replicateM m $ do
+    [x,y,z] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+    return (x-1,y-1,fromIntegral z)
+  let depth = ceiling (logBase 2 (fromIntegral n) :: Double) :: Int
+  let result :: Int64
+      result = runST $ do
+        vec <- UM.replicate (2^(depth+1) - 1) (10^18)
+        UM.write vec (2^depth-1 + 0) 0
+        U.forM_ specs $ \(l,r,c) -> do
+          lx <- queryM l depth vec
+          fill (l+1) (r+1) (lx+c) depth vec
+        queryM (n-1) depth vec
+        
+            {-
+  let ll = case U.unzip3 specs of (l,_,_) -> U.toList l ++ [n-1]
+  let vec :: U.Vector Int64
+      vec = U.create $ do
+        vec <- UM.replicate n (10^18)
+        UM.write vec 0 0
+        forM_ (zip [0..m-1] (tail $ tails ll)) $ \(i,rest) -> do
+          let (l,r,c) = specs U.! i
+          lx <- UM.read vec l
+          forM_ (takeWhile (<= r) rest) $ \j ->
+            UM.modify vec (min (lx+c)) j
+-}
+            {-
+        U.forM_ specs $ \(l,r,c) -> do
+          lx <- UM.read vec l
+          forM_ [l+1..r] $ \j ->
+            UM.modify vec (min (lx+c)) j
+-}
+  --      return vec
+  --let result = U.last vec
+  print $ if result == 10^18 then -1 else result
+
+mergeSortBy :: (U.Unbox a) => (a -> a -> Ordering) -> U.Vector a -> U.Vector a
+mergeSortBy !cmp !vec = doSort vec
+  where
+    doSort vec | U.length vec <= 1 = vec
+               | otherwise = let (xs, ys) = U.splitAt (U.length vec `quot` 2) vec
+                             in merge (doSort xs) (doSort ys)
+    merge xs ys = U.create $ do
+      let !n = U.length xs
+          !m = U.length ys
+      result <- UM.new (n + m)
+      let loop !i !j
+            | i == n = U.copy (UM.drop (i + j) result) (U.drop j ys)
+            | j == m = U.copy (UM.drop (i + j) result) (U.drop i xs)
+            | otherwise = let !x = xs U.! i
+                              !y = ys U.! j
+                          in case cmp x y of
+                               LT -> do UM.write result (i + j) x
+                                        loop (i + 1) j
+                               EQ -> do UM.write result (i + j) x
+                                        UM.write result (i + j + 1) y
+                                        loop (i + 1) (j + 1)
+                               GT -> do UM.write result (i + j) y
+                                        loop i (j + 1)
+      loop 0 0
+      return result
+
+mergeSort :: (U.Unbox a, Ord a) => U.Vector a -> U.Vector a
+mergeSort = mergeSortBy compare

From 66f8013a264cda0528f6349636c9e8e54d16b831 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Sun, 24 Nov 2019 23:10:33 +0900
Subject: [PATCH 111/148] ddcc2020-qual

---
 README.md               | 11 ++++++++++
 ddcc2020-qual-a/Main.hs | 22 ++++++++++++++++++++
 ddcc2020-qual-b/Main.hs | 18 ++++++++++++++++
 ddcc2020-qual-c/Main.hs | 46 +++++++++++++++++++++++++++++++++++++++++
 ddcc2020-qual-d/Main.hs | 32 ++++++++++++++++++++++++++++
 5 files changed, 129 insertions(+)
 create mode 100644 ddcc2020-qual-a/Main.hs
 create mode 100644 ddcc2020-qual-b/Main.hs
 create mode 100644 ddcc2020-qual-c/Main.hs
 create mode 100644 ddcc2020-qual-d/Main.hs

diff --git a/README.md b/README.md
index 4bda9c5..483367e 100644
--- a/README.md
+++ b/README.md
@@ -330,3 +330,14 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 * [x] D - Shortest Path on a Line
 * [ ] E - Non-triangular Triplets
 * [ ] F - Mirror Frame
+
+## DISCO presents ディスカバリーチャンネル コードコンテスト2020 予選 (2019-11-23)
+
+<https://atcoder.jp/contests/ddcc2020-qual>
+
+* [x] A - DDCC Finals
+* [x] B - Iron Bar Cutting
+* [x] C - Strawberry Cakes
+* [x] D - Digit Sum Replace
+* [ ] E - Majority of Balls
+* [ ] F - DISCOSMOS
diff --git a/ddcc2020-qual-a/Main.hs b/ddcc2020-qual-a/Main.hs
new file mode 100644
index 0000000..6f2d7a2
--- /dev/null
+++ b/ddcc2020-qual-a/Main.hs
@@ -0,0 +1,22 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.List (unfoldr)
+import Data.Char (isSpace)
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  [x,y] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  let a :: Int
+      a = case x of
+            3 -> 100000
+            2 -> 200000
+            1 -> 300000
+            _ -> 0
+  let b = case y of
+            3 -> 100000
+            2 -> 200000
+            1 -> 300000
+            _ -> 0
+  let c = case (x,y) of
+            (1,1) -> 400000
+            _ -> 0
+  print $ a+b+c
diff --git a/ddcc2020-qual-b/Main.hs b/ddcc2020-qual-b/Main.hs
new file mode 100644
index 0000000..9cc5983
--- /dev/null
+++ b/ddcc2020-qual-b/Main.hs
@@ -0,0 +1,18 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import qualified Data.Vector.Unboxed as U
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  n <- readLn :: IO Int
+  xs <- U.unfoldrN n (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  let ys = U.scanl (+) 0 xs
+  let total = U.last ys
+  let (zs,ws) = U.span (\x -> 2 * x <= total) ys
+  if 2 * (U.last zs) == total then
+    putStrLn "0"
+  else do
+    let a = U.last zs
+        b = U.head ws
+    print $ minimum $ map abs [total - 2 * a, total - 2 * b]
diff --git a/ddcc2020-qual-c/Main.hs b/ddcc2020-qual-c/Main.hs
new file mode 100644
index 0000000..32c4cb7
--- /dev/null
+++ b/ddcc2020-qual-c/Main.hs
@@ -0,0 +1,46 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.List (unfoldr, intersperse)
+import Control.Monad
+import qualified Data.Vector as V
+import qualified Data.Vector.Unboxed as U
+import qualified Data.ByteString.Char8 as BS
+import Data.Array.Unboxed
+import Data.Array.ST
+
+main = do
+  [h,w,k] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  matrix <- V.replicateM h BS.getLine
+  let result :: UArray (Int,Int) Int
+      result = runSTUArray $ do
+        a <- newArray ((0,0),(h-1,w-1)) 0
+        let go !i0 !i !n
+              | i == h = do
+                  forM_ [i0+1..h-1] $ \i' -> do
+                    forM_ [0..w-1] $ \j -> do
+                      v <- readArray a (i0,j)
+                      writeArray a (i',j) v
+              | BS.all (== '.') (matrix V.! i) = go i0 (i+1) n
+              | otherwise = do
+                  let row = matrix V.! i
+                  let go2 !j0 !j !n
+                        | j == w = do
+                            forM_ [j0+1..w-1] $ \j' -> do
+                              writeArray a (i,j') (n-1)
+                            return n
+                        | row `BS.index` j == '.' = go2 j0 (j+1) n
+                        | otherwise = do
+                            forM_ [j0+1..j] $ \j' -> do
+                              writeArray a (i,j') n
+                            go2 j (j+1) (n+1)
+                  n' <- go2 (-1) 0 n
+                  forM_ [i0+1..i-1] $ \i' -> do
+                    forM_ [0..w-1] $ \j -> do
+                      v <- readArray a (i,j)
+                      writeArray a (i',j) v
+                  go i (i+1) n'
+        go (-1) 0 1
+        return a
+  forM_ [0..h-1] $ \i -> do
+    putStrLn $ concat $ intersperse " " [show (result ! (i,j)) | j <- [0..w-1]]
diff --git a/ddcc2020-qual-d/Main.hs b/ddcc2020-qual-d/Main.hs
new file mode 100644
index 0000000..a628f0a
--- /dev/null
+++ b/ddcc2020-qual-d/Main.hs
@@ -0,0 +1,32 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import qualified Data.Vector as V
+import qualified Data.Vector.Unboxed as U
+import qualified Data.ByteString.Char8 as BS
+import Data.Bits
+
+nfIntPair :: (Int,Int) -> (Int,Int)
+nfIntPair x@(!_,!_) = x
+
+f :: (Int,Int) -> (Int,Int) -> (Int,Int)
+f (x,m) (y,n) = case (x + y) `quotRem` 10 of
+          (a,b) -> nfIntPair (a + b, m + n + 1 + a)
+
+gen :: Int -> U.Vector (Int,Int)
+gen a = U.iterateN 64 (\x -> f x x) (a,0)
+
+computed :: V.Vector (U.Vector (Int,Int))
+computed = V.fromList $ map gen [0..9]
+
+pow' :: Int -> Int -> (Int,Int)
+pow' a n = foldr1 f [ computed V.! a U.! i | i <- [0..60], testBit n i ]
+
+main = do
+  m <- readLn
+  xs <- U.replicateM m $ do
+    [d,c] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+    -- c should be Int64
+    return (pow' d c)
+  print $ snd $ U.foldr1 f xs

From 88732843a496093b59829cb8dd4190cc5a57ae16 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Sun, 24 Nov 2019 23:10:56 +0900
Subject: [PATCH 112/148] ABC146

---
 abc/README.md        | 13 +++++++++++++
 abc/abc146-a/Main.hs | 12 ++++++++++++
 abc/abc146-b/Main.hs |  9 +++++++++
 abc/abc146-c/Main.hs | 17 +++++++++++++++++
 abc/abc146-d/Main.hs | 34 ++++++++++++++++++++++++++++++++++
 5 files changed, 85 insertions(+)
 create mode 100644 abc/abc146-a/Main.hs
 create mode 100644 abc/abc146-b/Main.hs
 create mode 100644 abc/abc146-c/Main.hs
 create mode 100644 abc/abc146-d/Main.hs

diff --git a/abc/README.md b/abc/README.md
index da272e0..49286e2 100644
--- a/abc/README.md
+++ b/abc/README.md
@@ -358,3 +358,16 @@
 * [x] D - Water Bottle
 * [ ] E - Gluttony
 * [ ] F - Fork in the Road
+
+## AtCoder Beginner Contest 145
+
+## AtCoder Beginner Contest 146 (2019-11-24)
+
+<https://atcoder.jp/contests/abc146>
+
+* [x] A - Can't Wait for Holiday
+* [x] B - ROT N
+* [x] C - Buy an Integer
+* [x] D - Coloring Edges on Tree
+* [ ] E - Rem of Sum is Num
+* [ ] F - Sugoroku
diff --git a/abc/abc146-a/Main.hs b/abc/abc146-a/Main.hs
new file mode 100644
index 0000000..03348e9
--- /dev/null
+++ b/abc/abc146-a/Main.hs
@@ -0,0 +1,12 @@
+-- https://github.com/minoki/my-atcoder-solutions
+
+main = do
+  s <- getLine
+  print $ case s of
+    "SUN" -> 7
+    "MON" -> 6
+    "TUE" -> 5
+    "WED" -> 4
+    "THU" -> 3
+    "FRI" -> 2
+    "SAT" -> 1
diff --git a/abc/abc146-b/Main.hs b/abc/abc146-b/Main.hs
new file mode 100644
index 0000000..73eb62d
--- /dev/null
+++ b/abc/abc146-b/Main.hs
@@ -0,0 +1,9 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Char
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  n <- readLn
+  s <- BS.getLine
+  let f c = chr $ (ord c - ord 'A' + n) `rem` 26 + ord 'A'
+  BS.putStrLn $ BS.map f s
diff --git a/abc/abc146-c/Main.hs b/abc/abc146-c/Main.hs
new file mode 100644
index 0000000..dab8712
--- /dev/null
+++ b/abc/abc146-c/Main.hs
@@ -0,0 +1,17 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  [a,b,x] <- unfoldr (BS.readInteger . BS.dropWhile isSpace) <$> BS.getLine
+  -- a*n + b*d <= x
+  -- a*n <= x - b*d
+  print $ maximum $
+    [0]
+    ++ [ 10^9 | a*10^9+b*10 <= x ]
+    ++ [ min n (10^d-1) | d <- [1..9]
+                        , x - b*d >= 0
+                        , let n = (x - b*d) `quot` a
+                        , 10^(d-1) <= n
+                        ]
diff --git a/abc/abc146-d/Main.hs b/abc/abc146-d/Main.hs
new file mode 100644
index 0000000..1aef342
--- /dev/null
+++ b/abc/abc146-d/Main.hs
@@ -0,0 +1,34 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import Control.Monad
+import qualified Data.Vector as V
+import qualified Data.Vector.Mutable as VM
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  n <- readLn
+  edges <- U.replicateM (n-1) $ do
+    [a,b] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+    return (a-1,b-1)
+  let graph :: V.Vector [(Int,Int)]
+      graph = V.create $ do
+        g <- VM.replicate n []
+        flip U.imapM_ edges $ \i (a,b) -> do
+          VM.modify g ((b,i) :) a
+          VM.modify g ((a,i) :) b
+        return g
+  let result :: U.Vector Int
+      result = U.create $ do
+        r <- UM.new (n-1)
+        let go !i0 !i !c0 = do
+              forM_ (zip (filter ((/= i0) . fst) $ graph V.! i) (filter (/= c0) [1..])) $ \((j,k),c) -> do
+                UM.write r k c
+                go i j c
+        go (-1) 0 (-1)
+        return r
+  print (U.maximum result)
+  U.forM_ result print

From 43e56be7667dd7568277894cc70eb01949acd799 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Thu, 2 Jan 2020 21:26:32 +0900
Subject: [PATCH 113/148] ABC149-C

---
 abc/README.md        | 11 +++++++++++
 abc/abc149-c/Main.hs | 44 ++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 55 insertions(+)
 create mode 100644 abc/abc149-c/Main.hs

diff --git a/abc/README.md b/abc/README.md
index 49286e2..0a07c56 100644
--- a/abc/README.md
+++ b/abc/README.md
@@ -371,3 +371,14 @@
 * [x] D - Coloring Edges on Tree
 * [ ] E - Rem of Sum is Num
 * [ ] F - Sugoroku
+
+## AtCoder Beginner Contest 149
+
+<https://atcoder.jp/contests/abc149>
+
+* [ ] A - Strings
+* [ ] B - Greedy Takahashi
+* [x] C - Next Prime
+* [ ] D - Prediction and Restriction
+* [ ] E - Handshake
+* [ ] F - Surrounded Notes
diff --git a/abc/abc149-c/Main.hs b/abc/abc149-c/Main.hs
new file mode 100644
index 0000000..676002a
--- /dev/null
+++ b/abc/abc149-c/Main.hs
@@ -0,0 +1,44 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Int (Int64)
+import Data.List
+import Control.Monad
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+
+main = do
+  x <- readLn
+  print $ head $ dropWhile (< x) primes
+
+--
+-- Sieve of Eratosthenes
+--
+
+infixr 5 !:
+(!:) :: a -> [a] -> [a]
+(!x) !: xs = x : xs
+
+-- | エラトステネスの篩により、 max 以下の素数の一覧を構築して返す
+-- >>> sieve 100
+-- [2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97]
+sieve :: Int -> [Int64]
+sieve !max = 2 : U.ifoldr (\i isPrime xs -> if isPrime then fromIntegral (2 * i + 1) !: xs else xs) [] vec
+  where
+    vec = U.create $ do
+      vec <- UM.replicate ((max - 1) `quot` 2 + 1) True
+      UM.write vec 0 False -- 1 is not a prime
+      -- vec ! i : is (2 * i + 1) prime?
+      let clear !p = forM_ [3*p,5*p..max] $ \n -> UM.write vec (n `quot` 2) False
+          factorBound = floor (sqrt (fromIntegral max) :: Double)
+          loop !i | 2 * i + 1 > factorBound = return ()
+                  | otherwise = do b <- UM.read vec i
+                                   when b $ clear (2 * i + 1)
+                                   loop (i + 1)
+      loop 1
+      return vec
+
+-- |
+-- >>> takeWhile (< 100) primes
+-- [2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97]
+primes :: [Int64]
+primes = sieve 100003

From da2da3b10582f99cec91891f618267800c4bf90b Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Wed, 15 Apr 2020 00:22:25 +0900
Subject: [PATCH 114/148] ABC162

---
 abc/README.md          | 11 +++++++++
 abc/abc162-a/Main.hs   |  5 ++++
 abc/abc162-b/Main.hs   |  7 ++++++
 abc/abc162-c/Main.hs   | 10 ++++++++
 abc/abc162-d/Main.hs   | 23 ++++++++++++++++++
 abc/abc162-d/Small.hs  | 18 ++++++++++++++
 abc/abc162-e/Main.hs   | 54 ++++++++++++++++++++++++++++++++++++++++++
 abc/abc162-e/Naive.hs  | 15 ++++++++++++
 abc/abc162-e/Naive2.hs | 40 +++++++++++++++++++++++++++++++
 abc/abc162-f/Main.hs   | 23 ++++++++++++++++++
 10 files changed, 206 insertions(+)
 create mode 100644 abc/abc162-a/Main.hs
 create mode 100644 abc/abc162-b/Main.hs
 create mode 100644 abc/abc162-c/Main.hs
 create mode 100644 abc/abc162-d/Main.hs
 create mode 100644 abc/abc162-d/Small.hs
 create mode 100644 abc/abc162-e/Main.hs
 create mode 100644 abc/abc162-e/Naive.hs
 create mode 100644 abc/abc162-e/Naive2.hs
 create mode 100644 abc/abc162-f/Main.hs

diff --git a/abc/README.md b/abc/README.md
index 0a07c56..dacbc34 100644
--- a/abc/README.md
+++ b/abc/README.md
@@ -382,3 +382,14 @@
 * [ ] D - Prediction and Restriction
 * [ ] E - Handshake
 * [ ] F - Surrounded Notes
+
+## AtCoder Beginner Contest 162
+
+<https://atcoder.jp/contests/abc162>
+
+* [x] A - Lucky 7
+* [x] B - FizzBuzz Sum
+* [x] C - Sum of gcd of Tuples (Easy)
+* [x] D - RGB Triplets
+* [x] E - Sum of gcd of Tuples (Hard)
+* [x] F - Select Half
diff --git a/abc/abc162-a/Main.hs b/abc/abc162-a/Main.hs
new file mode 100644
index 0000000..5333066
--- /dev/null
+++ b/abc/abc162-a/Main.hs
@@ -0,0 +1,5 @@
+-- https://github.com/minoki/my-atcoder-solutions
+
+main = do
+  s <- getLine
+  putStrLn $ if '7' `elem` s then "Yes" else "No"
diff --git a/abc/abc162-b/Main.hs b/abc/abc162-b/Main.hs
new file mode 100644
index 0000000..d71736d
--- /dev/null
+++ b/abc/abc162-b/Main.hs
@@ -0,0 +1,7 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE TypeApplications #-}
+import Data.Int (Int64)
+
+main = do
+  n <- readLn @Int64
+  print $ sum [ x | x <- [1..n], x `rem` 3 /= 0, x `rem` 5 /= 0 ]
diff --git a/abc/abc162-c/Main.hs b/abc/abc162-c/Main.hs
new file mode 100644
index 0000000..5b2bd80
--- /dev/null
+++ b/abc/abc162-c/Main.hs
@@ -0,0 +1,10 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE TypeApplications #-}
+
+main = do
+  k <- readLn @Int
+  print $ sum [ if ab == 1 then k else sum [ gcd ab c | c <- [1..k] ]
+              | a <- [1..k]
+              , b <- [1..k]
+              , let ab = gcd a b
+              ]
diff --git a/abc/abc162-d/Main.hs b/abc/abc162-d/Main.hs
new file mode 100644
index 0000000..b8dde4e
--- /dev/null
+++ b/abc/abc162-d/Main.hs
@@ -0,0 +1,23 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE TypeApplications #-}
+import Data.Int (Int64)
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  n <- readLn @Int
+  s <- BS.getLine
+  let n_r, n_g, n_b :: Int64
+      n_r = fromIntegral (BS.count 'R' s)
+      n_g = fromIntegral (BS.count 'G' s)
+      n_b = fromIntegral (BS.count 'B' s)
+  print $
+    n_r * n_g * n_b
+    - sum [ 1 :: Int64
+          | d <- [1..n `div` 2]
+          , i <- [0..n - 1 - 2 * d]
+          , let j = i + d
+                k = j + d -- k <= n - 1
+          , s `BS.index` i /= s `BS.index` j
+          , s `BS.index` i /= s `BS.index` k
+          , s `BS.index` j /= s `BS.index` k
+          ]
diff --git a/abc/abc162-d/Small.hs b/abc/abc162-d/Small.hs
new file mode 100644
index 0000000..6372e47
--- /dev/null
+++ b/abc/abc162-d/Small.hs
@@ -0,0 +1,18 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE BangPatterns #-}
+import Data.Int (Int64)
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  n <- readLn @Int
+  s <- BS.getLine
+  print $ sum [ 1 :: Int64
+              | i <- [0..n-3]
+              , j <- [i+1..n-2]
+              , k <- [j+1..n-1]
+              , s `BS.index` i /= s `BS.index` j
+              , s `BS.index` i /= s `BS.index` k
+              , s `BS.index` j /= s `BS.index` k
+              , j - i /= k - j
+              ]
diff --git a/abc/abc162-e/Main.hs b/abc/abc162-e/Main.hs
new file mode 100644
index 0000000..b44542f
--- /dev/null
+++ b/abc/abc162-e/Main.hs
@@ -0,0 +1,54 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE TypeFamilies #-}
+import Data.Char (isSpace)
+import Data.Int (Int64)
+import Data.List (unfoldr)
+import Control.Monad
+import qualified Data.Vector.Unboxing as U
+import qualified Data.Vector.Unboxing.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  [n,k] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  let v :: U.Vector IntMod
+      v = U.create $ do
+        v <- UM.replicate (k+1) 0
+        forM_ [1..k] $ \i -> do
+          UM.write v i $! fromIntegral (k `quot` i) ^ n
+        return v
+      w :: U.Vector IntMod
+      w = U.create $ do
+        w <- U.thaw v
+        forM_ [k,k-1..1] $ \i -> do
+          s <- sum <$> sequence [ UM.read w j | j <- [2*i,3*i..k] ]
+          UM.modify w (subtract s) i
+        return w
+  print $ sum [ fromIntegral i * w U.! i | i <- [1..k] ]
+
+modulus :: Int64
+modulus = 10^9 + 7
+
+newtype IntMod = IntMod { getIntMod :: Int64 } deriving Eq
+
+instance Show IntMod where
+  show (IntMod x) = show x
+
+instance Num IntMod where
+  IntMod x + IntMod y = IntMod ((x + y) `rem` modulus)
+  IntMod x - IntMod y = IntMod ((x - y) `mod` modulus)
+  IntMod x * IntMod y = IntMod ((x * y) `rem` modulus)
+  negate (IntMod x) = IntMod (negate x `mod` modulus)
+  fromInteger x = IntMod (fromInteger (x `mod` fromIntegral modulus))
+  abs = undefined; signum = undefined
+
+{-# RULES
+"fromIntegral/Int64->IntMod" forall (x :: Int64).
+  fromIntegral x = IntMod (x `mod` modulus)
+"fromIntegral/Int->IntMod" forall (x :: Int).
+  fromIntegral x = IntMod (fromIntegral x `mod` modulus)
+  #-}
+
+instance U.Unboxable IntMod where
+  type Rep IntMod = Int64
diff --git a/abc/abc162-e/Naive.hs b/abc/abc162-e/Naive.hs
new file mode 100644
index 0000000..7f8276e
--- /dev/null
+++ b/abc/abc162-e/Naive.hs
@@ -0,0 +1,15 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.Int (Int64)
+import Data.List (unfoldr, foldl')
+import Control.Monad
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  [n,k] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  print $ sum @[] @Int $ do xs <- replicateM n [1..k]
+                            pure $ foldl' gcd 0 xs
diff --git a/abc/abc162-e/Naive2.hs b/abc/abc162-e/Naive2.hs
new file mode 100644
index 0000000..3638d66
--- /dev/null
+++ b/abc/abc162-e/Naive2.hs
@@ -0,0 +1,40 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE DerivingStrategies #-}
+import Data.Char (isSpace)
+import Data.Int (Int64)
+import Data.List (unfoldr, foldl')
+import Control.Monad
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  [n,k] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  print $ sum $ do xs <- replicateM n [1..k]
+                   pure $ fromIntegral $ foldl' gcd 0 xs
+
+modulus :: Int64
+modulus = 1_000_000_007
+
+newtype IntMod = IntMod { getIntMod :: Int64 }
+  deriving Eq
+  deriving newtype Show
+
+instance Num IntMod where
+  IntMod x + IntMod y = IntMod ((x + y) `rem` modulus)
+  IntMod x - IntMod y = IntMod ((x - y) `mod` modulus)
+  IntMod x * IntMod y = IntMod ((x * y) `rem` modulus)
+  negate (IntMod x) = IntMod (negate x `mod` modulus)
+  fromInteger x = IntMod (fromInteger (x `mod` fromIntegral modulus))
+  abs = undefined; signum = undefined
+
+{-# RULES
+"fromIntegral/Int64->IntMod" forall (x :: Int64).
+  fromIntegral x = IntMod (x `mod` modulus)
+"fromIntegral/Int->IntMod" forall (x :: Int).
+  fromIntegral x = IntMod (fromIntegral x `mod` modulus)
+  #-}
diff --git a/abc/abc162-f/Main.hs b/abc/abc162-f/Main.hs
new file mode 100644
index 0000000..a2933c7
--- /dev/null
+++ b/abc/abc162-f/Main.hs
@@ -0,0 +1,23 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.Int (Int64)
+import qualified Data.Vector.Unboxed as U
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  n <- readLn @Int
+  -- 2 <= n <= 2*10^5
+  xs <- U.map fromIntegral . U.unfoldrN n (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  let loop :: Int -> Int64 -> Int64 -> Int64 -> (Int64, Int64, Int64)
+      loop !k !a !b !c
+        | k > n `quot` 2 = (a, b, c)
+        | otherwise =
+          -- k <= n `quot` 2
+          let a' = a + xs U.! (2*k-2)
+              b' = max a' (b + xs U.! (2*k-1))
+              c' = if 2*k < n then max b' (c + xs U.! (2*k)) else b'
+          in loop (k+1) a' b' c'
+      (_,y,z) = loop 1 0 0 0
+  print $ if even n then y else z

From 2dba5399f21a35ae7e2bb00826a5475d1df92f74 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Thu, 16 Apr 2020 20:11:24 +0900
Subject: [PATCH 115/148] Judge System Update Test Contest 202004

---
 README.md                     |  9 ++++++++
 judge-update-202004-a/Main.hs |  8 +++++++
 judge-update-202004-b/Main.hs | 25 ++++++++++++++++++++++
 judge-update-202004-c/Main.hs | 21 ++++++++++++++++++
 judge-update-202004-d/Main.hs | 40 +++++++++++++++++++++++++++++++++++
 5 files changed, 103 insertions(+)
 create mode 100644 judge-update-202004-a/Main.hs
 create mode 100644 judge-update-202004-b/Main.hs
 create mode 100644 judge-update-202004-c/Main.hs
 create mode 100644 judge-update-202004-d/Main.hs

diff --git a/README.md b/README.md
index 483367e..1a99b61 100644
--- a/README.md
+++ b/README.md
@@ -341,3 +341,12 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 * [x] D - Digit Sum Replace
 * [ ] E - Majority of Balls
 * [ ] F - DISCOSMOS
+
+## Judge System Update Test Contest 202004
+
+<https://atcoder.jp/contests/judge-update-202004>
+
+* [x] A - Walking Takahashi
+* [x] B - Picking Balls
+* [x] C - Numbering Blocks
+* [x] D - Calculating GCD
diff --git a/judge-update-202004-a/Main.hs b/judge-update-202004-a/Main.hs
new file mode 100644
index 0000000..f2f3ea3
--- /dev/null
+++ b/judge-update-202004-a/Main.hs
@@ -0,0 +1,8 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  [s,l,r] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  print $ max l (min r s)
diff --git a/judge-update-202004-b/Main.hs b/judge-update-202004-b/Main.hs
new file mode 100644
index 0000000..551a542
--- /dev/null
+++ b/judge-update-202004-b/Main.hs
@@ -0,0 +1,25 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE BlockArguments #-}
+import qualified Data.Vector.Generic as G
+import qualified Data.Vector.Unboxed as U
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.Vector.Algorithms.Merge as A
+
+sortVector :: (G.Vector v a, Ord a) => v a -> v a
+sortVector v = G.create do
+  v' <- G.thaw v
+  A.sort v'
+  return v'
+{-# INLINE sortVector #-}
+
+main = do
+  n <- readLn @Int
+  balls <- U.replicateM n do
+    [s1,s2] <- BS.words <$> BS.getLine
+    let x = read @Int $ BS.unpack s1
+        [c] = BS.unpack s2
+    return (if c == 'R' then 0 else 1, x)
+  let sorted :: U.Vector (Int, Int)
+      sorted = sortVector balls
+  U.forM_ sorted \(_, x) -> print x
diff --git a/judge-update-202004-c/Main.hs b/judge-update-202004-c/Main.hs
new file mode 100644
index 0000000..184d9e4
--- /dev/null
+++ b/judge-update-202004-c/Main.hs
@@ -0,0 +1,21 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Char (isSpace)
+import Data.List
+import Control.Monad
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  [a1,a2,a3] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  -- a1 >= a2 >= a3
+  let n = a1 + a2 + a3
+  print $ length $ do
+    -- 1 <= x <= n
+    xs <- permutations [1..n]
+    let (x1,xs') = splitAt a1 xs
+        (x2,x3) = splitAt a2 xs'
+    guard $ and $ zipWith (>) (tail x1) x1
+    guard $ and $ zipWith (>) (tail x2) x2
+    guard $ and $ zipWith (>) (tail x3) x3
+    guard $ and $ zipWith (>) x2 x1
+    guard $ and $ zipWith (>) x3 x2
+    return ()
diff --git a/judge-update-202004-d/Main.hs b/judge-update-202004-d/Main.hs
new file mode 100644
index 0000000..0602f4e
--- /dev/null
+++ b/judge-update-202004-d/Main.hs
@@ -0,0 +1,40 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE BlockArguments #-}
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import qualified Data.Vector.Unboxed as U
+import qualified Data.ByteString.Char8 as BS
+
+solve :: U.Vector Int -> Int -> Either {- value -} Int {- index -} Int
+solve v !x = let y = gcd x (U.last v)
+             in if y == 1 then
+                  Right $ search 0 (U.length v - 1)
+                else
+                  Left y
+  where
+    n = U.length v
+    search i j
+      -- i < j, gcd x (v U.! i) /= 1, gcd x (v U.! j) == 1
+      | i >= j = error "invalid input"
+      | j - i == 1 = j
+      | otherwise = let k = i + (j - i) `quot` 2
+                        y = gcd x (v U.! k)
+                    in if y == 1 then
+                         search i k
+                       else
+                         search k j
+
+naive :: U.Vector Int -> Int -> Either {- value -} Int {- index -} Int
+naive v x = case U.findIndex (\y -> gcd x y == 1) v of
+              Nothing -> Left $ gcd x (U.last v)
+              Just i -> Right i
+
+main = do
+  [n,q] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  as <- U.unfoldrN n (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  ss <- U.unfoldrN q (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  let gs = U.scanl gcd 0 as
+  U.forM_ ss \s -> case solve gs s of
+                     Left x -> print x
+                     Right y -> print y

From a9b2cfbdb7dcee1a91d2b63ab5bca7abfeeb6a32 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Thu, 16 Apr 2020 20:14:37 +0900
Subject: [PATCH 116/148] Template: Enable TypeApplications by default

---
 gen.lua | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/gen.lua b/gen.lua
index a6677c4..1a1f158 100755
--- a/gen.lua
+++ b/gen.lua
@@ -19,7 +19,7 @@ end
 fh = assert(io.open(filename, "w"))
 fh:write([[
 -- https://github.com/minoki/my-atcoder-solutions
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE BangPatterns #-}
 import Data.Char (isSpace)
 import Data.Int (Int64)
@@ -30,7 +30,7 @@ import qualified Data.Vector.Unboxed.Mutable as UM
 import qualified Data.ByteString.Char8 as BS
 
 main = do
-  _ :: [Int] <- map (read . BS.unpack) . BS.words <$> BS.getLine
+  _ <- map (read @Int . BS.unpack) . BS.words <$> BS.getLine
   [n,m] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
   edges <- U.replicateM m $ do
     [x,y,z] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine

From 1aa2ecce316dc598123b88c5f37bdfd2c83a6028 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Mon, 15 Jun 2020 00:50:14 +0900
Subject: [PATCH 117/148] ABC170-A, B, C, D

---
 abc/README.md        | 11 +++++++++++
 abc/abc170-a/Main.hs |  8 ++++++++
 abc/abc170-b/Main.hs |  8 ++++++++
 abc/abc170-c/Main.hs | 10 ++++++++++
 abc/abc170-d/Main.hs | 23 +++++++++++++++++++++++
 5 files changed, 60 insertions(+)
 create mode 100644 abc/abc170-a/Main.hs
 create mode 100644 abc/abc170-b/Main.hs
 create mode 100644 abc/abc170-c/Main.hs
 create mode 100644 abc/abc170-d/Main.hs

diff --git a/abc/README.md b/abc/README.md
index dacbc34..32ab7a5 100644
--- a/abc/README.md
+++ b/abc/README.md
@@ -393,3 +393,14 @@
 * [x] D - RGB Triplets
 * [x] E - Sum of gcd of Tuples (Hard)
 * [x] F - Select Half
+
+## AtCoder Beginner Contest 170
+
+<https://atcoder.jp/contests/abc170>
+
+* [x] A - Five Variables
+* [x] B - Crane and Turtle
+* [x] C - Forbidden List
+* [x] D - Not Divisible
+* [ ] E - Smart Infants
+* [ ] F - Pond Skater
diff --git a/abc/abc170-a/Main.hs b/abc/abc170-a/Main.hs
new file mode 100644
index 0000000..bc758ce
--- /dev/null
+++ b/abc/abc170-a/Main.hs
@@ -0,0 +1,8 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  xs <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  print $ 1 + length (takeWhile (/= 0) xs)
diff --git a/abc/abc170-b/Main.hs b/abc/abc170-b/Main.hs
new file mode 100644
index 0000000..c27e315
--- /dev/null
+++ b/abc/abc170-b/Main.hs
@@ -0,0 +1,8 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  [x,y] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  putStrLn $ if or [ 2 * 鶴 + 4 * 亀 == y | 鶴 <- [0..x], let 亀 = x - 鶴 ] then "Yes" else "No"
diff --git a/abc/abc170-c/Main.hs b/abc/abc170-c/Main.hs
new file mode 100644
index 0000000..a3bfcf5
--- /dev/null
+++ b/abc/abc170-c/Main.hs
@@ -0,0 +1,10 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Char (isSpace)
+import Data.List (sort, unfoldr)
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  [x,n] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  ps <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  let (_, answer):_ = sort [ (abs (x - i), i) | i <- [0..101], i `notElem` ps ]
+  print answer
diff --git a/abc/abc170-d/Main.hs b/abc/abc170-d/Main.hs
new file mode 100644
index 0000000..97d59a8
--- /dev/null
+++ b/abc/abc170-d/Main.hs
@@ -0,0 +1,23 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE TypeApplications #-}
+-- {-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import Control.Monad
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  n <- readLn @Int
+  xs <- U.unfoldrN n (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  let m = U.maximum xs
+  let vec :: U.Vector Int
+      vec = U.create $ do
+        vec <- UM.replicate (m+1) 0
+        U.forM_ xs $ \x -> do
+          UM.modify vec (+ 1) x
+          forM_ [2*x,3*x..m] $ \i -> do
+            UM.modify vec (+ 2) i
+        return vec
+  print $ length [ () | x <- U.toList xs, vec U.! x <= 1 ]

From a7faea69f9e7efb1546b857187896b5653ad48ae Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Mon, 15 Jun 2020 00:54:15 +0900
Subject: [PATCH 118/148] ABC169-A, B, C

---
 abc/README.md         | 12 ++++++++++++
 abc/abc169-a/Main.hs  |  8 ++++++++
 abc/abc169-b/Main.hs  | 14 ++++++++++++++
 abc/abc169-c/Dec.hs   |  8 ++++++++
 abc/abc169-c/Fixed.hs | 15 +++++++++++++++
 abc/abc169-c/Main.hs  | 11 +++++++++++
 abc/abc169-c/Rat.hs   |  8 ++++++++
 7 files changed, 76 insertions(+)
 create mode 100644 abc/abc169-a/Main.hs
 create mode 100644 abc/abc169-b/Main.hs
 create mode 100644 abc/abc169-c/Dec.hs
 create mode 100644 abc/abc169-c/Fixed.hs
 create mode 100644 abc/abc169-c/Main.hs
 create mode 100644 abc/abc169-c/Rat.hs

diff --git a/abc/README.md b/abc/README.md
index 32ab7a5..4d19731 100644
--- a/abc/README.md
+++ b/abc/README.md
@@ -394,6 +394,18 @@
 * [x] E - Sum of gcd of Tuples (Hard)
 * [x] F - Select Half
 
+## AtCoder Beginner Contest 169
+
+<https://atcoder.jp/contests/abc169>
+
+* [x] A - Multiplication 1
+* [x] B - Multiplication 2
+* [x] C - Multiplication 3
+    * 解説記事：[浮動小数点数オタクが AtCoder Beginner Contest 169 のC問題をガチで解説してみる](https://qiita.com/mod_poppo/items/910b5fb9303baf864bf7)
+* [ ] D - Div Game
+* [ ] E - Count Median
+* [ ] F - Knapsack for All Subsets
+
 ## AtCoder Beginner Contest 170
 
 <https://atcoder.jp/contests/abc170>
diff --git a/abc/abc169-a/Main.hs b/abc/abc169-a/Main.hs
new file mode 100644
index 0000000..b0eb06d
--- /dev/null
+++ b/abc/abc169-a/Main.hs
@@ -0,0 +1,8 @@
+-- https://github.com/minoki/my-atcoder-solutions
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  [a,b] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  print $ a * b
diff --git a/abc/abc169-b/Main.hs b/abc/abc169-b/Main.hs
new file mode 100644
index 0000000..c130cac
--- /dev/null
+++ b/abc/abc169-b/Main.hs
@@ -0,0 +1,14 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE TypeApplications #-}
+import Data.Char (isSpace)
+import Data.Int (Int64)
+import Data.List (unfoldr)
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  n <- readLn @Int
+  xs <- unfoldr (BS.readInteger . BS.dropWhile isSpace) <$> BS.getLine
+  let p = product xs
+  let result | p > 10^18 = -1
+             | otherwise = p
+  print result
diff --git a/abc/abc169-c/Dec.hs b/abc/abc169-c/Dec.hs
new file mode 100644
index 0000000..dae7cdf
--- /dev/null
+++ b/abc/abc169-c/Dec.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE TypeApplications #-}
+import Data.Fixed
+
+main = do
+  [s,t] <- words <$> getLine
+  let a = read @Integer s
+      b = read @Centi t
+  print (truncate $ fromInteger a * b :: Integer)
diff --git a/abc/abc169-c/Fixed.hs b/abc/abc169-c/Fixed.hs
new file mode 100644
index 0000000..a2388b5
--- /dev/null
+++ b/abc/abc169-c/Fixed.hs
@@ -0,0 +1,15 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE TypeApplications #-}
+import Data.Int (Int64)
+import qualified Data.ByteString.Char8 as BS
+import Data.Fixed
+
+type N = Fixed E2
+-- type N = Double
+
+main = do
+  [a,b] <- BS.words <$> BS.getLine
+  let Just (a',_) = BS.readInteger a
+      a'' = fromIntegral a' :: Int64
+      b' = read @N (BS.unpack b)
+  print $ a'' * truncate (b' * 100) `quot` 100
diff --git a/abc/abc169-c/Main.hs b/abc/abc169-c/Main.hs
new file mode 100644
index 0000000..bc8f5dc
--- /dev/null
+++ b/abc/abc169-c/Main.hs
@@ -0,0 +1,11 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE TypeApplications #-}
+import Data.Int (Int64)
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  [a,b] <- BS.words <$> BS.getLine
+  let Just (a',_) = BS.readInteger a
+      a'' = fromIntegral a' :: Int64
+      b' = read @Double (BS.unpack b)
+  print $ a'' * round (b' * 100) `quot` 100
diff --git a/abc/abc169-c/Rat.hs b/abc/abc169-c/Rat.hs
new file mode 100644
index 0000000..5b63ab1
--- /dev/null
+++ b/abc/abc169-c/Rat.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE TypeApplications #-}
+import Numeric (readFloat)
+
+main = do
+  [s,t] <- words <$> getLine
+  let a = read @Integer s
+      [(b,"")] = readFloat @Rational t
+  print (truncate $ fromInteger a * b :: Integer)

From 0af3e04cc741a52c4344c18d211dd04a897e0e49 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Mon, 15 Jun 2020 01:12:15 +0900
Subject: [PATCH 119/148] =?UTF-8?q?ABC170-D=E3=81=8C=E5=98=98=E8=A7=A3?=
 =?UTF-8?q?=E6=B3=95=E3=81=A3=E3=81=BD=E3=81=8B=E3=81=A3=E3=81=9F=E3=81=AE?=
 =?UTF-8?q?=E3=81=A7=E7=9B=B4=E3=81=97=E3=81=9F?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 abc/abc170-d/Main.hs       |  9 +++++----
 abc/abc170-d/genkiller.lua |  8 ++++++++
 abc/abc170-d/usokaihou.hs  | 23 +++++++++++++++++++++++
 3 files changed, 36 insertions(+), 4 deletions(-)
 create mode 100644 abc/abc170-d/genkiller.lua
 create mode 100644 abc/abc170-d/usokaihou.hs

diff --git a/abc/abc170-d/Main.hs b/abc/abc170-d/Main.hs
index 97d59a8..d1eaae4 100644
--- a/abc/abc170-d/Main.hs
+++ b/abc/abc170-d/Main.hs
@@ -1,6 +1,5 @@
 -- https://github.com/minoki/my-atcoder-solutions
 {-# LANGUAGE TypeApplications #-}
--- {-# LANGUAGE BangPatterns #-}
 import Data.Char (isSpace)
 import Data.List (unfoldr)
 import Control.Monad
@@ -16,8 +15,10 @@ main = do
       vec = U.create $ do
         vec <- UM.replicate (m+1) 0
         U.forM_ xs $ \x -> do
-          UM.modify vec (+ 1) x
-          forM_ [2*x,3*x..m] $ \i -> do
-            UM.modify vec (+ 2) i
+          t <- UM.read vec x
+          when (t <= 1) $ do
+            UM.modify vec (+ 1) x
+            forM_ [2*x,3*x..m] $ \i -> do
+              UM.modify vec (+ 2) i
         return vec
   print $ length [ () | x <- U.toList xs, vec U.! x <= 1 ]
diff --git a/abc/abc170-d/genkiller.lua b/abc/abc170-d/genkiller.lua
new file mode 100644
index 0000000..1fb8f59
--- /dev/null
+++ b/abc/abc170-d/genkiller.lua
@@ -0,0 +1,8 @@
+local n = 2 * 10^5
+local t = {}
+table.insert(t, string.format("%d", 10^6))
+for i = 2, n do
+  t[i] = "1"
+end
+io.write(string.format("%d\n", n))
+io.write(table.concat(t, " "), "\n")
diff --git a/abc/abc170-d/usokaihou.hs b/abc/abc170-d/usokaihou.hs
new file mode 100644
index 0000000..2a1fd7b
--- /dev/null
+++ b/abc/abc170-d/usokaihou.hs
@@ -0,0 +1,23 @@
+-- https://github.com/minoki/my-atcoder-solutions
+-- 嘘解法につき注意
+{-# LANGUAGE TypeApplications #-}
+import Data.Char (isSpace)
+import Data.List (unfoldr)
+import Control.Monad
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+
+main = do
+  n <- readLn @Int
+  xs <- U.unfoldrN n (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  let m = U.maximum xs
+  let vec :: U.Vector Int
+      vec = U.create $ do
+        vec <- UM.replicate (m+1) 0
+        U.forM_ xs $ \x -> do
+          UM.modify vec (+ 1) x
+          forM_ [2*x,3*x..m] $ \i -> do
+            UM.modify vec (+ 2) i
+        return vec
+  print $ length [ () | x <- U.toList xs, vec U.! x <= 1 ]

From ad088f95dae53a06d418e715c86dceb920b88d1b Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Mon, 17 Aug 2020 14:11:22 +0900
Subject: [PATCH 120/148] ABC175-D

---
 abc/abc175-d/Main.hs          | 76 +++++++++++++++++++++++++++++++++++
 abc/abc175-d/genrandinput.lua | 20 +++++++++
 2 files changed, 96 insertions(+)
 create mode 100644 abc/abc175-d/Main.hs
 create mode 100644 abc/abc175-d/genrandinput.lua

diff --git a/abc/abc175-d/Main.hs b/abc/abc175-d/Main.hs
new file mode 100644
index 0000000..f963f01
--- /dev/null
+++ b/abc/abc175-d/Main.hs
@@ -0,0 +1,76 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import Data.Char (isSpace)
+import Data.Int (Int64)
+import Data.List (unfoldr)
+import qualified Data.Vector.Unboxed as U
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.IntSet as IntSet
+import Control.Exception (assert)
+import qualified Test.QuickCheck as QC
+import GHC.Stack (HasCallStack)
+
+(!) :: (HasCallStack, U.Unbox a) => U.Vector a -> Int -> a
+(!) = (U.!)
+{-
+(!) vec i | i < 0 = error $ "negative index: " ++ show i
+          | i >= U.length vec = error $ "out of bounds " ++ show (i,U.length vec)
+          | otherwise = vec U.! i
+-}
+
+cycles :: Int -> U.Vector Int -> [[Int]]
+cycles !n perm = loop (IntSet.fromDistinctAscList [0..n-1])
+  where
+    loop s | IntSet.null s = []
+           | otherwise = let (m,s') = IntSet.deleteFindMin s
+                             (cyc,s'') = oneCycle m m [m] s'
+                         in cyc : loop s''
+    oneCycle m0 m xs s = let m' = perm ! m
+                         in if m' == m0 then
+                              (xs, s)
+                            else
+                              oneCycle m0 m' (m':xs) (IntSet.delete m' s)
+
+solve :: Int -> Int -> U.Vector Int -> U.Vector Int64 -> Int64
+solve !n !k perm c = maximum $ map solveOneCycle $ cycles n perm
+  where
+    solveOneCycle cyc =
+      let scores = U.fromList $ map (c !) cyc
+          cycle_len = U.length scores
+          t = U.sum scores
+          scores' = U.init $ scores <> scores
+          ss = U.scanl' (+) 0 scores'
+          !_ = assert (U.length ss == 2 * cycle_len)
+      in if t <= 0 || k <= cycle_len then
+           maximum [ ss ! j - ss ! i
+                   | i <- [0 .. cycle_len - 1]
+                   , j <- [i + 1 .. min (2 * cycle_len - 1) (i + k)]
+                   ]
+         else
+           let (q,r) = k `quotRem` cycle_len
+               -- q >= 1
+           in t * fromIntegral q + if r == 0 then
+                                     max 0 $ maximum [ ss ! j - ss ! i
+                                                     | i <- [0 .. cycle_len - 1]
+                                                     , j <- [i + 1 .. min (2 * cycle_len - 1) (i + cycle_len)]
+                                                     ] - t
+                                   else
+                                     maximum [ ss ! j - ss ! i
+                                             | i <- [0 .. cycle_len - 1]
+                                             , j <- [i + 1 .. min (2 * cycle_len - 1) (i + r)]
+                                             ]
+
+main = do
+  [n,k] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  perm <- U.map (subtract 1) <$> U.unfoldrN n (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  c <- U.map fromIntegral <$> U.unfoldrN n (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  print $ solve n k perm c
+
+prop :: QC.Property
+prop = let gen = do n <- QC.choose (2, 100)
+                    -- n <- QC.choose (2, 5000)
+                    k <- QC.choose (1, 10^9)
+                    perm <- QC.shuffle [0..n-1]
+                    c <- QC.vectorOf n (QC.choose (-10^9, 10^9))
+                    return (n, k, U.fromList perm, U.fromList c)
+       in QC.forAll gen (\(n,k,perm,c) -> solve n k perm c `seq` ())
diff --git a/abc/abc175-d/genrandinput.lua b/abc/abc175-d/genrandinput.lua
new file mode 100644
index 0000000..30d819b
--- /dev/null
+++ b/abc/abc175-d/genrandinput.lua
@@ -0,0 +1,20 @@
+local n = tonumber(arg[1]) or 1000
+local k = tonumber(arg[2]) or 2324532
+
+math.randomseed(os.time())
+
+local P,C = {},{}
+for i = 1,n do
+  P[i] = i
+  C[i] = math.random(-10^9, 10^9)
+end
+
+for i = 1,n-1 do
+  local j = math.random(i+1,n)
+  -- P[i],P[j] = P[j],P[i]
+  P[i],P[i+1] = P[i+1],P[i]
+end
+
+io.write(string.format("%d %d\n", n, k))
+io.write(table.concat(P," "),"\n")
+io.write(table.concat(C," "),"\n")

From c340b3efa05901d26b9e355f559e79a31ceeeed5 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Tue, 1 Sep 2020 15:35:31 +0900
Subject: [PATCH 121/148] ABC177-E

---
 abc/README.md        | 11 +++++++
 abc/abc177-e/Main.hs | 69 ++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 80 insertions(+)
 create mode 100644 abc/abc177-e/Main.hs

diff --git a/abc/README.md b/abc/README.md
index 4d19731..8d35f14 100644
--- a/abc/README.md
+++ b/abc/README.md
@@ -416,3 +416,14 @@
 * [x] D - Not Divisible
 * [ ] E - Smart Infants
 * [ ] F - Pond Skater
+
+## AtCoder Beginner Contest 177
+
+<https://atcoder.jp/contests/abc177>
+
+* [ ] A - Don't be late
+* [ ] B - Substring
+* [ ] C - Sum of product of pairs
+* [ ] D - Friends
+* [x] E - Coprime
+* [ ] F - I hate Shortest Path Problem
diff --git a/abc/abc177-e/Main.hs b/abc/abc177-e/Main.hs
new file mode 100644
index 0000000..56cea1c
--- /dev/null
+++ b/abc/abc177-e/Main.hs
@@ -0,0 +1,69 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE NumericUnderscores #-}
+import Data.Char (isSpace)
+import Data.List
+import Control.Monad
+import Control.Monad.Trans.Maybe
+import Control.Monad.ST
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.ByteString.Char8 as BS
+import qualified Test.QuickCheck as QC
+import Data.Coerce
+
+isPairwiseCoprime_naive :: Int -> U.Vector Int -> Bool
+isPairwiseCoprime_naive _mbound xs = and [ gcd x y == 1 | x:ys <- tails (U.toList xs), y <- ys ]
+
+toHistogram :: Int -> U.Vector Int -> U.Vector Int
+toHistogram mbound xs = U.create $ do
+  m <- UM.replicate (mbound + 1) (0 :: Int)
+  U.forM_ xs $ \x -> do
+    UM.modify m (+ 1) x
+  return m
+
+isPairwiseCoprime :: Int -> U.Vector Int -> Bool
+isPairwiseCoprime !mbound !xs = maybe False (const True) $ runST $ runMaybeT $ do
+  let !m = toHistogram mbound xs
+  sieve <- UM.replicate (mbound + 1) True
+  UM.write sieve 0 False
+  UM.write sieve 1 False
+  forM_ [2..mbound] $ \i -> do
+    t <- UM.read sieve i
+    when t $ do
+      let loop !j !u | j > mbound = if u >= 2 then
+                                      mzero
+                                    else
+                                      return ()
+                     | otherwise = do
+                         UM.write sieve j False
+                         let !v = u + m U.! j
+                         if v >= 2 then
+                           mzero -- break
+                         else
+                           loop (j + i) v
+      loop (2 * i) (m U.! i)
+  return () -- The answer is "Yes" -- pairwise coprime
+
+isSetwiseCoprime :: U.Vector Int -> Bool
+isSetwiseCoprime xs = U.foldl' gcd 0 xs == 1 -- not best
+
+main = do
+  n <- readLn @Int
+  xs <- U.unfoldrN n (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  let mbound = U.maximum xs
+  if isPairwiseCoprime mbound xs then
+    putStrLn "pairwise coprime"
+  else if isSetwiseCoprime xs then
+    putStrLn "setwise coprime"
+  else
+    putStrLn "not coprime"
+
+prop :: QC.NonEmptyList (QC.Positive Int) -> QC.Property
+prop xs' = let xs = U.fromList (coerce xs') :: U.Vector Int
+               mbound = U.maximum xs
+           in isPairwiseCoprime mbound xs QC.=== isPairwiseCoprime_naive mbound xs
+
+runTest :: IO ()
+runTest = QC.quickCheck $ QC.withMaxSuccess 1000 $ QC.mapSize (* 1000) prop

From bd4e7e156c2e9f201199e3b502107c69ddf86105 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Tue, 1 Sep 2020 16:09:25 +0900
Subject: [PATCH 122/148] ABC177-E: Tweak

---
 abc/abc177-e/Main.hs | 48 ++++++++++++++++++++++++++------------------
 1 file changed, 29 insertions(+), 19 deletions(-)

diff --git a/abc/abc177-e/Main.hs b/abc/abc177-e/Main.hs
index 56cea1c..1b819db 100644
--- a/abc/abc177-e/Main.hs
+++ b/abc/abc177-e/Main.hs
@@ -32,22 +32,24 @@ isPairwiseCoprime !mbound !xs = maybe False (const True) $ runST $ runMaybeT $ d
   forM_ [2..mbound] $ \i -> do
     t <- UM.read sieve i
     when t $ do
-      let loop !j !u | j > mbound = if u >= 2 then
-                                      mzero
-                                    else
-                                      return ()
-                     | otherwise = do
-                         UM.write sieve j False
-                         let !v = u + m U.! j
-                         if v >= 2 then
-                           mzero -- break
-                         else
-                           loop (j + i) v
+      let loop !j !u
+            | u >= 2 = mzero -- break
+            | j > mbound = return ()
+            | otherwise = do
+                UM.write sieve j False
+                loop (j + i) (u + m U.! j)
       loop (2 * i) (m U.! i)
-  return () -- The answer is "Yes" -- pairwise coprime
+  return () -- The answer is "Yes" (pairwise coprime)
+
+isSetwiseCoprime_naive :: U.Vector Int -> Bool
+isSetwiseCoprime_naive xs = U.foldl' gcd 0 xs == 1
 
 isSetwiseCoprime :: U.Vector Int -> Bool
-isSetwiseCoprime xs = U.foldl' gcd 0 xs == 1 -- not best
+isSetwiseCoprime !xs = loop 0 0 == 1
+  where
+    loop !acc !i | i >= U.length xs = acc
+                 | acc == 1 = acc
+                 | otherwise = loop (gcd acc (xs U.! i)) (i + 1)
 
 main = do
   n <- readLn @Int
@@ -60,10 +62,18 @@ main = do
   else
     putStrLn "not coprime"
 
-prop :: QC.NonEmptyList (QC.Positive Int) -> QC.Property
-prop xs' = let xs = U.fromList (coerce xs') :: U.Vector Int
-               mbound = U.maximum xs
-           in isPairwiseCoprime mbound xs QC.=== isPairwiseCoprime_naive mbound xs
+prop_isPairwiseCoprime :: QC.NonEmptyList (QC.Positive Int) -> QC.Property
+prop_isPairwiseCoprime xs' =
+  let xs = U.fromList (coerce xs') :: U.Vector Int
+      mbound = U.maximum xs
+  in isPairwiseCoprime mbound xs QC.=== isPairwiseCoprime_naive mbound xs
+
+prop_isSetwiseCoprime :: QC.NonEmptyList (QC.Positive Int) -> QC.Property
+prop_isSetwiseCoprime xs' =
+  let xs = U.fromList (coerce xs') :: U.Vector Int
+  in isSetwiseCoprime xs QC.=== isSetwiseCoprime_naive xs
 
-runTest :: IO ()
-runTest = QC.quickCheck $ QC.withMaxSuccess 1000 $ QC.mapSize (* 1000) prop
+runTests :: IO ()
+runTests = do
+  QC.quickCheck $ QC.withMaxSuccess 500 $ QC.mapSize (* 1000) prop_isPairwiseCoprime
+  QC.quickCheck $ QC.withMaxSuccess 500 $ QC.mapSize (* 1000) prop_isSetwiseCoprime

From cb87242ac6e011204461321a30e957201b6b186d Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Tue, 8 Sep 2020 11:39:10 +0900
Subject: [PATCH 123/148] AtCoder Library Practice Contest - A, B

---
 README.md           | 19 ++++++++++++
 practice2-a/Main.hs | 65 +++++++++++++++++++++++++++++++++++++++
 practice2-b/Main.hs | 74 +++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 158 insertions(+)
 create mode 100644 practice2-a/Main.hs
 create mode 100644 practice2-b/Main.hs

diff --git a/README.md b/README.md
index 1a99b61..a59aec4 100644
--- a/README.md
+++ b/README.md
@@ -350,3 +350,22 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 * [x] B - Picking Balls
 * [x] C - Numbering Blocks
 * [x] D - Calculating GCD
+
+## AtCoder Library Practice Contest
+
+<https://atcoder.jp/contests/practice2>
+
+* [x] A - Disjoint Set Union
+    * Union Find
+* [x] B - Fenwick Tree
+    * Fenwick Tree, or Binary Indexed Tree
+* [ ] C - Floor Sum
+* [ ] D - Maxflow
+* [ ] E - MinCostFlow
+* [ ] F - Convolution
+* [ ] G - SCC
+* [ ] H - Two SAT
+* [ ] I - Number of Substrings
+* [ ] J - Segment Tree
+* [ ] K - Range Affine Range Sum
+* [ ] L - Lazy Segment Tree
diff --git a/practice2-a/Main.hs b/practice2-a/Main.hs
new file mode 100644
index 0000000..3241924
--- /dev/null
+++ b/practice2-a/Main.hs
@@ -0,0 +1,65 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns #-}
+import           Control.Monad
+import           Control.Monad.Primitive     (PrimMonad, PrimState)
+import qualified Data.ByteString.Builder     as BSB
+import qualified Data.ByteString.Char8       as BS
+import           Data.Char                   (isSpace)
+import           Data.Foldable               (foldlM)
+import           Data.List                   (unfoldr)
+import qualified Data.Vector.Unboxed         as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+import           System.IO                   (stdout)
+
+-- Union Find
+newUnionFindTree :: PrimMonad m => Int -> m (UM.MVector (PrimState m) Int)
+newUnionFindTree n = U.thaw $ U.enumFromN 0 n
+
+getRoot :: PrimMonad m => UM.MVector (PrimState m) Int -> Int -> m Int
+getRoot !v = go
+  where
+    go !i = do
+      j <- UM.read v i
+      if i == j then
+        return i
+      else do
+        k <- go j
+        UM.write v i k
+        return k
+{-# INLINE getRoot #-}
+
+unify :: PrimMonad m => UM.MVector (PrimState m) Int -> Int -> Int -> m ()
+unify !v !i !j = do
+  i' <- getRoot v i
+  j' <- getRoot v j
+  unless (i' == j') $ do
+    let !k = min i' j'
+    UM.write v i' k
+    UM.write v j' k
+{-# INLINE unify #-}
+
+main = do
+  [n,q] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  uf <- newUnionFindTree n
+  {-
+  queries <- U.replicateM q $ do
+    [t,u,v] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+    return (t,u,v)
+  bb <- U.foldM (\bb (t,u,v) ->
+                   if t == 0 then
+                     unify uf u v >> return bb
+                   else do
+                     i <- getRoot uf u
+                     j <- getRoot uf v
+                     return $! bb <> if i == j then BSB.string8 "1\n" else BSB.string8 "0\n"
+                ) mempty queries
+  BSB.hPutBuilder stdout bb
+  -}
+  replicateM_ q $ do
+    [t,u,v] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+    if t == 0 then
+      unify uf u v
+    else do
+      i <- getRoot uf u
+      j <- getRoot uf v
+      putStrLn $ if i == j then "1" else "0"
diff --git a/practice2-b/Main.hs b/practice2-b/Main.hs
new file mode 100644
index 0000000..ad200ef
--- /dev/null
+++ b/practice2-b/Main.hs
@@ -0,0 +1,74 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns    #-}
+{-# LANGUAGE ConstraintKinds #-}
+import           Control.Monad
+import           Control.Monad.Primitive      (PrimMonad, PrimState)
+import           Data.Bits
+import qualified Data.ByteString.Char8        as BS
+import           Data.Char                    (isSpace)
+import           Data.Int                     (Int64)
+import           Data.List                    (unfoldr)
+import           Data.Monoid
+import qualified Data.Vector.Generic          as G
+import qualified Data.Vector.Generic.Mutable  as GM
+import qualified Data.Vector.Unboxing         as U
+import qualified Data.Vector.Unboxing.Mutable as UM
+
+main = do
+  [n,q] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  xs0 <- U.unfoldrN n (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  tree <- fromVector_BIT (U.coerceVector xs0 :: U.Vector (Sum Int))
+  replicateM_ q $ do
+    [t,u,v] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+    if t == 0 then
+      let (p,x) = (u,v) in
+      add_BIT tree p (Sum x)
+    else do
+      let (l,r) = (u,v)
+      Sum a <- queryM_BIT tree l
+      Sum b <- queryM_BIT tree r
+      print $ b - a
+
+--
+-- Binary Indexed Tree (BIT), or Fenwick Tree
+--
+
+type CommutativeMonoid a = Monoid a
+
+newtype BIT mvec s a = BIT (mvec s a)
+
+-- index: 1-based
+-- property: forall vec i. fromVector_BIT vec >>= flip queryM_BIT i == pure (G.scanl (<>) mempty vec G.! i)
+queryM_BIT :: (Monoid a, GM.MVector mvec a, PrimMonad m) => BIT mvec (PrimState m) a -> Int -> m a
+queryM_BIT (BIT vec) !i = doQuery i mempty
+  where
+    doQuery 0 !acc = return acc
+    doQuery i !acc = do y <- GM.read vec (i - 1)
+                        let !j = (i - 1) .&. i
+                        doQuery j (y <> acc)
+{-# INLINE queryM_BIT #-}
+
+-- index: zero-based
+-- property: forall vec i x. do { tree <- fromVector_BIT vec; add_BIT tree i x; return tree } == fromVector_BIT (G.accum (<>) vec [(i,x)])
+add_BIT :: (CommutativeMonoid a, GM.MVector mvec a, PrimMonad m) => BIT mvec (PrimState m) a -> Int -> a -> m ()
+add_BIT (BIT vec) !i !y = loop (i + 1)
+  where
+    loop !k | k > GM.length vec = return ()
+    loop !k = do x <- GM.read vec (k - 1)
+                 GM.write vec (k - 1) $! x <> y
+                 loop (k + (k .&. (-k)))
+{-# INLINE add_BIT #-}
+
+new_BIT :: (Monoid a, GM.MVector mvec a, PrimMonad m) => Int -> m (BIT mvec (PrimState m) a)
+new_BIT n = BIT <$> GM.replicate n mempty
+
+asUnboxedBIT :: (PrimMonad m) => m (BIT UM.MVector (PrimState m) a) -> m (BIT UM.MVector (PrimState m) a)
+asUnboxedBIT = id
+
+-- TODO: Efficient initialization
+fromVector_BIT :: (CommutativeMonoid a, PrimMonad m, G.Vector vec a) => vec a -> m (BIT (G.Mutable vec) (PrimState m) a)
+fromVector_BIT vec = do
+  mvec <- GM.replicate (G.length vec) mempty
+  G.imapM_ (add_BIT (BIT mvec)) vec
+  return (BIT mvec)
+{-# INLINE fromVector_BIT #-}

From 27ffbdd82597d8d97a5f7823c7c625a1dc0d9911 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Tue, 8 Sep 2020 13:01:26 +0900
Subject: [PATCH 124/148] Update library

---
 lib/BinaryIndexedTree.hs          |  2 +-
 lib/Input.hs                      |  1 +
 lib/MergeSort.hs                  |  9 ++++
 lib/ModularArithmetic.hs          |  2 +-
 lib/ModularArithmetic_TypeNats.hs | 70 +++++++++++++++++++++++++++++++
 lib/Primes.hs                     | 14 +++++++
 lib/SegmentTree.hs                |  6 ++-
 7 files changed, 101 insertions(+), 3 deletions(-)
 create mode 100644 lib/ModularArithmetic_TypeNats.hs

diff --git a/lib/BinaryIndexedTree.hs b/lib/BinaryIndexedTree.hs
index f25f8bf..0ce8021 100644
--- a/lib/BinaryIndexedTree.hs
+++ b/lib/BinaryIndexedTree.hs
@@ -12,7 +12,7 @@ import qualified Data.Vector.Mutable as VM
 import qualified Data.Vector.Unboxed.Mutable as UM
 
 --
--- Binary Indexed Tree (BIT)
+-- Binary Indexed Tree (BIT), or Fenwick Tree
 --
 
 type CommutativeMonoid a = Monoid a
diff --git a/lib/Input.hs b/lib/Input.hs
index 6afdac2..ed9673f 100644
--- a/lib/Input.hs
+++ b/lib/Input.hs
@@ -6,6 +6,7 @@ import qualified Data.Vector.Unboxed as U
 import qualified Data.Vector.Unboxed.Mutable as UM
 import qualified Data.ByteString.Char8 as BS
 import Data.Bifunctor (first)
+import Data.Int (Int64)
 
 main = do
   _ :: [Int] <- map (read . BS.unpack) . BS.words <$> BS.getLine
diff --git a/lib/MergeSort.hs b/lib/MergeSort.hs
index b492e01..84f521c 100644
--- a/lib/MergeSort.hs
+++ b/lib/MergeSort.hs
@@ -2,6 +2,8 @@
 module MergeSort where
 import qualified Data.Vector.Unboxed as U
 import qualified Data.Vector.Unboxed.Mutable as UM
+import qualified Data.Vector.Generic as G
+import qualified Data.Vector.Algorithms.Merge as A
 
 mergeSortBy :: (U.Unbox a) => (a -> a -> Ordering) -> U.Vector a -> U.Vector a
 mergeSortBy !cmp !vec = doSort vec
@@ -31,3 +33,10 @@ mergeSortBy !cmp !vec = doSort vec
 
 mergeSort :: (U.Unbox a, Ord a) => U.Vector a -> U.Vector a
 mergeSort = mergeSortBy compare
+
+sortVector :: (G.Vector v a, Ord a) => v a -> v a
+sortVector v = G.create do
+  v' <- G.thaw v
+  A.sort v'
+  return v'
+{-# INLINE sortVector #-}
diff --git a/lib/ModularArithmetic.hs b/lib/ModularArithmetic.hs
index 64614aa..8a9a8f9 100644
--- a/lib/ModularArithmetic.hs
+++ b/lib/ModularArithmetic.hs
@@ -38,7 +38,7 @@ fromIntegral_Int64_N n | 0 <= n && n < modulo = N n
                        | otherwise = N (n `mod` modulo)
 
 {-# RULES
-"fromIntegral/Int->N" fromIntegral = fromIntegral_Int64_N . fromIntegral
+"fromIntegral/Int->N" fromIntegral = fromIntegral_Int64_N . (fromIntegral :: Int -> Int64)
 "fromIntegral/Int64->N" fromIntegral = fromIntegral_Int64_N
  #-}
 
diff --git a/lib/ModularArithmetic_TypeNats.hs b/lib/ModularArithmetic_TypeNats.hs
new file mode 100644
index 0000000..47351d2
--- /dev/null
+++ b/lib/ModularArithmetic_TypeNats.hs
@@ -0,0 +1,70 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE NoStarIsType #-}
+module ModularArithmetic_TypeNats where
+import Data.Int
+import GHC.TypeNats (Nat, KnownNat, natVal, type (^), type (+))
+
+--
+-- Modular Arithmetic
+--
+
+-- type N = IntMod (10^9 + 7)
+
+newtype IntMod (m :: Nat) = IntMod { unwrapN :: Int64 } deriving (Eq)
+
+instance Show (IntMod m) where
+  show (IntMod x) = show x
+
+instance KnownNat m => Num (IntMod m) where
+  t@(IntMod x) + IntMod y
+    | x + y >= modulus = IntMod (x + y - modulus)
+    | otherwise = IntMod (x + y)
+    where modulus = fromIntegral (natVal t)
+  t@(IntMod x) - IntMod y
+    | x >= y = IntMod (x - y)
+    | otherwise = IntMod (x - y + modulus)
+    where modulus = fromIntegral (natVal t)
+  t@(IntMod x) * IntMod y = IntMod ((x * y) `rem` modulus)
+    where modulus = fromIntegral (natVal t)
+  fromInteger n = let result = IntMod (fromInteger (n `mod` fromIntegral modulus))
+                      modulus = natVal result
+                  in result
+  abs = undefined; signum = undefined
+
+{-# RULES
+"^9/Int" forall x. x ^ (9 :: Int) = let u = x; v = u * u * u in v * v * v
+"^9/Integer" forall x. x ^ (9 :: Integer) = let u = x; v = u * u * u in v * v * v
+ #-}
+
+fromIntegral_Int64_IntMod :: KnownNat m => Int64 -> IntMod m
+fromIntegral_Int64_IntMod n = result
+  where
+    result | 0 <= n && n < modulus = IntMod n
+           | otherwise = IntMod (n `mod` modulus)
+    modulus = fromIntegral (natVal result)
+
+{-# RULES
+"fromIntegral/Int->IntMod" fromIntegral = fromIntegral_Int64_IntMod . (fromIntegral :: Int -> Int64) :: Int -> IntMod (10^9 + 7)
+"fromIntegral/Int64->IntMod" fromIntegral = fromIntegral_Int64_IntMod :: Int64 -> IntMod (10^9 + 7)
+ #-}
+
+---
+
+exEuclid :: (Eq a, Integral a) => a -> a -> (a, a, a)
+exEuclid !f !g = loop 1 0 0 1 f g
+  where loop !u0 !u1 !v0 !v1 !f 0 = (f, u0, v0)
+        loop !u0 !u1 !v0 !v1 !f g =
+          case divMod f g of
+            (q,r) -> loop u1 (u0 - q * u1) v1 (v0 - q * v1) g r
+
+instance KnownNat m => Fractional (IntMod m) where
+  recip t@(IntMod x) = IntMod $ case exEuclid x modulus of
+    (1,a,_) -> a `mod` modulus
+    (-1,a,_) -> (-a) `mod` modulus
+    _ -> error "not invertible"
+    where modulus = fromIntegral (natVal t)
+  fromRational = undefined
diff --git a/lib/Primes.hs b/lib/Primes.hs
index e2a3831..d78bb1f 100644
--- a/lib/Primes.hs
+++ b/lib/Primes.hs
@@ -5,6 +5,10 @@ import Control.Monad (forM_,when)
 import qualified Data.Vector.Unboxed as U
 import qualified Data.Vector.Unboxed.Mutable as UM
 
+--
+-- Sieve of Eratosthenes
+--
+
 infixr 5 !:
 (!:) :: a -> [a] -> [a]
 (!x) !: xs = x : xs
@@ -70,3 +74,13 @@ factor x = loop x primes
 -- 48
 euler :: Int64 -> Int64
 euler !x = product [(p - 1) * p^(n-1) | (p,n) <- factor x]
+
+{-
+-- |
+-- >>> positiveDivisors 24
+-- fromList [(1,fromList [1]),(2,fromList [1,2]),(3,fromList [1,3]),(4,fromList [1,2,4]),(6,fromList [1,2,3,6]),(8,fromList [1,2,4,8]),(12,fromList [1,2,3,4,6,12]),(24,fromList [1,2,3,4,6,8,12,24])]
+positiveDivisors :: Int -> IntMap.IntMap IntSet.IntSet
+positiveDivisors n = foldl' go (IntMap.singleton 1 (IntSet.singleton 1)) $ factor n
+  where go !m (!p,!k) = iterate go2 m !! k
+          where go2 !m = m `IntMap.union` IntMap.fromAscList [(a*p, b `IntSet.union` IntSet.map (*p) b) | (a,b) <- IntMap.assocs m]
+-}
diff --git a/lib/SegmentTree.hs b/lib/SegmentTree.hs
index 5725e45..91a6eb4 100644
--- a/lib/SegmentTree.hs
+++ b/lib/SegmentTree.hs
@@ -46,7 +46,7 @@ update_SegTree (SegTree depth vec) !i !x = loop ((1 `shiftL` depth) + i) x
 {-# INLINE update_SegTree #-}
 
 new_SegTree :: (Monoid a, GM.MVector mvec a, PrimMonad m) => Int -> m (SegTree mvec (PrimState m) a)
-new_SegTree n = do let depth = ceiling (logBase 2 (fromIntegral n) :: Double) :: Int
+new_SegTree n = do let depth = ceil_log2 n
                    vec <- GM.replicate ((1 `shiftL` (depth + 1)) - 1) mempty
                    return (SegTree depth vec)
 {-# INLINE new_SegTree #-}
@@ -56,3 +56,7 @@ asBoxedSegTree = id
 
 asUnboxedSegTree :: (PrimMonad m) => m (SegTree UM.MVector (PrimState m) a) -> m (SegTree UM.MVector (PrimState m) a)
 asUnboxedSegTree = id
+
+ceil_log2 :: Int -> Int
+ceil_log2 0 = 0
+ceil_log2 x = finiteBitSize x - countLeadingZeros (x - 1)

From 66ba519768103213d279760adb1ab840e1d80c56 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Fri, 11 Sep 2020 08:31:27 +0900
Subject: [PATCH 125/148] AtCoder Library Practice Contest - C (Floor Sum)

---
 README.md           |   2 +-
 practice2-c/Main.hs | 102 ++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 103 insertions(+), 1 deletion(-)
 create mode 100644 practice2-c/Main.hs

diff --git a/README.md b/README.md
index a59aec4..48d5c39 100644
--- a/README.md
+++ b/README.md
@@ -359,7 +359,7 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
     * Union Find
 * [x] B - Fenwick Tree
     * Fenwick Tree, or Binary Indexed Tree
-* [ ] C - Floor Sum
+* [x] C - Floor Sum
 * [ ] D - Maxflow
 * [ ] E - MinCostFlow
 * [ ] F - Convolution
diff --git a/practice2-c/Main.hs b/practice2-c/Main.hs
new file mode 100644
index 0000000..d10d21a
--- /dev/null
+++ b/practice2-c/Main.hs
@@ -0,0 +1,102 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE TypeApplications #-}
+import           Control.Monad
+import           Data.Bits
+import qualified Data.ByteString.Char8 as BS
+import           Data.Char             (isSpace)
+import           Data.Int              (Int64)
+import           Data.List             (unfoldr)
+import           Data.Ratio
+import qualified Test.QuickCheck       as QC
+import Control.Exception (assert)
+
+-- comb2 n = n * (n - 1) `quot` 2 without undue overflow
+-- n even: comb2 n = (n `quot` 2) * (n - 1)
+-- n odd: comb2 n = n * (n `quot` 2)
+comb2 :: (Integral a, Bits a) => a -> a
+comb2 n = (n `shiftR` 1) * ((n - 1) .|. 1)
+
+prop_comb2 :: Integer -> QC.Property
+prop_comb2 n = comb2 n QC.=== n * (n - 1) `quot` 2
+
+prop_floorSum_negate_a :: QC.NonNegative (QC.Small Int64) -> QC.Positive Int64 -> Int64 -> Int64 -> QC.Property
+prop_floorSum_negate_a (QC.NonNegative (QC.Small n)) (QC.Positive m) a b =
+  let does_not_overflow = (\t -> toInteger (minBound :: Int64) <= t && t <= toInteger (maxBound :: Int64)) (toInteger b + toInteger a * (toInteger n - 1))
+  in does_not_overflow QC.==> floorSum n m (- a) (b + a * (n - 1)) QC.=== floorSum n m a b
+
+-- floorSum n m a b
+-- n: non-negative, m: positive
+floorSum :: Int64 -> Int64 -> Int64 -> Int64 -> Int64
+floorSum n m a b | assert (n >= 0 && m > 0) False = undefined
+floorSum n m 0 b = n * floor (b % m)
+floorSum 0 m a b = 0
+floorSum n 1 a b = a * comb2 n + n * b
+floorSum n m a b
+  | a < 0 = floorSum n m (- a) (b + a * (n - 1))
+  {-
+  | a >= m || a < 0 = case a `divMod` m of
+                        (q, a') -> q * comb2 n + floorSum n m a' b
+-}
+  | let m2 = m `quot` 2
+  , abs a > m2 = case (a + m2) `divMod` m of
+                   (q, a') ->
+                     q * comb2 n + floorSum n m (a' - m2) b
+  | b >= m || b < 0 = case b `divMod` m of
+                        (q, b') -> q * n + floorSum n m a b'
+  | n > m = case n `quotRem` m of
+              (q, n') -> (q * n - comb2 (q + 1) * m) * a + q * floorSum m m a b + floorSum n' m a b
+  --  | n < 100 = fromInteger $ floorSum_naive n m a b
+--            in -- fromInteger $ floorSum_naive n m a b
+--              - n * t - floorSum t (- a) (- m) (- b - m) + floorSum t (- a) (- m) (b - m)
+  | otherwise = -- 0 < a < m, 0 <= b < m, 0 < n <= m
+      -- 0 < a < m
+      -- sum [ fromIntegral $ length [ i | i <- [0..n-1], floor ((toInteger a * toInteger i + toInteger b) % toInteger m) >= k ] | k <- [1..(floor $ (toInteger a * (toInteger n - 1) + toInteger b) % toInteger m)] ]
+      -- sum [ fromIntegral $ length [ i | i <- [0..n-1], i >= - floor ((- toInteger m * toInteger k + toInteger b) % toInteger a) ] | k <- [1..(floor $ (toInteger a * (toInteger n - 1) + toInteger b) % toInteger m)] ]
+      -- sum [ n - max 0 (- floor ((- toInteger m * toInteger k + toInteger b - toInteger m) % toInteger a)) | k <- [0..(floor $ (toInteger a * (toInteger n - 1) + toInteger b) % toInteger m) - 1] ]
+      let t = floor ((toInteger a * (toInteger n - 1) + toInteger b) % toInteger m)
+      in n * t + floorSum t a (- m) (b - m)
+      -- ceilSum (ceiling $ (a * (n - 1) + b) % m) a m (m - b)
+
+{-
+ceilSum :: Int64 -> Int64 -> Int64 -> Int64 -> Int64
+ceilSum n m 0 b = n * ceiling (b % m)
+ceilSum 0 m a b = 0
+ceilSum n 1 a b = a * (n * (n - 1) `quot` 2) + n * b
+ceilSum n m a b
+  | a >= m = case a `quotRem` m of
+               (q, a') -> q * (n * (n - 1) `quot` 2) + ceilSum n m a' b
+  | b >= m || b < 0 = case b `divMod` m of
+                        (q, b') -> q * n + ceilSum n m a b'
+  | n > m = case n `quotRem` m of
+              (q, n') -> (q * n - q * (q + 1) `quot` 2 * m) * a + q * ceilSum m m a b + ceilSum n' m a b
+  | n < 100 = fromInteger $ ceilSum_naive n m a b
+  | otherwise = n * (n - 1) `quot` 2 - floorSum n m (m - a) (- b) -- 0 < a < m, 0 <= b < m, 0 < n <= m
+
+-}
+floorSum_naive :: Int64 -> Int64 -> Int64 -> Int64 -> Integer
+floorSum_naive n m a b = sum [ floor ((fromIntegral a * fromIntegral i + fromIntegral b) % fromIntegral m) | i <- [0..n-1] ]
+
+{-
+ceilSum_naive :: Int64 -> Int64 -> Int64 -> Int64 -> Integer
+ceilSum_naive n m a b = sum [ ceiling ((fromIntegral a * fromIntegral i + fromIntegral b) % fromIntegral m) | i <- [0..n-1] ]
+-}
+prop_floorSum :: QC.NonNegative (QC.Small Int64) -> QC.Positive Int64 -> Int64 -> Int64 -> QC.Property
+prop_floorSum (QC.NonNegative (QC.Small n)) (QC.Positive m) a b = QC.within (100 * 1000) $ toInteger (floorSum n m a b) QC.=== floorSum_naive n m a b
+
+prop_floorSum_r :: QC.Property
+prop_floorSum_r = QC.forAllShrink (QC.choose (1, 10^4)) QC.shrink $ \n -> n >= 1 QC.==>
+  QC.forAllShrink (QC.choose (1, 10^9)) QC.shrink $ \m -> m >= 1 QC.==>
+  QC.forAllShrink (QC.choose (0, m - 1)) QC.shrink $ \a ->
+  QC.forAllShrink (QC.choose (0, m - 1)) QC.shrink $ \b ->
+  QC.within (100 * 1000) $ toInteger (floorSum n m a b) QC.=== floorSum_naive n m a b
+
+{-
+prop_ceilSum :: QC.NonNegative (QC.Small Int64) -> QC.Positive Int64 -> Int64 -> Int64 -> QC.Property
+prop_ceilSum (QC.NonNegative (QC.Small n)) (QC.Positive m) a b = QC.within (100 * 1000) $ toInteger (ceilSum n m a b) QC.=== ceilSum_naive n m a b
+-}
+
+main = do
+  t <- readLn @Int
+  replicateM_ t $ do
+    [n,m,a,b] <- map fromIntegral . unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+    print $ floorSum n m a b

From a4c93cd97995f6cee6056d21412e13205fcd34f0 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Fri, 11 Sep 2020 08:33:07 +0900
Subject: [PATCH 126/148] ACL Practice Contest C - clean up

---
 practice2-c/Main.hs | 63 ++++++++++-----------------------------------
 1 file changed, 13 insertions(+), 50 deletions(-)

diff --git a/practice2-c/Main.hs b/practice2-c/Main.hs
index d10d21a..b2b94ba 100644
--- a/practice2-c/Main.hs
+++ b/practice2-c/Main.hs
@@ -16,14 +16,6 @@ import Control.Exception (assert)
 comb2 :: (Integral a, Bits a) => a -> a
 comb2 n = (n `shiftR` 1) * ((n - 1) .|. 1)
 
-prop_comb2 :: Integer -> QC.Property
-prop_comb2 n = comb2 n QC.=== n * (n - 1) `quot` 2
-
-prop_floorSum_negate_a :: QC.NonNegative (QC.Small Int64) -> QC.Positive Int64 -> Int64 -> Int64 -> QC.Property
-prop_floorSum_negate_a (QC.NonNegative (QC.Small n)) (QC.Positive m) a b =
-  let does_not_overflow = (\t -> toInteger (minBound :: Int64) <= t && t <= toInteger (maxBound :: Int64)) (toInteger b + toInteger a * (toInteger n - 1))
-  in does_not_overflow QC.==> floorSum n m (- a) (b + a * (n - 1)) QC.=== floorSum n m a b
-
 -- floorSum n m a b
 -- n: non-negative, m: positive
 floorSum :: Int64 -> Int64 -> Int64 -> Int64 -> Int64
@@ -33,53 +25,34 @@ floorSum 0 m a b = 0
 floorSum n 1 a b = a * comb2 n + n * b
 floorSum n m a b
   | a < 0 = floorSum n m (- a) (b + a * (n - 1))
-  {-
+{-
   | a >= m || a < 0 = case a `divMod` m of
                         (q, a') -> q * comb2 n + floorSum n m a' b
 -}
   | let m2 = m `quot` 2
   , abs a > m2 = case (a + m2) `divMod` m of
-                   (q, a') ->
-                     q * comb2 n + floorSum n m (a' - m2) b
+                   (q, a') -> q * comb2 n + floorSum n m (a' - m2) b
   | b >= m || b < 0 = case b `divMod` m of
                         (q, b') -> q * n + floorSum n m a b'
   | n > m = case n `quotRem` m of
               (q, n') -> (q * n - comb2 (q + 1) * m) * a + q * floorSum m m a b + floorSum n' m a b
-  --  | n < 100 = fromInteger $ floorSum_naive n m a b
---            in -- fromInteger $ floorSum_naive n m a b
---              - n * t - floorSum t (- a) (- m) (- b - m) + floorSum t (- a) (- m) (b - m)
-  | otherwise = -- 0 < a < m, 0 <= b < m, 0 < n <= m
-      -- 0 < a < m
-      -- sum [ fromIntegral $ length [ i | i <- [0..n-1], floor ((toInteger a * toInteger i + toInteger b) % toInteger m) >= k ] | k <- [1..(floor $ (toInteger a * (toInteger n - 1) + toInteger b) % toInteger m)] ]
-      -- sum [ fromIntegral $ length [ i | i <- [0..n-1], i >= - floor ((- toInteger m * toInteger k + toInteger b) % toInteger a) ] | k <- [1..(floor $ (toInteger a * (toInteger n - 1) + toInteger b) % toInteger m)] ]
-      -- sum [ n - max 0 (- floor ((- toInteger m * toInteger k + toInteger b - toInteger m) % toInteger a)) | k <- [0..(floor $ (toInteger a * (toInteger n - 1) + toInteger b) % toInteger m) - 1] ]
+  | otherwise =
+      -- 0 < a < m, 0 <= b < m, 0 < n <= m
       let t = floor ((toInteger a * (toInteger n - 1) + toInteger b) % toInteger m)
       in n * t + floorSum t a (- m) (b - m)
-      -- ceilSum (ceiling $ (a * (n - 1) + b) % m) a m (m - b)
 
-{-
-ceilSum :: Int64 -> Int64 -> Int64 -> Int64 -> Int64
-ceilSum n m 0 b = n * ceiling (b % m)
-ceilSum 0 m a b = 0
-ceilSum n 1 a b = a * (n * (n - 1) `quot` 2) + n * b
-ceilSum n m a b
-  | a >= m = case a `quotRem` m of
-               (q, a') -> q * (n * (n - 1) `quot` 2) + ceilSum n m a' b
-  | b >= m || b < 0 = case b `divMod` m of
-                        (q, b') -> q * n + ceilSum n m a b'
-  | n > m = case n `quotRem` m of
-              (q, n') -> (q * n - q * (q + 1) `quot` 2 * m) * a + q * ceilSum m m a b + ceilSum n' m a b
-  | n < 100 = fromInteger $ ceilSum_naive n m a b
-  | otherwise = n * (n - 1) `quot` 2 - floorSum n m (m - a) (- b) -- 0 < a < m, 0 <= b < m, 0 < n <= m
-
--}
 floorSum_naive :: Int64 -> Int64 -> Int64 -> Int64 -> Integer
 floorSum_naive n m a b = sum [ floor ((fromIntegral a * fromIntegral i + fromIntegral b) % fromIntegral m) | i <- [0..n-1] ]
 
-{-
-ceilSum_naive :: Int64 -> Int64 -> Int64 -> Int64 -> Integer
-ceilSum_naive n m a b = sum [ ceiling ((fromIntegral a * fromIntegral i + fromIntegral b) % fromIntegral m) | i <- [0..n-1] ]
--}
+main = do
+  t <- readLn @Int
+  replicateM_ t $ do
+    [n,m,a,b] <- map fromIntegral . unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+    print $ floorSum n m a b
+
+prop_comb2 :: Integer -> QC.Property
+prop_comb2 n = comb2 n QC.=== n * (n - 1) `quot` 2
+
 prop_floorSum :: QC.NonNegative (QC.Small Int64) -> QC.Positive Int64 -> Int64 -> Int64 -> QC.Property
 prop_floorSum (QC.NonNegative (QC.Small n)) (QC.Positive m) a b = QC.within (100 * 1000) $ toInteger (floorSum n m a b) QC.=== floorSum_naive n m a b
 
@@ -90,13 +63,3 @@ prop_floorSum_r = QC.forAllShrink (QC.choose (1, 10^4)) QC.shrink $ \n -> n >= 1
   QC.forAllShrink (QC.choose (0, m - 1)) QC.shrink $ \b ->
   QC.within (100 * 1000) $ toInteger (floorSum n m a b) QC.=== floorSum_naive n m a b
 
-{-
-prop_ceilSum :: QC.NonNegative (QC.Small Int64) -> QC.Positive Int64 -> Int64 -> Int64 -> QC.Property
-prop_ceilSum (QC.NonNegative (QC.Small n)) (QC.Positive m) a b = QC.within (100 * 1000) $ toInteger (ceilSum n m a b) QC.=== ceilSum_naive n m a b
--}
-
-main = do
-  t <- readLn @Int
-  replicateM_ t $ do
-    [n,m,a,b] <- map fromIntegral . unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
-    print $ floorSum n m a b

From ff66bc00a32ca85f24ca5409a3da543cb6bb756b Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Fri, 11 Sep 2020 09:35:13 +0900
Subject: [PATCH 127/148] More clean up

---
 practice2-c/Main.hs | 59 +++++++++++++++++++++++++++------------------
 1 file changed, 35 insertions(+), 24 deletions(-)

diff --git a/practice2-c/Main.hs b/practice2-c/Main.hs
index b2b94ba..1e28e81 100644
--- a/practice2-c/Main.hs
+++ b/practice2-c/Main.hs
@@ -1,5 +1,7 @@
 -- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns     #-}
 {-# LANGUAGE TypeApplications #-}
+import           Control.Exception     (assert)
 import           Control.Monad
 import           Data.Bits
 import qualified Data.ByteString.Char8 as BS
@@ -8,7 +10,6 @@ import           Data.Int              (Int64)
 import           Data.List             (unfoldr)
 import           Data.Ratio
 import qualified Test.QuickCheck       as QC
-import Control.Exception (assert)
 
 -- comb2 n = n * (n - 1) `quot` 2 without undue overflow
 -- n even: comb2 n = (n `quot` 2) * (n - 1)
@@ -17,32 +18,43 @@ comb2 :: (Integral a, Bits a) => a -> a
 comb2 n = (n `shiftR` 1) * ((n - 1) .|. 1)
 
 -- floorSum n m a b
--- n: non-negative, m: positive
+-- Assumptions:
+-- * n: non-negative, m: positive
 floorSum :: Int64 -> Int64 -> Int64 -> Int64 -> Int64
-floorSum n m a b | assert (n >= 0 && m > 0) False = undefined
-floorSum n m 0 b = n * floor (b % m)
-floorSum 0 m a b = 0
-floorSum n 1 a b = a * comb2 n + n * b
-floorSum n m a b
+floorSum !n !m !a !b
+  | assert (n >= 0 && m > 0) False = undefined
   | a < 0 = floorSum n m (- a) (b + a * (n - 1))
-{-
-  | a >= m || a < 0 = case a `divMod` m of
-                        (q, a') -> q * comb2 n + floorSum n m a' b
+  {-
+  | m < n = case n `quotRem` m of
+              (q, n') -> (q * n - comb2 (q + 1) * m) * a +
+                         q * floorSum_positive 0 m m a b +
+                         floorSum_positive 0 n' m a b
 -}
-  | let m2 = m `quot` 2
-  , abs a > m2 = case (a + m2) `divMod` m of
-                   (q, a') -> q * comb2 n + floorSum n m (a' - m2) b
-  | b >= m || b < 0 = case b `divMod` m of
-                        (q, b') -> q * n + floorSum n m a b'
-  | n > m = case n `quotRem` m of
-              (q, n') -> (q * n - comb2 (q + 1) * m) * a + q * floorSum m m a b + floorSum n' m a b
-  | otherwise =
-      -- 0 < a < m, 0 <= b < m, 0 < n <= m
-      let t = floor ((toInteger a * (toInteger n - 1) + toInteger b) % toInteger m)
-      in n * t + floorSum t a (- m) (b - m)
+  | otherwise = floorSum_positive 0 n m a b
+  where
+    -- Invariants:
+    -- * n: non-negative, m: positive, a: non-negative
+    -- * 0 <= n <= m
+    floorSum_positive :: Int64 -> Int64 -> Int64 -> Int64 -> Int64 -> Int64
+    floorSum_positive !acc !n !m !a !b
+      | a == 0 = acc + n * (b `div` m)
+      | n == 0 = acc
+      | m == 1 = acc + a * comb2 n + b * n
+      | let m2 = m `quot` 2, a > m2 =
+              let (q, a') = (a + m2) `quotRem` m
+                  (a'',b'') = if a' < m2 then
+                                (m2 - a', b - (m2 - a') * (n - 1))
+                              else
+                                (a' - m2, b)
+              in floorSum_positive (acc + q * comb2 n) n m a'' b''
+      | otherwise =
+          let (q, b') = b `divMod` m
+              t = (a * (n - 1) + b') `div` m
+              -- t <= (m * (m - 1) + m) `div` m = m
+          in floorSum_positive (acc + n * (q + t)) t a m (b' - m * t)
 
 floorSum_naive :: Int64 -> Int64 -> Int64 -> Int64 -> Integer
-floorSum_naive n m a b = sum [ floor ((fromIntegral a * fromIntegral i + fromIntegral b) % fromIntegral m) | i <- [0..n-1] ]
+floorSum_naive n m a b = sum [ floor ((toInteger a * toInteger i + toInteger b) % toInteger m) | i <- [0..n-1] ]
 
 main = do
   t <- readLn @Int
@@ -61,5 +73,4 @@ prop_floorSum_r = QC.forAllShrink (QC.choose (1, 10^4)) QC.shrink $ \n -> n >= 1
   QC.forAllShrink (QC.choose (1, 10^9)) QC.shrink $ \m -> m >= 1 QC.==>
   QC.forAllShrink (QC.choose (0, m - 1)) QC.shrink $ \a ->
   QC.forAllShrink (QC.choose (0, m - 1)) QC.shrink $ \b ->
-  QC.within (100 * 1000) $ toInteger (floorSum n m a b) QC.=== floorSum_naive n m a b
-
+  QC.within (100 * 1000 {- 100ms -}) $ toInteger (floorSum n m a b) QC.=== floorSum_naive n m a b

From 9993e948755996dd0ae427383c8b8a86af2592d4 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Fri, 11 Sep 2020 09:45:38 +0900
Subject: [PATCH 128/148] Even more cleanup

---
 practice2-c/Main.hs | 11 ++---------
 1 file changed, 2 insertions(+), 9 deletions(-)

diff --git a/practice2-c/Main.hs b/practice2-c/Main.hs
index 1e28e81..9dccfc8 100644
--- a/practice2-c/Main.hs
+++ b/practice2-c/Main.hs
@@ -20,16 +20,11 @@ comb2 n = (n `shiftR` 1) * ((n - 1) .|. 1)
 -- floorSum n m a b
 -- Assumptions:
 -- * n: non-negative, m: positive
+-- * a and b can be negative, or >= m
 floorSum :: Int64 -> Int64 -> Int64 -> Int64 -> Int64
 floorSum !n !m !a !b
   | assert (n >= 0 && m > 0) False = undefined
-  | a < 0 = floorSum n m (- a) (b + a * (n - 1))
-  {-
-  | m < n = case n `quotRem` m of
-              (q, n') -> (q * n - comb2 (q + 1) * m) * a +
-                         q * floorSum_positive 0 m m a b +
-                         floorSum_positive 0 n' m a b
--}
+  | a < 0 = floorSum_positive 0 n m (- a) (b + a * (n - 1))
   | otherwise = floorSum_positive 0 n m a b
   where
     -- Invariants:
@@ -37,9 +32,7 @@ floorSum !n !m !a !b
     -- * 0 <= n <= m
     floorSum_positive :: Int64 -> Int64 -> Int64 -> Int64 -> Int64 -> Int64
     floorSum_positive !acc !n !m !a !b
-      | a == 0 = acc + n * (b `div` m)
       | n == 0 = acc
-      | m == 1 = acc + a * comb2 n + b * n
       | let m2 = m `quot` 2, a > m2 =
               let (q, a') = (a + m2) `quotRem` m
                   (a'',b'') = if a' < m2 then

From eceeb529bb387b91ed496defeeed0e91f8bbbf65 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Fri, 11 Sep 2020 10:15:55 +0900
Subject: [PATCH 129/148] Maybe a bit faster

---
 practice2-c/Main.hs | 14 ++++++++++++++
 1 file changed, 14 insertions(+)

diff --git a/practice2-c/Main.hs b/practice2-c/Main.hs
index 9dccfc8..ff68163 100644
--- a/practice2-c/Main.hs
+++ b/practice2-c/Main.hs
@@ -33,6 +33,19 @@ floorSum !n !m !a !b
     floorSum_positive :: Int64 -> Int64 -> Int64 -> Int64 -> Int64 -> Int64
     floorSum_positive !acc !n !m !a !b
       | n == 0 = acc
+      | otherwise =
+        let m2 = m `quot` 2
+            (q, a') = (a + m2) `quotRem` m
+            (a'',b'') = if a' < m2 then
+                          (m2 - a', b - (m2 - a') * (n - 1))
+                        else
+                          (a' - m2, b)
+            -- 0 <= a'' < m `quot` 2 < m
+            (q', b''') = b'' `divMod` m
+            t = (a'' * (n - 1) + b''') `div` m
+            -- t <= (m * (m - 1) + m) `div` m = m
+        in floorSum_positive (acc + q * comb2 n + n * (q' + t)) t a'' m (b''' - m * t)
+      {-
       | let m2 = m `quot` 2, a > m2 =
               let (q, a') = (a + m2) `quotRem` m
                   (a'',b'') = if a' < m2 then
@@ -45,6 +58,7 @@ floorSum !n !m !a !b
               t = (a * (n - 1) + b') `div` m
               -- t <= (m * (m - 1) + m) `div` m = m
           in floorSum_positive (acc + n * (q + t)) t a m (b' - m * t)
+-}
 
 floorSum_naive :: Int64 -> Int64 -> Int64 -> Int64 -> Integer
 floorSum_naive n m a b = sum [ floor ((toInteger a * toInteger i + toInteger b) % toInteger m) | i <- [0..n-1] ]

From 54fcd03dd819643128f2bfa575bfd392d4afabf7 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Mon, 2 Nov 2020 19:54:59 +0900
Subject: [PATCH 130/148] ABC181-C, D

---
 abc/README.md        | 11 +++++++++++
 abc/abc181-c/Main.hs | 16 ++++++++++++++++
 abc/abc181-d/Main.hs | 35 +++++++++++++++++++++++++++++++++++
 3 files changed, 62 insertions(+)
 create mode 100644 abc/abc181-c/Main.hs
 create mode 100644 abc/abc181-d/Main.hs

diff --git a/abc/README.md b/abc/README.md
index 8d35f14..ebc9aeb 100644
--- a/abc/README.md
+++ b/abc/README.md
@@ -427,3 +427,14 @@
 * [ ] D - Friends
 * [x] E - Coprime
 * [ ] F - I hate Shortest Path Problem
+
+## AtCoder Beginner Contest 181
+
+<https://atcoder.jp/contests/abc181>
+
+* [ ] A - Heavy Rotation
+* [ ] B - Trapezoid Sum
+* [x] C - Collinearity
+* [x] D - Hachi
+* [ ] E - Transformable Teacher
+* [ ] F - Silver Woods
diff --git a/abc/abc181-c/Main.hs b/abc/abc181-c/Main.hs
new file mode 100644
index 0000000..a37c7f3
--- /dev/null
+++ b/abc/abc181-c/Main.hs
@@ -0,0 +1,16 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE TypeApplications #-}
+import Data.Char (isSpace)
+import Data.List
+import Control.Monad
+import qualified Data.ByteString.Char8 as BS
+
+det2 a b c d = a * d - b * c
+
+main = do
+  n <- readLn @Int
+  points <- replicateM n $ do
+    [x,y] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+    return (x,y)
+  let result = or [ det2 (x1-x0) (y1-y0) (x2-x0) (y2-y0) == 0 | (x0,y0):ps <- tails points, (x1,y1):ps' <- tails ps, (x2,y2) <- ps' ]
+  putStrLn $ if result then "Yes" else "No"
diff --git a/abc/abc181-d/Main.hs b/abc/abc181-d/Main.hs
new file mode 100644
index 0000000..bf5a400
--- /dev/null
+++ b/abc/abc181-d/Main.hs
@@ -0,0 +1,35 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE TypeApplications #-}
+import Data.List
+import qualified Data.ByteString.Char8 as BS
+
+shortCase :: String -> Bool
+shortCase xs = or $ do
+  ys <- permutations xs
+  return (read @Int ys `rem` 8 == 0)
+
+multiplesOf8 :: [[(Char, Int)]]
+multiplesOf8 = [ if c0 == c2 then
+                   [(c0,3)]
+                 else if c0 == c1 then
+                   [(c0,2),(c2,1)]
+                 else if c1 == c2 then
+                   [(c0,1),(c1,2)]
+                 else
+                   [(c0,1),(c1,1),(c2,1)]
+               | n <- [13 .. 124]
+               , let [c0,c1,c2] = sort $ show (8 * n)
+               ]
+
+longCase :: BS.ByteString -> Bool
+longCase s = or $ do
+  m <- multiplesOf8
+  return $ all (\(c,n) -> BS.count c s >= n) m
+
+main = do
+  s <- BS.getLine
+  let result = if BS.length s <= 2 then
+                 shortCase (BS.unpack s)
+               else
+                 longCase s
+  putStrLn $ if result then "Yes" else "No"

From 260b53c28a760154cf3f279c0b723d47ce7d8db8 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Sat, 16 Jan 2021 18:42:18 +0900
Subject: [PATCH 131/148] Add TDPC-T

---
 tdpc-t/Main.hs    | 104 +++++++++++++++++++++++++++++++++++++++
 tdpc-t/Mutable.hs | 123 ++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 227 insertions(+)
 create mode 100644 tdpc-t/Main.hs
 create mode 100644 tdpc-t/Mutable.hs

diff --git a/tdpc-t/Main.hs b/tdpc-t/Main.hs
new file mode 100644
index 0000000..6cbec93
--- /dev/null
+++ b/tdpc-t/Main.hs
@@ -0,0 +1,104 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns  #-}
+{-# LANGUAGE DataKinds     #-}
+{-# LANGUAGE NoStarIsType  #-}
+{-# LANGUAGE TypeFamilies  #-}
+{-# LANGUAGE TypeOperators #-}
+import qualified Data.ByteString.Char8 as BS
+import           Data.Char             (isSpace)
+import           Data.Int              (Int64)
+import           Data.List             (tails, unfoldr)
+import qualified Data.Vector.Unboxing  as U
+import           GHC.TypeNats          (type (+), KnownNat, Nat, type (^),
+                                        natVal)
+
+type Poly = U.Vector (IntMod (10^9 + 7))
+
+-- 多項式は
+--   U.fromList [a,b,c,...,z] = a + b * X + c * X^2 + ... + z * X^(k-1)
+-- により表す。
+
+reduce :: Int -> Poly -> Poly
+reduce !k !v | U.last v == 0 = U.init v
+             | U.length v <= k = v
+             | otherwise = let b = U.last v
+                               l = U.length v
+                           in reduce k (U.imap (\i a -> if i >= l - k - 1 then a + b else a) (U.init v))
+
+-- 多項式の積を X^k - X^(k-1) - ... - X - 1 で割った余りを返す。
+mulP :: Int -> Poly -> Poly -> Poly
+mulP !k !v !w = reduce k $ U.generate (U.length v + U.length w - 1) $
+                \i -> sum [(v U.! (i-j)) * (w U.! j) | j <- [0..U.length w-1], j <= i, j > i - U.length v]
+
+-- 多項式に X をかけたものを X^k - X^(k-1) - ... - X - 1 で割った余りを返す。
+mulByX :: Int -> Poly -> Poly
+mulByX !k !v
+  | U.length v == k = let !v_k = v U.! (k-1)
+                      in U.generate k $ \i -> if i == 0 then
+                                                v_k
+                                              else
+                                                v_k + (v U.! (i - 1))
+  | otherwise = U.cons 0 v
+
+-- X の（mod X^k - X^(k-1) - ... - X - 1 での）n 乗
+powX :: Int -> Int -> Poly
+powX !k !n = doPowX n
+  where
+    doPowX 0 = U.fromList [1]   -- 1
+    doPowX 1 = U.fromList [0,1] -- X
+    doPowX i = case i `quotRem` 2 of
+                 (j,0) -> let !f = doPowX j -- X^j mod P
+                          in mulP k f f
+                 (j,_) -> let !f = doPowX j -- X^j mod P
+                          in mulByX k (mulP k f f)
+
+main :: IO ()
+main = do
+  [k,n] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  if n <= k then
+    print 1
+  else do
+    let f = powX k (n - k) -- X^(n-k) mod X^k - X^(k-1) - ... - X - 1
+    let seq = replicate k 1 ++ map (sum . take k) (tails seq) -- 数列
+    print $ sum $ zipWith (*) (U.toList f) (drop (k-1) seq)
+
+--
+-- Modular Arithmetic
+--
+
+newtype IntMod (m :: Nat) = IntMod { unwrapN :: Int64 } deriving (Eq)
+
+instance Show (IntMod m) where
+  show (IntMod x) = show x
+
+instance KnownNat m => Num (IntMod m) where
+  t@(IntMod x) + IntMod y
+    | x + y >= modulus = IntMod (x + y - modulus)
+    | otherwise = IntMod (x + y)
+    where modulus = fromIntegral (natVal t)
+  t@(IntMod x) - IntMod y
+    | x >= y = IntMod (x - y)
+    | otherwise = IntMod (x - y + modulus)
+    where modulus = fromIntegral (natVal t)
+  t@(IntMod x) * IntMod y = IntMod ((x * y) `rem` modulus)
+    where modulus = fromIntegral (natVal t)
+  fromInteger n = let result = IntMod (fromInteger (n `mod` fromIntegral modulus))
+                      modulus = natVal result
+                  in result
+  abs = undefined; signum = undefined
+  {-# SPECIALIZE instance Num (IntMod 1000000007) #-}
+
+fromIntegral_Int64_IntMod :: KnownNat m => Int64 -> IntMod m
+fromIntegral_Int64_IntMod n = result
+  where
+    result | 0 <= n && n < modulus = IntMod n
+           | otherwise = IntMod (n `mod` modulus)
+    modulus = fromIntegral (natVal result)
+
+{-# RULES
+"fromIntegral/Int->IntMod" fromIntegral = fromIntegral_Int64_IntMod . (fromIntegral :: Int -> Int64) :: Int -> IntMod (10^9 + 7)
+"fromIntegral/Int64->IntMod" fromIntegral = fromIntegral_Int64_IntMod :: Int64 -> IntMod (10^9 + 7)
+ #-}
+
+instance U.Unboxable (IntMod m) where
+  type Rep (IntMod m) = Int64
diff --git a/tdpc-t/Mutable.hs b/tdpc-t/Mutable.hs
new file mode 100644
index 0000000..e047ceb
--- /dev/null
+++ b/tdpc-t/Mutable.hs
@@ -0,0 +1,123 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns  #-}
+{-# LANGUAGE DataKinds     #-}
+{-# LANGUAGE NoStarIsType  #-}
+{-# LANGUAGE TypeFamilies  #-}
+{-# LANGUAGE TypeOperators #-}
+import           Control.Monad
+import           Control.Monad.ST
+import qualified Data.ByteString.Char8        as BS
+import           Data.Char                    (isSpace)
+import           Data.Coerce
+import           Data.Int                     (Int64)
+import           Data.List                    (foldl', tails, unfoldr)
+import qualified Data.Vector.Unboxing         as U
+import qualified Data.Vector.Unboxing.Mutable as UM
+import           GHC.TypeNats                 (type (+), KnownNat, Nat,
+                                               type (^), natVal)
+
+type Poly = U.Vector (IntMod (10^9 + 7))
+type PolyM s = UM.MVector s (IntMod (10^9 + 7))
+
+sum' :: KnownNat m => [IntMod m] -> IntMod m
+sum' = fromIntegral . foldl' (\x y -> x + unwrapN y) 0
+{-# INLINE sum' #-}
+
+-- 多項式は
+--   U.fromList [a,b,c,...,z] = a + b * X + c * X^2 + ... + z * X^(k-1)
+-- により表す。
+
+-- 多項式を X^k - X^(k-1) - ... - X - 1 で割った余りを返す。
+reduceM :: Int -> PolyM s -> ST s (PolyM s)
+reduceM !k !v = loop (UM.length v)
+  where loop !l | l <= k = return (UM.take l v)
+                | otherwise = do b <- UM.read v (l - 1)
+                                 forM_ [l - k - 1 .. l - 2] $ \i -> do
+                                   UM.modify v (+ b) i
+                                 loop (l - 1)
+
+-- 多項式の積を X^k - X^(k-1) - ... - X - 1 で割った余りを返す。
+mulP :: Int -> Poly -> Poly -> Poly
+mulP !k !v !w = {- U.force $ -} U.create $ do
+  let !vl = U.length v
+      !wl = U.length w
+  s <- UM.new (vl + wl - 1)
+  forM_ [0 .. vl + wl - 2] $ \i -> do
+    let !x = sum' [(v U.! (i-j)) * (w U.! j) | j <- [max 0 (i - vl + 1) .. min (wl - 1) i]]
+    UM.write s i x
+  reduceM k s
+
+-- 多項式に X をかけたものを X^k - X^(k-1) - ... - X - 1 で割った余りを返す。
+mulByX :: Int -> Poly -> Poly
+mulByX !k !v
+  | U.length v == k = let !v_k = v U.! (k-1)
+                      in U.generate k $ \i -> if i == 0 then
+                                                v_k
+                                              else
+                                                v_k + (v U.! (i - 1))
+  | otherwise = U.cons 0 v
+
+-- X の（mod X^k - X^(k-1) - ... - X - 1 での）n 乗
+powX :: Int -> Int -> Poly
+powX !k !n = doPowX n
+  where
+    doPowX 0 = U.fromList [1]   -- 1
+    doPowX 1 = U.fromList [0,1] -- X
+    doPowX i = case i `quotRem` 2 of
+                 (j,0) -> let !f = doPowX j -- X^j mod P
+                          in mulP k f f
+                 (j,_) -> let !f = doPowX j -- X^j mod P
+                          in mulByX k (mulP k f f)
+
+main :: IO ()
+main = do
+  [k,n] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  -- 2 <= k <= 1000
+  -- 1 <= n <= 10^9
+  if n <= k then
+    print 1
+  else do
+    let f = powX k (n - k) -- X^(n-k) mod X^k - X^(k-1) - ... - X - 1
+    let seq = replicate k 1 ++ map (sum . take k) (tails seq) -- 数列
+    print $ sum $ zipWith (*) (U.toList f) (drop (k-1) seq)
+
+--
+-- Modular Arithmetic
+--
+
+newtype IntMod (m :: Nat) = IntMod { unwrapN :: Int64 } deriving (Eq)
+
+instance Show (IntMod m) where
+  show (IntMod x) = show x
+
+instance KnownNat m => Num (IntMod m) where
+  t@(IntMod x) + IntMod y
+    | x + y >= modulus = IntMod (x + y - modulus)
+    | otherwise = IntMod (x + y)
+    where modulus = fromIntegral (natVal t)
+  t@(IntMod x) - IntMod y
+    | x >= y = IntMod (x - y)
+    | otherwise = IntMod (x - y + modulus)
+    where modulus = fromIntegral (natVal t)
+  t@(IntMod x) * IntMod y = IntMod ((x * y) `rem` modulus)
+    where modulus = fromIntegral (natVal t)
+  fromInteger n = let result = IntMod (fromInteger (n `mod` fromIntegral modulus))
+                      modulus = natVal result
+                  in result
+  abs = undefined; signum = undefined
+  {-# SPECIALIZE instance Num (IntMod 1000000007) #-}
+
+fromIntegral_Int64_IntMod :: KnownNat m => Int64 -> IntMod m
+fromIntegral_Int64_IntMod n = result
+  where
+    result | 0 <= n && n < modulus = IntMod n
+           | otherwise = IntMod (n `mod` modulus)
+    modulus = fromIntegral (natVal result)
+
+{-# RULES
+"fromIntegral/Int->IntMod" fromIntegral = fromIntegral_Int64_IntMod . (fromIntegral :: Int -> Int64) :: Int -> IntMod (10^9 + 7)
+"fromIntegral/Int64->IntMod" fromIntegral = fromIntegral_Int64_IntMod :: Int64 -> IntMod (10^9 + 7)
+ #-}
+
+instance U.Unboxable (IntMod m) where
+  type Rep (IntMod m) = Int64

From bf187ef3cb3837eddeafcfd855180663e543f9d2 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Mon, 18 Jan 2021 16:55:22 +0900
Subject: [PATCH 132/148] TDPC-T: Karatsuba

---
 tdpc-t/Karatsuba.hs | 280 ++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 280 insertions(+)
 create mode 100644 tdpc-t/Karatsuba.hs

diff --git a/tdpc-t/Karatsuba.hs b/tdpc-t/Karatsuba.hs
new file mode 100644
index 0000000..dfbace1
--- /dev/null
+++ b/tdpc-t/Karatsuba.hs
@@ -0,0 +1,280 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns        #-}
+{-# LANGUAGE DataKinds           #-}
+{-# LANGUAGE NoStarIsType        #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies        #-}
+{-# LANGUAGE TypeOperators       #-}
+import           Control.Monad
+import           Control.Monad.ST
+import           Data.Bits
+import qualified Data.ByteString.Char8        as BS
+import           Data.Char                    (isSpace)
+import           Data.Coerce
+import           Data.Int                     (Int64)
+import           Data.List                    (foldl', tails, unfoldr)
+import qualified Data.Vector.Generic          as G
+import qualified Data.Vector.Unboxing         as U
+import qualified Data.Vector.Unboxing.Mutable as UM
+import           GHC.TypeNats                 (type (+), KnownNat, Nat,
+                                               type (^), natVal)
+
+type P = U.Vector (IntMod (10^9 + 7))
+type PM s = UM.MVector s (IntMod (10^9 + 7))
+
+{-
+sum' :: KnownNat m => [IntMod m] -> IntMod m
+sum' = fromIntegral . foldl' (\x y -> x + unwrapN y) 0
+{-# INLINE sum' #-}
+-}
+
+-- 多項式は
+--   U.fromList [a,b,c,...,z] = a + b * X + c * X^2 + ... + z * X^(k-1)
+-- により表す。
+
+-- 多項式を X^k - X^(k-1) - ... - X - 1 で割った余りを返す。
+reduceM :: Int -> PM s -> ST s (PM s)
+reduceM !k !v = loop (UM.length v)
+  where loop !l | l <= k = return (UM.take l v)
+                | otherwise = do b <- UM.read v (l - 1)
+                                 forM_ [l - k - 1 .. l - 2] $ \i -> do
+                                   UM.modify v (+ b) i
+                                 loop (l - 1)
+
+-- 多項式の積を X^k - X^(k-1) - ... - X - 1 で割った余りを返す。
+mulP :: Int -> P -> P -> P
+mulP !k !v !w = {- U.force $ -} U.create $ do
+  let !vl = U.length v
+      !wl = U.length w
+  -- s <- UM.new (vl + wl - 1)
+  -- forM_ [0 .. vl + wl - 2] $ \i -> do
+  --   let !x = sum' [(v U.! (i-j)) * (w U.! j) | j <- [max 0 (i - vl + 1) .. min (wl - 1) i]]
+  --   UM.write s i x
+  let n = ceiling ((log (fromIntegral (vl .|. wl)) :: Double) / log 2) :: Int
+  s <- U.thaw (doMulP (2^n) v w)
+  reduceM k s
+
+-- 多項式に X をかけたものを X^k - X^(k-1) - ... - X - 1 で割った余りを返す。
+mulByX :: Int -> P -> P
+mulByX !k !v
+  | U.length v == k = let !v_k = v U.! (k-1)
+                      in U.generate k $ \i -> if i == 0 then
+                                                v_k
+                                              else
+                                                v_k + (v U.! (i - 1))
+  | otherwise = U.cons 0 v
+
+-- X の（mod X^k - X^(k-1) - ... - X - 1 での）n 乗
+powX :: Int -> Int -> P
+powX !k !n = doPowX n
+  where
+    doPowX 0 = U.fromList [1]   -- 1
+    doPowX 1 = U.fromList [0,1] -- X
+    doPowX i = case i `quotRem` 2 of
+                 (j,0) -> let !f = doPowX j -- X^j mod P
+                          in mulP k f f
+                 (j,_) -> let !f = doPowX j -- X^j mod P
+                          in mulByX k (mulP k f f)
+
+main :: IO ()
+main = do
+  [k,n] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  -- 2 <= k <= 1000
+  -- 1 <= n <= 10^9
+  if n <= k then
+    print 1
+  else do
+    let f = powX k (n - k) -- X^(n-k) mod X^k - X^(k-1) - ... - X - 1
+    let seq = replicate k 1 ++ map (sum . take k) (tails seq) -- 数列
+    print $ sum $ zipWith (*) (U.toList f) (drop (k-1) seq)
+
+--
+-- Modular Arithmetic
+--
+
+newtype IntMod (m :: Nat) = IntMod { unwrapN :: Int64 } deriving (Eq)
+
+instance Show (IntMod m) where
+  show (IntMod x) = show x
+
+instance KnownNat m => Num (IntMod m) where
+  t@(IntMod x) + IntMod y
+    | x + y >= modulus = IntMod (x + y - modulus)
+    | otherwise = IntMod (x + y)
+    where modulus = fromIntegral (natVal t)
+  t@(IntMod x) - IntMod y
+    | x >= y = IntMod (x - y)
+    | otherwise = IntMod (x - y + modulus)
+    where modulus = fromIntegral (natVal t)
+  t@(IntMod x) * IntMod y = IntMod ((x * y) `rem` modulus)
+    where modulus = fromIntegral (natVal t)
+  fromInteger n = let result = IntMod (fromInteger (n `mod` fromIntegral modulus))
+                      modulus = natVal result
+                  in result
+  abs = undefined; signum = undefined
+  {-# SPECIALIZE instance Num (IntMod 1000000007) #-}
+
+fromIntegral_Int64_IntMod :: KnownNat m => Int64 -> IntMod m
+fromIntegral_Int64_IntMod n = result
+  where
+    result | 0 <= n && n < modulus = IntMod n
+           | otherwise = IntMod (n `mod` modulus)
+    modulus = fromIntegral (natVal result)
+
+{-# RULES
+"fromIntegral/Int->IntMod" fromIntegral = fromIntegral_Int64_IntMod . (fromIntegral :: Int -> Int64) :: Int -> IntMod (10^9 + 7)
+"fromIntegral/Int64->IntMod" fromIntegral = fromIntegral_Int64_IntMod :: Int64 -> IntMod (10^9 + 7)
+ #-}
+
+instance U.Unboxable (IntMod m) where
+  type Rep (IntMod m) = Int64
+
+--
+-- Univariate polynomial
+--
+
+newtype Poly vec a = Poly { coeffAsc :: vec a } deriving Eq
+
+normalizePoly :: (Eq a, Num a, G.Vector vec a) => vec a -> vec a
+normalizePoly v | G.null v || G.last v /= 0 = v
+                | otherwise = normalizePoly (G.init v)
+
+addPoly :: (Eq a, Num a, G.Vector vec a) => vec a -> vec a -> vec a
+addPoly v w = case compare n m of
+                LT -> G.generate m $ \i -> if i < n
+                                           then v G.! i + w G.! i
+                                           else w G.! i
+                GT -> G.generate n $ \i -> if i < m
+                                           then v G.! i + w G.! i
+                                           else v G.! i
+                EQ -> normalizePoly $ G.zipWith (+) v w
+  where n = G.length v
+        m = G.length w
+
+subPoly :: (Eq a, Num a, G.Vector vec a) => vec a -> vec a -> vec a
+subPoly v w = case compare n m of
+                LT -> G.generate m $ \i -> if i < n
+                                           then v G.! i - w G.! i
+                                           else negate (w G.! i)
+                GT -> G.generate n $ \i -> if i < m
+                                           then v G.! i - w G.! i
+                                           else v G.! i
+                EQ -> normalizePoly $ G.zipWith (-) v w
+  where n = G.length v
+        m = G.length w
+
+naiveMulPoly :: (Num a, G.Vector vec a) => vec a -> vec a -> vec a
+naiveMulPoly v w = G.generate (n + m - 1) $
+                   \i -> sum [(v G.! (i-j)) * (w G.! j) | j <- [max (i-n+1) 0..min i (m-1)]]
+  where n = G.length v
+        m = G.length w
+
+doMulP :: (Eq a, Num a, G.Vector vec a) => Int -> vec a -> vec a -> vec a
+doMulP n !v !w | n <= 16 = naiveMulPoly v w
+doMulP n !v !w
+  | G.null v = v
+  | G.null w = w
+  | G.length v < n2 = let (w0, w1) = G.splitAt n2 w
+                          u0 = doMulP n2 v w0
+                          u1 = doMulP n2 v w1
+                      in G.generate (G.length v + G.length w - 1)
+                         $ \i -> case () of
+                                   _ | i < n2     ->  u0 `at` i
+                                     | i < n      -> (u0 `at` i) + (u1 `at` (i - n2))
+                                     | i < n + n2 -> (u1 `at` (i - n2))
+  | G.length w < n2 = let (v0, v1) = G.splitAt n2 v
+                          u0 = doMulP n2 v0 w
+                          u1 = doMulP n2 v1 w
+                      in G.generate (G.length v + G.length w - 1)
+                         $ \i -> case () of
+                                   _ | i < n2     ->  u0 `at` i
+                                     | i < n      -> (u0 `at` i) + (u1 `at` (i - n2))
+                                     | i < n + n2 -> (u1 `at` (i - n2))
+  | otherwise = let (v0, v1) = G.splitAt n2 v
+                    (w0, w1) = G.splitAt n2 w
+                    v0_1 = v0 `addPoly` v1
+                    w0_1 = w0 `addPoly` w1
+                    p = doMulP n2 v0_1 w0_1
+                    q = doMulP n2 v0 w0
+                    r = doMulP n2 v1 w1
+                    -- s = (p `subPoly` q) `subPoly` r -- p - q - r
+                    -- q + s*X^n2 + r*X^n
+                in G.generate (G.length v + G.length w - 1)
+                   $ \i -> case () of
+                             _ | i < n2     ->   q `at` i
+                               | i < n      -> ((q `at` i) + (p `at` (i - n2))) - ((q `at` (i - n2)) + (r `at` (i - n2)))
+                               | i < n + n2 -> ((r `at` (i - n)) + (p `at` (i - n2))) - ((q `at` (i - n2)) + (r `at` (i - n2)))
+                               | otherwise  ->   r `at` (i - n)
+  where n2 = n `quot` 2
+        at :: (Num a, G.Vector vec a) => vec a -> Int -> a
+        at v i = if i < G.length v then v G.! i else 0
+{-# INLINE doMulP #-}
+
+mulPoly :: (Eq a, Num a, G.Vector vec a) => vec a -> vec a -> vec a
+mulPoly !v !w = let k = ceiling ((log (fromIntegral (max n m)) :: Double) / log 2) :: Int
+                in doMulP (2^k) v w
+  where n = G.length v
+        m = G.length w
+{-# INLINE mulPoly #-}
+
+zeroPoly :: (G.Vector vec a) => Poly vec a
+zeroPoly = Poly G.empty
+
+constPoly :: (Eq a, Num a, G.Vector vec a) => a -> Poly vec a
+constPoly 0 = Poly G.empty
+constPoly x = Poly (G.singleton x)
+
+scalePoly :: (Eq a, Num a, G.Vector vec a) => a -> Poly vec a -> Poly vec a
+scalePoly a (Poly xs)
+  | a == 0 = zeroPoly
+  | otherwise = Poly $ G.map (* a) xs
+
+valueAtPoly :: (Num a, G.Vector vec a) => Poly vec a -> a -> a
+valueAtPoly (Poly xs) t = G.foldr' (\a b -> a + t * b) 0 xs
+
+instance (Eq a, Num a, G.Vector vec a) => Num (Poly vec a) where
+  (+) = coerce (addPoly :: vec a -> vec a -> vec a)
+  (-) = coerce (subPoly :: vec a -> vec a -> vec a)
+  negate (Poly v) = Poly (G.map negate v)
+  (*) = coerce (mulPoly :: vec a -> vec a -> vec a)
+  fromInteger = constPoly . fromInteger
+  abs = undefined; signum = undefined
+
+divModPoly :: (Eq a, Fractional a, G.Vector vec a) => Poly vec a -> Poly vec a -> (Poly vec a, Poly vec a)
+divModPoly f g@(Poly w)
+  | G.null w = error "divModPoly: divide by zero"
+  | degree f < degree g = (zeroPoly, f)
+  | otherwise = loop zeroPoly (scalePoly (recip b) f)
+  where
+    g' = toMonic g
+    b = leadingCoefficient g
+    -- invariant: f == q * g + scalePoly b p
+    loop q p | degree p < degree g = (q, scalePoly b p)
+             | otherwise = let q' = Poly (G.drop (degree' g) (coeffAsc p))
+                           in loop (q + q') (p - q' * g')
+
+    toMonic :: (Fractional a, G.Vector vec a) => Poly vec a -> Poly vec a
+    toMonic f@(Poly xs)
+      | G.null xs = zeroPoly
+      | otherwise = Poly $ G.map (* recip (leadingCoefficient f)) xs
+
+    leadingCoefficient :: (Num a, G.Vector vec a) => Poly vec a -> a
+    leadingCoefficient (Poly xs)
+      | G.null xs = 0
+      | otherwise = G.last xs
+
+    degree :: G.Vector vec a => Poly vec a -> Maybe Int
+    degree (Poly xs) = case G.length xs - 1 of
+      -1 -> Nothing
+      n  -> Just n
+
+    degree' :: G.Vector vec a => Poly vec a -> Int
+    degree' (Poly xs) = case G.length xs of
+      0 -> error "degree': zero polynomial"
+      n -> n - 1
+
+-- 組立除法
+-- second constPoly (divModByDeg1 f t) = divMod f (Poly (G.fromList [-t, 1]))
+divModByDeg1 :: (Eq a, Num a, G.Vector vec a) => Poly vec a -> a -> (Poly vec a, a)
+divModByDeg1 f t = let w = G.postscanr (\a b -> a + b * t) 0 $ coeffAsc f
+                   in (Poly (G.tail w), G.head w)

From 688ea9e70f4ebfaa551d1330fbdec3d560a936a9 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Mon, 18 Jan 2021 21:55:48 +0900
Subject: [PATCH 133/148] =?UTF-8?q?AtCoder=20Typical=20Contest=20001=20-?=
 =?UTF-8?q?=20C=20-=20=E9=AB=98=E9=80=9F=E3=83=95=E3=83=BC=E3=83=AA?=
 =?UTF-8?q?=E3=82=A8=E5=A4=89=E6=8F=9B?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 README.md             |   8 ++
 atc001-c/Karatsuba.hs | 180 +++++++++++++++++++++++++++++++++
 atc001-c/Main.hs      | 224 ++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 412 insertions(+)
 create mode 100644 atc001-c/Karatsuba.hs
 create mode 100644 atc001-c/Main.hs

diff --git a/README.md b/README.md
index 48d5c39..2622c12 100644
--- a/README.md
+++ b/README.md
@@ -369,3 +369,11 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 * [ ] J - Segment Tree
 * [ ] K - Range Affine Range Sum
 * [ ] L - Lazy Segment Tree
+
+## AtCoder Typical Contest 001
+
+<https://atcoder.jp/contests/atc001>
+
+* [ ] A - 深さ優先探索
+* [ ] B - Union Find
+* [x] C - 高速フーリエ変換
diff --git a/atc001-c/Karatsuba.hs b/atc001-c/Karatsuba.hs
new file mode 100644
index 0000000..2602d41
--- /dev/null
+++ b/atc001-c/Karatsuba.hs
@@ -0,0 +1,180 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns          #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TypeApplications      #-}
+import           Control.Monad
+import qualified Data.ByteString.Char8       as BS
+import           Data.Char                   (isSpace)
+import           Data.Coerce
+import           Data.Int                    (Int64)
+import           Data.List                   (unfoldr)
+import qualified Data.Vector.Generic         as G
+import qualified Data.Vector.Unboxed         as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+
+main = do
+  n <- readLn @Int -- n <= 10^5
+  (as,bs) <- fmap U.unzip $ U.replicateM n $ do
+    [a,b] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+    return (a,b)
+  let p, q :: Poly U.Vector Int
+      p = Poly $ normalizePoly (0 `U.cons` as)
+      q = Poly $ normalizePoly (0 `U.cons` bs)
+      !v = coeffAsc (p * q)
+      !l = U.length v
+  forM_ [1..2*n] $ \k -> do
+    print $ if k < l then
+              v U.! k
+            else
+              0
+
+--
+-- Univariate polynomial
+--
+
+newtype Poly vec a = Poly { coeffAsc :: vec a } deriving Eq
+
+normalizePoly :: (Eq a, Num a, G.Vector vec a) => vec a -> vec a
+normalizePoly v | G.null v || G.last v /= 0 = v
+                | otherwise = normalizePoly (G.init v)
+
+addPoly :: (Eq a, Num a, G.Vector vec a) => vec a -> vec a -> vec a
+addPoly v w = case compare n m of
+                LT -> G.generate m $ \i -> if i < n
+                                           then v G.! i + w G.! i
+                                           else w G.! i
+                GT -> G.generate n $ \i -> if i < m
+                                           then v G.! i + w G.! i
+                                           else v G.! i
+                EQ -> normalizePoly $ G.zipWith (+) v w
+  where n = G.length v
+        m = G.length w
+
+subPoly :: (Eq a, Num a, G.Vector vec a) => vec a -> vec a -> vec a
+subPoly v w = case compare n m of
+                LT -> G.generate m $ \i -> if i < n
+                                           then v G.! i - w G.! i
+                                           else negate (w G.! i)
+                GT -> G.generate n $ \i -> if i < m
+                                           then v G.! i - w G.! i
+                                           else v G.! i
+                EQ -> normalizePoly $ G.zipWith (-) v w
+  where n = G.length v
+        m = G.length w
+
+naiveMulPoly :: (Num a, G.Vector vec a) => vec a -> vec a -> vec a
+naiveMulPoly v w = G.generate (n + m - 1) $
+                   \i -> sum [(v G.! (i-j)) * (w G.! j) | j <- [max (i-n+1) 0..min i (m-1)]]
+  where n = G.length v
+        m = G.length w
+
+doMulP :: (Eq a, Num a, G.Vector vec a) => Int -> vec a -> vec a -> vec a
+doMulP n !v !w | n <= 16 = naiveMulPoly v w
+doMulP n !v !w
+  | G.null v = v
+  | G.null w = w
+  | G.length v < n2 = let (w0, w1) = G.splitAt n2 w
+                          u0 = doMulP n2 v w0
+                          u1 = doMulP n2 v w1
+                      in G.generate (G.length v + G.length w - 1)
+                         $ \i -> case () of
+                                   _ | i < n2     ->  u0 `at` i
+                                     | i < n      -> (u0 `at` i) + (u1 `at` (i - n2))
+                                     | i < n + n2 -> (u1 `at` (i - n2))
+  | G.length w < n2 = let (v0, v1) = G.splitAt n2 v
+                          u0 = doMulP n2 v0 w
+                          u1 = doMulP n2 v1 w
+                      in G.generate (G.length v + G.length w - 1)
+                         $ \i -> case () of
+                                   _ | i < n2     ->  u0 `at` i
+                                     | i < n      -> (u0 `at` i) + (u1 `at` (i - n2))
+                                     | i < n + n2 -> (u1 `at` (i - n2))
+  | otherwise = let (v0, v1) = G.splitAt n2 v
+                    (w0, w1) = G.splitAt n2 w
+                    v0_1 = v0 `addPoly` v1
+                    w0_1 = w0 `addPoly` w1
+                    p = doMulP n2 v0_1 w0_1
+                    q = doMulP n2 v0 w0
+                    r = doMulP n2 v1 w1
+                    -- s = (p `subPoly` q) `subPoly` r -- p - q - r
+                    -- q + s*X^n2 + r*X^n
+                in G.generate (G.length v + G.length w - 1)
+                   $ \i -> case () of
+                             _ | i < n2     ->   q `at` i
+                               | i < n      -> ((q `at` i) + (p `at` (i - n2))) - ((q `at` (i - n2)) + (r `at` (i - n2)))
+                               | i < n + n2 -> ((r `at` (i - n)) + (p `at` (i - n2))) - ((q `at` (i - n2)) + (r `at` (i - n2)))
+                               | otherwise  ->   r `at` (i - n)
+  where n2 = n `quot` 2
+        at :: (Num a, G.Vector vec a) => vec a -> Int -> a
+        at v i = if i < G.length v then v G.! i else 0
+{-# INLINE doMulP #-}
+
+mulPoly :: (Eq a, Num a, G.Vector vec a) => vec a -> vec a -> vec a
+mulPoly !v !w = let k = ceiling ((log (fromIntegral (max n m)) :: Double) / log 2) :: Int
+                in doMulP (2^k) v w
+  where n = G.length v
+        m = G.length w
+{-# INLINE mulPoly #-}
+
+zeroPoly :: (G.Vector vec a) => Poly vec a
+zeroPoly = Poly G.empty
+
+constPoly :: (Eq a, Num a, G.Vector vec a) => a -> Poly vec a
+constPoly 0 = Poly G.empty
+constPoly x = Poly (G.singleton x)
+
+scalePoly :: (Eq a, Num a, G.Vector vec a) => a -> Poly vec a -> Poly vec a
+scalePoly a (Poly xs)
+  | a == 0 = zeroPoly
+  | otherwise = Poly $ G.map (* a) xs
+
+valueAtPoly :: (Num a, G.Vector vec a) => Poly vec a -> a -> a
+valueAtPoly (Poly xs) t = G.foldr' (\a b -> a + t * b) 0 xs
+
+instance (Eq a, Num a, G.Vector vec a) => Num (Poly vec a) where
+  (+) = coerce (addPoly :: vec a -> vec a -> vec a)
+  (-) = coerce (subPoly :: vec a -> vec a -> vec a)
+  negate (Poly v) = Poly (G.map negate v)
+  (*) = coerce (mulPoly :: vec a -> vec a -> vec a)
+  fromInteger = constPoly . fromInteger
+  abs = undefined; signum = undefined
+
+divModPoly :: (Eq a, Fractional a, G.Vector vec a) => Poly vec a -> Poly vec a -> (Poly vec a, Poly vec a)
+divModPoly f g@(Poly w)
+  | G.null w = error "divModPoly: divide by zero"
+  | degree f < degree g = (zeroPoly, f)
+  | otherwise = loop zeroPoly (scalePoly (recip b) f)
+  where
+    g' = toMonic g
+    b = leadingCoefficient g
+    -- invariant: f == q * g + scalePoly b p
+    loop q p | degree p < degree g = (q, scalePoly b p)
+             | otherwise = let q' = Poly (G.drop (degree' g) (coeffAsc p))
+                           in loop (q + q') (p - q' * g')
+
+    toMonic :: (Fractional a, G.Vector vec a) => Poly vec a -> Poly vec a
+    toMonic f@(Poly xs)
+      | G.null xs = zeroPoly
+      | otherwise = Poly $ G.map (* recip (leadingCoefficient f)) xs
+
+    leadingCoefficient :: (Num a, G.Vector vec a) => Poly vec a -> a
+    leadingCoefficient (Poly xs)
+      | G.null xs = 0
+      | otherwise = G.last xs
+
+    degree :: G.Vector vec a => Poly vec a -> Maybe Int
+    degree (Poly xs) = case G.length xs - 1 of
+      -1 -> Nothing
+      n  -> Just n
+
+    degree' :: G.Vector vec a => Poly vec a -> Int
+    degree' (Poly xs) = case G.length xs of
+      0 -> error "degree': zero polynomial"
+      n -> n - 1
+
+-- 組立除法
+-- second constPoly (divModByDeg1 f t) = divMod f (Poly (G.fromList [-t, 1]))
+divModByDeg1 :: (Eq a, Num a, G.Vector vec a) => Poly vec a -> a -> (Poly vec a, a)
+divModByDeg1 f t = let w = G.postscanr (\a b -> a + b * t) 0 $ coeffAsc f
+                   in (Poly (G.tail w), G.head w)
diff --git a/atc001-c/Main.hs b/atc001-c/Main.hs
new file mode 100644
index 0000000..cac136e
--- /dev/null
+++ b/atc001-c/Main.hs
@@ -0,0 +1,224 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns          #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TypeApplications      #-}
+import           Control.Exception           (assert)
+import           Control.Monad
+import           Data.Bits
+import qualified Data.ByteString.Char8       as BS
+import           Data.Char                   (isSpace)
+import           Data.Coerce
+import           Data.Complex
+import           Data.Int                    (Int64)
+import           Data.List                   (unfoldr)
+import qualified Data.Vector.Generic         as G
+import qualified Data.Vector.Unboxed         as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+
+main = do
+  n <- readLn @Int -- n <= 10^5
+  (as,bs) <- fmap U.unzip $ U.replicateM n $ do
+    [a,b] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+    return (a,b)
+  let p, q :: Poly U.Vector Int
+      p = Poly $ normalizePoly (0 `U.cons` as)
+      q = Poly $ normalizePoly (0 `U.cons` bs)
+      -- v = coeffAsc (p * q)
+      !v = coeffAsc p `mulFFT` coeffAsc q
+      !l = U.length v
+  forM_ [1..2*n] $ \k -> do
+    print $ if k < l then
+              v U.! k
+            else
+              0
+
+--
+-- Fast Fourier Transform (FFT)
+--
+
+fft :: forall vec a. (Num a, G.Vector vec a)
+    => vec a -- ^ For a primitive n-th root of unity @u@, @[1,u,u^2 .. u^(n-1)]@
+    -> vec a -- ^ a polynomial of length n (= 2^k for some k)
+    -> vec a
+fft u f | n == 1 = f
+        | otherwise = let !n2 = n `quot` 2
+                          r0, r1', u2, t0, t1' :: vec a
+                          r0 = G.generate n2 $ \j -> (f G.! j) + (f G.! (j + n2))
+                          r1' = G.generate n2 $ \j -> ((f G.! j) - (f G.! (j + n2))) * u G.! j
+                          !u2 = G.generate n2 $ \j -> u G.! (j * 2)
+                          !t0 = fft u2 r0
+                          !t1' = fft u2 r1'
+                      in G.generate n $ \j -> if even j then t0 G.! (j `quot` 2) else t1' G.! (j `quot` 2)
+  where n = G.length f
+
+mulFFT :: U.Vector Int -> U.Vector Int -> U.Vector Int
+mulFFT !f !g = let n' = U.length f + U.length g - 2
+                   k = finiteBitSize n' - countLeadingZeros n'
+                   !_ = assert (n' < 2^k) ()
+                   n = bit k
+                   u :: U.Vector (Complex Double)
+                   u = U.generate n $ \j -> cis (fromIntegral j * (2 * pi / fromIntegral n))
+                   f' = U.generate n $ \j -> if j < U.length f then
+                                               fromIntegral (f U.! j)
+                                             else
+                                               0
+                   g' = U.generate n $ \j -> if j < U.length g then
+                                               fromIntegral (g U.! j)
+                                             else
+                                               0
+                   f'' = fft u f'
+                   g'' = fft u g'
+                   fg = U.generate n $ \j -> (f'' U.! j) * (g'' U.! j)
+                   fg' = fft (U.map conjugate u) fg
+               in U.generate n $ \j -> round (realPart (fg' U.! j) / fromIntegral n)
+
+--
+-- Univariate polynomial
+--
+
+newtype Poly vec a = Poly { coeffAsc :: vec a } deriving Eq
+
+normalizePoly :: (Eq a, Num a, G.Vector vec a) => vec a -> vec a
+normalizePoly v | G.null v || G.last v /= 0 = v
+                | otherwise = normalizePoly (G.init v)
+
+addPoly :: (Eq a, Num a, G.Vector vec a) => vec a -> vec a -> vec a
+addPoly v w = case compare n m of
+                LT -> G.generate m $ \i -> if i < n
+                                           then v G.! i + w G.! i
+                                           else w G.! i
+                GT -> G.generate n $ \i -> if i < m
+                                           then v G.! i + w G.! i
+                                           else v G.! i
+                EQ -> normalizePoly $ G.zipWith (+) v w
+  where n = G.length v
+        m = G.length w
+
+subPoly :: (Eq a, Num a, G.Vector vec a) => vec a -> vec a -> vec a
+subPoly v w = case compare n m of
+                LT -> G.generate m $ \i -> if i < n
+                                           then v G.! i - w G.! i
+                                           else negate (w G.! i)
+                GT -> G.generate n $ \i -> if i < m
+                                           then v G.! i - w G.! i
+                                           else v G.! i
+                EQ -> normalizePoly $ G.zipWith (-) v w
+  where n = G.length v
+        m = G.length w
+
+naiveMulPoly :: (Num a, G.Vector vec a) => vec a -> vec a -> vec a
+naiveMulPoly v w = G.generate (n + m - 1) $
+                   \i -> sum [(v G.! (i-j)) * (w G.! j) | j <- [max (i-n+1) 0..min i (m-1)]]
+  where n = G.length v
+        m = G.length w
+
+doMulP :: (Eq a, Num a, G.Vector vec a) => Int -> vec a -> vec a -> vec a
+doMulP n !v !w | n <= 16 = naiveMulPoly v w
+doMulP n !v !w
+  | G.null v = v
+  | G.null w = w
+  | G.length v < n2 = let (w0, w1) = G.splitAt n2 w
+                          u0 = doMulP n2 v w0
+                          u1 = doMulP n2 v w1
+                      in G.generate (G.length v + G.length w - 1)
+                         $ \i -> case () of
+                                   _ | i < n2     ->  u0 `at` i
+                                     | i < n      -> (u0 `at` i) + (u1 `at` (i - n2))
+                                     | i < n + n2 -> (u1 `at` (i - n2))
+  | G.length w < n2 = let (v0, v1) = G.splitAt n2 v
+                          u0 = doMulP n2 v0 w
+                          u1 = doMulP n2 v1 w
+                      in G.generate (G.length v + G.length w - 1)
+                         $ \i -> case () of
+                                   _ | i < n2     ->  u0 `at` i
+                                     | i < n      -> (u0 `at` i) + (u1 `at` (i - n2))
+                                     | i < n + n2 -> (u1 `at` (i - n2))
+  | otherwise = let (v0, v1) = G.splitAt n2 v
+                    (w0, w1) = G.splitAt n2 w
+                    v0_1 = v0 `addPoly` v1
+                    w0_1 = w0 `addPoly` w1
+                    p = doMulP n2 v0_1 w0_1
+                    q = doMulP n2 v0 w0
+                    r = doMulP n2 v1 w1
+                    -- s = (p `subPoly` q) `subPoly` r -- p - q - r
+                    -- q + s*X^n2 + r*X^n
+                in G.generate (G.length v + G.length w - 1)
+                   $ \i -> case () of
+                             _ | i < n2     ->   q `at` i
+                               | i < n      -> ((q `at` i) + (p `at` (i - n2))) - ((q `at` (i - n2)) + (r `at` (i - n2)))
+                               | i < n + n2 -> ((r `at` (i - n)) + (p `at` (i - n2))) - ((q `at` (i - n2)) + (r `at` (i - n2)))
+                               | otherwise  ->   r `at` (i - n)
+  where n2 = n `quot` 2
+        at :: (Num a, G.Vector vec a) => vec a -> Int -> a
+        at v i = if i < G.length v then v G.! i else 0
+{-# INLINE doMulP #-}
+
+mulPoly :: (Eq a, Num a, G.Vector vec a) => vec a -> vec a -> vec a
+mulPoly !v !w = let k = ceiling ((log (fromIntegral (max n m)) :: Double) / log 2) :: Int
+                in doMulP (2^k) v w
+  where n = G.length v
+        m = G.length w
+{-# INLINE mulPoly #-}
+
+zeroPoly :: (G.Vector vec a) => Poly vec a
+zeroPoly = Poly G.empty
+
+constPoly :: (Eq a, Num a, G.Vector vec a) => a -> Poly vec a
+constPoly 0 = Poly G.empty
+constPoly x = Poly (G.singleton x)
+
+scalePoly :: (Eq a, Num a, G.Vector vec a) => a -> Poly vec a -> Poly vec a
+scalePoly a (Poly xs)
+  | a == 0 = zeroPoly
+  | otherwise = Poly $ G.map (* a) xs
+
+valueAtPoly :: (Num a, G.Vector vec a) => Poly vec a -> a -> a
+valueAtPoly (Poly xs) t = G.foldr' (\a b -> a + t * b) 0 xs
+
+instance (Eq a, Num a, G.Vector vec a) => Num (Poly vec a) where
+  (+) = coerce (addPoly :: vec a -> vec a -> vec a)
+  (-) = coerce (subPoly :: vec a -> vec a -> vec a)
+  negate (Poly v) = Poly (G.map negate v)
+  (*) = coerce (mulPoly :: vec a -> vec a -> vec a)
+  fromInteger = constPoly . fromInteger
+  abs = undefined; signum = undefined
+
+divModPoly :: (Eq a, Fractional a, G.Vector vec a) => Poly vec a -> Poly vec a -> (Poly vec a, Poly vec a)
+divModPoly f g@(Poly w)
+  | G.null w = error "divModPoly: divide by zero"
+  | degree f < degree g = (zeroPoly, f)
+  | otherwise = loop zeroPoly (scalePoly (recip b) f)
+  where
+    g' = toMonic g
+    b = leadingCoefficient g
+    -- invariant: f == q * g + scalePoly b p
+    loop q p | degree p < degree g = (q, scalePoly b p)
+             | otherwise = let q' = Poly (G.drop (degree' g) (coeffAsc p))
+                           in loop (q + q') (p - q' * g')
+
+    toMonic :: (Fractional a, G.Vector vec a) => Poly vec a -> Poly vec a
+    toMonic f@(Poly xs)
+      | G.null xs = zeroPoly
+      | otherwise = Poly $ G.map (* recip (leadingCoefficient f)) xs
+
+    leadingCoefficient :: (Num a, G.Vector vec a) => Poly vec a -> a
+    leadingCoefficient (Poly xs)
+      | G.null xs = 0
+      | otherwise = G.last xs
+
+    degree :: G.Vector vec a => Poly vec a -> Maybe Int
+    degree (Poly xs) = case G.length xs - 1 of
+      -1 -> Nothing
+      n  -> Just n
+
+    degree' :: G.Vector vec a => Poly vec a -> Int
+    degree' (Poly xs) = case G.length xs of
+      0 -> error "degree': zero polynomial"
+      n -> n - 1
+
+-- 組立除法
+-- second constPoly (divModByDeg1 f t) = divMod f (Poly (G.fromList [-t, 1]))
+divModByDeg1 :: (Eq a, Num a, G.Vector vec a) => Poly vec a -> a -> (Poly vec a, a)
+divModByDeg1 f t = let w = G.postscanr (\a b -> a + b * t) 0 $ coeffAsc f
+                   in (Poly (G.tail w), G.head w)

From 2eca7181d8ffd9d3d669c8cfcd2aafb843212bc5 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Tue, 19 Jan 2021 13:56:48 +0900
Subject: [PATCH 134/148] Update stack.yaml

---
 stack.yaml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/stack.yaml b/stack.yaml
index fff9875..4f224b4 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -17,7 +17,7 @@
 #
 # resolver: ./custom-snapshot.yaml
 # resolver: https://example.com/snapshots/2018-01-01.yaml
-resolver: lts-13.6
+resolver: lts-16.31
 
 # User packages to be built.
 # Various formats can be used as shown in the example below.

From a8bf0657e1766e9dca14dcd0eb62fb420b618b20 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Tue, 19 Jan 2021 13:57:36 +0900
Subject: [PATCH 135/148] Enable more packages

---
 package.yaml | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/package.yaml b/package.yaml
index 1cdaab7..7be3e6a 100644
--- a/package.yaml
+++ b/package.yaml
@@ -27,7 +27,12 @@ dependencies:
 - mtl
 - bytestring
 - text
+- deepseq
 - primitive
+- reflection
+- unboxing-vector
+- vector-algorithms
+- QuickCheck
 
 ghc-options:
 # Maximum heap size: 1GiB

From 01029b47f2cc8f937ba41f05c17cf39214c96f44 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Thu, 21 Jan 2021 23:58:55 +0900
Subject: [PATCH 136/148] ATC001-C: Implement NTT

---
 atc001-c/Main.hs       |  30 +--
 atc001-c/NTT.hs        | 432 +++++++++++++++++++++++++++++++++++++++++
 atc001-c/PrepareNTT.hs | 324 +++++++++++++++++++++++++++++++
 3 files changed, 773 insertions(+), 13 deletions(-)
 create mode 100644 atc001-c/NTT.hs
 create mode 100644 atc001-c/PrepareNTT.hs

diff --git a/atc001-c/Main.hs b/atc001-c/Main.hs
index cac136e..410b20e 100644
--- a/atc001-c/Main.hs
+++ b/atc001-c/Main.hs
@@ -37,19 +37,22 @@ main = do
 -- Fast Fourier Transform (FFT)
 --
 
+halve :: G.Vector vec a => vec a -> vec a
+halve v = let n = G.length v
+          in G.generate (n `quot` 2) $ \j -> v G.! (j * 2)
+
 fft :: forall vec a. (Num a, G.Vector vec a)
-    => vec a -- ^ For a primitive n-th root of unity @u@, @[1,u,u^2 .. u^(n-1)]@
+    => [vec a] -- ^ For a primitive n-th root of unity @u@, @iterate halve [1,u,u^2 .. u^(n-1)]@
     -> vec a -- ^ a polynomial of length n (= 2^k for some k)
     -> vec a
-fft u f | n == 1 = f
-        | otherwise = let !n2 = n `quot` 2
-                          r0, r1', u2, t0, t1' :: vec a
-                          r0 = G.generate n2 $ \j -> (f G.! j) + (f G.! (j + n2))
-                          r1' = G.generate n2 $ \j -> ((f G.! j) - (f G.! (j + n2))) * u G.! j
-                          !u2 = G.generate n2 $ \j -> u G.! (j * 2)
-                          !t0 = fft u2 r0
-                          !t1' = fft u2 r1'
-                      in G.generate n $ \j -> if even j then t0 G.! (j `quot` 2) else t1' G.! (j `quot` 2)
+fft (u:u2) f | n == 1 = f
+             | otherwise = let !n2 = n `quot` 2
+                               r0, r1', t0, t1' :: vec a
+                               r0 = G.generate n2 $ \j -> (f G.! j) + (f G.! (j + n2))
+                               r1' = G.generate n2 $ \j -> ((f G.! j) - (f G.! (j + n2))) * u G.! j
+                               !t0 = fft u2 r0
+                               !t1' = fft u2 r1'
+                           in G.generate n $ \j -> if even j then t0 G.! (j `quot` 2) else t1' G.! (j `quot` 2)
   where n = G.length f
 
 mulFFT :: U.Vector Int -> U.Vector Int -> U.Vector Int
@@ -59,6 +62,7 @@ mulFFT !f !g = let n' = U.length f + U.length g - 2
                    n = bit k
                    u :: U.Vector (Complex Double)
                    u = U.generate n $ \j -> cis (fromIntegral j * (2 * pi / fromIntegral n))
+                   us = iterate halve u
                    f' = U.generate n $ \j -> if j < U.length f then
                                                fromIntegral (f U.! j)
                                              else
@@ -67,10 +71,10 @@ mulFFT !f !g = let n' = U.length f + U.length g - 2
                                                fromIntegral (g U.! j)
                                              else
                                                0
-                   f'' = fft u f'
-                   g'' = fft u g'
+                   f'' = fft us f'
+                   g'' = fft us g'
                    fg = U.generate n $ \j -> (f'' U.! j) * (g'' U.! j)
-                   fg' = fft (U.map conjugate u) fg
+                   fg' = fft (map (U.map conjugate) us) fg
                in U.generate n $ \j -> round (realPart (fg' U.! j) / fromIntegral n)
 
 --
diff --git a/atc001-c/NTT.hs b/atc001-c/NTT.hs
new file mode 100644
index 0000000..23f7ecc
--- /dev/null
+++ b/atc001-c/NTT.hs
@@ -0,0 +1,432 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns               #-}
+{-# LANGUAGE DataKinds                  #-}
+{-# LANGUAGE DerivingStrategies         #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE NoStarIsType               #-}
+{-# LANGUAGE ScopedTypeVariables        #-}
+{-# LANGUAGE TypeApplications           #-}
+{-# LANGUAGE TypeFamilies               #-}
+{-# LANGUAGE TypeOperators              #-}
+{-# LANGUAGE UndecidableInstances       #-}
+import           Control.Exception            (assert)
+import           Control.Monad
+import           Data.Bits
+import qualified Data.ByteString.Char8        as BS
+import           Data.Char                    (isSpace)
+import           Data.Coerce
+import           Data.Complex
+import           Data.Int                     (Int64)
+import           Data.List                    (unfoldr)
+import           Data.Proxy
+import qualified Data.Vector.Generic          as G
+import qualified Data.Vector.Unboxing         as U
+import qualified Data.Vector.Unboxing.Mutable as UM
+import           GHC.TypeNats                 (type (*), type (+), KnownNat,
+                                               Nat, SomeNat (..), type (^),
+                                               natVal, someNatVal)
+import qualified Test.QuickCheck              as QC
+
+main = do
+  n <- readLn @Int -- n <= 10^5
+  (as,bs) <- fmap U.unzip $ U.replicateM n $ do
+    [a,b] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+    -- a <= 100, b <= 100
+    return (a,b)
+  let p, q :: Poly U.Vector Int
+      p = Poly $ normalizePoly (0 `U.cons` as)
+      q = Poly $ normalizePoly (0 `U.cons` bs)
+      -- v = coeffAsc (p * q)
+      !v = coeffAsc p `mulFFTInt` coeffAsc q
+      !l = U.length v
+  forM_ [1..2*n] $ \k -> do
+    print $ if k < l then
+              v U.! k -- <= 10^9
+            else
+              0
+
+--
+-- Fast Fourier Transform (FFT)
+--
+
+halve :: G.Vector vec a => vec a -> vec a
+halve v = let n = G.length v
+          in G.generate (n `quot` 2) $ \j -> v G.! (j * 2)
+
+fft :: forall vec a. (Num a, G.Vector vec a)
+    => [vec a] -- ^ For a primitive n-th root of unity @u@, @iterate halve [1,u,u^2 .. u^(n-1)]@
+    -> vec a -- ^ a polynomial of length n (= 2^k for some k)
+    -> vec a
+fft (u:u2) f | n == 1 = f
+             | otherwise = let !n2 = n `quot` 2
+                               r0, r1', t0, t1' :: vec a
+                               r0 = G.generate n2 $ \j -> (f G.! j) + (f G.! (j + n2))
+                               r1' = G.generate n2 $ \j -> ((f G.! j) - (f G.! (j + n2))) * u G.! j
+                               !t0 = fft u2 r0
+                               !t1' = fft u2 r1'
+                           in G.generate n $ \j -> if even j then t0 G.! (j `quot` 2) else t1' G.! (j `quot` 2)
+  where n = G.length f
+
+mulFFT :: forall a. (U.Unboxable a, Fractional a, PrimitiveRoot a) => U.Vector a -> U.Vector a -> U.Vector a
+mulFFT !f !g = let n' = U.length f + U.length g - 2
+                   k = finiteBitSize n' - countLeadingZeros n'
+                   !_ = assert (n' < 2^k) ()
+                   n = bit k
+                   u0 = nthRoot n
+                   u :: U.Vector a
+                   u = U.iterateN n (* u0) 1
+                   us = iterate halve u
+                   f' = U.generate n $ \j -> if j < U.length f then
+                                               f U.! j
+                                             else
+                                               0
+                   g' = U.generate n $ \j -> if j < U.length g then
+                                               g U.! j
+                                             else
+                                               0
+                   f'' = fft us f'
+                   g'' = fft us g'
+                   v0 = recip u0
+                   v :: U.Vector a
+                   v = U.iterateN n (* v0) 1
+                   fg = U.generate n $ \j -> (f'' U.! j) * (g'' U.! j)
+                   fg' = fft (iterate halve v) fg
+               in U.generate n $ \j -> (fg' U.! j) / fromIntegral n
+
+{-
+mulFFTInt :: U.Vector Int -> U.Vector Int -> U.Vector Int64
+mulFFTInt f g = let f1 = U.map fromIntegral f :: U.Vector R1
+                    g1 = U.map fromIntegral g :: U.Vector R1
+                    !h1 = mulFFT f1 g1
+                    f2 = U.map fromIntegral f :: U.Vector R2
+                    g2 = U.map fromIntegral g :: U.Vector R2
+                    !h2 = mulFFT f2 g2
+                in U.generate (U.length h1) $ \i -> case crt' (unwrapR1 $ h1 U.! i) (unwrapR2 $ h2 U.! i) of
+                                                      IntMod x -> x
+-}
+
+mulFFTInt :: U.Vector Int -> U.Vector Int -> U.Vector Int64
+mulFFTInt f g = let f' = U.map fromIntegral f :: U.Vector R5
+                    g' = U.map fromIntegral g :: U.Vector R5
+                in U.map (\(R5 (IntMod x)) -> x) (mulFFT f' g')
+
+class PrimitiveRoot a where
+  -- (nthRoot n)^n == 1
+  -- (nthRoot (2 * m))^m == -1
+  nthRoot :: Int -> a
+
+order' :: (Eq a, Num a) => Int -> a -> Int
+order' !m !x = go 1 x
+  where
+    go !n 1 = n
+    go !n y | n > m = m + 1
+    go !n y = go (n + 1) (x * y)
+
+findPrimitiveNthRoot :: (Eq a, Num a) => Int -> a
+findPrimitiveNthRoot n = head [ x | k <- [1..], let x = fromInteger k, order' n x == n ]
+
+newtype R1 = R1 { unwrapR1 :: IntMod (5 * 2^25 + 1) } deriving newtype (Eq, Show, Num, Fractional, U.Unboxable)
+
+instance PrimitiveRoot R1 where
+  nthRoot n | (5 * 2^25) `rem` n /= 0 = error "nthRoot: does not exist"
+            | n .&. (n - 1) == 0 = let k = round (log (fromIntegral n) / log 2) :: Int
+                                   in 17 ^ (2^(25 - k) :: Int)
+            | otherwise = error "nthRoot: not implemented"
+
+newtype R2 = R2 { unwrapR2 :: IntMod (7 * 2^26 + 1) } deriving newtype (Eq, Show, Num, Fractional, U.Unboxable)
+
+instance PrimitiveRoot R2 where
+  nthRoot n | (7 * 2^26) `rem` n /= 0 = error "nthRoot: does not exist"
+            | n .&. (n - 1) == 0 = let k = round (log (fromIntegral n) / log 2) :: Int
+                                   in 30 ^ (2^(26 - k) :: Int)
+            | otherwise = error "nthRoot: not implemented"
+
+newtype R5 = R5 { unwrapR5 :: IntMod (483 * 2^21 + 1) } deriving newtype (Eq, Show, Num, Fractional, U.Unboxable)
+
+instance PrimitiveRoot R5 where
+  nthRoot n | (483 * 2^21) `rem` n /= 0 = error "nthRoot: does not exist"
+            | n .&. (n - 1) == 0 = let k = round (log (fromIntegral n) / log 2) :: Int
+                                   in 198 ^ (2^(21 - k) :: Int)
+            | otherwise = error "nthRoot: not implemented"
+
+{-# RULES
+"fromIntegral/Int->R1" fromIntegral = R1 . fromIntegral_Int64_IntMod . (fromIntegral :: Int -> Int64)
+"fromIntegral/Int64->R1" fromIntegral = R1 . fromIntegral_Int64_IntMod
+"fromIntegral/Int->R2" fromIntegral = R2 . fromIntegral_Int64_IntMod . (fromIntegral :: Int -> Int64)
+"fromIntegral/Int64->R2" fromIntegral = R2 . fromIntegral_Int64_IntMod
+"fromIntegral/Int->R5" fromIntegral = R5 . fromIntegral_Int64_IntMod . (fromIntegral :: Int -> Int64)
+"fromIntegral/Int64->R5" fromIntegral = R5 . fromIntegral_Int64_IntMod
+ #-}
+
+--
+-- Univariate polynomial
+--
+
+newtype Poly vec a = Poly { coeffAsc :: vec a } deriving Eq
+
+normalizePoly :: (Eq a, Num a, G.Vector vec a) => vec a -> vec a
+normalizePoly v | G.null v || G.last v /= 0 = v
+                | otherwise = normalizePoly (G.init v)
+
+addPoly :: (Eq a, Num a, G.Vector vec a) => vec a -> vec a -> vec a
+addPoly v w = case compare n m of
+                LT -> G.generate m $ \i -> if i < n
+                                           then v G.! i + w G.! i
+                                           else w G.! i
+                GT -> G.generate n $ \i -> if i < m
+                                           then v G.! i + w G.! i
+                                           else v G.! i
+                EQ -> normalizePoly $ G.zipWith (+) v w
+  where n = G.length v
+        m = G.length w
+
+subPoly :: (Eq a, Num a, G.Vector vec a) => vec a -> vec a -> vec a
+subPoly v w = case compare n m of
+                LT -> G.generate m $ \i -> if i < n
+                                           then v G.! i - w G.! i
+                                           else negate (w G.! i)
+                GT -> G.generate n $ \i -> if i < m
+                                           then v G.! i - w G.! i
+                                           else v G.! i
+                EQ -> normalizePoly $ G.zipWith (-) v w
+  where n = G.length v
+        m = G.length w
+
+naiveMulPoly :: (Num a, G.Vector vec a) => vec a -> vec a -> vec a
+naiveMulPoly v w = G.generate (n + m - 1) $
+                   \i -> sum [(v G.! (i-j)) * (w G.! j) | j <- [max (i-n+1) 0..min i (m-1)]]
+  where n = G.length v
+        m = G.length w
+
+doMulP :: (Eq a, Num a, G.Vector vec a) => Int -> vec a -> vec a -> vec a
+doMulP n !v !w | n <= 16 = naiveMulPoly v w
+doMulP n !v !w
+  | G.null v = v
+  | G.null w = w
+  | G.length v < n2 = let (w0, w1) = G.splitAt n2 w
+                          u0 = doMulP n2 v w0
+                          u1 = doMulP n2 v w1
+                      in G.generate (G.length v + G.length w - 1)
+                         $ \i -> case () of
+                                   _ | i < n2     ->  u0 `at` i
+                                     | i < n      -> (u0 `at` i) + (u1 `at` (i - n2))
+                                     | i < n + n2 -> (u1 `at` (i - n2))
+  | G.length w < n2 = let (v0, v1) = G.splitAt n2 v
+                          u0 = doMulP n2 v0 w
+                          u1 = doMulP n2 v1 w
+                      in G.generate (G.length v + G.length w - 1)
+                         $ \i -> case () of
+                                   _ | i < n2     ->  u0 `at` i
+                                     | i < n      -> (u0 `at` i) + (u1 `at` (i - n2))
+                                     | i < n + n2 -> (u1 `at` (i - n2))
+  | otherwise = let (v0, v1) = G.splitAt n2 v
+                    (w0, w1) = G.splitAt n2 w
+                    v0_1 = v0 `addPoly` v1
+                    w0_1 = w0 `addPoly` w1
+                    p = doMulP n2 v0_1 w0_1
+                    q = doMulP n2 v0 w0
+                    r = doMulP n2 v1 w1
+                    -- s = (p `subPoly` q) `subPoly` r -- p - q - r
+                    -- q + s*X^n2 + r*X^n
+                in G.generate (G.length v + G.length w - 1)
+                   $ \i -> case () of
+                             _ | i < n2     ->   q `at` i
+                               | i < n      -> ((q `at` i) + (p `at` (i - n2))) - ((q `at` (i - n2)) + (r `at` (i - n2)))
+                               | i < n + n2 -> ((r `at` (i - n)) + (p `at` (i - n2))) - ((q `at` (i - n2)) + (r `at` (i - n2)))
+                               | otherwise  ->   r `at` (i - n)
+  where n2 = n `quot` 2
+        at :: (Num a, G.Vector vec a) => vec a -> Int -> a
+        at v i = if i < G.length v then v G.! i else 0
+{-# INLINE doMulP #-}
+
+mulPoly :: (Eq a, Num a, G.Vector vec a) => vec a -> vec a -> vec a
+mulPoly !v !w = let k = ceiling ((log (fromIntegral (max n m)) :: Double) / log 2) :: Int
+                in doMulP (2^k) v w
+  where n = G.length v
+        m = G.length w
+{-# INLINE mulPoly #-}
+
+zeroPoly :: (G.Vector vec a) => Poly vec a
+zeroPoly = Poly G.empty
+
+constPoly :: (Eq a, Num a, G.Vector vec a) => a -> Poly vec a
+constPoly 0 = Poly G.empty
+constPoly x = Poly (G.singleton x)
+
+scalePoly :: (Eq a, Num a, G.Vector vec a) => a -> Poly vec a -> Poly vec a
+scalePoly a (Poly xs)
+  | a == 0 = zeroPoly
+  | otherwise = Poly $ G.map (* a) xs
+
+valueAtPoly :: (Num a, G.Vector vec a) => Poly vec a -> a -> a
+valueAtPoly (Poly xs) t = G.foldr' (\a b -> a + t * b) 0 xs
+
+instance (Eq a, Num a, G.Vector vec a) => Num (Poly vec a) where
+  (+) = coerce (addPoly :: vec a -> vec a -> vec a)
+  (-) = coerce (subPoly :: vec a -> vec a -> vec a)
+  negate (Poly v) = Poly (G.map negate v)
+  (*) = coerce (mulPoly :: vec a -> vec a -> vec a)
+  fromInteger = constPoly . fromInteger
+  abs = undefined; signum = undefined
+
+divModPoly :: (Eq a, Fractional a, G.Vector vec a) => Poly vec a -> Poly vec a -> (Poly vec a, Poly vec a)
+divModPoly f g@(Poly w)
+  | G.null w = error "divModPoly: divide by zero"
+  | degree f < degree g = (zeroPoly, f)
+  | otherwise = loop zeroPoly (scalePoly (recip b) f)
+  where
+    g' = toMonic g
+    b = leadingCoefficient g
+    -- invariant: f == q * g + scalePoly b p
+    loop q p | degree p < degree g = (q, scalePoly b p)
+             | otherwise = let q' = Poly (G.drop (degree' g) (coeffAsc p))
+                           in loop (q + q') (p - q' * g')
+
+    toMonic :: (Fractional a, G.Vector vec a) => Poly vec a -> Poly vec a
+    toMonic f@(Poly xs)
+      | G.null xs = zeroPoly
+      | otherwise = Poly $ G.map (* recip (leadingCoefficient f)) xs
+
+    leadingCoefficient :: (Num a, G.Vector vec a) => Poly vec a -> a
+    leadingCoefficient (Poly xs)
+      | G.null xs = 0
+      | otherwise = G.last xs
+
+    degree :: G.Vector vec a => Poly vec a -> Maybe Int
+    degree (Poly xs) = case G.length xs - 1 of
+      -1 -> Nothing
+      n  -> Just n
+
+    degree' :: G.Vector vec a => Poly vec a -> Int
+    degree' (Poly xs) = case G.length xs of
+      0 -> error "degree': zero polynomial"
+      n -> n - 1
+
+-- 組立除法
+-- second constPoly (divModByDeg1 f t) = divMod f (Poly (G.fromList [-t, 1]))
+divModByDeg1 :: (Eq a, Num a, G.Vector vec a) => Poly vec a -> a -> (Poly vec a, a)
+divModByDeg1 f t = let w = G.postscanr (\a b -> a + b * t) 0 $ coeffAsc f
+                   in (Poly (G.tail w), G.head w)
+
+--
+-- Modular Arithmetic
+--
+
+newtype IntMod (m :: Nat) = IntMod { unwrapN :: Int64 } deriving (Eq)
+
+instance Show (IntMod m) where
+  show (IntMod x) = show x
+
+instance KnownNat m => Num (IntMod m) where
+  t@(IntMod x) + IntMod y
+    | x + y >= modulus = IntMod (x + y - modulus)
+    | otherwise = IntMod (x + y)
+    where modulus = fromIntegral (natVal t)
+  t@(IntMod x) - IntMod y
+    | x >= y = IntMod (x - y)
+    | otherwise = IntMod (x - y + modulus)
+    where modulus = fromIntegral (natVal t)
+  t@(IntMod x) * IntMod y = IntMod ((x * y) `rem` modulus)
+    where modulus = fromIntegral (natVal t)
+  fromInteger n = let result = IntMod (fromInteger (n `mod` fromIntegral modulus))
+                      modulus = natVal result
+                  in result
+  abs = undefined; signum = undefined
+
+{-# RULES
+"^9/Int" forall x. x ^ (9 :: Int) = let u = x; v = u * u * u in v * v * v
+"^9/Integer" forall x. x ^ (9 :: Integer) = let u = x; v = u * u * u in v * v * v
+ #-}
+
+fromIntegral_Int64_IntMod :: KnownNat m => Int64 -> IntMod m
+fromIntegral_Int64_IntMod n = result
+  where
+    result | 0 <= n && n < modulus = IntMod n
+           | otherwise = IntMod (n `mod` modulus)
+    modulus = fromIntegral (natVal result)
+
+{-# RULES
+"fromIntegral/Int->IntMod" fromIntegral = fromIntegral_Int64_IntMod . (fromIntegral :: Int -> Int64) :: Int -> IntMod (10^9 + 7)
+"fromIntegral/Int64->IntMod" fromIntegral = fromIntegral_Int64_IntMod :: Int64 -> IntMod (10^9 + 7)
+ #-}
+
+instance U.Unboxable (IntMod m) where
+  type Rep (IntMod m) = Int64
+
+exEuclid :: (Eq a, Integral a) => a -> a -> (a, a, a)
+exEuclid !f !g = loop 1 0 0 1 f g
+  where loop !u0 !u1 !v0 !v1 !f 0 = (f, u0, v0)
+        loop !u0 !u1 !v0 !v1 !f g =
+          case divMod f g of
+            (q,r) -> loop u1 (u0 - q * u1) v1 (v0 - q * v1) g r
+
+instance KnownNat m => Fractional (IntMod m) where
+  recip t@(IntMod x) = IntMod $ case exEuclid x modulus of
+    (1,a,_)  -> a `mod` modulus
+    (-1,a,_) -> (-a) `mod` modulus
+    _        -> error "not invertible"
+    where modulus = fromIntegral (natVal t)
+  fromRational = undefined
+
+recipM :: (Eq a, Integral a, Show a) => a -> a -> a
+recipM !x modulo = case exEuclid x modulo of
+                     (1,a,_) -> a `mod` modulo
+                     (-1,a,_) -> (-a) `mod` modulo
+                     (g,a,b) -> error $ show x ++ "^(-1) mod " ++ show modulo ++ " failed: gcd=" ++ show g
+
+-- |
+-- >>> crt 3 6 2 7
+-- 9
+-- >>> crt 2 5 3 9
+-- 12
+crt :: (Eq a, Integral a, Show a) => a -> a -> a -> a -> a
+crt !a1 !m1 !a2 !m2 = let m1' = recipM m1 m2
+                          m2' = recipM m2 m1
+                          mm = m1 * m2
+                      in
+                        fromInteger ((toInteger m2 * toInteger m2' * toInteger a1 + toInteger m1 * toInteger m1' * toInteger a2) `mod` toInteger mm)
+                        -- (m2 * m2' * a1 + m1 * m1' * a2) `mod` mm
+                        -- ((m2 * m2' `mod` mm) * (a1 `mod` m1) `mod` mm + (m1 * m1' `mod` mm) * (a2 `mod` m2) `mod` mm) `mod` mm
+
+crt' :: (KnownNat m1, KnownNat m2) => IntMod m1 -> IntMod m2 -> IntMod (m1 * m2)
+crt' x1@(IntMod a1) x2@(IntMod !a2) = let m1, m2, m1', m2' :: Int64
+                                          m1 = fromIntegral (natVal x1)
+                                          m2 = fromIntegral (natVal x2)
+                                          m1' = recipM m1 m2
+                                          m2' = recipM m2 m1
+                                      in IntMod (fromInteger ((toInteger m2 * toInteger m2' * toInteger a1 + toInteger m1 * toInteger m1' * toInteger a2) `mod` (toInteger m1 * toInteger m2)))
+
+--
+-- Tests
+--
+
+instance KnownNat m => QC.Arbitrary (IntMod m) where
+  arbitrary = IntMod <$> QC.choose (0, m - 1)
+    where
+      m = fromIntegral (natVal (Proxy :: Proxy m))
+
+runTests :: IO ()
+runTests = do
+  QC.quickCheck $ QC.forAll (QC.choose (2, 10^9+9)) $ \m x -> prop_recipM x (QC.Positive m)
+  QC.quickCheck $ QC.forAll (QC.choose (2, 10^9+9)) $ \m1 -> QC.forAll (QC.choose (2, 10^9+9)) $ \m2 x y -> prop_crt x (QC.Positive m1) y (QC.Positive m2)
+  QC.quickCheck $ QC.forAll (QC.choose (2, 10^9+9)) $ \m1 -> QC.forAll (QC.choose (2, 10^9+9)) $ \m2 x y -> prop_crt' x (QC.Positive m1) y (QC.Positive m2)
+
+prop_recipM :: Int64 -> QC.Positive Int64 -> QC.Property
+prop_recipM x (QC.Positive m) = gcd x m == 1 && m > 1 && m <= 10^9 + 9 QC.==>
+  let y = recipM x m
+  in 0 <= y QC..&&. y < m QC..&&. ((x `mod` m) * recipM x m) `mod` m QC.=== 1
+
+prop_crt :: Int64 -> QC.Positive Int64 -> Int64 -> QC.Positive Int64 -> QC.Property
+prop_crt a1 (QC.Positive m1) a2 (QC.Positive m2)
+  = gcd m1 m2 == 1 QC.==> let r = crt a1 m1 a2 m2
+                          in r `mod` m1 QC.=== a1 `mod` m1 QC..&&. r `mod` m2 QC.=== a2 `mod` m2
+
+prop_crt' :: Int64 -> QC.Positive Int64 -> Int64 -> QC.Positive Int64 -> QC.Property
+prop_crt' a1 (QC.Positive m1) a2 (QC.Positive m2)
+  = gcd m1 m2 == 1 QC.==> case (someNatVal (fromIntegral m1), someNatVal (fromIntegral m2)) of
+                            (SomeNat (Proxy :: Proxy m1), SomeNat (Proxy :: Proxy m2)) ->
+                              let x = fromIntegral a1 :: IntMod m1
+                                  y = fromIntegral a2 :: IntMod m2
+                                  IntMod r = crt' x y
+                              in r `mod` m1 QC.=== a1 `mod` m1 QC..&&. r `mod` m2 QC.=== a2 `mod` m2
diff --git a/atc001-c/PrepareNTT.hs b/atc001-c/PrepareNTT.hs
new file mode 100644
index 0000000..21c2684
--- /dev/null
+++ b/atc001-c/PrepareNTT.hs
@@ -0,0 +1,324 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns          #-}
+{-# LANGUAGE DataKinds             #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NoStarIsType          #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TypeApplications      #-}
+{-# LANGUAGE TypeFamilies          #-}
+{-# LANGUAGE TypeOperators         #-}
+import           Control.Exception           (assert)
+import           Control.Monad
+import           Data.Bits
+import qualified Data.ByteString.Char8       as BS
+import           Data.Char                   (isSpace)
+import           Data.Coerce
+import           Data.Complex
+import           Data.Int                    (Int64)
+import           Data.List                   (unfoldr)
+import qualified Data.Vector.Generic         as G
+import qualified Data.Vector.Unboxing         as U
+import qualified Data.Vector.Unboxing.Mutable as UM
+import           GHC.TypeNats                (type (+), type (*), KnownNat, Nat, type (^),
+                                              natVal)
+
+type R1 = IntMod (5 * 2^25 + 1)
+type R2 = IntMod (7 * 2^26 + 1)
+type R3 = IntMod (3 * 2^18 + 1)
+type R4 = IntMod (7 * 2^20 + 1)
+type R5 = IntMod (483 * 2^21 + 1)
+
+order :: (Num a, Eq a) => a -> Int
+order !x = go 1 x
+  where
+    go !n 1 = n
+    go !n y = go (n + 1) (x * y)
+
+order' :: (Num a, Eq a) => Int -> a -> Int
+order' !m !x = go 1 x
+  where
+    go !n 1 = n
+    go !n y | n > m = m + 1
+    go !n y = go (n + 1) (x * y)
+
+findPrimitiveNthRoot :: (Num a, Eq a) => Int -> a
+findPrimitiveNthRoot n = head [ x | k <- [1..], let x = fromInteger k, order' n x == n ]
+
+main = do
+  -- print (findPrimitiveNthRoot 2)
+  -- print (findPrimitiveNthRoot (2^10))
+  print (findPrimitiveNthRoot (2^25) :: R1) -- 17 mod 5 * 2^25 + 1
+  print (findPrimitiveNthRoot (2^26) :: R2) -- 30 mod 7 * 2^26 + 1
+  print (findPrimitiveNthRoot (2^18) :: R3) -- 5 mod 3 * 2^18 + 1
+  print (findPrimitiveNthRoot (2^20) :: R4) -- 5 mod 7 * 2^20 + 1
+  print (findPrimitiveNthRoot (2^21) :: R5) -- 198 mod 483 * 2^21 + 1
+
+--
+-- Fast Fourier Transform (FFT)
+--
+
+halve :: G.Vector vec a => vec a -> vec a
+halve v = let n = G.length v
+          in G.generate (n `quot` 2) $ \j -> v G.! (j * 2)
+
+fft :: forall vec a. (Num a, G.Vector vec a)
+    => [vec a] -- ^ For a primitive n-th root of unity @u@, @iterate halve [1,u,u^2 .. u^(n-1)]@
+    -> vec a -- ^ a polynomial of length n (= 2^k for some k)
+    -> vec a
+fft (u:u2) f | n == 1 = f
+             | otherwise = let !n2 = n `quot` 2
+                               r0, r1', t0, t1' :: vec a
+                               r0 = G.generate n2 $ \j -> (f G.! j) + (f G.! (j + n2))
+                               r1' = G.generate n2 $ \j -> ((f G.! j) - (f G.! (j + n2))) * u G.! j
+                               !t0 = fft u2 r0
+                               !t1' = fft u2 r1'
+                           in G.generate n $ \j -> if even j then t0 G.! (j `quot` 2) else t1' G.! (j `quot` 2)
+  where n = G.length f
+
+mulFFT :: U.Vector Int -> U.Vector Int -> U.Vector Int
+mulFFT !f !g = let n' = U.length f + U.length g - 2
+                   k = finiteBitSize n' - countLeadingZeros n'
+                   !_ = assert (n' < 2^k) ()
+                   n = bit k
+                   u :: U.Vector (Complex Double)
+                   u = U.generate n $ \j -> cis (fromIntegral j * (2 * pi / fromIntegral n))
+                   us = iterate halve u
+                   f' = U.generate n $ \j -> if j < U.length f then
+                                               fromIntegral (f U.! j)
+                                             else
+                                               0
+                   g' = U.generate n $ \j -> if j < U.length g then
+                                               fromIntegral (g U.! j)
+                                             else
+                                               0
+                   f'' = fft us f'
+                   g'' = fft us g'
+                   fg = U.generate n $ \j -> (f'' U.! j) * (g'' U.! j)
+                   fg' = fft (map (U.map conjugate) us) fg
+               in U.generate n $ \j -> round (realPart (fg' U.! j) / fromIntegral n)
+
+--
+-- Univariate polynomial
+--
+
+newtype Poly vec a = Poly { coeffAsc :: vec a } deriving Eq
+
+normalizePoly :: (Eq a, Num a, G.Vector vec a) => vec a -> vec a
+normalizePoly v | G.null v || G.last v /= 0 = v
+                | otherwise = normalizePoly (G.init v)
+
+addPoly :: (Eq a, Num a, G.Vector vec a) => vec a -> vec a -> vec a
+addPoly v w = case compare n m of
+                LT -> G.generate m $ \i -> if i < n
+                                           then v G.! i + w G.! i
+                                           else w G.! i
+                GT -> G.generate n $ \i -> if i < m
+                                           then v G.! i + w G.! i
+                                           else v G.! i
+                EQ -> normalizePoly $ G.zipWith (+) v w
+  where n = G.length v
+        m = G.length w
+
+subPoly :: (Eq a, Num a, G.Vector vec a) => vec a -> vec a -> vec a
+subPoly v w = case compare n m of
+                LT -> G.generate m $ \i -> if i < n
+                                           then v G.! i - w G.! i
+                                           else negate (w G.! i)
+                GT -> G.generate n $ \i -> if i < m
+                                           then v G.! i - w G.! i
+                                           else v G.! i
+                EQ -> normalizePoly $ G.zipWith (-) v w
+  where n = G.length v
+        m = G.length w
+
+naiveMulPoly :: (Num a, G.Vector vec a) => vec a -> vec a -> vec a
+naiveMulPoly v w = G.generate (n + m - 1) $
+                   \i -> sum [(v G.! (i-j)) * (w G.! j) | j <- [max (i-n+1) 0..min i (m-1)]]
+  where n = G.length v
+        m = G.length w
+
+doMulP :: (Eq a, Num a, G.Vector vec a) => Int -> vec a -> vec a -> vec a
+doMulP n !v !w | n <= 16 = naiveMulPoly v w
+doMulP n !v !w
+  | G.null v = v
+  | G.null w = w
+  | G.length v < n2 = let (w0, w1) = G.splitAt n2 w
+                          u0 = doMulP n2 v w0
+                          u1 = doMulP n2 v w1
+                      in G.generate (G.length v + G.length w - 1)
+                         $ \i -> case () of
+                                   _ | i < n2     ->  u0 `at` i
+                                     | i < n      -> (u0 `at` i) + (u1 `at` (i - n2))
+                                     | i < n + n2 -> (u1 `at` (i - n2))
+  | G.length w < n2 = let (v0, v1) = G.splitAt n2 v
+                          u0 = doMulP n2 v0 w
+                          u1 = doMulP n2 v1 w
+                      in G.generate (G.length v + G.length w - 1)
+                         $ \i -> case () of
+                                   _ | i < n2     ->  u0 `at` i
+                                     | i < n      -> (u0 `at` i) + (u1 `at` (i - n2))
+                                     | i < n + n2 -> (u1 `at` (i - n2))
+  | otherwise = let (v0, v1) = G.splitAt n2 v
+                    (w0, w1) = G.splitAt n2 w
+                    v0_1 = v0 `addPoly` v1
+                    w0_1 = w0 `addPoly` w1
+                    p = doMulP n2 v0_1 w0_1
+                    q = doMulP n2 v0 w0
+                    r = doMulP n2 v1 w1
+                    -- s = (p `subPoly` q) `subPoly` r -- p - q - r
+                    -- q + s*X^n2 + r*X^n
+                in G.generate (G.length v + G.length w - 1)
+                   $ \i -> case () of
+                             _ | i < n2     ->   q `at` i
+                               | i < n      -> ((q `at` i) + (p `at` (i - n2))) - ((q `at` (i - n2)) + (r `at` (i - n2)))
+                               | i < n + n2 -> ((r `at` (i - n)) + (p `at` (i - n2))) - ((q `at` (i - n2)) + (r `at` (i - n2)))
+                               | otherwise  ->   r `at` (i - n)
+  where n2 = n `quot` 2
+        at :: (Num a, G.Vector vec a) => vec a -> Int -> a
+        at v i = if i < G.length v then v G.! i else 0
+{-# INLINE doMulP #-}
+
+mulPoly :: (Eq a, Num a, G.Vector vec a) => vec a -> vec a -> vec a
+mulPoly !v !w = let k = ceiling ((log (fromIntegral (max n m)) :: Double) / log 2) :: Int
+                in doMulP (2^k) v w
+  where n = G.length v
+        m = G.length w
+{-# INLINE mulPoly #-}
+
+zeroPoly :: (G.Vector vec a) => Poly vec a
+zeroPoly = Poly G.empty
+
+constPoly :: (Eq a, Num a, G.Vector vec a) => a -> Poly vec a
+constPoly 0 = Poly G.empty
+constPoly x = Poly (G.singleton x)
+
+scalePoly :: (Eq a, Num a, G.Vector vec a) => a -> Poly vec a -> Poly vec a
+scalePoly a (Poly xs)
+  | a == 0 = zeroPoly
+  | otherwise = Poly $ G.map (* a) xs
+
+valueAtPoly :: (Num a, G.Vector vec a) => Poly vec a -> a -> a
+valueAtPoly (Poly xs) t = G.foldr' (\a b -> a + t * b) 0 xs
+
+instance (Eq a, Num a, G.Vector vec a) => Num (Poly vec a) where
+  (+) = coerce (addPoly :: vec a -> vec a -> vec a)
+  (-) = coerce (subPoly :: vec a -> vec a -> vec a)
+  negate (Poly v) = Poly (G.map negate v)
+  (*) = coerce (mulPoly :: vec a -> vec a -> vec a)
+  fromInteger = constPoly . fromInteger
+  abs = undefined; signum = undefined
+
+divModPoly :: (Eq a, Fractional a, G.Vector vec a) => Poly vec a -> Poly vec a -> (Poly vec a, Poly vec a)
+divModPoly f g@(Poly w)
+  | G.null w = error "divModPoly: divide by zero"
+  | degree f < degree g = (zeroPoly, f)
+  | otherwise = loop zeroPoly (scalePoly (recip b) f)
+  where
+    g' = toMonic g
+    b = leadingCoefficient g
+    -- invariant: f == q * g + scalePoly b p
+    loop q p | degree p < degree g = (q, scalePoly b p)
+             | otherwise = let q' = Poly (G.drop (degree' g) (coeffAsc p))
+                           in loop (q + q') (p - q' * g')
+
+    toMonic :: (Fractional a, G.Vector vec a) => Poly vec a -> Poly vec a
+    toMonic f@(Poly xs)
+      | G.null xs = zeroPoly
+      | otherwise = Poly $ G.map (* recip (leadingCoefficient f)) xs
+
+    leadingCoefficient :: (Num a, G.Vector vec a) => Poly vec a -> a
+    leadingCoefficient (Poly xs)
+      | G.null xs = 0
+      | otherwise = G.last xs
+
+    degree :: G.Vector vec a => Poly vec a -> Maybe Int
+    degree (Poly xs) = case G.length xs - 1 of
+      -1 -> Nothing
+      n  -> Just n
+
+    degree' :: G.Vector vec a => Poly vec a -> Int
+    degree' (Poly xs) = case G.length xs of
+      0 -> error "degree': zero polynomial"
+      n -> n - 1
+
+-- 組立除法
+-- second constPoly (divModByDeg1 f t) = divMod f (Poly (G.fromList [-t, 1]))
+divModByDeg1 :: (Eq a, Num a, G.Vector vec a) => Poly vec a -> a -> (Poly vec a, a)
+divModByDeg1 f t = let w = G.postscanr (\a b -> a + b * t) 0 $ coeffAsc f
+                   in (Poly (G.tail w), G.head w)
+
+--
+-- Modular Arithmetic
+--
+
+newtype IntMod (m :: Nat) = IntMod { unwrapN :: Int64 } deriving (Eq)
+
+instance Show (IntMod m) where
+  show (IntMod x) = show x
+
+instance KnownNat m => Num (IntMod m) where
+  t@(IntMod x) + IntMod y
+    | x + y >= modulus = IntMod (x + y - modulus)
+    | otherwise = IntMod (x + y)
+    where modulus = fromIntegral (natVal t)
+  t@(IntMod x) - IntMod y
+    | x >= y = IntMod (x - y)
+    | otherwise = IntMod (x - y + modulus)
+    where modulus = fromIntegral (natVal t)
+  t@(IntMod x) * IntMod y = IntMod ((x * y) `rem` modulus)
+    where modulus = fromIntegral (natVal t)
+  fromInteger n = let result = IntMod (fromInteger (n `mod` fromIntegral modulus))
+                      modulus = natVal result
+                  in result
+  abs = undefined; signum = undefined
+
+{-# RULES
+"^9/Int" forall x. x ^ (9 :: Int) = let u = x; v = u * u * u in v * v * v
+"^9/Integer" forall x. x ^ (9 :: Integer) = let u = x; v = u * u * u in v * v * v
+ #-}
+
+fromIntegral_Int64_IntMod :: KnownNat m => Int64 -> IntMod m
+fromIntegral_Int64_IntMod n = result
+  where
+    result | 0 <= n && n < modulus = IntMod n
+           | otherwise = IntMod (n `mod` modulus)
+    modulus = fromIntegral (natVal result)
+
+{-# RULES
+"fromIntegral/Int->IntMod" fromIntegral = fromIntegral_Int64_IntMod . (fromIntegral :: Int -> Int64) :: Int -> IntMod (10^9 + 7)
+"fromIntegral/Int64->IntMod" fromIntegral = fromIntegral_Int64_IntMod :: Int64 -> IntMod (10^9 + 7)
+ #-}
+
+instance U.Unboxable (IntMod m) where
+  type Rep (IntMod m) = Int64
+
+exEuclid :: (Eq a, Integral a) => a -> a -> (a, a, a)
+exEuclid !f !g = loop 1 0 0 1 f g
+  where loop !u0 !u1 !v0 !v1 !f 0 = (f, u0, v0)
+        loop !u0 !u1 !v0 !v1 !f g =
+          case divMod f g of
+            (q,r) -> loop u1 (u0 - q * u1) v1 (v0 - q * v1) g r
+
+instance KnownNat m => Fractional (IntMod m) where
+  recip t@(IntMod x) = IntMod $ case exEuclid x modulus of
+    (1,a,_)  -> a `mod` modulus
+    (-1,a,_) -> (-a) `mod` modulus
+    _        -> error "not invertible"
+    where modulus = fromIntegral (natVal t)
+  fromRational = undefined
+
+recipM :: (Eq a, Integral a, Show a) => a -> a -> a
+recipM !x modulo = case exEuclid x modulo of
+                     (1,a,_) -> a `mod` modulo
+                     (-1,a,_) -> (-a) `mod` modulo
+                     (g,a,b) -> error $ show x ++ "^(-1) mod " ++ show modulo ++ " failed: gcd=" ++ show g
+
+-- |
+-- >>> crt 3 6 2 7
+-- 9
+-- >>> crt 2 5 3 9
+-- 12
+crt :: Int64 -> Int64 -> Int64 -> Int64 -> Int64
+crt !a1 !m1 !a2 !m2 = let m1' = recipM m1 m2
+                          m2' = recipM m2 m1
+                      in (m2 * m2' * a1 + m1 * m1' * a2) `mod` (m1 * m2)

From b961a647fe5a6cb759c24151c8dc079dc7f3bfde Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Fri, 22 Jan 2021 15:39:01 +0900
Subject: [PATCH 137/148] ATC001-C: Use ByteString.Builder

---
 atc001-c/Main.hs | 14 +++++++++-----
 atc001-c/NTT.hs  | 39 ++++++++++++++++++++-------------------
 2 files changed, 29 insertions(+), 24 deletions(-)

diff --git a/atc001-c/Main.hs b/atc001-c/Main.hs
index 410b20e..5501ff2 100644
--- a/atc001-c/Main.hs
+++ b/atc001-c/Main.hs
@@ -6,6 +6,7 @@
 import           Control.Exception           (assert)
 import           Control.Monad
 import           Data.Bits
+import qualified Data.ByteString.Builder     as BSB
 import qualified Data.ByteString.Char8       as BS
 import           Data.Char                   (isSpace)
 import           Data.Coerce
@@ -15,6 +16,7 @@ import           Data.List                   (unfoldr)
 import qualified Data.Vector.Generic         as G
 import qualified Data.Vector.Unboxed         as U
 import qualified Data.Vector.Unboxed.Mutable as UM
+import           System.IO                   (stdout)
 
 main = do
   n <- readLn @Int -- n <= 10^5
@@ -27,11 +29,13 @@ main = do
       -- v = coeffAsc (p * q)
       !v = coeffAsc p `mulFFT` coeffAsc q
       !l = U.length v
-  forM_ [1..2*n] $ \k -> do
-    print $ if k < l then
-              v U.! k
-            else
-              0
+  BSB.hPutBuilder stdout $ mconcat
+    [ if k < l then
+        BSB.intDec (v U.! k) <> BSB.char8 '\n' -- <= 10^9
+      else
+        BSB.string8 "0\n"
+    | k <- [1..2*n]
+    ]
 
 --
 -- Fast Fourier Transform (FFT)
diff --git a/atc001-c/NTT.hs b/atc001-c/NTT.hs
index 23f7ecc..85a97a3 100644
--- a/atc001-c/NTT.hs
+++ b/atc001-c/NTT.hs
@@ -10,23 +10,22 @@
 {-# LANGUAGE TypeFamilies               #-}
 {-# LANGUAGE TypeOperators              #-}
 {-# LANGUAGE UndecidableInstances       #-}
-import           Control.Exception            (assert)
-import           Control.Monad
+import           Control.Exception       (assert)
 import           Data.Bits
-import qualified Data.ByteString.Char8        as BS
-import           Data.Char                    (isSpace)
+import qualified Data.ByteString.Builder as BSB
+import qualified Data.ByteString.Char8   as BS
+import           Data.Char               (isSpace)
 import           Data.Coerce
-import           Data.Complex
-import           Data.Int                     (Int64)
-import           Data.List                    (unfoldr)
+import           Data.Int                (Int64)
+import           Data.List               (unfoldr)
 import           Data.Proxy
-import qualified Data.Vector.Generic          as G
-import qualified Data.Vector.Unboxing         as U
-import qualified Data.Vector.Unboxing.Mutable as UM
-import           GHC.TypeNats                 (type (*), type (+), KnownNat,
-                                               Nat, SomeNat (..), type (^),
-                                               natVal, someNatVal)
-import qualified Test.QuickCheck              as QC
+import qualified Data.Vector.Generic     as G
+import qualified Data.Vector.Unboxing    as U
+import           GHC.TypeNats            (type (*), type (+), KnownNat, Nat,
+                                          SomeNat (..), type (^), natVal,
+                                          someNatVal)
+import           System.IO               (stdout)
+import qualified Test.QuickCheck         as QC
 
 main = do
   n <- readLn @Int -- n <= 10^5
@@ -40,11 +39,13 @@ main = do
       -- v = coeffAsc (p * q)
       !v = coeffAsc p `mulFFTInt` coeffAsc q
       !l = U.length v
-  forM_ [1..2*n] $ \k -> do
-    print $ if k < l then
-              v U.! k -- <= 10^9
-            else
-              0
+  BSB.hPutBuilder stdout $ mconcat
+    [ if k < l then
+        BSB.int64Dec (v U.! k) <> BSB.char8 '\n' -- <= 10^9
+      else
+        BSB.string8 "0\n"
+    | k <- [1..2*n]
+    ]
 
 --
 -- Fast Fourier Transform (FFT)

From 77837e5bd44c90244fa9ae5a3f1790e38bb6cf2c Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Fri, 22 Jan 2021 15:43:44 +0900
Subject: [PATCH 138/148] Fix MergeSort.hs

---
 lib/MergeSort.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/lib/MergeSort.hs b/lib/MergeSort.hs
index 84f521c..2cdce4c 100644
--- a/lib/MergeSort.hs
+++ b/lib/MergeSort.hs
@@ -35,7 +35,7 @@ mergeSort :: (U.Unbox a, Ord a) => U.Vector a -> U.Vector a
 mergeSort = mergeSortBy compare
 
 sortVector :: (G.Vector v a, Ord a) => v a -> v a
-sortVector v = G.create do
+sortVector v = G.create $ do
   v' <- G.thaw v
   A.sort v'
   return v'

From 4a4afad46955673671a3d3827417310e18999e82 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Fri, 22 Jan 2021 20:34:14 +0900
Subject: [PATCH 139/148] ATC001-C/NTT: Some clean up

---
 atc001-c/NTT.hs | 74 ++++++++++++++++++++++++++++---------------------
 1 file changed, 42 insertions(+), 32 deletions(-)

diff --git a/atc001-c/NTT.hs b/atc001-c/NTT.hs
index 85a97a3..43ffc53 100644
--- a/atc001-c/NTT.hs
+++ b/atc001-c/NTT.hs
@@ -10,22 +10,24 @@
 {-# LANGUAGE TypeFamilies               #-}
 {-# LANGUAGE TypeOperators              #-}
 {-# LANGUAGE UndecidableInstances       #-}
-import           Control.Exception       (assert)
+import           Control.Exception            (assert)
 import           Data.Bits
-import qualified Data.ByteString.Builder as BSB
-import qualified Data.ByteString.Char8   as BS
-import           Data.Char               (isSpace)
+import qualified Data.ByteString.Builder      as BSB
+import qualified Data.ByteString.Char8        as BS
+import           Data.Char                    (isSpace)
 import           Data.Coerce
-import           Data.Int                (Int64)
-import           Data.List               (unfoldr)
+import           Data.Int                     (Int64)
+import           Data.List                    (unfoldr)
 import           Data.Proxy
-import qualified Data.Vector.Generic     as G
-import qualified Data.Vector.Unboxing    as U
-import           GHC.TypeNats            (type (*), type (+), KnownNat, Nat,
-                                          SomeNat (..), type (^), natVal,
-                                          someNatVal)
-import           System.IO               (stdout)
-import qualified Test.QuickCheck         as QC
+import qualified Data.Vector.Generic          as G
+import qualified Data.Vector.Generic.Mutable  as GM
+import qualified Data.Vector.Unboxing         as U
+import qualified Data.Vector.Unboxing.Mutable as UM
+import           GHC.TypeNats                 (type (*), type (+), KnownNat,
+                                               Nat, SomeNat (..), type (^),
+                                               natVal, someNatVal)
+import           System.IO                    (stdout)
+import qualified Test.QuickCheck              as QC
 
 main = do
   n <- readLn @Int -- n <= 10^5
@@ -66,8 +68,22 @@ fft (u:u2) f | n == 1 = f
                                r1' = G.generate n2 $ \j -> ((f G.! j) - (f G.! (j + n2))) * u G.! j
                                !t0 = fft u2 r0
                                !t1' = fft u2 r1'
-                           in G.generate n $ \j -> if even j then t0 G.! (j `quot` 2) else t1' G.! (j `quot` 2)
+                           in -- G.generate n $ \j -> if even j then t0 G.! (j `quot` 2) else t1' G.! (j `quot` 2)
+                              G.create $ do
+                                v <- GM.new n
+                                G.imapM_ (\i -> GM.write v (2 * i)) t0
+                                G.imapM_ (\i -> GM.write v (2 * i + 1)) t1'
+                                return v
   where n = G.length f
+{-# SPECIALIZE fft :: [U.Vector R5] -> U.Vector R5 -> U.Vector R5 #-}
+
+zeroExtend :: (Num a, U.Unboxable a) => Int -> U.Vector a -> U.Vector a
+zeroExtend n v | U.length v >= n = v
+               | otherwise = U.create $ do
+                   w <- UM.replicate n 0
+                   U.copy (UM.take (U.length v) w) v
+                   return w
+{-# SPECIALIZE zeroExtend :: Int -> U.Vector R5 -> U.Vector R5 #-}
 
 mulFFT :: forall a. (U.Unboxable a, Fractional a, PrimitiveRoot a) => U.Vector a -> U.Vector a -> U.Vector a
 mulFFT !f !g = let n' = U.length f + U.length g - 2
@@ -75,25 +91,17 @@ mulFFT !f !g = let n' = U.length f + U.length g - 2
                    !_ = assert (n' < 2^k) ()
                    n = bit k
                    u0 = nthRoot n
-                   u :: U.Vector a
-                   u = U.iterateN n (* u0) 1
-                   us = iterate halve u
-                   f' = U.generate n $ \j -> if j < U.length f then
-                                               f U.! j
-                                             else
-                                               0
-                   g' = U.generate n $ \j -> if j < U.length g then
-                                               g U.! j
-                                             else
-                                               0
-                   f'' = fft us f'
-                   g'' = fft us g'
+                   us :: [U.Vector a]
+                   us = iterate halve $ U.iterateN n (* u0) 1
+                   f'' = fft us (zeroExtend n f)
+                   g'' = fft us (zeroExtend n g)
                    v0 = recip u0
-                   v :: U.Vector a
-                   v = U.iterateN n (* v0) 1
-                   fg = U.generate n $ \j -> (f'' U.! j) * (g'' U.! j)
-                   fg' = fft (iterate halve v) fg
-               in U.generate n $ \j -> (fg' U.! j) / fromIntegral n
+                   vs :: [U.Vector a]
+                   vs = iterate halve $ U.iterateN n (* v0) 1
+                   fg' = fft vs (U.zipWith (*) f'' g'')
+                   !recip_n = recip (fromIntegral n)
+               in U.map (* recip_n) fg'
+{-# SPECIALIZE mulFFT :: U.Vector R5 -> U.Vector R5 -> U.Vector R5 #-}
 
 {-
 mulFFTInt :: U.Vector Int -> U.Vector Int -> U.Vector Int64
@@ -135,6 +143,7 @@ instance PrimitiveRoot R1 where
                                    in 17 ^ (2^(25 - k) :: Int)
             | otherwise = error "nthRoot: not implemented"
 
+-- Z / 1012924417 Z
 newtype R2 = R2 { unwrapR2 :: IntMod (7 * 2^26 + 1) } deriving newtype (Eq, Show, Num, Fractional, U.Unboxable)
 
 instance PrimitiveRoot R2 where
@@ -334,6 +343,7 @@ instance KnownNat m => Num (IntMod m) where
                       modulus = natVal result
                   in result
   abs = undefined; signum = undefined
+  {-# SPECIALIZE instance Num (IntMod 1012924417) #-}
 
 {-# RULES
 "^9/Int" forall x. x ^ (9 :: Int) = let u = x; v = u * u * u in v * v * v

From f39e27e4cd4093bee580445523b073bc31787394 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Fri, 22 Jan 2021 20:48:12 +0900
Subject: [PATCH 140/148] ATC001-C/NTT: More clean up

---
 atc001-c/NTT.hs | 285 ++++--------------------------------------------
 1 file changed, 20 insertions(+), 265 deletions(-)

diff --git a/atc001-c/NTT.hs b/atc001-c/NTT.hs
index 43ffc53..9cdbeb5 100644
--- a/atc001-c/NTT.hs
+++ b/atc001-c/NTT.hs
@@ -9,7 +9,6 @@
 {-# LANGUAGE TypeApplications           #-}
 {-# LANGUAGE TypeFamilies               #-}
 {-# LANGUAGE TypeOperators              #-}
-{-# LANGUAGE UndecidableInstances       #-}
 import           Control.Exception            (assert)
 import           Data.Bits
 import qualified Data.ByteString.Builder      as BSB
@@ -27,7 +26,6 @@ import           GHC.TypeNats                 (type (*), type (+), KnownNat,
                                                Nat, SomeNat (..), type (^),
                                                natVal, someNatVal)
 import           System.IO                    (stdout)
-import qualified Test.QuickCheck              as QC
 
 main = do
   n <- readLn @Int -- n <= 10^5
@@ -35,11 +33,10 @@ main = do
     [a,b] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
     -- a <= 100, b <= 100
     return (a,b)
-  let p, q :: Poly U.Vector Int
-      p = Poly $ normalizePoly (0 `U.cons` as)
-      q = Poly $ normalizePoly (0 `U.cons` bs)
-      -- v = coeffAsc (p * q)
-      !v = coeffAsc p `mulFFTInt` coeffAsc q
+  let p, q :: U.Vector Int
+      p = 0 `U.cons` as
+      q = 0 `U.cons` bs
+      !v = p `mulFFTInt` q
       !l = U.length v
   BSB.hPutBuilder stdout $ mconcat
     [ if k < l then
@@ -75,7 +72,7 @@ fft (u:u2) f | n == 1 = f
                                 G.imapM_ (\i -> GM.write v (2 * i + 1)) t1'
                                 return v
   where n = G.length f
-{-# SPECIALIZE fft :: [U.Vector R5] -> U.Vector R5 -> U.Vector R5 #-}
+{-# SPECIALIZE fft :: [U.Vector R] -> U.Vector R -> U.Vector R #-}
 
 zeroExtend :: (Num a, U.Unboxable a) => Int -> U.Vector a -> U.Vector a
 zeroExtend n v | U.length v >= n = v
@@ -83,7 +80,7 @@ zeroExtend n v | U.length v >= n = v
                    w <- UM.replicate n 0
                    U.copy (UM.take (U.length v) w) v
                    return w
-{-# SPECIALIZE zeroExtend :: Int -> U.Vector R5 -> U.Vector R5 #-}
+{-# SPECIALIZE zeroExtend :: Int -> U.Vector R -> U.Vector R #-}
 
 mulFFT :: forall a. (U.Unboxable a, Fractional a, PrimitiveRoot a) => U.Vector a -> U.Vector a -> U.Vector a
 mulFFT !f !g = let n' = U.length f + U.length g - 2
@@ -101,24 +98,12 @@ mulFFT !f !g = let n' = U.length f + U.length g - 2
                    fg' = fft vs (U.zipWith (*) f'' g'')
                    !recip_n = recip (fromIntegral n)
                in U.map (* recip_n) fg'
-{-# SPECIALIZE mulFFT :: U.Vector R5 -> U.Vector R5 -> U.Vector R5 #-}
+{-# SPECIALIZE mulFFT :: U.Vector R -> U.Vector R -> U.Vector R #-}
 
-{-
 mulFFTInt :: U.Vector Int -> U.Vector Int -> U.Vector Int64
-mulFFTInt f g = let f1 = U.map fromIntegral f :: U.Vector R1
-                    g1 = U.map fromIntegral g :: U.Vector R1
-                    !h1 = mulFFT f1 g1
-                    f2 = U.map fromIntegral f :: U.Vector R2
-                    g2 = U.map fromIntegral g :: U.Vector R2
-                    !h2 = mulFFT f2 g2
-                in U.generate (U.length h1) $ \i -> case crt' (unwrapR1 $ h1 U.! i) (unwrapR2 $ h2 U.! i) of
-                                                      IntMod x -> x
--}
-
-mulFFTInt :: U.Vector Int -> U.Vector Int -> U.Vector Int64
-mulFFTInt f g = let f' = U.map fromIntegral f :: U.Vector R5
-                    g' = U.map fromIntegral g :: U.Vector R5
-                in U.map (\(R5 (IntMod x)) -> x) (mulFFT f' g')
+mulFFTInt f g = let f' = U.map fromIntegral f :: U.Vector R
+                    g' = U.map fromIntegral g :: U.Vector R
+                in U.map (\(R (IntMod x)) -> x) (mulFFT f' g')
 
 class PrimitiveRoot a where
   -- (nthRoot n)^n == 1
@@ -135,190 +120,23 @@ order' !m !x = go 1 x
 findPrimitiveNthRoot :: (Eq a, Num a) => Int -> a
 findPrimitiveNthRoot n = head [ x | k <- [1..], let x = fromInteger k, order' n x == n ]
 
-newtype R1 = R1 { unwrapR1 :: IntMod (5 * 2^25 + 1) } deriving newtype (Eq, Show, Num, Fractional, U.Unboxable)
-
-instance PrimitiveRoot R1 where
-  nthRoot n | (5 * 2^25) `rem` n /= 0 = error "nthRoot: does not exist"
-            | n .&. (n - 1) == 0 = let k = round (log (fromIntegral n) / log 2) :: Int
-                                   in 17 ^ (2^(25 - k) :: Int)
-            | otherwise = error "nthRoot: not implemented"
-
 -- Z / 1012924417 Z
-newtype R2 = R2 { unwrapR2 :: IntMod (7 * 2^26 + 1) } deriving newtype (Eq, Show, Num, Fractional, U.Unboxable)
+newtype R = R { unwrapR :: IntMod (483 * 2^21 + 1) } deriving newtype (Eq, Show, Num, Fractional)
 
-instance PrimitiveRoot R2 where
-  nthRoot n | (7 * 2^26) `rem` n /= 0 = error "nthRoot: does not exist"
-            | n .&. (n - 1) == 0 = let k = round (log (fromIntegral n) / log 2) :: Int
-                                   in 30 ^ (2^(26 - k) :: Int)
-            | otherwise = error "nthRoot: not implemented"
-
-newtype R5 = R5 { unwrapR5 :: IntMod (483 * 2^21 + 1) } deriving newtype (Eq, Show, Num, Fractional, U.Unboxable)
+instance U.Unboxable R where
+  type Rep R = Int64
 
-instance PrimitiveRoot R5 where
+instance PrimitiveRoot R where
   nthRoot n | (483 * 2^21) `rem` n /= 0 = error "nthRoot: does not exist"
             | n .&. (n - 1) == 0 = let k = round (log (fromIntegral n) / log 2) :: Int
                                    in 198 ^ (2^(21 - k) :: Int)
             | otherwise = error "nthRoot: not implemented"
 
 {-# RULES
-"fromIntegral/Int->R1" fromIntegral = R1 . fromIntegral_Int64_IntMod . (fromIntegral :: Int -> Int64)
-"fromIntegral/Int64->R1" fromIntegral = R1 . fromIntegral_Int64_IntMod
-"fromIntegral/Int->R2" fromIntegral = R2 . fromIntegral_Int64_IntMod . (fromIntegral :: Int -> Int64)
-"fromIntegral/Int64->R2" fromIntegral = R2 . fromIntegral_Int64_IntMod
-"fromIntegral/Int->R5" fromIntegral = R5 . fromIntegral_Int64_IntMod . (fromIntegral :: Int -> Int64)
-"fromIntegral/Int64->R5" fromIntegral = R5 . fromIntegral_Int64_IntMod
+"fromIntegral/Int->R" fromIntegral = R . fromIntegral_Int64_IntMod . (fromIntegral :: Int -> Int64)
+"fromIntegral/Int64->R" fromIntegral = R . fromIntegral_Int64_IntMod
  #-}
 
---
--- Univariate polynomial
---
-
-newtype Poly vec a = Poly { coeffAsc :: vec a } deriving Eq
-
-normalizePoly :: (Eq a, Num a, G.Vector vec a) => vec a -> vec a
-normalizePoly v | G.null v || G.last v /= 0 = v
-                | otherwise = normalizePoly (G.init v)
-
-addPoly :: (Eq a, Num a, G.Vector vec a) => vec a -> vec a -> vec a
-addPoly v w = case compare n m of
-                LT -> G.generate m $ \i -> if i < n
-                                           then v G.! i + w G.! i
-                                           else w G.! i
-                GT -> G.generate n $ \i -> if i < m
-                                           then v G.! i + w G.! i
-                                           else v G.! i
-                EQ -> normalizePoly $ G.zipWith (+) v w
-  where n = G.length v
-        m = G.length w
-
-subPoly :: (Eq a, Num a, G.Vector vec a) => vec a -> vec a -> vec a
-subPoly v w = case compare n m of
-                LT -> G.generate m $ \i -> if i < n
-                                           then v G.! i - w G.! i
-                                           else negate (w G.! i)
-                GT -> G.generate n $ \i -> if i < m
-                                           then v G.! i - w G.! i
-                                           else v G.! i
-                EQ -> normalizePoly $ G.zipWith (-) v w
-  where n = G.length v
-        m = G.length w
-
-naiveMulPoly :: (Num a, G.Vector vec a) => vec a -> vec a -> vec a
-naiveMulPoly v w = G.generate (n + m - 1) $
-                   \i -> sum [(v G.! (i-j)) * (w G.! j) | j <- [max (i-n+1) 0..min i (m-1)]]
-  where n = G.length v
-        m = G.length w
-
-doMulP :: (Eq a, Num a, G.Vector vec a) => Int -> vec a -> vec a -> vec a
-doMulP n !v !w | n <= 16 = naiveMulPoly v w
-doMulP n !v !w
-  | G.null v = v
-  | G.null w = w
-  | G.length v < n2 = let (w0, w1) = G.splitAt n2 w
-                          u0 = doMulP n2 v w0
-                          u1 = doMulP n2 v w1
-                      in G.generate (G.length v + G.length w - 1)
-                         $ \i -> case () of
-                                   _ | i < n2     ->  u0 `at` i
-                                     | i < n      -> (u0 `at` i) + (u1 `at` (i - n2))
-                                     | i < n + n2 -> (u1 `at` (i - n2))
-  | G.length w < n2 = let (v0, v1) = G.splitAt n2 v
-                          u0 = doMulP n2 v0 w
-                          u1 = doMulP n2 v1 w
-                      in G.generate (G.length v + G.length w - 1)
-                         $ \i -> case () of
-                                   _ | i < n2     ->  u0 `at` i
-                                     | i < n      -> (u0 `at` i) + (u1 `at` (i - n2))
-                                     | i < n + n2 -> (u1 `at` (i - n2))
-  | otherwise = let (v0, v1) = G.splitAt n2 v
-                    (w0, w1) = G.splitAt n2 w
-                    v0_1 = v0 `addPoly` v1
-                    w0_1 = w0 `addPoly` w1
-                    p = doMulP n2 v0_1 w0_1
-                    q = doMulP n2 v0 w0
-                    r = doMulP n2 v1 w1
-                    -- s = (p `subPoly` q) `subPoly` r -- p - q - r
-                    -- q + s*X^n2 + r*X^n
-                in G.generate (G.length v + G.length w - 1)
-                   $ \i -> case () of
-                             _ | i < n2     ->   q `at` i
-                               | i < n      -> ((q `at` i) + (p `at` (i - n2))) - ((q `at` (i - n2)) + (r `at` (i - n2)))
-                               | i < n + n2 -> ((r `at` (i - n)) + (p `at` (i - n2))) - ((q `at` (i - n2)) + (r `at` (i - n2)))
-                               | otherwise  ->   r `at` (i - n)
-  where n2 = n `quot` 2
-        at :: (Num a, G.Vector vec a) => vec a -> Int -> a
-        at v i = if i < G.length v then v G.! i else 0
-{-# INLINE doMulP #-}
-
-mulPoly :: (Eq a, Num a, G.Vector vec a) => vec a -> vec a -> vec a
-mulPoly !v !w = let k = ceiling ((log (fromIntegral (max n m)) :: Double) / log 2) :: Int
-                in doMulP (2^k) v w
-  where n = G.length v
-        m = G.length w
-{-# INLINE mulPoly #-}
-
-zeroPoly :: (G.Vector vec a) => Poly vec a
-zeroPoly = Poly G.empty
-
-constPoly :: (Eq a, Num a, G.Vector vec a) => a -> Poly vec a
-constPoly 0 = Poly G.empty
-constPoly x = Poly (G.singleton x)
-
-scalePoly :: (Eq a, Num a, G.Vector vec a) => a -> Poly vec a -> Poly vec a
-scalePoly a (Poly xs)
-  | a == 0 = zeroPoly
-  | otherwise = Poly $ G.map (* a) xs
-
-valueAtPoly :: (Num a, G.Vector vec a) => Poly vec a -> a -> a
-valueAtPoly (Poly xs) t = G.foldr' (\a b -> a + t * b) 0 xs
-
-instance (Eq a, Num a, G.Vector vec a) => Num (Poly vec a) where
-  (+) = coerce (addPoly :: vec a -> vec a -> vec a)
-  (-) = coerce (subPoly :: vec a -> vec a -> vec a)
-  negate (Poly v) = Poly (G.map negate v)
-  (*) = coerce (mulPoly :: vec a -> vec a -> vec a)
-  fromInteger = constPoly . fromInteger
-  abs = undefined; signum = undefined
-
-divModPoly :: (Eq a, Fractional a, G.Vector vec a) => Poly vec a -> Poly vec a -> (Poly vec a, Poly vec a)
-divModPoly f g@(Poly w)
-  | G.null w = error "divModPoly: divide by zero"
-  | degree f < degree g = (zeroPoly, f)
-  | otherwise = loop zeroPoly (scalePoly (recip b) f)
-  where
-    g' = toMonic g
-    b = leadingCoefficient g
-    -- invariant: f == q * g + scalePoly b p
-    loop q p | degree p < degree g = (q, scalePoly b p)
-             | otherwise = let q' = Poly (G.drop (degree' g) (coeffAsc p))
-                           in loop (q + q') (p - q' * g')
-
-    toMonic :: (Fractional a, G.Vector vec a) => Poly vec a -> Poly vec a
-    toMonic f@(Poly xs)
-      | G.null xs = zeroPoly
-      | otherwise = Poly $ G.map (* recip (leadingCoefficient f)) xs
-
-    leadingCoefficient :: (Num a, G.Vector vec a) => Poly vec a -> a
-    leadingCoefficient (Poly xs)
-      | G.null xs = 0
-      | otherwise = G.last xs
-
-    degree :: G.Vector vec a => Poly vec a -> Maybe Int
-    degree (Poly xs) = case G.length xs - 1 of
-      -1 -> Nothing
-      n  -> Just n
-
-    degree' :: G.Vector vec a => Poly vec a -> Int
-    degree' (Poly xs) = case G.length xs of
-      0 -> error "degree': zero polynomial"
-      n -> n - 1
-
--- 組立除法
--- second constPoly (divModByDeg1 f t) = divMod f (Poly (G.fromList [-t, 1]))
-divModByDeg1 :: (Eq a, Num a, G.Vector vec a) => Poly vec a -> a -> (Poly vec a, a)
-divModByDeg1 f t = let w = G.postscanr (\a b -> a + b * t) 0 $ coeffAsc f
-                   in (Poly (G.tail w), G.head w)
-
 --
 -- Modular Arithmetic
 --
@@ -345,21 +163,19 @@ instance KnownNat m => Num (IntMod m) where
   abs = undefined; signum = undefined
   {-# SPECIALIZE instance Num (IntMod 1012924417) #-}
 
-{-# RULES
-"^9/Int" forall x. x ^ (9 :: Int) = let u = x; v = u * u * u in v * v * v
-"^9/Integer" forall x. x ^ (9 :: Integer) = let u = x; v = u * u * u in v * v * v
- #-}
-
 fromIntegral_Int64_IntMod :: KnownNat m => Int64 -> IntMod m
 fromIntegral_Int64_IntMod n = result
   where
     result | 0 <= n && n < modulus = IntMod n
            | otherwise = IntMod (n `mod` modulus)
     modulus = fromIntegral (natVal result)
+{-# SPECIALIZE fromIntegral_Int64_IntMod :: Int64 -> IntMod 1012924417 #-}
 
 {-# RULES
 "fromIntegral/Int->IntMod" fromIntegral = fromIntegral_Int64_IntMod . (fromIntegral :: Int -> Int64) :: Int -> IntMod (10^9 + 7)
 "fromIntegral/Int64->IntMod" fromIntegral = fromIntegral_Int64_IntMod :: Int64 -> IntMod (10^9 + 7)
+"fromIntegral/Int->IntMod 1012924417" fromIntegral = fromIntegral_Int64_IntMod . (fromIntegral :: Int -> Int64) :: Int -> IntMod 1012924417
+"fromIntegral/Int64->IntMod 1012924417" fromIntegral = fromIntegral_Int64_IntMod :: Int64 -> IntMod 1012924417
  #-}
 
 instance U.Unboxable (IntMod m) where
@@ -371,6 +187,7 @@ exEuclid !f !g = loop 1 0 0 1 f g
         loop !u0 !u1 !v0 !v1 !f g =
           case divMod f g of
             (q,r) -> loop u1 (u0 - q * u1) v1 (v0 - q * v1) g r
+{-# SPECIALIZE exEuclid :: Int64 -> Int64 -> (Int64, Int64, Int64) #-}
 
 instance KnownNat m => Fractional (IntMod m) where
   recip t@(IntMod x) = IntMod $ case exEuclid x modulus of
@@ -379,65 +196,3 @@ instance KnownNat m => Fractional (IntMod m) where
     _        -> error "not invertible"
     where modulus = fromIntegral (natVal t)
   fromRational = undefined
-
-recipM :: (Eq a, Integral a, Show a) => a -> a -> a
-recipM !x modulo = case exEuclid x modulo of
-                     (1,a,_) -> a `mod` modulo
-                     (-1,a,_) -> (-a) `mod` modulo
-                     (g,a,b) -> error $ show x ++ "^(-1) mod " ++ show modulo ++ " failed: gcd=" ++ show g
-
--- |
--- >>> crt 3 6 2 7
--- 9
--- >>> crt 2 5 3 9
--- 12
-crt :: (Eq a, Integral a, Show a) => a -> a -> a -> a -> a
-crt !a1 !m1 !a2 !m2 = let m1' = recipM m1 m2
-                          m2' = recipM m2 m1
-                          mm = m1 * m2
-                      in
-                        fromInteger ((toInteger m2 * toInteger m2' * toInteger a1 + toInteger m1 * toInteger m1' * toInteger a2) `mod` toInteger mm)
-                        -- (m2 * m2' * a1 + m1 * m1' * a2) `mod` mm
-                        -- ((m2 * m2' `mod` mm) * (a1 `mod` m1) `mod` mm + (m1 * m1' `mod` mm) * (a2 `mod` m2) `mod` mm) `mod` mm
-
-crt' :: (KnownNat m1, KnownNat m2) => IntMod m1 -> IntMod m2 -> IntMod (m1 * m2)
-crt' x1@(IntMod a1) x2@(IntMod !a2) = let m1, m2, m1', m2' :: Int64
-                                          m1 = fromIntegral (natVal x1)
-                                          m2 = fromIntegral (natVal x2)
-                                          m1' = recipM m1 m2
-                                          m2' = recipM m2 m1
-                                      in IntMod (fromInteger ((toInteger m2 * toInteger m2' * toInteger a1 + toInteger m1 * toInteger m1' * toInteger a2) `mod` (toInteger m1 * toInteger m2)))
-
---
--- Tests
---
-
-instance KnownNat m => QC.Arbitrary (IntMod m) where
-  arbitrary = IntMod <$> QC.choose (0, m - 1)
-    where
-      m = fromIntegral (natVal (Proxy :: Proxy m))
-
-runTests :: IO ()
-runTests = do
-  QC.quickCheck $ QC.forAll (QC.choose (2, 10^9+9)) $ \m x -> prop_recipM x (QC.Positive m)
-  QC.quickCheck $ QC.forAll (QC.choose (2, 10^9+9)) $ \m1 -> QC.forAll (QC.choose (2, 10^9+9)) $ \m2 x y -> prop_crt x (QC.Positive m1) y (QC.Positive m2)
-  QC.quickCheck $ QC.forAll (QC.choose (2, 10^9+9)) $ \m1 -> QC.forAll (QC.choose (2, 10^9+9)) $ \m2 x y -> prop_crt' x (QC.Positive m1) y (QC.Positive m2)
-
-prop_recipM :: Int64 -> QC.Positive Int64 -> QC.Property
-prop_recipM x (QC.Positive m) = gcd x m == 1 && m > 1 && m <= 10^9 + 9 QC.==>
-  let y = recipM x m
-  in 0 <= y QC..&&. y < m QC..&&. ((x `mod` m) * recipM x m) `mod` m QC.=== 1
-
-prop_crt :: Int64 -> QC.Positive Int64 -> Int64 -> QC.Positive Int64 -> QC.Property
-prop_crt a1 (QC.Positive m1) a2 (QC.Positive m2)
-  = gcd m1 m2 == 1 QC.==> let r = crt a1 m1 a2 m2
-                          in r `mod` m1 QC.=== a1 `mod` m1 QC..&&. r `mod` m2 QC.=== a2 `mod` m2
-
-prop_crt' :: Int64 -> QC.Positive Int64 -> Int64 -> QC.Positive Int64 -> QC.Property
-prop_crt' a1 (QC.Positive m1) a2 (QC.Positive m2)
-  = gcd m1 m2 == 1 QC.==> case (someNatVal (fromIntegral m1), someNatVal (fromIntegral m2)) of
-                            (SomeNat (Proxy :: Proxy m1), SomeNat (Proxy :: Proxy m2)) ->
-                              let x = fromIntegral a1 :: IntMod m1
-                                  y = fromIntegral a2 :: IntMod m2
-                                  IntMod r = crt' x y
-                              in r `mod` m1 QC.=== a1 `mod` m1 QC..&&. r `mod` m2 QC.=== a2 `mod` m2

From b7d2a972ac3ac957e98e4dea5adaba369b46791e Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Fri, 22 Jan 2021 21:26:41 +0900
Subject: [PATCH 141/148] AtCoder Library Practice Contest F - Convolution

---
 README.md           |   2 +-
 practice2-f/Main.hs | 180 ++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 181 insertions(+), 1 deletion(-)
 create mode 100644 practice2-f/Main.hs

diff --git a/README.md b/README.md
index 2622c12..e8103f0 100644
--- a/README.md
+++ b/README.md
@@ -362,7 +362,7 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 * [x] C - Floor Sum
 * [ ] D - Maxflow
 * [ ] E - MinCostFlow
-* [ ] F - Convolution
+* [x] F - Convolution
 * [ ] G - SCC
 * [ ] H - Two SAT
 * [ ] I - Number of Substrings
diff --git a/practice2-f/Main.hs b/practice2-f/Main.hs
new file mode 100644
index 0000000..838c9e5
--- /dev/null
+++ b/practice2-f/Main.hs
@@ -0,0 +1,180 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns               #-}
+{-# LANGUAGE DataKinds                  #-}
+{-# LANGUAGE DerivingStrategies         #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE NoStarIsType               #-}
+{-# LANGUAGE ScopedTypeVariables        #-}
+{-# LANGUAGE TypeApplications           #-}
+{-# LANGUAGE TypeFamilies               #-}
+{-# LANGUAGE TypeOperators              #-}
+import           Control.Exception            (assert)
+import           Control.Monad
+import           Data.Bits
+import qualified Data.ByteString.Builder      as BSB
+import qualified Data.ByteString.Char8        as BS
+import           Data.Char                    (isSpace)
+import           Data.Int                     (Int64)
+import           Data.List
+import qualified Data.Vector.Generic          as G
+import qualified Data.Vector.Generic.Mutable  as GM
+import qualified Data.Vector.Unboxing         as U
+import qualified Data.Vector.Unboxing.Mutable as UM
+import           GHC.TypeNats
+import           System.IO                    (stdout)
+
+-- main = print (findPrimitiveNthRoot (2^23) :: R)
+
+main = do
+  [n,m] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  xs <- U.map fromIntegral . U.unfoldrN n (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  ys <- U.map fromIntegral . U.unfoldrN m (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  let !zs = U.take (n + m - 1) $ mulFFT xs ys
+  BSB.hPutBuilder stdout $ mconcat (intersperse (BSB.char8 ' ') [ BSB.int64Dec x | R (IntMod x) <- U.toList zs ]) <> BSB.char8 '\n'
+
+--
+-- Fast Fourier Transform (FFT)
+--
+
+halve :: G.Vector vec a => vec a -> vec a
+halve v = let n = G.length v
+          in G.generate (n `quot` 2) $ \j -> v G.! (j * 2)
+
+fft :: forall vec a. (Num a, G.Vector vec a)
+    => [vec a] -- ^ For a primitive n-th root of unity @u@, @iterate halve [1,u,u^2 .. u^(n-1)]@
+    -> vec a -- ^ a polynomial of length n (= 2^k for some k)
+    -> vec a
+fft (!u:u2) f | n == 1 = f
+              | otherwise = let !n2 = n `quot` 2
+                                r0, r1', t0, t1' :: vec a
+                                r0 = G.generate n2 $ \j -> (f G.! j) + (f G.! (j + n2))
+                                r1' = G.generate n2 $ \j -> ((f G.! j) - (f G.! (j + n2))) * u G.! j
+                                !t0 = fft u2 r0
+                                !t1' = fft u2 r1'
+                            in G.create $ do
+                                 v <- GM.new n
+                                 G.imapM_ (\i -> GM.write v (2 * i)) t0
+                                 G.imapM_ (\i -> GM.write v (2 * i + 1)) t1'
+                                 return v
+                               -- G.generate n $ \j -> if even j then t0 G.! (j `quot` 2) else t1' G.! (j `quot` 2)
+  where n = G.length f
+{-# SPECIALIZE fft :: [U.Vector R] -> U.Vector R -> U.Vector R #-}
+
+zeroExtend :: (Num a, U.Unboxable a) => Int -> U.Vector a -> U.Vector a
+zeroExtend n v | U.length v >= n = v
+               | otherwise = U.create $ do
+                   w <- UM.replicate n 0
+                   U.copy (UM.take (U.length v) w) v
+                   return w
+{-# SPECIALIZE zeroExtend :: Int -> U.Vector R -> U.Vector R #-}
+
+mulFFT :: forall a. (U.Unboxable a, Fractional a, PrimitiveRoot a) => U.Vector a -> U.Vector a -> U.Vector a
+mulFFT !f !g = let n' = U.length f + U.length g - 2
+                   k = finiteBitSize n' - countLeadingZeros n'
+                   !_ = assert (n' < 2^k) ()
+                   n = bit k
+                   u0 = nthRoot n
+                   us :: [U.Vector a]
+                   us = iterate halve $ U.iterateN n (* u0) 1
+                   f'' = fft us (zeroExtend n f)
+                   g'' = fft us (zeroExtend n g)
+                   v0 = recip u0
+                   vs :: [U.Vector a]
+                   vs = iterate halve $ U.iterateN n (* v0) 1
+                   fg' = fft vs (U.zipWith (*) f'' g'')
+                   !recip_n = recip (fromIntegral n)
+               in U.map (* recip_n) fg'
+{-# SPECIALIZE mulFFT :: U.Vector R -> U.Vector R -> U.Vector R #-}
+
+class PrimitiveRoot a where
+  -- (nthRoot n)^n == 1
+  -- (nthRoot (2 * m))^m == -1
+  nthRoot :: Int -> a
+
+order' :: (Eq a, Num a) => Int -> a -> Int
+order' !m !x = go 1 x
+  where
+    go !n 1 = n
+    go !n y | n > m = m + 1
+    go !n y = go (n + 1) (x * y)
+
+findPrimitiveNthRoot :: (Eq a, Num a) => Int -> a
+findPrimitiveNthRoot n = head [ x | k <- [1..], let x = fromInteger k, order' n x == n ]
+
+-- Z / 998244353 Z
+newtype R = R { unwrapR :: IntMod 998244353 } deriving newtype (Eq, Show, Num, Fractional)
+
+instance U.Unboxable R where
+  type Rep R = Int64
+
+instance PrimitiveRoot R where
+  nthRoot n | (998244353 - 1) `rem` n /= 0 = error "nthRoot: does not exist"
+            | n .&. (n - 1) == 0 = let k = round (log (fromIntegral n) / log 2) :: Int
+                                   in 31 ^ (2^(23 - k) :: Int)
+            | otherwise = error "nthRoot: not implemented"
+
+{-# RULES
+"fromIntegral/Int->R" fromIntegral = R . fromIntegral_Int64_IntMod . (fromIntegral :: Int -> Int64)
+"fromIntegral/Int64->R" fromIntegral = R . fromIntegral_Int64_IntMod
+ #-}
+
+--
+-- Modular Arithmetic
+--
+
+newtype IntMod (m :: Nat) = IntMod { unwrapN :: Int64 } deriving (Eq)
+
+instance Show (IntMod m) where
+  show (IntMod x) = show x
+
+instance KnownNat m => Num (IntMod m) where
+  t@(IntMod x) + IntMod y
+    | x + y >= modulus = IntMod (x + y - modulus)
+    | otherwise = IntMod (x + y)
+    where modulus = fromIntegral (natVal t)
+  t@(IntMod x) - IntMod y
+    | x >= y = IntMod (x - y)
+    | otherwise = IntMod (x - y + modulus)
+    where modulus = fromIntegral (natVal t)
+  t@(IntMod x) * IntMod y = IntMod ((x * y) `rem` modulus)
+    where modulus = fromIntegral (natVal t)
+  fromInteger n = let result = IntMod (fromInteger (n `mod` fromIntegral modulus))
+                      modulus = natVal result
+                  in result
+  abs = undefined; signum = undefined
+  {-# SPECIALIZE instance Num (IntMod 998244353) #-}
+
+fromIntegral_Int64_IntMod :: KnownNat m => Int64 -> IntMod m
+fromIntegral_Int64_IntMod n = result
+  where
+    result | 0 <= n && n < modulus = IntMod n
+           | otherwise = IntMod (n `mod` modulus)
+    modulus = fromIntegral (natVal result)
+{-# SPECIALIZE fromIntegral_Int64_IntMod :: Int64 -> IntMod 998244353 #-}
+
+{-# RULES
+"fromIntegral/Int->IntMod" fromIntegral = fromIntegral_Int64_IntMod . (fromIntegral :: Int -> Int64) :: Int -> IntMod (10^9 + 7)
+"fromIntegral/Int64->IntMod" fromIntegral = fromIntegral_Int64_IntMod :: Int64 -> IntMod (10^9 + 7)
+"fromIntegral/Int->IntMod 998244353" fromIntegral = fromIntegral_Int64_IntMod . (fromIntegral :: Int -> Int64) :: Int -> IntMod 998244353
+"fromIntegral/Int64->IntMod 998244353" fromIntegral = fromIntegral_Int64_IntMod :: Int64 -> IntMod 998244353
+ #-}
+
+instance U.Unboxable (IntMod m) where
+  type Rep (IntMod m) = Int64
+
+exEuclid :: (Eq a, Integral a) => a -> a -> (a, a, a)
+exEuclid !f !g = loop 1 0 0 1 f g
+  where loop !u0 !u1 !v0 !v1 !f 0 = (f, u0, v0)
+        loop !u0 !u1 !v0 !v1 !f g =
+          case divMod f g of
+            (q,r) -> loop u1 (u0 - q * u1) v1 (v0 - q * v1) g r
+{-# SPECIALIZE exEuclid :: Int64 -> Int64 -> (Int64, Int64, Int64) #-}
+
+instance KnownNat m => Fractional (IntMod m) where
+  recip t@(IntMod x) = IntMod $ case exEuclid x modulus of
+    (1,a,_)  -> a `mod` modulus
+    (-1,a,_) -> (-a) `mod` modulus
+    _        -> error "not invertible"
+    where modulus = fromIntegral (natVal t)
+  fromRational = undefined

From d830e46b411b0d596f7831f55577bf312c226bd4 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Sun, 24 Jan 2021 00:03:12 +0900
Subject: [PATCH 142/148] Chinese Remainder Theorem

---
 lib/ModularArithmetic.hs          |   6 ++
 lib/ModularArithmetic_TypeNats.hs | 102 +++++++++++++++++++++++++++++-
 2 files changed, 107 insertions(+), 1 deletion(-)

diff --git a/lib/ModularArithmetic.hs b/lib/ModularArithmetic.hs
index 8a9a8f9..fa50dc3 100644
--- a/lib/ModularArithmetic.hs
+++ b/lib/ModularArithmetic.hs
@@ -62,3 +62,9 @@ instance Fractional N where
   (/) = coerce divM
   recip = coerce recipM
   fromRational = undefined
+
+{-
+import qualified Data.Vector.Unboxing  as U
+instance U.Unboxable N where
+  type Rep N = Int64
+-}
diff --git a/lib/ModularArithmetic_TypeNats.hs b/lib/ModularArithmetic_TypeNats.hs
index 47351d2..e0fad80 100644
--- a/lib/ModularArithmetic_TypeNats.hs
+++ b/lib/ModularArithmetic_TypeNats.hs
@@ -6,7 +6,10 @@
 {-# LANGUAGE NoStarIsType #-}
 module ModularArithmetic_TypeNats where
 import Data.Int
-import GHC.TypeNats (Nat, KnownNat, natVal, type (^), type (+))
+import GHC.TypeNats
+import qualified Test.QuickCheck as QC
+import Data.Proxy
+import Control.Exception (assert)
 
 --
 -- Modular Arithmetic
@@ -68,3 +71,100 @@ instance KnownNat m => Fractional (IntMod m) where
     _ -> error "not invertible"
     where modulus = fromIntegral (natVal t)
   fromRational = undefined
+
+{-
+import qualified Data.Vector.Unboxing  as U
+instance U.Unboxable (IntMod m) where
+  type Rep (IntMod m) = Int64
+-}
+
+recipM :: (Eq a, Integral a, Show a) => a -> a -> a
+recipM !x modulo = case exEuclid x modulo of
+                     (1,a,_) -> a `mod` modulo
+                     (-1,a,_) -> (-a) `mod` modulo
+                     (g,a,b) -> error $ show x ++ "^(-1) mod " ++ show modulo ++ " failed: gcd=" ++ show g
+
+-- |
+-- Assumption: @gcd m1 m2 == 1@
+--
+-- >>> crt 3 6 2 7
+-- 9
+-- >>> crt 2 5 3 9
+-- 12
+crt :: (Eq a, Integral a, Show a) => a -> a -> a -> a -> a
+crt !a1 !m1 !a2 !m2 = let !(s1,s2) = case exEuclid m2 m1 of
+                                       (1,b,c) -> (b `mod` m1, c `mod` m2)
+                                       (-1,b,c) -> ((-b) `mod` m1, (-c) `mod` m2)
+                                       (g,a,b) -> error $ "CRT: " ++ show m1 ++ " and " ++ show m2 ++ " not coprime; gcd=" ++ show (abs g)
+                          !_ = assert (s1 == recipM m2 m1) ()
+                          !_ = assert (s2 == recipM m1 m2) ()
+                          c1 = ((a1 `mod` m1) * s1) `rem` m1
+                          c2 = ((a2 `mod` m2) * s2) `rem` m2
+                          m = m1 * m2
+                          result = c1 * m2 + c2 * m1
+                      in if result < m then
+                           result
+                         else
+                           result - m
+{-# SPECIALIZE crt :: Int64 -> Int64 -> Int64 -> Int64 -> Int64 #-}
+
+-- |
+-- Assumption: @gcd m1 m2 == 1@
+crt' :: (KnownNat m1, KnownNat m2) => IntMod m1 -> IntMod m2 -> IntMod (m1 * m2)
+crt' x1@(IntMod !a1) x2@(IntMod !a2) = let !(s1,s2) = case exEuclid m2 m1 of
+                                             (1,b,c) -> (b `mod` m1, c `mod` m2)
+                                             (-1,b,c) -> ((-b) `mod` m1, (-c) `mod` m2)
+                                             (g,a,b) -> error $ "CRT: " ++ show m1 ++ " and " ++ show m2 ++ " not coprime; gcd=" ++ show (abs g)
+                                           !_ = assert (s1 == recipM m2 m1) ()
+                                           !_ = assert (s2 == recipM m1 m2) ()
+                                           c1 = (a1 * s1) `rem` m1
+                                           c2 = (a2 * s2) `rem` m2
+                                           result = c1 * m2 + c2 * m1
+                                       in IntMod $ if result < m then
+                                                     result
+                                                   else
+                                                     result - m
+  where
+    m1 = fromIntegral (natVal x1)
+    m2 = fromIntegral (natVal x2)
+    m = m1 * m2
+
+--
+-- Tests
+--
+
+instance KnownNat m => QC.Arbitrary (IntMod m) where
+  arbitrary = let result = IntMod <$> QC.choose (0, m - 1)
+                  m = fromIntegral (natVal (proxy result))
+              in result
+    where
+      proxy :: f (IntMod m) -> Proxy m
+      proxy _ = Proxy
+
+runTests :: IO ()
+runTests = do
+  QC.quickCheck $ QC.forAll (QC.choose (2, 10^9+9)) $ \m x -> prop_recipM x (QC.Positive m)
+  QC.quickCheck $ QC.withMaxSuccess 10000 $ QC.forAll (QC.choose (2, 10^9+9)) $ \m1 -> QC.forAll (QC.choose (2, 10^9+9)) $ \m2 x y -> prop_crt x (QC.Positive m1) y (QC.Positive m2)
+  QC.quickCheck $ QC.withMaxSuccess 10000 $ QC.forAll (QC.choose (2, 10^9+9)) $ \m1 -> QC.forAll (QC.choose (2, 10^9+9)) $ \m2 x y -> prop_crt' x (QC.Positive m1) y (QC.Positive m2)
+
+prop_recipM :: Int64 -> QC.Positive Int64 -> QC.Property
+prop_recipM x (QC.Positive m) = gcd x m == 1 && m > 1 && m <= 10^9 + 9 QC.==>
+  let y = recipM x m
+  in 0 <= y QC..&&. y < m QC..&&. ((x `mod` m) * recipM x m) `mod` m QC.=== 1
+
+prop_crt :: Int64 -> QC.Positive Int64 -> Int64 -> QC.Positive Int64 -> QC.Property
+prop_crt a1 (QC.Positive m1) a2 (QC.Positive m2)
+  = gcd m1 m2 == 1 QC.==> let r = crt a1 m1 a2 m2
+                          in r `mod` m1 QC.=== a1 `mod` m1 QC..&&. r `mod` m2 QC.=== a2 `mod` m2
+
+prop_crt' :: Int64 -> QC.Positive Int64 -> Int64 -> QC.Positive Int64 -> QC.Property
+prop_crt' a1 (QC.Positive m1) a2 (QC.Positive m2)
+  = gcd m1 m2 == 1 QC.==> case (someNatVal (fromIntegral m1), someNatVal (fromIntegral m2)) of
+                            (SomeNat p1, SomeNat p2) ->
+                              let x = fromIntegral a1 `asIntModProxy` p1
+                                  y = fromIntegral a2 `asIntModProxy` p2
+                                  IntMod r = crt' x y
+                              in 0 <= r QC..&&. r < m1 * m2 QC..&&. r `mod` m1 QC.=== a1 `mod` m1 QC..&&. r `mod` m2 QC.=== a2 `mod` m2
+  where
+    asIntModProxy :: IntMod m -> Proxy m -> IntMod m
+    asIntModProxy x _ = x

From 5ccce95ca94f3e6a34aff60b8d854cfd7233e1ea Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Sun, 24 Jan 2021 00:56:00 +0900
Subject: [PATCH 143/148] Convolution: Mutable version

---
 practice2-f/Mutable.hs | 188 +++++++++++++++++++++++++++++++++++++++++
 1 file changed, 188 insertions(+)
 create mode 100644 practice2-f/Mutable.hs

diff --git a/practice2-f/Mutable.hs b/practice2-f/Mutable.hs
new file mode 100644
index 0000000..67ab014
--- /dev/null
+++ b/practice2-f/Mutable.hs
@@ -0,0 +1,188 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns               #-}
+{-# LANGUAGE DataKinds                  #-}
+{-# LANGUAGE DerivingStrategies         #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE NoStarIsType               #-}
+{-# LANGUAGE ScopedTypeVariables        #-}
+{-# LANGUAGE TypeApplications           #-}
+{-# LANGUAGE TypeFamilies               #-}
+{-# LANGUAGE TypeOperators              #-}
+import           Control.Exception            (assert)
+import           Control.Monad
+import           Control.Monad.ST
+import           Data.Bits
+import qualified Data.ByteString.Builder      as BSB
+import qualified Data.ByteString.Char8        as BS
+import           Data.Char                    (isSpace)
+import           Data.Int                     (Int64)
+import           Data.List
+import qualified Data.Vector.Generic          as G
+import qualified Data.Vector.Generic.Mutable  as GM
+import qualified Data.Vector.Unboxing         as U
+import qualified Data.Vector.Unboxing.Mutable as UM
+import           GHC.TypeNats
+import           System.IO                    (stdout)
+
+-- main = print (findPrimitiveNthRoot (2^23) :: R)
+
+main = do
+  [n,m] <- unfoldr (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  xs <- U.map fromIntegral . U.unfoldrN n (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  ys <- U.map fromIntegral . U.unfoldrN m (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  let !zs = U.take (n + m - 1) $ mulFFT xs ys
+  BSB.hPutBuilder stdout $ mconcat (intersperse (BSB.char8 ' ') [ BSB.int64Dec x | R (IntMod x) <- U.toList zs ]) <> BSB.char8 '\n'
+
+--
+-- Fast Fourier Transform (FFT)
+--
+
+halve :: G.Vector vec a => vec a -> vec a
+halve v = let n = G.length v
+          in G.generate (n `quot` 2) $ \j -> v G.! (j * 2)
+
+fftM :: forall vec a s. (Num a, G.Vector vec a)
+     => [vec a] -- ^ For a primitive n-th root of unity @u@, @iterate halve [1,u,u^2 .. u^(n-1)]@
+     -> vec a -- ^ a polynomial of length n (= 2^k for some k)
+     -> Int
+     -> G.Mutable vec s a
+     -> ST s ()
+fftM (!u:u2) !f !s !dest
+  | n == 1 = GM.write dest 0 (G.head f)
+  | otherwise = let !n2 = n `quot` 2
+                    r0, r1' :: vec a
+                    r0 = G.generate n2 $ \j -> (f G.! j) + (f G.! (j + n2))
+                    r1' = G.generate n2 $ \j -> ((f G.! j) - (f G.! (j + n2))) * u G.! j
+                in do fftM u2 r0 (2 * s) dest
+                      fftM u2 r1' (2 * s) (GM.drop s dest)
+  where n = G.length f
+{-# SPECIALIZE fftM :: [U.Vector R] -> U.Vector R -> Int -> UM.MVector s R -> ST s () #-}
+
+fft :: forall vec a. (Num a, G.Vector vec a)
+    => [vec a] -- ^ For a primitive n-th root of unity @u@, @iterate halve [1,u,u^2 .. u^(n-1)]@
+    -> vec a -- ^ a polynomial of length n (= 2^k for some k)
+    -> vec a
+fft us f = G.create $ do
+  dest <- GM.new (G.length f)
+  fftM us f 1 dest
+  return dest
+{-# SPECIALIZE fft :: [U.Vector R] -> U.Vector R -> U.Vector R #-}
+
+zeroExtend :: (Num a, U.Unboxable a) => Int -> U.Vector a -> U.Vector a
+zeroExtend n v | U.length v >= n = v
+               | otherwise = U.create $ do
+                   w <- UM.replicate n 0
+                   U.copy (UM.take (U.length v) w) v
+                   return w
+{-# SPECIALIZE zeroExtend :: Int -> U.Vector R -> U.Vector R #-}
+
+mulFFT :: forall a. (U.Unboxable a, Fractional a, PrimitiveRoot a) => U.Vector a -> U.Vector a -> U.Vector a
+mulFFT !f !g = let n' = U.length f + U.length g - 2
+                   k = finiteBitSize n' - countLeadingZeros n'
+                   !_ = assert (n' < 2^k) ()
+                   n = bit k
+                   u0 = nthRoot n
+                   us :: [U.Vector a]
+                   us = iterate halve $ U.iterateN n (* u0) 1
+                   f'' = fft us (zeroExtend n f)
+                   g'' = fft us (zeroExtend n g)
+                   v0 = recip u0
+                   vs :: [U.Vector a]
+                   vs = iterate halve $ U.iterateN n (* v0) 1
+                   fg' = fft vs (U.zipWith (*) f'' g'')
+                   !recip_n = recip (fromIntegral n)
+               in U.map (* recip_n) fg'
+{-# SPECIALIZE mulFFT :: U.Vector R -> U.Vector R -> U.Vector R #-}
+
+class PrimitiveRoot a where
+  -- (nthRoot n)^n == 1
+  -- (nthRoot (2 * m))^m == -1
+  nthRoot :: Int -> a
+
+order' :: (Eq a, Num a) => Int -> a -> Int
+order' !m !x = go 1 x
+  where
+    go !n 1 = n
+    go !n y | n > m = m + 1
+    go !n y = go (n + 1) (x * y)
+
+findPrimitiveNthRoot :: (Eq a, Num a) => Int -> a
+findPrimitiveNthRoot n = head [ x | k <- [1..], let x = fromInteger k, order' n x == n ]
+
+-- Z / 998244353 Z
+newtype R = R { unwrapR :: IntMod 998244353 } deriving newtype (Eq, Show, Num, Fractional)
+
+instance U.Unboxable R where
+  type Rep R = Int64
+
+instance PrimitiveRoot R where
+  nthRoot n | (998244353 - 1) `rem` n /= 0 = error "nthRoot: does not exist"
+            | n .&. (n - 1) == 0 = let k = round (log (fromIntegral n) / log 2) :: Int
+                                   in 31 ^ (2^(23 - k) :: Int)
+            | otherwise = error "nthRoot: not implemented"
+
+{-# RULES
+"fromIntegral/Int->R" fromIntegral = R . fromIntegral_Int64_IntMod . (fromIntegral :: Int -> Int64)
+"fromIntegral/Int64->R" fromIntegral = R . fromIntegral_Int64_IntMod
+ #-}
+
+--
+-- Modular Arithmetic
+--
+
+newtype IntMod (m :: Nat) = IntMod { unwrapN :: Int64 } deriving (Eq)
+
+instance Show (IntMod m) where
+  show (IntMod x) = show x
+
+instance KnownNat m => Num (IntMod m) where
+  t@(IntMod x) + IntMod y
+    | x + y >= modulus = IntMod (x + y - modulus)
+    | otherwise = IntMod (x + y)
+    where modulus = fromIntegral (natVal t)
+  t@(IntMod x) - IntMod y
+    | x >= y = IntMod (x - y)
+    | otherwise = IntMod (x - y + modulus)
+    where modulus = fromIntegral (natVal t)
+  t@(IntMod x) * IntMod y = IntMod ((x * y) `rem` modulus)
+    where modulus = fromIntegral (natVal t)
+  fromInteger n = let result = IntMod (fromInteger (n `mod` fromIntegral modulus))
+                      modulus = natVal result
+                  in result
+  abs = undefined; signum = undefined
+  {-# SPECIALIZE instance Num (IntMod 998244353) #-}
+
+fromIntegral_Int64_IntMod :: KnownNat m => Int64 -> IntMod m
+fromIntegral_Int64_IntMod n = result
+  where
+    result | 0 <= n && n < modulus = IntMod n
+           | otherwise = IntMod (n `mod` modulus)
+    modulus = fromIntegral (natVal result)
+{-# SPECIALIZE fromIntegral_Int64_IntMod :: Int64 -> IntMod 998244353 #-}
+
+{-# RULES
+"fromIntegral/Int->IntMod" fromIntegral = fromIntegral_Int64_IntMod . (fromIntegral :: Int -> Int64) :: Int -> IntMod (10^9 + 7)
+"fromIntegral/Int64->IntMod" fromIntegral = fromIntegral_Int64_IntMod :: Int64 -> IntMod (10^9 + 7)
+"fromIntegral/Int->IntMod 998244353" fromIntegral = fromIntegral_Int64_IntMod . (fromIntegral :: Int -> Int64) :: Int -> IntMod 998244353
+"fromIntegral/Int64->IntMod 998244353" fromIntegral = fromIntegral_Int64_IntMod :: Int64 -> IntMod 998244353
+ #-}
+
+instance U.Unboxable (IntMod m) where
+  type Rep (IntMod m) = Int64
+
+exEuclid :: (Eq a, Integral a) => a -> a -> (a, a, a)
+exEuclid !f !g = loop 1 0 0 1 f g
+  where loop !u0 !u1 !v0 !v1 !f 0 = (f, u0, v0)
+        loop !u0 !u1 !v0 !v1 !f g =
+          case divMod f g of
+            (q,r) -> loop u1 (u0 - q * u1) v1 (v0 - q * v1) g r
+{-# SPECIALIZE exEuclid :: Int64 -> Int64 -> (Int64, Int64, Int64) #-}
+
+instance KnownNat m => Fractional (IntMod m) where
+  recip t@(IntMod x) = IntMod $ case exEuclid x modulus of
+    (1,a,_)  -> a `mod` modulus
+    (-1,a,_) -> (-a) `mod` modulus
+    _        -> error "not invertible"
+    where modulus = fromIntegral (natVal t)
+  fromRational = undefined

From 53fec8efef56b6dcec9e2d22370495a5f7a1e883 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Sun, 24 Jan 2021 23:37:41 +0900
Subject: [PATCH 144/148] practice2-f: In-place FFT

---
 practice2-f/Mutable.hs | 75 ++++++++++++++++++++++++++++++++----------
 1 file changed, 57 insertions(+), 18 deletions(-)

diff --git a/practice2-f/Mutable.hs b/practice2-f/Mutable.hs
index 67ab014..6068098 100644
--- a/practice2-f/Mutable.hs
+++ b/practice2-f/Mutable.hs
@@ -18,6 +18,7 @@ import qualified Data.ByteString.Char8        as BS
 import           Data.Char                    (isSpace)
 import           Data.Int                     (Int64)
 import           Data.List
+import Data.Word
 import qualified Data.Vector.Generic          as G
 import qualified Data.Vector.Generic.Mutable  as GM
 import qualified Data.Vector.Unboxing         as U
@@ -44,30 +45,60 @@ halve v = let n = G.length v
 
 fftM :: forall vec a s. (Num a, G.Vector vec a)
      => [vec a] -- ^ For a primitive n-th root of unity @u@, @iterate halve [1,u,u^2 .. u^(n-1)]@
-     -> vec a -- ^ a polynomial of length n (= 2^k for some k)
-     -> Int
-     -> G.Mutable vec s a
+     -> G.Mutable vec s a -- ^ a vector of length n (= 2^k for some k)
      -> ST s ()
-fftM (!u:u2) !f !s !dest
-  | n == 1 = GM.write dest 0 (G.head f)
-  | otherwise = let !n2 = n `quot` 2
-                    r0, r1' :: vec a
-                    r0 = G.generate n2 $ \j -> (f G.! j) + (f G.! (j + n2))
-                    r1' = G.generate n2 $ \j -> ((f G.! j) - (f G.! (j + n2))) * u G.! j
-                in do fftM u2 r0 (2 * s) dest
-                      fftM u2 r1' (2 * s) (GM.drop s dest)
-  where n = G.length f
-{-# SPECIALIZE fftM :: [U.Vector R] -> U.Vector R -> Int -> UM.MVector s R -> ST s () #-}
+fftM (!u:u2) !f
+  | n == 1 = return ()
+  | otherwise = do let !n2 = n `quot` 2
+                   forM_ [0..n2-1] $ \j -> do
+                     !fj <- GM.read f j
+                     !fj' <- GM.read f (j + n2)
+                     GM.write f j $! fj + fj'
+                     GM.write f (j + n2) $! (fj - fj') * u G.! j
+                   let !(r0,r1') = GM.splitAt n2 f
+                   fftM u2 r0
+                   fftM u2 r1'
+  where n = GM.length f
+{-# SPECIALIZE fftM :: [U.Vector R] -> UM.MVector s R -> ST s () #-}
 
 fft :: forall vec a. (Num a, G.Vector vec a)
     => [vec a] -- ^ For a primitive n-th root of unity @u@, @iterate halve [1,u,u^2 .. u^(n-1)]@
     -> vec a -- ^ a polynomial of length n (= 2^k for some k)
     -> vec a
 fft us f = G.create $ do
-  dest <- GM.new (G.length f)
-  fftM us f 1 dest
-  return dest
-{-# SPECIALIZE fft :: [U.Vector R] -> U.Vector R -> U.Vector R #-}
+  let !n = G.length f
+  f' <- G.thaw f
+  fftM us f'
+  let !k = countTrailingZeros n
+  forM_ [0..n-1] $ \i -> do
+    let j = fromIntegral (bitRevN k (fromIntegral i))
+    when (i < j) $ GM.swap f' i j
+  return f'
+{-# INLINE fft #-}
+
+bitRevN :: Int -> Word -> Word
+bitRevN w x = bitReverse x `shiftR` (finiteBitSize x - w)
+
+bitReverse :: Word -> Word
+bitReverse x = case finiteBitSize x of
+                 32 -> fromIntegral (bitReverse32 (fromIntegral x))
+                 64 -> fromIntegral (bitReverse64 (fromIntegral x))
+                 _ -> error "bitReverse: unsupported word size"
+
+bitReverse32 :: Word32 -> Word32
+bitReverse32 !x0 = let !x1 = ((x0 .&. 0xaaaaaaaa) `shiftR` 1) .|. ((x0 .&. 0x55555555) `shiftL` 1)
+                       !x2 = ((x1 .&. 0xcccccccc) `shiftR` 2) .|. ((x1 .&. 0x33333333) `shiftL` 2)
+                       !x3 = ((x2 .&. 0xf0f0f0f0) `shiftR` 4) .|. ((x2 .&. 0x0f0f0f0f) `shiftL` 4)
+                       !x4 = ((x3 .&. 0xff00ff00) `shiftR` 8) .|. ((x3 .&. 0x00ff00ff) `shiftL` 8)
+                   in (x4 `shiftR` 16) .|. (x4 `shiftL` 16)
+
+bitReverse64 :: Word64 -> Word64
+bitReverse64 !x0 = let !x1 = ((x0 .&. 0xaaaaaaaaaaaaaaaa) `shiftR` 1) .|. ((x0 .&. 0x5555555555555555) `shiftL` 1)
+                       !x2 = ((x1 .&. 0xcccccccccccccccc) `shiftR` 2) .|. ((x1 .&. 0x3333333333333333) `shiftL` 2)
+                       !x3 = ((x2 .&. 0xf0f0f0f0f0f0f0f0) `shiftR` 4) .|. ((x2 .&. 0x0f0f0f0f0f0f0f0f) `shiftL` 4)
+                       !x4 = ((x3 .&. 0xff00ff00ff00ff00) `shiftR` 8) .|. ((x3 .&. 0x00ff00ff00ff00ff) `shiftL` 8)
+                       !x5 = ((x4 .&. 0xffff0000ffff0000) `shiftR` 16) .|. ((x4 .&. 0x0000ffff0000ffff) `shiftL` 16)
+                   in (x5 `shiftR` 32) .|. (x5 `shiftL` 32)
 
 zeroExtend :: (Num a, U.Unboxable a) => Int -> U.Vector a -> U.Vector a
 zeroExtend n v | U.length v >= n = v
@@ -75,7 +106,7 @@ zeroExtend n v | U.length v >= n = v
                    w <- UM.replicate n 0
                    U.copy (UM.take (U.length v) w) v
                    return w
-{-# SPECIALIZE zeroExtend :: Int -> U.Vector R -> U.Vector R #-}
+{-# INLINE zeroExtend #-}
 
 mulFFT :: forall a. (U.Unboxable a, Fractional a, PrimitiveRoot a) => U.Vector a -> U.Vector a -> U.Vector a
 mulFFT !f !g = let n' = U.length f + U.length g - 2
@@ -147,10 +178,18 @@ instance KnownNat m => Num (IntMod m) where
     where modulus = fromIntegral (natVal t)
   t@(IntMod x) * IntMod y = IntMod ((x * y) `rem` modulus)
     where modulus = fromIntegral (natVal t)
+  negate t@(IntMod x) | x == 0 = t
+                      | otherwise = IntMod (modulus - x)
+    where modulus = fromIntegral (natVal t)
   fromInteger n = let result = IntMod (fromInteger (n `mod` fromIntegral modulus))
                       modulus = natVal result
                   in result
   abs = undefined; signum = undefined
+  {-# INLINE (+) #-}
+  {-# INLINE (-) #-}
+  {-# INLINE (*) #-}
+  {-# INLINE negate #-}
+  {-# INLINE fromInteger #-}
   {-# SPECIALIZE instance Num (IntMod 998244353) #-}
 
 fromIntegral_Int64_IntMod :: KnownNat m => Int64 -> IntMod m

From b571a65bae7794b315e39b95ab1b2b62706f3aaa Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Sat, 6 Feb 2021 23:29:11 +0900
Subject: [PATCH 145/148] ABC191-D

---
 abc/README.md        | 11 +++++++++++
 abc/abc191-d/Main.hs | 46 ++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 57 insertions(+)
 create mode 100644 abc/abc191-d/Main.hs

diff --git a/abc/README.md b/abc/README.md
index ebc9aeb..c4cca87 100644
--- a/abc/README.md
+++ b/abc/README.md
@@ -438,3 +438,14 @@
 * [x] D - Hachi
 * [ ] E - Transformable Teacher
 * [ ] F - Silver Woods
+
+## AtCoder Beginner Contest 191
+
+<https://atcoder.jp/contests/abc191>
+
+* [ ] A - Vanishing Pitch
+* [ ] B - Remove It
+* [ ] C - Digital Graffiti
+* [x] D - Circle Lattice Points
+* [ ] E - Come Back Quickly
+* [ ] F - GCD or MIN
diff --git a/abc/abc191-d/Main.hs b/abc/abc191-d/Main.hs
new file mode 100644
index 0000000..3a2e29c
--- /dev/null
+++ b/abc/abc191-d/Main.hs
@@ -0,0 +1,46 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE BangPatterns #-}
+import Data.Int (Int64)
+import qualified Data.ByteString.Char8 as BS
+import Data.Ratio
+
+main = do
+  [cx,cy,r] <- map (read @Double . BS.unpack) . BS.words <$> BS.getLine
+  let cx4, cy4, r4 :: Int64
+      cx4 = round (cx * 10^4)
+      cy4 = round (cy * 10^4)
+      r4 = round (r * 10^4)
+      isInside x y = (10^4 * x - cx4)^2 + (10^4 * y - cy4)^2 <= r4^2
+      minX = ceiling $ (cx4 - r4) % (10^4)
+      maxX = floor $ (cx4 + r4) % (10^4)
+      go1 !acc !x !yB !yT | x > maxX = acc
+                          | otherwise = let yB' = if isInside x yB then
+                                                    let go !y | isInside x (y - 1) = go (y - 1)
+                                                              | otherwise = y
+                                                    in go yB
+                                                  else
+                                                    let go !y | isInside x (y + 1) = y + 1
+                                                              | y > yT = y
+                                                              | otherwise = go (y + 1)
+                                                    in go yB
+                                            yT' = if isInside x yT then
+                                                    let go !y | isInside x (y + 1) = go (y + 1)
+                                                              | otherwise = y
+                                                    in go yT
+                                                  else
+                                                    let go !y | isInside x (y - 1) = y - 1
+                                                              | y < yB = y
+                                                              | otherwise = go (y - 1)
+                                                    in go yT
+                                        in if yT' < yB' then
+                                             acc
+                                           else
+                                             go1 (acc + yT' - yB' + 1) (x + 1) yB' yT'
+      y0 = round cy
+      go0 !x | x > maxX = 0
+             | otherwise = if isInside x y0 then
+                             go1 0 x y0 y0
+                           else
+                             go0 (x + 1)
+  print $ go0 minX

From 6bbc142ce681d09421af70c60db6c19170a9da88 Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Tue, 13 Sep 2022 22:57:49 +0900
Subject: [PATCH 146/148] ARC033-D

---
 README.md        |  9 +++++
 arc033-d/Main.hs | 85 ++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 94 insertions(+)
 create mode 100644 arc033-d/Main.hs

diff --git a/README.md b/README.md
index e8103f0..3a913c1 100644
--- a/README.md
+++ b/README.md
@@ -377,3 +377,12 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 * [ ] A - 深さ優先探索
 * [ ] B - Union Find
 * [x] C - 高速フーリエ変換
+
+## AtCoder Regular Contest 033
+
+<https://atcoder.jp/contests/arc033>
+
+* [ ] A - 隠れた言葉
+* [ ] B - メタ構文変数
+* [ ] C - データ構造
+* [x] D - 見たことのない多項式
diff --git a/arc033-d/Main.hs b/arc033-d/Main.hs
new file mode 100644
index 0000000..de6ff58
--- /dev/null
+++ b/arc033-d/Main.hs
@@ -0,0 +1,85 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE BangPatterns     #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies     #-}
+import qualified Data.ByteString.Char8        as BS
+import           Data.Char                    (isSpace)
+import           Data.Coerce
+import           Data.Int                     (Int64)
+import qualified Data.Vector.Unboxing         as U
+
+main = do
+  n <- readLn @Int -- 1 <= n <= 10^5
+  values <- U.map (fromIntegral :: Int -> N) . U.unfoldrN (n + 1) (BS.readInt . BS.dropWhile isSpace) <$> BS.getLine
+  t <- readLn @Int -- 1 <= t <= 10^9
+  if t <= n then
+    print (values U.! t)
+  else do
+    let t_n = product $ map fromIntegral [t-n..t] :: N
+    let fact = U.scanl (*) 1 $ U.map fromIntegral $ U.fromListN n [1..n] :: U.Vector N
+    print $ t_n * sum [ s * values U.! i / d
+                      | i <- [0..n]
+                      , let s = if even (n - i) then 1 else -1
+                      , let d = fromIntegral (t - i) * fact U.! i * fact U.! (n - i)
+                      ]
+
+--
+-- Modular Arithmetic
+--
+
+modulo :: Int64
+modulo = 10^9+7
+addMod, subMod, mulMod :: Int64 -> Int64 -> Int64
+addMod !x !y | x + y >= modulo = x + y - modulo
+             | otherwise = x + y
+subMod !x !y | x >= y = x - y
+             | otherwise = x - y + modulo
+mulMod !x !y = (x * y) `rem` modulo
+
+newtype N = N { unwrapN :: Int64 } deriving (Eq)
+instance Show N where
+  show (N x) = show x
+instance Num N where
+  (+) = coerce addMod
+  (-) = coerce subMod
+  (*) = coerce mulMod
+  fromInteger n = N (fromInteger (n `mod` fromIntegral modulo))
+  abs = undefined; signum = undefined
+
+{-# RULES
+"^9/Int" forall x. x ^ (9 :: Int) = let u = x; v = u * u * u in v * v * v
+"^9/Integer" forall x. x ^ (9 :: Integer) = let u = x; v = u * u * u in v * v * v
+ #-}
+
+fromIntegral_Int64_N :: Int64 -> N
+fromIntegral_Int64_N n | 0 <= n && n < modulo = N n
+                       | otherwise = N (n `mod` modulo)
+
+{-# RULES
+"fromIntegral/Int->N" fromIntegral = fromIntegral_Int64_N . (fromIntegral :: Int -> Int64)
+"fromIntegral/Int64->N" fromIntegral = fromIntegral_Int64_N
+ #-}
+
+---
+
+exEuclid :: (Eq a, Integral a) => a -> a -> (a, a, a)
+exEuclid !f !g = loop 1 0 0 1 f g
+  where loop !u0 !u1 !v0 !v1 !f 0 = (f, u0, v0)
+        loop !u0 !u1 !v0 !v1 !f g =
+          case divMod f g of
+            (q,r) -> loop u1 (u0 - q * u1) v1 (v0 - q * v1) g r
+
+recipM :: Int64 -> Int64
+recipM !x = case exEuclid x modulo of
+             (1,a,_)  -> a `mod` modulo
+             (-1,a,_) -> (-a) `mod` modulo
+divM :: Int64 -> Int64 -> Int64
+divM !x !y = x `mulMod` recipM y
+
+instance Fractional N where
+  (/) = coerce divM
+  recip = coerce recipM
+  fromRational = undefined
+
+instance U.Unboxable N where
+  type Rep N = Int64

From 8b3f7f79976539b54fc5d8a3b4185006f072d53e Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Mon, 9 Jan 2023 14:58:54 +0900
Subject: [PATCH 147/148] ABC284-D

---
 README.md                          | 13 ++++++
 abc/abc284-d/Main.hs               | 66 ++++++++++++++++++++++++++++++
 abc/abc284-d/Search.hs             | 19 +++++++++
 abc/abc284-d/main-binarysearch.c   | 59 ++++++++++++++++++++++++++
 abc/abc284-d/main-longdouble.c     | 49 ++++++++++++++++++++++
 abc/abc284-d/main-round.c          | 45 ++++++++++++++++++++
 abc/abc284-d/main-trunc.c          | 45 ++++++++++++++++++++
 abc/abc284-d/validate-sqrt-trunc.c | 17 ++++++++
 package.yaml                       |  1 +
 9 files changed, 314 insertions(+)
 create mode 100644 abc/abc284-d/Main.hs
 create mode 100644 abc/abc284-d/Search.hs
 create mode 100644 abc/abc284-d/main-binarysearch.c
 create mode 100644 abc/abc284-d/main-longdouble.c
 create mode 100644 abc/abc284-d/main-round.c
 create mode 100644 abc/abc284-d/main-trunc.c
 create mode 100644 abc/abc284-d/validate-sqrt-trunc.c

diff --git a/README.md b/README.md
index 3a913c1..d2b45bb 100644
--- a/README.md
+++ b/README.md
@@ -386,3 +386,16 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで
 * [ ] B - メタ構文変数
 * [ ] C - データ構造
 * [x] D - 見たことのない多項式
+
+## AtCoder Beginner Contest 284
+
+<https://atcoder.jp/contests/abc284>
+
+* [ ] A - Sequence of Strings
+* [ ] B - Multi Test Cases
+* [ ] C - Count Connected Components
+* [x] D - Happy New Year 2023
+* [ ] E - Count Simple Paths
+* [ ] F - ABCBAC
+* [ ] G - Only Once
+* [ ] Ex - Count Unlabeled Graphs
diff --git a/abc/abc284-d/Main.hs b/abc/abc284-d/Main.hs
new file mode 100644
index 0000000..77c97bc
--- /dev/null
+++ b/abc/abc284-d/Main.hs
@@ -0,0 +1,66 @@
+-- https://github.com/minoki/my-atcoder-solutions
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE BangPatterns #-}
+import Data.Int (Int64)
+import Control.Monad
+import qualified Data.Vector.Unboxed as U
+import qualified Data.Vector.Unboxed.Mutable as UM
+
+{-
+-- i <= 4.5 * 10^18
+integerSquareRoot :: Int64 -> Int64
+integerSquareRoot i = loop 2 2121320343
+  where loop !low !high | low == high = low
+                        | otherwise = let !mid = (low + high) `quot` 2
+                                          !mid2 = mid * mid
+                                      in case compare i mid2 of
+                                           LT -> loop low mid
+                                           EQ -> mid
+                                           GT -> loop mid high
+-}
+integerSquareRoot :: Int64 -> Int64
+integerSquareRoot = round . sqrt . fromIntegral
+
+solve :: [Int64] -> Int64 -> (Int64, Int64)
+solve primes !n = case [(p,m) | p <- primes, (m,0) <- [n `quotRem` p]] of
+                    [] -> error "No prime factor found"
+                    (p,m):_ -> if m `rem` p == 0 then
+                                 (p, m `quot` p)
+                               else
+                                 -- m <= 4.5 * 10^18
+                                 (integerSquareRoot m, p)
+
+main = do
+  t <- readLn @Int
+  tests <- U.replicateM t $ readLn @Int64
+  let !primes = sieve 2080083 -- 2080083^3 < 9*10^18 < 2080084^3
+  U.forM_ tests $ \t -> do
+    let (p, q) = solve primes t
+    putStrLn $ show p ++ " " ++ show q
+
+--
+-- Sieve of Eratosthenes
+--
+
+infixr 5 !:
+(!:) :: a -> [a] -> [a]
+(!x) !: xs = x : xs
+
+-- | エラトステネスの篩により、 max 以下の素数の一覧を構築して返す
+-- >>> sieve 100
+-- [2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97]
+sieve :: Int -> [Int64]
+sieve !max = 2 : U.ifoldr (\i isPrime xs -> if isPrime then fromIntegral (2 * i + 1) !: xs else xs) [] vec
+  where
+    vec = U.create $ do
+      vec <- UM.replicate ((max - 1) `quot` 2 + 1) True
+      UM.write vec 0 False -- 1 is not a prime
+      -- vec ! i : is (2 * i + 1) prime?
+      let clear !p = forM_ [3*p,5*p..max] $ \n -> UM.write vec (n `quot` 2) False
+          factorBound = floor (sqrt (fromIntegral max) :: Double)
+          loop !i | 2 * i + 1 > factorBound = return ()
+                  | otherwise = do b <- UM.read vec i
+                                   when b $ clear (2 * i + 1)
+                                   loop (i + 1)
+      loop 1
+      return vec
diff --git a/abc/abc284-d/Search.hs b/abc/abc284-d/Search.hs
new file mode 100644
index 0000000..6447289
--- /dev/null
+++ b/abc/abc284-d/Search.hs
@@ -0,0 +1,19 @@
+import Data.Int (Int64)
+import qualified Test.QuickCheck as QC
+import Math.NumberTheory.Primes
+
+test :: Int64 -> Bool
+test n = truncate (sqrt (fromIntegral (n^2 :: Int64) :: Double)) < n
+
+examples :: [Int64]
+examples = [a | p <- [nextPrime 94906266..precPrime 3037000499], let a = fromInteger (unPrime p), test a]
+
+prop :: QC.Property
+prop = let gen = QC.choose (94906266, 3037000499) -- 94906265^2 < 2^53 < 94906266^2, 3037000499^2 < 2^63 - 1 < 3037000500^2
+       in QC.forAll gen (\n -> truncate (fromIntegral (n^2 :: Int64) :: Double) < n^2)
+
+-- main = QC.quickCheck prop
+
+main = print $ take 10 [n | n <- [94906266..3037000499], test n]
+
+-- main = print examples
diff --git a/abc/abc284-d/main-binarysearch.c b/abc/abc284-d/main-binarysearch.c
new file mode 100644
index 0000000..c9b77d9
--- /dev/null
+++ b/abc/abc284-d/main-binarysearch.c
@@ -0,0 +1,59 @@
+#include <inttypes.h>
+#include <math.h>
+#include <stdio.h>
+#include <stdlib.h>
+
+// 入力：n <= 4.5*10^18, nは平方数
+int64_t isqrt(int64_t n)
+{
+    // 4.5*10^18 < 2^62
+    // 真の答えは 2 <= _ < 2^31 の範囲にある
+    int64_t low = 2, high = INT64_C(1) << 31;
+    while (low < high) {
+        int64_t mid = (low + high) / 2;
+        int64_t mid2 = mid * mid;
+        if (mid2 < n) {
+            low = mid;
+        } else if (mid2 == n) {
+            return mid;
+        } else {
+            high = mid;
+        }
+    }
+    return low;
+}
+
+struct result {
+    int64_t p, q;
+};
+
+// 入力：N <= 9*10^18
+struct result solve(int64_t N)
+{
+    // 2080083^3 < 9*10^18 < 2080084^3
+    for (int64_t a = 2; a <= 2080083; ++a) {
+        if (N % a == 0) {
+            int64_t b = N / a;
+            if (b % a == 0) {
+                // a = p
+                return (struct result){.p = a, .q = b / a};
+            } else {
+                // a = q
+                return (struct result){.p = isqrt(b), .q = a};
+            }
+        }
+    }
+    abort();
+}
+
+int main()
+{
+    int T;
+    scanf("%d", &T);
+    for (int i = 0; i < T; ++i) {
+        int64_t N;
+        scanf("%" SCNd64, &N);
+        struct result r = solve(N);
+        printf("%" PRId64 " %" PRId64 "\n", r.p, r.q);
+    }
+}
diff --git a/abc/abc284-d/main-longdouble.c b/abc/abc284-d/main-longdouble.c
new file mode 100644
index 0000000..f92c318
--- /dev/null
+++ b/abc/abc284-d/main-longdouble.c
@@ -0,0 +1,49 @@
+#include <assert.h>
+#include <float.h>
+#include <inttypes.h>
+#include <math.h>
+#include <stdio.h>
+#include <stdlib.h>
+
+static_assert(LDBL_MANT_DIG >= 64, "not enough precision");
+
+// 入力：n <= 4.5*10^18, nは平方数
+int64_t isqrt(int64_t n)
+{
+    return (int64_t)sqrtl((long double)n);
+}
+
+struct result {
+    int64_t p, q;
+};
+
+// 入力：N <= 9*10^18
+struct result solve(int64_t N)
+{
+    // 2080083^3 < 9*10^18 < 2080084^3
+    for (int64_t a = 2; a <= 2080083; ++a) {
+        if (N % a == 0) {
+            int64_t b = N / a;
+            if (b % a == 0) {
+                // a = p
+                return (struct result){.p = a, .q = b / a};
+            } else {
+                // a = q
+                return (struct result){.p = isqrt(b), .q = a};
+            }
+        }
+    }
+    abort();
+}
+
+int main()
+{
+    int T;
+    scanf("%d", &T);
+    for (int i = 0; i < T; ++i) {
+        int64_t N;
+        scanf("%" SCNd64, &N);
+        struct result r = solve(N);
+        printf("%" PRId64 " %" PRId64 "\n", r.p, r.q);
+    }
+}
diff --git a/abc/abc284-d/main-round.c b/abc/abc284-d/main-round.c
new file mode 100644
index 0000000..4b1b8ac
--- /dev/null
+++ b/abc/abc284-d/main-round.c
@@ -0,0 +1,45 @@
+#include <inttypes.h>
+#include <math.h>
+#include <stdio.h>
+#include <stdlib.h>
+
+// 入力：n <= 4.5*10^18, nは平方数
+int64_t isqrt(int64_t n)
+{
+    return llround(sqrt((double)n));
+}
+
+struct result {
+    int64_t p, q;
+};
+
+// 入力：N <= 9*10^18
+struct result solve(int64_t N)
+{
+    // 2080083^3 < 9*10^18 < 2080084^3
+    for (int64_t a = 2; a <= 2080083; ++a) {
+        if (N % a == 0) {
+            int64_t b = N / a;
+            if (b % a == 0) {
+                // a = p
+                return (struct result){.p = a, .q = b / a};
+            } else {
+                // a = q
+                return (struct result){.p = isqrt(b), .q = a};
+            }
+        }
+    }
+    abort();
+}
+
+int main()
+{
+    int T;
+    scanf("%d", &T);
+    for (int i = 0; i < T; ++i) {
+        int64_t N;
+        scanf("%" SCNd64, &N);
+        struct result r = solve(N);
+        printf("%" PRId64 " %" PRId64 "\n", r.p, r.q);
+    }
+}
diff --git a/abc/abc284-d/main-trunc.c b/abc/abc284-d/main-trunc.c
new file mode 100644
index 0000000..1d47279
--- /dev/null
+++ b/abc/abc284-d/main-trunc.c
@@ -0,0 +1,45 @@
+#include <inttypes.h>
+#include <math.h>
+#include <stdio.h>
+#include <stdlib.h>
+
+// 入力：n <= 4.5*10^18, nは平方数
+int64_t isqrt(int64_t n)
+{
+    return (int64_t)sqrt((double)n);
+}
+
+struct result {
+    int64_t p, q;
+};
+
+// 入力：N <= 9*10^18
+struct result solve(int64_t N)
+{
+    // 2080083^3 < 9*10^18 < 2080084^3
+    for (int64_t a = 2; a <= 2080083; ++a) {
+        if (N % a == 0) {
+            int64_t b = N / a;
+            if (b % a == 0) {
+                // a = p
+                return (struct result){.p = a, .q = b / a};
+            } else {
+                // a = q
+                return (struct result){.p = isqrt(b), .q = a};
+            }
+        }
+    }
+    abort();
+}
+
+int main()
+{
+    int T;
+    scanf("%d", &T);
+    for (int i = 0; i < T; ++i) {
+        int64_t N;
+        scanf("%" SCNd64, &N);
+        struct result r = solve(N);
+        printf("%" PRId64 " %" PRId64 "\n", r.p, r.q);
+    }
+}
diff --git a/abc/abc284-d/validate-sqrt-trunc.c b/abc/abc284-d/validate-sqrt-trunc.c
new file mode 100644
index 0000000..0f3aabe
--- /dev/null
+++ b/abc/abc284-d/validate-sqrt-trunc.c
@@ -0,0 +1,17 @@
+#include <inttypes.h>
+#include <math.h>
+#include <stdio.h>
+
+int main()
+{
+    // 3037000499^2 < 2^63-1 < 3037000500^2
+    for (int64_t i = 0; i <= 3037000499; ++i) {
+        int64_t n = i * i;
+        int64_t j = (int64_t)sqrt((double)n);
+        if (i != j) {
+            printf("%" PRId64 "\n", i);
+            return 0;
+        }
+    }
+    puts("Done");
+}
diff --git a/package.yaml b/package.yaml
index 7be3e6a..850f71c 100644
--- a/package.yaml
+++ b/package.yaml
@@ -33,6 +33,7 @@ dependencies:
 - unboxing-vector
 - vector-algorithms
 - QuickCheck
+- arithmoi
 
 ghc-options:
 # Maximum heap size: 1GiB

From 08c3d609dd01745a8fb6b733431f0f31fd66292a Mon Sep 17 00:00:00 2001
From: ARATA Mizuki <minorinoki@gmail.com>
Date: Thu, 21 Sep 2023 18:55:04 +0900
Subject: [PATCH 148/148] ABC169-B: C version

---
 abc/abc169-b/main.c | 32 ++++++++++++++++++++++++++++++++
 1 file changed, 32 insertions(+)
 create mode 100644 abc/abc169-b/main.c

diff --git a/abc/abc169-b/main.c b/abc/abc169-b/main.c
new file mode 100644
index 0000000..796eee7
--- /dev/null
+++ b/abc/abc169-b/main.c
@@ -0,0 +1,32 @@
+#include <stdbool.h>
+#include <stdlib.h>
+#include <stdio.h>
+int main(void)
+{
+    int n;
+    scanf("%d", &n);
+    unsigned long long *input = calloc(n, sizeof(unsigned long long));
+    for (int i = 0; i < n; ++i) {
+        scanf("%llu", &input[i]);
+    }
+    unsigned long long p = 1;
+    bool overflow = false;
+    for (int i = 0; i < n; ++i) {
+        unsigned long long a = p, b = input[i];
+        if (b == 0ull) {
+            puts("0");
+            return 0;
+        }
+        unsigned long long c = a * b;
+        if (c > 1000000000000000000ull || c / a != b || c / b != a) {
+            overflow = true;
+        } else {
+            p = c;
+        }
+    }
+    if (overflow) {
+        puts("-1");
+    } else {
+        printf("%llu\n", p);
+    }
+}