diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,177 @@ + + Apache License + Version 2.0, January 2004 + http://www.apache.org/licenses/ + + TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION + + 1. Definitions. + + "License" shall mean the terms and conditions for use, reproduction, + and distribution as defined by Sections 1 through 9 of this document. + + "Licensor" shall mean the copyright owner or entity authorized by + the copyright owner that is granting the License. + + "Legal Entity" shall mean the union of the acting entity and all + other entities that control, are controlled by, or are under common + control with that entity. For the purposes of this definition, + "control" means (i) the power, direct or indirect, to cause the + direction or management of such entity, whether by contract or + otherwise, or (ii) ownership of fifty percent (50%) or more of the + outstanding shares, or (iii) beneficial ownership of such entity. + + "You" (or "Your") shall mean an individual or Legal Entity + exercising permissions granted by this License. + + "Source" form shall mean the preferred form for making modifications, + including but not limited to software source code, documentation + source, and configuration files. + + "Object" form shall mean any form resulting from mechanical + transformation or translation of a Source form, including but + not limited to compiled object code, generated documentation, + and conversions to other media types. + + "Work" shall mean the work of authorship, whether in Source or + Object form, made available under the License, as indicated by a + copyright notice that is included in or attached to the work + (an example is provided in the Appendix below). + + "Derivative Works" shall mean any work, whether in Source or Object + form, that is based on (or derived from) the Work and for which the + editorial revisions, annotations, elaborations, or other modifications + represent, as a whole, an original work of authorship. For the purposes + of this License, Derivative Works shall not include works that remain + separable from, or merely link (or bind by name) to the interfaces of, + the Work and Derivative Works thereof. + + "Contribution" shall mean any work of authorship, including + the original version of the Work and any modifications or additions + to that Work or Derivative Works thereof, that is intentionally + submitted to Licensor for inclusion in the Work by the copyright owner + or by an individual or Legal Entity authorized to submit on behalf of + the copyright owner. For the purposes of this definition, "submitted" + means any form of electronic, verbal, or written communication sent + to the Licensor or its representatives, including but not limited to + communication on electronic mailing lists, source code control systems, + and issue tracking systems that are managed by, or on behalf of, the + Licensor for the purpose of discussing and improving the Work, but + excluding communication that is conspicuously marked or otherwise + designated in writing by the copyright owner as "Not a Contribution." + + "Contributor" shall mean Licensor and any individual or Legal Entity + on behalf of whom a Contribution has been received by Licensor and + subsequently incorporated within the Work. + + 2. Grant of Copyright License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + copyright license to reproduce, prepare Derivative Works of, + publicly display, publicly perform, sublicense, and distribute the + Work and such Derivative Works in Source or Object form. + + 3. Grant of Patent License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + (except as stated in this section) patent license to make, have made, + use, offer to sell, sell, import, and otherwise transfer the Work, + where such license applies only to those patent claims licensable + by such Contributor that are necessarily infringed by their + Contribution(s) alone or by combination of their Contribution(s) + with the Work to which such Contribution(s) was submitted. If You + institute patent litigation against any entity (including a + cross-claim or counterclaim in a lawsuit) alleging that the Work + or a Contribution incorporated within the Work constitutes direct + or contributory patent infringement, then any patent licenses + granted to You under this License for that Work shall terminate + as of the date such litigation is filed. + + 4. Redistribution. You may reproduce and distribute copies of the + Work or Derivative Works thereof in any medium, with or without + modifications, and in Source or Object form, provided that You + meet the following conditions: + + (a) You must give any other recipients of the Work or + Derivative Works a copy of this License; and + + (b) You must cause any modified files to carry prominent notices + stating that You changed the files; and + + (c) You must retain, in the Source form of any Derivative Works + that You distribute, all copyright, patent, trademark, and + attribution notices from the Source form of the Work, + excluding those notices that do not pertain to any part of + the Derivative Works; and + + (d) If the Work includes a "NOTICE" text file as part of its + distribution, then any Derivative Works that You distribute must + include a readable copy of the attribution notices contained + within such NOTICE file, excluding those notices that do not + pertain to any part of the Derivative Works, in at least one + of the following places: within a NOTICE text file distributed + as part of the Derivative Works; within the Source form or + documentation, if provided along with the Derivative Works; or, + within a display generated by the Derivative Works, if and + wherever such third-party notices normally appear. The contents + of the NOTICE file are for informational purposes only and + do not modify the License. You may add Your own attribution + notices within Derivative Works that You distribute, alongside + or as an addendum to the NOTICE text from the Work, provided + that such additional attribution notices cannot be construed + as modifying the License. + + You may add Your own copyright statement to Your modifications and + may provide additional or different license terms and conditions + for use, reproduction, or distribution of Your modifications, or + for any such Derivative Works as a whole, provided Your use, + reproduction, and distribution of the Work otherwise complies with + the conditions stated in this License. + + 5. Submission of Contributions. Unless You explicitly state otherwise, + any Contribution intentionally submitted for inclusion in the Work + by You to the Licensor shall be under the terms and conditions of + this License, without any additional terms or conditions. + Notwithstanding the above, nothing herein shall supersede or modify + the terms of any separate license agreement you may have executed + with Licensor regarding such Contributions. + + 6. Trademarks. This License does not grant permission to use the trade + names, trademarks, service marks, or product names of the Licensor, + except as required for reasonable and customary use in describing the + origin of the Work and reproducing the content of the NOTICE file. + + 7. Disclaimer of Warranty. Unless required by applicable law or + agreed to in writing, Licensor provides the Work (and each + Contributor provides its Contributions) on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or + implied, including, without limitation, any warranties or conditions + of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A + PARTICULAR PURPOSE. You are solely responsible for determining the + appropriateness of using or redistributing the Work and assume any + risks associated with Your exercise of permissions under this License. + + 8. Limitation of Liability. In no event and under no legal theory, + whether in tort (including negligence), contract, or otherwise, + unless required by applicable law (such as deliberate and grossly + negligent acts) or agreed to in writing, shall any Contributor be + liable to You for damages, including any direct, indirect, special, + incidental, or consequential damages of any character arising as a + result of this License or out of the use or inability to use the + Work (including but not limited to damages for loss of goodwill, + work stoppage, computer failure or malfunction, or any and all + other commercial damages or losses), even if such Contributor + has been advised of the possibility of such damages. + + 9. Accepting Warranty or Additional Liability. While redistributing + the Work or Derivative Works thereof, You may choose to offer, + and charge a fee for, acceptance of support, warranty, indemnity, + or other liability obligations and/or rights consistent with this + License. However, in accepting such obligations, You may act only + on Your own behalf and on Your sole responsibility, not on behalf + of any other Contributor, and only if You agree to indemnify, + defend, and hold each Contributor harmless for any liability + incurred by, or claims asserted against, such Contributor by reason + of your accepting any such warranty or additional liability. + + END OF TERMS AND CONDITIONS diff --git a/Readme.md b/Readme.md new file mode 100644 --- /dev/null +++ b/Readme.md @@ -0,0 +1,591 @@ +[![build](https://github.com/sergv/atomic-counter/actions/workflows/haskell-ci.yaml/badge.svg)](https://github.com/sergv/atomic-counter/actions/workflows/haskell-ci.yaml) + +# Synopsis + +This package features reasonable sort function that is a good default +for sorting mutable vectors using well-known quicksort algorithm. +During development one of the goals was making it perform on par with +C++’s `std::sort`, i.e. fast. + +While providing reasonably good single-threaded default sorting, the +algorithm in this package is also parallelisable and can provides ways +to run on multiple cores using either threads or sparks, so bigger +vectors can be sorted even faster. + +# Algorithm details + +Technically it’s an (introsort)[https://en.wikipedia.org/wiki/Introsort], i.e. +pathological `O(N^2)` quicksort case will get delegated to heapsort when recursion +gets too deep, thus making algorithm reliably `O(N * log(N))`. + +# Benchmarks + +The benchmark is to generate some random arrays of different length +and sort them. For each array size N two versions are generated: one +from range [0, N] (`with few duplicates` below), +another from [0, N / 1000] (`with many duplicates` below) to +introduce duplicates. And there’s one reasonably big array (around +40,000 elements) with lots of duplicates that I managed to come by in +the real world under `Sorting fuzzy matching scores vector` that comes +from `test.txt` file in this repository. with + +Test setup: Intel i5-9600K CPU @ 3.70GHz, 6 cores, no hyperthreading, GHC 9.6.1. + +The default sort exported in `Data.Vector.Algorithms.Quicksort` is `Sequential` and `Median3or5`. + +``` +$ cabal run bench -- -j1 --time-mode wall --timeout 300 +All + Sorting fuzzy matching scores vector + C++: OK (0.54s) + 377 μs ± 30 μs + Sequential ST Median3: OK (0.36s) + 315 μs ± 17 μs, 0.83x + Sequential IO Median3: OK (0.31s) + 288 μs ± 17 μs, 0.76x + ParStrategies ST Median3: OK (0.15s) + 285 μs ± 23 μs, 0.76x + ParStrategies IO Median3: OK (0.16s) + 306 μs ± 22 μs, 0.81x + Sequential ST Median3or5: OK (0.28s) + 261 μs ± 13 μs, 0.69x + Sequential IO Median3or5: OK (0.28s) + 264 μs ± 25 μs, 0.70x + ParStrategies ST Median3or5: OK (0.14s) + 268 μs ± 21 μs, 0.71x + ParStrategies IO Median3or5: OK (0.15s) + 272 μs ± 27 μs, 0.72x + Sequential ST AveragingMedian: OK (0.16s) + 2.47 ms ± 191 μs, 6.55x + Threads IO Median3: OK (0.31s) + 295 μs ± 28 μs, 0.78x + Threads IO Median3or5: OK (0.24s) + 230 μs ± 12 μs, 0.61x + vector-algorithms heapsort: OK (0.27s) + 2.06 ms ± 97 μs, 5.45x + fallback heapsort: OK (0.25s) + 1.91 ms ± 106 μs, 5.07x + Sorting 10 random arrays of length 16 with few duplicates + C++: OK (0.36s) + 654 ns ± 24 ns + Sequential ST Median3: OK (0.31s) + 554 ns ± 23 ns, 0.85x + Sequential IO Median3: OK (0.16s) + 559 ns ± 44 ns, 0.85x + ParStrategies ST Median3: OK (0.16s) + 578 ns ± 58 ns, 0.88x + ParStrategies IO Median3: OK (0.32s) + 578 ns ± 26 ns, 0.88x + Sequential ST Median3or5: OK (0.16s) + 569 ns ± 50 ns, 0.87x + Sequential IO Median3or5: OK (0.16s) + 571 ns ± 50 ns, 0.87x + ParStrategies ST Median3or5: OK (0.17s) + 580 ns ± 42 ns, 0.89x + ParStrategies IO Median3or5: OK (0.16s) + 577 ns ± 49 ns, 0.88x + Sequential ST AveragingMedian: OK (0.31s) + 557 ns ± 27 ns, 0.85x + Threads IO Median3: OK (0.24s) + 1.71 μs ± 128 ns, 2.62x + Threads IO Median3or5: OK (0.24s) + 1.73 μs ± 120 ns, 2.64x + vector-algorithms heapsort: OK (0.20s) + 1.41 μs ± 117 ns, 2.16x + fallback heapsort: OK (0.62s) + 1.15 μs ± 29 ns, 1.76x + Sorting 10 random arrays of length 17 with few duplicates + C++: OK (0.21s) + 758 ns ± 73 ns + Sequential ST Median3: OK (0.38s) + 701 ns ± 35 ns, 0.92x + Sequential IO Median3: OK (0.20s) + 728 ns ± 60 ns, 0.96x + ParStrategies ST Median3: OK (0.22s) + 773 ns ± 49 ns, 1.02x + ParStrategies IO Median3: OK (0.21s) + 766 ns ± 44 ns, 1.01x + Sequential ST Median3or5: OK (0.39s) + 727 ns ± 55 ns, 0.96x + Sequential IO Median3or5: OK (0.20s) + 724 ns ± 47 ns, 0.95x + ParStrategies ST Median3or5: OK (0.22s) + 793 ns ± 68 ns, 1.05x + ParStrategies IO Median3or5: OK (0.22s) + 791 ns ± 63 ns, 1.04x + Sequential ST AveragingMedian: OK (0.30s) + 2.18 μs ± 92 ns, 2.88x + Threads IO Median3: OK (0.14s) + 1.89 μs ± 182 ns, 2.49x + Threads IO Median3or5: OK (0.14s) + 1.99 μs ± 176 ns, 2.63x + vector-algorithms heapsort: OK (0.21s) + 1.52 μs ± 114 ns, 2.01x + fallback heapsort: OK (0.18s) + 1.23 μs ± 116 ns, 1.62x + Sorting 10 random arrays of length 100 with few duplicates + C++: OK (0.16s) + 4.33 μs ± 413 ns + Sequential ST Median3: OK (0.38s) + 5.56 μs ± 371 ns, 1.29x + Sequential IO Median3: OK (0.20s) + 5.55 μs ± 333 ns, 1.28x + ParStrategies ST Median3: OK (0.21s) + 6.03 μs ± 345 ns, 1.39x + ParStrategies IO Median3: OK (0.50s) + 7.24 μs ± 287 ns, 1.67x + Sequential ST Median3or5: OK (0.20s) + 5.57 μs ± 337 ns, 1.29x + Sequential IO Median3or5: OK (0.20s) + 5.59 μs ± 329 ns, 1.29x + ParStrategies ST Median3or5: OK (0.22s) + 6.28 μs ± 371 ns, 1.45x + ParStrategies IO Median3or5: OK (0.22s) + 6.52 μs ± 621 ns, 1.51x + Sequential ST AveragingMedian: OK (0.26s) + 30.5 μs ± 2.8 μs, 7.05x + Threads IO Median3: OK (0.13s) + 7.28 μs ± 686 ns, 1.68x + Threads IO Median3or5: OK (0.49s) + 7.22 μs ± 296 ns, 1.67x + vector-algorithms heapsort: OK (0.32s) + 18.8 μs ± 1.4 μs, 4.35x + fallback heapsort: OK (0.20s) + 22.9 μs ± 1.5 μs, 5.30x + Sorting 10 random arrays of length 256 with few duplicates + C++: OK (0.19s) + 44.7 μs ± 2.9 μs + Sequential ST Median3: OK (0.45s) + 54.6 μs ± 2.8 μs, 1.22x + Sequential IO Median3: OK (0.20s) + 46.9 μs ± 3.5 μs, 1.05x + ParStrategies ST Median3: OK (0.22s) + 51.3 μs ± 3.9 μs, 1.15x + ParStrategies IO Median3: OK (0.23s) + 53.7 μs ± 4.1 μs, 1.20x + Sequential ST Median3or5: OK (0.21s) + 48.1 μs ± 3.1 μs, 1.07x + Sequential IO Median3or5: OK (0.21s) + 47.8 μs ± 2.9 μs, 1.07x + ParStrategies ST Median3or5: OK (0.23s) + 54.0 μs ± 4.0 μs, 1.21x + ParStrategies IO Median3or5: OK (0.24s) + 54.3 μs ± 5.0 μs, 1.21x + Sequential ST AveragingMedian: OK (0.13s) + 119 μs ± 11 μs, 2.67x + Threads IO Median3: OK (0.24s) + 56.3 μs ± 5.6 μs, 1.26x + Threads IO Median3or5: OK (0.24s) + 56.1 μs ± 4.6 μs, 1.25x + vector-algorithms heapsort: OK (0.23s) + 110 μs ± 6.6 μs, 2.47x + fallback heapsort: OK (0.21s) + 95.2 μs ± 6.5 μs, 2.13x + Sorting 10 random arrays of length 1,000 with few duplicates + C++: OK (0.15s) + 274 μs ± 24 μs + Sequential ST Median3: OK (0.13s) + 471 μs ± 46 μs, 1.72x + Sequential IO Median3: OK (0.23s) + 428 μs ± 28 μs, 1.56x + ParStrategies ST Median3: OK (0.19s) + 350 μs ± 27 μs, 1.27x + ParStrategies IO Median3: OK (0.24s) + 451 μs ± 42 μs, 1.65x + Sequential ST Median3or5: OK (0.18s) + 333 μs ± 31 μs, 1.22x + Sequential IO Median3or5: OK (0.12s) + 428 μs ± 42 μs, 1.56x + ParStrategies ST Median3or5: OK (0.25s) + 460 μs ± 42 μs, 1.68x + ParStrategies IO Median3or5: OK (0.19s) + 363 μs ± 27 μs, 1.32x + Sequential ST AveragingMedian: OK (0.20s) + 742 μs ± 64 μs, 2.71x + Threads IO Median3: OK (0.25s) + 469 μs ± 25 μs, 1.71x + Threads IO Median3or5: OK (0.25s) + 457 μs ± 37 μs, 1.67x + vector-algorithms heapsort: OK (0.18s) + 667 μs ± 65 μs, 2.43x + fallback heapsort: OK (0.17s) + 618 μs ± 46 μs, 2.25x + Sorting 10 random arrays of length 10,000 with few duplicates + C++: OK (0.29s) + 4.50 ms ± 269 μs + Sequential ST Median3: OK (0.19s) + 6.00 ms ± 586 μs, 1.33x + Sequential IO Median3: OK (0.28s) + 4.31 ms ± 260 μs, 0.96x + ParStrategies ST Median3: OK (0.18s) + 5.73 ms ± 514 μs, 1.27x + ParStrategies IO Median3: OK (0.20s) + 6.06 ms ± 375 μs, 1.35x + Sequential ST Median3or5: OK (0.14s) + 4.35 ms ± 353 μs, 0.97x + Sequential IO Median3or5: OK (0.18s) + 5.57 ms ± 524 μs, 1.24x + ParStrategies ST Median3or5: OK (0.15s) + 4.62 ms ± 340 μs, 1.03x + ParStrategies IO Median3or5: OK (0.38s) + 5.89 ms ± 520 μs, 1.31x + Sequential ST AveragingMedian: OK (0.31s) + 9.89 ms ± 437 μs, 2.20x + Threads IO Median3: OK (0.60s) + 4.65 ms ± 291 μs, 1.03x + Threads IO Median3or5: OK (0.37s) + 5.77 ms ± 183 μs, 1.28x + vector-algorithms heapsort: OK (0.14s) + 8.79 ms ± 718 μs, 1.95x + fallback heapsort: OK (0.26s) + 8.34 ms ± 568 μs, 1.85x + Sorting 10 random arrays of length 100,000 with few duplicates + C++: OK (0.17s) + 55.6 ms ± 3.2 ms + Sequential ST Median3: OK (0.24s) + 78.1 ms ± 3.7 ms, 1.41x + Sequential IO Median3: OK (0.21s) + 69.3 ms ± 3.7 ms, 1.25x + ParStrategies ST Median3: OK (0.18s) + 59.5 ms ± 4.5 ms, 1.07x + ParStrategies IO Median3: OK (3.66s) + 56.6 ms ± 5.3 ms, 1.02x + Sequential ST Median3or5: OK (0.16s) + 54.0 ms ± 3.5 ms, 0.97x + Sequential IO Median3or5: OK (0.21s) + 67.3 ms ± 5.7 ms, 1.21x + ParStrategies ST Median3or5: OK (0.19s) + 62.3 ms ± 5.6 ms, 1.12x + ParStrategies IO Median3or5: OK (0.45s) + 65.3 ms ± 4.7 ms, 1.17x + Sequential ST AveragingMedian: OK (0.38s) + 127 ms ± 4.5 ms, 2.28x + Threads IO Median3: OK (0.34s) + 48.3 ms ± 2.7 ms, 0.87x + Threads IO Median3or5: OK (0.34s) + 47.7 ms ± 2.4 ms, 0.86x + vector-algorithms heapsort: OK (0.37s) + 124 ms ± 8.9 ms, 2.23x + fallback heapsort: OK (0.81s) + 113 ms ± 5.4 ms, 2.04x + Sorting 10 random arrays of length 1,000,000 with few duplicates + C++: OK (2.05s) + 682 ms ± 15 ms + Sequential ST Median3: OK (2.18s) + 727 ms ± 7.5 ms, 1.06x + Sequential IO Median3: OK (2.44s) + 812 ms ± 9.6 ms, 1.19x + ParStrategies ST Median3: OK (1.44s) + 204 ms ± 13 ms, 0.30x + ParStrategies IO Median3: OK (0.81s) + 268 ms ± 20 ms, 0.39x + Sequential ST Median3or5: OK (2.00s) + 664 ms ± 45 ms, 0.97x + Sequential IO Median3or5: OK (1.95s) + 645 ms ± 43 ms, 0.95x + ParStrategies ST Median3or5: OK (1.49s) + 209 ms ± 4.9 ms, 0.31x + ParStrategies IO Median3or5: OK (1.46s) + 208 ms ± 21 ms, 0.30x + Sequential ST AveragingMedian: OK (4.05s) + 1.348 s ± 8.5 ms, 1.98x + Threads IO Median3: OK (1.53s) + 508 ms ± 7.1 ms, 0.74x + Threads IO Median3or5: OK (1.36s) + 452 ms ± 6.2 ms, 0.66x + vector-algorithms heapsort: OK (3.94s) + 1.309 s ± 53 ms, 1.92x + fallback heapsort: OK (3.67s) + 1.220 s ± 27 ms, 1.79x + Sorting 10 random arrays of length 10,000,000 with few duplicates + C++: OK (18.62s) + 6.188 s ± 240 ms + Sequential ST Median3: OK (25.26s) + 8.422 s ± 49 ms, 1.36x + Sequential IO Median3: OK (21.91s) + 7.295 s ± 118 ms, 1.18x + ParStrategies ST Median3: OK (6.01s) + 2.010 s ± 110 ms, 0.32x + ParStrategies IO Median3: OK (6.16s) + 2.044 s ± 100 ms, 0.33x + Sequential ST Median3or5: OK (21.85s) + 7.284 s ± 4.9 ms, 1.18x + Sequential IO Median3or5: OK (21.94s) + 7.311 s ± 38 ms, 1.18x + ParStrategies ST Median3or5: OK (6.05s) + 2.010 s ± 72 ms, 0.32x + ParStrategies IO Median3or5: OK (6.27s) + 2.090 s ± 2.8 ms, 0.34x + Sequential ST AveragingMedian: OK (81.58s) + 27.074 s ± 1.60 s, 4.38x + Threads IO Median3: OK (15.86s) + 5.283 s ± 29 ms, 0.85x + Threads IO Median3or5: OK (12.85s) + 4.283 s ± 7.3 ms, 0.69x + vector-algorithms heapsort: OK (71.14s) + 23.711 s ± 33 ms, 3.83x + fallback heapsort: OK (96.39s) + 32.157 s ± 355 ms, 5.20x + Sorting 10 random arrays of length 16 with many duplicates + C++: OK (0.37s) + 673 ns ± 36 ns + Sequential ST Median3: OK (0.17s) + 576 ns ± 53 ns, 0.86x + Sequential IO Median3: OK (0.16s) + 560 ns ± 49 ns, 0.83x + ParStrategies ST Median3: OK (0.17s) + 576 ns ± 49 ns, 0.86x + ParStrategies IO Median3: OK (0.17s) + 575 ns ± 42 ns, 0.85x + Sequential ST Median3or5: OK (0.17s) + 575 ns ± 57 ns, 0.85x + Sequential IO Median3or5: OK (0.17s) + 568 ns ± 47 ns, 0.84x + ParStrategies ST Median3or5: OK (0.33s) + 596 ns ± 50 ns, 0.89x + ParStrategies IO Median3or5: OK (0.33s) + 593 ns ± 30 ns, 0.88x + Sequential ST AveragingMedian: OK (0.32s) + 571 ns ± 26 ns, 0.85x + Threads IO Median3: OK (0.24s) + 1.71 μs ± 85 ns, 2.54x + Threads IO Median3or5: OK (0.24s) + 1.71 μs ± 118 ns, 2.53x + vector-algorithms heapsort: OK (0.20s) + 1.39 μs ± 90 ns, 2.06x + fallback heapsort: OK (0.17s) + 1.17 μs ± 83 ns, 1.73x + Sorting 10 random arrays of length 17 with many duplicates + C++: OK (0.22s) + 763 ns ± 56 ns + Sequential ST Median3: OK (0.41s) + 752 ns ± 22 ns, 0.99x + Sequential IO Median3: OK (0.21s) + 744 ns ± 64 ns, 0.98x + ParStrategies ST Median3: OK (0.23s) + 798 ns ± 44 ns, 1.05x + ParStrategies IO Median3: OK (0.22s) + 782 ns ± 46 ns, 1.03x + Sequential ST Median3or5: OK (0.21s) + 738 ns ± 44 ns, 0.97x + Sequential IO Median3or5: OK (0.21s) + 749 ns ± 52 ns, 0.98x + ParStrategies ST Median3or5: OK (0.22s) + 786 ns ± 42 ns, 1.03x + ParStrategies IO Median3or5: OK (0.44s) + 796 ns ± 29 ns, 1.04x + Sequential ST AveragingMedian: OK (0.30s) + 2.16 μs ± 88 ns, 2.83x + Threads IO Median3: OK (0.14s) + 1.92 μs ± 173 ns, 2.51x + Threads IO Median3or5: OK (0.27s) + 1.98 μs ± 116 ns, 2.59x + vector-algorithms heapsort: OK (0.22s) + 1.52 μs ± 97 ns, 1.99x + fallback heapsort: OK (0.18s) + 1.26 μs ± 85 ns, 1.65x + Sorting 10 random arrays of length 100 with many duplicates + C++: OK (0.19s) + 5.12 μs ± 401 ns + Sequential ST Median3: OK (0.21s) + 5.85 μs ± 409 ns, 1.14x + Sequential IO Median3: OK (0.21s) + 5.85 μs ± 527 ns, 1.14x + ParStrategies ST Median3: OK (0.22s) + 6.26 μs ± 395 ns, 1.22x + ParStrategies IO Median3: OK (0.28s) + 7.89 μs ± 461 ns, 1.54x + Sequential ST Median3or5: OK (0.21s) + 5.71 μs ± 458 ns, 1.11x + Sequential IO Median3or5: OK (0.20s) + 5.70 μs ± 404 ns, 1.11x + ParStrategies ST Median3or5: OK (0.23s) + 6.45 μs ± 381 ns, 1.26x + ParStrategies IO Median3or5: OK (0.23s) + 6.47 μs ± 499 ns, 1.26x + Sequential ST AveragingMedian: OK (0.13s) + 29.0 μs ± 2.6 μs, 5.65x + Threads IO Median3: OK (0.14s) + 7.34 μs ± 671 ns, 1.43x + Threads IO Median3or5: OK (0.26s) + 7.48 μs ± 455 ns, 1.46x + vector-algorithms heapsort: OK (0.17s) + 18.6 μs ± 1.3 μs, 3.63x + fallback heapsort: OK (0.20s) + 23.2 μs ± 2.2 μs, 4.52x + Sorting 10 random arrays of length 256 with many duplicates + C++: OK (0.20s) + 46.3 μs ± 3.2 μs + Sequential ST Median3: OK (0.25s) + 55.6 μs ± 5.0 μs, 1.20x + Sequential IO Median3: OK (0.42s) + 49.5 μs ± 3.0 μs, 1.07x + ParStrategies ST Median3: OK (0.23s) + 53.0 μs ± 2.7 μs, 1.14x + ParStrategies IO Median3: OK (0.13s) + 55.7 μs ± 5.3 μs, 1.20x + Sequential ST Median3or5: OK (0.22s) + 49.2 μs ± 2.9 μs, 1.06x + Sequential IO Median3or5: OK (0.42s) + 49.3 μs ± 2.0 μs, 1.06x + ParStrategies ST Median3or5: OK (0.24s) + 55.2 μs ± 4.2 μs, 1.19x + ParStrategies IO Median3or5: OK (0.47s) + 55.0 μs ± 1.5 μs, 1.19x + Sequential ST AveragingMedian: OK (0.13s) + 121 μs ± 11 μs, 2.60x + Threads IO Median3: OK (0.13s) + 56.1 μs ± 5.4 μs, 1.21x + Threads IO Median3or5: OK (0.25s) + 56.6 μs ± 3.4 μs, 1.22x + vector-algorithms heapsort: OK (0.22s) + 102 μs ± 5.2 μs, 2.21x + fallback heapsort: OK (0.21s) + 94.9 μs ± 5.4 μs, 2.05x + Sorting 10 random arrays of length 1,000 with many duplicates + C++: OK (0.30s) + 279 μs ± 14 μs + Sequential ST Median3: OK (0.20s) + 367 μs ± 22 μs, 1.31x + Sequential IO Median3: OK (0.18s) + 335 μs ± 33 μs, 1.20x + ParStrategies ST Median3: OK (0.19s) + 344 μs ± 22 μs, 1.23x + ParStrategies IO Median3: OK (0.19s) + 359 μs ± 24 μs, 1.28x + Sequential ST Median3or5: OK (0.18s) + 336 μs ± 25 μs, 1.20x + Sequential IO Median3or5: OK (0.18s) + 336 μs ± 21 μs, 1.20x + ParStrategies ST Median3or5: OK (0.38s) + 358 μs ± 14 μs, 1.28x + ParStrategies IO Median3or5: OK (0.19s) + 363 μs ± 26 μs, 1.30x + Sequential ST AveragingMedian: OK (0.16s) + 583 μs ± 43 μs, 2.09x + Threads IO Median3: OK (0.19s) + 357 μs ± 23 μs, 1.28x + Threads IO Median3or5: OK (0.19s) + 358 μs ± 28 μs, 1.28x + vector-algorithms heapsort: OK (0.15s) + 536 μs ± 42 μs, 1.92x + fallback heapsort: OK (0.13s) + 494 μs ± 46 μs, 1.77x + Sorting 10 random arrays of length 10,000 with many duplicates + C++: OK (0.21s) + 3.25 ms ± 184 μs + Sequential ST Median3: OK (0.14s) + 4.23 ms ± 347 μs, 1.30x + Sequential IO Median3: OK (0.24s) + 3.65 ms ± 329 μs, 1.12x + ParStrategies ST Median3: OK (0.12s) + 3.76 ms ± 362 μs, 1.15x + ParStrategies IO Median3: OK (0.13s) + 3.98 ms ± 360 μs, 1.22x + Sequential ST Median3or5: OK (0.24s) + 3.72 ms ± 254 μs, 1.14x + Sequential IO Median3or5: OK (0.12s) + 3.71 ms ± 344 μs, 1.14x + ParStrategies ST Median3or5: OK (0.13s) + 3.96 ms ± 344 μs, 1.22x + ParStrategies IO Median3or5: OK (0.27s) + 4.10 ms ± 315 μs, 1.26x + Sequential ST AveragingMedian: OK (0.12s) + 7.81 ms ± 724 μs, 2.40x + Threads IO Median3: OK (0.13s) + 3.92 ms ± 338 μs, 1.20x + Threads IO Median3or5: OK (0.13s) + 4.05 ms ± 347 μs, 1.24x + vector-algorithms heapsort: OK (0.12s) + 7.85 ms ± 674 μs, 2.41x + fallback heapsort: OK (0.21s) + 6.58 ms ± 434 μs, 2.02x + Sorting 10 random arrays of length 100,000 with many duplicates + C++: OK (0.24s) + 33.0 ms ± 1.5 ms + Sequential ST Median3: OK (0.12s) + 38.8 ms ± 2.7 ms, 1.18x + Sequential IO Median3: OK (0.10s) + 33.1 ms ± 2.9 ms, 1.00x + ParStrategies ST Median3: OK (0.23s) + 32.9 ms ± 1.9 ms, 1.00x + ParStrategies IO Median3: OK (0.13s) + 41.5 ms ± 3.3 ms, 1.26x + Sequential ST Median3or5: OK (0.23s) + 32.8 ms ± 2.3 ms, 1.00x + Sequential IO Median3or5: OK (0.10s) + 33.4 ms ± 3.1 ms, 1.01x + ParStrategies ST Median3or5: OK (0.23s) + 32.9 ms ± 1.5 ms, 1.00x + ParStrategies IO Median3or5: OK (0.23s) + 33.0 ms ± 2.0 ms, 1.00x + Sequential ST AveragingMedian: OK (0.31s) + 102 ms ± 7.6 ms, 3.08x + Threads IO Median3: OK (0.48s) + 32.2 ms ± 982 μs, 0.98x + Threads IO Median3or5: OK (0.48s) + 31.3 ms ± 1.6 ms, 0.95x + vector-algorithms heapsort: OK (0.31s) + 103 ms ± 5.2 ms, 3.12x + fallback heapsort: OK (0.27s) + 89.0 ms ± 4.7 ms, 2.70x + Sorting 10 random arrays of length 1,000,000 with many duplicates + C++: OK (1.03s) + 339 ms ± 32 ms + Sequential ST Median3: OK (1.16s) + 387 ms ± 5.5 ms, 1.14x + Sequential IO Median3: OK (0.99s) + 329 ms ± 5.0 ms, 0.97x + ParStrategies ST Median3: OK (0.59s) + 198 ms ± 15 ms, 0.58x + ParStrategies IO Median3: OK (0.60s) + 198 ms ± 5.8 ms, 0.58x + Sequential ST Median3or5: OK (0.99s) + 329 ms ± 8.3 ms, 0.97x + Sequential IO Median3or5: OK (1.00s) + 331 ms ± 3.6 ms, 0.98x + ParStrategies ST Median3or5: OK (1.39s) + 199 ms ± 5.0 ms, 0.59x + ParStrategies IO Median3or5: OK (0.60s) + 199 ms ± 3.0 ms, 0.59x + Sequential ST AveragingMedian: OK (3.82s) + 1.273 s ± 25 ms, 3.76x + Threads IO Median3: OK (0.88s) + 294 ms ± 27 ms, 0.87x + Threads IO Median3or5: OK (1.92s) + 274 ms ± 15 ms, 0.81x + vector-algorithms heapsort: OK (11.77s) + 1.664 s ± 6.3 ms, 4.91x + fallback heapsort: OK (4.08s) + 1.357 s ± 23 ms, 4.00x + Sorting 10 random arrays of length 10,000,000 with many duplicates + C++: OK (16.77s) + 5.595 s ± 88 ms + Sequential ST Median3: OK (15.18s) + 5.059 s ± 9.0 ms, 0.90x + Sequential IO Median3: OK (16.64s) + 5.541 s ± 75 ms, 0.99x + ParStrategies ST Median3: OK (4.50s) + 1.499 s ± 4.0 ms, 0.27x + ParStrategies IO Median3: OK (4.60s) + 1.534 s ± 14 ms, 0.27x + Sequential ST Median3or5: OK (12.89s) + 4.287 s ± 114 ms, 0.77x + Sequential IO Median3or5: OK (12.81s) + 4.267 s ± 46 ms, 0.76x + ParStrategies ST Median3or5: OK (4.19s) + 1.399 s ± 70 ms, 0.25x + ParStrategies IO Median3or5: OK (4.28s) + 1.430 s ± 43 ms, 0.26x + Sequential ST AveragingMedian: OK (72.72s) + 24.214 s ± 367 ms, 4.33x + Threads IO Median3: OK (10.38s) + 3.450 s ± 125 ms, 0.62x + Threads IO Median3or5: OK (8.70s) + 2.886 s ± 191 ms, 0.52x + vector-algorithms heapsort: OK (68.36s) + 22.767 s ± 265 ms, 4.07x + fallback heapsort: OK (65.38s) + 21.792 s ± 5.9 ms, 3.90x +``` + diff --git a/bench/BenchMain.hs b/bench/BenchMain.hs new file mode 100644 --- /dev/null +++ b/bench/BenchMain.hs @@ -0,0 +1,257 @@ +-- | +-- Module: BenchmarkMain +-- Copyright: (c) Sergey Vinokurov 2022 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +{-# LANGUAGE CPP #-} +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE QuantifiedConstraints #-} + +{-# OPTIONS_GHC -Wno-orphans #-} + +module BenchmarkMain (main) where + +import Prelude hiding (pi, last) + +import Control.Concurrent.STM +import Control.DeepSeq +import Control.Exception +import Control.Monad +import Control.Monad.ST +import Data.ByteString.Char8 qualified as C8 +import Data.Int +import Data.Ord +import Data.Text (Text) +import Data.Text qualified as T +import Data.Text.Builder.Linear qualified as TBL +import Data.Tuple +import Data.Vector.Algorithms.Heap qualified as Heap +import Data.Vector.Primitive qualified as P +import Data.Vector.Primitive.Mutable qualified as PM +import Data.Vector.Storable qualified as S +import Data.Vector.Storable.Mutable qualified as SM +import Foreign.C.Types +import System.Random.Stateful + +import Test.Tasty.Bench +import Test.Tasty.Patterns.Printer (printAwkExpr) + +import ForeignSorting + +import Data.Vector.Algorithms.Heapsort qualified as Heapsort + +import Data.Vector.Algorithms.Quicksort.Predefined.PIntParallelStrategiesMedian3IO +import Data.Vector.Algorithms.Quicksort.Predefined.PIntParallelStrategiesMedian3ST +import Data.Vector.Algorithms.Quicksort.Predefined.PIntParallelStrategiesMedian3or5IO +import Data.Vector.Algorithms.Quicksort.Predefined.PIntParallelStrategiesMedian3or5ST +import Data.Vector.Algorithms.Quicksort.Predefined.PIntSequentialAveragingMedianST +import Data.Vector.Algorithms.Quicksort.Predefined.PIntSequentialMedian3IO +import Data.Vector.Algorithms.Quicksort.Predefined.PIntSequentialMedian3ST +import Data.Vector.Algorithms.Quicksort.Predefined.PIntSequentialMedian3or5IO +import Data.Vector.Algorithms.Quicksort.Predefined.PIntSequentialMedian3or5ST + +import Data.Vector.Algorithms.Quicksort.Predefined.PIntParallelMedian3IO +import Data.Vector.Algorithms.Quicksort.Predefined.PIntParallelMedian3or5IO + +newtype SortKey v = SortKey { _unSortKey :: (Int32, Int, v) } + +instance Eq (SortKey v) where + SortKey (a, b, _) == SortKey (a', b', _) = a == a' && b == b' + +instance Ord (SortKey v) where + SortKey (a, b, _) `compare` SortKey (a', b', _) = Down a `compare` Down a' <> b `compare` b' + +{-# NOINLINE qsortSeq3 #-} +qsortSeq3 :: P.Vector Int64 -> ST s (PM.MVector s Int64) +qsortSeq3 xs = do + ys <- P.thaw xs + sortPIntSequentialMedian3ST ys + pure ys + +{-# NOINLINE qsortSeqIO3 #-} +qsortSeqIO3 :: P.Vector Int64 -> IO (PM.MVector RealWorld Int64) +qsortSeqIO3 xs = do + ys <- P.thaw xs + sortPIntSequentialMedian3IO ys + pure ys + +{-# NOINLINE qsortParStrategies3IO #-} +qsortParStrategies3IO :: P.Vector Int64 -> IO (PM.MVector RealWorld Int64) +qsortParStrategies3IO xs = do + ys <- P.thaw xs + sortPIntParallelStrategiesMedian3IO ys + pure ys + +{-# NOINLINE qsortParStrategies3ST #-} +qsortParStrategies3ST :: P.Vector Int64 -> ST s (PM.MVector s Int64) +qsortParStrategies3ST xs = do + ys <- P.thaw xs + sortPIntParallelStrategiesMedian3ST ys + pure ys + +{-# NOINLINE qsortSeq3or5ST #-} +qsortSeq3or5ST :: P.Vector Int64 -> ST s (PM.MVector s Int64) +qsortSeq3or5ST xs = do + ys <- P.thaw xs + sortPIntSequentialMedian3or5ST ys + pure ys + +{-# NOINLINE qsortSeqAvgST #-} +qsortSeqAvgST :: P.Vector Int64 -> ST s (PM.MVector s Int64) +qsortSeqAvgST xs = do + ys <- P.thaw xs + sortPIntSequentialAveragingMedianST ys + pure ys + +{-# NOINLINE qsortSeq3or5IO #-} +qsortSeq3or5IO :: P.Vector Int64 -> IO (PM.MVector RealWorld Int64) +qsortSeq3or5IO xs = do + ys <- P.thaw xs + sortPIntSequentialMedian3or5IO ys + pure ys + +{-# NOINLINE qsortParStrategies3or5IO #-} +qsortParStrategies3or5IO :: P.Vector Int64 -> IO (PM.MVector RealWorld Int64) +qsortParStrategies3or5IO xs = do + ys <- P.thaw xs + sortPIntParallelStrategiesMedian3or5IO ys + pure ys + +{-# NOINLINE qsortParStrategies3or5ST #-} +qsortParStrategies3or5ST :: P.Vector Int64 -> ST s (PM.MVector s Int64) +qsortParStrategies3or5ST xs = do + ys <- P.thaw xs + sortPIntParallelStrategiesMedian3or5ST ys + pure ys + +{-# NOINLINE qsortParallel3IO #-} +qsortParallel3IO :: P.Vector Int64 -> IO (PM.MVector RealWorld Int64) +qsortParallel3IO xs = do + ys <- P.thaw xs + sortPIntParallelMedian3IO ys + pure ys + +{-# NOINLINE qsortParallel3or5IO #-} +qsortParallel3or5IO :: P.Vector Int64 -> IO (PM.MVector RealWorld Int64) +qsortParallel3or5IO xs = do + ys <- P.thaw xs + sortPIntParallelMedian3or5IO ys + pure ys + +{-# NOINLINE vectorAlgoHeapsortInt64 #-} +vectorAlgoHeapsortInt64 :: P.Vector Int64 -> ST s (PM.MVector s Int64) +vectorAlgoHeapsortInt64 xs = do + ys <- P.thaw xs + Heap.sort ys + pure ys + +{-# NOINLINE fallbackHeapsortInt64 #-} +fallbackHeapsortInt64 :: P.Vector Int64 -> ST s (PM.MVector s Int64) +fallbackHeapsortInt64 xs = do + ys <- P.thaw xs + Heapsort.heapSort ys + pure ys + +{-# NOINLINE cppUnboxedInt64 #-} +cppUnboxedInt64 :: S.Vector Int64 -> IO (SM.MVector RealWorld Int64) +cppUnboxedInt64 xs = do + ys <- S.thaw xs + SM.unsafeWith ys $ \ptr -> cppSortInt64 ptr (CInt (fromIntegral (SM.length ys))) + pure ys + +main :: IO () +main = do + (fuzzyMatchScores :: P.Vector Int64) <- + read . C8.unpack <$> C8.readFile "test.txt" + + putStrLn $ "P.length fuzzyMatchScores = " ++ show (P.length fuzzyMatchScores) + + let generate :: Int -> Int -> IOGenM StdGen -> IO (P.Vector Int64) + generate n k g = P.fromList <$> replicateM n (uniformRM (1 :: Int64, fromIntegral k) g) + + gen <- newIOGenM $ mkStdGen 1 + let sizes :: [(Int, Int)] + sizes = map (10, ) [16, 17, 100, 256, 1000, 10_000, 100_000, 1_000_000, 10_000_000] + + xsssNoDup <- traverse (\(n, k) -> replicateM n $ generate k k gen) sizes + xsssDup <- traverse (\(n, k) -> replicateM n $ generate k (max 1000 (k `quot` 1000)) gen) sizes + + evaluate $ rnf xsssNoDup + evaluate $ rnf xsssDup + + defaultMain $ + [ mkBenches "Sorting fuzzy matching scores vector" (MkSolo fuzzyMatchScores) + ] ++ + [ mkBenches ("Sorting " ++ show (length xss) ++ " random arrays of length " ++ T.unpack (formatNumber (P.length (head xss))) ++ " with few duplicates") xss + | xss <- xsssNoDup + ] ++ + [ mkBenches ("Sorting " ++ show (length xss) ++ " random arrays of length " ++ T.unpack (formatNumber (P.length (head xss))) ++ " with many duplicates") xss + | xss <- xsssDup + ] + +instance NFData (TVar a) where + rnf x = x `seq` () + +{-# INLINE mkBenches #-} +mkBenches + :: forall f. (Traversable f, forall a. NFData a => NFData (f a)) + => String -> f (P.Vector Int64) -> Benchmark +mkBenches name xssPrim = mapLeafBenchmarks addCompare $ bgroup name + [ bench cppBenchName $ nfAppIO (traverse cppUnboxedInt64) xsStorable + + , bench "Sequential ST Median3" $ nfAppIO (stToIO . traverse qsortSeq3) xssPrim + , bench "Sequential IO Median3" $ nfAppIO (traverse qsortSeqIO3) xssPrim + , bench "ParStrategies ST Median3" $ nfAppIO (stToIO . traverse qsortParStrategies3ST) xssPrim + , bench "ParStrategies IO Median3" $ nfAppIO (traverse qsortParStrategies3IO) xssPrim + + , bench "Sequential ST Median3or5" $ nfAppIO (stToIO . traverse qsortSeq3or5ST) xssPrim + , bench "Sequential IO Median3or5" $ nfAppIO (traverse qsortSeq3or5IO) xssPrim + , bench "ParStrategies ST Median3or5" $ nfAppIO (stToIO . traverse qsortParStrategies3or5ST) xssPrim + , bench "ParStrategies IO Median3or5" $ nfAppIO (traverse qsortParStrategies3or5IO) xssPrim + + , bench "Sequential ST AveragingMedian" $ nfAppIO (stToIO . traverse qsortSeqAvgST) xssPrim + + , bench "Threads IO Median3" $ nfAppIO (traverse qsortParallel3IO) xssPrim + , bench "Threads IO Median3or5" $ nfAppIO (traverse qsortParallel3or5IO) xssPrim + + , bench "vector-algorithms heapsort" $ nfAppIO (stToIO . traverse vectorAlgoHeapsortInt64) xssPrim + , bench "fallback heapsort" $ nfAppIO (stToIO . traverse fallbackHeapsortInt64) xssPrim + ] + where + xsStorable :: f (S.Vector Int64) + xsStorable = P.convert <$> xssPrim + +cppBenchName :: String +cppBenchName = "C++" + +addCompare :: [String] -> Benchmark -> Benchmark +addCompare (name : path) + | name /= cppBenchName + = bcompare (printAwkExpr (locateBenchmark (cppBenchName : path))) +addCompare _ = id + +#if !MIN_VERSION_base(4, 18, 0) +pattern MkSolo :: a -> Solo a +pattern MkSolo x = Solo x + +# if !MIN_VERSION_base(4, 17, 0) +instance NFData a => NFData (Solo a) +# endif +#endif + +formatNumber :: Int -> Text +formatNumber x = TBL.runBuilder $ sign <> go mempty (abs x) + where + sign :: TBL.Builder + sign = if x < 0 then "-" else "" + go :: TBL.Builder -> Int -> TBL.Builder + go acc n + | n < 1000 = TBL.fromDec n <> acc + | otherwise = go (TBL.fromChar ',' <> padding <> TBL.fromText k' <> acc) n' + where + (n', k) = n `quotRem` 1000 + k' = TBL.runBuilder $ TBL.fromDec k + padding = TBL.fromText $ T.replicate (3 - T.length k') $ T.singleton '0' diff --git a/bench/ForeignSorting.hs b/bench/ForeignSorting.hs new file mode 100644 --- /dev/null +++ b/bench/ForeignSorting.hs @@ -0,0 +1,18 @@ +-- | +-- Module: ForeignSorting +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +module ForeignSorting + ( cppSortInt64 + ) where + +import Data.Int +import Foreign +import Foreign.C.Types + +foreign import ccall unsafe "cplusplus_sort" cppSortInt64 + :: Ptr Int64 + -> CInt + -> IO () diff --git a/cbits/sort.cpp b/cbits/sort.cpp new file mode 100644 --- /dev/null +++ b/cbits/sort.cpp @@ -0,0 +1,8 @@ +#include +#include + +extern "C" { + void cplusplus_sort(int64_t* xs, int len) { + std::sort(xs, xs + len); + } +} diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/AveragingMedian.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/AveragingMedian.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/AveragingMedian.hs @@ -0,0 +1,68 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.AveragingMedian +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} + +module Data.Vector.Algorithms.Quicksort.Predefined.AveragingMedian + ( AveragingMedian(..) + ) where + +import Control.Monad.Primitive +import Data.Bits +import Data.Int +import Data.Kind +import Data.Vector.Generic.Mutable qualified as GM + +import Data.Vector.Algorithms.Quicksort.Median +import Data.Vector.Algorithms.Quicksort.Predefined.Pair + +data AveragingMedian a = AveragingMedian + +instance (PrimMonad m, s ~ PrimState m) => Median (AveragingMedian Int64) Int64 m s where + {-# INLINE selectMedian #-} + selectMedian + :: forall (v :: Type -> Type -> Type). + GM.MVector v Int64 + => AveragingMedian Int64 + -> v s Int64 + -> m (MedianResult Int64) + selectMedian _ !v = do + let len :: Int + !len = GM.length v + pi0, pi1, pi2 :: Int + !pi0 = 0 + !pi1 = halve len + !pi2 = len - 1 + !pv0 <- GM.unsafeRead v pi0 + !pv1 <- GM.unsafeRead v pi1 + !pv2 <- GM.unsafeRead v pi2 + pure $! Guess $ pv0 + pv1 + pv2 `quot` 3 + +instance (PrimMonad m, s ~ PrimState m) => Median (AveragingMedian (TestPair Int32 b)) (TestPair Int32 b) m s where + {-# INLINE selectMedian #-} + selectMedian + :: forall (v :: Type -> Type -> Type). + GM.MVector v (TestPair Int32 b) + => AveragingMedian (TestPair Int32 b) + -> v s (TestPair Int32 b) + -> m (MedianResult (TestPair Int32 b)) + selectMedian _ !v = do + let len :: Int + !len = GM.length v + pi0, pi1, pi2 :: Int + !pi0 = 0 + !pi1 = halve len + !pi2 = len - 1 + !(TestPair !pv0 pv0') <- GM.unsafeRead v pi0 + !pv1 <- fst . toTuple <$> GM.unsafeRead v pi1 + !pv2 <- fst . toTuple <$> GM.unsafeRead v pi2 + pure $! Guess $ TestPair (pv0 + pv1 + pv2 `quot` 3) pv0' + +{-# INLINE halve #-} +halve :: Int -> Int +halve x = x `unsafeShiftR` 1 + diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/BitonicIntST.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/BitonicIntST.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/BitonicIntST.hs @@ -0,0 +1,20 @@ +---------------------------------------------------------------------------- +-- | +-- Module : Data.Vector.Algorithms.Quicksort.Predefined.BitonicIntST +-- Copyright : (c) Sergey Vinokurov 2023 +-- License : Apache-2.0 (see LICENSE) +-- Maintainer : serg.foo@gmail.com +---------------------------------------------------------------------------- + +module Data.Vector.Algorithms.Quicksort.Predefined.BitonicIntST (bitonicSortIntST) where + +import Control.Monad.ST +import Data.Int +import Data.Vector.Primitive qualified as P +import Data.Vector.Primitive.Mutable qualified as PM + +import Data.Vector.Algorithms.FixedSort + +{-# NOINLINE bitonicSortIntST #-} +bitonicSortIntST :: P.MVector s Int64 -> ST s () +bitonicSortIntST xs = bitonicSort (PM.length xs) xs diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/PIntParallelMedian3IO.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/PIntParallelMedian3IO.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/PIntParallelMedian3IO.hs @@ -0,0 +1,26 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.PIntParallelMedian3IO +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +module Data.Vector.Algorithms.Quicksort.Predefined.PIntParallelMedian3IO + ( sortPIntParallelMedian3IO + ) where + +import Control.Concurrent (getNumCapabilities) +import Control.Monad.ST +import Data.Int +import Data.Vector.Primitive qualified as P + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.Quicksort.Predefined.PIntSequentialMedian3IO () + +{-# NOINLINE sortPIntParallelMedian3IO #-} +sortPIntParallelMedian3IO :: P.MVector RealWorld Int64 -> IO () +sortPIntParallelMedian3IO xs = do + p <- mkParallel =<< getNumCapabilities + sortInplaceFM p (Median3 @Int64) xs + waitParallel p + diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/PIntParallelMedian3or5IO.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/PIntParallelMedian3or5IO.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/PIntParallelMedian3or5IO.hs @@ -0,0 +1,26 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.PIntParallelMedian3or5IO +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +module Data.Vector.Algorithms.Quicksort.Predefined.PIntParallelMedian3or5IO + ( sortPIntParallelMedian3or5IO + ) where + +import Control.Concurrent (getNumCapabilities) +import Control.Monad.ST +import Data.Int +import Data.Vector.Primitive qualified as P + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.Quicksort.Predefined.PIntSequentialMedian3IO () + +{-# NOINLINE sortPIntParallelMedian3or5IO #-} +sortPIntParallelMedian3or5IO :: P.MVector RealWorld Int64 -> IO () +sortPIntParallelMedian3or5IO xs = do + p <- mkParallel =<< getNumCapabilities + sortInplaceFM p (Median3or5 @Int64) xs + waitParallel p + diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/PIntParallelStrategiesMedian3IO.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/PIntParallelStrategiesMedian3IO.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/PIntParallelStrategiesMedian3IO.hs @@ -0,0 +1,22 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.PIntParallelStrategiesMedian3IO +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +module Data.Vector.Algorithms.Quicksort.Predefined.PIntParallelStrategiesMedian3IO + ( sortPIntParallelStrategiesMedian3IO + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector.Primitive qualified as P + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.Quicksort.Predefined.PIntSequentialMedian3IO () + +{-# NOINLINE sortPIntParallelStrategiesMedian3IO #-} +sortPIntParallelStrategiesMedian3IO :: P.MVector RealWorld Int64 -> IO () +sortPIntParallelStrategiesMedian3IO = sortInplaceFM defaultParStrategies (Median3 @Int64) + diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/PIntParallelStrategiesMedian3ST.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/PIntParallelStrategiesMedian3ST.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/PIntParallelStrategiesMedian3ST.hs @@ -0,0 +1,21 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.VIntParallelStrategiesMedian3ST +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +module Data.Vector.Algorithms.Quicksort.Predefined.PIntParallelStrategiesMedian3ST + ( sortPIntParallelStrategiesMedian3ST + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector.Primitive qualified as P + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.Quicksort.Predefined.PIntSequentialMedian3ST () + +{-# NOINLINE sortPIntParallelStrategiesMedian3ST #-} +sortPIntParallelStrategiesMedian3ST :: P.MVector s Int64 -> ST s () +sortPIntParallelStrategiesMedian3ST = sortInplaceFM defaultParStrategies (Median3 @Int64) diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/PIntParallelStrategiesMedian3or5IO.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/PIntParallelStrategiesMedian3or5IO.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/PIntParallelStrategiesMedian3or5IO.hs @@ -0,0 +1,22 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.VIntParallelStrategiesMedian3or5ST +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +module Data.Vector.Algorithms.Quicksort.Predefined.PIntParallelStrategiesMedian3or5IO + ( sortPIntParallelStrategiesMedian3or5IO + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector.Primitive qualified as P + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.Quicksort.Predefined.PIntSequentialMedian3IO () + +{-# NOINLINE sortPIntParallelStrategiesMedian3or5IO #-} +sortPIntParallelStrategiesMedian3or5IO :: P.MVector RealWorld Int64 -> IO () +sortPIntParallelStrategiesMedian3or5IO = sortInplaceFM defaultParStrategies (Median3or5 @Int64) + diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/PIntParallelStrategiesMedian3or5ST.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/PIntParallelStrategiesMedian3or5ST.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/PIntParallelStrategiesMedian3or5ST.hs @@ -0,0 +1,22 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.VIntParallelStrategiesMedian3or5ST +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +module Data.Vector.Algorithms.Quicksort.Predefined.PIntParallelStrategiesMedian3or5ST + ( sortPIntParallelStrategiesMedian3or5ST + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector.Primitive qualified as P + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.Quicksort.Predefined.PIntSequentialMedian3ST () + +{-# NOINLINE sortPIntParallelStrategiesMedian3or5ST #-} +sortPIntParallelStrategiesMedian3or5ST :: P.MVector s Int64 -> ST s () +sortPIntParallelStrategiesMedian3or5ST = sortInplaceFM defaultParStrategies (Median3or5 @Int64) + diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/PIntSequentialAveragingMedianST.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/PIntSequentialAveragingMedianST.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/PIntSequentialAveragingMedianST.hs @@ -0,0 +1,24 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.VIntSequentialMedian3ST +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +module Data.Vector.Algorithms.Quicksort.Predefined.PIntSequentialAveragingMedianST + ( sortPIntSequentialAveragingMedianST + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector.Primitive qualified as P + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.Quicksort.Predefined.AveragingMedian +import Data.Vector.Algorithms.Quicksort.Predefined.PIntSequentialMedian3ST () + +{-# NOINLINE sortPIntSequentialAveragingMedianST #-} +sortPIntSequentialAveragingMedianST :: P.MVector s Int64 -> ST s () +sortPIntSequentialAveragingMedianST = sortInplaceFM Sequential (AveragingMedian @Int64) + + diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/PIntSequentialMedian3IO.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/PIntSequentialMedian3IO.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/PIntSequentialMedian3IO.hs @@ -0,0 +1,28 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.VIntSequentialMedian3ST +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +{-# OPTIONS_GHC -Wno-orphans #-} + +module Data.Vector.Algorithms.Quicksort.Predefined.PIntSequentialMedian3IO + ( sortPIntSequentialMedian3IO + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector.Primitive qualified as P + +import Data.Vector.Algorithms.FixedSort +import Data.Vector.Algorithms.Heapsort +import Data.Vector.Algorithms.Quicksort.Parameterised + +{-# SPECIALIZE heapSort :: P.MVector RealWorld Int64 -> IO () #-} +{-# SPECIALIZE bitonicSort :: Int -> P.MVector RealWorld Int64 -> IO () #-} + +{-# NOINLINE sortPIntSequentialMedian3IO #-} +sortPIntSequentialMedian3IO :: P.MVector RealWorld Int64 -> IO () +sortPIntSequentialMedian3IO = sortInplaceFM Sequential (Median3 @Int64) + + diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/PIntSequentialMedian3ST.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/PIntSequentialMedian3ST.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/PIntSequentialMedian3ST.hs @@ -0,0 +1,31 @@ +---------------------------------------------------------------------------- +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.VIntSequentialMedian3ST +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com +---------------------------------------------------------------------------- + +{-# OPTIONS_GHC -Wno-orphans #-} + +module Data.Vector.Algorithms.Quicksort.Predefined.PIntSequentialMedian3ST + ( sortPIntSequentialMedian3ST + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector.Primitive qualified as P + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.FixedSort +import Data.Vector.Algorithms.Heapsort + +{-# SPECIALIZE heapSort :: P.MVector s Int64 -> ST s () #-} +{-# SPECIALIZE bitonicSort :: Int -> P.MVector s Int64 -> ST s () #-} + +{-# NOINLINE sortPIntSequentialMedian3ST #-} +sortPIntSequentialMedian3ST :: P.MVector s Int64 -> ST s () +sortPIntSequentialMedian3ST = sortInplaceFM Sequential (Median3 @Int64) + + diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/PIntSequentialMedian3or5IO.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/PIntSequentialMedian3or5IO.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/PIntSequentialMedian3or5IO.hs @@ -0,0 +1,22 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.VIntSequentialMedian3or5ST +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +module Data.Vector.Algorithms.Quicksort.Predefined.PIntSequentialMedian3or5IO + ( sortPIntSequentialMedian3or5IO + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector.Primitive qualified as P + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.Quicksort.Predefined.PIntSequentialMedian3IO () + +{-# NOINLINE sortPIntSequentialMedian3or5IO #-} +sortPIntSequentialMedian3or5IO :: P.MVector RealWorld Int64 -> IO () +sortPIntSequentialMedian3or5IO = sortInplaceFM Sequential (Median3or5 @Int64) + diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/PIntSequentialMedian3or5ST.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/PIntSequentialMedian3or5ST.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/PIntSequentialMedian3or5ST.hs @@ -0,0 +1,22 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.VIntSequentialMedian3or5ST +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +module Data.Vector.Algorithms.Quicksort.Predefined.PIntSequentialMedian3or5ST + ( sortPIntSequentialMedian3or5ST + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector.Primitive qualified as P + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.Quicksort.Predefined.PIntSequentialMedian3ST () + +{-# NOINLINE sortPIntSequentialMedian3or5ST #-} +sortPIntSequentialMedian3or5ST :: P.MVector s Int64 -> ST s () +sortPIntSequentialMedian3or5ST = sortInplaceFM Sequential (Median3or5 @Int64) + diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/Pair.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/Pair.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/Pair.hs @@ -0,0 +1,42 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.Pair +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE TypeFamilies #-} + +module Data.Vector.Algorithms.Quicksort.Predefined.Pair + ( TestPair(..) + , toTuple + ) where + +import Data.Vector.Generic qualified as G +import Data.Vector.Generic.Mutable qualified as GM +import Data.Vector.Unboxed qualified as U + +data TestPair a b = TestPair a b + deriving (Show) + +{-# INLINE toTuple #-} +toTuple :: TestPair a b -> (a, b) +toTuple (TestPair a b) = (a, b) + +instance U.IsoUnbox (TestPair a b) (a, b) where + {-# INLINE toURepr #-} + {-# INLINE fromURepr #-} + toURepr = toTuple + fromURepr (a, b) = TestPair a b + +newtype instance U.MVector s (TestPair a b) = MV_TestPair (U.MVector s (a, b)) +newtype instance U.Vector (TestPair a b) = V_TestPair (U.Vector (a, b)) +deriving via (TestPair a b `U.As` (a, b)) instance (U.Unbox a, U.Unbox b) => GM.MVector U.MVector (TestPair a b) +deriving via (TestPair a b `U.As` (a, b)) instance (U.Unbox a, U.Unbox b) => G.Vector U.Vector (TestPair a b) +instance (U.Unbox a, U.Unbox b) => U.Unbox (TestPair a b) + +instance Eq a => Eq (TestPair a b) where + TestPair x _ == TestPair x' _ = x == x' + +instance Ord a => Ord (TestPair a b) where + TestPair x _ `compare` TestPair x' _ = x `compare` x' diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UIntParallelStrategiesMedian3IO.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UIntParallelStrategiesMedian3IO.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UIntParallelStrategiesMedian3IO.hs @@ -0,0 +1,22 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.UIntParallelStrategiesMedian3IO +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +module Data.Vector.Algorithms.Quicksort.Predefined.UIntParallelStrategiesMedian3IO + ( sortUIntParallelStrategiesMedian3IO + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector.Unboxed qualified as U + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.Quicksort.Predefined.UIntSequentialMedian3IO () + +{-# NOINLINE sortUIntParallelStrategiesMedian3IO #-} +sortUIntParallelStrategiesMedian3IO :: U.MVector RealWorld Int64 -> IO () +sortUIntParallelStrategiesMedian3IO = sortInplaceFM defaultParStrategies (Median3 @Int64) + diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UIntParallelStrategiesMedian3ST.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UIntParallelStrategiesMedian3ST.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UIntParallelStrategiesMedian3ST.hs @@ -0,0 +1,23 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.UIntParallelStrategiesMedian3ST +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +module Data.Vector.Algorithms.Quicksort.Predefined.UIntParallelStrategiesMedian3ST + ( sortUIntParallelStrategiesMedian3ST + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector.Unboxed qualified as U + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.Quicksort.Predefined.UIntSequentialMedian3ST () + +{-# NOINLINE sortUIntParallelStrategiesMedian3ST #-} +sortUIntParallelStrategiesMedian3ST :: U.MVector s Int64 -> ST s () +sortUIntParallelStrategiesMedian3ST = sortInplaceFM defaultParStrategies (Median3 @Int64) + + diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UIntParallelStrategiesMedian3or5IO.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UIntParallelStrategiesMedian3or5IO.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UIntParallelStrategiesMedian3or5IO.hs @@ -0,0 +1,23 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.UIntParallelStrategiesMedian3or5IO +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +module Data.Vector.Algorithms.Quicksort.Predefined.UIntParallelStrategiesMedian3or5IO + ( sortUIntParallelStrategiesMedian3or5IO + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector.Unboxed qualified as U + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.Quicksort.Predefined.UIntSequentialMedian3IO () + +{-# NOINLINE sortUIntParallelStrategiesMedian3or5IO #-} +sortUIntParallelStrategiesMedian3or5IO :: U.MVector RealWorld Int64 -> IO () +sortUIntParallelStrategiesMedian3or5IO = sortInplaceFM defaultParStrategies (Median3or5 @Int64) + + diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UIntParallelStrategiesMedian3or5ST.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UIntParallelStrategiesMedian3or5ST.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UIntParallelStrategiesMedian3or5ST.hs @@ -0,0 +1,22 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.UIntParallelStrategiesMedian3or5ST +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +module Data.Vector.Algorithms.Quicksort.Predefined.UIntParallelStrategiesMedian3or5ST + ( sortUIntParallelStrategiesMedian3or5ST + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector.Unboxed qualified as U + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.Quicksort.Predefined.UIntSequentialMedian3ST () + +{-# NOINLINE sortUIntParallelStrategiesMedian3or5ST #-} +sortUIntParallelStrategiesMedian3or5ST :: U.MVector s Int64 -> ST s () +sortUIntParallelStrategiesMedian3or5ST = sortInplaceFM defaultParStrategies (Median3or5 @Int64) + diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UIntSequentialMedian3IO.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UIntSequentialMedian3IO.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UIntSequentialMedian3IO.hs @@ -0,0 +1,28 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.UIntSequentialMedian3IO +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +{-# OPTIONS_GHC -Wno-orphans #-} + +module Data.Vector.Algorithms.Quicksort.Predefined.UIntSequentialMedian3IO + ( sortUIntSequentialMedian3IO + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector.Unboxed qualified as U + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.FixedSort +import Data.Vector.Algorithms.Heapsort + +{-# SPECIALIZE heapSort :: U.MVector RealWorld Int64 -> IO () #-} +{-# SPECIALIZE bitonicSort :: Int -> U.MVector RealWorld Int64 -> IO () #-} + +{-# NOINLINE sortUIntSequentialMedian3IO #-} +sortUIntSequentialMedian3IO :: U.MVector RealWorld Int64 -> IO () +sortUIntSequentialMedian3IO = sortInplaceFM Sequential (Median3 @Int64) + diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UIntSequentialMedian3ST.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UIntSequentialMedian3ST.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UIntSequentialMedian3ST.hs @@ -0,0 +1,29 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.UIntSequentialMedian3ST +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +{-# OPTIONS_GHC -Wno-orphans #-} + +module Data.Vector.Algorithms.Quicksort.Predefined.UIntSequentialMedian3ST + ( sortUIntSequentialMedian3ST + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector.Unboxed qualified as U + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.FixedSort +import Data.Vector.Algorithms.Heapsort + +{-# SPECIALIZE heapSort :: U.MVector s Int64 -> ST s () #-} +{-# SPECIALIZE bitonicSort :: Int -> U.MVector s Int64 -> ST s () #-} + +{-# NOINLINE sortUIntSequentialMedian3ST #-} +sortUIntSequentialMedian3ST :: U.MVector s Int64 -> ST s () +sortUIntSequentialMedian3ST = sortInplaceFM Sequential (Median3 @Int64) + + diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UIntSequentialMedian3or5IO.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UIntSequentialMedian3or5IO.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UIntSequentialMedian3or5IO.hs @@ -0,0 +1,23 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.UIntSequentialMedian3or5IO +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +module Data.Vector.Algorithms.Quicksort.Predefined.UIntSequentialMedian3or5IO + ( sortUIntSequentialMedian3or5IO + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector.Unboxed qualified as U + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.Quicksort.Predefined.UIntSequentialMedian3IO () + +{-# NOINLINE sortUIntSequentialMedian3or5IO #-} +sortUIntSequentialMedian3or5IO :: U.MVector RealWorld Int64 -> IO () +sortUIntSequentialMedian3or5IO = sortInplaceFM Sequential (Median3or5 @Int64) + + diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UIntSequentialMedian3or5ST.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UIntSequentialMedian3or5ST.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UIntSequentialMedian3or5ST.hs @@ -0,0 +1,22 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.UIntSequentialMedian3or5ST +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +module Data.Vector.Algorithms.Quicksort.Predefined.UIntSequentialMedian3or5ST + ( sortUIntSequentialMedian3or5ST + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector.Unboxed qualified as U + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.Quicksort.Predefined.UIntSequentialMedian3ST () + +{-# NOINLINE sortUIntSequentialMedian3or5ST #-} +sortUIntSequentialMedian3or5ST :: U.MVector s Int64 -> ST s () +sortUIntSequentialMedian3or5ST = sortInplaceFM Sequential (Median3or5 @Int64) + diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UPairParallelStrategiesMedian3IO.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UPairParallelStrategiesMedian3IO.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UPairParallelStrategiesMedian3IO.hs @@ -0,0 +1,23 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.UPairParallelStrategiesMedian3IO +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +module Data.Vector.Algorithms.Quicksort.Predefined.UPairParallelStrategiesMedian3IO + ( sortUPairParallelStrategiesMedian3IO + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector.Unboxed qualified as U + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.Quicksort.Predefined.Pair +import Data.Vector.Algorithms.Quicksort.Predefined.UPairSequentialMedian3IO () + +{-# NOINLINE sortUPairParallelStrategiesMedian3IO #-} +sortUPairParallelStrategiesMedian3IO :: U.MVector RealWorld (TestPair Int32 Int32) -> IO () +sortUPairParallelStrategiesMedian3IO = sortInplaceFM defaultParStrategies (Median3 @(TestPair Int32 Int32)) + diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UPairParallelStrategiesMedian3ST.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UPairParallelStrategiesMedian3ST.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UPairParallelStrategiesMedian3ST.hs @@ -0,0 +1,22 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.UPairParallelStrategiesMedian3ST +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +module Data.Vector.Algorithms.Quicksort.Predefined.UPairParallelStrategiesMedian3ST + ( sortUPairParallelStrategiesMedian3ST + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector.Unboxed qualified as U + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.Quicksort.Predefined.Pair +import Data.Vector.Algorithms.Quicksort.Predefined.UPairSequentialMedian3ST () + +{-# NOINLINE sortUPairParallelStrategiesMedian3ST #-} +sortUPairParallelStrategiesMedian3ST :: U.MVector s (TestPair Int32 Int32) -> ST s () +sortUPairParallelStrategiesMedian3ST = sortInplaceFM defaultParStrategies (Median3 @(TestPair Int32 Int32)) diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UPairParallelStrategiesMedian3or5IO.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UPairParallelStrategiesMedian3or5IO.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UPairParallelStrategiesMedian3or5IO.hs @@ -0,0 +1,24 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.UPairParallelStrategiesMedian3or5IO +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +module Data.Vector.Algorithms.Quicksort.Predefined.UPairParallelStrategiesMedian3or5IO + ( sortUPairParallelStrategiesMedian3or5IO + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector.Unboxed qualified as U + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.Quicksort.Predefined.Pair +import Data.Vector.Algorithms.Quicksort.Predefined.UPairSequentialMedian3IO () + +{-# NOINLINE sortUPairParallelStrategiesMedian3or5IO #-} +sortUPairParallelStrategiesMedian3or5IO :: U.MVector RealWorld (TestPair Int32 Int32) -> IO () +sortUPairParallelStrategiesMedian3or5IO = sortInplaceFM defaultParStrategies (Median3or5 @(TestPair Int32 Int32)) + + diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UPairParallelStrategiesMedian3or5ST.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UPairParallelStrategiesMedian3or5ST.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UPairParallelStrategiesMedian3or5ST.hs @@ -0,0 +1,24 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.UPairParallelStrategiesMedian3or5ST +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +module Data.Vector.Algorithms.Quicksort.Predefined.UPairParallelStrategiesMedian3or5ST + ( sortUPairParallelStrategiesMedian3or5ST + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector.Unboxed qualified as U + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.Quicksort.Predefined.Pair +import Data.Vector.Algorithms.Quicksort.Predefined.UPairSequentialMedian3ST () + +{-# NOINLINE sortUPairParallelStrategiesMedian3or5ST #-} +sortUPairParallelStrategiesMedian3or5ST :: U.MVector s (TestPair Int32 Int32) -> ST s () +sortUPairParallelStrategiesMedian3or5ST = sortInplaceFM defaultParStrategies (Median3or5 @(TestPair Int32 Int32)) + + diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UPairSequentialAveragingMedianST.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UPairSequentialAveragingMedianST.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UPairSequentialAveragingMedianST.hs @@ -0,0 +1,23 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.UPairSequentialAveragingMedianST +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +module Data.Vector.Algorithms.Quicksort.Predefined.UPairSequentialAveragingMedianST + ( sortUPairSequentialAveragingMedianST + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector.Unboxed qualified as U + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.Quicksort.Predefined.AveragingMedian +import Data.Vector.Algorithms.Quicksort.Predefined.Pair +import Data.Vector.Algorithms.Quicksort.Predefined.UPairSequentialMedian3ST () + +{-# NOINLINE sortUPairSequentialAveragingMedianST #-} +sortUPairSequentialAveragingMedianST :: U.MVector s (TestPair Int32 Int32) -> ST s () +sortUPairSequentialAveragingMedianST = sortInplaceFM Sequential (AveragingMedian @(TestPair Int32 Int32)) diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UPairSequentialMedian3IO.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UPairSequentialMedian3IO.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UPairSequentialMedian3IO.hs @@ -0,0 +1,29 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.UPairSequentialMedian3IO +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +{-# OPTIONS_GHC -Wno-orphans #-} + +module Data.Vector.Algorithms.Quicksort.Predefined.UPairSequentialMedian3IO + ( sortUPairSequentialMedian3IO + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector.Unboxed qualified as U + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.Quicksort.Predefined.Pair + +import Data.Vector.Algorithms.FixedSort +import Data.Vector.Algorithms.Heapsort + +{-# SPECIALIZE heapSort :: U.MVector RealWorld (TestPair Int32 Int32) -> IO () #-} +{-# SPECIALIZE bitonicSort :: Int -> U.MVector RealWorld (TestPair Int32 Int32) -> IO () #-} + +{-# NOINLINE sortUPairSequentialMedian3IO #-} +sortUPairSequentialMedian3IO :: U.MVector RealWorld (TestPair Int32 Int32) -> IO () +sortUPairSequentialMedian3IO = sortInplaceFM Sequential (Median3 @(TestPair Int32 Int32)) diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UPairSequentialMedian3ST.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UPairSequentialMedian3ST.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UPairSequentialMedian3ST.hs @@ -0,0 +1,31 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.UPairSequentialMedian3ST +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +{-# OPTIONS_GHC -Wno-orphans #-} + +module Data.Vector.Algorithms.Quicksort.Predefined.UPairSequentialMedian3ST + ( sortUPairSequentialMedian3ST + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector.Unboxed qualified as U + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.Quicksort.Predefined.Pair + +import Data.Vector.Algorithms.FixedSort +import Data.Vector.Algorithms.Heapsort + +{-# SPECIALIZE heapSort :: U.MVector s (TestPair Int32 Int32) -> ST s () #-} +{-# SPECIALIZE bitonicSort :: Int -> U.MVector s (TestPair Int32 Int32) -> ST s () #-} + +{-# NOINLINE sortUPairSequentialMedian3ST #-} +sortUPairSequentialMedian3ST :: U.MVector s (TestPair Int32 Int32) -> ST s () +sortUPairSequentialMedian3ST = sortInplaceFM Sequential (Median3 @(TestPair Int32 Int32)) + + diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UPairSequentialMedian3or5IO.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UPairSequentialMedian3or5IO.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UPairSequentialMedian3or5IO.hs @@ -0,0 +1,24 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.UPairSequentialMedian3or5IO +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +module Data.Vector.Algorithms.Quicksort.Predefined.UPairSequentialMedian3or5IO + ( sortUPairSequentialMedian3or5IO + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector.Unboxed qualified as U + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.Quicksort.Predefined.Pair +import Data.Vector.Algorithms.Quicksort.Predefined.UPairSequentialMedian3IO () + +{-# NOINLINE sortUPairSequentialMedian3or5IO #-} +sortUPairSequentialMedian3or5IO :: U.MVector RealWorld (TestPair Int32 Int32) -> IO () +sortUPairSequentialMedian3or5IO = sortInplaceFM Sequential (Median3or5 @(TestPair Int32 Int32)) + + diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UPairSequentialMedian3or5ST.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UPairSequentialMedian3or5ST.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UPairSequentialMedian3or5ST.hs @@ -0,0 +1,24 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.UPairSequentialMedian3or5ST +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +module Data.Vector.Algorithms.Quicksort.Predefined.UPairSequentialMedian3or5ST + ( sortUPairSequentialMedian3or5ST + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector.Unboxed qualified as U + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.Quicksort.Predefined.Pair +import Data.Vector.Algorithms.Quicksort.Predefined.UPairSequentialMedian3ST () + +{-# NOINLINE sortUPairSequentialMedian3or5ST #-} +sortUPairSequentialMedian3or5ST :: U.MVector s (TestPair Int32 Int32) -> ST s () +sortUPairSequentialMedian3or5ST = sortInplaceFM Sequential (Median3or5 @(TestPair Int32 Int32)) + + diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UTupleParallelStrategiesMedian3IO.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UTupleParallelStrategiesMedian3IO.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UTupleParallelStrategiesMedian3IO.hs @@ -0,0 +1,22 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.UTupleParallelStrategiesMedian3IO +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +module Data.Vector.Algorithms.Quicksort.Predefined.UTupleParallelStrategiesMedian3IO + ( sortUTupleParallelStrategiesMedian3IO + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector.Unboxed qualified as U + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.Quicksort.Predefined.UTupleSequentialMedian3IO () + +{-# NOINLINE sortUTupleParallelStrategiesMedian3IO #-} +sortUTupleParallelStrategiesMedian3IO :: U.MVector RealWorld (Int32, Int32) -> IO () +sortUTupleParallelStrategiesMedian3IO = sortInplaceFM defaultParStrategies (Median3 @(Int32, Int32)) + diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UTupleParallelStrategiesMedian3ST.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UTupleParallelStrategiesMedian3ST.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UTupleParallelStrategiesMedian3ST.hs @@ -0,0 +1,21 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.UTupleParallelStrategiesMedian3ST +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +module Data.Vector.Algorithms.Quicksort.Predefined.UTupleParallelStrategiesMedian3ST + ( sortUTupleParallelStrategiesMedian3ST + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector.Unboxed qualified as U + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.Quicksort.Predefined.UTupleSequentialMedian3ST () + +{-# NOINLINE sortUTupleParallelStrategiesMedian3ST #-} +sortUTupleParallelStrategiesMedian3ST :: U.MVector s (Int32, Int32) -> ST s () +sortUTupleParallelStrategiesMedian3ST = sortInplaceFM defaultParStrategies (Median3 @(Int32, Int32)) diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UTupleParallelStrategiesMedian3or5IO.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UTupleParallelStrategiesMedian3or5IO.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UTupleParallelStrategiesMedian3or5IO.hs @@ -0,0 +1,23 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.UTupleParallelStrategiesMedian3or5IO +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +module Data.Vector.Algorithms.Quicksort.Predefined.UTupleParallelStrategiesMedian3or5IO + ( sortUTupleParallelStrategiesMedian3or5IO + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector.Unboxed qualified as U + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.Quicksort.Predefined.UTupleSequentialMedian3IO () + +{-# NOINLINE sortUTupleParallelStrategiesMedian3or5IO #-} +sortUTupleParallelStrategiesMedian3or5IO :: U.MVector RealWorld (Int32, Int32) -> IO () +sortUTupleParallelStrategiesMedian3or5IO = sortInplaceFM defaultParStrategies (Median3or5 @(Int32, Int32)) + + diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UTupleParallelStrategiesMedian3or5ST.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UTupleParallelStrategiesMedian3or5ST.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UTupleParallelStrategiesMedian3or5ST.hs @@ -0,0 +1,23 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.UTupleParallelStrategiesMedian3or5ST +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +module Data.Vector.Algorithms.Quicksort.Predefined.UTupleParallelStrategiesMedian3or5ST + ( sortUTupleParallelStrategiesMedian3or5ST + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector.Unboxed qualified as U + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.Quicksort.Predefined.UTupleSequentialMedian3ST () + +{-# NOINLINE sortUTupleParallelStrategiesMedian3or5ST #-} +sortUTupleParallelStrategiesMedian3or5ST :: U.MVector s (Int32, Int32) -> ST s () +sortUTupleParallelStrategiesMedian3or5ST = sortInplaceFM defaultParStrategies (Median3or5 @(Int32, Int32)) + + diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UTupleSequentialMedian3IO.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UTupleSequentialMedian3IO.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UTupleSequentialMedian3IO.hs @@ -0,0 +1,27 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.UTupleSequentialMedian3IO +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +{-# OPTIONS_GHC -Wno-orphans #-} + +module Data.Vector.Algorithms.Quicksort.Predefined.UTupleSequentialMedian3IO + ( sortUTupleSequentialMedian3IO + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector.Unboxed qualified as U + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.FixedSort +import Data.Vector.Algorithms.Heapsort + +{-# SPECIALIZE heapSort :: U.MVector RealWorld (Int32, Int32) -> IO () #-} +{-# SPECIALIZE bitonicSort :: Int -> U.MVector RealWorld (Int32, Int32) -> IO () #-} + +{-# NOINLINE sortUTupleSequentialMedian3IO #-} +sortUTupleSequentialMedian3IO :: U.MVector RealWorld (Int32, Int32) -> IO () +sortUTupleSequentialMedian3IO = sortInplaceFM Sequential (Median3 @(Int32, Int32)) diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UTupleSequentialMedian3ST.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UTupleSequentialMedian3ST.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UTupleSequentialMedian3ST.hs @@ -0,0 +1,29 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.UTupleSequentialMedian3ST +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +{-# OPTIONS_GHC -Wno-orphans #-} + +module Data.Vector.Algorithms.Quicksort.Predefined.UTupleSequentialMedian3ST + ( sortUTupleSequentialMedian3ST + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector.Unboxed qualified as U + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.FixedSort +import Data.Vector.Algorithms.Heapsort + +{-# SPECIALIZE heapSort :: U.MVector s (Int32, Int32) -> ST s () #-} +{-# SPECIALIZE bitonicSort :: Int -> U.MVector s (Int32, Int32) -> ST s () #-} + +{-# NOINLINE sortUTupleSequentialMedian3ST #-} +sortUTupleSequentialMedian3ST :: U.MVector s (Int32, Int32) -> ST s () +sortUTupleSequentialMedian3ST = sortInplaceFM Sequential (Median3 @(Int32, Int32)) + + diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UTupleSequentialMedian3or5IO.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UTupleSequentialMedian3or5IO.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UTupleSequentialMedian3or5IO.hs @@ -0,0 +1,23 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.UTupleSequentialMedian3or5IO +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +module Data.Vector.Algorithms.Quicksort.Predefined.UTupleSequentialMedian3or5IO + ( sortUTupleSequentialMedian3or5IO + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector.Unboxed qualified as U + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.Quicksort.Predefined.UTupleSequentialMedian3IO () + +{-# NOINLINE sortUTupleSequentialMedian3or5IO #-} +sortUTupleSequentialMedian3or5IO :: U.MVector RealWorld (Int32, Int32) -> IO () +sortUTupleSequentialMedian3or5IO = sortInplaceFM Sequential (Median3or5 @(Int32, Int32)) + + diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UTupleSequentialMedian3or5ST.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UTupleSequentialMedian3or5ST.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/UTupleSequentialMedian3or5ST.hs @@ -0,0 +1,23 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.UTupleSequentialMedian3or5ST +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +module Data.Vector.Algorithms.Quicksort.Predefined.UTupleSequentialMedian3or5ST + ( sortUTupleSequentialMedian3or5ST + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector.Unboxed qualified as U + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.Quicksort.Predefined.UTupleSequentialMedian3ST () + +{-# NOINLINE sortUTupleSequentialMedian3or5ST #-} +sortUTupleSequentialMedian3or5ST :: U.MVector s (Int32, Int32) -> ST s () +sortUTupleSequentialMedian3or5ST = sortInplaceFM Sequential (Median3or5 @(Int32, Int32)) + + diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VIntParallelStrategiesMedian3IO.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VIntParallelStrategiesMedian3IO.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VIntParallelStrategiesMedian3IO.hs @@ -0,0 +1,22 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.VIntParallelStrategiesMedian3IO +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +module Data.Vector.Algorithms.Quicksort.Predefined.VIntParallelStrategiesMedian3IO + ( sortVIntParallelStrategiesMedian3IO + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector qualified as V + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.Quicksort.Predefined.VIntSequentialMedian3IO () + +{-# NOINLINE sortVIntParallelStrategiesMedian3IO #-} +sortVIntParallelStrategiesMedian3IO :: V.MVector RealWorld Int64 -> IO () +sortVIntParallelStrategiesMedian3IO = sortInplaceFM defaultParStrategies (Median3 @Int64) + diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VIntParallelStrategiesMedian3ST.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VIntParallelStrategiesMedian3ST.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VIntParallelStrategiesMedian3ST.hs @@ -0,0 +1,23 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.VIntParallelStrategiesMedian3ST +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +module Data.Vector.Algorithms.Quicksort.Predefined.VIntParallelStrategiesMedian3ST + ( sortVIntParallelStrategiesMedian3ST + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector qualified as V + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.Quicksort.Predefined.VIntSequentialMedian3ST () + +{-# NOINLINE sortVIntParallelStrategiesMedian3ST #-} +sortVIntParallelStrategiesMedian3ST :: V.MVector s Int64 -> ST s () +sortVIntParallelStrategiesMedian3ST = sortInplaceFM defaultParStrategies (Median3 @Int64) + + diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VIntParallelStrategiesMedian3or5IO.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VIntParallelStrategiesMedian3or5IO.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VIntParallelStrategiesMedian3or5IO.hs @@ -0,0 +1,23 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.VIntParallelStrategiesMedian3or5IO +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +module Data.Vector.Algorithms.Quicksort.Predefined.VIntParallelStrategiesMedian3or5IO + ( sortVIntParallelStrategiesMedian3or5IO + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector qualified as V + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.Quicksort.Predefined.VIntSequentialMedian3IO () + +{-# NOINLINE sortVIntParallelStrategiesMedian3or5IO #-} +sortVIntParallelStrategiesMedian3or5IO :: V.MVector RealWorld Int64 -> IO () +sortVIntParallelStrategiesMedian3or5IO = sortInplaceFM defaultParStrategies (Median3or5 @Int64) + + diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VIntParallelStrategiesMedian3or5ST.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VIntParallelStrategiesMedian3or5ST.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VIntParallelStrategiesMedian3or5ST.hs @@ -0,0 +1,22 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.VIntParallelStrategiesMedian3or5ST +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +module Data.Vector.Algorithms.Quicksort.Predefined.VIntParallelStrategiesMedian3or5ST + ( sortVIntParallelStrategiesMedian3or5ST + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector qualified as V + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.Quicksort.Predefined.VIntSequentialMedian3ST () + +{-# NOINLINE sortVIntParallelStrategiesMedian3or5ST #-} +sortVIntParallelStrategiesMedian3or5ST :: V.MVector s Int64 -> ST s () +sortVIntParallelStrategiesMedian3or5ST = sortInplaceFM defaultParStrategies (Median3or5 @Int64) + diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VIntSequentialMedian3IO.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VIntSequentialMedian3IO.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VIntSequentialMedian3IO.hs @@ -0,0 +1,28 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.VIntSequentialMedian3IO +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +{-# OPTIONS_GHC -Wno-orphans #-} + +module Data.Vector.Algorithms.Quicksort.Predefined.VIntSequentialMedian3IO + ( sortVIntSequentialMedian3IO + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector qualified as V + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.FixedSort +import Data.Vector.Algorithms.Heapsort + +{-# SPECIALIZE heapSort :: V.MVector RealWorld Int64 -> IO () #-} +{-# SPECIALIZE bitonicSort :: Int -> V.MVector RealWorld Int64 -> IO () #-} + +{-# NOINLINE sortVIntSequentialMedian3IO #-} +sortVIntSequentialMedian3IO :: V.MVector RealWorld Int64 -> IO () +sortVIntSequentialMedian3IO = sortInplaceFM Sequential (Median3 @Int64) + diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VIntSequentialMedian3ST.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VIntSequentialMedian3ST.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VIntSequentialMedian3ST.hs @@ -0,0 +1,29 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.VIntSequentialMedian3ST +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +{-# OPTIONS_GHC -Wno-orphans #-} + +module Data.Vector.Algorithms.Quicksort.Predefined.VIntSequentialMedian3ST + ( sortVIntSequentialMedian3ST + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector qualified as V + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.FixedSort +import Data.Vector.Algorithms.Heapsort + +{-# SPECIALIZE heapSort :: V.MVector s Int64 -> ST s () #-} +{-# SPECIALIZE bitonicSort :: Int -> V.MVector s Int64 -> ST s () #-} + +{-# NOINLINE sortVIntSequentialMedian3ST #-} +sortVIntSequentialMedian3ST :: V.MVector s Int64 -> ST s () +sortVIntSequentialMedian3ST = sortInplaceFM Sequential (Median3 @Int64) + + diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VIntSequentialMedian3or5IO.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VIntSequentialMedian3or5IO.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VIntSequentialMedian3or5IO.hs @@ -0,0 +1,23 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.VIntSequentialMedian3or5IO +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +module Data.Vector.Algorithms.Quicksort.Predefined.VIntSequentialMedian3or5IO + ( sortVIntSequentialMedian3or5IO + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector qualified as V + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.Quicksort.Predefined.VIntSequentialMedian3IO () + +{-# NOINLINE sortVIntSequentialMedian3or5IO #-} +sortVIntSequentialMedian3or5IO :: V.MVector RealWorld Int64 -> IO () +sortVIntSequentialMedian3or5IO = sortInplaceFM Sequential (Median3or5 @Int64) + + diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VIntSequentialMedian3or5ST.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VIntSequentialMedian3or5ST.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VIntSequentialMedian3or5ST.hs @@ -0,0 +1,22 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.VIntSequentialMedian3or5ST +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +module Data.Vector.Algorithms.Quicksort.Predefined.VIntSequentialMedian3or5ST + ( sortVIntSequentialMedian3or5ST + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector qualified as V + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.Quicksort.Predefined.VIntSequentialMedian3ST () + +{-# NOINLINE sortVIntSequentialMedian3or5ST #-} +sortVIntSequentialMedian3or5ST :: V.MVector s Int64 -> ST s () +sortVIntSequentialMedian3or5ST = sortInplaceFM Sequential (Median3or5 @Int64) + diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VPairParallelStrategiesMedian3IO.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VPairParallelStrategiesMedian3IO.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VPairParallelStrategiesMedian3IO.hs @@ -0,0 +1,22 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.VPairParallelStrategiesMedian3IO +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +module Data.Vector.Algorithms.Quicksort.Predefined.VPairParallelStrategiesMedian3IO + ( sortVPairParallelStrategiesMedian3IO + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector qualified as V + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.Quicksort.Predefined.Pair +import Data.Vector.Algorithms.Quicksort.Predefined.VPairSequentialMedian3IO () + +{-# NOINLINE sortVPairParallelStrategiesMedian3IO #-} +sortVPairParallelStrategiesMedian3IO :: V.MVector RealWorld (TestPair Int32 Int32) -> IO () +sortVPairParallelStrategiesMedian3IO = sortInplaceFM defaultParStrategies (Median3 @(TestPair Int32 Int32)) diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VPairParallelStrategiesMedian3ST.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VPairParallelStrategiesMedian3ST.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VPairParallelStrategiesMedian3ST.hs @@ -0,0 +1,22 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.VPairParallelStrategiesMedian3ST +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +module Data.Vector.Algorithms.Quicksort.Predefined.VPairParallelStrategiesMedian3ST + ( sortVPairParallelStrategiesMedian3ST + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector qualified as V + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.Quicksort.Predefined.Pair +import Data.Vector.Algorithms.Quicksort.Predefined.VPairSequentialMedian3ST () + +{-# NOINLINE sortVPairParallelStrategiesMedian3ST #-} +sortVPairParallelStrategiesMedian3ST :: V.MVector s (TestPair Int32 Int32) -> ST s () +sortVPairParallelStrategiesMedian3ST = sortInplaceFM defaultParStrategies (Median3 @(TestPair Int32 Int32)) diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VPairParallelStrategiesMedian3or5IO.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VPairParallelStrategiesMedian3or5IO.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VPairParallelStrategiesMedian3or5IO.hs @@ -0,0 +1,22 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.VPairParallelStrategiesMedian3or5IO +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +module Data.Vector.Algorithms.Quicksort.Predefined.VPairParallelStrategiesMedian3or5IO + ( sortVPairParallelStrategiesMedian3or5IO + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector qualified as V + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.Quicksort.Predefined.Pair +import Data.Vector.Algorithms.Quicksort.Predefined.VPairSequentialMedian3IO () + +{-# NOINLINE sortVPairParallelStrategiesMedian3or5IO #-} +sortVPairParallelStrategiesMedian3or5IO :: V.MVector RealWorld (TestPair Int32 Int32) -> IO () +sortVPairParallelStrategiesMedian3or5IO = sortInplaceFM defaultParStrategies (Median3or5 @(TestPair Int32 Int32)) diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VPairParallelStrategiesMedian3or5ST.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VPairParallelStrategiesMedian3or5ST.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VPairParallelStrategiesMedian3or5ST.hs @@ -0,0 +1,24 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.VPairParallelStrategiesMedian3or5ST +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +module Data.Vector.Algorithms.Quicksort.Predefined.VPairParallelStrategiesMedian3or5ST + ( sortVPairParallelStrategiesMedian3or5ST + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector qualified as V + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.Quicksort.Predefined.Pair +import Data.Vector.Algorithms.Quicksort.Predefined.VPairSequentialMedian3ST () + +{-# NOINLINE sortVPairParallelStrategiesMedian3or5ST #-} +sortVPairParallelStrategiesMedian3or5ST :: V.MVector s (TestPair Int32 Int32) -> ST s () +sortVPairParallelStrategiesMedian3or5ST = sortInplaceFM defaultParStrategies (Median3or5 @(TestPair Int32 Int32)) + + diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VPairSequentialMedian3IO.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VPairSequentialMedian3IO.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VPairSequentialMedian3IO.hs @@ -0,0 +1,30 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.VPairSequentialMedian3IO +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +{-# OPTIONS_GHC -Wno-orphans #-} + +module Data.Vector.Algorithms.Quicksort.Predefined.VPairSequentialMedian3IO + ( sortVPairSequentialMedian3IO + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector qualified as V + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.Quicksort.Predefined.Pair + +import Data.Vector.Algorithms.FixedSort +import Data.Vector.Algorithms.Heapsort + +{-# SPECIALIZE heapSort :: V.MVector RealWorld (TestPair Int32 Int32) -> IO () #-} +{-# SPECIALIZE bitonicSort :: Int -> V.MVector RealWorld (TestPair Int32 Int32) -> IO () #-} + + +{-# NOINLINE sortVPairSequentialMedian3IO #-} +sortVPairSequentialMedian3IO :: V.MVector RealWorld (TestPair Int32 Int32) -> IO () +sortVPairSequentialMedian3IO = sortInplaceFM Sequential (Median3 @(TestPair Int32 Int32)) diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VPairSequentialMedian3ST.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VPairSequentialMedian3ST.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VPairSequentialMedian3ST.hs @@ -0,0 +1,29 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.VPairSequentialMedian3ST +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +{-# OPTIONS_GHC -Wno-orphans #-} + +module Data.Vector.Algorithms.Quicksort.Predefined.VPairSequentialMedian3ST + ( sortVPairSequentialMedian3ST + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector qualified as V + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.Quicksort.Predefined.Pair + +import Data.Vector.Algorithms.FixedSort +import Data.Vector.Algorithms.Heapsort + +{-# SPECIALIZE heapSort :: V.MVector s (TestPair Int32 Int32) -> ST s () #-} +{-# SPECIALIZE bitonicSort :: Int -> V.MVector s (TestPair Int32 Int32) -> ST s () #-} + +{-# NOINLINE sortVPairSequentialMedian3ST #-} +sortVPairSequentialMedian3ST :: V.MVector s (TestPair Int32 Int32) -> ST s () +sortVPairSequentialMedian3ST = sortInplaceFM Sequential (Median3 @(TestPair Int32 Int32)) diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VPairSequentialMedian3or5IO.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VPairSequentialMedian3or5IO.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VPairSequentialMedian3or5IO.hs @@ -0,0 +1,22 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.VPairSequentialMedian3or5IO +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +module Data.Vector.Algorithms.Quicksort.Predefined.VPairSequentialMedian3or5IO + ( sortVPairSequentialMedian3or5IO + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector qualified as V + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.Quicksort.Predefined.Pair +import Data.Vector.Algorithms.Quicksort.Predefined.VPairSequentialMedian3IO () + +{-# NOINLINE sortVPairSequentialMedian3or5IO #-} +sortVPairSequentialMedian3or5IO :: V.MVector RealWorld (TestPair Int32 Int32) -> IO () +sortVPairSequentialMedian3or5IO = sortInplaceFM Sequential (Median3or5 @(TestPair Int32 Int32)) diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VPairSequentialMedian3or5ST.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VPairSequentialMedian3or5ST.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VPairSequentialMedian3or5ST.hs @@ -0,0 +1,24 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.VPairSequentialMedian3or5ST +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +module Data.Vector.Algorithms.Quicksort.Predefined.VPairSequentialMedian3or5ST + ( sortVPairSequentialMedian3or5ST + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector qualified as V + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.Quicksort.Predefined.Pair +import Data.Vector.Algorithms.Quicksort.Predefined.VPairSequentialMedian3ST () + +{-# NOINLINE sortVPairSequentialMedian3or5ST #-} +sortVPairSequentialMedian3or5ST :: V.MVector s (TestPair Int32 Int32) -> ST s () +sortVPairSequentialMedian3or5ST = sortInplaceFM Sequential (Median3or5 @(TestPair Int32 Int32)) + + diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VTupleParallelStrategiesMedian3IO.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VTupleParallelStrategiesMedian3IO.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VTupleParallelStrategiesMedian3IO.hs @@ -0,0 +1,21 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.VTupleParallelStrategiesMedian3IO +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +module Data.Vector.Algorithms.Quicksort.Predefined.VTupleParallelStrategiesMedian3IO + ( sortVTupleParallelStrategiesMedian3IO + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector qualified as V + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.Quicksort.Predefined.VTupleSequentialMedian3IO () + +{-# NOINLINE sortVTupleParallelStrategiesMedian3IO #-} +sortVTupleParallelStrategiesMedian3IO :: V.MVector RealWorld (Int32, Int32) -> IO () +sortVTupleParallelStrategiesMedian3IO = sortInplaceFM defaultParStrategies (Median3 @(Int32, Int32)) diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VTupleParallelStrategiesMedian3ST.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VTupleParallelStrategiesMedian3ST.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VTupleParallelStrategiesMedian3ST.hs @@ -0,0 +1,21 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.VTupleParallelStrategiesMedian3ST +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +module Data.Vector.Algorithms.Quicksort.Predefined.VTupleParallelStrategiesMedian3ST + ( sortVTupleParallelStrategiesMedian3ST + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector qualified as V + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.Quicksort.Predefined.VTupleSequentialMedian3ST () + +{-# NOINLINE sortVTupleParallelStrategiesMedian3ST #-} +sortVTupleParallelStrategiesMedian3ST :: V.MVector s (Int32, Int32) -> ST s () +sortVTupleParallelStrategiesMedian3ST = sortInplaceFM defaultParStrategies (Median3 @(Int32, Int32)) diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VTupleParallelStrategiesMedian3or5IO.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VTupleParallelStrategiesMedian3or5IO.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VTupleParallelStrategiesMedian3or5IO.hs @@ -0,0 +1,21 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.VTupleParallelStrategiesMedian3or5IO +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +module Data.Vector.Algorithms.Quicksort.Predefined.VTupleParallelStrategiesMedian3or5IO + ( sortVTupleParallelStrategiesMedian3or5IO + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector qualified as V + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.Quicksort.Predefined.VTupleSequentialMedian3IO () + +{-# NOINLINE sortVTupleParallelStrategiesMedian3or5IO #-} +sortVTupleParallelStrategiesMedian3or5IO :: V.MVector RealWorld (Int32, Int32) -> IO () +sortVTupleParallelStrategiesMedian3or5IO = sortInplaceFM defaultParStrategies (Median3or5 @(Int32, Int32)) diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VTupleParallelStrategiesMedian3or5ST.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VTupleParallelStrategiesMedian3or5ST.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VTupleParallelStrategiesMedian3or5ST.hs @@ -0,0 +1,23 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.VTupleParallelStrategiesMedian3or5ST +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +module Data.Vector.Algorithms.Quicksort.Predefined.VTupleParallelStrategiesMedian3or5ST + ( sortVTupleParallelStrategiesMedian3or5ST + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector qualified as V + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.Quicksort.Predefined.VTupleSequentialMedian3ST () + +{-# NOINLINE sortVTupleParallelStrategiesMedian3or5ST #-} +sortVTupleParallelStrategiesMedian3or5ST :: V.MVector s (Int32, Int32) -> ST s () +sortVTupleParallelStrategiesMedian3or5ST = sortInplaceFM defaultParStrategies (Median3or5 @(Int32, Int32)) + + diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VTupleSequentialMedian3IO.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VTupleSequentialMedian3IO.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VTupleSequentialMedian3IO.hs @@ -0,0 +1,28 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.VTupleSequentialMedian3IO +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +{-# OPTIONS_GHC -Wno-orphans #-} + +module Data.Vector.Algorithms.Quicksort.Predefined.VTupleSequentialMedian3IO + ( sortVTupleSequentialMedian3IO + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector qualified as V + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.FixedSort +import Data.Vector.Algorithms.Heapsort + +{-# SPECIALIZE heapSort :: V.MVector RealWorld (Int32, Int32) -> IO () #-} +{-# SPECIALIZE bitonicSort :: Int -> V.MVector RealWorld (Int32, Int32) -> IO () #-} + + +{-# NOINLINE sortVTupleSequentialMedian3IO #-} +sortVTupleSequentialMedian3IO :: V.MVector RealWorld (Int32, Int32) -> IO () +sortVTupleSequentialMedian3IO = sortInplaceFM Sequential (Median3 @(Int32, Int32)) diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VTupleSequentialMedian3ST.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VTupleSequentialMedian3ST.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VTupleSequentialMedian3ST.hs @@ -0,0 +1,27 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.VTupleSequentialMedian3ST +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +{-# OPTIONS_GHC -Wno-orphans #-} + +module Data.Vector.Algorithms.Quicksort.Predefined.VTupleSequentialMedian3ST + ( sortVTupleSequentialMedian3ST + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector qualified as V + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.FixedSort +import Data.Vector.Algorithms.Heapsort + +{-# SPECIALIZE heapSort :: V.MVector s (Int32, Int32) -> ST s () #-} +{-# SPECIALIZE bitonicSort :: Int -> V.MVector s (Int32, Int32) -> ST s () #-} + +{-# NOINLINE sortVTupleSequentialMedian3ST #-} +sortVTupleSequentialMedian3ST :: V.MVector s (Int32, Int32) -> ST s () +sortVTupleSequentialMedian3ST = sortInplaceFM Sequential (Median3 @(Int32, Int32)) diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VTupleSequentialMedian3or5IO.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VTupleSequentialMedian3or5IO.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VTupleSequentialMedian3or5IO.hs @@ -0,0 +1,21 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.VTupleSequentialMedian3or5IO +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +module Data.Vector.Algorithms.Quicksort.Predefined.VTupleSequentialMedian3or5IO + ( sortVTupleSequentialMedian3or5IO + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector qualified as V + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.Quicksort.Predefined.VTupleSequentialMedian3IO () + +{-# NOINLINE sortVTupleSequentialMedian3or5IO #-} +sortVTupleSequentialMedian3or5IO :: V.MVector RealWorld (Int32, Int32) -> IO () +sortVTupleSequentialMedian3or5IO = sortInplaceFM Sequential (Median3or5 @(Int32, Int32)) diff --git a/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VTupleSequentialMedian3or5ST.hs b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VTupleSequentialMedian3or5ST.hs new file mode 100644 --- /dev/null +++ b/src-predefined/Data/Vector/Algorithms/Quicksort/Predefined/VTupleSequentialMedian3or5ST.hs @@ -0,0 +1,23 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Predefined.VTupleSequentialMedian3or5ST +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +module Data.Vector.Algorithms.Quicksort.Predefined.VTupleSequentialMedian3or5ST + ( sortVTupleSequentialMedian3or5ST + ) where + +import Control.Monad.ST +import Data.Int +import Data.Vector qualified as V + +import Data.Vector.Algorithms.Quicksort.Parameterised + +import Data.Vector.Algorithms.Quicksort.Predefined.VTupleSequentialMedian3ST () + +{-# NOINLINE sortVTupleSequentialMedian3or5ST #-} +sortVTupleSequentialMedian3or5ST :: V.MVector s (Int32, Int32) -> ST s () +sortVTupleSequentialMedian3or5ST = sortInplaceFM Sequential (Median3or5 @(Int32, Int32)) + + diff --git a/src/Data/Vector/Algorithms/FixedSort.hs b/src/Data/Vector/Algorithms/FixedSort.hs new file mode 100644 --- /dev/null +++ b/src/Data/Vector/Algorithms/FixedSort.hs @@ -0,0 +1,681 @@ +-- | +-- Module: Data.Vector.Algorithms.FixedSort +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com +-- +-- Sorts for fixed number of elements. Mostly helpers for quicksort + +module Data.Vector.Algorithms.FixedSort + ( sort3 + , sort4 + , bitonicSort + ) where + +import Control.Monad hiding (forM) +import Control.Monad.Primitive +import Data.Vector.Generic.Mutable qualified as GM + +{-# INLINABLE sort3 #-} +-- | Sorts the elements at the three given indices. The indices are assumed +-- to be given from lowest to highest, so if 'l < m < u' then +-- 'sort3ByIndex cmp a m l u' essentially sorts the median of three into the +-- lowest position in the array. +sort3 + :: (PrimMonad m, GM.MVector v a, Ord a) + => v (PrimState m) a -> m () +sort3 !xs = do + !x0 <- GM.unsafeRead xs 0 + !x1 <- GM.unsafeRead xs 1 + !x2 <- GM.unsafeRead xs 2 + if x1 < x0 + then + if x2 < x0 + then + if x2 < x1 + then do + GM.unsafeWrite xs 0 x2 + GM.unsafeWrite xs 2 x0 + else do + GM.unsafeWrite xs 0 x1 + GM.unsafeWrite xs 1 x2 + GM.unsafeWrite xs 2 x0 + else do + GM.unsafeWrite xs 0 x1 + GM.unsafeWrite xs 1 x0 + else + if x2 < x1 + then + if x2 < x0 + then do + GM.unsafeWrite xs 0 x2 + GM.unsafeWrite xs 1 x0 + GM.unsafeWrite xs 2 x1 + else do + GM.unsafeWrite xs 1 x2 + GM.unsafeWrite xs 2 x1 + else + pure () + +{-# INLINABLE sort4 #-} +-- | Sorts the elements at the four given indices. Like the 2 and 3 element +-- versions, this assumes that the indices are given in increasing order, so +-- it can be used to sort medians into particular positions and so on. +sort4 + :: (PrimMonad m, GM.MVector v a, Ord a) + => v (PrimState m) a -> m () +sort4 !xs = do + !x0 <- GM.unsafeRead xs 0 + !x1 <- GM.unsafeRead xs 1 + !x2 <- GM.unsafeRead xs 2 + !x3 <- GM.unsafeRead xs 3 + if x1 < x0 + then + if x2 < x0 + then + if x2 < x1 + then + if x3 < x1 + then + if x3 < x2 + then do + GM.unsafeWrite xs 0 x3 + GM.unsafeWrite xs 1 x2 + GM.unsafeWrite xs 2 x1 + GM.unsafeWrite xs 3 x0 + else do + GM.unsafeWrite xs 0 x2 + GM.unsafeWrite xs 1 x3 + GM.unsafeWrite xs 2 x1 + GM.unsafeWrite xs 3 x0 + else + if x3 < x0 + then do + GM.unsafeWrite xs 0 x2 + -- GM.unsafeWrite xs 1 x1 + GM.unsafeWrite xs 2 x3 + GM.unsafeWrite xs 3 x0 + else do + GM.unsafeWrite xs 0 x2 + -- GM.unsafeWrite xs 1 x1 + GM.unsafeWrite xs 2 x0 + GM.unsafeWrite xs 3 x3 + else + if x3 < x2 + then + if x3 < x1 + then do + GM.unsafeWrite xs 0 x3 + -- GM.unsafeWrite xs 1 x1 + GM.unsafeWrite xs 2 x2 + GM.unsafeWrite xs 3 x0 + else do + GM.unsafeWrite xs 0 x1 + GM.unsafeWrite xs 1 x3 + GM.unsafeWrite xs 2 x2 + GM.unsafeWrite xs 3 x0 + else + if x3 < x0 + then do + GM.unsafeWrite xs 0 x1 + GM.unsafeWrite xs 1 x2 + GM.unsafeWrite xs 2 x3 + GM.unsafeWrite xs 3 x0 + else do + GM.unsafeWrite xs 0 x1 + GM.unsafeWrite xs 1 x2 + GM.unsafeWrite xs 2 x0 + -- GM.unsafeWrite xs 3 x3 + else + if x3 < x0 + then + if x3 < x1 + then do + GM.unsafeWrite xs 0 x3 + -- GM.unsafeWrite xs 1 x1 + GM.unsafeWrite xs 2 x0 + GM.unsafeWrite xs 3 x2 + else do + GM.unsafeWrite xs 0 x1 + GM.unsafeWrite xs 1 x3 + GM.unsafeWrite xs 2 x0 + GM.unsafeWrite xs 3 x2 + else + if x3 < x2 + then do + GM.unsafeWrite xs 0 x1 + GM.unsafeWrite xs 1 x0 + GM.unsafeWrite xs 2 x3 + GM.unsafeWrite xs 3 x2 + else do + GM.unsafeWrite xs 0 x1 + GM.unsafeWrite xs 1 x0 + -- GM.unsafeWrite xs 2 x2 + -- GM.unsafeWrite xs 3 x3 + else + if x2 < x1 + then + if x2 < x0 + then + if x3 < x0 + then + if x3 < x2 + then do + GM.unsafeWrite xs 0 x3 + GM.unsafeWrite xs 1 x2 + GM.unsafeWrite xs 2 x0 + GM.unsafeWrite xs 3 x1 + else do + GM.unsafeWrite xs 0 x2 + GM.unsafeWrite xs 1 x3 + GM.unsafeWrite xs 2 x0 + GM.unsafeWrite xs 3 x1 + else + if x3 < x1 + then do + GM.unsafeWrite xs 0 x2 + GM.unsafeWrite xs 1 x0 + GM.unsafeWrite xs 2 x3 + GM.unsafeWrite xs 3 x1 + else do + GM.unsafeWrite xs 0 x2 + GM.unsafeWrite xs 1 x0 + GM.unsafeWrite xs 2 x1 + -- GM.unsafeWrite xs 3 x3 + else + if x3 < x2 + then + if x3 < x0 + then do + GM.unsafeWrite xs 0 x3 + GM.unsafeWrite xs 1 x0 + -- GM.unsafeWrite xs 2 x2 + GM.unsafeWrite xs 3 x1 + else do + -- GM.unsafeWrite xs 0 x0 + GM.unsafeWrite xs 1 x3 + -- GM.unsafeWrite xs 2 x2 + GM.unsafeWrite xs 3 x1 + else + if x3 < x1 + then do + -- GM.unsafeWrite xs 0 x0 + GM.unsafeWrite xs 1 x2 + GM.unsafeWrite xs 2 x3 + GM.unsafeWrite xs 3 x1 + else do + -- GM.unsafeWrite xs 0 x0 + GM.unsafeWrite xs 1 x2 + GM.unsafeWrite xs 2 x1 + -- GM.unsafeWrite xs 3 x3 + else + if x3 < x1 + then + if x3 < x0 + then do + GM.unsafeWrite xs 0 x3 + GM.unsafeWrite xs 1 x0 + GM.unsafeWrite xs 2 x1 + GM.unsafeWrite xs 3 x2 + else do + -- GM.unsafeWrite xs 0 x0 + GM.unsafeWrite xs 1 x3 + GM.unsafeWrite xs 2 x1 + GM.unsafeWrite xs 3 x2 + else + if x3 < x2 + then do + -- GM.unsafeWrite xs 0 x0 + -- GM.unsafeWrite xs 1 x1 + GM.unsafeWrite xs 2 x3 + GM.unsafeWrite xs 3 x2 + else do + -- GM.unsafeWrite xs 0 x0 + -- GM.unsafeWrite xs 1 x1 + -- GM.unsafeWrite xs 2 x2 + -- GM.unsafeWrite xs 3 x3 + pure () + +{-# INLINABLE bitonicSort #-} +-- | Sorts vectors containing strictly less that 17 elements. Otherwise does nothing. +-- +-- Depending on GHC may be good candidate for SPECIALIZE pragma. +bitonicSort + :: forall m v a. (PrimMonad m, Ord a, GM.MVector v a) + => Int -- ^ Vector length + -> v (PrimState m) a -- ^ Vector to be sorted + -> m () +bitonicSort !n !v = do + case n of + 2 -> + swap 0 1 + 3 -> + -- swap 1 2 + -- swap 0 2 + -- swap 0 1 + sort3 v + 4 -> + -- swap 0 1 + -- swap 2 3 + -- swap 0 2 + -- swap 1 3 + -- swap 1 2 + sort4 v + 5 -> do + swap 0 1 + swap 3 4 + swap 2 4 + swap 2 3 + swap 1 4 + swap 0 3 + swap 0 2 + swap 1 3 + swap 1 2 + 6 -> do + swap 1 2 + swap 4 5 + swap 0 2 + swap 3 5 + swap 0 1 + swap 3 4 + swap 2 5 + swap 0 3 + swap 1 4 + swap 2 4 + swap 1 3 + swap 2 3 + 7 -> do + swap 1 2 + swap 3 4 + swap 5 6 + swap 0 2 + swap 3 5 + swap 4 6 + swap 0 1 + swap 4 5 + swap 2 6 + swap 0 4 + swap 1 5 + swap 0 3 + swap 2 5 + swap 1 3 + swap 2 4 + swap 2 3 + 8 -> do + swap 0 1 + swap 2 3 + swap 4 5 + swap 6 7 + swap 0 2 + swap 1 3 + swap 4 6 + swap 5 7 + swap 1 2 + swap 5 6 + swap 0 4 + swap 3 7 + swap 1 5 + swap 2 6 + swap 1 4 + swap 3 6 + swap 2 4 + swap 3 5 + swap 3 4 + 9 -> do + swap 0 1 + swap 3 4 + swap 6 7 + swap 1 2 + swap 4 5 + swap 7 8 + swap 0 1 + swap 3 4 + swap 6 7 + swap 2 5 + swap 0 3 + swap 1 4 + swap 5 8 + swap 3 6 + swap 4 7 + swap 2 5 + swap 0 3 + swap 1 4 + swap 5 7 + swap 2 6 + swap 1 3 + swap 4 6 + swap 2 4 + swap 5 6 + swap 2 3 + 10 -> do + swap 4 9 + swap 3 8 + swap 2 7 + swap 1 6 + swap 0 5 + swap 1 4 + swap 6 9 + swap 0 3 + swap 5 8 + swap 0 2 + swap 3 6 + swap 7 9 + swap 0 1 + swap 2 4 + swap 5 7 + swap 8 9 + swap 1 2 + swap 4 6 + swap 7 8 + swap 3 5 + swap 2 5 + swap 6 8 + swap 1 3 + swap 4 7 + swap 2 3 + swap 6 7 + swap 3 4 + swap 5 6 + swap 4 5 + 11 -> do + swap 0 1 + swap 2 3 + swap 4 5 + swap 6 7 + swap 8 9 + swap 1 3 + swap 5 7 + swap 0 2 + swap 4 6 + swap 8 10 + swap 1 2 + swap 5 6 + swap 9 10 + swap 0 4 + swap 3 7 + swap 1 5 + swap 6 10 + swap 4 8 + swap 5 9 + swap 2 6 + swap 0 4 + swap 3 8 + swap 1 5 + swap 6 10 + swap 2 3 + swap 8 9 + swap 1 4 + swap 7 10 + swap 3 5 + swap 6 8 + swap 2 4 + swap 7 9 + swap 5 6 + swap 3 4 + swap 7 8 + 12 -> do + swap 0 1 + swap 2 3 + swap 4 5 + swap 6 7 + swap 8 9 + swap 10 11 + swap 1 3 + swap 5 7 + swap 9 11 + swap 0 2 + swap 4 6 + swap 8 10 + swap 1 2 + swap 5 6 + swap 9 10 + swap 0 4 + swap 7 11 + swap 1 5 + swap 6 10 + swap 3 7 + swap 4 8 + swap 5 9 + swap 2 6 + swap 0 4 + swap 7 11 + swap 3 8 + swap 1 5 + swap 6 10 + swap 2 3 + swap 8 9 + swap 1 4 + swap 7 10 + swap 3 5 + swap 6 8 + swap 2 4 + swap 7 9 + swap 5 6 + swap 3 4 + swap 7 8 + 13 -> do + swap 1 7 + swap 9 11 + swap 3 4 + swap 5 8 + swap 0 12 + swap 2 6 + swap 0 1 + swap 2 3 + swap 4 6 + swap 8 11 + swap 7 12 + swap 5 9 + swap 0 2 + swap 3 7 + swap 10 11 + swap 1 4 + swap 6 12 + swap 7 8 + swap 11 12 + swap 4 9 + swap 6 10 + swap 3 4 + swap 5 6 + swap 8 9 + swap 10 11 + swap 1 7 + swap 2 6 + swap 9 11 + swap 1 3 + swap 4 7 + swap 8 10 + swap 0 5 + swap 2 5 + swap 6 8 + swap 9 10 + swap 1 2 + swap 3 5 + swap 7 8 + swap 4 6 + swap 2 3 + swap 4 5 + swap 6 7 + swap 8 9 + swap 3 4 + swap 5 6 + 14 -> do + swap 0 1 + swap 2 3 + swap 4 5 + swap 6 7 + swap 8 9 + swap 10 11 + swap 12 13 + swap 0 2 + swap 4 6 + swap 8 10 + swap 1 3 + swap 5 7 + swap 9 11 + swap 0 4 + swap 8 12 + swap 1 5 + swap 9 13 + swap 2 6 + swap 3 7 + swap 0 8 + swap 1 9 + swap 2 10 + swap 3 11 + swap 4 12 + swap 5 13 + swap 5 10 + swap 6 9 + swap 3 12 + swap 7 11 + swap 1 2 + swap 4 8 + swap 1 4 + swap 7 13 + swap 2 8 + swap 5 6 + swap 9 10 + swap 2 4 + swap 11 13 + swap 3 8 + swap 7 12 + swap 6 8 + swap 10 12 + swap 3 5 + swap 7 9 + swap 3 4 + swap 5 6 + swap 7 8 + swap 9 10 + swap 11 12 + swap 6 7 + swap 8 9 + 15 -> do + swap 0 1 + swap 2 3 + swap 4 5 + swap 6 7 + swap 8 9 + swap 10 11 + swap 12 13 + swap 0 2 + swap 4 6 + swap 8 10 + swap 12 14 + swap 1 3 + swap 5 7 + swap 9 11 + swap 0 4 + swap 8 12 + swap 1 5 + swap 9 13 + swap 2 6 + swap 10 14 + swap 3 7 + swap 0 8 + swap 1 9 + swap 2 10 + swap 3 11 + swap 4 12 + swap 5 13 + swap 6 14 + swap 5 10 + swap 6 9 + swap 3 12 + swap 13 14 + swap 7 11 + swap 1 2 + swap 4 8 + swap 1 4 + swap 7 13 + swap 2 8 + swap 11 14 + swap 5 6 + swap 9 10 + swap 2 4 + swap 11 13 + swap 3 8 + swap 7 12 + swap 6 8 + swap 10 12 + swap 3 5 + swap 7 9 + swap 3 4 + swap 5 6 + swap 7 8 + swap 9 10 + swap 11 12 + swap 6 7 + swap 8 9 + 16 -> do + swap 0 1 + swap 2 3 + swap 4 5 + swap 6 7 + swap 8 9 + swap 10 11 + swap 12 13 + swap 14 15 + swap 0 2 + swap 4 6 + swap 8 10 + swap 12 14 + swap 1 3 + swap 5 7 + swap 9 11 + swap 13 15 + swap 0 4 + swap 8 12 + swap 1 5 + swap 9 13 + swap 2 6 + swap 10 14 + swap 3 7 + swap 11 15 + swap 0 8 + swap 1 9 + swap 2 10 + swap 3 11 + swap 4 12 + swap 5 13 + swap 6 14 + swap 7 15 + swap 5 10 + swap 6 9 + swap 3 12 + swap 13 14 + swap 7 11 + swap 1 2 + swap 4 8 + swap 1 4 + swap 7 13 + swap 2 8 + swap 11 14 + swap 5 6 + swap 9 10 + swap 2 4 + swap 11 13 + swap 3 8 + swap 7 12 + swap 6 8 + swap 10 12 + swap 3 5 + swap 7 9 + swap 3 4 + swap 5 6 + swap 7 8 + swap 9 10 + swap 11 12 + swap 6 7 + swap 8 9 + _ -> + pure () + where + swap :: Int -> Int -> m () + swap !i !j = do + !x <- GM.unsafeRead v i + !y <- GM.unsafeRead v j + when (y < x) $ do + GM.unsafeWrite v i y + GM.unsafeWrite v j x diff --git a/src/Data/Vector/Algorithms/Heapsort.hs b/src/Data/Vector/Algorithms/Heapsort.hs new file mode 100644 --- /dev/null +++ b/src/Data/Vector/Algorithms/Heapsort.hs @@ -0,0 +1,67 @@ +-- | +-- Module: Data.Vector.Algorithms.Heapsort +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +module Data.Vector.Algorithms.Heapsort + ( heapSort + ) where + +import Control.Monad.Primitive +import Data.Bits +import Data.Vector.Generic.Mutable qualified as GM + +{-# INLINABLE shiftDown #-} +shiftDown :: (PrimMonad m, Ord a, GM.MVector v a) => v (PrimState m) a -> Int -> m () +shiftDown !v = go + where + !end = GM.length v + go !p + | c1 < end + = do + let !c2 = c1 + 1 + c1Val <- GM.unsafeRead v c1 + (maxIdx, maxVal) <- + if c2 < end + then do + c2Val <- GM.unsafeRead v c2 + pure $ if c1Val > c2Val then (c1, c1Val) else (c2, c2Val) + else pure (c1, c1Val) + pVal <- GM.unsafeRead v p + if maxVal > pVal + then do + GM.unsafeWrite v p maxVal + GM.unsafeWrite v maxIdx pVal + go maxIdx + else + pure () + | otherwise + = pure () + where + !c1 = p * 2 + 1 + +{-# INLINABLE heapify #-} +heapify :: (PrimMonad m, Ord a, GM.MVector v a) => v (PrimState m) a -> m () +heapify !v = + go (GM.length v `unsafeShiftR` 1) + where + go 0 = shiftDown v 0 + go n = shiftDown v n *> go (n - 1) + +{-# INLINABLE heapSort #-} +-- | O(N * log(N)) regular heapsort (with 2-way heap, whereas vector-algorithm's is 4-way). +-- Can be used as a standalone sort but main purpose is fallback sort for quicksort. +-- +-- Depending on GHC may be good candidate for SPECIALIZE pragma. +heapSort :: (PrimMonad m, Ord a, GM.MVector v a) => v (PrimState m) a -> m () +heapSort !v = do + heapify v + go (GM.length v) + where + go 0 = pure () + go n = do + let !k = n - 1 + GM.unsafeSwap v 0 k + shiftDown (GM.unsafeSlice 0 k v) 0 + go k diff --git a/src/Data/Vector/Algorithms/Quicksort.hs b/src/Data/Vector/Algorithms/Quicksort.hs new file mode 100644 --- /dev/null +++ b/src/Data/Vector/Algorithms/Quicksort.hs @@ -0,0 +1,113 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com +-- +-- This module provides reasonable default sorting algorithm with no parallelisation. +-- To get parallelisation please use 'Data.Vector.Algorithms.Quicksort.Parameterised'. +-- +-- === Example +-- +-- Vanilla vectors: +-- +-- >>> import Data.Vector.Unboxed qualified as U +-- >>> sort $ U.fromList @Int [20, 19 .. 0] +-- [0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20] +-- +-- Mutable vectors: +-- +-- >>> import Control.Monad.ST (runST) +-- >>> import Data.Vector.Unboxed qualified as U +-- >>> :{ +-- runST $ do +-- xs <- U.unsafeThaw $ U.fromList @Int [20, 19 .. 0] +-- sortInplace xs +-- U.unsafeFreeze xs +-- :} +-- [0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20] +-- +-- With 'U.modify': +-- +-- >>> import Data.Vector.Unboxed qualified as U +-- >>> U.modify sortInplace $ U.fromList @Int [20, 19 .. 0] +-- [0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20] +-- +-- === Performance considerations +-- For best performance it's recommended to keep a close eye on core +-- to make sure that this function doesn't take any class +-- dictionaries. If it does then performance will be very bad since +-- either comparisons will go via indirection, vector reads/writes, +-- monadic bind, or any combinatior of those will go through +-- dictionary indirection. This can be avoided either by compiling +-- with @-fspecialise-aggressively@ flag or by using via @SPECIALIZE@ +-- pragmas, like so: +-- +-- > -- Either use the flag to specialize everything, ... +-- > {-# OPTIONS_GHC -fspecialise-aggressively #-} +-- > +-- > -- ... or the pragmas for specific functions +-- > import Data.Vector.Algorithms.FixedSort +-- > import Data.Vector.Algorithms.Heapsort +-- > import Data.Vector.Algorithms.Quicksort +-- > import Data.Vector.Unboxed qualified as U +-- > +-- > -- If sorting in ST +-- > -- These are fallback sorts and their performance is important +-- > {-# SPECIALIZE heapSort :: U.MVector s Int -> ST s () #-} +-- > {-# SPECIALIZE bitonicSort :: Int -> U.MVector s Int -> ST s () #-} +-- > -- Main sort entry point +-- > {-# SPECIALIZE sort :: U.MVector s Int -> ST s () #-} +-- > +-- > -- If sorting in IO +-- > {-# SPECIALIZE heapSort :: U.MVector RealWorld Int -> IO () #-} +-- > {-# SPECIALIZE bitonicSort :: Int -> U.MVector RealWorld Int -> IO () #-} +-- > {-# SPECIALIZE sort :: U.MVector RealWorld Int -> IO () #-} + +{-# OPTIONS_GHC -Wno-orphans #-} + +module Data.Vector.Algorithms.Quicksort + ( sort + , sortInplace + ) where + +import Prelude hiding (last, pi) + +import Control.Monad.Primitive +import Control.Monad.ST +import Data.Vector.Generic qualified as G +import Data.Vector.Generic.Mutable qualified as GM + +import Data.Vector.Algorithms.Quicksort.Parameterised + +{-# SPECIALIZE sortInplaceFM + :: (PrimMonad m, Ord a, GM.MVector v a) => Sequential -> Median3or5 a -> v (PrimState m) a -> m () #-} + +{-# INLINABLE sort #-} +-- | Good default sort. Returns sorted copy. +-- +-- This function takes generic vectors so will work with any vectors +-- from the @vector@ package. +sort + :: forall a v. + (Ord a, G.Vector v a) + => v a + -> v a +sort xs = runST $ do + ys <- G.thaw xs + sortInplaceFM Sequential (Median3or5 @a) ys + G.unsafeFreeze ys + +{-# INLINABLE sortInplace #-} +-- | Good default sort for mutable vectors. +-- +-- This function takes generic mutable vectors so will work with any +-- vectors from the @vector@ package. +-- +-- Could be run on immutable vectors with 'G.modify'. +sortInplace + :: forall m a v. + (PrimMonad m, Ord a, GM.MVector v a) + => v (PrimState m) a + -> m () +sortInplace = sortInplaceFM Sequential (Median3or5 @a) diff --git a/src/Data/Vector/Algorithms/Quicksort/Fork2.hs b/src/Data/Vector/Algorithms/Quicksort/Fork2.hs new file mode 100644 --- /dev/null +++ b/src/Data/Vector/Algorithms/Quicksort/Fork2.hs @@ -0,0 +1,276 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Fork2 +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com +-- +-- This module defines how quicksort is parallelised using the 'Fork2' class. + +{-# LANGUAGE FunctionalDependencies #-} + +module Data.Vector.Algorithms.Quicksort.Fork2 + ( + + -- * Main interface + Fork2(..) + + -- * No parallelisation + , Sequential(..) + + -- * Parallelisation with threads + , Parallel + , mkParallel + , waitParallel + + -- * Parallelisation with sparks + , ParStrategies + , defaultParStrategies + , setParStrategiesCutoff + + -- * Helpers + , HasLength + , getLength + ) where + +import GHC.Conc (par, pseq) + +import Control.Concurrent +import Control.Concurrent.STM +import Control.Monad.ST +import Data.Bits +import Data.Vector.Generic.Mutable qualified as GM +import GHC.ST (unsafeInterleaveST) +import System.IO.Unsafe + +-- | Parallelization strategy for the quicksort algorithm with +-- single-pivot partitioning. Specifies how to apply a pair of functions +-- to their respective inputs (which will be recursive quicksort calls). +-- +-- NB the name @Fork2@ suggests that two threads will be only forked. +-- +-- Parameter meaning; +-- - @a@ - the parallelisation we're defining instance for +-- - @x@ - type of tokens that strategy can pass around to track recursive calls +-- - @m@ - monad the strategy operates in. Some strategies only make +-- sense in a particular monad, e.g. parellelisation via 'forkIO' +class Fork2 a x m | a -> x where + -- | Will get called /only once/ by quicksort when sorting starts, + -- returns token to be passed around. Other tokens, e.g. for new + -- spawned threads, are created by the strategy in the corresponding + -- class instance. + startWork :: a -> m x + -- | Will get called by quicksort when it finishes sorting its array. Will receive + -- previously created token. + endWork :: a -> x -> m () + fork2 + :: (HasLength b, HasLength d) + => a -- ^ Parallelisation algorithm that can carry + -- extra info, e.g. for synchronization + -> x -- ^ Token for current execution thread, + -- will be passed to 'endWork' when done + -> Int -- ^ Recursion depth + -> (x -> b -> m ()) -- ^ One recursive quicksort call + -> (x -> d -> m ()) -- ^ The other recursive quicksort call + -> b -- ^ One of the subarrays after partitioning to be sorted + -> d -- ^ The other subarray to be sorted + -> m () + +-- | Trivial parallelisation strategy that executes everything +-- sequentially in current thread. Good default overall. +data Sequential = Sequential + +instance Monad m => Fork2 Sequential () m where + {-# INLINE startWork #-} + {-# INLINE endWork #-} + {-# INLINE fork2 #-} + startWork _ = pure () + endWork _ _ = pure () + fork2 _ tok _ f g !b !d = f tok b *> g tok d + +-- | At most N concurrent jobs will be spawned to evaluate recursive calls after quicksort +-- partitioning. +-- +-- Warning: currently not as fast as sparks-based 'ParStrategies' +-- strategy, take care to benchmark before using. +data Parallel = Parallel !Int !(TVar Int) + +-- | Make parallelisation strategy with at most @N@ threads. +mkParallel :: Int -> IO Parallel +mkParallel jobs = + Parallel jobs <$> newTVarIO 0 + +addPending :: Parallel -> IO () +addPending (Parallel _ pending) = + atomically $ modifyTVar' pending (+ 1) + +removePending :: Parallel -> IO () +removePending (Parallel _ pending) = + atomically $ modifyTVar' pending $ \x -> x - 1 + +-- | Wait until all threads related to a particular 'Parallel' instance finish. +waitParallel :: Parallel -> IO () +waitParallel (Parallel _ pending) = atomically $ do + m <- readTVar pending + if m == 0 + then pure () + else retry + +instance Fork2 Parallel (Bool, Bool) IO where + {-# INLINE startWork #-} + {-# INLINE endWork #-} + {-# INLINE fork2 #-} + startWork !p = do + addPending p + pure (False, True) + + endWork p (_, shouldDecrement) + | shouldDecrement + = removePending p + | otherwise + = pure () + + fork2 + :: forall b d. (HasLength b, HasLength d) + => Parallel + -> (Bool, Bool) + -> Int + -> ((Bool, Bool) -> b -> IO ()) + -> ((Bool, Bool) -> d -> IO ()) + -> b + -> d + -> IO () + fork2 !p@(Parallel jobs _) tok@(!isSeq, shouldDecrement) !depth f g !b !d + | isSeq + = f (True, False) b *> g tok d + | 2 `unsafeShiftL` depth < jobs && mn > 10_000 + = do + addPending p + _ <- forkIO $ f (False, True) b + g tok d + | bLen > dLen + = f (False, False) b *> g (True, shouldDecrement) d + | otherwise + = g (False, False) d *> f (True, shouldDecrement) b + where + bLen, dLen :: Int + !bLen = getLength b + !dLen = getLength d + + !mn = min bLen dLen + +-- | Parallelise with sparks. After partitioning, if sides are +-- sufficiently big then spark will be created to evaluate one of the +-- parts while another will continue to be evaluated in current +-- execution thread. +-- +-- This strategy works in both 'IO' and 'ST' monads (see docs for +-- relevant instance for some discussion on how that works). +-- +-- Sparks will seamlessly use all available RTS capabilities +-- (configured with @+RTS -N@ flag) and according to benchmarks in +-- this package have pretty low synchronization overhead as opposed to +-- thread-based parallelisation that 'Parallel' offers. These benefits +-- allow sparks to work on much smaller chunks and exercise more +-- parallelism. +data ParStrategies = ParStrategies !Int + +-- | Parallelise with sparks for reasonably big vectors. +defaultParStrategies :: ParStrategies +defaultParStrategies = ParStrategies 10_000 + +-- | Adjust length of vectors for which parallelisation will be performed. +setParStrategiesCutoff :: Int -> ParStrategies -> ParStrategies +setParStrategiesCutoff n _ = ParStrategies n + +instance Fork2 ParStrategies () IO where + {-# INLINE startWork #-} + {-# INLINE endWork #-} + {-# INLINE fork2 #-} + startWork _ = pure () + endWork _ _ = pure () + + fork2 + :: forall b d. (HasLength b, HasLength d) + => ParStrategies + -> () + -> Int + -> (() -> b -> IO ()) + -> (() -> d -> IO ()) + -> b + -> d + -> IO () + fork2 !(ParStrategies cutoff) _ _ f g !b !d + | mn > cutoff + = do + let b' = unsafePerformIO $ f () b + d' <- b' `par` g () d + pure (b' `pseq` (d' `pseq` ())) + | otherwise + = do + b' <- f () b + d' <- g () d + pure (b' `pseq` (d' `pseq` ())) + where + bLen, dLen :: Int + !bLen = getLength b + !dLen = getLength d + + !mn = min bLen dLen + +-- | This instance is a bit surprising - ST monad, after all, doesn’t +-- have concurrency and threads everywhere its @s@ parameter to +-- signal, among other things, that it’s single execution thread. +-- +-- Still, quicksort in this package hopefully doesn’t do anything +-- funny that may break under parallelism. Use of this instance for +-- other purposes has at least the same caveats as use of +-- 'unsafeInterleaveST' (i.e. not recommended, especially considering +-- that the instance may change). +instance Fork2 ParStrategies () (ST s) where + {-# INLINE startWork #-} + {-# INLINE endWork #-} + {-# INLINE fork2 #-} + startWork _ = pure () + endWork _ _ = pure () + + fork2 + :: forall b d. (HasLength b, HasLength d) + => ParStrategies + -> () + -> Int + -> (() -> b -> ST s ()) + -> (() -> d -> ST s ()) + -> b + -> d + -> ST s () + fork2 !(ParStrategies cutoff) _ _ f g !b !d + | mn > cutoff + = do + b' <- unsafeInterleaveST $ f () b + d' <- b' `par` g () d + pure (b' `pseq` (d' `pseq` ())) + | otherwise + = do + b' <- f () b + d' <- g () d + pure (b' `pseq` (d' `pseq` ())) + where + bLen, dLen :: Int + !bLen = getLength b + !dLen = getLength d + + !mn = min bLen dLen + +-- | Helper that can be used to estimatae sizes of subproblems. +-- +-- For inscance, too small array will not benefit from sorting it in +-- parallel because parallelisation overhead will likely trump any +-- time savings. +class HasLength a where + -- | Length of item + getLength :: a -> Int + +instance GM.MVector v a => HasLength (v s a) where + {-# INLINE getLength #-} + getLength = GM.length + diff --git a/src/Data/Vector/Algorithms/Quicksort/Median.hs b/src/Data/Vector/Algorithms/Quicksort/Median.hs new file mode 100644 --- /dev/null +++ b/src/Data/Vector/Algorithms/Quicksort/Median.hs @@ -0,0 +1,221 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Median +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} + +module Data.Vector.Algorithms.Quicksort.Median + ( Median(..) + , Median3(..) + , Median3or5(..) + , MedianResult(..) + ) where + +import Prelude hiding (last) + +import Control.Monad.Primitive +import Data.Bits +import Data.Function +import Data.Kind (Type) +import Data.Vector.Generic.Mutable qualified as GM + +-- | Median selection result. +data MedianResult a + -- | Value that was located at specific index in the original array. + = ExistingValue !a {-# UNPACK #-} !Int + -- | Value that is a good guess for a real median but may not be + -- present in the array (or we don't know where it's exactly). + -- + -- Good example is to pick first, last, and middle element and + -- average them, which restricts us to dealing with numeric values + -- but may yield good results depending on distribution of values in + -- the array to be sorted. + | Guess !a + +existingValue :: CmpFst a Int -> MedianResult a +existingValue (CmpFst (x, n)) = ExistingValue x n + +-- | Median selection algorithm that, given a vector, should come up +-- with an elements that has good chances to be median (i.e to be +-- greater that half the elements and lower than the other remaining +-- half). The closer to the real median the selected element is, the +-- faster quicksort will run and the better parallelisation will be +-- achieved. +-- +-- Instance can be declared for specific monad. This is useful if we want +-- to select median at random and need to thread random gen. +-- +-- Parameter meaning; +-- - @a@ - the median parameter we're defining instance for +-- - @b@ - type of ellements this median selection method is applicable to +-- - @m@ - monad the median selection operates in +-- - @s@ - the same ‘index’ as in ‘ST s’ because vector to be sorted is parameterised and @m@ may need to mention it +class Median (a :: Type) (b :: Type) (m :: Type -> Type) (s :: Type) | a -> b, m -> s where + -- | Come up with a median value of a given array + selectMedian + :: (GM.MVector v b, Ord b) + => a -- ^ Median algorithm than can carry extra info to be + -- used during median selection (e.g. random generator) + -> v s b -- ^ Array + -> m (MedianResult b) + +-- | Pick first, last, and the middle elements and find the one that's between the other two, e.g. +-- given elements @a@, @b@, and @c@ find @y@ among them that satisfies @x <= y <= z@. +data Median3 a = Median3 + +-- | Pick first, last, and the middle elements, if all of them are +-- distinct then return median of 3 like 'Median3' does, otherwise +-- take median of 5 from the already taken 3 and extra 2 elements at +-- @1/4@th and @3/4@th of array length. +data Median3or5 a = Median3or5 + +{-# INLINE pick3 #-} +-- Pick median among 3 values. +pick3 :: Ord a => a -> a -> a -> a +pick3 a b c = + if b < a + then + -- ... b < a ... + if c < a + then + if c < b + then + -- c < b < a + b + else + -- b <= c < a + c + else + -- b < a <= c + a + else + -- ... a <= b ... + if c < b + then + if c < a + then + -- c < a <= b + a + else + -- a <= c <= b + c + else + -- a <= b <= c + b + +{-# INLINE sort3 #-} +-- Establish sortered order among 3 values. +sort3 :: Ord a => a -> a -> a -> (a, a, a) +sort3 a b c = + if b < a + then + -- ... b < a ... + if c < a + then + if c < b + then + -- c < b < a + (c, b, a) + else + -- b <= c < a + (b, c, a) + else + -- b < a <= c + (b, a, c) + else + -- ... a <= b ... + if c < b + then + if c < a + then + -- c < a <= b + (c, a, b) + else + -- a <= c <= b + (a, c, b) + else + -- a <= b <= c + (a, b, c) + +newtype CmpFst a b = CmpFst { unCmpFst :: (a, b) } + +instance Eq a => Eq (CmpFst a b) where + (==) = (==) `on` fst . unCmpFst + +instance Ord a => Ord (CmpFst a b) where + compare = compare `on` fst . unCmpFst + +{-# INLINE readAt #-} +readAt :: (PrimMonad m, GM.MVector v a) => v (PrimState m) a -> Int -> m (CmpFst a Int) +readAt xs n = (\x -> CmpFst (x, n)) <$> GM.unsafeRead xs n + +instance (PrimMonad m, s ~ PrimState m) => Median (Median3 a) a m s where + {-# INLINE selectMedian #-} + selectMedian + :: forall (v :: Type -> Type -> Type). + (GM.MVector v a, Ord a) + => Median3 a + -> v s a + -> m (MedianResult a) + selectMedian _ !v = do + let len :: Int + !len = GM.length v + pi0, pi1, pi2 :: Int + !pi0 = 0 + !pi1 = halve len + !pi2 = len - 1 + !pv0 <- readAt v pi0 + !pv1 <- readAt v pi1 + !pv2 <- readAt v pi2 + pure $! existingValue $ pick3 pv0 pv1 pv2 + +instance (PrimMonad m, s ~ PrimState m) => Median (Median3or5 a) a m s where + {-# INLINE selectMedian #-} + selectMedian + :: forall (v :: Type -> Type -> Type). + (GM.MVector v a, Ord a) + => Median3or5 a + -> v s a + -> m (MedianResult a) + selectMedian _ !v = do + let len :: Int + !len = GM.length v + pi0, pi1, pi2 :: Int + !pi0 = 0 + !pi1 = halve len + !pi2 = len - 1 + !pv0 <- readAt v pi0 + !pv1 <- readAt v pi1 + !pv2 <- readAt v pi2 + + -- If median of 3 has chances to be good enough + if pv0 /= pv1 && pv1 /= pv2 && pv2 /= pv0 + then pure $! existingValue $ pick3 pv0 pv1 pv2 + else do + let pi01, pi12 :: Int + !pi01 = halve pi1 + !pi12 = pi1 + pi01 + + !pv01 <- readAt v pi01 + !pv12 <- readAt v pi12 + + let (!mn, !med, !mx) = sort3 pv0 pv1 pv2 + (!mn', !mx') + | pv01 < pv12 = (pv01, pv12) + | otherwise = (pv12, pv01) + + !med' + | mn' > mx = mx + | mx' < mn = mn + | otherwise = pick3 mn' med mx' + + pure $! existingValue med' + +{-# INLINE halve #-} +halve :: Int -> Int +halve x = x `unsafeShiftR` 1 diff --git a/src/Data/Vector/Algorithms/Quicksort/Parameterised.hs b/src/Data/Vector/Algorithms/Quicksort/Parameterised.hs new file mode 100644 --- /dev/null +++ b/src/Data/Vector/Algorithms/Quicksort/Parameterised.hs @@ -0,0 +1,252 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Parameterised +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com +-- +-- This module provides fully generic quicksort for now allowing +-- caller to decide how to parallelize and how to select median. More +-- things may be parameterised in the future, likely by introducing +-- new functions taking more arguments. +-- +-- === Example +-- This is how you’d define parallel sort that uses sparks on unboxed vectors of integers: +-- +-- >>> import Control.Monad.ST +-- >>> import Data.Int +-- >>> import Data.Vector.Algorithms.Quicksort.Parameterised +-- >>> import Data.Vector.Unboxed qualified as U +-- >>> :{ +-- let myParallelSort :: U.MVector s Int64 -> ST s () +-- myParallelSort = sortInplaceFM defaultParStrategies (Median3or5 @Int64) +-- in U.modify myParallelSort $ U.fromList @Int64 [20, 19 .. 0] +-- :} +-- [0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20] +-- +-- === Design considerations +-- Because of reliance on specialisation, this package doesn't provide +-- sort functions that take comparator function as argument. They rely +-- on the 'Ord' instance instead. While somewhat limiting, this allows +-- to offload optimization to the @SPECIALIZE@ pragmas even if compiler +-- wasn't smart enough to monomorphise automatically. +-- +-- === Performance considerations +-- Compared to the default sort this one is even more sensitive to +-- specialisation. Users caring about performance are advised to dump +-- core and ensure that sort is monomorphised. The GHC 9.6.1 was seen +-- to specialize automatically but 9.4 wasn't as good and required +-- pragmas both for the main sort function and for its helpers, like this: +-- +-- > -- Either use the flag to specialize everything, ... +-- > {-# OPTIONS_GHC -fspecialise-aggressively #-} +-- > +-- > -- ... or the pragmas for specific functions +-- > import Control.Monad.ST +-- > import Data.Int +-- > import Data.Vector.Algorithms.FixedSort +-- > import Data.Vector.Algorithms.Heapsort +-- > import Data.Vector.Algorithms.Quicksort.Parameterised +-- > import Data.Vector.Unboxed qualified as U +-- > +-- > {-# SPECIALIZE heapSort :: U.MVector s Int64 -> ST s () #-} +-- > {-# SPECIALIZE bitonicSort :: Int -> U.MVector s Int64 -> ST s () #-} +-- > {-# SPECIALIZE sortInplaceFM :: Sequential -> Median3 Int64 -> U.MVector s Int64 -> ST s () #-} +-- +-- === Speeding up compilation +-- In order to speed up compilations it's a good idea to introduce +-- dedicated module where all the sorts will reside and import it +-- instead of calling @sort@ or @sortInplaceFM@ in moduler with other logic. +-- This way the sort functions, which can take a while to compile, will be +-- recompiled rarely. +-- +-- > module MySorts (mySequentialSort) where +-- > +-- > import Control.Monad.ST +-- > import Data.Int +-- > import Data.Vector.Unboxed qualified as U +-- > +-- > import Data.Vector.Algorithms.Quicksort.Parameterised +-- > +-- > {-# NOINLINE mySequentialSort #-} +-- > mySequentialSort :: U.MVector s Int64 -> ST s () +-- > mySequentialSort = sortInplaceFM Sequential (Median3or5 @Int64) +-- +-- === Reducing code bloat +-- Avoid using sorts with both 'ST' and 'IO' monads. Stick to the 'ST' +-- monad as much as possible because it can be easily converted to +-- 'IO' via safe 'stToIO' function. Using same sort in both 'IO' and +-- 'ST' monads will compile two versions of it along with all it’s +-- helper sorts which can be pretty big (especially the bitonic sort). + +-- So that haddock will resolve references in the documentation. +{-# OPTIONS_GHC -Wno-unused-imports #-} + +module Data.Vector.Algorithms.Quicksort.Parameterised + ( sortInplaceFM + -- * Reexports + , module E + ) where + +import Prelude hiding (last, pi) + +import Control.Monad +import Control.Monad.Primitive +import Data.Bits +import Data.Vector.Generic.Mutable qualified as GM + +import Data.Vector.Algorithms.FixedSort +import Data.Vector.Algorithms.Heapsort +import Data.Vector.Algorithms.Quicksort.Fork2 as E +import Data.Vector.Algorithms.Quicksort.Median as E + +-- For haddock +import Control.Monad.ST + +{-# INLINABLE sortInplaceFM #-} +-- | Quicksort parameterised by median selection method and +-- parallelisation strategy. +sortInplaceFM + :: forall p med x m a v. + (Fork2 p x m, Median med a m (PrimState m), PrimMonad m, Ord a, GM.MVector v a) + => p + -> med + -> v (PrimState m) a + -> m () +sortInplaceFM !p !med !vector = do + !releaseToken <- startWork p + -- ParStrategies requires forcing the unit, otherwise we may return + -- while some sparks are still working. + () <- qsortLoop 0 releaseToken vector + pure () + where + -- If we select bad median 4 times in a row then fall back to heapsort. + !cutoffLen = GM.length vector + + !logLen = binlog2 (GM.length vector) + + !threshold = 2 * logLen + + qsortLoop :: Int -> x -> v (PrimState m) a -> m () + qsortLoop !depth !releaseToken !v + | len < 17 + = bitonicSort len v *> endWork p releaseToken + + | depth == threshold || if depthDiff > 0 then len `unsafeShiftL` depthDiff > cutoffLen else False + = heapSort v *> endWork p releaseToken + + | otherwise = do + let !last = len - 1 + v' = GM.unsafeSlice 0 last v + res <- selectMedian med v' + + (!pi', !pv) <- case res of + Guess pv -> do + (_, !pi') <- partitionTwoWaysGuessedPivot pv last v + pure (pi', pv) + + ExistingValue pv pi -> do + when (pi /= last) $ do + GM.unsafeWrite v pi =<< GM.unsafeRead v last + GM.unsafeWrite v last pv + (!xi, !pi') <- partitionTwoWaysPivotAtEnd pv (last - 1) v + GM.unsafeWrite v pi' pv + GM.unsafeWrite v last xi + pure (pi' + 1, pv) + + !pi'' <- skipEq pv pi' v + + let !left = GM.unsafeSlice 0 pi' v + !right = GM.unsafeSlice pi'' (len - pi'') v + !depth' = depth + 1 + fork2 + p + releaseToken + depth + (qsortLoop depth') + (qsortLoop depth') + left + right + where + !len = GM.length v + !depthDiff = depth - logLen + +{-# INLINE partitionTwoWaysGuessedPivot #-} +partitionTwoWaysGuessedPivot + :: (PrimMonad m, Ord a, GM.MVector v a) + => a -> Int -> v (PrimState m) a -> m (a, Int) +partitionTwoWaysGuessedPivot !pv !lastIdx !v = + go 0 lastIdx + where + go !i !j = do + !(i', xi) <- goLT i + !(j', xj) <- goGT j + if i' < j' + then do + GM.unsafeWrite v j' xi + GM.unsafeWrite v i' xj + go (i' + 1) (j' - 1) + else pure (xi, i') + where + goLT !k = do + if k <= j + then do + !x <- GM.unsafeRead v k + if x < pv + then goLT (k + 1) + else pure (k, x) + -- Be careful not to write this pv into array - pv may not exsit there. + else pure (k, pv) + goGT !k = do + !x <- GM.unsafeRead v k + if x >= pv && i < k + then goGT (k - 1) + else pure (k, x) + +{-# INLINE partitionTwoWaysPivotAtEnd #-} +partitionTwoWaysPivotAtEnd + :: (PrimMonad m, Ord a, GM.MVector v a) + => a -> Int -> v (PrimState m) a -> m (a, Int) +partitionTwoWaysPivotAtEnd !pv !lastIdx !v = + go 0 lastIdx + where + go !i !j = do + !(i', xi) <- goLT i + !(j', xj) <- goGT j + if i' < j' + then do + GM.unsafeWrite v j' xi + GM.unsafeWrite v i' xj + go (i' + 1) (j' - 1) + else pure (xi, i') + where + goLT !k = do + !x <- GM.unsafeRead v k + if x < pv && k <= j + then goLT (k + 1) + else pure (k, x) + goGT !k = do + !x <- GM.unsafeRead v k + if x >= pv && i < k + then goGT (k - 1) + else pure (k, x) + +{-# INLINE skipEq #-} +-- Idetnify multiple pivots that are equal to the one we were partitioning with so that +-- whole run of equal pivots can be excluded from recursion. +skipEq :: (PrimMonad m, Eq a, GM.MVector v a) => a -> Int -> v (PrimState m) a -> m Int +skipEq !x !start !v = go start + where + !last = GM.length v + go !k + | k < last + = do + !y <- GM.unsafeRead v k + if y == x + then go (k + 1) + else pure k + | otherwise + = pure k + +{-# INLINE binlog2 #-} +binlog2 :: Int -> Int +binlog2 x = finiteBitSize x - 1 - countLeadingZeros x diff --git a/test/Data/Vector/Algorithms/Quicksort/Tests.hs b/test/Data/Vector/Algorithms/Quicksort/Tests.hs new file mode 100644 --- /dev/null +++ b/test/Data/Vector/Algorithms/Quicksort/Tests.hs @@ -0,0 +1,458 @@ +-- | +-- Module: Data.Vector.Algorithms.Quicksort.Tests +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} + +{-# OPTIONS_GHC -fspecialise-aggressively #-} + +module Data.Vector.Algorithms.Quicksort.Tests (tests) where + +import Control.Monad.ST +import Data.Int +import Data.List qualified as L +import Data.Set (Set) +import Data.Set qualified as S +import Data.Vector qualified as V +import Data.Vector.Generic qualified as G +import Data.Vector.Primitive qualified as P +import Data.Vector.Unboxed qualified as U +import GHC.Generics (Generic) +import Test.QuickCheck +import Test.Tasty +import Test.Tasty.QuickCheck qualified as QC + +import Data.Vector.Algorithms.Quicksort.Predefined.BitonicIntST + +import Data.Vector.Algorithms.Quicksort.Predefined.Pair + +import Data.Vector.Algorithms.Quicksort.Predefined.PIntSequentialAveragingMedianST +import Data.Vector.Algorithms.Quicksort.Predefined.UPairSequentialAveragingMedianST + +import Data.Vector.Algorithms.Quicksort.Predefined.PIntParallelMedian3IO +import Data.Vector.Algorithms.Quicksort.Predefined.PIntParallelMedian3or5IO + +import Data.Vector.Algorithms.Quicksort.Predefined.VIntSequentialMedian3ST +import Data.Vector.Algorithms.Quicksort.Predefined.VIntSequentialMedian3IO +import Data.Vector.Algorithms.Quicksort.Predefined.VPairSequentialMedian3ST +import Data.Vector.Algorithms.Quicksort.Predefined.VPairSequentialMedian3IO +-- import Data.Vector.Algorithms.Quicksort.Predefined.VIntParallelStrategiesMedian3ST +-- import Data.Vector.Algorithms.Quicksort.Predefined.VIntParallelStrategiesMedian3IO +import Data.Vector.Algorithms.Quicksort.Predefined.VPairParallelStrategiesMedian3ST +import Data.Vector.Algorithms.Quicksort.Predefined.VPairParallelStrategiesMedian3IO + +import Data.Vector.Algorithms.Quicksort.Predefined.VIntSequentialMedian3or5ST +import Data.Vector.Algorithms.Quicksort.Predefined.VIntSequentialMedian3or5IO +import Data.Vector.Algorithms.Quicksort.Predefined.VPairSequentialMedian3or5ST +import Data.Vector.Algorithms.Quicksort.Predefined.VPairSequentialMedian3or5IO +import Data.Vector.Algorithms.Quicksort.Predefined.VIntParallelStrategiesMedian3or5ST +import Data.Vector.Algorithms.Quicksort.Predefined.VIntParallelStrategiesMedian3or5IO +import Data.Vector.Algorithms.Quicksort.Predefined.VPairParallelStrategiesMedian3or5ST +import Data.Vector.Algorithms.Quicksort.Predefined.VPairParallelStrategiesMedian3or5IO + +import Data.Vector.Algorithms.Quicksort.Predefined.UIntSequentialMedian3ST +import Data.Vector.Algorithms.Quicksort.Predefined.UIntSequentialMedian3IO +import Data.Vector.Algorithms.Quicksort.Predefined.UPairSequentialMedian3ST +import Data.Vector.Algorithms.Quicksort.Predefined.UPairSequentialMedian3IO +-- import Data.Vector.Algorithms.Quicksort.Predefined.UIntParallelStrategiesMedian3ST +-- import Data.Vector.Algorithms.Quicksort.Predefined.UIntParallelStrategiesMedian3IO +import Data.Vector.Algorithms.Quicksort.Predefined.UPairParallelStrategiesMedian3ST +import Data.Vector.Algorithms.Quicksort.Predefined.UPairParallelStrategiesMedian3IO + +import Data.Vector.Algorithms.Quicksort.Predefined.UIntSequentialMedian3or5ST +import Data.Vector.Algorithms.Quicksort.Predefined.UIntSequentialMedian3or5IO +import Data.Vector.Algorithms.Quicksort.Predefined.UPairSequentialMedian3or5ST +import Data.Vector.Algorithms.Quicksort.Predefined.UPairSequentialMedian3or5IO +import Data.Vector.Algorithms.Quicksort.Predefined.UIntParallelStrategiesMedian3or5ST +import Data.Vector.Algorithms.Quicksort.Predefined.UIntParallelStrategiesMedian3or5IO +import Data.Vector.Algorithms.Quicksort.Predefined.UPairParallelStrategiesMedian3or5ST +import Data.Vector.Algorithms.Quicksort.Predefined.UPairParallelStrategiesMedian3or5IO + +import Data.Vector.Algorithms.Quicksort.Predefined.VTupleSequentialMedian3ST +import Data.Vector.Algorithms.Quicksort.Predefined.VTupleSequentialMedian3IO +-- import Data.Vector.Algorithms.Quicksort.Predefined.VTupleParallelStrategiesMedian3ST +-- import Data.Vector.Algorithms.Quicksort.Predefined.VTupleParallelStrategiesMedian3IO +import Data.Vector.Algorithms.Quicksort.Predefined.VTupleSequentialMedian3or5ST +import Data.Vector.Algorithms.Quicksort.Predefined.VTupleSequentialMedian3or5IO +import Data.Vector.Algorithms.Quicksort.Predefined.VTupleParallelStrategiesMedian3or5ST +import Data.Vector.Algorithms.Quicksort.Predefined.VTupleParallelStrategiesMedian3or5IO +import Data.Vector.Algorithms.Quicksort.Predefined.UTupleSequentialMedian3ST +import Data.Vector.Algorithms.Quicksort.Predefined.UTupleSequentialMedian3IO +-- import Data.Vector.Algorithms.Quicksort.Predefined.UTupleParallelStrategiesMedian3ST +-- import Data.Vector.Algorithms.Quicksort.Predefined.UTupleParallelStrategiesMedian3IO +import Data.Vector.Algorithms.Quicksort.Predefined.UTupleSequentialMedian3or5ST +import Data.Vector.Algorithms.Quicksort.Predefined.UTupleSequentialMedian3or5IO +import Data.Vector.Algorithms.Quicksort.Predefined.UTupleParallelStrategiesMedian3or5ST +import Data.Vector.Algorithms.Quicksort.Predefined.UTupleParallelStrategiesMedian3or5IO + +tests :: TestTree +tests = testGroup "Data.Vector.Algorithms.Quicksort tests" + [ sortProps + , sortTestsST + , sortTestsIO + , sortTestsSTtoIO + , sortBitonic + ] + +setTestCount :: TestTree -> TestTree +setTestCount = adjustOption $ \(QC.QuickCheckTests n) -> QC.QuickCheckTests $ n `max` 100_000 + +{-# INLINE runSort #-} +runSort + :: (G.Vector w a, v ~ G.Mutable w) + => (v s a -> ST s ()) + -> [a] + -> ST s [a] +runSort doSort xs = do + (ys :: v s a) <- G.unsafeThaw $ G.fromList xs + doSort ys + G.toList <$> G.unsafeFreeze ys + +{-# INLINE runSortIO #-} +runSortIO + :: (G.Vector w a, v ~ G.Mutable w) + => (v RealWorld a -> IO ()) + -> [a] + -> IO [a] +runSortIO doSort xs = do + (ys :: v RealWorld a) <- G.unsafeThaw $ G.fromList xs + doSort ys + G.toList <$> G.unsafeFreeze ys + +{-# INLINE runSortSTtoIO #-} +runSortSTtoIO + :: (G.Vector w a, v ~ G.Mutable w) + => (forall s. v s a -> ST s ()) + -> [a] + -> IO [a] +runSortSTtoIO doSort xs = do + (ys :: v RealWorld a) <- G.unsafeThaw $ G.fromList xs + stToIO $ doSort ys + G.toList <$> G.unsafeFreeze ys + +checkIsSorted + :: (Show a, Ord a, Ord b) + => (a -> b) + -> [a] + -> (Set b, Property) +checkIsSorted _ [] = (S.empty, property True) +checkIsSorted f xs'@(x:xs) = go S.empty x xs + where + go !acc prev [] = (S.insert (f prev) acc, property True) + go acc prev (y:ys) + | prev <= y + = go (S.insert (f prev) acc) y ys + | otherwise + = (acc, counterexample ("Result is not sorted: " ++ show xs') $ property False) + +newtype TestInput = TestInput { unTestInput :: [Int32] } + deriving (Eq, Ord, Show, Generic) + +instance Arbitrary TestInput where + shrink = filter ((17 <=) . length . unTestInput) . genericShrink + arbitrary = + TestInput <$> ((++) <$> vectorOf 17 arbitrary <*> arbitrary) + +sortProps :: TestTree +sortProps = setTestCount $ testGroup "sort does not lose items" + [ testGroup "ST" + [ QC.testProperty "Data.Vector (TestPair Int32 Int32) sorting Sequential Median3" $ + sortsAndDoesNotLoseItemsST @V.Vector sortVPairSequentialMedian3ST + , QC.testProperty "Data.Vector (TestPair Int32 Int32) sorting Sequential Median3or5" $ + sortsAndDoesNotLoseItemsST @V.Vector sortVPairSequentialMedian3or5ST + , QC.testProperty "Data.Vector (TestPair Int32 Int32) sorting ParallelStrategies Median3" $ + sortsAndDoesNotLoseItemsST @V.Vector sortVPairParallelStrategiesMedian3ST + , QC.testProperty "Data.Vector (TestPair Int32 Int32) sorting ParallelStrategies Median3or5" $ + sortsAndDoesNotLoseItemsST @V.Vector sortVPairParallelStrategiesMedian3or5ST + + , QC.testProperty "Data.Vector.Unboxed (TestPair Int32 Int32) sorting Sequential Median3" $ + sortsAndDoesNotLoseItemsST @U.Vector sortUPairSequentialMedian3ST + , QC.testProperty "Data.Vector.Unboxed (TestPair Int32 Int32) sorting Sequential Median3or5" $ + sortsAndDoesNotLoseItemsST @U.Vector sortUPairSequentialMedian3or5ST + , QC.testProperty "Data.Vector.Unboxed (TestPair Int32 Int32) sorting ParallelStrategies Median3" $ + sortsAndDoesNotLoseItemsST @U.Vector sortUPairParallelStrategiesMedian3ST + , QC.testProperty "Data.Vector.Unboxed (TestPair Int32 Int32) sorting ParallelStrategies Median3or5" $ + sortsAndDoesNotLoseItemsST @U.Vector sortUPairParallelStrategiesMedian3or5ST + + , QC.testProperty "Data.Vector.Unboxed (TestPair Int32 Int32) sorting Sequential AveragingMedian" $ + sortsAndDoesNotLoseItemsST @U.Vector sortUPairSequentialAveragingMedianST + ] + , testGroup "IO" + [ QC.testProperty "Data.Vector (TestPair Int32 Int32) sorting Sequential Median3" $ + sortsAndDoesNotLoseItemsIO @V.Vector sortVPairSequentialMedian3IO + , QC.testProperty "Data.Vector (TestPair Int32 Int32) sorting Sequential Median3or5" $ + sortsAndDoesNotLoseItemsIO @V.Vector sortVPairSequentialMedian3or5IO + , QC.testProperty "Data.Vector (TestPair Int32 Int32) sorting ParallelStrategies Median3" $ + sortsAndDoesNotLoseItemsIO @V.Vector sortVPairParallelStrategiesMedian3IO + , QC.testProperty "Data.Vector (TestPair Int32 Int32) sorting ParallelStrategies Median3or5" $ + sortsAndDoesNotLoseItemsIO @V.Vector sortVPairParallelStrategiesMedian3or5IO + + , QC.testProperty "Data.Vector.Unboxed (TestPair Int32 Int32) sorting Sequential Median3" $ + sortsAndDoesNotLoseItemsIO @U.Vector sortUPairSequentialMedian3IO + , QC.testProperty "Data.Vector.Unboxed (TestPair Int32 Int32) sorting Sequential Median3or5" $ + sortsAndDoesNotLoseItemsIO @U.Vector sortUPairSequentialMedian3or5IO + , QC.testProperty "Data.Vector.Unboxed (TestPair Int32 Int32) sorting ParallelStrategies Median3" $ + sortsAndDoesNotLoseItemsIO @U.Vector sortUPairParallelStrategiesMedian3IO + , QC.testProperty "Data.Vector.Unboxed (TestPair Int32 Int32) sorting ParallelStrategies Median3or5" $ + sortsAndDoesNotLoseItemsIO @U.Vector sortUPairParallelStrategiesMedian3or5IO + ] + , testGroup "IO via stToIO" + [ QC.testProperty "Data.Vector (TestPair Int32 Int32) sorting Sequential Median3" $ + sortsAndDoesNotLoseItemsSTtoIO @V.Vector sortVPairSequentialMedian3ST + , QC.testProperty "Data.Vector (TestPair Int32 Int32) sorting Sequential Median3or5" $ + sortsAndDoesNotLoseItemsSTtoIO @V.Vector sortVPairSequentialMedian3or5ST + , QC.testProperty "Data.Vector (TestPair Int32 Int32) sorting ParallelStrategies Median3" $ + sortsAndDoesNotLoseItemsSTtoIO @V.Vector sortVPairParallelStrategiesMedian3ST + , QC.testProperty "Data.Vector (TestPair Int32 Int32) sorting ParallelStrategies Median3or5" $ + sortsAndDoesNotLoseItemsSTtoIO @V.Vector sortVPairParallelStrategiesMedian3or5ST + + , QC.testProperty "Data.Vector.Unboxed (TestPair Int32 Int32) sorting Sequential Median3" $ + sortsAndDoesNotLoseItemsSTtoIO @U.Vector sortUPairSequentialMedian3ST + , QC.testProperty "Data.Vector.Unboxed (TestPair Int32 Int32) sorting Sequential Median3or5" $ + sortsAndDoesNotLoseItemsSTtoIO @U.Vector sortUPairSequentialMedian3or5ST + , QC.testProperty "Data.Vector.Unboxed (TestPair Int32 Int32) sorting ParallelStrategies Median3" $ + sortsAndDoesNotLoseItemsSTtoIO @U.Vector sortUPairParallelStrategiesMedian3ST + , QC.testProperty "Data.Vector.Unboxed (TestPair Int32 Int32) sorting ParallelStrategies Median3or5" $ + sortsAndDoesNotLoseItemsSTtoIO @U.Vector sortUPairParallelStrategiesMedian3or5ST + + , QC.testProperty "Data.Vector.Unboxed (TestPair Int32 Int32) sorting Sequential AveragingMedian" $ + sortsAndDoesNotLoseItemsSTtoIO @U.Vector sortUPairSequentialAveragingMedianST + ] + ] + where + sortsAndDoesNotLoseItemsST + :: forall w v. (G.Vector w (TestPair Int32 Int32), v ~ G.Mutable w) + => (forall s. G.Mutable w s (TestPair Int32 Int32) -> ST s ()) + -> TestInput + -> Property + sortsAndDoesNotLoseItemsST doSort (TestInput xs) = + isSorted .&&. items === S.fromList (map (snd . toTuple) unsorted) + where + items :: Set Int32 + (items, isSorted) = checkIsSorted (snd . toTuple) sorted + sorted, unsorted :: [TestPair Int32 Int32] + sorted = runST $ runSort @w doSort unsorted + unsorted = zipWith TestPair xs [0..] + + sortsAndDoesNotLoseItemsIO + :: forall w v. (G.Vector w (TestPair Int32 Int32), v ~ G.Mutable w) + => (G.Mutable w RealWorld (TestPair Int32 Int32) -> IO ()) + -> TestInput + -> Property + sortsAndDoesNotLoseItemsIO doSort (TestInput xs) = ioProperty $ do + sorted <- runSortIO @w doSort unsorted + let items :: Set Int32 + (items, isSorted) = checkIsSorted (snd . toTuple) sorted + pure $ + isSorted .&&. items === S.fromList (map (snd . toTuple) unsorted) + where + unsorted = zipWith TestPair xs [0..] + + sortsAndDoesNotLoseItemsSTtoIO + :: forall w v. (G.Vector w (TestPair Int32 Int32), v ~ G.Mutable w) + => (forall s. G.Mutable w s (TestPair Int32 Int32) -> ST s ()) + -> TestInput + -> Property + sortsAndDoesNotLoseItemsSTtoIO doSort (TestInput xs) = ioProperty $ do + sorted <- runSortSTtoIO @w doSort unsorted + let items :: Set Int32 + (items, isSorted) = checkIsSorted (snd . toTuple) sorted + pure $ + isSorted .&&. items === S.fromList (map (snd . toTuple) unsorted) + where + unsorted = zipWith TestPair xs [0..] + +sortTestsST :: TestTree +sortTestsST = setTestCount $ testGroup "sort tests in ST" + [ QC.testProperty "Data.Vector Int64 sorting Sequential Median3" $ + \(xs :: [Int64]) -> + runST (runSort @V.Vector sortVIntSequentialMedian3ST xs) === L.sort xs + , QC.testProperty "Data.Vector (Int32, Int32) sorting Sequential Median3" $ + \(xs :: [(Int32, Int32)]) -> + runST (runSort @V.Vector sortVTupleSequentialMedian3ST xs) === L.sort xs + , QC.testProperty "Data.Vector.Unboxed Int64 sorting Sequential Median3" $ + \(xs :: [Int64]) -> + runST (runSort @U.Vector sortUIntSequentialMedian3ST xs) === L.sort xs + , QC.testProperty "Data.Vector.Unboxed (Int32, Int32) sorting Sequential Median3" $ + \(xs :: [(Int32, Int32)]) -> + runST (runSort @U.Vector sortUTupleSequentialMedian3ST xs) === L.sort xs + + , QC.testProperty "Data.Vector Int64 sorting Sequential Median3or5" $ + \(xs :: [Int64]) -> + runST (runSort @V.Vector sortVIntSequentialMedian3or5ST xs) === L.sort xs + , QC.testProperty "Data.Vector (Int32, Int32) sorting Sequential Median3or5" $ + \(xs :: [(Int32, Int32)]) -> + runST (runSort @V.Vector sortVTupleSequentialMedian3or5ST xs) === L.sort xs + , QC.testProperty "Data.Vector.Unboxed Int64 sorting Sequential Median3or5" $ + \(xs :: [Int64]) -> + runST (runSort @U.Vector sortUIntSequentialMedian3or5ST xs) === L.sort xs + , QC.testProperty "Data.Vector.Unboxed (Int32, Int32) sorting Sequential Median3or5" $ + \(xs :: [(Int32, Int32)]) -> + runST (runSort @U.Vector sortUTupleSequentialMedian3or5ST xs) === L.sort xs + + , QC.testProperty "Data.Vector Int64 sorting ParStrategies Median3or5" $ + \(xs :: [Int64]) -> + runST (runSort @V.Vector sortVIntParallelStrategiesMedian3or5ST xs) === L.sort xs + , QC.testProperty "Data.Vector (Int32, Int32) sorting ParStrategies Median3or5" $ + \(xs :: [(Int32, Int32)]) -> + runST (runSort @V.Vector sortVTupleParallelStrategiesMedian3or5ST xs) === L.sort xs + , QC.testProperty "Data.Vector.Unboxed Int64 sorting ParStrategies Median3or5" $ + \(xs :: [Int64]) -> + runST (runSort @U.Vector sortUIntParallelStrategiesMedian3or5ST xs) === L.sort xs + , QC.testProperty "Data.Vector.Unboxed (Int32, Int32) sorting ParStrategies Median3or5" $ + \(xs :: [(Int32, Int32)]) -> + runST (runSort @U.Vector sortUTupleParallelStrategiesMedian3or5ST xs) === L.sort xs + + , QC.testProperty "Data.Vector.Primitive Int64 sorting Sequential AveragingMedian" $ + \(xs :: [Int64]) -> + runST (runSort @P.Vector sortPIntSequentialAveragingMedianST xs) === L.sort xs + ] + +sortTestsIO :: TestTree +sortTestsIO = setTestCount $ testGroup "sort tests in IO" + [ QC.testProperty "Data.Vector Int64 sorting Sequential Median3" $ + \(xs :: [Int64]) -> ioProperty $ do + ys <- runSortIO @V.Vector sortVIntSequentialMedian3IO xs + pure $ ys === L.sort xs + , QC.testProperty "Data.Vector (Int32, Int32) sorting Sequential Median3" $ + \(xs :: [(Int32, Int32)]) -> ioProperty $ do + ys <- runSortIO @V.Vector sortVTupleSequentialMedian3IO xs + pure $ ys === L.sort xs + , QC.testProperty "Data.Vector.Unboxed Int64 sorting Sequential Median3" $ + \(xs :: [Int64]) -> ioProperty $ do + ys <- runSortIO @U.Vector sortUIntSequentialMedian3IO xs + pure $ ys === L.sort xs + , QC.testProperty "Data.Vector.Unboxed (Int32, Int32) sorting Sequential Median3" $ + \(xs :: [(Int32, Int32)]) -> ioProperty $ do + ys <- runSortIO @U.Vector sortUTupleSequentialMedian3IO xs + pure $ ys === L.sort xs + + , QC.testProperty "Data.Vector Int64 sorting Sequential Median3or5" $ + \(xs :: [Int64]) -> ioProperty $ do + ys <- runSortIO @V.Vector sortVIntSequentialMedian3or5IO xs + pure $ ys === L.sort xs + , QC.testProperty "Data.Vector (Int32, Int32) sorting Sequential Median3or5" $ + \(xs :: [(Int32, Int32)]) -> ioProperty $ do + ys <- runSortIO @V.Vector sortVTupleSequentialMedian3or5IO xs + pure $ ys === L.sort xs + , QC.testProperty "Data.Vector.Unboxed Int64 sorting Sequential Median3or5" $ + \(xs :: [Int64]) -> ioProperty $ do + ys <- runSortIO @U.Vector sortUIntSequentialMedian3or5IO xs + pure $ ys === L.sort xs + , QC.testProperty "Data.Vector.Unboxed (Int32, Int32) sorting Sequential Median3or5" $ + \(xs :: [(Int32, Int32)]) -> ioProperty $ do + ys <- runSortIO @U.Vector sortUTupleSequentialMedian3or5IO xs + pure $ ys === L.sort xs + + , QC.testProperty "Data.Vector Int64 sorting ParStrategies Median3or5" $ + \(xs :: [Int64]) -> ioProperty $ do + ys <- runSortIO @V.Vector sortVIntParallelStrategiesMedian3or5IO xs + pure $ ys === L.sort xs + , QC.testProperty "Data.Vector (Int32, Int32) sorting ParStrategies Median3or5" $ + \(xs :: [(Int32, Int32)]) -> ioProperty $ do + ys <- runSortIO @V.Vector sortVTupleParallelStrategiesMedian3or5IO xs + pure $ ys === L.sort xs + , QC.testProperty "Data.Vector.Unboxed Int64 sorting ParStrategies Median3or5" $ + \(xs :: [Int64]) -> ioProperty $ do + ys <- runSortIO @U.Vector sortUIntParallelStrategiesMedian3or5IO xs + pure $ ys === L.sort xs + , QC.testProperty "Data.Vector.Unboxed (Int32, Int32) sorting ParStrategies Median3or5" $ + \(xs :: [(Int32, Int32)]) -> ioProperty $ do + ys <- runSortIO @U.Vector sortUTupleParallelStrategiesMedian3or5IO xs + pure $ ys === L.sort xs + + , QC.testProperty "Data.Vector.Primitive Int64 sorting Parallel Median3" $ + \(xs :: [Int64]) -> ioProperty $ do + ys <- runSortIO @P.Vector sortPIntParallelMedian3IO xs + pure $ ys === L.sort xs + , QC.testProperty "Data.Vector.Primitive Int64 sorting Parallel Median3or5" $ + \(xs :: [Int64]) -> ioProperty $ do + ys <- runSortIO @P.Vector sortPIntParallelMedian3or5IO xs + pure $ ys === L.sort xs + ] + +sortTestsSTtoIO :: TestTree +sortTestsSTtoIO = setTestCount $ testGroup "sort tests in IO via stToIO" + [ QC.testProperty "Data.Vector Int64 sorting Sequential Median3" $ + \(xs :: [Int64]) -> ioProperty $ do + ys <- runSortSTtoIO @V.Vector sortVIntSequentialMedian3ST xs + pure $ ys === L.sort xs + , QC.testProperty "Data.Vector (Int32, Int32) sorting Sequential Median3" $ + \(xs :: [(Int32, Int32)]) -> ioProperty $ do + ys <- runSortSTtoIO @V.Vector sortVTupleSequentialMedian3ST xs + pure $ ys === L.sort xs + , QC.testProperty "Data.Vector.Unboxed Int64 sorting Sequential Median3" $ + \(xs :: [Int64]) -> ioProperty $ do + ys <- runSortSTtoIO @U.Vector sortUIntSequentialMedian3ST xs + pure $ ys === L.sort xs + , QC.testProperty "Data.Vector.Unboxed (Int32, Int32) sorting Sequential Median3" $ + \(xs :: [(Int32, Int32)]) -> ioProperty $ do + ys <- runSortSTtoIO @U.Vector sortUTupleSequentialMedian3ST xs + pure $ ys === L.sort xs + + , QC.testProperty "Data.Vector Int64 sorting Sequential Median3or5" $ + \(xs :: [Int64]) -> ioProperty $ do + ys <- runSortSTtoIO @V.Vector sortVIntSequentialMedian3or5ST xs + pure $ ys === L.sort xs + , QC.testProperty "Data.Vector (Int32, Int32) sorting Sequential Median3or5" $ + \(xs :: [(Int32, Int32)]) -> ioProperty $ do + ys <- runSortSTtoIO @V.Vector sortVTupleSequentialMedian3or5ST xs + pure $ ys === L.sort xs + , QC.testProperty "Data.Vector.Unboxed Int64 sorting Sequential Median3or5" $ + \(xs :: [Int64]) -> ioProperty $ do + ys <- runSortSTtoIO @U.Vector sortUIntSequentialMedian3or5ST xs + pure $ ys === L.sort xs + , QC.testProperty "Data.Vector.Unboxed (Int32, Int32) sorting Sequential Median3or5" $ + \(xs :: [(Int32, Int32)]) -> ioProperty $ do + ys <- runSortSTtoIO @U.Vector sortUTupleSequentialMedian3or5ST xs + pure $ ys === L.sort xs + + , QC.testProperty "Data.Vector Int64 sorting ParStrategies Median3or5" $ + \(xs :: [Int64]) -> ioProperty $ do + ys <- runSortSTtoIO @V.Vector sortVIntParallelStrategiesMedian3or5ST xs + pure $ ys === L.sort xs + , QC.testProperty "Data.Vector (Int32, Int32) sorting ParStrategies Median3or5" $ + \(xs :: [(Int32, Int32)]) -> ioProperty $ do + ys <- runSortSTtoIO @V.Vector sortVTupleParallelStrategiesMedian3or5ST xs + pure $ ys === L.sort xs + , QC.testProperty "Data.Vector.Unboxed Int64 sorting ParStrategies Median3or5" $ + \(xs :: [Int64]) -> ioProperty $ do + ys <- runSortSTtoIO @U.Vector sortUIntParallelStrategiesMedian3or5ST xs + pure $ ys === L.sort xs + , QC.testProperty "Data.Vector.Unboxed (Int32, Int32) sorting ParStrategies Median3or5" $ + \(xs :: [(Int32, Int32)]) -> ioProperty $ do + ys <- runSortSTtoIO @U.Vector sortUTupleParallelStrategiesMedian3or5ST xs + pure $ ys === L.sort xs + + , QC.testProperty "Data.Vector.Primitive Int64 sorting Sequential AveragingMedian" $ + \(xs :: [Int64]) -> ioProperty $ do + ys <- runSortSTtoIO @P.Vector sortPIntSequentialAveragingMedianST xs + pure $ ys === L.sort xs + ] + +newtype BitonicInput a = BitonicInput [a] + deriving (Eq, Ord, Show, Generic) + +instance Arbitrary a => Arbitrary (BitonicInput a) where + shrink = genericShrink + arbitrary = do + len <- frequency [(2 ^ n, pure $ n + 2) | n <- [0..14]] + BitonicInput <$> vectorOf len arbitrary + +sortBitonic :: TestTree +sortBitonic = setTestCount $ testGroup "bitonic sort" + [ QC.testProperty "Int64 ST" $ + \(BitonicInput (xs :: [Int64])) -> + let zs = runST $ do + ys <- P.unsafeThaw $ P.fromList xs + bitonicSortIntST ys + P.unsafeFreeze ys + in + label ("length " ++ show (length xs)) $ + zs === P.fromList (L.sort xs) + ] diff --git a/test/TestMain.hs b/test/TestMain.hs new file mode 100644 --- /dev/null +++ b/test/TestMain.hs @@ -0,0 +1,20 @@ +-- | +-- Module: TestMain +-- Copyright: (c) Sergey Vinokurov 2023 +-- License: Apache-2.0 (see LICENSE) +-- Maintainer: serg.foo@gmail.com + +module TestMain (main) where + +import Test.Tasty + +import Data.Vector.Algorithms.Quicksort.Tests qualified + +main :: IO () +main = defaultMain tests + +tests :: TestTree +tests = testGroup "Tests" + [ Data.Vector.Algorithms.Quicksort.Tests.tests + ] + diff --git a/vector-quicksort.cabal b/vector-quicksort.cabal new file mode 100644 --- /dev/null +++ b/vector-quicksort.cabal @@ -0,0 +1,279 @@ +cabal-version: 3.0 + +name: + vector-quicksort +version: + 0.1 + +synopsis: + Fast and flexible quicksort implementation for mutable vectors + +description: + + Quicksort implementation developed with performance in mind. Has + good default single-threaded sort and provides parallelised versions + that are actually faster than the single-threaded version. Users can + define new parallelisation methods. + + Good starting point: + + > import Data.Vector.Algorithms.Quicksort qualified as Quick + + Then call as + + > Quick.sort xs + +copyright: + (c) Sergey Vinokurov 2022 +license: + Apache-2.0 +license-file: + LICENSE +author: + Sergey Vinokurov +maintainer: + Sergey Vinokurov +category: + Algorithms + +build-type: + Simple + +extra-source-files: + Readme.md + +homepage: + https://github.com/sergv/vector-quicksort + +source-repository head + type: git + location: https://github.com/sergv/vector-quicksort.git + +common ghc-options + default-language: + GHC2021 + + default-extensions: + ImportQualifiedPost + LambdaCase + + ghc-options: + -O2 + -Weverything + -Wno-all-missed-specialisations + -Wno-implicit-prelude + -Wno-missed-specialisations + -Wno-missing-import-lists + -Wno-missing-local-signatures + -Wno-missing-safe-haskell-mode + -Wno-safe + -Wno-type-defaults + -Wno-unsafe + -Wno-unused-packages + + if impl(ghc >= 8.8) + ghc-options: + -Wno-missing-deriving-strategies + + if impl(ghc >= 9.2) + ghc-options: + -Wno-missing-kind-signatures + +library + import: ghc-options + exposed-modules: + Data.Vector.Algorithms.FixedSort + Data.Vector.Algorithms.Heapsort + Data.Vector.Algorithms.Quicksort + Data.Vector.Algorithms.Quicksort.Fork2 + Data.Vector.Algorithms.Quicksort.Median + Data.Vector.Algorithms.Quicksort.Parameterised + hs-source-dirs: + src + build-depends: + , base >= 4.14 && < 5 + , primitive + , stm + , vector + +library vector-quicksort-predefined + import: ghc-options + + exposed-modules: + Data.Vector.Algorithms.Quicksort.Predefined.AveragingMedian + Data.Vector.Algorithms.Quicksort.Predefined.Pair + + Data.Vector.Algorithms.Quicksort.Predefined.BitonicIntST + + Data.Vector.Algorithms.Quicksort.Predefined.PIntParallelMedian3IO + Data.Vector.Algorithms.Quicksort.Predefined.PIntParallelMedian3or5IO + + Data.Vector.Algorithms.Quicksort.Predefined.PIntSequentialMedian3ST + Data.Vector.Algorithms.Quicksort.Predefined.PIntSequentialMedian3IO + Data.Vector.Algorithms.Quicksort.Predefined.PIntParallelStrategiesMedian3ST + Data.Vector.Algorithms.Quicksort.Predefined.PIntParallelStrategiesMedian3IO + Data.Vector.Algorithms.Quicksort.Predefined.PIntSequentialMedian3or5ST + Data.Vector.Algorithms.Quicksort.Predefined.PIntSequentialMedian3or5IO + Data.Vector.Algorithms.Quicksort.Predefined.PIntParallelStrategiesMedian3or5ST + Data.Vector.Algorithms.Quicksort.Predefined.PIntParallelStrategiesMedian3or5IO + + Data.Vector.Algorithms.Quicksort.Predefined.PIntSequentialAveragingMedianST + Data.Vector.Algorithms.Quicksort.Predefined.UPairSequentialAveragingMedianST + + Data.Vector.Algorithms.Quicksort.Predefined.VIntSequentialMedian3ST + Data.Vector.Algorithms.Quicksort.Predefined.VIntSequentialMedian3IO + Data.Vector.Algorithms.Quicksort.Predefined.VPairSequentialMedian3ST + Data.Vector.Algorithms.Quicksort.Predefined.VPairSequentialMedian3IO + Data.Vector.Algorithms.Quicksort.Predefined.VIntParallelStrategiesMedian3ST + Data.Vector.Algorithms.Quicksort.Predefined.VIntParallelStrategiesMedian3IO + Data.Vector.Algorithms.Quicksort.Predefined.VPairParallelStrategiesMedian3ST + Data.Vector.Algorithms.Quicksort.Predefined.VPairParallelStrategiesMedian3IO + + Data.Vector.Algorithms.Quicksort.Predefined.VIntSequentialMedian3or5ST + Data.Vector.Algorithms.Quicksort.Predefined.VIntSequentialMedian3or5IO + Data.Vector.Algorithms.Quicksort.Predefined.VPairSequentialMedian3or5ST + Data.Vector.Algorithms.Quicksort.Predefined.VPairSequentialMedian3or5IO + Data.Vector.Algorithms.Quicksort.Predefined.VIntParallelStrategiesMedian3or5ST + Data.Vector.Algorithms.Quicksort.Predefined.VIntParallelStrategiesMedian3or5IO + Data.Vector.Algorithms.Quicksort.Predefined.VPairParallelStrategiesMedian3or5ST + Data.Vector.Algorithms.Quicksort.Predefined.VPairParallelStrategiesMedian3or5IO + + Data.Vector.Algorithms.Quicksort.Predefined.UIntSequentialMedian3ST + Data.Vector.Algorithms.Quicksort.Predefined.UIntSequentialMedian3IO + Data.Vector.Algorithms.Quicksort.Predefined.UPairSequentialMedian3ST + Data.Vector.Algorithms.Quicksort.Predefined.UPairSequentialMedian3IO + Data.Vector.Algorithms.Quicksort.Predefined.UIntParallelStrategiesMedian3ST + Data.Vector.Algorithms.Quicksort.Predefined.UIntParallelStrategiesMedian3IO + Data.Vector.Algorithms.Quicksort.Predefined.UPairParallelStrategiesMedian3ST + Data.Vector.Algorithms.Quicksort.Predefined.UPairParallelStrategiesMedian3IO + + Data.Vector.Algorithms.Quicksort.Predefined.UIntSequentialMedian3or5ST + Data.Vector.Algorithms.Quicksort.Predefined.UIntSequentialMedian3or5IO + Data.Vector.Algorithms.Quicksort.Predefined.UPairSequentialMedian3or5ST + Data.Vector.Algorithms.Quicksort.Predefined.UPairSequentialMedian3or5IO + Data.Vector.Algorithms.Quicksort.Predefined.UIntParallelStrategiesMedian3or5ST + Data.Vector.Algorithms.Quicksort.Predefined.UIntParallelStrategiesMedian3or5IO + Data.Vector.Algorithms.Quicksort.Predefined.UPairParallelStrategiesMedian3or5ST + Data.Vector.Algorithms.Quicksort.Predefined.UPairParallelStrategiesMedian3or5IO + + Data.Vector.Algorithms.Quicksort.Predefined.VTupleSequentialMedian3ST + Data.Vector.Algorithms.Quicksort.Predefined.VTupleSequentialMedian3IO + Data.Vector.Algorithms.Quicksort.Predefined.VTupleParallelStrategiesMedian3ST + Data.Vector.Algorithms.Quicksort.Predefined.VTupleParallelStrategiesMedian3IO + Data.Vector.Algorithms.Quicksort.Predefined.VTupleSequentialMedian3or5ST + Data.Vector.Algorithms.Quicksort.Predefined.VTupleSequentialMedian3or5IO + Data.Vector.Algorithms.Quicksort.Predefined.VTupleParallelStrategiesMedian3or5ST + Data.Vector.Algorithms.Quicksort.Predefined.VTupleParallelStrategiesMedian3or5IO + Data.Vector.Algorithms.Quicksort.Predefined.UTupleSequentialMedian3ST + Data.Vector.Algorithms.Quicksort.Predefined.UTupleSequentialMedian3IO + Data.Vector.Algorithms.Quicksort.Predefined.UTupleParallelStrategiesMedian3ST + Data.Vector.Algorithms.Quicksort.Predefined.UTupleParallelStrategiesMedian3IO + Data.Vector.Algorithms.Quicksort.Predefined.UTupleSequentialMedian3or5ST + Data.Vector.Algorithms.Quicksort.Predefined.UTupleSequentialMedian3or5IO + Data.Vector.Algorithms.Quicksort.Predefined.UTupleParallelStrategiesMedian3or5ST + Data.Vector.Algorithms.Quicksort.Predefined.UTupleParallelStrategiesMedian3or5IO + + hs-source-dirs: + src-predefined + + build-depends: + , base >= 4.14 + , parallel + , primitive + , stm + , vector + , vector-quicksort + +test-suite test + import: ghc-options + type: + exitcode-stdio-1.0 + main-is: + test/TestMain.hs + other-modules: + Data.Vector.Algorithms.Quicksort.Tests + hs-source-dirs: + . + test + build-depends: + , QuickCheck + , base >= 4.14 + , containers + , tasty + , tasty-quickcheck + , vector + , vector-quicksort-predefined + ghc-options: + -rtsopts + -threaded + "-with-rtsopts=-N -A16m -n1m -qg -qb" + -main-is TestMain + +library vector-quicksort-cpp + default-language: + GHC2021 + include-dirs: + cbits + cxx-sources: + cbits/sort.cpp + cxx-options: + -std=c++17 + -- Just like in the ‘text’ package, less critical for us since this + -- is a library for testing and benchmarking only. + if impl(ghc >= 9.4) + build-depends: system-cxx-std-lib == 1.0 + elif os(darwin) || os(freebsd) + extra-libraries: c++ + elif os(openbsd) + extra-libraries: c++ c++abi pthread + elif os(windows) + -- GHC's Windows toolchain is based on clang/libc++ in GHC 9.4 and later + if impl(ghc < 9.3) + extra-libraries: stdc++ + else + extra-libraries: c++ c++abi + elif os(linux) + extra-libraries: stdc++ + else + -- This is supposed to be under arch(wasm32), but we can't do that yet + -- since cabal check would fail with unrecognized arch, see + -- https://github.com/haskell/cabal/pull/8096 for the fix. + -- TODO: when a new cabal release is out with that fix, bump cabal in CI + -- and add proper arch(wasm32) declaration here. + cpp-options: -DSIMDUTF_NO_THREADS + cxx-options: -fno-exceptions + extra-libraries: c++ c++abi + +benchmark bench + import: ghc-options + type: + exitcode-stdio-1.0 + main-is: + BenchMain.hs + other-modules: + ForeignSorting + hs-source-dirs: + bench + build-depends: + , atomic-counter + , base >= 4.14 + , bytestring + , deepseq + , primitive + , random + , stm + , tasty + , tasty-bench >= 0.3.2 + , text + , text-builder-linear + , vector + , vector-algorithms + , vector-quicksort + , vector-quicksort-cpp + , vector-quicksort-predefined + ghc-options: + -fno-spec-constr + -rtsopts + -threaded + "-with-rtsopts=-N -A16m -n1m -qg -qb" + -main-is BenchmarkMain