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/ diff --git a/README.md b/README.md index ac30e5f..d2b45bb 100644 --- a/README.md +++ b/README.md @@ -6,22 +6,42 @@ Haskellを主に使用。 Haskellで競技プログラミングをやるテクニックは「[Haskellで競技プログラミングをやる](competitive-programming-with-haskell.md)」を参照。 +## AtCoder Beginner Contest + +[abc/README.md](abc/README.md) を参照。 + ## Typical DP Contest - + 解いた問題： -* A コンテスト -* B ゲーム -* C トーナメント -* D サイコロ -* E 数 -* F 準急 -* G 辞書順 -* H ナップザック -* T フィボナッチ +* [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 - 猫 +* [ ] M - 家 +* [ ] N - 木 +* [ ] O - 文字列 +* [ ] P - うなぎ +* [ ] Q - 連結 +* [ ] R - グラフ +* [ ] S - マス目 +* [x] T - フィボナッチ * 解説記事：[フィボナッチ数絡みの競プロの問題を解いてみた（Typical DP Contest T）](https://blog.miz-ar.info/2019/02/typical-dp-contest-t/) + * 行列の固有多項式が既知なので多項式除算を使って高速に行列累乗ができる ## Educational DP Contest @@ -29,23 +49,48 @@ 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 - -## AtCoder Beginner Contest 032 - - - -解いた問題： - -* D ナップサック問題 +* [x] A - Frog 1 +* [x] B - Frog 2 +* [x] C - Vacation +* [x] D - Knapsack 1 + * 01ナップサック問題。重さは比較的小さく（〜105）、価値は大きい（〜109） +* [x] E - Knapsack 2 + * 01ナップサック問題。重さは大きく（〜109）、価値は小さい（〜103） +* [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 +* [ ] Z - Frog 3 ## AtCoder Grand Contest 031 @@ -53,10 +98,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) @@ -64,45 +111,12 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで 解いた問題： -* A - Limited Insertion -* B - Balanced Neighbors - -## AtCoder Beginner Contest 122 (2019-03-24) - - - -解いた問題： - -* A - Double Helix -* B - ATCoder -* C - GeT AC -* 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 - - - -解いた問題： - -* A - White Cells -* B - Can you solve this? -* C - Energy Drink Collector -* D - XOR World - -## AtCoder Beginner Contest 120 - - - -解いた問題： - -* A - Favorite Sound -* B - K-th Common Divisor -* C - Unification -* D - Decayed Bridges +* [x] A - Limited Insertion +* [x] B - Balanced Neighbors +* [ ] C - Three Circuits +* [ ] D - Rotation Sort +* [ ] E - Modulo Pairing +* [ ] F - One Third ## エクサウィザーズ 2019 (2019-03-30) @@ -110,9 +124,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 +* [x] D - Modulo Operations +* [x] E - Black or White +* [ ] F - More Realistic Manhattan Distance ## AtCoder Grand Contest 023 @@ -120,18 +137,13 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで 解いた問題： -* A - Zero Sum Ranges - -## AtCoder Beginner Contest 124 (2019-04-13) - - - -解いた問題： - -* A - Buttons -* B - Great Ocean View -* C - Coloring Colorfully -* D - Handstand +* [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) @@ -139,19 +151,12 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで 解いた問題： -* C - Stones -* E - Polynomial Divisors - -## AtCoder Beginner Contest 125 (2019-04-27) - - - -解いた問題： - -* A - Biscuit Generator -* B - Resale -* C - GCD on Blackboard -* D - Flipping Signs +* [x] C - Stones +* [ ] D - Three Colors +* [x] E - Polynomial Divisors + * 素数と多項式 + * 有限体 Fp 上で関数として恒等的に0になるような多項式は xp-x で割り切れる +* [ ] F - Banned X ## エイシングプログラミングコンテスト2019 @@ -159,9 +164,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 @@ -177,146 +184,218 @@ Haskellで競技プログラミングをやるテクニックは「[Haskellで 解いた問題： -* A - 素数、コンテスト、素数 +* [x] A - 素数、コンテスト、素数 +* [ ] B - 解像度が低い。 +* [ ] C - 無駄なものが嫌いな人 +* [ ] D - ARCたんクッキー -## AtCoder Beginner Contest 086 +## diverta 2019 Programming Contest (2019-05-11) - + 解いた問題： -* A - Product - * [AtCoderに登録したら解くべき精選過去問10問](https://qiita.com/drken/items/fd4e5e3630d0f5859067) 1問目 -* C - Traveling - * AtCoderに登録したら解くべき精選過去問10問 10問目 +* [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 081 +## M-SOLUTIONS プロコンオープン (2019-06-01) - + 解いた問題： -* A - Placing Marbles - * AtCoderに登録したら解くべき精選過去問10問 2問目 -* B - Shift only - * AtCoderに登録したら解くべき精選過去問10問 3問目 +* [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 + * mod N での逆元や階乗の計算に帰着させる。 +* [ ] F - Random Tournament -## AtCoder Beginner Contest 087 +## AtCoder Grand Contest 034 (2019-06-02) - + 解いた問題： -* B - Coins - * AtCoderに登録したら解くべき精選過去問10問 4問目 +* [x] A - Kenken Race +* [x] B - ABC +* [ ] C - Tests +* [ ] D - Manhattan Max Matching +* [ ] E - Complete Compress +* [ ] F - RNG and XOR -## AtCoder Beginner Contest 083 +## diverta 2019 Programming Contest 2 (2019-06-15) - + 解いた問題： -* B - Some Sums - * AtCoderに登録したら解くべき精選過去問10問 5問目 +* [x] A - Ball Distribution +* [x] B - Picking Up +* [x] C - Successive Subtraction +* [x] D - Squirrel Merchant +* [ ] E - Balanced Piles +* [ ] F - Diverta City -## AtCoder Beginner Contest 088 +## AtCoder Grand Contest 035 (2019-07-14) - + -* B - Card Game for Two - * AtCoderに登録したら解くべき精選過去問10問 6問目 +* [x] A - XOR Circle +* [x] B - Even Degrees +* [x] C - Skolem XOR Tree +* [ ] D - Add and Remove +* [ ] E - Develop +* [ ] F - Two Histograms -## AtCoder Beginner Contest 085 +## AtCoder Grand Contest 036 (2019-07-21) - + -* B - Kagami Mochi - * AtCoderに登録したら解くべき精選過去問10問 7問目 -* C - Otoshidama - * AtCoderに登録したら解くべき精選過去問10問 8問目 +* [x] A - Triangle +* [x] B - Do Not Duplicate +* [x] C - GP 2 +* [ ] D - Negative Cycle +* [ ] E - ABC String +* [ ] F - Square Constraints -## AtCoder Beginner Contest 049 +## AtCoder Grand Contest 037 - + -* C - 白昼夢 / Daydream - * AtCoderに登録したら解くべき精選過去問10問 9問目 +* [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 -## diverta 2019 Programming Contest (2019-05-11) +## 第一回日本最強プログラマー学生選手権 -予選- (2019-08-24) - + -解いた問題： +* [x] A - Takahashi Calendar +* [x] B - Kleene Inversion +* [x] C - Cell Inversion +* [x] D - Classified +* [ ] E - Card Collector +* [ ] F - Candy Retribution -* A - Consecutive Integers -* B - RGB Boxes -* C - AB Substrings -* D - DivRem Number +## AtCoder Grand Contest 038 -## AtCoder Beginner Contest 126 (2019-05-19) + - +* [ ] A - 01 Matrix +* [ ] B - Sorting a Segment +* [ ] C - LCMs +* [ ] D - Unique Path +* [ ] E - Gachapon +* [ ] F - Two Permutations -解いた問題： +## AtCoder Grand Contest 039 (2019-10-05) -* A - Changing a Character -* B - YYMM or MMYY -* C - Dice and Coin -* D - Even Relation -* E - 1 or 2 -* F - XOR Matching + -## AtCoder Beginner Contest 127 +* [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 - +## AtCoder Grand Contest 040 (2019-11-04) -解いた問題： + -* A - Ferris Wheel -* B - Algae -* C - Prison -* D - Integer Cards +* [x] A - \>\< +* [ ] B - Two Contests +* [ ] C - Neither AB nor BA +* [ ] D - Balance Beam +* [ ] E - Prefix Suffix Addition +* [ ] F - Two Pieces -## AtCoder Beginner Contest 128 (2019-05-26) +## 第二回全国統一プログラミング王決定戦予選 (2019-11-09) - + -解いた問題： +* [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 -* A - Apple Pie -* B - Guidebook -* C - Switches -* D - equeue -* E - Roadwork +## DISCO presents ディスカバリーチャンネル コードコンテスト2020 予選 (2019-11-23) -## M-SOLUTIONS プロコンオープン (2019-06-01) + - +* [x] A - DDCC Finals +* [x] B - Iron Bar Cutting +* [x] C - Strawberry Cakes +* [x] D - Digit Sum Replace +* [ ] E - Majority of Balls +* [ ] F - DISCOSMOS -解いた問題： +## Judge System Update Test Contest 202004 -* A - Sum of Interior Angles -* B - Sumo -* E - Product of Arithmetic Progression + -## AtCoder Grand Contest 034 (2019-06-02) +* [x] A - Walking Takahashi +* [x] B - Picking Balls +* [x] C - Numbering Blocks +* [x] D - Calculating GCD - +## AtCoder Library Practice Contest -解いた問題： + -* A - Kenken Race -* B - ABC +* [x] A - Disjoint Set Union + * Union Find +* [x] B - Fenwick Tree + * Fenwick Tree, or Binary Indexed Tree +* [x] C - Floor Sum +* [ ] D - Maxflow +* [ ] E - MinCostFlow +* [x] F - Convolution +* [ ] G - SCC +* [ ] H - Two SAT +* [ ] I - Number of Substrings +* [ ] J - Segment Tree +* [ ] K - Range Affine Range Sum +* [ ] L - Lazy Segment Tree -## AtCoder Beginner Contest 129 (2019-06-09) +## AtCoder Typical Contest 001 - + -解いた問題： +* [ ] A - 深さ優先探索 +* [ ] B - Union Find +* [x] C - 高速フーリエ変換 + +## AtCoder Regular Contest 033 + + + +* [ ] A - 隠れた言葉 +* [ ] B - メタ構文変数 +* [ ] C - データ構造 +* [x] D - 見たことのない多項式 + +## AtCoder Beginner Contest 284 + + -* A - Airplane -* B - Balance -* C - Typical Stairs -* D - Lamp -* E - Sum Equals Xor -* F - Takahashi's Basics in Education and Learning +* [ ] 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/README.md b/abc/README.md new file mode 100644 index 0000000..c4cca87 --- /dev/null +++ b/abc/README.md @@ -0,0 +1,451 @@ +# AtCoder Beginner Contestのオレオレ解答集 by @mod_poppo + +## AtCoder Beginner Contest 032 + + + +解いた問題： + +* D - ナップサック問題 + * 0/1ナップサック問題。Nが小さいデータセット、重さが比較的小さいデータセット、価値が比較的小さいデータセットの3種類がある。 + +## AtCoder Beginner Contest 122 (2019-03-24) + + + +解いた問題： + +* [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 + + + +解いた問題： + +* [x] A - White Cells +* [x] B - Can you solve this? +* [x] C - Energy Drink Collector +* [x] D - XOR World + +## AtCoder Beginner Contest 120 + + + +解いた問題： + +* [x] A - Favorite Sound +* [x] B - K-th Common Divisor +* [x] C - Unification +* [x] D - Decayed Bridges + +## AtCoder Beginner Contest 124 (2019-04-13) + + + +解いた問題： + +* [x] A - Buttons +* [x] B - Great Ocean View +* [x] C - Coloring Colorfully +* [x] D - Handstand + +## AtCoder Beginner Contest 125 (2019-04-27) + + + +解いた問題： + +* [x] A - Biscuit Generator +* [x] B - Resale +* [x] C - GCD on Blackboard +* [x] D - Flipping Signs + +## AtCoder Beginner Contest 086 + + + +解いた問題： + +* A - Product + * [AtCoderに登録したら解くべき精選過去問10問](https://qiita.com/drken/items/fd4e5e3630d0f5859067) 1問目 +* C - Traveling + * AtCoderに登録したら解くべき精選過去問10問 10問目 + +## AtCoder Beginner Contest 081 + + + +解いた問題： + +* A - Placing Marbles + * AtCoderに登録したら解くべき精選過去問10問 2問目 +* B - Shift only + * AtCoderに登録したら解くべき精選過去問10問 3問目 + +## AtCoder Beginner Contest 087 + + + +解いた問題： + +* B - Coins + * AtCoderに登録したら解くべき精選過去問10問 4問目 + +## AtCoder Beginner Contest 083 + + + +解いた問題： + +* B - Some Sums + * AtCoderに登録したら解くべき精選過去問10問 5問目 + +## AtCoder Beginner Contest 088 + + + +* B - Card Game for Two + * AtCoderに登録したら解くべき精選過去問10問 6問目 + +## AtCoder Beginner Contest 085 + + + +* B - Kagami Mochi + * AtCoderに登録したら解くべき精選過去問10問 7問目 +* C - Otoshidama + * AtCoderに登録したら解くべき精選過去問10問 8問目 + +## AtCoder Beginner Contest 049 + + + +* C - 白昼夢 / Daydream + * AtCoderに登録したら解くべき精選過去問10問 9問目 + +## AtCoder Beginner Contest 126 (2019-05-19) + + + +解いた問題： + +* [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 + + + +解いた問題： + +* [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) + + + +解いた問題： + +* [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) + + + +解いた問題： + +* [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) + + + +解いた問題： + +* [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) + + + +解いた問題： + +* [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) + + + +解いた問題： + +* [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) + + + +解いた問題： + +* [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) + + + +* [x] A - Dodecagon +* [x] B - Golden Apple +* [x] C - Exception Handling +* [x] D - Preparing Boxes +* [x] E - Sequence Decomposing +* [ ] F - Permutation Oddness + +## AtCoder Beginner Contest 135 (2019-07-27) + + + +* [x] A - Harmony +* [x] B - 0 or 1 Swap +* [x] C - City Savers +* [x] D - Digits Parade +* [x] E - Golf +* [ ] F - Strings of Eternity + +## AtCoder Beginner Contest 136 (2019-08-04) + + + +* [x] A - Transfer +* [x] B - Uneven Numbers +* [x] C - Build Stairs +* [x] D - Gathering Children +* [x] E - Max GCD +* [ ] F - Enclosed Points + +## AtCoder Beginner Contest 137 (2019-08-10) + + + +* [x] A - +-x +* [x] B - One Clue +* [x] C - Green Bin +* [x] D - Summer Vacation +* [x] E - Coins Respawn +* [x] F - Polynomial Construction + * 有限体上の多項式を構築する + * 多項式補間っぽいが……？ + +## AtCoder Beginner Contest 138 + + + +* [x] A - Red or Not +* [x] B - Resistors in Parallel +* [x] C - Alchemist +* [x] D - Ki +* [x] E - Strings of Impurity +* [x] F - Coincidence + +## AtCoder Beginner Contest 139 (2019-09-01) + + + +* [x] A - Tenki +* [x] B - Power Socket +* [x] C - Lower +* [x] D - ModSum +* [x] E - League + * 有向グラフの閉路判定と、DAGの最長路 +* [x] F - Engines + +## AtCoder Beginner Contest 140 (2019-09-07) + + + +* [x] A - Password +* [x] B - Buffet +* [x] C - Maximal Value +* [x] D - Face Produces Unhappiness +* [ ] E - Second Sum +* [x] F - Many Slimes + +## AtCoder Beginner Contest 141 (2019-09-15) + + + +* [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 + +## AtCoder Beginner Contest 142 (2019-09-28) + + + +* [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 + +## AtCoder Beginner Contest 143 + + + +* [x] A - Curtain +* [x] B - TAKOYAKI FESTIVAL 2019 +* [x] C - Slimes +* [x] D - Triangles +* [x] E - Travel by Car +* [ ] F - Distinct Numbers + +## AtCoder Beginner Contest 144 (2019-10-27) + + + +* [x] A - 9x9 +* [x] B - 81 +* [x] C - Walk on Multiplication Table +* [x] D - Water Bottle +* [ ] E - Gluttony +* [ ] F - Fork in the Road + +## AtCoder Beginner Contest 145 + +## AtCoder Beginner Contest 146 (2019-11-24) + + + +* [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 + +## AtCoder Beginner Contest 149 + + + +* [ ] A - Strings +* [ ] B - Greedy Takahashi +* [x] C - Next Prime +* [ ] D - Prediction and Restriction +* [ ] E - Handshake +* [ ] F - Surrounded Notes + +## AtCoder Beginner Contest 162 + + + +* [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 + +## AtCoder Beginner Contest 169 + + + +* [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 + + + +* [x] A - Five Variables +* [x] B - Crane and Turtle +* [x] C - Forbidden List +* [x] D - Not Divisible +* [ ] E - Smart Infants +* [ ] F - Pond Skater + +## AtCoder Beginner Contest 177 + + + +* [ ] A - Don't be late +* [ ] B - Substring +* [ ] C - Sum of product of pairs +* [ ] D - Friends +* [x] E - Coprime +* [ ] F - I hate Shortest Path Problem + +## AtCoder Beginner Contest 181 + + + +* [ ] A - Heavy Rotation +* [ ] B - Trapezoid Sum +* [x] C - Collinearity +* [x] D - Hachi +* [ ] E - Transformable Teacher +* [ ] F - Silver Woods + +## AtCoder Beginner Contest 191 + + + +* [ ] 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/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 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 62% rename from abc128-e/Main.hs rename to abc/abc128-e/Main.hs index 790561a..bb00d25 100644 --- a/abc128-e/Main.hs +++ b/abc/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 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/abc/abc128-f/List.hs b/abc/abc128-f/List.hs new file mode 100644 index 0000000..df43cbc --- /dev/null +++ b/abc/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 diff --git a/abc/abc128-f/Main.hs b/abc/abc128-f/Main.hs new file mode 100644 index 0000000..d824e2f --- /dev/null +++ b/abc/abc128-f/Main.hs @@ -0,0 +1,25 @@ +-- 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 = 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 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/abc/abc130-a/Main.hs b/abc/abc130-a/Main.hs new file mode 100644 index 0000000..a8f59aa --- /dev/null +++ b/abc/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/abc/abc130-b/Main.hs b/abc/abc130-b/Main.hs new file mode 100644 index 0000000..9006f30 --- /dev/null +++ b/abc/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/abc/abc130-c/Main.hs b/abc/abc130-c/Main.hs new file mode 100644 index 0000000..16a4ebe --- /dev/null +++ b/abc/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/abc/abc130-d/Main.hs b/abc/abc130-d/Main.hs new file mode 100644 index 0000000..afce6dd --- /dev/null +++ b/abc/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/abc/abc130-e/Main.hs b/abc/abc130-e/Main.hs new file mode 100644 index 0000000..2c4963a --- /dev/null +++ b/abc/abc130-e/Main.hs @@ -0,0 +1,75 @@ +-- 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.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/abc/abc130-e/Vec.hs b/abc/abc130-e/Vec.hs new file mode 100644 index 0000000..734381f --- /dev/null +++ b/abc/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 diff --git a/abc/abc130-f/Main.hs b/abc/abc130-f/Main.hs new file mode 100644 index 0000000..d5240ce --- /dev/null +++ b/abc/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 diff --git a/abc/abc131-a/Main.hs b/abc/abc131-a/Main.hs new file mode 100644 index 0000000..f8dd6db --- /dev/null +++ b/abc/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/abc/abc131-b/Main.hs b/abc/abc131-b/Main.hs new file mode 100644 index 0000000..f5150d9 --- /dev/null +++ b/abc/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/abc/abc131-c/Main.hs b/abc/abc131-c/Main.hs new file mode 100644 index 0000000..a674618 --- /dev/null +++ b/abc/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/abc/abc131-d/Main.hs b/abc/abc131-d/Main.hs new file mode 100644 index 0000000..011cf12 --- /dev/null +++ b/abc/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/abc/abc131-d/VectorSort.hs b/abc/abc131-d/VectorSort.hs new file mode 100644 index 0000000..f10a97f --- /dev/null +++ b/abc/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 diff --git a/abc/abc131-e/Main.hs b/abc/abc131-e/Main.hs new file mode 100644 index 0000000..0e7b40f --- /dev/null +++ b/abc/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 diff --git a/abc/abc131-f/Main.hs b/abc/abc131-f/Main.hs new file mode 100644 index 0000000..cd16d8c --- /dev/null +++ b/abc/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 diff --git a/abc/abc132-a/Main.hs b/abc/abc132-a/Main.hs new file mode 100644 index 0000000..5e61561 --- /dev/null +++ b/abc/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/abc/abc132-b/Main.hs b/abc/abc132-b/Main.hs new file mode 100644 index 0000000..ed067bf --- /dev/null +++ b/abc/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/abc/abc132-c/Main.hs b/abc/abc132-c/Main.hs new file mode 100644 index 0000000..5e0ecb7 --- /dev/null +++ b/abc/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/abc/abc132-d/Main.hs b/abc/abc132-d/Main.hs new file mode 100644 index 0000000..915ae82 --- /dev/null +++ b/abc/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 diff --git a/abc/abc132-e/IntMap.hs b/abc/abc132-e/IntMap.hs new file mode 100644 index 0000000..5981631 --- /dev/null +++ b/abc/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/abc/abc132-e/Slow.hs b/abc/abc132-e/Slow.hs new file mode 100644 index 0000000..b250232 --- /dev/null +++ b/abc/abc132-e/Slow.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 diff --git a/abc/abc132-e/Vec.hs b/abc/abc132-e/Vec.hs new file mode 100644 index 0000000..546278e --- /dev/null +++ b/abc/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 diff --git a/abc/abc133-a/Main.hs b/abc/abc133-a/Main.hs new file mode 100644 index 0000000..d024a2f --- /dev/null +++ b/abc/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/abc/abc133-b/Main.hs b/abc/abc133-b/Main.hs new file mode 100644 index 0000000..7e5b8e0 --- /dev/null +++ b/abc/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/abc/abc133-c/Main.hs b/abc/abc133-c/Main.hs new file mode 100644 index 0000000..81a79cc --- /dev/null +++ b/abc/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/abc/abc133-d/Main.hs b/abc/abc133-d/Main.hs new file mode 100644 index 0000000..309426a --- /dev/null +++ b/abc/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/abc/abc133-e/Main.hs b/abc/abc133-e/Main.hs new file mode 100644 index 0000000..0fe13c1 --- /dev/null +++ b/abc/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 diff --git a/abc/abc133-f/Main.hs b/abc/abc133-f/Main.hs new file mode 100644 index 0000000..7bed8f1 --- /dev/null +++ b/abc/abc133-f/Main.hs @@ -0,0 +1,70 @@ +-- https://github.com/minoki/my-atcoder-solutions +{-# 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 +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.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 + 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 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 (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 + 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/abc/abc133-f/Slow.hs b/abc/abc133-f/Slow.hs new file mode 100644 index 0000000..25a1272 --- /dev/null +++ b/abc/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/abc/abc133-f/mkinput.lua b/abc/abc133-f/mkinput.lua new file mode 100644 index 0000000..397c027 --- /dev/null +++ b/abc/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 diff --git a/abc/abc134-a/Main.hs b/abc/abc134-a/Main.hs new file mode 100644 index 0000000..b01743c --- /dev/null +++ b/abc/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/abc/abc134-b/Main.hs b/abc/abc134-b/Main.hs new file mode 100644 index 0000000..a6b34ee --- /dev/null +++ b/abc/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/abc/abc134-c/Main.hs b/abc/abc134-c/Main.hs new file mode 100644 index 0000000..ac54d6e --- /dev/null +++ b/abc/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/abc/abc134-d/Main.hs b/abc/abc134-d/Main.hs new file mode 100644 index 0000000..678833a --- /dev/null +++ b/abc/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/abc/abc134-e/Main.hs b/abc/abc134-e/Main.hs new file mode 100644 index 0000000..1168fe3 --- /dev/null +++ b/abc/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 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 diff --git a/abc/abc135-e/Main.hs b/abc/abc135-e/Main.hs new file mode 100644 index 0000000..9278d27 --- /dev/null +++ b/abc/abc135-e/Main.hs @@ -0,0 +1,78 @@ +-- 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 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)] +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'] + 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 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 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 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))) diff --git a/abc/abc137-f/Main.hs b/abc/abc137-f/Main.hs new file mode 100644 index 0000000..df8acc8 --- /dev/null +++ b/abc/abc137-f/Main.hs @@ -0,0 +1,280 @@ +-- https://github.com/minoki/my-atcoder-solutions +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE RankNTypes #-} +import Data.Char (isSpace) +import Data.Int (Int64) +import Data.List (intersperse) +import Control.Monad +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.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 Unsafe.Coerce + +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 + 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) (\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' + ) + +--- + +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 + +--- + +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 + 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 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 new file mode 100644 index 0000000..d70a0d9 --- /dev/null +++ b/abc/abc137-f/mkinput.lua @@ -0,0 +1,8 @@ +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 = {} +for i = 0, p-1 do + table.insert(t, "1") +end +io.write(table.concat(t, " "), "\n") 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' 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 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 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 + #-} 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..f103944 --- /dev/null +++ b/abc/abc139-e/Main.hs @@ -0,0 +1,72 @@ +-- 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 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 + +-- 有向グラフに閉路があるか判定する +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 V.! x) $ \y -> do + -- 辺 (x,y) が存在 + s <- UM.read seen y + case s of 0 -> dfs y + 1 -> mzero -- コールスタックのどこかで dfs y が呼ばれている。閉路 + _ -> return () + UM.write seen x 2 + forM_ [0..n-1] $ \x -> do + s <- UM.read seen x + when (s == 0) $ dfs x + return () + +-- 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 + 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 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 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 + print $ if hasCycle edges + then -1 + else longest edges 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 diff --git a/abc/abc139-f/Main.hs b/abc/abc139-f/Main.hs new file mode 100644 index 0000000..33256cf --- /dev/null +++ b/abc/abc139-f/Main.hs @@ -0,0 +1,24 @@ +-- https://github.com/minoki/my-atcoder-solutions +{-# LANGUAGE BangPatterns #-} +import Data.Char (isSpace) +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 + -- 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 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 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-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] 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" 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) 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..c3ffc9c --- /dev/null +++ b/abc/abc142-f/Main.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 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 + +-- 閉路を見つける +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 + -- 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 -> [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 + 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 + case findCycle edges_from of + Right _ -> putStrLn "-1" + Left path -> do + let path' = reduceCycle edges_from path + print $ length path' + forM_ path' $ \i -> do + print (i+1) 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) ] 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 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 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 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 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-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 +#include +#include +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); + } +} 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) 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..d1eaae4 --- /dev/null +++ b/abc/abc170-d/Main.hs @@ -0,0 +1,24 @@ +-- 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 + 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 ] 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") diff --git a/abc/abc177-e/Main.hs b/abc/abc177-e/Main.hs new file mode 100644 index 0000000..1b819db --- /dev/null +++ b/abc/abc177-e/Main.hs @@ -0,0 +1,79 @@ +-- 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 + | 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) + +isSetwiseCoprime_naive :: U.Vector Int -> Bool +isSetwiseCoprime_naive xs = U.foldl' gcd 0 xs == 1 + +isSetwiseCoprime :: U.Vector Int -> Bool +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 + 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_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 + +runTests :: IO () +runTests = do + QC.quickCheck $ QC.withMaxSuccess 500 $ QC.mapSize (* 1000) prop_isPairwiseCoprime + QC.quickCheck $ QC.withMaxSuccess 500 $ QC.mapSize (* 1000) prop_isSetwiseCoprime 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" 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 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 +#include +#include +#include + +// 入力：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 +#include +#include +#include +#include +#include + +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 +#include +#include +#include + +// 入力：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 +#include +#include +#include + +// 入力：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 +#include +#include + +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/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..978047f --- /dev/null +++ b/agc035-b/Main.hs @@ -0,0 +1,98 @@ +-- 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 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 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 graphS :: V.Vector IntSet.IntSet + graphS = V.create $ do + vec <- VM.replicate n IntSet.empty + U.forM_ edges $ \(a,b) -> do + modify'_MV vec (IntSet.insert b) a + modify'_MV vec (IntSet.insert a) b + return vec + let treeParent :: U.Vector Int + treeSorted :: U.Vector Int + (treeParent, treeSorted) = runST $ do + parentVec <- 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 !i = do + forM_IntSet (graphS V.! i) $ \j -> do + p <- UM.read parentVec j + when (p == -1) $ do + UM.write parentVec j i + dfs j + pushfront i + UM.write parentVec 0 0 + 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 + 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 + printEdge (i+1) (j+1) + modify'_MV 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" + +-- 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 + 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..4b77b4c --- /dev/null +++ b/agc035-c/Main.hs @@ -0,0 +1,41 @@ +-- https://github.com/minoki/my-atcoder-solutions +{-# LANGUAGE ScopedTypeVariables #-} +{-# 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 = BSB.hPutBuilder stdout $ BSB.intDec i <> BSB.char7 ' ' <> BSB.intDec j <> BSB.char7 '\n' + +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 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) 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 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) 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 diff --git a/agc039-c/Main.hs b/agc039-c/Main.hs new file mode 100644 index 0000000..8531c1e --- /dev/null +++ b/agc039-c/Main.hs @@ -0,0 +1,204 @@ +-- https://github.com/minoki/my-atcoder-solutions +{-# LANGUAGE BangPatterns #-} +import Data.Char (digitToInt, intToDigit) +import Data.Int (Int64) +import Data.List (tails) +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 +import System.Environment + +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) * fromIntegral p * a | (p,a) <- IntMap.toList d ] + where + countOne :: Int -> 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 = IntMap.mapWithKey (\a _ -> countOne $ m `div` a) divisorLattice + d :: IntMap.IntMap N + 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 + 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 + +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 +-- + +modulus :: Int64 +modulus = 998244353 +addMod, subMod, mulMod :: Int64 -> Int64 -> Int64 +addMod !x !y | x + y >= modulus = x + y - modulus + | otherwise = x + y +subMod !x !y | x >= y = x - y + | otherwise = x - y + modulus +mulMod !x !y = (x * y) `rem` modulus + +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 modulus)) + 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 < modulus = N n + | otherwise = N (n `mod` modulus) + +{-# 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) + +-- | +-- >>> 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 ]) 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 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 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..5501ff2 --- /dev/null +++ b/atc001-c/Main.hs @@ -0,0 +1,232 @@ +-- 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.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 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 + (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 + 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) +-- + +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) diff --git a/atc001-c/NTT.hs b/atc001-c/NTT.hs new file mode 100644 index 0000000..9cdbeb5 --- /dev/null +++ b/atc001-c/NTT.hs @@ -0,0 +1,198 @@ +-- 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 Data.Bits +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.Proxy +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) + +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 :: 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 + BSB.int64Dec (v U.! k) <> BSB.char8 '\n' -- <= 10^9 + else + BSB.string8 "0\n" + | k <- [1..2*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.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 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 #-} + +mulFFTInt :: U.Vector Int -> U.Vector Int -> U.Vector Int64 +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 + -- (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 / 1012924417 Z +newtype R = R { unwrapR :: IntMod (483 * 2^21 + 1) } deriving newtype (Eq, Show, Num, Fractional) + +instance U.Unboxable R where + type Rep R = Int64 + +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->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 1012924417) #-} + +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 + 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 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) 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) diff --git a/competitive-programming-with-haskell.md b/competitive-programming-with-haskell.md index 9a3192a..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日 @@ -30,6 +33,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 +78,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 +178,8 @@ unsafeCoerce_UArray_Int_N = Unsafe.Coerce.unsafeCoerce を参照せよ。 +競技プログラミング外で自由にパッケージを使える環境の場合、unboxed vectorに関しては、筆者が作っている [unboxing-vectorパッケージ](https://hackage.haskell.org/package/unboxing-vector) を使うとnewtype時に記述量が少なくて済む。 + ## IntSet `IntSet` を舐める際にいちいちリストに変換するのがだるい、という場合は @@ -133,7 +208,9 @@ foldMap_IntSet f set = go set ## ソート -標準のリストのソートは遅い。 +標準のリストのソート (`Data.List.sort`) は遅い。 + +標準のリストのソートを使ったせいでTLEとなったケースには筆者は（まだ）遭遇していないが、より高速な代替手段を用意しておくと精神的に楽である。 vector-algorithmsパッケージの各種アルゴリズムが使えると良いのだが、現状使えないようなので自分でソートアルゴリズムを書こう。 実装例は [abc127-d/Main.hs](abc127-d/Main.hs) を参照（この問題は標準のリストのソートでも十分ACできる）。 @@ -153,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拡張に頼る必要がある。 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 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..e4c11d1 --- /dev/null +++ b/diverta2019-2-c/Main.hs @@ -0,0 +1,73 @@ +-- 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.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 <- 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 = + 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] + +--- + +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 diff --git a/diverta2019-2-d/Main.hs b/diverta2019-2-d/Main.hs new file mode 100644 index 0000000..3b0a211 --- /dev/null +++ b/diverta2019-2-d/Main.hs @@ -0,0 +1,45 @@ +-- 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)] -> + 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 + [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 diff --git a/dp-i/Main.hs b/dp-i/Main.hs deleted file mode 100644 index ae8efd1..0000000 --- a/dp-i/Main.hs +++ /dev/null @@ -1,25 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE ScopedTypeVariables #-} -import qualified Data.ByteString.Char8 as BS -import qualified Data.Vector.Unboxed as U - --- n := V.length v + 1 --- v ! i = 表が i 枚、裏が n - i 枚出る確率 -solve :: [Double] -> U.Vector Double -solve ps = go ps (U.singleton 1) - 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 - -main = do - n :: Int <- readLn - -- 1 <= n <= 2999, n is odd - ps :: [Double] <- map (read . BS.unpack) . BS.words <$> BS.getLine - let result = solve ps - -- U.length result == n + 1 - print $ U.sum $ U.drop (n `quot` 2 + 1) result 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/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/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/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) 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/educational-dp/dp-i/Main.hs b/educational-dp/dp-i/Main.hs new file mode 100644 index 0000000..0bf8aa3 --- /dev/null +++ b/educational-dp/dp-i/Main.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE BangPatterns #-} +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 :: U.Vector Double -> U.Vector Double +solve ps = U.foldl' step (U.singleton 1) ps + where + 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 <- readLn + -- 1 <= n <= 2999, n is odd + 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 diff --git a/educational-dp/dp-j/Main.hs b/educational-dp/dp-j/Main.hs new file mode 100644 index 0000000..012d2ff --- /dev/null +++ b/educational-dp/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 diff --git a/educational-dp/dp-k/Main.hs b/educational-dp/dp-k/Main.hs new file mode 100644 index 0000000..4fcef62 --- /dev/null +++ b/educational-dp/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") diff --git a/educational-dp/dp-l/Main.hs b/educational-dp/dp-l/Main.hs new file mode 100644 index 0000000..2ae4333 --- /dev/null +++ b/educational-dp/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) diff --git a/educational-dp/dp-m/Main.hs b/educational-dp/dp-m/Main.hs new file mode 100644 index 0000000..10a9bf4 --- /dev/null +++ b/educational-dp/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.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) + +--- + +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 diff --git a/educational-dp/dp-n/Main.hs b/educational-dp/dp-n/Main.hs new file mode 100644 index 0000000..6cd8ab8 --- /dev/null +++ b/educational-dp/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が効かない？） diff --git a/educational-dp/dp-o/Main.hs b/educational-dp/dp-o/Main.hs new file mode 100644 index 0000000..fae999d --- /dev/null +++ b/educational-dp/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) diff --git a/educational-dp/dp-o/Vector.hs b/educational-dp/dp-o/Vector.hs new file mode 100644 index 0000000..620f0b7 --- /dev/null +++ b/educational-dp/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 diff --git a/educational-dp/dp-p/Main.hs b/educational-dp/dp-p/Main.hs new file mode 100644 index 0000000..3e69f46 --- /dev/null +++ b/educational-dp/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 diff --git a/educational-dp/dp-q/BIT.hs b/educational-dp/dp-q/BIT.hs new file mode 100644 index 0000000..bddb89f --- /dev/null +++ b/educational-dp/dp-q/BIT.hs @@ -0,0 +1,128 @@ +-- 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) +{-# 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 + +-- +-- 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) diff --git a/educational-dp/dp-q/Main.hs b/educational-dp/dp-q/Main.hs new file mode 100644 index 0000000..ba147cd --- /dev/null +++ b/educational-dp/dp-q/Main.hs @@ -0,0 +1,75 @@ +-- 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 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 + +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 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.head result + +readInt64 :: BS.ByteString -> Maybe (Int64, BS.ByteString) +readInt64 s = first fromIntegral <$> BS.readInt s diff --git a/educational-dp/dp-q/SegTree.hs b/educational-dp/dp-q/SegTree.hs new file mode 100644 index 0000000..b942828 --- /dev/null +++ b/educational-dp/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) diff --git a/educational-dp/dp-r/Main.hs b/educational-dp/dp-r/Main.hs new file mode 100644 index 0000000..1c5f75a --- /dev/null +++ b/educational-dp/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) diff --git a/educational-dp/dp-s/Main.hs b/educational-dp/dp-s/Main.hs new file mode 100644 index 0000000..f4012c8 --- /dev/null +++ b/educational-dp/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 -> 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) (acc + sum [(v V.! BS.length s') U.! ((j - l) `mod` d) | l <- [0..kn-1]]) + print $ f k 0 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 diff --git a/educational-dp/dp-t/Main.hs b/educational-dp/dp-t/Main.hs new file mode 100644 index 0000000..f383766 --- /dev/null +++ b/educational-dp/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 diff --git a/educational-dp/dp-u/Main.hs b/educational-dp/dp-u/Main.hs new file mode 100644 index 0000000..0b7d936 --- /dev/null +++ b/educational-dp/dp-u/Main.hs @@ -0,0 +1,92 @@ +-- 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 + +{- +-- set に入っているウサギを全て同じグループに入れた時に得られる得点 +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 +-} + +-- ビット列を集合と見立てた時の部分集合の全体（冪集合） +-- 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 + 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 : set に入っているウサギを使って得られる最大の得点 + go !set = do + v <- UM.read vec set + if v == minBound + then do let v0 = scoreOneV U.! 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 + go (2^n-1) + print result + +readInt64 :: BS.ByteString -> Maybe (Int64, BS.ByteString) +readInt64 s = first fromIntegral <$> BS.readInt s diff --git a/educational-dp/dp-v/Main.hs b/educational-dp/dp-v/Main.hs new file mode 100644 index 0000000..912cf9e --- /dev/null +++ b/educational-dp/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) diff --git a/exawizards2019-d/Main.hs b/exawizards2019-d/Main.hs index 432db2f..faee0a9 100644 --- a/exawizards2019-d/Main.hs +++ b/exawizards2019-d/Main.hs @@ -1,35 +1,200 @@ +-- https://github.com/minoki/my-atcoder-solutions {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE RankNTypes #-} import Control.Monad -import Data.Int +import Data.Char (isSpace) +import Data.Int (Int64) 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 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 qualified Data.Array.Base +import qualified Unsafe.Coerce -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 +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 -> 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) +memo :: (Int,Int) -> Memo s N -> Memo s N +memo x action = do + arr <- ask + val <- lift $ readArray arr x + if val == invalidN + 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 - [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 + 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 + +-- 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 +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 +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 + #-} + +--- + +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 + +--- + +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 + +--- + +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 + +--- 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) diff --git a/gen.lua b/gen.lua index c72c46b..1a1f158 100755 --- a/gen.lua +++ b/gen.lua @@ -19,10 +19,10 @@ 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 +import Data.Int (Int64) import Data.List (unfoldr) import Control.Monad import qualified Data.Vector.Unboxed as U @@ -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 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..957e42b --- /dev/null +++ b/jsc2019-qual-b/Main.hs @@ -0,0 +1,129 @@ +-- 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 + #-} + +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) +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..95c30a3 --- /dev/null +++ b/jsc2019-qual-c/Main.hs @@ -0,0 +1,57 @@ +-- https://github.com/minoki/my-atcoder-solutions +{-# LANGUAGE BangPatterns #-} +import Data.Int (Int64) +import Data.Coerce +import qualified Data.ByteString.Char8 as BS +import Control.Exception (assert) + +main = do + n <- readLn + s <- BS.getLine + 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 +-- + +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 + #-} 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]] 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 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) diff --git a/lib/BinaryIndexedTree.hs b/lib/BinaryIndexedTree.hs new file mode 100644 index 0000000..0ce8021 --- /dev/null +++ b/lib/BinaryIndexedTree.hs @@ -0,0 +1,78 @@ +{-# 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), 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 + +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/Input.hs b/lib/Input.hs index 3e7f5ec..ed9673f 100644 --- a/lib/Input.hs +++ b/lib/Input.hs @@ -5,6 +5,8 @@ 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) +import Data.Int (Int64) main = do _ :: [Int] <- map (read . BS.unpack) . BS.words <$> BS.getLine @@ -13,3 +15,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 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 diff --git a/lib/MergeSort.hs b/lib/MergeSort.hs new file mode 100644 index 0000000..2cdce4c --- /dev/null +++ b/lib/MergeSort.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE BangPatterns #-} +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 + 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 + +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 68e715c..fa50dc3 100644 --- a/lib/ModularArithmetic.hs +++ b/lib/ModularArithmetic.hs @@ -3,24 +3,47 @@ {-# LANGUAGE TypeFamilies #-} module ModularArithmetic where import Data.Int +import Data.Coerce + +-- +-- Modular Arithmetic +-- 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 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 +{-# 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) @@ -36,6 +59,12 @@ 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 + +{- +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 new file mode 100644 index 0000000..e0fad80 --- /dev/null +++ b/lib/ModularArithmetic_TypeNats.hs @@ -0,0 +1,170 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE NoStarIsType #-} +module ModularArithmetic_TypeNats where +import Data.Int +import GHC.TypeNats +import qualified Test.QuickCheck as QC +import Data.Proxy +import Control.Exception (assert) + +-- +-- 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 + +{- +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 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) 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) 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 new file mode 100644 index 0000000..91a6eb4 --- /dev/null +++ b/lib/SegmentTree.hs @@ -0,0 +1,62 @@ +{-# 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 = ceil_log2 n + 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 + +ceil_log2 :: Int -> Int +ceil_log2 0 = 0 +ceil_log2 x = finiteBitSize x - countLeadingZeros (x - 1) 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 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 diff --git a/package.yaml b/package.yaml index c3b36e2..850f71c 100644 --- a/package.yaml +++ b/package.yaml @@ -27,6 +27,13 @@ dependencies: - mtl - bytestring - text +- deepseq +- primitive +- reflection +- unboxing-vector +- vector-algorithms +- QuickCheck +- arithmoi ghc-options: # Maximum heap size: 1GiB @@ -42,335 +49,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 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 #-} diff --git a/practice2-c/Main.hs b/practice2-c/Main.hs new file mode 100644 index 0000000..ff68163 --- /dev/null +++ b/practice2-c/Main.hs @@ -0,0 +1,83 @@ +-- 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 +import Data.Char (isSpace) +import Data.Int (Int64) +import Data.List (unfoldr) +import Data.Ratio +import qualified Test.QuickCheck as QC + +-- 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) + +-- 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_positive 0 n m (- a) (b + a * (n - 1)) + | 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 + | 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 + (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 ((toInteger a * toInteger i + toInteger b) % toInteger 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 + +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 {- 100ms -}) $ toInteger (floorSum n m a b) QC.=== floorSum_naive n m a b 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 diff --git a/practice2-f/Mutable.hs b/practice2-f/Mutable.hs new file mode 100644 index 0000000..6068098 --- /dev/null +++ b/practice2-f/Mutable.hs @@ -0,0 +1,227 @@ +-- 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 Data.Word +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)]@ + -> G.Mutable vec s a -- ^ a vector of length n (= 2^k for some k) + -> 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 + 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 + | otherwise = U.create $ do + w <- UM.replicate n 0 + U.copy (UM.take (U.length v) w) v + return w +{-# 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 + 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) + 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 +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 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. 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 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, "")) 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) 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