diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -40,4 +40,27 @@ ## 0.2.0.3 -- 2024-06-16 -* Improve testing compatibility (fix text breaking Stackage build) +* Improve testing compatibility (fix QuickCheck breaking Stackage build) + +## 1.0.0.0 -- 2024-08-21 + +* Add Recursive Robustsort + +* Add Rotationsort + +* Fix Bubblesort to more closely match Ackley's non-'optimized' version + +* Add Benchmarking + +* Expand README + +* Replace Exchangesort with Rotationsort in Robustsort + +* Use Sortable type in Tensort and Robustsort so they can be used recursively + +* Add top-level Tensort and Robustsort functions wrapped in a type converter so + they can be easily used to sort Bits (Integers) + +* Add more helper functions + +* Many more updates to the algorithms - see README for details diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,756 +1,1128 @@ # Tensort [![Hackage](https://img.shields.io/hackage/v/tensort.svg)](https://hackage.haskell.org/package/tensort) -Tensort is a tensor-based sorting algorithm that is tunable to adjust to -the priorities of the task at hand. - -This project started as an exploration of what a sorting algorithm that -prioritizes robustness would look like. As such it also describes and provides -implementations of Robustsort, a group of Tensort variants designed to -prioritize robustness in conditions defined in David H. Ackley's -[Beyond Efficiency](https://www.cs.unm.edu/~ackley/be-201301131528.pdf). - -Note: This project is still under construction. Everything works and according -to my calculations will perform excellently under Ackley's testing conditions. -Still to add: benchmarking to prove how cool it is, documentation -additions/revisions, memes. There's likely a lot of room for improvement in the -code as well. - -## Table of Contents - -- [Introduction](#introduction) - - [Inspiration](#inspiration) - - [Why?](#why) - - [But why would anyone care about this in the first place?](#but-why-would-anyone-care-about-this-in-the-first-place) - - [Why Haskell?](#why-haskell) -- [Project structure](#project-structure) -- [Algorithms overview](#algorithms-overview) - - [Tensort](#tensort) - - [Preface](#preface) - - [Structure](#structure) - - [Algorithm](#algorithm) - - [What are the benefits?](#what-are-the-benefits) - - [Logarithmic Tensort](#logarithmic-tensort) - - [Robustsort](#robustsort) - - [Preface](#preface-1) - - [Overview](#overview) - - [Examining Bubblesort](#examining-bubblesort) - - [Exchangesort](#exchangesort) - - [Introducing Supersort](#introducing-supersort) - - [Permutationsort](#permutationsort) - - [Supersort Adjudication](#supersort-adjudication) - - [Magicsort](#magicsort) - - [Supersort adjudication with Magic](#supersort-adjudication-with-magic) - - [A note on Robustsort and Bogosort](#a-note-on-robustsort-and-bogosort) -- [Comparing it all](#comparing-it-all) -- [Library](#library) - -## Introduction - -### Inspiration - - - [Beyond Efficiency](https://www.cs.unm.edu/~ackley/be-201301131528.pdf) by - [David H. Ackley](https://github.com/DaveAckley) - - - [Beyond Efficiency by Dave Ackley](https://futureofcoding.org/episodes/070) - by Future of Coding ([Lu Wilson](https://github.com/TodePond), - [Jimmy Miller](https://github.com/jimmyhmiller), - [Ivan Reese](https://github.com/ivanreese)) - -### Why? - -Because near the end of [that podcast episode](https://futureofcoding.org/episodes/070), -[Ivan](https://github.com/ivanreese) said "Why are we comparing Bubblesort -versus Quicksort and Mergesort? Well, because no one's made Robustsort yet." - -And I thought, "Why not?" - -### But why would anyone care about this in the first place? - -Well, a tunable sorting algorithm is a really cool thing to have! - -This can have many different uses, one of which is prioritizing robustness. - -[Ackley](https://www.cs.unm.edu/~ackley/be-201301131528.pdf) has some really -compelling things to say about why prioritizing robustness is important and -useful, and I'd highly recommend you read that paper! - -Or listen to [this podcast](https://futureofcoding.org/episodes/070)! - -If you want my elevator pitch, it's because we eventually want to build things -like [Dyson Spheres](https://en.wikipedia.org/wiki/Dyson_sphere). Doing so will -likely involve massively distributed systems being constantly pelted by -radiation. In circumstances like that, robustnesss is key. - -Another example I like to consider is artificial cognition. When working -in a non-deterministic system (or a system so complex as to be considered -non-deterministic), it can be helpful to have systems in place to make sure -that the answer we come to is really valid. - -Incidentally, while I was preparing for this project, we experienced -[the strongest solar storm to reach Earth in 2 decades](https://science.nasa.gov/science-research/heliophysics/how-nasa-tracked-the-most-intense-solar-storm-in-decades/). -I don't know for certain whether the solar activity caused any computer errors, -but we had some anomalies at work and certainly joked about them being caused by -the Sun. - -Also during the same period, -[one of the Internet's root-servers glitched out for unexplained reasons](https://arstechnica.com/security/2024/05/dns-glitch-that-threatened-internet-stability-fixed-cause-remains-unclear/). - -As Ackley mentions, as a culture we have tended to prioritize correctness and -efficiency to the exclusion of robustness. The rate of our technological -progression precludes us from continuing to do so. - -### Why Haskell? - -[Obviously](https://www.youtube.com/shorts/LGZKXZQeEBg). - -## Project structure - -- `src/` contains the Tensort library - -- `app/` contains the suite for comparing different sorting algorithms in terms of robustness and time efficiency - -## Algorithms overview - -This README assumes some general knowledge of basic sorting algoritms. If you -would like a refresher, I recommend -[this video](https://www.youtube.com/watch?v=kgBjXUE_Nwc) which touches on -Bubblesort, MergeSort, and Bogosort, and -[this video](https://www.youtube.com/watch?v=XE4VP_8Y0BU) which discusses -Quicksort. - -It also assumes you've read -[Beyond Efficiency](https://www.cs.unm.edu/~ackley/be-201301131528.pdf) by -David H. Ackley. Go read it! - -Please note that we will discuss a few algorithms that I've either made up or -am just not familiar with by other names. If any of these algorithms have -previously been named, please let me know. Prior to this project I really -only had a rudimentary understanding of Insertionsort, Quicksort, Mergesort, -Bubblesort and Bogosort, so it's entirely possible that I've reinvented a few -things that already exist. - -It also may be helpful to note that this project was originally undertaken in -an endeavor to come up with a solution naively, for the practice, before -researching other algorithms built to tackle the same problem. I did very -briefly check out Ackley's -[Demon Horde Sort](https://www.youtube.com/watch?v=helScS3coAE&t=260s), -but only enough (about 5 seconds of that video) to verify that it is different -from this algorithm. I've been purposefully avoiding learning much about Demon -Horde Sort before publishing v1.0.0.0 of this package, but Ackley is way -smarter than me so if you do actually want a real, professional approach to -robust sorting, Demon Horde Sort is likely the place to look. - -The algorithms used here that I have made up or renamed are, in order of -introduction, Tensort, Robustsort, Permutationsort, and Magicsort. Get ready! - -### Tensort - -#### Preface - -Tensort is my attempt to write the most robust O(n log n) sorting algorithm -possible while avoiding anything that Ackley might consider a "cheap hack." -My hope is that it will be, if not competitive with Bubblesort in robustness, -at least a major improvement over Quicksort and Mergesort. - -Again, I'm not well-studied in sorting algorithms, so this may well be known -already under another name. After settling on this algorithm, I looked into -several other sorting algorithms for comparison and found a few that I think -are similar - significantly Blocksort, Bucketsort, and Patiencesort. If you are -familiar with these algorithms, you may recognize that they each have a -structure that aids in understanding them. - -Tensort uses an underlying structure as well. We will discuss this structure -before going over the algorithm's actual steps. If this doesn't make sense yet, -fear not! - - - -#### Structure - - - Bit <- Element of the list to be sorted - - - Byte <- List of Bits - - - Bytesize <- Maximum length of a Byte - - - Tensor <- Tuple of a Register list and a Memory list - - - Memory <- List of Bytes or Tensors contained in the current Tensor. - - - Register <- List of Records referencing each Byte or Tensor in Memory - - - Record <- Tuple of the Address and the TopBit of the referenced Byte or Tensor - - - Address <- Pointer to a Byte or Tensor in Memory - - - TopBit <- Value of the Bit at the top of the stack in a Byte or Tensor - - - TensorStack <- A top-level Tensor along with all the Bits, Bytes, and Tensors it contains - - - SubAlgorithm <- The sorting sub-algorithm used at various stages - -In Tensort, the smallest unit of information is a Bit. Each Bit stores one -element of the list to be sorted. A group of Bits is known as a Byte. - -A Byte is a list of Bits. The maximum length of a Byte is set according to an -argument passed to Tensort. In practice, almost all Bytes will be of maximum -length until the final steps of Tensort. Several Bytes are grouped together -in a Tensor. - -A Tensor is a tuple with two elements: Register and Memory. - -Memory is the second element in a Tensor tuple. It is a list of Bytes or -other Tensors. The length of this Memory list is equal to the Bytesize. - -A Register is the first element in a Tensor tuple. It is a list of Records, -each of which has an Address pointing to an element in its Tensor's Memory -and a copy of the TopBit in the referenced element. These Records are arranged -in the order that the elements of the Tensor's Memory are sorted (this will be -clarified soon). - -A TensorStack is a top-level Tensor along with all the Bits, Bytes, and -Tensors it contains. Once the Tensors are fully built, the total number -of TensorStacks will equal the Bytesize, but before that point there will -be many more TensorStacks. - -The sorting SubAlgorithm will be used any time we sort something within -Tensort. The choice of this SubAlgorithm is very important. For reasons that -will become clear soon, the SubAlgorithm for Standard Tensort will be -Bubblesort, but the major part of Tensort's tunability is the ability to -substitute another sorting algorithm based on current priorities. - -Now, on to the algorithm! - -#### Algorithm - -The first step in Tensort is to randomize the input list. I'll explain why we -do this in more detail later - for now just know that it's easier for Tensort -to make mistakes when the list is already nearly sorted. - - 1. Randomize the input list of elements (Bits) - - 2. Assemble Bytes by sorting the Bits using the SubAlgorithm. After this, we - will do no more write operations on the Bits until the final steps. Instead, we - will make copies of the Bits and sort the copies alongside their pointers. - - 3. Assemble TensorStacks by creating Tensors from the Bytes. Tensors are - created by grouping Bytes together (setting them as the Tensor's - second element), making Records from their top bits, sorting the records, and - then recording the Pointers from the Records (after being sorted) as the - Tensor's first element. - - 4. Reduce the number of TensorStacks by creating a new layer of Tensors from - the Tensors created in Step 3. These new Tensors are created by grouping - the first layer of Tensors together (setting them as the new Tensor's - second element), making Records from their top Bits, sorting the Records, and - then recording the Pointers from the Records - (after being sorted) as the Tensor's first element. - - 5. Continue in the same manner as in Step 4 until the number of TensorStacks - equals the Bytesize - - 6. Assemble a top Register by Making Records from the Top Bits on each - TensorStack and sort the Records. - - 7. Remove the Top Bit from the top Byte in the top TensorStack and add it - to the final Sorted List. If the top Byte has more than one But in it stll, - Re-sort the Byte for good measure (technically this is - running the algorithm on different arguments - if anyone wants to me about - this I'll update this README) - - 8. If the top Byte in the top TensorStack is empty, remove the Record that - points to it from its Tensor's Register. If the Tensor is empty, remove - the Record that points to it from its Tensor's Register. Do this recursively - until the Tensor is not empty or the top of the TensorStack is reached. If the - entire TensorStack is empty of Bits, remove its Record from the top Register. If - all TensorStacks are empty of Bits, return the final Sorted List. Otherwise, - re-sort the top Register - - 9. Otherwise (the top Byte (or a Tensor that contains it) is not empty), - update the top Byte's (or Tensor's) Record with its - new Top Bit and re-sort its Tensor's Register. Then jump up a level to - the Tensor that contains that Tensor and update the top Tensor's Record - with its new Top Bit and re-sort its Register. Do this recursively until - the whole TensorStack is rebalanced. Then update the TensorStack's Record in the - top Register with its new Top Bit and re-sort the top Register. - -Now that we know all the steps, it's easier to see why we randomize the list -as the beginning step. This way, if the list is already nearly -sorted, values close to each other don't get stuck under each other in their -Byte. Ideally, we want the top Bits from all TensorStacks to be close to -each other. Say for example, the first three elements in a 1,000,000-element -list are 121, 122, 123, and 124. If we don't randomize the list, these 3 -elements get grouped together in the first byte. That's all well and good if -everything performs as expected, but if something unexpected happens -during an operation where we intend to add 124 to the final list -and we add a different element instead, three of the best-case elements to have -mistakenly added (121, 122, and 123) are impossible to have been selected. - -#### What are the benefits? - -The core idea of Tensort is breaking the input into smaller pieces along an -ever-expanding rank, and sorting the smaller pieces. Once we understand the -overall structure, we can design the SubAlgorithm (and Bytesize) to suit our -needs. - -Standard Tensort leverages the robustness of Bubblesort while reducing the time -required by never Bubblesorting the entire input. - -We are able to do this because A) Bubblesort is really good at making sure the -last element is in the final position of a list, and B) at each step of Tensort -the only element we *really* care about is the last element in a given list -(or to look at it another way, the TopBit of a given Tensor). - -#### Logarithmic Tensort - -When using standard Tensort (i.e. using Bubblesort as the SubAlgoritm), as the -Bytesize approaches the square root of the number of elements in the -input list, its time efficiency approaches O(n^2). - -Standard Tensort is most time efficient when the Bytesize is close -to the natural log of the number of elements in the input list. A logarithmic -Bytesize is likely to be ideal for most use cases of standard Tensort. - -Alright! Now we have a simple sorting algorithm absent of cheap hacks that is -both relatively fast and relatively robust. I'm pretty happy with that! - - - -Now for some cheap hacks! - -### Robustsort - -#### Preface - -In Beyond Efficiency, Ackley augmented Mergesort and Quicksort with what he -called "cheap hacks" in order to give them a boost in robustness to get them to -compare with Bubblesort. This amounted to adding a quorum system to the -unpredictable comparison operator and choosing the most-agreed-upon answer. - -I agree that adding a quorum for the unpredictable comparison operator is a bit -of a cheap hack, or at least a post-hoc solution to a known problem. Instead of -retrying a specific component again because we know it to be unpredictable, -let's build redundancy into the system at the (sub-)algorithmic level. A simple -way to do this is by asking different components the same question and see if -they agree. - -Robustsort is my attempt to make the most robust sorting algorithm possible -utilizing some solution-checking on the (sub-)algorithmic level while still: - - - Keeping runtime somewhat reasonable - - - Never re-running a sub-algorithm that is expected to act deterministicly - on the same arguments looking for a non-deterministic result (i.e. expect - that if a components gives a wrong answer, running it again won't somehow - yield a right answer) - - - Using a minimal number of different sub-algorithms (i.e. doesn't just - use every O(n log n) sorting algorithm I can think of and compare all - their results) - -With those ground rules in place, let's get to Robustsort! - -#### Overview - -Once we have Tensort in our toolbox, the road to Robustsort is pretty simple. -Robustsort is a 3-bit Tensort with a custom SubAlgorithm that compares other -sub-algorithms. For convenience, we will call this custom SubAlgorithm -Supersort. We use a 3-bit Tensort here because there's something -magical that happens around these numbers. - -Robust sorting algorithms tend to be -slow. Bubblesort, for example, has an average time efficiency of O(n^2), -compared with Quicksort and Mergesort, which both have an average of (n log n). - -Here's the trick though: with small numbers the difference between these values -is minimal. For example, when n=4, Mergesort will make 6 comparisons, while -Bubblesort will make 12. A Byte holding 4 Bites is both small enough to run -the Bubblesort quickly and large enough to allow multiple opportunities for a -mistake to be corrected. Since we don't as much built-in parallelism in -Tensort, it can make sense to weight more heavily on the side of making more -checks. - -In Robustsort, however, we have parallelism built into the Supersort -SubAlgorithm, so we can afford to make less checks during this step. -We choose a Bytesize of -3 because a list of -3 Bits has some special properties. For one thing, sorting at -this length greatly reduces the time it takes to run our slow-but-robust -algorithms. For example, at this size, Bubblesort will make only 6 comparisons. -Mergesort still makes 6 as well. - -In addition, when making a mistake while sorting 3 elements, the mistake -will displace an element by only 1 or 2 positions at the, no matter which -algorithm is used. - -This is all to say that using a 3-bit byte size allows us to have our pick of -algorithms to compare with! - -Note: One might ask why we don't use a Bytesize of 2, since it would be even faster -and still have the same property of displacing an element by only 1 or 2 -positions. Well, how many different algorithms can you use to sort 2 elements? -At this length, most algorithms function equivalently (in terms of the -sub-operations performed) and in my mind running two such algorithms is -equivalent to re-running a single algorithm (which violates the requirements -of this project). - -#### Examining Bubblesort - -Before moving further, let's talk a little about Bubblesort, and why we're -using it in our SubAlgorithm. - -As a reminder, Bubblesort will make an average of 6 comparisons when sorting -a 3-element list. - -We've said before that Bubblesort is likely to put the last element in the -correct position. Let's examine this in the context of Bubblesorting a -3-element list. - -Our implementation of Bubblesort (which mirrors Ackley's) will perform three -iterations over a 3-element list. After the second iteration, if everything -goes as planned, the list will be sorted and the final iteration is an extra -verification step. Therefore, to simplify the analysis, we will consider -what happens with a faulty comparator during the final iteration, assuming the -list has been correctly sorted up to that point. - -Given a Byte of [1,2,3], here are the chances of various outcomes from using a -faulty comparator that gives a random result 10% of the time: - - 81% <- [1,2,3] (correct - no swaps made) - - 9% <- [2,1,3] (faulty first swap) - - 9% <- [1,3,2] (faulty second swap) - - 1% <- [2,3,1] (faulty first and second swap) - -In these cases, 90% of the time the Top Bit will be in the correct position, -and in the other cases it will be off by one position, and in no case will the -Byte be reverse sorted. - -#### Exchangesort - -When choosing an algorithm to compare with Bubblesort, we want something with -substantially different logic, for the sake of robustness. We do, -however, want something similar to Bubblesort in that it compares our elements -multiple times. And, as mentioned above, the element that is most important to -our sorting is the top (biggest) element, by a large degree. - -With these priorities in mind, the comparison algorithm we choose shall be -Exchangesort. If you're not familiar with this algorithm, I'd recommend -checking out [this video](https://youtu.be/wqibJMG42Ik?feature=shared&t=143). - -The Exchangesort we use is notable in two ways. Firstly, it is a Reverse -Exchangesort, as explained in that video. - -Secondly, the algorithm as described in the video only compares selected element -with elements that appear after (or before, as in Reverse Exchangesort) it in -the list, swapping them if the compared element is larger. This functions -similarly to an optimized Bubblesort where after the each round the last -element compared that round is no longer compared in following rounds. Our -implementation will compare the selected element with all other elements in the -list, swapping them if the element that appears later is larger. Ackley -uses an unoptimized Bubblesort in Beyond Efficiency, so I feel comfortable -using this variation for our Exchangesort. - -Exchangesort will also make an average of 6 comparisons when sorting a -3-element list. - -As with Bubblesort, Exchangesort will perform three iterations over a 3-element -list, with the final iteration being redundant. - -Given a Byte of [1,2,3], here are the chances of various outcomes from using a -faulty comparator that gives a random result 10% of the time: - - 81% <- [1,2,3] (correct - no swaps made) - - 9% <- [2,1,3] (faulty first swap) - - 9% <- [3,2,1] (faulty second swap) - - 1% <- [3,1,2] (faulty first and second swap) - -In these cases, 90% of the time the Top Bit will have the correct value. -Notably there is a 9% chance that the Byte will be reverse sorted, but we will -exploit this trait later on in the Supersort SubAlgorithm. Note also that the -only possible outcomes shared between this example and the Bubblesort example -are the correct outcome and [2,1,3], which retains the TopBit with the correct -value. - -#### Introducing Supersort - -Supersort is a SubAlgorithm that compares the results of two different -sorting algorithms, in our case Bubblesort and Exchangesort. If both -algorithms agree on the result, that result is used. - -Looking at our analysis on Bubblesort and Exchangesort, we can -approximate the chances of various outcomes when comparing the results of -running these two algorithms in similar conditions: - - 65.61% <- [1,2,3], [1,2,3] (Agree Correctly) - - 7.29% <- [1,2,3], [2,1,3] (Disagree - TopBit agrees correctly) - - 7.29% <- [1,2,3], [3,2,1] (Disagree Fully) - - 7.29% <- [2,1,3], [1,2,3] (Disagree - TopBit agrees correctly) - - 7.29% <- [1,3,2], [1,2,3] (Disagree Fully) - - 0.81% <- [2,1,3], [2,1,3] (Agree Incorrectly - TopBit correct) - - 0.81% <- [2,1,3], [3,2,1] (Disagree Fully) - - 0.81% <- [1,3,2], [2,1,3] (Disagree Fully) - - 0.81% <- [1,3,2], [3,2,1] (Disagree Fully) - - 0.09% <- [2,1,3], [3,1,2] (Disagree Fully) - - 0.09% <- [1,3,2], [3,1,2] (Disagree - TopBit agrees incorrectly) - - 0.09% <- [2,3,1], [2,1,3] (Disagree Fully) - - 0.09% <- [2,3,1], [3,2,1] (Disagree - TopBit agrees incorrectly) - - 0.01% <- [2,3,1], [3,1,2] (Disagree Fully) - -In total, that makes: - - 65.61% <- Agree Correctly - - 17.2% <- Disagree Fully - - 14.58% <- Disagree - TopBit agrees correctly - - 0.81% <- Agree Incorrectly - TopBit correct - - 0.18% <- Disagree - TopBit agrees incorrectly - - [no outcome] <- Agree with TopBit incorrect - -The first thing that might stand out is that around 34% of the time, these -sub-algorithms will disagree with each other. What happens then? - -Well, in that case we run a third sub-algorithm to compare the results with: -Permutationsort. - -#### Permutationsort - -Permutationsort is a simple, brute-force sorting algorithm. As a first step we -generate all the different ways the elements could possibly be arranged in the -list. Then we loop over this list of permutations until we find one that is in -the right order. We check if a permutation is in the right order by comparing -the first two elements, if they are in the right order comparing the next two -elements, and so on until we either find two elements that are out of order or -we confirm that the list is in order. - -Permutationsort will also make an average of 7 comparisons when sorting a -3-element list. This is slightly more than the other algorithms examined but -it's worth it because A) the spread of outcomes is favorable for our needs, and -B) it uses logic that is completely different from Bubblesort and Exchangesort. -Using different manners of reasoning to reach an agreed-upon answer greatly -increases the robustness of the system. - -Given a Byte of [1,2,3], here are the chances of various outcomes from using a -faulty comparator that gives a random result 10% of the time: - - ~68.67% <- [1,2,3] (correct) - - ~7.63% <- [2,1,3] (faulty first comparator) - - ~7.63% <- [3,1,2] (faulty first comparator) - - ~7.63% <- [1,3,2] (faulty second comparator) - - ~7.63% <- [2,3,1] (faulty second comparator) - - ~0.85% <- [3,2,1] (faulty first and second comparator) - -In these cases, 76.6% of the time the Top Bit will be in the correct position. -Notably the least likely outcome is a reverse-sorted Byte and the other -possible incorrect outcomes are in even distribution with each other. - -#### Supersort Adjudication - -Supposing that our results from Bubblesort and Exchangesort disagree -and we now have our result from Permutationsort, how do we choose which to -use? - -First we check to see whether the result from Permutationsort agrees with -the results from either Bubblesort or Exchangesort. To keep things -simple, let's just look at the raw chances that -Permutationsort will agree on results with Bubblesort or Exchangesort. - -Permutationsort and Bubblesort: - - ~55.62% <- [1,2,3] (Correct) - - ~0.69% <- [2,1,3] (Correct TopBit) - - ~0.69% <- [1,3,2] (Incorrect) - - ~0.08% <- [2,3,1] (Incorrect) - -Permutationsort and Exchangesort: - - ~55.62% <- [1,2,3] (Correct) - - ~0.69% <- [2,1,3] (Correct TopBit) - - ~0.08% <- [3,1,2] (Incorrect) - - ~0.08% <- [3,2,1] (Reverse) - -As we can see, it is very unlikely that Permutationsort will agree with -either Bubblesort or Exchangesort incorrectly. It is even less likely -that they will do so when the TopBit is incorrect. However, there are many -cases in which they do not agree, so let's handle those. - -If there is no agreed-upon result between these three algorithms, we will look -at the top bit only. - -First we check if the results from Bubblesort and Exchangesort agree on the -TopBit. This is because the chance is very unlikely -(0.18%) that they will agree on an incorrect TopBit. If they do agree, we use -the result from Bubblesort (as it will not return a reverse-sorted list). - -If they do not agree, we will check the TopBit results from Bubblesort and -Permutationsort. This is because it is unlikely -(~0.92%) that they will agree on an incorrect TopBit, and the chance of them -incorrectly agreeing on the highest Bit as the TopBit is even lower (~0.16%). -If they do agree, we use the result from Bubblesort. - -If they do not agree, we will check the TopBit results from Exchangesort -and Permutationsort. The chance that they will agree on an -incorrect TopBit is about 1.55%, with the chances of them incorrectly agreeing -on the highest Bit as the TopBit also around 0.16%. If they do agree, we use -the result from Exchangesort. - -If after all this adjudication we still do not have an agreed-upon result, we -will use the result from Bubblesort. - -Now obviously we have made some approximations in our analysis (and I may have -made some mistakes in my calculations), but in general I think we can conclude -that it is very unlikely that this Supersort process will return an incorrect -result, and that if an incorrect result is returned, it is very likely to still -have a correct TopBit. - -We now have the basic form of Robustsort: a 3-bit Tensort with a Supersort -adjudicating Bubblesort, Exchangesort, and Permutationsort as its -SubAlgorithm. - -Well that's pretty cool! But I wonder... can we make this more robust, if -we relax the rules just a little more? - - - -Of course we can! And we will. To do so, we will simply replace Permutationsort -with another newly-named sorting algorithm: Magicsort! - -### Magicsort - -For our most robust iteration of Robustsort we will relax the requirement on -never re-running the same deterministic sub-algorithm in one specific context. -Magicsort is an algorithm that will re-run Permutationsort only if it disagrees -with an extremely reliable algorithm algorithm - one that's so good it's robust -against logic itself... - - - -Bogosort! - - - -Magicsort simply runs both Permutationsort and Bogosort on the same input and -checks if they agree. If they do, the result is used and if not, both -algorithms are run again. This process is repeated until the two algorithms -agree on a result. - -Strong-brained readers may have already deduced that Permutationsort functions -nearly identically to Bogosort. Indeed, their approximate analysis results are -the same. Magicsort is based on the idea that if you happen to pull the right -answer out of a hat once, it might be random chance, but if you do it twice, -it might just be magic! - -Given a Byte of [1,2,3], here are the approximate chances of various outcomes -from Magicsort using a faulty comparator that gives a random result 10% of the -time: - - ~95.27% <- [1,2,3] (Correct) - - ~1.18% <- [2,1,3] (Correct TopBit) - - ~1.18% <- [1,3,2] (Incorrect) - - ~1.18% <- [3,1,2] (Incorrect) - - ~1.18% <- [2,3,1] (Incorrect) - - ~0.02% <- [3,2,1] (Reverse) - -The downside here is that Magisort can take a long time to run. I don't know -how many comparisons are made on average, but it's well over 14. - -Thankfully, Magicsort will only be run in our algorithm if Bubblesort and -Exchangesort disagree on an answer. Overall the Robustsort we're building that -uses Magicsort will still have an average of O(n log n) time efficiency. - -#### Supersort adjudication with Magic - -Since we have replaced Permutationsort with Magicsort (which is far more robust -than Bubblesort or Exchangesort), we will adjust our adjudication -within the Supersort SubAlgorithm. - -If Bubblesort and Exchangesort disagree, we will run Magicsort on the -input. If Magicsort agrees with either Bubblesort or Exchangesort, we -will use the result from Magicsort. Otherwise, if Magicsort agrees on the -TopBit with either Bubblesort or Exchangesort, we will use the result -from Magicsort. Otherwise, if Bubblesort and Exchangesort agree on the -TopBit, we will use the result from Bubblesort. - -If no agreement is reached at this point, we abandon all logic and just use -Magicsort. - -### A note on Robustsort and Bogosort - -It is perfectly valid to use Bogosort in place of Permutationsort in Robustsort's -standard Supersort SubAlgorithm. It may be argued that doing so is even more -robust, since it barely even relies on logic. Here are some considerations to -keep in mind: - - - Permutationsort uses additional space and may take slightly longer on average - due to computing all possible permutations of the input and storing them in a - list. - - - Bogosort could theoretically run forever without returning a result, even - when no errors occur. - -## Comparing it all - -Now let's take a look at how everything compares. Here is a graph showing the -benchmarking results in both in both robustness and time efficiency for -Quicksort, Mergesort, Standard Logarithmic Tensort, Robustsort (Permutations), -Robustsort (Bogo), Robustsort (Magic), and Bubblesort: - -...Coming Soon! - -## Library - -This package contains implementations of each algorithm discussed above. -Notably, it provides the following: - - - Customizable Tensort - - - Standard Logarithmic Tensort - - - Standard Tensort with customizable Bytesize - - - Mundane Robustsort with Permutationsort adjudicator - - - Mundane Robustsort with Bogosort adjudicator - - - Magic Robustsort - -Check the code in `src/` or the documentation on Hackage/Hoogle -for more details. +Tensort is a family of sorting algorithms that are tunable to adjust to the +priorities of the task at hand. + +This project started as an exploration of what a sorting algorithm that +prioritizes robustness might look like. As such it also describes and provides +implementations of Robustsort, a group of Tensort variants designed for +robustness in conditions described in David H. Ackley's +[Beyond Efficiency](https://www.cs.unm.edu/~ackley/be-201301131528.pdf). + +Simply put, Tensort takes an input list, transforms the list into a +multi-dimensional tensor field, then transforms that tensor field back into a +sorted list. These transformations provide opportunities to increase redundancy +for improved robustness and can be leveraged to include any further processing +we wish to do on the elements. + +
+ When sorting a randomly shuffled deck of cards, Quicksort makes + 202 positional errors, Mergesort makes 201, Bubblesort makes 4, Tensort + makes 51, Mundane Robustsort makes 11, and Magic Robustsort makes + [CENSORED] +
+ Read on for the full data, or + + click here to jump to the comparison section for spoilers + +
+
+ +## Table of Contents + +- [Introduction](#introduction) + - [Inspiration](#inspiration) + - [Why?](#why) + - [But why would anyone care about this in the first + place?](#but-why-would-anyone-care-about-this-in-the-first-place) + - [Why Haskell?](#why-haskell) + - [What's a tensor?](#whats-a-tensor) +- [Project structure](#project-structure) +- [Algorithms overview](#algorithms-overview) + - [Tensort](#tensort) + - [Preface](#preface) + - [Structure](#structure) + - [Algorithm](#algorithm) + - [Benefits](#benefits) + - [Logarithmic Bytesize](#logarithmic-bytesize) + - [Robustsort](#robustsort) + - [Preface](#preface-1) + - [Overview](#overview) + - [Examining Bubblesort](#examining-bubblesort) + - [Rotationsort](#rotationsort) + - [Introducing Supersort](#introducing-supersort) + - [Permutationsort](#permutationsort) + - [Supersort Adjudication](#supersort-adjudication) + - [Recursion](#recursion) + - [Magicsort](#magicsort) + - [Magic Robustsort SubAlgorithm + alterations](#magic-robustsort-subalgorithm-alterations) + - [A note about Mundane Robustsort + SubAlgorithms](#a-note-about-mundane-robustsort-subalgorithms) +- [Comparing it all](#comparing-it-all) +- [Library](#library) +- [Development Environment](#development-environment) +- [Contact](#contact) +- [Thank you](#thank-you) + +## Introduction + +### Inspiration + + - [Beyond Efficiency](https://www.cs.unm.edu/~ackley/be-201301131528.pdf) by + [David H. Ackley](https://livingcomputation.com/) + + - [Beyond Efficiency by Dave Ackley](https://futureofcoding.org/episodes/070) + by Future of Coding ([Lu Wilson](https://www.todepond.com/), + [Jimmy Miller](https://jimmyhmiller.github.io/), + [Ivan Reese](https://ivanish.ca/)) + +### Why? + +Because near the end of +[that podcast episode](https://futureofcoding.org/episodes/070), +[Ivan](https://ivanish.ca/) said "Why are we comparing Bubblesort versus +Quicksort and Mergesort? Well, because no one's made Robustsort yet." + +And I thought, "Why not?" + +### But why would anyone care about this in the first place? + +Being adaptable to different scenarios, a tunable sorting algorithm has many +potential applications. This README will focus on robustness in sorting. + +[Ackley](https://www.cs.unm.edu/~ackley/be-201301131528.pdf) has compelling +things to say about why prioritizing robustness is important and useful. I'd +highly recommend reading that paper! + +Or listening to [this podcast](https://futureofcoding.org/episodes/070)! + +If you want my elevator pitch, it's because we eventually want to build things +like [Dyson Spheres](https://en.wikipedia.org/wiki/Dyson_sphere). Doing so will +involve massively distributed systems that are constantly pelted by radiation. +In such circumstances, robustness is key. + +Another example I like to consider is artificial cognition. When working +in a non-deterministic system (or a system so complex as to be considered +non-deterministic), it can be helpful to have systems in place to verify that +the answer we come to is valid. + +Incidentally, while I was preparing for this project, we experienced +[the strongest solar storm to reach Earth in 2 +decades](https://science.nasa.gov/science-research/heliophysics/how-nasa-tracked-the-most-intense-solar-storm-in-decades/). +I don't know for certain whether the solar activity caused any computer errors, +but we had some anomalies at work and certainly joked about them being caused +by the Sun. + +Also during the same period, +[one of the Internet's root-servers glitched out for unexplained +reasons](https://arstechnica.com/security/2024/05/dns-glitch-that-threatened-internet-stability-fixed-cause-remains-unclear/). + +As Ackley asserts, as a culture we have tended to prioritize correctness and +efficiency to the detriment of robustness. The rate of our technological +progression precludes us from continuing to do so. + +### Why Haskell? + +1. Tensort can involve a lot of recursion, which Haskell handles well + +2. All the other benefits we get from using a purely functional language, such +as strict dependency management, which even the smartest among us sometimes +falter without: + +
+ Comment from Ackley in the Beyond Efficiency code about Perl + updates breaking their code +
+ Source +
+
+ +       + +3. [Obviously](https://www.youtube.com/shorts/LGZKXZQeEBg) + +### What's a tensor? + +If you want an in-depth explanation, +[Wikipedia](https://en.wikipedia.org/wiki/Tensor) is usually a good starting +place. + +If you just want to understand Tensort, you can think of 'tensor' as a fancy +word for a multi-dimensional array. + +Every tensor has a degree, which is the number of dimensions it has. A 0-degree +tensor is a scalar (like an integer), a 1-degree tensor is a vector (like a +list), a 2-degree tensor is a matrix, and so on. + +Each dimension of a tensor has a rank, which can be thought of as the length of +that dimension. A tensor's shape can be described by another tensor that +denotes the ranks of each of its dimensions. For example. [1,2,3] is an +instance of a 1-degree tensor. Its single dimension is 3 elements long, so it +has a rank 3. Thus its shape is [3]. + +For another example, consider the following tensor which has the shape [3,2]: + + [[1,2,3], + [4,5,6]] + +Tensort transforms a list into a field of the highest-degree tensors possible +while giving its dimensions a specified maximum rank size to achieve the +densest possible cluster of short lists. This provides opportunities to add +processing tailored to suit the current goals while preserving time efficiency. + +## Project structure + +- `src/` contains the Tensort library + +- `app/` contains the suite for comparing different sorting algorithms in terms +of robustness and time efficiency (only in the benchmarking branch) + +- `data/` contains benchmarking data + +## Algorithms overview + +This README assumes some general knowledge of basic sorting algoritms. If you +would like a refresher, I recommend +[this video](https://www.youtube.com/watch?v=kgBjXUE_Nwc) which touches on +Bubblesort and Mergesort, and +[this video](https://www.youtube.com/watch?v=XE4VP_8Y0BU) which discusses +Quicksort. + +It also assumes you've read +[Beyond Efficiency](https://www.cs.unm.edu/~ackley/be-201301131528.pdf) by +David H. Ackley. Go read it! It's short! + +Please note that we will discuss a few algorithms that I've either made up or +am just not familiar with by other names. If any of these algorithms have +previously been named, please [let me know](#contact). Prior to this project I +really only had a rudimentary understanding of Insertionsort, Quicksort, +Mergesort, Bubblesort and Bogosort, so it's entirely possible that I've +reinvented a few things that already exist. + +It may be helpful to note that this project was originally undertaken in an +endeavor to come up with a solution naively, for the exercise, before +researching other algorithms built to tackle the same problem. I did very +briefly check out Ackley's [Demon Horde +Sort](https://www.youtube.com/watch?v=helScS3coAE&t=260s), but only enough +(about 5 seconds of that video) to verify that it is different from this +algorithm. I've been purposefully avoiding learning much about Demon +Horde Sort before publishing v1.0.0.0 of this package, but Ackley is way +smarter than me so if you do actually want a real, professional approach to +robust sorting, Demon Horde Sort is likely the place to look. + +The algorithms used here that I have made up or renamed are, in order of +introduction, Tensort, Robustsort, Rotationsort, Permutationsort, and +Magicsort. + +I will also be joined by the spirit of Sir Michael Caine, who is here for two +reasons. One is to keep an eye on me and make sure I don't go too overboard. +More importantly, he's here as a bit of insurance to make sure you've read +[Beyond Efficiency](https://www.cs.unm.edu/~ackley/be-201301131528.pdf). You +can think of him as my version of the M&M's on Van Halen's concert +rider ([the most famously robust rider in rock +history](https://en.wikipedia.org/wiki/Van_Halen#Contract_riders)). If you +can't figure out why he's here, especially by the end of this README, go back +and re-read the paper! + +Alright, let's get started! Ready, Sir Michael? + +
+ Sir Michael Caine, ready to go! +
+ Source +
+
+ +### Tensort + +#### Preface + +Tensort is my original attempt to write the most robust sorting algorithm +possible with O(n log n) average time efficiency while avoiding anything that +Ackley might consider a "cheap hack." Starting out, my hope was that it would +be, if not competitive with Bubblesort in robustness, at least a major +improvement over Quicksort and Mergesort. + +After settling on this algorithm, I looked into several other sorting +algorithms for comparison and found a few that have some similarities with +Tensort - notably Blocksort, Bucketsort, and Patiencesort. If you are familiar +with these algorithms, you may recognize that they each have a structure that +aids in understanding them. + +Tensort uses an underlying structure as well. We will discuss this structure +before going over the algorithm's actual steps. If this doesn't make sense yet, +fear not! + +#### Structure + + - Bit <- Element of the list to be sorted + + - Byte <- List of Bits + + - Bytesize <- Maximum length of a Byte + + - Tensor <- Tuple of a Register list and a Memory list + + - Memory <- List of Bytes or other Tensors contained in the current Tensor + + - Register <- List of Records, each Record referencing one Byte or Tensor + in Memory + + - Record <- Tuple of the Address and a copy of the TopBit of the referenced + Byte or Tensor + + - Address <- Pointer to a Byte or Tensor in Memory + + - TopBit <- Value of the Bit at the top of the stack in a Byte or Tensor + + - TensorStack <- A top-level Tensor along with all the Bits, Bytes, and + Tensors contained within it. Structurally equivalent to a Tensor + + - TopRegister <- List of Records that is built after all Tensors are built. + Each Record references one TensorStack. Structurally equivalent to a + Register + + - SubAlgorithm <- The sorting sub-algorithm used at various stages + +In Tensort, the smallest unit of information is a Bit. Each Bit stores one +element of the list to be sorted. A group of Bits is known as a Byte. + +A Byte is a list of Bits. The maximum length of a Byte (known as the Bytesize) +is set according to an argument passed to Tensort. This Bytesize can also be +thought of as the maximum rank (not degree) of a tensor in Tensort. +Ideally, all Bytes will be of maximum length until the final steps of Tensort. +Several Bytes are grouped together in a Tensor. + +A Tensor is a tuple with two elements: Register and Memory. + +Memory is the second element in a Tensor tuple. It is a list of Bytes or +other Tensors. The maximum length of this Memory list is equal to the Bytesize. + +A Register is the first element in a Tensor tuple. It is a list of Records, +each of which has an Address pointing to an element in its Tensor's Memory +and a copy of the TopBit in the referenced element. + +Each Record is a simplification of a Byte or Tensor in a Tensor's memory. It +is a tuple comprised of an Address and a TopBit + +The Address of a Record is an integer representing the index of the referenced +Byte or Tensor in its containing Tensor's memory + +The TopBit of a Byte (which is copied into the Byte's referencing Record) is +the Bit at the end of the Byte list. If everything functions correctly, this +will be the highest value Bit in the Byte. + +The TopBit of a Tensor (which is copied into the Tensor's referencing Record) +is the TopBit of the Byte referenced by the Record at the end of the Register +list of the Tensor referenced by the Record at the end of the Register list of +the Tensor... and so on until the original (containing) Tensor is reached. If +everything functions correctly, this TopBit will be the highest value Bit in +the Byte. + +A TensorStack is a top-level Tensor (i.e. a Tensor not contained within another +Tensor) along with all the Bits, Bytes, and Tensors it contains. Once the +Tensors are fully built, the total number of TensorStacks will be equal to (or +sometimes less than) the Bytesize, but before that point there will be many +more TensorStacks. + +Once all Tensors are built, a TopRegister is assembled as a list of Records, +each Record referencing one TensorStack. + +The sorting SubAlgorithm will be used any time we sort something within +Tensort. The choice of this SubAlgorithm is very important. For reasons that +will become clear soon, the SubAlgorithm for Standard Tensort will be +Bubblesort, but the major part of Tensort's tunability is the ability to +substitute another sorting algorithm based on current priorities. + +Now, on to the algorithm! + +#### Algorithm + +The first step in Tensort is to randomize the input list. I'll explain why we +do this in more detail later - for now just know that it's easier for Tensort +to make mistakes when the list is already nearly sorted. + + 1. Randomize the input list of Bits. + + 2. Assemble Bytes by grouping the Bits into lists of lengths equal to the + Bytesize, then sorting the Bits in each Byte using the SubAlgorithm. After + this, we will do no more write operations on the Bits until the final + steps. Instead, we will make copies of the Bits and sort the copies + alongside their pointers. + + 3. Assemble TensorStacks by creating Tensors from the Bytes: +
    +
  1. + Group the Bytes together in Memory lists of Bytesize length. +
    2. +
  2. Assign each Memory to a newly-created Tensor.
    3. +
  3. + For each Tensor, make Records for each Byte in its Memory + by combining the Byte's index in Memory list with a copy of its + TopBit. +
    4. +
  4. + Group the Records for each Tensor together and form them into + their Tensor's Register list. +
    5. +
  5. + Sort the Records in each Register list in order of their + TopBits. +
    6. +
+ + 4. Reduce the number of TensorStacks by creating a new layer of Tensors from + the Tensors created in Step 3: +
    +
  1. + Group the first layer of Tensors together in Memory lists of + Bytesize length. +
    2. +
  2. Assign each Memory to a newly-created Tensor.
    3. +
  3. + For each newly-created Tensor, make Records for each Tensor in + its Memory by combining the enclosed Tensor's index in the + Memory list with a copy of its TopBit. +
    4. +
  4. + Group the Records for each newly-created Tensor together and + form them into their Tensor's Register list. +
    5. +
  5. + Sort each Register list in order of its Records' TopBits. +
    6. +
+ + 5. Continue in the same manner as in Step 4 until the number of TensorStacks + is equal to or less than the Bytesize. + + 6. Assemble a TopRegister by making Records from the Top Bits of each + TensorStack and sorting the Records. + + 7. Remove the TopBit from the top Byte in the top TensorStack and add it to + the final Sorted List. If the top Byte has more than one Bit in it still, + re-sort the Byte for good measure + + 8. If the top Byte in the top TensorStack is empty: +
    +
  1. + Remove the Record that points to the top Byte from its containing + Tensor's Register. +
    2. +
  2. + If the Tensor containing that byte is empty, remove the Record + that points to that Tensor from its containing Tensor's Register. + Do this recursively until finding a Tensor that is not empty or + the top of the TensorStack is reached. +
    3. +
  3. + If the entire TensorStack is empty of Bits, remove its Record + from the TopRegister. +
    4. +
  4. + If all TensorStacks are empty of Bits, return the final Sorted + List. Otherwise, re-sort the TopRegister. +
    5. +
+ + 9. Otherwise (i.e. the top Byte or a Tensor that contains it is not empty): +
    +
  1. + Update the top Byte's (or Tensor's) Record with its new TopBit. +
    2. +
  2. + Re-sort the top Byte's (or Tensor's) containing Tensor's + Register. +
    3. +
  3. + Jump up a level to the Tensor that contains that Tensor, update + the containing Tensor's Record with its new TopBit, and re-sort + its Register. Do this recursively until the whole TensorStack is + rebalanced. +
    4. +
  4. + Update the TensorStack's Record in the TopRegister with its new + TopBit. +
    5. +
  5. Re-sort the TopRegister.
    6. +
+ + 10. Repeat Steps 7-9 until the final Sorted List is returned. + +Now that we know all the steps, it's easier to see why we randomize the list +as the beginning step. This way, if the list is already nearly sorted, values +close to each other don't get stuck under each other in their Byte. Ideally, we +want the top Bits in all the TensorStacks to be close to the same value. + +To illustrate, say that we're using a Bytesize of 4 and the first four Bits +in a list of 1,000,000 to be sorted are 121, 122, 123, and 124. If we don't +randomize the list, these 4 Bits get grouped together in the first Byte. + +That's all well and good if everything performs as expected, but if something +unexpected happens during an operation where we intend to add 124 to the final +list and we add a different Bit instead, three of the best Bits to have +mistakenly added (121, 122, and 123) are impossible to have been selected. + +#### Benefits + +Tensort is designed to be adaptable for different purposes. The core mechanic +in Tensort is the breaking down of the input into smaller pieces along many +dimensions to sort the smaller pieces. Once we understand the overall +structure of Tensort, we can design a SubAlgorithm (and Bytesize) to suit our +needs. + +Standard Tensort leverages the robustness of Bubblesort while reducing runtime +by never Bubblesorting the entire input at once. + +We are able to do this because A) Bubblesort is very good at making sure the +last element is in the final position of a list, and B) at each step in Tensort +the only element we *really* care about is the last element of a given list (or +to look at it another way, the TopBit of a given Tensor). + +#### Logarithmic Bytesize + +When using standard Tensort (i.e. using Bubblesort as the SubAlgoritm), as the +Bytesize approaches 1, the length of the input list, or the square root of the +number of elements in the input list, its average time efficiency approaches +O(n^2). + +Standard Tensort is most time efficient when the Bytesize is close to the +natural log of the number of elements in the input list. A logarithmic Bytesize +is likely to be ideal for most use cases of standard Tensort. + +------- + +Alright! We now have a sorting algorithm absent of cheap hacks that both +maintains O(n log n) average time efficiency and is relatively robust. I'm +pretty happy with that! + +But now that we understand Tensort's basic structure, let's tune it for even +more robustness! + +
+ Michael Caine sitting at a desk in front of a chalkboard full of + mathematical formulae and architectural drawings +
+ Source +
+
+ +### Robustsort + +#### Preface + +In Beyond Efficiency, Ackley augmented Mergesort and Quicksort with what he +called "cheap hacks" in order to give them a boost in robustness in an attempt +to get them to compare with Bubblesort. This amounted to adding a quorum system +to the unpredictable comparison operator and choosing the most-agreed-upon +answer. + +I agree that adding a quorum for the unpredictable comparison operator is at +least a post-hoc solution to a known problem. Instead of retrying a specific +component again because we know it to be unpredictable, let's build redundancy +into the system at the (sub-)algorithmic level. A simple way to do this is by +asking different components the same question and see if they agree. + +Robustsort is my attempt to make the most robust sorting algorithm possible, +utilizing some solution-checking on the (sub-)algorithmic level while still: + + - Keeping to O(n log n) average time efficiency + + - Never re-running a sub-algorithm that is expected to act deterministicly + on the same arguments looking for a non-deterministic result (i.e. expect + that if a component gives a wrong answer, running it again the same way + won't somehow yield a right answer) + + - Using a minimal number of different sub-algorithms (i.e. don't just use + every sorting algorithm that comes to mind and compare all their results) + +With those ground rules in place, let's get to Robustsort! + +#### Overview + +Once we have Tensort in our toolbox, the road to Robustsort is not long. + +Robustsort is a potentially recursive version of Tensort, but first we'll look +at the basic variant: a 3-Bit Tensort with a custom SubAlgorithm that compares +other sub-algorithms. For convenience, we will call this custom SubAlgorithm +Supersort. We use a 3-Bit Tensort here because there's something magical that +happens around the number 3. + +Robust sorting algorithms tend to be slow. Bubblesort, for example, having an +average time efficiency of O(n^2), is practically glacial compared with +Quicksort and Mergesort (which both have an average of O(n log n)). + +Here's the trick though: with small numbers the difference between these values +is minimal. For example, when n=4, Mergesort will make 6 comparisons, while +Bubblesort will make 12. A Byte holding 4 Bits is both small enough to run the +Bubblesort quickly and large enough to allow multiple opportunities for a +mistake to be corrected. + +In Robustsort we choose a Bytesize of 3 because a list of 3 Bits has some +special properties. For one thing, sorting at this length greatly reduces the +time it takes to run our slow-but-robust algorithms. For example, at this size, +Bubblesort will make only 6 comparisons. Mergesort still makes 6 as well. + +Furthermore, when making a mistake while sorting a list of 3 elements, the +mistake will displace an element by only 1 or 2 positions at most, no matter +which algorithm is used. + +This is all to say that using a 3-Bit Bytesize allows us to have our pick of +sub-algorithms to compare with! + +#### Examining Bubblesort + +Before moving further, let's talk a little about Bubblesort and why we're +using it in our SubAlgorithm. + +We've said before that Bubblesort is likely to put the last element in the +correct position of a list. Let's examine this in the context of Bubblesorting +a 3-element list. + +I ran Bubblesort 1000 times on random permutations of [1,2,3] using a faulty +comparator that gives a random result 10% of the time when comparing two +elements. Here is how often each outcome was returned: + + 94.1% <- [1,2,3] + + 2.5% <- [1,3,2] + + 3.0% <- [2,1,3] + + 0.0% <- [2,3,1] + + 0.4% <- [3,1,2] + + 0.0% <- [3,2,1] + +In these results, 97.1% of the time the TopBit was returned in the correct +position. The only results returned in which the TopBit was not in the correct +position were [1,3,2] and [3,1,2]. + +#### Rotationsort + +When choosing an algorithm to compare with Bubblesort, we want something with +substantially different logic, for the sake of robustness. We do, however, want +something similar to Bubblesort in that it compares our elements multiple +times. And as mentioned above, the element that is most important to our +sorting is the last (i.e. highest value) element, by a large degree. + +In terms of the probability of different outcomes, if our algorithm returns +an incorrect result, we want that result to be different than what Bubblesort +is likely to return. + +Keeping these priorities in mind, the algorithm we will use to compare with +Bubblesort is Rotationsort. + +The steps in Rotationsort are relatively simple: + + 1. Compare the last element with the first element. If the last element is + smaller, move it to the beginning of the list and repeat Step 1. + + 2. Compare the first two elements. If the second element is smaller, move it + to the beginning of the list and return to Step 1. + + 3. Compare the second and third elements. If the third element is smaller, + move it to the beginning of the list and return to Step 1. + + 4. Continue on in this fashion until the end of the list is reached. + + 5. Return the sorted list. + +The version we use here will be a Reverse Rotationsort. Instead of starting at +the beginning of the list and working forward, moving lower-value elements back +to the beginning, a Reverse Rotationsort starts at the end and works backward, +moving higher-value elements to the end. We do this because it yields a more +favorable spread of results to combine with Bubblesort than a Forward +Rotationsort does. + +Here are the results of running (Reverse) Rotationsort 1000 times on random +permutations of [1,2,3] using a faulty comparator that gives a random result +10% of the time when comparing two elements: + + 95.3% <- [1,2,3] + + 1.5% <- [1,3,2] + + 3.1% <- [2,1,3] + + 0.1% <- [2,3,1] + + 0.0% <- [3,1,2] + + 0.0% <- [3,2,1] + +In these results, 98.4% of the time the TopBit was returned in the correct +position The only results returned in which the TopBit was not in the correct +position were [1,3,2] and [2,3,1]. + +You may notice that one of the two problematic results returned ([2,3,1]) was +never returned by Bubblesort. In turn, Bubblesort returned one result ([3,1,2]) +that Rotationsort did not. This doesn't mean that these algorithms will never +return these results, but the chances of them doing so are very low. + +Overall, there is a modest probability (about 0.04% according to these results) +that Bubblesort and Rotationsort will agree on [1,3,2] as the result, but it is +very unlikely that they will agree on any other result that does not have the +Top Bit in the correct position. + +##### A note about [1,3,2] + +You may notice that the most common problematic result returned by both +Bubblesort and Rotationsort is [1,3,2]. Wouldn't it be better to compare with +an algorithm that doesn't return this result as often? + +It would. It seems, however, that any sorting algorithm which has [1,2,3] and +[2,1,3] as its most common results also has [1,3,2] as its third most common. +This may be inevitable due to [2,1,3] and [1,3,2] being only one adjacent +element swap away from [1,2,3]. + +I came up with Rotationsort while attempting to discover a robust sorting +algorithm that prioritizes non-adjacent swaps (compare +[Circlesort](https://youtu.be/wqibJMG42Ik?feature=shared&t=222)). If anyone +finds an algorithm that is comparable with Bubblesort and Rotationsort in terms +of both accuracy in determining the TopBit and adhering to the general rules of +this project while returning something besides [1,3,2] as its third most common +result, [I'd love to hear about it](#contact)! + + +       + +
+ Michael Caine rushing past the Batmobile +
+ Source +
+
+ +#### Introducing Supersort + +Supersort is a SubAlgorithm that compares the results of two different +sorting algorithms, in our case Bubblesort and Rotationsort. If both +algorithms agree on the result, that result is used. + +Looking at our analysis of Bubblesort and Rotationsort, we can +approximate the chances that they will agree in similar conditions: + + ~89.68% <- Agree Correctly + + ~10.19% <- Disagree + + ~0.09% <- Agree Incorrectly - TopBit correct + + ~0.04% <- Agree Incorectly - TopBit incorrect + +Hey, that's pretty good! If they agree, then return the results from +Rotationsort because if for some reason the module that compares the full Bytes +is also faulty (outside the scope of these benchmarks), Rotationsort is more +likely to have an accurate result. + +Around 10% of the time, these sub-algorithms will disagree with each other. If +this happens, we run our third sub-algorithm: Permutationsort. + +#### Permutationsort + +Permutationsort is a simple, brute-force sorting algorithm. + +As a first step we generate all the different ways the elements could possibly +be arranged in the list. Then we loop over this list of permutations until we +find one that is in the right order. + +We check if a permutation is in the right order by comparing the first two +elements. If the first element is greater, we move to the next permutation. +Otherwise (i.e. the first element is smaller), we compare the next two +elements, and so on until we either find two elements that are out of order or +we reach the end of the list, confirming that the list is in order. + +Permutationsort is a good choice for our adjudication algorithm because A) the +spread of outcomes is favorable for our needs and B) it uses logic that is +completely different from Bubblesort and Rotationsort. Using different manners +of reasoning to reach an agreed-upon answer increases the robustness of a +system. + +Here are the results of running Permutationsort 1000 times on random +permutations of [1,2,3] using a faulty comparator that gives a random result +10% of the time: + + 81.9% <- [1,2,3] + + 4.1% <- [2,1,3] + + 4.5% <- [3,1,2] + + 5.3% <- [1,3,2] + + 3.4% <- [2,3,1] + + 0.8% <- [3,2,1] + +In these cases, 86% of the time the Top Bit was in the correct position. +The least likely outcome is a reverse-sorted Byte and the other possible +incorrect outcomes are in approximately even distribution with each other. + +#### Supersort Adjudication + +Supposing that our results from Bubblesort and Rotationsort disagree and we now +have our result from Permutationsort, how do we choose which to use? + +First we check to see whether the result from Permutationsort agrees with the +results from either Bubblesort or Rotationsort. To keep things simple, let's +just look at the raw chances that Permutationsort will agree on results with +Bubblesort or Rotationsort. + +Permutationsort and Bubblesort: + + ~77.07% <- Agree Correctly + + ~28.13% <- Disagree + + ~0.14% <- Agree Incorrectly - TopBit correct + + ~0.12% <- Agree Incorectly - TopBit incorrect + +Permutationsort and Rotationsort: + + ~78.05% <- Agree Correctly + + ~21.74% <- Disagree + + ~0.14% <- Agree Incorrectly - TopBit correct + + ~0.07% <- Agree Incorectly - TopBit incorrect + +If Permutationsort agrees with either Bubblesort or Rotationsort, then it's +easy - just use that result! + +According to these results, Permutationsort is likely to disagree with both +Bubblesort and Rotationsort about 6.12% of the time if all three are run +independently. In practice, if Permutationsort is run at all it has a greater +chance than that because in order to reach that point, first either Bubblesort +or Rotationsort must have sorted the list incorrectly, which makes them less +likely to agree with Permutationsort. + +In any case, if all three sub-algorithms disagree, use the results from +Rotationsort. + +#### Recursion + +You'll remember that our standard Tensort uses a logarithmic Bytesize. Our base +Robustsort uses a Bytesize of 3, but we can use a logarithmic Bytesize by +adding recursion. + +
+ Michael Caine reaching into a cage to gently retrieve a bird. The + cage is in a larger structure of cages. The camera is viewing + from an adjacent cage and can see into multiple subsequent cages, + giving the appearance of a recursive picture-in-picture effect +
+ Source +
+
+ + +       + +Let's take our base Robustsort example above and make it recursive. + +First, instead of using a 3-Bit Bytesize, we will use a logarithmic Bytesize. +Then, instead of using our Supersort directly as our SubAlgorithm, we will use +Robustsort itself to sort the records. + +At the base case, this Robustsort will have a Bytesize of 3. If the logarithmic +Bytesize of the input list is greater than 27, then the SubAlgorithm of the +top-level Robustsort will be a recursive Robustsort with a logarithmic +Bytesize. + +The number 27 is chosen because we want a number that has a natural log that is +close to 3 (27's is about 3.3) and since 3 ^ 3 = 27, it is easy to sort lists +of 27 elements in groups of 3. + +This recursive version of Robustsort is more tailored to large input lists (in +fact, it doesn't add another layer of recursion until the input list is is +longer than 500 billion elements), but differences can be noticed when sorting +smaller lists as well. + +We now have a simple form of Robustsort: a potentially recursive Tensort with a +3-Bit base case using a Supersort adjudicating Bubblesort, Rotationsort, and +Permutationsort as its base SubAlgorithm. + +Well that's pretty cool! But I wonder... can we make this more robust, if we +relax the rules just a little more? + +Of course we can! And we will. To do so, we will replace Permutationsort with +another newly-named sorting algorithm: Magicsort! + +### Magicsort + +For our most robust iteration of Robustsort we will relax the requirement on +never re-running the same deterministic sub-algorithm in one specific context. +Magicsort is an algorithm that will re-run Permutationsort only if it disagrees +with an extremely reliable, theoretically non-deterministic algorithm - one +that's so good it's robust against logic itself... + +
+ Michael Caine and Mike Meyers looking taken aback +
+ Source +
+
+ + +       + + +...[Bogosort!](https://www.youtube.com/watch?v=kgBjXUE_Nwc&t=583) + +Magicsort simply runs both Permutationsort and Bogosort on the same input and +checks if they agree. If they do, the result is used and if not, both +algorithms are run again. This process is repeated until the two algorithms +agree on a result. + +Magicsort is based on the notion that if you happen to pull the right answer +out of a hat once, it might be random chance, but if you do it twice, it might +just be magic! + +Observant readers may have already deduced that Permutationsort functions +nearly identically to Bogosort. Here are the results of running Bogosort 1000 +times on random permutations of [1,2,3] using a faulty comparator that gives a +random result 10% of the time: + + 81.3% <- [1,2,3] + + 3.0% <- [2,1,3] + + 3.8% <- [3,1,2] + + 5.8% <- [1,3,2] + + 5.7% <- [2,3,1] + + 0.4% <- [3,2,1] + +In these cases, 84.3% of the time the Top Bit was in the correct position. +Even though both Bogosort and Permutationsort were ran with the same random +seeds, they gave slightly different results because their methodology is +slightly different. Still, the least likely outcome for Bogosort is also a +reverse-sorted Byte and the other possible incorrect outcomes are in +approximately even distribution with each other. + +Here are the results of running Magicsort 1000 times on random permutations of +[1,2,3] using a faulty comparator that gives a random result 10% of the time +when comparing two elements: + + ~94.0% <- [1,2,3] (Correct) + + ~1.5% <- [2,1,3] (Correct TopBit) + + ~1.4% <- [1,3,2] (Incorrect) + + ~1.5% <- [3,1,2] (Incorrect) + + ~1.5% <- [2,3,1] (Incorrect) + + ~0.1% <- [3,2,1] (Reverse) + +In total, 95.5% of the time we got the TopBit in the correct position, 0.1% of +the time we got a reverse-sorted list, and the other results are in almost +exactly even distribution with each other. + +You may note that [1,3,2] (the most common problematic result from earlier) +was second least common result. This is likely a fluke, but it's still pretty +neat. + +The downside here is that Magisort can take a long time to run. Thankfully, +Magicsort will only be run in our algorithm if Bubblesort and Rotationsort +disagree on an answer, and even then it only has 3 elements to sort. Overall, +the Robustsort we're building that uses Magicsort will still have an average of +O(n log n) time efficiency. + +#### Magic Robustsort SubAlgorithm alterations + +We will also make a few adjustments to our SubAlgorithms for Magic Robustsort. + +First, we will make our Reverse Rotationsort ambidextrous. This means that after each +forward comparison (with a chance to rotate the smaller element to the front +of the list), we will make a backward comparison (with a chance to rotate the +larger element to the back of the list). + +Second, we will replace Bubblesort with a Forward Ambidextrous Rotationsort. + +Finally, we will adjust our adjudication scheme, taking the Forward Ambidextrous +Rotationsort's results if there is no agreement within Supersort. + +### A note about Mundane Robustsort Subalgorithms + +It is perfectly valid to use Bogosort in place of Permutationsort in +Robustsort's standard Supersort SubAlgorithm. It may even be argued that doing +so is more robust, since Bogosort barely even relies on logic. Here are some +considerations to keep in mind: + + - Bogosort by nature re-runs on the same input multiple times. Depending on + viewpoint, this either violates the original rules I set forward or is a + major benefit + + - In testing, Robustsort with Bogosort tends to give more robust results, + though Robustsort with Permutationsort tends to run slightly faster + + - Permutationsort uses additional space due to computing all possible + permutations of the input and storing them in a list + + - If Permutaionsort incorrectly judges the correct permutation to be + incorrect, it must loop back over the entire list of permutations again + before it has another chance of giving the correct result + + - Bogosort could theoretically run forever without returning a result, even + when no errors occur + +## Comparing it all + +Now let's take a look at how everything compares. Here is a graph showing the +benchmarking results for average error score for our algorithms: + +
+ When sorting a randomly shuffled deck of cards, Quicksort makes + 202 positional errors, Mergesort makes 201, Bubblesort makes 4, Tensort + makes 51, Mundane Robustsort makes 11, and Magic Robustsort makes 1 +
+ +As shown above, when sorting a randomly shuffled deck of cards, Quicksort makes +202 positional errors, Mergesort makes 201, Bubblesort makes 4, Logarithmic +Tensort makes 51, Basic Mundane Robustsort with Bogosort adjudicator makes 11, +and Basic Magic Robustsort makes only 1! + +I'll note here that the results weren't nearly as dramatic when adding in a +stuck comparator (which gives the same answer it gave previously 50% of the +time) in addition to the wonky one (which gives a random answer 10% of the +time). Our Recursive Magic Robustsort made an average of 292 positional errors +in these conditions, which well outperformed Mergesort's 747, but was still +behind Bubblesort's 97. + +More benchmarking data can be found in the `data/` directory. Before we wrap +up, let's look at the runtimes and average error scores (with a wonky +comparator) for the largest input list (2048) I benchmarked before removing +Bubblesort from the comparisons (you may have to scroll to view the entire +information): + + ---------------------------------------------------------- + Algorithm | Time | Score | n = 2048 + Mergesort | 0.002706653s | 319199 | + Quicksort | 0.002206037s | 269252 | + Bubblesort | 67.229769894s | 707 | + TensortBL | 0.056649886s | 34223 | + RobustsortP | 0.036861441s | 21177 | + RobustsortB | 0.038692015s | 18025 | + RobustsortM | 0.046679795s | 3255 | + RobustsortRP | 0.229615609s | 15254 | + RobustsortRB | 0.22648706s | 10147 | + RobustsortRM | 0.249211013s | 1824 | + ---------------------------------------------------------- + +Well, there it is! I'm pretty happy with the results. What do you think, Sir +Michael? + +
+ Michael Caine looking upset with Michael Standing +
+ Source +
+
+ +## Library + +This package provides implementations of the following algorithms wrapped for +integer sorting: + + - Standard Logarithmic Tensort + + - Basic Robustsort with Permutationsort adjudicator + + - Basic Robustsort with Bogosort adjudicator + + - Basic Magic Robustsort + + - Recursive Robustsort with Permutationsort adjudicator + + - Recursive Robustsort with Bogosort adjudicator + + - Recursive Magic Robustsort + +It also provides many more algorithms and helper functions wrapped for both Bit +and Record sorting so you can make your own Tensort variants! + +Check the code in `src/` or the documentation on Hackage/Hoogle +for more details. + +## Development Environment + +This project is wrapped in a Nix Flake, so it's easy to hack on yourself! + +Note that (unless otherwise specified) all instructions assume you are in the +repository root, have Nix installed, and have entered the development shell. + +### Entering the Dev Shell + +Note that these instructions don't make the assumptions listed above + + * [Install Nix](https://nixos.org/download/) + * [Enable Flakes](https://nixos.wiki/wiki/Flakes) + * [Clone this repository](https://docs.github.com/en/repositories/creating-and-managing-repositories/cloning-a-repository) + * Run `nix develop` in the repository root + +### Run main test suite (QuickCheck) + + * Run `cabal test` + +### Run DocTest + + * Run `cabal repl --with-compiler=doctest` + +### Print Benchmarking Data + + * [Checkout to the 'benchmarking' + branch](https://git-scm.com/docs/git-checkout) + * Uncomment the desired benchmarking process(es) in `app/Main.hs` + * Tweak any settings desired + * Run `cabal run` + +## Contact + +Questions and feedback are welcome! + +The easiest way to contact me is usually via +[LinkedIn](https://www.linkedin.com/in/kyle-beechly), or you can try +[email](mailto:tensort@kabeech.com). + +## Thank you! + +Thank you for reading! I've had so much fun working on this project. I hope +you've enjoyed our time and that you'll continue thinking about tunable sorting +and robustness in computing. + +I'd like to send a special thank you to the following people: + + - [David H. Ackley](https://livingcomputation.com/), obviously + + - [Lu Wilson](https://www.todepond.com/), + [Jimmy Miller](https://jimmyhmiller.github.io/), and + [Ivan Reese](https://ivanish.ca/) of + [Future of Coding](https://futureofcoding.org/) (Check it out! They do my + favorite tech podcast) + + - The Haskell community at large, specifically the + [Haskell Subreddit](https://www.reddit.com/r/haskell/) and + [Portland Has Skill](https://github.com/kabeech/portland-has-skill) + + - Countless family, friends, acquaintances, and strangers who've tolerated me + blathering on about sorting algorithms over the past few months 💙 diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -1,62 +1,6 @@ module Main where -import Data.Tensort.OtherSorts.Mergesort (mergesort) -import Data.Tensort.OtherSorts.Quicksort (quicksort) -import Data.Tensort.Robustsort (robustsortB, robustsortM, robustsortP) -import Data.Tensort.Subalgorithms.Bubblesort (bubblesort) -import Data.Tensort.Tensort (tensortB4, tensortBL) -import Data.Tensort.Utils.RandomizeList (randomizeList) -import Data.Tensort.Utils.Types (Sortable (..), fromSortBit) -import Data.Time.Clock - -genUnsortedBits :: Int -> Sortable -genUnsortedBits n = randomizeList (SortBit [1 .. n]) 143 - main :: IO () main = do - -- Eventually I hope to turn that 14 into a 20 - printTimes (map (genUnsortedBits . (2 ^)) [3 .. 14]) - -printTimes :: [Sortable] -> IO () -printTimes [] = return () -printTimes (x : xs) = do - printTime x - printTimes xs - -printTime :: Sortable -> IO () -printTime l = do - putStr " Algorithm | Time | n =" - startTensortB4 <- getCurrentTime - putStrLn (" " ++ show (length (tensortB4 (fromSortBit l)))) - endTensortB4 <- getCurrentTime - putStr (" Tensort4Bit | " ++ show (diffUTCTime endTensortB4 startTensortB4) ++ " | ") - startTensortBL <- getCurrentTime - putStrLn (" " ++ show (length (tensortBL (fromSortBit l)))) - endTensortBL <- getCurrentTime - putStr (" TensortBL | " ++ show (diffUTCTime endTensortBL startTensortBL) ++ " | ") - startRSortP <- getCurrentTime - putStrLn (" " ++ show (length (robustsortP (fromSortBit l)))) - endRSortP <- getCurrentTime - putStr (" RobustsortP | " ++ show (diffUTCTime endRSortP startRSortP) ++ " | ") - startRSortB <- getCurrentTime - putStrLn (" " ++ show (length (robustsortB (fromSortBit l)))) - endRSortB <- getCurrentTime - putStr (" RobustsortB | " ++ show (diffUTCTime endRSortB startRSortB) ++ " | ") - startRSortM <- getCurrentTime - putStrLn (" " ++ show (length (robustsortM (fromSortBit l)))) - endRSortM <- getCurrentTime - putStr (" RobustsortM | " ++ show (diffUTCTime endRSortM startRSortM) ++ " | ") - startMergesort <- getCurrentTime - putStrLn (" " ++ show (length (fromSortBit (mergesort l)))) - endMergesort <- getCurrentTime - putStr (" Mergesort | " ++ show (diffUTCTime endMergesort startMergesort) ++ " | ") - startQuicksort <- getCurrentTime - putStrLn (" " ++ show (length (fromSortBit (quicksort l)))) - endQuicksort <- getCurrentTime - putStr (" Quicksort | " ++ show (diffUTCTime endQuicksort startQuicksort) ++ " | ") - startBubblesort <- getCurrentTime - putStrLn (" " ++ show (length (fromSortBit (bubblesort l)))) - endBubblesort <- getCurrentTime - putStr (" Bubblesort | " ++ show (diffUTCTime endBubblesort startBubblesort) ++ " | ") - putStrLn (" " ++ show (length (fromSortBit l))) - putStrLn "----------------------------------------------------------" + print + "To run benchmarks, switch to the 'benchmarking' branch in this repository" diff --git a/src/Data/Robustsort.hs b/src/Data/Robustsort.hs new file mode 100644 --- /dev/null +++ b/src/Data/Robustsort.hs @@ -0,0 +1,94 @@ +-- | This module provides convenience functions that wraps common Robustsort +-- functions to sort lists of Bits without dealing with type conversion +module Data.Robustsort + ( robustsortP, + robustsortB, + robustsortM, + robustsortRP, + robustsortRB, + robustsortRM, + ) +where + +import qualified Data.Tensort.Robustsort + ( robustsortB, + robustsortM, + robustsortP, + robustsortRB, + robustsortRM, + robustsortRP, + ) +import Data.Tensort.Utils.Types (Bit) +import Data.Tensort.Utils.WrapSortAlg (wrapSortAlg) + +-- | Takes a list of Bits and returns a sorted list of Bits using a Basic +-- Mundane Robustsort algorithm with a Permutationsort adjudicator +-- +-- | This is a convenience function that wraps the +-- 'Data.Tensort.Robustsort.robustsortP' function + +-- | ==== __Examples__ +-- >>> robustsortP [16, 23, 4, 8, 15, 42] +-- [4,8,15,16,23,42] +robustsortP :: [Bit] -> [Bit] +robustsortP = wrapSortAlg Data.Tensort.Robustsort.robustsortP + +-- | Takes a list of Bits and returns a sorted list of Bits using a Basic +-- Mundane Robustsort algorithm with a Bogosort adjudicator +-- +-- | This is a convenience function that wraps the +-- 'Data.Tensort.Robustsort.robustsortB' function + +-- | ==== __Examples__ +-- >>> robustsortB [16, 23, 4, 8, 15, 42] +-- [4,8,15,16,23,42] +robustsortB :: [Bit] -> [Bit] +robustsortB = wrapSortAlg Data.Tensort.Robustsort.robustsortB + +-- | Takes a list of Bits and returns a sorted list of Bits using a Basic +-- Magic Robustsort algorithm +-- +-- | This is a convenience function that wraps the +-- 'Data.Tensort.Robustsort.robustsortM' function + +-- | ==== __Examples__ +-- >>> robustsortM [16, 23, 4, 8, 15, 42] +-- [4,8,15,16,23,42] +robustsortM :: [Bit] -> [Bit] +robustsortM = wrapSortAlg Data.Tensort.Robustsort.robustsortM + +-- | Takes a list of Bits and returns a sorted list of Bits using a Recursive +-- Mundane Robustsort algorithm with a Permutationsort adjudicator +-- +-- | This is a convenience function that wraps the +-- 'Data.Tensort.Robustsort.robustsortRP' function + +-- | ==== __Examples__ +-- >>> robustsortRP [16, 23, 4, 8, 15, 42] +-- [4,8,15,16,23,42] +robustsortRP :: [Bit] -> [Bit] +robustsortRP = wrapSortAlg Data.Tensort.Robustsort.robustsortRP + +-- | Takes a list of Bits and returns a sorted list of Bits using a Recursive +-- Mundane Robustsort algorithm with a Bogosort adjudicator +-- +-- | This is a convenience function that wraps the +-- 'Data.Tensort.Robustsort.robustsortRB' function + +-- | ==== __Examples__ +-- >>> robustsortRB [16, 23, 4, 8, 15, 42] +-- [4,8,15,16,23,42] +robustsortRB :: [Bit] -> [Bit] +robustsortRB = wrapSortAlg Data.Tensort.Robustsort.robustsortRB + +-- | Takes a list of Bits and returns a sorted list of Bits using a Recursive +-- Magic Robustsort algorithm +-- +-- | This is a convenience function that wraps the +-- 'Data.Tensort.Robustsort.robustsortRM' function + +-- | ==== __Examples__ +-- >>> robustsortRM [16, 23, 4, 8, 15, 42] +-- [4,8,15,16,23,42] +robustsortRM :: [Bit] -> [Bit] +robustsortRM = wrapSortAlg Data.Tensort.Robustsort.robustsortRM diff --git a/src/Data/Tensort.hs b/src/Data/Tensort.hs --- a/src/Data/Tensort.hs +++ b/src/Data/Tensort.hs @@ -1,6 +1,21 @@ +-- | This module provides convenience functions that wraps common Tensort +-- functions to sort lists of Bits without dealing with type conversion module Data.Tensort - ( module Data.Tensort.Tensort, + ( tensort, ) where -import Data.Tensort.Tensort +import Data.Tensort.Tensort (tensortBL) +import Data.Tensort.Utils.Types (Bit) +import Data.Tensort.Utils.WrapSortAlg (wrapSortAlg) + +-- | Takes a list of Bits and returns a sorted list of Bits using a Standard +-- Logarithmic Tensort algorithm +-- +-- | This is a convenience function that wraps the 'tensortBL' function + +-- | ==== __Examples__ +-- >>> tensort [16, 23, 4, 8, 15, 42] +-- [4,8,15,16,23,42] +tensort :: [Bit] -> [Bit] +tensort = wrapSortAlg tensortBL diff --git a/src/Data/Tensort/OtherSorts/Mergesort.hs b/src/Data/Tensort/OtherSorts/Mergesort.hs --- a/src/Data/Tensort/OtherSorts/Mergesort.hs +++ b/src/Data/Tensort/OtherSorts/Mergesort.hs @@ -1,8 +1,18 @@ +-- | This module provides the mergesort function for sorting lists using the +-- Sortable type module Data.Tensort.OtherSorts.Mergesort (mergesort) where import Data.Tensort.Utils.ComparisonFunctions (lessThanBit, lessThanRecord) -import Data.Tensort.Utils.Types (Record, Sortable (..), Bit) +import Data.Tensort.Utils.Types (Bit, Record, Sortable (..)) +-- | Takes a Sortable and returns a sorted Sortable using a Mergesort algorithm + +-- | ==== __Examples__ +-- >>> mergesort (SortBit [16, 23, 4, 8, 15, 42]) +-- SortBit [4,8,15,16,23,42] +-- +-- >>> mergesort (SortRec [(1, 16), (5, 23), (2, 4) ,(3, 8), (0, 15) , (4, 42)]) +-- SortRec [(2,4),(3,8),(0,15),(1,16),(5,23),(4,42)] mergesort :: Sortable -> Sortable mergesort (SortBit xs) = SortBit (mergesortBits xs) mergesort (SortRec xs) = SortRec (mergesortRecs xs) diff --git a/src/Data/Tensort/OtherSorts/Quicksort.hs b/src/Data/Tensort/OtherSorts/Quicksort.hs --- a/src/Data/Tensort/OtherSorts/Quicksort.hs +++ b/src/Data/Tensort/OtherSorts/Quicksort.hs @@ -1,16 +1,56 @@ +-- | This module provides the quicksort function for sorting lists using the +-- Sortable type module Data.Tensort.OtherSorts.Quicksort (quicksort) where -import Data.Tensort.Utils.ComparisonFunctions (greaterThanBit, greaterThanRecord, lessThanOrEqualBit, lessThanOrEqualRecord) -import Data.Tensort.Utils.Types (Sortable (..), fromSortBit, fromSortRec) +import Data.Tensort.Utils.ComparisonFunctions (greaterThanBit, greaterThanRecord) +import Data.Tensort.Utils.Types (Bit, Record, Sortable (..)) +-- | Takes a Sortable and returns a sorted Sortable using a Quicksort algorithm + +-- | ==== __Examples__ +-- >>> quicksort (SortBit [16, 23, 4, 8, 15, 42]) +-- SortBit [4,8,15,16,23,42] +-- +-- >>> quicksort (SortRec [(1, 16), (5, 23), (2, 4) ,(3, 8), (0, 15) , (4, 42)]) +-- SortRec [(2,4),(3,8),(0,15),(1,16),(5,23),(4,42)] quicksort :: Sortable -> Sortable quicksort (SortBit []) = SortBit [] -quicksort (SortBit (x : xs)) = - let lowerPartition = quicksort (SortBit [a | a <- xs, lessThanOrEqualBit a x]) - upperPartition = quicksort (SortBit [a | a <- xs, greaterThanBit a x]) - in SortBit (fromSortBit lowerPartition ++ [x] ++ fromSortBit upperPartition) +quicksort (SortBit [x]) = SortBit [x] +quicksort (SortBit xs) = SortBit (quicksortBits xs) quicksort (SortRec []) = SortRec [] -quicksort (SortRec (x : xs)) = - let lowerPartition = quicksort (SortRec [a | a <- xs, lessThanOrEqualRecord a x]) - upperPartition = quicksort (SortRec [a | a <- xs, greaterThanRecord a x]) - in SortRec (fromSortRec lowerPartition ++ [x] ++ fromSortRec upperPartition) +quicksort (SortRec [x]) = SortRec [x] +quicksort (SortRec xs) = SortRec (quicksortRecs xs) + +quicksortBits :: [Bit] -> [Bit] +quicksortBits [] = [] +quicksortBits [x] = [x] +quicksortBits xs = + let (lower, pivot, upper) = getPartitionsBits xs + in quicksortBits lower ++ [pivot] ++ quicksortBits upper + +getPartitionsBits :: [Bit] -> ([Bit], Bit, [Bit]) +getPartitionsBits [] = error "From getPartitionsBits: empty input list" +getPartitionsBits [x] = ([], x, []) +getPartitionsBits (x : xs) = foldr acc ([], x, []) xs + where + acc :: Bit -> ([Bit], Bit, [Bit]) -> ([Bit], Bit, [Bit]) + acc y (lower, pivot, upper) + | greaterThanBit y pivot = (lower, pivot, y : upper) + | otherwise = (y : lower, pivot, upper) + +quicksortRecs :: [Record] -> [Record] +quicksortRecs [] = [] +quicksortRecs [x] = [x] +quicksortRecs xs = + let (lower, pivot, upper) = getPartitionsRecs xs + in quicksortRecs lower ++ [pivot] ++ quicksortRecs upper + +getPartitionsRecs :: [Record] -> ([Record], Record, [Record]) +getPartitionsRecs [] = error "From getPartitionsRecs: empty input list" +getPartitionsRecs [x] = ([], x, []) +getPartitionsRecs (x : xs) = foldr acc ([], x, []) xs + where + acc :: Record -> ([Record], Record, [Record]) -> ([Record], Record, [Record]) + acc y (lower, pivot, upper) + | greaterThanRecord y pivot = (lower, pivot, y : upper) + | otherwise = (y : lower, pivot, upper) diff --git a/src/Data/Tensort/Robustsort.hs b/src/Data/Tensort/Robustsort.hs --- a/src/Data/Tensort/Robustsort.hs +++ b/src/Data/Tensort/Robustsort.hs @@ -1,7 +1,13 @@ +-- | This module provides variations of the Robustsort algorithm using the +-- Sortable type module Data.Tensort.Robustsort ( robustsortP, robustsortB, robustsortM, + robustsortRCustom, + robustsortRP, + robustsortRB, + robustsortRM, ) where @@ -9,25 +15,131 @@ import Data.Tensort.Subalgorithms.Bubblesort (bubblesort) import Data.Tensort.Subalgorithms.Magicsort (magicsort) import Data.Tensort.Subalgorithms.Permutationsort (permutationsort) -import Data.Tensort.Subalgorithms.Exchangesort (exchangesort) -import Data.Tensort.Subalgorithms.Supersort (magicSuperStrat, mundaneSuperStrat, supersort) -import Data.Tensort.Tensort (mkTSProps, tensort) -import Data.Tensort.Utils.Types (Sortable, Bit) +import Data.Tensort.Subalgorithms.Rotationsort + ( rotationsortAmbi, + rotationsortReverse, + rotationsortReverseAmbi, + ) +import Data.Tensort.Subalgorithms.Supersort + ( magicSuperStrat, + mundaneSuperStrat, + supersort, + ) +import Data.Tensort.Tensort (tensort) +import Data.Tensort.Utils.MkTsProps (mkTsProps) +import Data.Tensort.Utils.Types (SortAlg, Sortable (..)) -robustsortP :: [Bit] -> [Bit] -robustsortP xs = tensort xs (mkTSProps 3 supersortP) +-- | Takes a Sortable and returns a sorted Sortable using a Recursive Mundane +-- Robustsort algorithm with a Permutationsort adjudicator +-- | ==== __Examples__ +-- >>> robustsortRP (SortBit [16, 23, 4, 8, 15, 42]) +-- SortBit [4,8,15,16,23,42] +robustsortRP :: Sortable -> Sortable +robustsortRP = robustsortRCustom robustsortP + +-- | Takes a Sortable and returns a sorted Sortable using a Basic Mundane +-- Robustsort algorithm with a Permutationsort adjudicator + +-- | ==== __Examples__ +-- >>> robustsortP (SortBit [16, 23, 4, 8, 15, 42]) +-- SortBit [4,8,15,16,23,42] +robustsortP :: Sortable -> Sortable +robustsortP = tensort (mkTsProps 3 supersortP) + supersortP :: Sortable -> Sortable -supersortP xs = supersort xs (bubblesort, exchangesort, permutationsort, mundaneSuperStrat) +supersortP = + supersort + ( rotationsortReverse, + bubblesort, + permutationsort, + mundaneSuperStrat + ) -robustsortB :: [Bit] -> [Bit] -robustsortB xs = tensort xs (mkTSProps 3 supersortB) +-- | Takes a Sortable and returns a sorted Sortable using a Recursive Mundane +-- Robustsort algorithm with a Bogosort adjudicator +-- | ==== __Examples__ +-- >>> robustsortRB (SortBit [16, 23, 4, 8, 15, 42]) +-- SortBit [4,8,15,16,23,42] +robustsortRB :: Sortable -> Sortable +robustsortRB = robustsortRCustom robustsortB + +-- | Takes a Sortable and returns a sorted Sortable using a Basic Mundane +-- Robustsort algorithm with a Bogosort adjudicator + +-- | ==== __Examples__ +-- >>> robustsortB (SortBit [16, 23, 4, 8, 15, 42]) +-- SortBit [4,8,15,16,23,42] +robustsortB :: Sortable -> Sortable +robustsortB = tensort (mkTsProps 3 supersortB) + supersortB :: Sortable -> Sortable -supersortB xs = supersort xs (bubblesort, exchangesort, bogosort, mundaneSuperStrat) +supersortB = + supersort + ( rotationsortReverse, + bubblesort, + bogosort, + mundaneSuperStrat + ) -robustsortM :: [Bit] -> [Bit] -robustsortM xs = tensort xs (mkTSProps 3 supersortM) +-- | Takes a Sortable and returns a sorted Sortable using a Recursive Magic +-- Robustsort algorithm +-- | ==== __Examples__ +-- >>> robustsortRM (SortBit [16, 23, 4, 8, 15, 42]) +-- SortBit [4,8,15,16,23,42] +robustsortRM :: Sortable -> Sortable +robustsortRM = robustsortRCustom robustsortM + +-- | Takes a Sortable and returns a sorted Sortable using a Basic Magic +-- Robustsort algorithm + +-- | ==== __Examples__ +-- >>> robustsortM (SortBit [16, 23, 4, 8, 15, 42]) +-- SortBit [4,8,15,16,23,42] +robustsortM :: Sortable -> Sortable +robustsortM = tensort (mkTsProps 3 supersortM) + supersortM :: Sortable -> Sortable -supersortM xs = supersort xs (bubblesort, exchangesort, magicsort, magicSuperStrat) +supersortM = + supersort + ( rotationsortAmbi, + rotationsortReverseAmbi, + magicsort, + magicSuperStrat + ) + +-- | Used for making recursive Robustsort algorithms +robustsortRCustom :: SortAlg -> Sortable -> Sortable +robustsortRCustom baseSortAlg xs = + tensort + ( mkTsProps + (getLnBytesize xs) + (robustsortRecursive (getLnBytesize xs) baseSortAlg) + ) + xs + +getLnBytesize :: Sortable -> Int +getLnBytesize (SortBit xs) = getLn (length xs) +getLnBytesize (SortRec xs) = getLn (length xs) + +getLn :: Int -> Int +getLn x = ceiling (log (fromIntegral x) :: Double) + +robustsortRecursive :: Int -> SortAlg -> SortAlg +robustsortRecursive bytesize baseSortAlg + -- ln (532048240602) ~= 27 + -- ln (27) ~= 3 + -- 3 ^ 3 = 27 + -- So this is saying, if we have a bitesize of 532,048,240,602 or less, use + -- one more iteration of Tensort to sort the records. This last iteration + -- will use the baseSortAlg (which by default is a standard version of + -- Robustsort with a bytesize of 3) to sort its records. + | bytesize <= 27 = baseSortAlg + | otherwise = + tensort + ( mkTsProps + (getLn bytesize) + (robustsortRecursive (getLn bytesize) baseSortAlg) + ) diff --git a/src/Data/Tensort/Subalgorithms/Bogosort.hs b/src/Data/Tensort/Subalgorithms/Bogosort.hs --- a/src/Data/Tensort/Subalgorithms/Bogosort.hs +++ b/src/Data/Tensort/Subalgorithms/Bogosort.hs @@ -1,13 +1,33 @@ +-- | This module provides the bogosort function for sorting lists using the +-- Sortable type module Data.Tensort.Subalgorithms.Bogosort (bogosort, bogosortSeeded) where import Data.Tensort.Utils.Check (isSorted) import Data.Tensort.Utils.RandomizeList (randomizeList) import Data.Tensort.Utils.Types (Sortable (..)) +-- | Takes a Sortable and returns a sorted Sortable using a Bogosort algorithm +-- using the default seed for random generation + +-- | ==== __Examples__ +-- >>> bogosort (SortBit [16, 23, 4, 8, 15, 42]) +-- SortBit [4,8,15,16,23,42] +-- +-- >>> bogosort (SortRec [(1, 16), (5, 23), (2, 4) ,(3, 8), (0, 15) , (4, 42)]) +-- SortRec [(2,4),(3,8),(0,15),(1,16),(5,23),(4,42)] bogosort :: Sortable -> Sortable -bogosort xs = bogosortSeeded xs 143 +bogosort = bogosortSeeded 143 -bogosortSeeded :: Sortable -> Int -> Sortable -bogosortSeeded xs seed +-- | Takes a seed for use in random generation and a Sortable and returns a +-- sorted Sortable using a Bogosort algorithm + +-- | ==== __Examples__ +-- >>> bogosortSeeded 42 (SortBit [16, 23, 4, 8, 15, 42]) +-- SortBit [4,8,15,16,23,42] +-- +-- >>> bogosortSeeded 24 (SortRec [(1, 16), (5, 23), (2, 4) ,(3, 8), (0, 15) , (4, 42)]) +-- SortRec [(2,4),(3,8),(0,15),(1,16),(5,23),(4,42)] +bogosortSeeded :: Int -> Sortable -> Sortable +bogosortSeeded seed xs | isSorted xs = xs - | otherwise = bogosortSeeded (randomizeList xs seed) (seed + 1) + | otherwise = bogosortSeeded (seed + 1) (randomizeList seed xs) diff --git a/src/Data/Tensort/Subalgorithms/Bubblesort.hs b/src/Data/Tensort/Subalgorithms/Bubblesort.hs --- a/src/Data/Tensort/Subalgorithms/Bubblesort.hs +++ b/src/Data/Tensort/Subalgorithms/Bubblesort.hs @@ -1,21 +1,46 @@ +-- | This module provides the bubblesort function for sorting lists using the +-- Sortable type module Data.Tensort.Subalgorithms.Bubblesort (bubblesort) where -import Data.Tensort.Utils.ComparisonFunctions (lessThanBit, lessThanRecord) -import Data.Tensort.Utils.Types (Record, Sortable (..), Bit) +import Data.Tensort.Utils.ComparisonFunctions + ( greaterThanBit, + greaterThanRecord, + ) +import Data.Tensort.Utils.Types (Sortable (..)) +-- | Takes a Sortable and returns a sorted Sortable using a Bubblesort +-- algorithm + +-- | ==== __Examples__ +-- >>> bubblesort (SortBit [16, 23, 4, 8, 15, 42]) +-- SortBit [4,8,15,16,23,42] +-- +-- >>> bubblesort (SortRec [(1, 16), (5, 23), (2, 4) ,(3, 8), (0, 15) , (4, 42)]) +-- SortRec [(2,4),(3,8),(0,15),(1,16),(5,23),(4,42)] bubblesort :: Sortable -> Sortable -bubblesort (SortBit bits) = SortBit (foldr acc [] bits) - where - acc :: Bit -> [Bit] -> [Bit] - acc x xs = bubblesortSinglePass x xs lessThanBit -bubblesort (SortRec recs) = SortRec (foldr acc [] recs) - where - acc :: Record -> [Record] -> [Record] - acc x xs = bubblesortSinglePass x xs lessThanRecord +bubblesort (SortBit bits) = + SortBit + ( bublesortIterable greaterThanBit bits 0 (length bits) + ) +bubblesort (SortRec recs) = + SortRec + ( bublesortIterable greaterThanRecord recs 0 (length recs) + ) -bubblesortSinglePass :: a -> [a] -> (a -> a -> Bool) -> [a] -bubblesortSinglePass x [] _ = [x] -bubblesortSinglePass x (y : remaningElements) lessThan = do - if lessThan x y - then x : bubblesortSinglePass y remaningElements lessThan - else y : bubblesortSinglePass x remaningElements lessThan +bublesortIterable :: (Ord a) => (a -> a -> Bool) -> [a] -> Int -> Int -> [a] +bublesortIterable greaterThan xs currentIndex i + | length xs < 2 = xs + | i < 1 = + xs + | currentIndex > length xs - 2 = + bublesortIterable greaterThan xs 0 (i - 1) + | otherwise = + let left = take currentIndex xs + right = drop (currentIndex + 2) xs + x = xs !! currentIndex + y = xs !! (currentIndex + 1) + leftElemGreater = greaterThan x y + swappedXs = left ++ [y] ++ [x] ++ right + in if leftElemGreater + then bublesortIterable greaterThan swappedXs (currentIndex + 1) i + else bublesortIterable greaterThan xs (currentIndex + 1) i diff --git a/src/Data/Tensort/Subalgorithms/Exchangesort.hs b/src/Data/Tensort/Subalgorithms/Exchangesort.hs --- a/src/Data/Tensort/Subalgorithms/Exchangesort.hs +++ b/src/Data/Tensort/Subalgorithms/Exchangesort.hs @@ -1,31 +1,41 @@ +-- | This module provides the bubblesort function for sorting lists using the +-- Sortable type module Data.Tensort.Subalgorithms.Exchangesort (exchangesort) where import Data.Tensort.Utils.ComparisonFunctions (greaterThanBit, greaterThanRecord) import Data.Tensort.Utils.Types (Sortable (..)) -exchangesort :: Sortable -> Sortable -exchangesort (SortBit bits) = SortBit (exchangesortIterable bits (length bits - 1) (length bits - 2) greaterThanBit) -exchangesort (SortRec recs) = SortRec (exchangesortIterable recs (length recs - 1) (length recs - 2) greaterThanRecord) +-- | Takes a Sortable and returns a sorted Sortable using an Exchangesort +-- algorithm -exchangesortIterable :: [a] -> Int -> Int -> (a -> a -> Bool) -> [a] -exchangesortIterable xs i j greaterThan = do - if i < 0 - then xs - else - if j < 0 - then exchangesortIterable xs (i - 1) (length xs - 1) greaterThan - else - if ((i > j) && greaterThan (xs !! j) (xs !! i)) || ((j > i) && greaterThan (xs !! i) (xs !! j)) - then exchangesortIterable (swap xs i j) i (j - 1) greaterThan - else exchangesortIterable xs i (j - 1) greaterThan +-- | ==== __Examples__ +-- >>> exchangesort (SortBit [16, 23, 4, 8, 15, 42]) +-- SortBit [4,8,15,16,23,42] +-- +-- >>> exchangesort (SortRec [(1, 16), (5, 23), (2, 4) ,(3, 8), (0, 15) , (4, 42)]) +-- SortRec [(2,4),(3,8),(0,15),(1,16),(5,23),(4,42)] +exchangesort :: Sortable -> Sortable +exchangesort (SortBit bits) = SortBit (exchangesortIterable greaterThanBit bits 0 (length bits - 1)) +exchangesort (SortRec recs) = SortRec (exchangesortIterable greaterThanRecord recs 0 (length recs - 1)) -swap :: [a] -> Int -> Int -> [a] -swap xs i j = do - let x = xs !! i - let y = xs !! j - let mini = min i j - let maxi = max i j - let left = take mini xs - let middle = take (maxi - mini - 1) (drop (mini + 1) xs) - let right = drop (maxi + 1) xs - left ++ [y] ++ middle ++ [x] ++ right +exchangesortIterable :: (Ord a) => (a -> a -> Bool) -> [a] -> Int -> Int -> [a] +exchangesortIterable greaterThan xs i j + | i > length xs - 1 = + xs + | j < 0 = + exchangesortIterable greaterThan xs (i + 1) (length xs - 1) + | i == j = + exchangesortIterable greaterThan xs i (j - 1) + | otherwise = + let mini = min i j + maxi = max i j + left = take mini xs + middle = take (maxi - mini - 1) (drop (mini + 1) xs) + right = drop (maxi + 1) xs + x = xs !! mini + y = xs !! maxi + leftElemGreater = greaterThan x y + swappedXs = left ++ [y] ++ middle ++ [x] ++ right + in if leftElemGreater + then exchangesortIterable greaterThan swappedXs i (j - 1) + else exchangesortIterable greaterThan xs i (j - 1) diff --git a/src/Data/Tensort/Subalgorithms/Magicsort.hs b/src/Data/Tensort/Subalgorithms/Magicsort.hs --- a/src/Data/Tensort/Subalgorithms/Magicsort.hs +++ b/src/Data/Tensort/Subalgorithms/Magicsort.hs @@ -1,3 +1,5 @@ +-- | This module provides the magicsort function for sorting lists using the +-- Sortable type module Data.Tensort.Subalgorithms.Magicsort ( magicsort, ) @@ -7,6 +9,17 @@ import Data.Tensort.Subalgorithms.Permutationsort (permutationsort) import Data.Tensort.Utils.Types (Sortable (..)) +-- | Takes a Sortable and returns a sorted Sortable +-- +-- | Adjudicates between three other sorting algorithms to return a robust +-- solution + +-- | ==== __Examples__ +-- >>> magicsort (SortBit [16, 23, 4, 8, 15, 42]) +-- SortBit [4,8,15,16,23,42] +-- +-- >>> magicsort (SortRec [(1, 16), (5, 23), (2, 4) ,(3, 8), (0, 15) , (4, 42)]) +-- SortRec [(2,4),(3,8),(0,15),(1,16),(5,23),(4,42)] magicsort :: Sortable -> Sortable magicsort xs = do let result1 = permutationsort xs diff --git a/src/Data/Tensort/Subalgorithms/Permutationsort.hs b/src/Data/Tensort/Subalgorithms/Permutationsort.hs --- a/src/Data/Tensort/Subalgorithms/Permutationsort.hs +++ b/src/Data/Tensort/Subalgorithms/Permutationsort.hs @@ -1,15 +1,33 @@ +-- | This module provides the permutationsort function for sorting lists using the +-- Sortable type module Data.Tensort.Subalgorithms.Permutationsort (permutationsort) where import Data.List (permutations) import Data.Tensort.Utils.Check (isSorted) -import Data.Tensort.Utils.Types (Record, Sortable (..), fromSortBit, fromSortRec, Bit) +import Data.Tensort.Utils.Types + ( Bit, + Record, + Sortable (..), + fromSortBit, + fromSortRec, + ) +-- | Takes a Sortable and returns a sorted Sortable using a Permutationsort +-- algorithm + +-- | ==== __Examples__ +-- >>> permutationsort (SortBit [16, 23, 4, 8, 15, 42]) +-- SortBit [4,8,15,16,23,42] +-- +-- >>> permutationsort (SortRec [(1, 16), (5, 23), (2, 4) ,(3, 8), (0, 15) , (4, 42)]) +-- SortRec [(2,4),(3,8),(0,15),(1,16),(5,23),(4,42)] permutationsort :: Sortable -> Sortable permutationsort (SortBit xs) = SortBit (acc (permutations x) []) where x = xs acc :: [[Bit]] -> [Bit] -> [Bit] - acc [] unsortedPermutations = fromSortBit (permutationsort (SortBit unsortedPermutations)) + acc [] unsortedPermutations = + fromSortBit (permutationsort (SortBit unsortedPermutations)) acc (permutation : remainingPermutations) unsortedPermutations | isSorted (SortBit permutation) = permutation | otherwise = acc remainingPermutations unsortedPermutations @@ -17,7 +35,8 @@ where x = xs acc :: [[Record]] -> [Record] -> [Record] - acc [] unsortedPermutations = fromSortRec (permutationsort (SortRec unsortedPermutations)) + acc [] unsortedPermutations = + fromSortRec (permutationsort (SortRec unsortedPermutations)) acc (permutation : remainingPermutations) unsortedPermutations | isSorted (SortRec permutation) = permutation | otherwise = acc remainingPermutations unsortedPermutations diff --git a/src/Data/Tensort/Subalgorithms/Rotationsort.hs b/src/Data/Tensort/Subalgorithms/Rotationsort.hs new file mode 100644 --- /dev/null +++ b/src/Data/Tensort/Subalgorithms/Rotationsort.hs @@ -0,0 +1,374 @@ +-- | This module provides Rotationsort variants for sorting lists using the +-- Sortable type +-- +-- | I was having some issues with the swaps for larger input lists, so for now +-- these functions are only implemented for lists of length 3 or less. +module Data.Tensort.Subalgorithms.Rotationsort + ( rotationsort, + rotationsortAmbi, + rotationsortReverse, + rotationsortReverseAmbi, + ) +where + +import Data.Tensort.Utils.ComparisonFunctions + ( greaterThanOrEqualBit, + greaterThanOrEqualRecord, + ) +import Data.Tensort.Utils.Types (Sortable (..)) + +-- | Takes a Sortable and returns a sorted Sortable using a Rotationsort +-- algorithm +-- +-- I was having some issues with the swaps for larger input lists, so for now +-- this function is only implemented for lists of length 3 or less. + +-- | ==== __Examples__ +-- >>> rotationsort (SortBit [1,3,2]) +-- SortBit [1,2,3] +-- +-- >>> rotationsort (SortRec [(3, 1), (1, 3), (2, 2)]) +-- SortRec [(3,1),(2,2),(1,3)] +rotationsort :: Sortable -> Sortable +rotationsort (SortBit bits) = + let result = + rotationsortIterable greaterThanOrEqualBit bits 0 False False + in SortBit result +rotationsort (SortRec recs) = + let result = + rotationsortIterable greaterThanOrEqualRecord recs 0 False False + in SortRec result + +-- | Takes a Sortable and returns a sorted Sortable using an Ambidextrous +-- Rotationsort algorithm +-- +-- I was having some issues with the swaps for larger input lists, so for now +-- this function is only implemented for lists of length 3 or less. + +-- | ==== __Examples__ +-- >>> rotationsortAmbi (SortBit [1,3,2]) +-- SortBit [1,2,3] +-- +-- >>> rotationsortAmbi (SortRec [(3, 1), (1, 3), (2, 2)]) +-- SortRec [(3,1),(2,2),(1,3)] +rotationsortAmbi :: Sortable -> Sortable +rotationsortAmbi (SortBit bits) = + let result = + rotationsortIterable greaterThanOrEqualBit bits 0 True False + in SortBit result +rotationsortAmbi (SortRec recs) = + let result = + rotationsortIterable greaterThanOrEqualRecord recs 0 True False + in SortRec result + +-- | Takes a Sortable and returns a sorted Sortable using a Reverse +-- Rotationsort algorithm +-- +-- I was having some issues with the swaps for larger input lists, so for now +-- this function is only implemented for lists of length 3 or less. + +-- | ==== __Examples__ +-- >>> rotationsortReverse (SortBit [1,3,2]) +-- SortBit [1,2,3] +-- +-- >>> rotationsortReverse (SortRec [(3, 1), (1, 3), (2, 2)]) +-- SortRec [(3,1),(2,2),(1,3)] +rotationsortReverse :: Sortable -> Sortable +rotationsortReverse (SortBit bits) = + let result = + rotationsortIterable + greaterThanOrEqualBit + bits + (length bits - 1) + False + True + in SortBit result +rotationsortReverse (SortRec recs) = + let result = + rotationsortIterable + greaterThanOrEqualRecord + recs + (length recs - 1) + False + True + in SortRec result + +-- | Takes a Sortable and returns a sorted Sortable using an Ambidextrous +-- Reverse Rotationsort algorithm +-- +-- I was having some issues with the swaps for larger input lists, so for now +-- this function is only implemented for lists of length 3 or less. + +-- | ==== __Examples__ +-- >>> rotationsortReverseAmbi (SortBit [1,3,2]) +-- SortBit [1,2,3] +-- +-- >>> rotationsortReverseAmbi (SortRec [(3, 1), (1, 3), (2, 2)]) +-- SortRec [(3,1),(2,2),(1,3)] +rotationsortReverseAmbi :: Sortable -> Sortable +rotationsortReverseAmbi (SortBit bits) = + let result = + rotationsortIterable + greaterThanOrEqualBit + bits + (length bits - 1) + True + True + in SortBit result +rotationsortReverseAmbi (SortRec recs) = + let result = + rotationsortIterable + greaterThanOrEqualRecord + recs + (length recs - 1) + True + True + in SortRec result + +rotationsortIterable :: + (Ord a) => + (a -> a -> Bool) -> + [a] -> + Int -> + Bool -> + Bool -> + [a] +rotationsortIterable greaterThanOrEqual xs currentIndex isAmbi isReverse + | length xs > 3 = + error + "From rotationsortIterable: algorithm not yet implemented for lists of length greater than 3" + | currentIndex < 0 || currentIndex >= length xs = + xs + | length xs < 2 = xs + | length xs == 2 = + rotatationsortPair greaterThanOrEqual xs currentIndex isAmbi isReverse + | currentIndex == firstIndex (length xs) isReverse = + rotationsortHead greaterThanOrEqual xs currentIndex isAmbi isReverse + | currentIndex == lastIndex (length xs) isReverse = + rotationsortLast greaterThanOrEqual xs currentIndex isAmbi isReverse + | otherwise = + rotationsortMiddle greaterThanOrEqual xs currentIndex isAmbi isReverse + +rotatationsortPair :: + (Ord a) => + (a -> a -> Bool) -> + [a] -> + Int -> + Bool -> + Bool -> + [a] +rotatationsortPair greaterThanOrEqual xs currentIndex isAmbi isReverse = + let x = head xs + y = xs !! 1 + secondElemGreater = greaterThanOrEqual y x + swappedXs = y : [x] + in switch secondElemGreater swappedXs + where + switch secondElemGreater swappedXs + | not secondElemGreater = + rotationsortIterable + greaterThanOrEqual + swappedXs + (firstIndex (length xs) isReverse) + isAmbi + isReverse + | otherwise = + rotationsortIterable + greaterThanOrEqual + xs + (nextIndex currentIndex isReverse) + isAmbi + isReverse + +rotationsortHead :: + (Ord a) => + (a -> a -> Bool) -> + [a] -> + Int -> + Bool -> + Bool -> + [a] +rotationsortHead greaterThanOrEqual xs currentIndex isAmbi isReverse = + let w = xs !! lastIndex (length xs) isReverse + x = xs !! currentIndex + y = xs !! nextIndex currentIndex isReverse + rotateToFirst = + if isReverse then [y] ++ [x] ++ [w] else [w] ++ [x] ++ [y] + rotateBackward = + if isReverse then [w] ++ [x] ++ [y] else [y] ++ [x] ++ [w] + in switch + rotateToFirst + rotateBackward + where + switch + rotateToFirst + rotateBackward + | not (lastElemOrdered greaterThanOrEqual xs currentIndex isReverse) = + rotationsortIterable + greaterThanOrEqual + rotateToFirst + (firstIndex (length xs) isReverse) + isAmbi + isReverse + | not (nextElemOrdered greaterThanOrEqual xs currentIndex isReverse) = + rotationsortIterable + greaterThanOrEqual + rotateBackward + (firstIndex (length xs) isReverse) + isAmbi + isReverse + | otherwise = + rotationsortIterable + greaterThanOrEqual + xs + (nextIndex currentIndex isReverse) + isAmbi + isReverse + +rotationsortMiddle :: + (Ord a) => + (a -> a -> Bool) -> + [a] -> + Int -> + Bool -> + Bool -> + [a] +rotationsortMiddle greaterThanOrEqual xs currentIndex isAmbi isReverse = + let w = xs !! prevIndex currentIndex isReverse + x = xs !! currentIndex + y = xs !! nextIndex currentIndex isReverse + rotateBackward = + if isReverse then [x] ++ [y] ++ [w] else [y] ++ [w] ++ [x] + rotateForward = + if isReverse then [y] ++ [w] ++ [x] else [x] ++ [y] ++ [w] + in switch + rotateBackward + rotateForward + where + switch + rotateBackward + rotateForward + | not (nextElemOrdered greaterThanOrEqual xs currentIndex isReverse) = + rotationsortIterable + greaterThanOrEqual + rotateBackward + (firstIndex (length xs) isReverse) + isAmbi + isReverse + | not isAmbi = + rotationsortIterable + greaterThanOrEqual + xs + (nextIndex currentIndex isReverse) + isAmbi + isReverse + | not (prevElemOrdered greaterThanOrEqual xs currentIndex isReverse) = + rotationsortIterable + greaterThanOrEqual + rotateForward + (prevIndex currentIndex isReverse) + isAmbi + isReverse + | otherwise = + rotationsortIterable + greaterThanOrEqual + xs + (nextIndex currentIndex isReverse) + isAmbi + isReverse + +rotationsortLast :: + (Ord a) => + (a -> a -> Bool) -> + [a] -> + Int -> + Bool -> + Bool -> + [a] +rotationsortLast greaterThanOrEqual xs currentIndex isAmbi isReverse = + let w = xs !! prevIndex currentIndex isReverse + x = xs !! currentIndex + y = xs !! firstIndex (length xs) isReverse + rotateForward = + if isReverse then [w] ++ [x] ++ [y] else [y] ++ [x] ++ [w] + rotateToLast = + if isReverse then [y] ++ [x] ++ [w] else [w] ++ [x] ++ [y] + in switch + rotateForward + rotateToLast + where + switch + rotateForward + rotateToLast + | not isAmbi = + rotationsortIterable + greaterThanOrEqual + xs + (nextIndex currentIndex isReverse) + isAmbi + isReverse + | not (firstElemOrdered greaterThanOrEqual xs currentIndex isReverse) = + rotationsortIterable + greaterThanOrEqual + rotateToLast + (prevIndex currentIndex isReverse) + isAmbi + isReverse + | not (prevElemOrdered greaterThanOrEqual xs currentIndex isReverse) = + rotationsortIterable + greaterThanOrEqual + rotateForward + (prevIndex currentIndex isReverse) + isAmbi + isReverse + | otherwise = + rotationsortIterable + greaterThanOrEqual + xs + (nextIndex currentIndex isReverse) + isAmbi + isReverse + +nextIndex :: Int -> Bool -> Int +nextIndex currentIndex isReverse + | isReverse = currentIndex - 1 + | otherwise = currentIndex + 1 + +prevIndex :: Int -> Bool -> Int +prevIndex currentIndex isReverse + | isReverse = currentIndex + 1 + | otherwise = currentIndex - 1 + +lastIndex :: Int -> Bool -> Int +lastIndex listLength isReverse + | isReverse = 0 + | otherwise = listLength - 1 + +firstIndex :: Int -> Bool -> Int +firstIndex listLength isReverse + | isReverse = listLength - 1 + | otherwise = 0 + +nextElemOrdered :: (Ord a) => (a -> a -> Bool) -> [a] -> Int -> Bool -> Bool +nextElemOrdered greaterThanOrEqual xs currentIndex isReverse = + let x = xs !! currentIndex + y = xs !! nextIndex currentIndex isReverse + in if isReverse then greaterThanOrEqual x y else greaterThanOrEqual y x + +prevElemOrdered :: (Ord a) => (a -> a -> Bool) -> [a] -> Int -> Bool -> Bool +prevElemOrdered greaterThanOrEqual xs currentIndex isReverse = + let x = xs !! currentIndex + w = xs !! prevIndex currentIndex isReverse + in if isReverse then greaterThanOrEqual w x else greaterThanOrEqual x w + +firstElemOrdered :: (Ord a) => (a -> a -> Bool) -> [a] -> Int -> Bool -> Bool +firstElemOrdered greaterThanOrEqual xs currentIndex isReverse = + let x = xs !! currentIndex + w = xs !! firstIndex (length xs) isReverse + in if isReverse then greaterThanOrEqual w x else greaterThanOrEqual x w + +lastElemOrdered :: (Ord a) => (a -> a -> Bool) -> [a] -> Int -> Bool -> Bool +lastElemOrdered greaterThanOrEqual xs currentIndex isReverse = + let x = xs !! currentIndex + y = xs !! lastIndex (length xs) isReverse + in if isReverse then greaterThanOrEqual x y else greaterThanOrEqual y x diff --git a/src/Data/Tensort/Subalgorithms/Supersort.hs b/src/Data/Tensort/Subalgorithms/Supersort.hs --- a/src/Data/Tensort/Subalgorithms/Supersort.hs +++ b/src/Data/Tensort/Subalgorithms/Supersort.hs @@ -1,3 +1,5 @@ +-- | This module provides functions for creating Supersort variants for +-- adjudicating between 3 sorting algorithms that use the Sortable type module Data.Tensort.Subalgorithms.Supersort ( supersort, mundaneSuperStrat, @@ -5,52 +7,68 @@ ) where -import Data.Tensort.Utils.Types (SortAlg, Sortable (..), SupersortStrat) +import Data.Tensort.Utils.Types + ( SortAlg, + Sortable (..), + SupersortStrat, + ) -supersort :: Sortable -> (SortAlg, SortAlg, SortAlg, SupersortStrat) -> Sortable -supersort xs (subAlg1, subAlg2, subAlg3, superStrat) = do +-- | Takes 3 sorting algorithms and a SuperStrat and returns a SortAlg that +-- adjudicates between the 3 sorting algorithms using the provided SuperStrat + +-- | ==== __Examples__ +-- >>> import Data.Tensort.Subalgorithms.Bubblesort (bubblesort) +-- >>> import Data.Tensort.Subalgorithms.Permutationsort (permutationsort) +-- >>> import Data.Tensort.OtherSorts.Mergesort (mergesort) +-- +-- >>> supersort (mergesort, bubblesort, permutationsort, mundaneSuperStrat) (SortBit [16, 23, 4, 8, 15, 42]) +-- SortBit [4,8,15,16,23,42] +-- +-- >>> supersort (mergesort, bubblesort, permutationsort, mundaneSuperStrat) (SortRec [(16, 23), (4, 8), (15, 42)]) +-- SortRec [(4,8),(16,23),(15,42)] +supersort :: + (SortAlg, SortAlg, SortAlg, SupersortStrat) -> + Sortable -> + Sortable +supersort (subAlg1, subAlg2, subAlg3, superStrat) xs = do let result1 = subAlg1 xs let result2 = subAlg2 xs if result1 == result2 then result1 else superStrat (result1, result2, subAlg3 xs) +-- | Takes 3 SortAlgs and adjudicates between them to find a common result to +-- increase robustness + +-- | ==== __Examples__ +-- >>> import Data.Tensort.Subalgorithms.Bubblesort (bubblesort) +-- >>> import Data.Tensort.OtherSorts.Mergesort (mergesort) +-- >>> import Data.Tensort.Subalgorithms.Permutationsort (permutationsort) +-- +-- >>> supersort (mergesort, bubblesort, permutationsort, mundaneSuperStrat) (SortBit [16, 23, 4, 8, 15, 42]) +-- SortBit [4,8,15,16,23,42] +-- +-- >>> supersort (mergesort, bubblesort, permutationsort, mundaneSuperStrat) (SortRec [(16, 23), (4, 8), (15, 42)]) +-- SortRec [(4,8),(16,23),(15,42)] mundaneSuperStrat :: SupersortStrat -mundaneSuperStrat (SortBit result1, SortBit result2, SortBit result3) = do - if result1 == result3 || result2 == result3 - then SortBit result3 - else - if last result1 == last result2 || last result1 == last result3 - then SortBit result1 - else - if last result2 == last result3 - then SortBit result2 - else SortBit result1 -mundaneSuperStrat (SortRec result1, SortRec result2, SortRec result3) = do - if result1 == result3 || result2 == result3 - then SortRec result3 - else - if last result1 == last result2 || last result1 == last result3 - then SortRec result1 - else - if last result2 == last result3 - then SortRec result2 - else SortRec result1 -mundaneSuperStrat (_, _, _) = error "All three inputs must be of the same type." +mundaneSuperStrat (result1, result2, result3) = if result2 == result3 then result2 else result1 +-- | Takes 3 SortAlgs and adjudicates between them to find a common result to +-- increase robustness +-- +-- Previously we used different SuperStrats for Mundane and Magic Supersorts. +-- Currently there is no need to differentiate, but we keep this here for +-- backwards compatibility and in case this changes again in the future + +-- | ==== __Examples__ +-- >>> import Data.Tensort.Subalgorithms.Bubblesort (bubblesort) +-- >>> import Data.Tensort.OtherSorts.Mergesort (mergesort) +-- >>> import Data.Tensort.Subalgorithms.Permutationsort (permutationsort) +-- +-- >>> supersort (mergesort, bubblesort, permutationsort, magicSuperStrat) (SortBit [16, 23, 4, 8, 15, 42]) +-- SortBit [4,8,15,16,23,42] +-- +-- >>> supersort (mergesort, bubblesort, permutationsort, magicSuperStrat) (SortRec [(16, 23), (4, 8), (15, 42)]) +-- SortRec [(4,8),(16,23),(15,42)] magicSuperStrat :: SupersortStrat -magicSuperStrat (SortBit result1, SortBit result2, SortBit result3) = do - if last result1 == last result3 || last result2 == last result3 - then SortBit result3 - else - if last result1 == last result2 - then SortBit result1 - else SortBit result3 -magicSuperStrat (SortRec result1, SortRec result2, SortRec result3) = do - if last result1 == last result3 || last result2 == last result3 - then SortRec result3 - else - if last result1 == last result2 - then SortRec result1 - else SortRec result3 -magicSuperStrat (_, _, _) = error "All three inputs must be of the same type." +magicSuperStrat = mundaneSuperStrat diff --git a/src/Data/Tensort/Tensort.hs b/src/Data/Tensort/Tensort.hs --- a/src/Data/Tensort/Tensort.hs +++ b/src/Data/Tensort/Tensort.hs @@ -1,48 +1,96 @@ +-- | This module provides variations of the Tensort algorithm using the +-- Sortable type module Data.Tensort.Tensort ( tensort, tensortB4, tensortBN, tensortBL, - mkTSProps, ) where import Data.Tensort.Subalgorithms.Bubblesort (bubblesort) import Data.Tensort.Utils.Compose (createInitialTensors) -import Data.Tensort.Utils.Convert (rawBitsToBytes) +import Data.Tensort.Utils.Convert (rawToBytes) +import Data.Tensort.Utils.MkTsProps (mkTsProps) import Data.Tensort.Utils.RandomizeList (randomizeList) import Data.Tensort.Utils.Reduce (reduceTensorStacks) import Data.Tensort.Utils.Render (getSortedBitsFromTensor) -import Data.Tensort.Utils.Types (Bit, SortAlg, Sortable (..), TensortProps (..), fromSortBit) +import Data.Tensort.Utils.Types (Sortable (..), TensortProps (..), fromSBitBits, fromSBitRecs) --- | Sort a list of Bits using the Tensort algorithm +-- | Sort a list of Sortables using a custom Tensort algorithm +-- +-- | Takes TensortProps and a Sortable and returns a sorted Sortable -- | ==== __Examples__ --- >>> tensort (randomizeList [1..100] 143) 2 --- [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100] -tensort :: [Bit] -> TensortProps -> [Bit] -tensort [] _ = [] -tensort xs tsProps = do - let bits = randomizeList (SortBit xs) 143 - let bytes = rawBitsToBytes (fromSortBit bits) tsProps - let tensorStacks = createInitialTensors bytes tsProps - let topTensor = reduceTensorStacks tensorStacks tsProps - getSortedBitsFromTensor topTensor (subAlgorithm tsProps) +-- >>> import Data.Tensort.Subalgorithms.Bubblesort (bubblesort) +-- >>> import Data.Tensort.Utils.MkTsProps (mkTsProps) +-- >>> tensort (mkTsProps 2 bubblesort) (SortBit [16, 23, 4, 8, 15, 42]) +-- SortBit [4,8,15,16,23,42] +-- +-- >>> tensort (mkTsProps 2 bubblesort) (SortRec [(1, 16), (5, 23), (2, 4) ,(3, 8), (0, 15) , (4, 42)]) +-- SortRec [(2,4),(3,8),(0,15),(1,16),(5,23),(4,42)] +tensort :: TensortProps -> Sortable -> Sortable +tensort _ (SortBit []) = SortBit [] +tensort _ (SortBit [x]) = SortBit [x] +tensort tsProps (SortBit [x, y]) = subAlgorithm tsProps (SortBit [x, y]) +tensort tsProps (SortBit xs) = do + let bits = randomizeList 143 (SortBit xs) + let bytes = rawToBytes tsProps bits + let tensorStacks = createInitialTensors tsProps bytes + let topTensor = reduceTensorStacks tsProps tensorStacks + fromSBitBits (getSortedBitsFromTensor (subAlgorithm tsProps) topTensor) +tensort _ (SortRec []) = SortRec [] +tensort _ (SortRec [x]) = SortRec [x] +tensort tsProps (SortRec [x, y]) = subAlgorithm tsProps (SortRec [x, y]) +tensort tsProps (SortRec xs) = do + let recs = randomizeList 143 (SortRec xs) + let bytes = rawToBytes tsProps recs + let tensorStacks = createInitialTensors tsProps bytes + let topTensor = reduceTensorStacks tsProps tensorStacks + fromSBitRecs (getSortedBitsFromTensor (subAlgorithm tsProps) topTensor) -mkTSProps :: Int -> SortAlg -> TensortProps -mkTSProps bSize subAlg = TensortProps {bytesize = bSize, subAlgorithm = subAlg} +-- | Sort a list of Sortables using a Standard Tensort algorithm with a 4-Bit +-- Bytesize -tensortB4 :: [Bit] -> [Bit] -tensortB4 xs = tensort xs (mkTSProps 4 bubblesort) +-- | ==== __Examples__ +-- >>> tensortB4 (SortBit [16, 23, 4, 8, 15, 42]) +-- SortBit [4,8,15,16,23,42] +-- +-- >>> tensortB4 (SortRec [(1, 16), (5, 23), (2, 4) ,(3, 8), (0, 15) , (4, 42)]) +-- SortRec [(2,4),(3,8),(0,15),(1,16),(5,23),(4,42)] +tensortB4 :: Sortable -> Sortable +tensortB4 = tensort (mkTsProps 4 bubblesort) -tensortBN :: Int -> [Bit] -> [Bit] -tensortBN n xs = tensort xs (mkTSProps n bubblesort) +-- | Sort a list of Sortables using a Standard Tensort algorithm with a custom +-- Bytesize -tensortBL :: [Bit] -> [Bit] -tensortBL [] = [] -tensortBL [x] = [x] -tensortBL [x, y] = if x <= y then [x, y] else [y, x] -tensortBL xs = tensort xs (mkTSProps (calculateBytesize xs) bubblesort) +-- | ==== __Examples__ +-- >>> tensortBN 3 (SortBit [16, 23, 4, 8, 15, 42]) +-- SortBit [4,8,15,16,23,42] +-- +-- >>> tensortBN 3 (SortRec [(1, 16), (5, 23), (2, 4) ,(3, 8), (0, 15) , (4, 42)]) +-- SortRec [(2,4),(3,8),(0,15),(1,16),(5,23),(4,42)] +tensortBN :: Int -> Sortable -> Sortable +tensortBN n = tensort (mkTsProps n bubblesort) -calculateBytesize :: [Bit] -> Int -calculateBytesize xs = ceiling (log (fromIntegral (length xs)) :: Double) +-- | Sort a list of Sortables using a Standard Logarithmic Tensort algorithm + +-- | ==== __Examples__ +-- >>> tensortBL (SortBit [16, 23, 4, 8, 15, 42]) +-- SortBit [4,8,15,16,23,42] +-- +-- >>> tensortBL (SortRec [(1, 16), (5, 23), (2, 4) ,(3, 8), (0, 15) , (4, 42)]) +-- SortRec [(2,4),(3,8),(0,15),(1,16),(5,23),(4,42)] +tensortBL :: Sortable -> Sortable +tensortBL xs = tensort (mkTsProps (calculateBytesize xs) bubblesort) xs + +-- | Calculate a logarithmic Bytesize from a Sortable + +-- | ==== __Examples__ +-- >>> calculateBytesize (SortRec [(1, 16), (5, 23), (2, 4) ,(3, 8), (0, 15) , (4, 42)]) +-- 2 +calculateBytesize :: Sortable -> Int +calculateBytesize (SortBit xs) = + ceiling (log (fromIntegral (length xs)) :: Double) +calculateBytesize (SortRec xs) = + ceiling (log (fromIntegral (length xs)) :: Double) diff --git a/src/Data/Tensort/Utils/Check.hs b/src/Data/Tensort/Utils/Check.hs --- a/src/Data/Tensort/Utils/Check.hs +++ b/src/Data/Tensort/Utils/Check.hs @@ -1,8 +1,19 @@ +-- | This module provides the isSorted function, which checks if a list of +-- elements is sorted in ascending order. module Data.Tensort.Utils.Check (isSorted) where import Data.Tensort.Utils.ComparisonFunctions (lessThanOrEqualBit, lessThanOrEqualRecord) import Data.Tensort.Utils.Types (Sortable (..)) +-- | Takes a Sortable list and returns True if the list is sorted in ascending +-- order and False otherwise. + +-- | ==== __Examples__ +-- >>> isSorted (SortBit [0, 1, 2, 3, 4]) +-- True +-- +-- >>> isSorted (SortBit [0, 1, 2, 4, 3]) +-- False isSorted :: Sortable -> Bool isSorted (SortBit []) = True isSorted (SortBit [_]) = True diff --git a/src/Data/Tensort/Utils/ComparisonFunctions.hs b/src/Data/Tensort/Utils/ComparisonFunctions.hs --- a/src/Data/Tensort/Utils/ComparisonFunctions.hs +++ b/src/Data/Tensort/Utils/ComparisonFunctions.hs @@ -1,14 +1,18 @@ module Data.Tensort.Utils.ComparisonFunctions ( lessThanBit, lessThanRecord, - greaterThanBit, - greaterThanRecord, lessThanOrEqualBit, lessThanOrEqualRecord, + greaterThanBit, + greaterThanRecord, + greaterThanOrEqualBit, + greaterThanOrEqualRecord, + equalBit, + equalRecord, ) where -import Data.Tensort.Utils.Types (Record, Bit) +import Data.Tensort.Utils.Types (Bit, Record) lessThanBit :: Bit -> Bit -> Bool lessThanBit x y = x < y @@ -16,14 +20,26 @@ lessThanRecord :: Record -> Record -> Bool lessThanRecord x y = snd x < snd y +lessThanOrEqualBit :: Bit -> Bit -> Bool +lessThanOrEqualBit x y = x <= y + +lessThanOrEqualRecord :: Record -> Record -> Bool +lessThanOrEqualRecord x y = snd x <= snd y + greaterThanBit :: Bit -> Bit -> Bool greaterThanBit x y = x > y greaterThanRecord :: Record -> Record -> Bool greaterThanRecord x y = snd x > snd y -lessThanOrEqualBit :: Bit -> Bit -> Bool -lessThanOrEqualBit x y = x <= y +greaterThanOrEqualBit :: Bit -> Bit -> Bool +greaterThanOrEqualBit x y = x >= y -lessThanOrEqualRecord :: Record -> Record -> Bool -lessThanOrEqualRecord x y = snd x <= snd y +greaterThanOrEqualRecord :: Record -> Record -> Bool +greaterThanOrEqualRecord x y = snd x >= snd y + +equalBit :: Bit -> Bit -> Bool +equalBit x y = x == y + +equalRecord :: Record -> Record -> Bool +equalRecord x y = snd x == snd y diff --git a/src/Data/Tensort/Utils/Compose.hs b/src/Data/Tensort/Utils/Compose.hs --- a/src/Data/Tensort/Utils/Compose.hs +++ b/src/Data/Tensort/Utils/Compose.hs @@ -4,8 +4,37 @@ ) where +import Data.Tensort.Utils.SimplifyRegister + ( applySortingFromSimplifiedRegister, + simplifyRegister, + ) import Data.Tensort.Utils.Split (splitEvery) -import Data.Tensort.Utils.Types (Byte, Memory (..), Record, SortAlg, Sortable (..), Tensor, TensortProps (..), fromSortRec, Bit) +import Data.Tensort.Utils.Types + ( Byte, + ByteR, + Memory (..), + MemoryR (..), + Record, + RecordR, + SBit (..), + SBytes (..), + SMemory (..), + SRecord (..), + STensor (..), + STensors (..), + SortAlg, + Sortable (..), + Tensor, + TensorR, + TensortProps (..), + fromSBitBit, + fromSBitRec, + fromSRecordArrayBit, + fromSRecordArrayRec, + fromSTensorBit, + fromSTensorRec, + fromSortRec, + ) -- | Convert a list of Bytes to a list of TensorStacks. @@ -14,21 +43,43 @@ -- definitions for more info) and collating the TensorStacks into a list -- | ==== __Examples__ --- >>> createInitialTensors [[2,4],[6,8],[1,3],[5,7]] 2 --- [([(0,3),(1,7)],ByteMem [[1,3],[5,7]]),([(0,4),(1,8)],ByteMem [[2,4],[6,8]])] -createInitialTensors :: [Byte] -> TensortProps -> [Tensor] -createInitialTensors bytes tsProps = foldr acc [] (splitEvery (bytesize tsProps) bytes) +-- >>> import Data.Tensort.Subalgorithms.Bubblesort (bubblesort) +-- >>> import Data.Tensort.Utils.MkTsProps (mkTsProps) +-- >>> createInitialTensors (mkTsProps 2 bubblesort) (SBytesBit [[2,4],[6,8],[1,3],[5,7]]) +-- STensorsBit [([(0,3),(1,7)],ByteMem [[1,3],[5,7]]),([(0,4),(1,8)],ByteMem [[2,4],[6,8]])] +createInitialTensors :: TensortProps -> SBytes -> STensors +createInitialTensors tsProps (SBytesBit bytes) = + STensorsBit (createInitialTensorsBits tsProps bytes) +createInitialTensors tsProps (SBytesRec recs) = + STensorsRec (createInitialTensorsRecs tsProps recs) + +createInitialTensorsBits :: TensortProps -> [Byte] -> [Tensor] +createInitialTensorsBits tsProps bytes = foldr acc [] (splitEvery (bytesize tsProps) bytes) where acc :: [Byte] -> [Tensor] -> [Tensor] - acc byte tensorStacks = tensorStacks ++ [getTensorFromBytes byte (subAlgorithm tsProps)] + acc byte tensorStacks = tensorStacks ++ [fromSTensorBit (getTensorFromBytes (subAlgorithm tsProps) (SBytesBit byte))] +createInitialTensorsRecs :: TensortProps -> [ByteR] -> [TensorR] +createInitialTensorsRecs tsProps bytesR = foldr acc [] (splitEvery (bytesize tsProps) bytesR) + where + acc :: [ByteR] -> [TensorR] -> [TensorR] + acc byteR tensorStacks = tensorStacks ++ [fromSTensorRec (getTensorFromBytes (subAlgorithm tsProps) (SBytesRec byteR))] + -- | Create a Tensor from a Memory -- Aliases to getTensorFromBytes for ByteMem and getTensorFromTensors for -- TensorMem -createTensor :: Memory -> SortAlg -> Tensor -createTensor (ByteMem bytes) subAlg = getTensorFromBytes bytes subAlg -createTensor (TensorMem tensors) subAlg = getTensorFromTensors tensors subAlg +createTensor :: SortAlg -> SMemory -> STensor +createTensor subAlg (SMemoryBit memory) = createTensorB subAlg memory +createTensor subAlg (SMemoryRec memoryR) = createTensorR subAlg memoryR +createTensorB :: SortAlg -> Memory -> STensor +createTensorB subAlg (ByteMem bytes) = getTensorFromBytes subAlg (SBytesBit bytes) +createTensorB subAlg (TensorMem tensors) = getTensorFromTensors subAlg (STensorsBit tensors) + +createTensorR :: SortAlg -> MemoryR -> STensor +createTensorR subAlg (ByteMemR bytesR) = getTensorFromBytes subAlg (SBytesRec bytesR) +createTensorR subAlg (TensorMemR tensorsR) = getTensorFromTensors subAlg (STensorsRec tensorsR) + -- | Convert a list of Bytes to a Tensor -- | We do this by loading the list of Bytes into the new Tensor's Memory @@ -41,10 +92,15 @@ -- | The Register is sorted by the TopBits of each Record -- | ==== __Examples__ --- >>> getTensorFromBytes [[2,4,6,8],[1,3,5,7]] --- ([(1,7),(0,8)],ByteMem [[2,4,6,8],[1,3,5,7]]) -getTensorFromBytes :: [Byte] -> SortAlg -> Tensor -getTensorFromBytes bytes subAlg = do +-- >>> import Data.Tensort.Subalgorithms.Bubblesort (bubblesort) +-- >>> getTensorFromBytes bubblesort (SBytesBit [[2,4,6,8],[1,3,5,7]]) +-- STensorBit ([(1,7),(0,8)],ByteMem [[2,4,6,8],[1,3,5,7]]) +getTensorFromBytes :: SortAlg -> SBytes -> STensor +getTensorFromBytes subAlg (SBytesBit bytes) = STensorBit (getTensorFromBytesB subAlg bytes) +getTensorFromBytes subAlg (SBytesRec recs) = STensorRec (getTensorFromBytesR subAlg recs) + +getTensorFromBytesB :: SortAlg -> [Byte] -> Tensor +getTensorFromBytesB subAlg bytes = do let register = acc bytes [] 0 let register' = fromSortRec (subAlg (SortRec register)) (register', ByteMem bytes) @@ -54,15 +110,41 @@ acc ([] : remainingBytes) register i = acc remainingBytes register (i + 1) acc (byte : remainingBytes) register i = acc remainingBytes (register ++ [(i, last byte)]) (i + 1) +getTensorFromBytesR :: SortAlg -> [ByteR] -> TensorR +getTensorFromBytesR subAlg bytesR = do + let registerR = acc bytesR [] 0 + let simplifiedRegiser = simplifyRegister registerR + let simplifiedRegiser' = fromSortRec (subAlg (SortRec simplifiedRegiser)) + let registerR' = applySortingFromSimplifiedRegister simplifiedRegiser' registerR + (registerR', ByteMemR bytesR) + where + acc :: [ByteR] -> [RecordR] -> Int -> [RecordR] + acc [] register _ = register + acc ([] : remainingBytesR) registerR i = acc remainingBytesR registerR (i + 1) + acc (byteR : remainingBytesR) registerR i = acc remainingBytesR (registerR ++ [(i, last byteR)]) (i + 1) + -- | Create a TensorStack with the collated and sorted References from the -- Tensors as the Register and the original Tensors as the data -- | ==== __Examples__ --- >>> getTensorFromTensors [([(0,13),(1,18)],ByteMem [[11,13],[15,18]]),([(1,14),(0,17)],ByteMem [[16,17],[12,14]])] --- ([(1,17),(0,18)],TensorMem [([(0,13),(1,18)],ByteMem [[11,13],[15,18]]),([(1,14),(0,17)],ByteMem [[16,17],[12,14]])]) -getTensorFromTensors :: [Tensor] -> SortAlg -> Tensor -getTensorFromTensors tensors subAlg = (fromSortRec (subAlg (SortRec (getRegisterFromTensors tensors))), TensorMem tensors) +-- >>> import Data.Tensort.Subalgorithms.Bubblesort (bubblesort) +-- >>> getTensorFromTensors bubblesort (STensorsBit [([(0,13),(1,18)],ByteMem [[11,13],[15,18]]),([(1,14),(0,17)],ByteMem [[16,17],[12,14]])]) +-- STensorBit ([(1,17),(0,18)],TensorMem [([(0,13),(1,18)],ByteMem [[11,13],[15,18]]),([(1,14),(0,17)],ByteMem [[16,17],[12,14]])]) +getTensorFromTensors :: SortAlg -> STensors -> STensor +getTensorFromTensors subAlg (STensorsBit tensors) = STensorBit (getTensorFromTensorsB subAlg tensors) +getTensorFromTensors subAlg (STensorsRec tensors) = STensorRec (getTensorFromTensorsR subAlg tensors) +getTensorFromTensorsB :: SortAlg -> [Tensor] -> Tensor +getTensorFromTensorsB subAlg tensors = (fromSortRec (subAlg (SortRec (fromSRecordArrayBit (getRegisterFromTensors (STensorsBit tensors))))), TensorMem tensors) + +getTensorFromTensorsR :: SortAlg -> [TensorR] -> TensorR +getTensorFromTensorsR subAlg tensorsR = do + let registerR = getRegisterFromTensors (STensorsRec tensorsR) + let simplifiedRegiser = simplifyRegister (fromSRecordArrayRec registerR) + let simplifiedRegiser' = fromSortRec (subAlg (SortRec simplifiedRegiser)) + let registerR' = applySortingFromSimplifiedRegister simplifiedRegiser' (fromSRecordArrayRec registerR) + (registerR', TensorMemR tensorsR) + -- | For each Tensor, produces a Record by combining the top bit of the -- Tensor with an index value for its Address @@ -70,18 +152,32 @@ -- getTensorFromTensors function -- | ==== __Examples__ --- >>> getRegisterFromTensors [([(0,13),(1,18)],ByteMem [[11,13],[15,18]]),([(0,14),(1,17)],ByteMem [[12,14],[16,17]]),([(0,3),(1,7)],ByteMem [[1,3],[5,7]]),([(0,4),(1,8)],ByteMem [[2,4],[6,8]])] --- [(0,18),(1,17),(2,7),(3,8)] -getRegisterFromTensors :: [Tensor] -> [Record] -getRegisterFromTensors tensors = acc tensors [] +-- >>> getRegisterFromTensors (STensorsBit [([(0,13),(1,18)],ByteMem [[11,13],[15,18]]),([(0,14),(1,17)],ByteMem [[12,14],[16,17]]),([(0,3),(1,7)],ByteMem [[1,3],[5,7]]),([(0,4),(1,8)],ByteMem [[2,4],[6,8]])]) +-- [SRecordBit (0,18),SRecordBit (1,17),SRecordBit (2,7),SRecordBit (3,8)] +getRegisterFromTensors :: STensors -> [SRecord] +getRegisterFromTensors (STensorsBit tensors) = getRegisterFromTensorsB tensors +getRegisterFromTensors (STensorsRec tensors) = getRegisterFromTensorsR tensors + +getRegisterFromTensorsB :: [Tensor] -> [SRecord] +getRegisterFromTensorsB tensors = acc tensors [] where - acc :: [Tensor] -> [Record] -> [Record] + acc :: [Tensor] -> [SRecord] -> [SRecord] acc [] records = records acc (([], _) : remainingTensors) records = acc remainingTensors records - acc (tensor : remainingTensors) records = acc remainingTensors (records ++ [(i, getTopBitFromTensorStack tensor)]) + acc (tensor : remainingTensors) records = acc remainingTensors (records ++ [SRecordBit (i, fromSBitBit (getTopBitFromTensorStack (STensorBit tensor)))]) where i = length records +getRegisterFromTensorsR :: [TensorR] -> [SRecord] +getRegisterFromTensorsR tensorsR = acc tensorsR [] + where + acc :: [TensorR] -> [SRecord] -> [SRecord] + acc [] records = records + acc (([], _) : remainingTensorsR) records = acc remainingTensorsR records + acc (tensorR : remainingTensorsR) records = acc remainingTensorsR (records ++ [SRecordRec (i, fromSBitRec (getTopBitFromTensorStack (STensorRec tensorR)))]) + where + i = length records + -- | Get the top Bit from a TensorStack -- | The top Bit is the last Bit in the last Byte referenced in the last record @@ -91,7 +187,14 @@ -- | This is also expected to be the highest value in the TensorStack -- | ==== __Examples__ --- >>> getTopBitFromTensorStack (([(0,28),(1,38)],TensorMem [([(0,27),(1,28)],TensorMem [([(0,23),(1,27)],ByteMem [[21,23],[25,27]]),([(0,24),(1,28)],ByteMem [[22,24],[26,28]])]),([(1,37),(0,38)],TensorMem [([(0,33),(1,38)],ByteMem [[31,33],[35,38]]),([(0,34),(1,37)],ByteMem [[32,14],[36,37]])])])) --- 38 -getTopBitFromTensorStack :: Tensor -> Bit -getTopBitFromTensorStack (register, _) = snd (last register) +-- >>> getTopBitFromTensorStack (STensorBit ([(0,28),(1,38)],TensorMem [([(0,27),(1,28)],TensorMem [([(0,23),(1,27)],ByteMem [[21,23],[25,27]]),([(0,24),(1,28)],ByteMem [[22,24],[26,28]])]),([(1,37),(0,38)],TensorMem [([(0,33),(1,38)],ByteMem [[31,33],[35,38]]),([(0,34),(1,37)],ByteMem [[32,14],[36,37]])])])) +-- SBitBit 38 +getTopBitFromTensorStack :: STensor -> SBit +getTopBitFromTensorStack (STensorBit tensor) = getTopBitFromTensorStackB tensor +getTopBitFromTensorStack (STensorRec tensorR) = getTopBitFromTensorStackR tensorR + +getTopBitFromTensorStackB :: Tensor -> SBit +getTopBitFromTensorStackB (register, _) = SBitBit (snd (last register)) + +getTopBitFromTensorStackR :: TensorR -> SBit +getTopBitFromTensorStackR (registerR, _) = SBitRec (snd (last registerR)) diff --git a/src/Data/Tensort/Utils/Convert.hs b/src/Data/Tensort/Utils/Convert.hs --- a/src/Data/Tensort/Utils/Convert.hs +++ b/src/Data/Tensort/Utils/Convert.hs @@ -1,21 +1,28 @@ -module Data.Tensort.Utils.Convert (rawBitsToBytes) where +module Data.Tensort.Utils.Convert (rawToBytes) where import Data.Tensort.Utils.Split (splitEvery) -import Data.Tensort.Utils.Types (Byte, Sortable (..), TensortProps (..), fromSortBit, Bit) +import Data.Tensort.Utils.Types (Bit, Byte, Record, SBytes (SBytesBit, SBytesRec), Sortable (..), TensortProps (..), fromSortBit, fromSortRec) --- | Convert a list of Bits to a list of Bytes of given bytesize, bubblesorting --- each byte. +-- | Convert a list of Bits to a list of Bytes of given bytesize, sorting +-- each byte with the given subalgorithm. -- | ==== __Examples__ --- >>> rawBitsToBytes [5,1,3,7,8,2,4,6] 4 +-- >>> import Data.Tensort.Subalgorithms.Bubblesort (bubblesort) +-- >>> import Data.Tensort.Utils.MkTsProps (mkTsProps) +-- >>> rawBitsToBytes (mkTsProps 4 bubblesort) [5,1,3,7,8,2,4,6] -- [[2,4,6,8],[1,3,5,7]] --- rawBitsToBytes :: [Bit] -> Int -> [Byte] --- rawBitsToBytes bits bytesize = foldr acc [] (splitEvery bytesize bits) --- where --- acc :: [Bit] -> [Byte] -> [Byte] --- acc byte bytes = bytes ++ [fromSortBit (bubblesort (SortBit byte))] -rawBitsToBytes :: [Bit] -> TensortProps -> [Byte] -rawBitsToBytes bits tsProps = foldr acc [] (splitEvery (bytesize tsProps) bits) +rawToBytes :: TensortProps -> Sortable -> SBytes +rawToBytes tsProps (SortBit xs) = SBytesBit (rawBitsToBytes tsProps xs) +rawToBytes tsProps (SortRec xs) = SBytesRec (rawRecsToBytes tsProps xs) + +rawBitsToBytes :: TensortProps -> [Bit] -> [Byte] +rawBitsToBytes tsProps bits = foldr acc [] (splitEvery (bytesize tsProps) bits) where acc :: [Bit] -> [Byte] -> [Byte] acc byte bytes = bytes ++ [fromSortBit (subAlgorithm tsProps (SortBit byte))] + +rawRecsToBytes :: TensortProps -> [Record] -> [[Record]] +rawRecsToBytes tsProps recs = foldr acc [] (splitEvery (bytesize tsProps) recs) + where + acc :: [Record] -> [[Record]] -> [[Record]] + acc rbyte rbytes = rbytes ++ [fromSortRec (subAlgorithm tsProps (SortRec rbyte))] diff --git a/src/Data/Tensort/Utils/MkTsProps.hs b/src/Data/Tensort/Utils/MkTsProps.hs new file mode 100644 --- /dev/null +++ b/src/Data/Tensort/Utils/MkTsProps.hs @@ -0,0 +1,8 @@ +-- | This module provides the mkTsProps function for creating TensortProps +module Data.Tensort.Utils.MkTsProps (mkTsProps) where + +import Data.Tensort.Utils.Types (SortAlg, TensortProps (..)) + +-- | Wraps in integer Bytesize and a SortAlg together as TensortProps +mkTsProps :: Int -> SortAlg -> TensortProps +mkTsProps bSize subAlg = TensortProps {bytesize = bSize, subAlgorithm = subAlg} diff --git a/src/Data/Tensort/Utils/RandomizeList.hs b/src/Data/Tensort/Utils/RandomizeList.hs --- a/src/Data/Tensort/Utils/RandomizeList.hs +++ b/src/Data/Tensort/Utils/RandomizeList.hs @@ -1,9 +1,21 @@ +-- | This module prvodies the randomizeList function, which randomizes Sortable +-- lists. module Data.Tensort.Utils.RandomizeList (randomizeList) where import Data.Tensort.Utils.Types (Sortable (..)) import System.Random (mkStdGen) import System.Random.Shuffle (shuffle') -randomizeList :: Sortable -> Int -> Sortable -randomizeList (SortBit xs) seed = SortBit (shuffle' xs (length xs) (mkStdGen seed)) -randomizeList (SortRec xs) seed = SortRec (shuffle' xs (length xs) (mkStdGen seed)) +-- | Takes a seed for random generation and a Sortable list and returns a new +-- Sortable list with the same elements as the input list but in a random +-- order. + +-- | ==== __Examples__ +-- >>> randomizeList 143 (SortBit [4, 8, 15, 16, 23, 42]) +-- SortBit [16,23,4,8,15,42] +-- +-- >>> randomizeList 143 (SortRec [(2,4),(3,8),(0,15),(1,16),(5,23),(4,42)]) +-- SortRec [(1,16),(5,23),(2,4),(3,8),(0,15),(4,42)] +randomizeList :: Int -> Sortable -> Sortable +randomizeList seed (SortBit xs) = SortBit (shuffle' xs (length xs) (mkStdGen seed)) +randomizeList seed (SortRec xs) = SortRec (shuffle' xs (length xs) (mkStdGen seed)) diff --git a/src/Data/Tensort/Utils/Reduce.hs b/src/Data/Tensort/Utils/Reduce.hs --- a/src/Data/Tensort/Utils/Reduce.hs +++ b/src/Data/Tensort/Utils/Reduce.hs @@ -2,7 +2,19 @@ import Data.Tensort.Utils.Compose (createTensor) import Data.Tensort.Utils.Split (splitEvery) -import Data.Tensort.Utils.Types (Memory (..), TensorStack, TensortProps (..)) +import Data.Tensort.Utils.Types + ( Memory (..), + MemoryR (..), + SMemory (..), + STensorStack, + STensorStacks, + STensors (..), + TensorStack, + TensorStackR, + TensortProps (..), + fromSTensorBit, + fromSTensorRec, + ) -- | Take a list of TensorStacks and group them together in new -- TensorStacks, each containing bytesize number of Tensors (former @@ -11,25 +23,46 @@ -- | The Registers of the new TensorStacks are bubblesorted, as usual -- | ==== __Examples__ --- >>> reduceTensorStacks [([(0, 33), (1, 38)], ByteMem [[31, 33], [35, 38]]), ([(0, 34), (1, 37)], ByteMem [[32, 14], [36, 37]]), ([(0, 23), (1, 27)], ByteMem [[21, 23], [25, 27]]), ([(0, 24), (1, 28)], ByteMem [[22, 24], [26, 28]]),([(0,13),(1,18)],ByteMem [[11,13],[15,18]]),([(0,14),(1,17)],ByteMem [[12,14],[16,17]]),([(0,3),(1,7)],ByteMem [[1,3],[5,7]]),([(0,4),(1,8)],ByteMem [[2,4],[6,8]])] 2 --- ([(1,18),(0,38)],TensorMem [([(0,28),(1,38)],TensorMem [([(0,27),(1,28)],TensorMem [([(0,23),(1,27)],ByteMem [[21,23],[25,27]]),([(0,24),(1,28)],ByteMem [[22,24],[26,28]])]),([(1,37),(0,38)],TensorMem [([(0,33),(1,38)],ByteMem [[31,33],[35,38]]),([(0,34),(1,37)],ByteMem [[32,14],[36,37]])])]),([(0,8),(1,18)],TensorMem [([(0,7),(1,8)],TensorMem [([(0,3),(1,7)],ByteMem [[1,3],[5,7]]),([(0,4),(1,8)],ByteMem [[2,4],[6,8]])]),([(1,17),(0,18)],TensorMem [([(0,13),(1,18)],ByteMem [[11,13],[15,18]]),([(0,14),(1,17)],ByteMem [[12,14],[16,17]])])])]) -reduceTensorStacks :: [TensorStack] -> TensortProps -> TensorStack -reduceTensorStacks tensorStacks tsProps = do - let newTensorStacks = reduceTensorStacksSinglePass tensorStacks tsProps +-- >>> import Data.Tensort.Subalgorithms.Bubblesort (bubblesort) +-- >>> import Data.Tensort.Utils.MkTsProps (mkTsProps) +-- >>> reduceTensorStacks (mkTsProps 2 bubblesort) (STensorsBit [([(0, 33), (1, 38)], ByteMem [[31, 33], [35, 38]]), ([(0, 34), (1, 37)], ByteMem [[32, 14], [36, 37]]), ([(0, 23), (1, 27)], ByteMem [[21, 23], [25, 27]]), ([(0, 24), (1, 28)], ByteMem [[22, 24], [26, 28]]),([(0,13),(1,18)],ByteMem [[11,13],[15,18]]),([(0,14),(1,17)],ByteMem [[12,14],[16,17]]),([(0,3),(1,7)],ByteMem [[1,3],[5,7]]),([(0,4),(1,8)],ByteMem [[2,4],[6,8]])]) +-- STensorBit ([(1,18),(0,38)],TensorMem [([(0,28),(1,38)],TensorMem [([(0,27),(1,28)],TensorMem [([(0,23),(1,27)],ByteMem [[21,23],[25,27]]),([(0,24),(1,28)],ByteMem [[22,24],[26,28]])]),([(1,37),(0,38)],TensorMem [([(0,33),(1,38)],ByteMem [[31,33],[35,38]]),([(0,34),(1,37)],ByteMem [[32,14],[36,37]])])]),([(0,8),(1,18)],TensorMem [([(0,7),(1,8)],TensorMem [([(0,3),(1,7)],ByteMem [[1,3],[5,7]]),([(0,4),(1,8)],ByteMem [[2,4],[6,8]])]),([(1,17),(0,18)],TensorMem [([(0,13),(1,18)],ByteMem [[11,13],[15,18]]),([(0,14),(1,17)],ByteMem [[12,14],[16,17]])])])]) +reduceTensorStacks :: TensortProps -> STensorStacks -> STensorStack +reduceTensorStacks tsProps (STensorsBit tensorStacks) = reduceTensorStacksB tsProps tensorStacks +reduceTensorStacks tsProps (STensorsRec tensorStacks) = reduceTensorStacksR tsProps tensorStacks + +reduceTensorStacksB :: TensortProps -> [TensorStack] -> STensorStack +reduceTensorStacksB tsProps tensorStacks = do + let newTensorStacks = reduceTensorStacksSinglePass tsProps tensorStacks if length newTensorStacks <= bytesize tsProps - then createTensor (TensorMem newTensorStacks) (subAlgorithm tsProps) - else reduceTensorStacks newTensorStacks tsProps + then createTensor (subAlgorithm tsProps) (SMemoryBit (TensorMem newTensorStacks)) + else reduceTensorStacksB tsProps newTensorStacks +reduceTensorStacksR :: TensortProps -> [TensorStackR] -> STensorStack +reduceTensorStacksR tsProps tensorStacks = do + let newTensorStacks = reduceTensorStacksRSinglePass tsProps tensorStacks + if length newTensorStacks <= bytesize tsProps + then createTensor (subAlgorithm tsProps) (SMemoryRec (TensorMemR newTensorStacks)) + else reduceTensorStacksR tsProps newTensorStacks + -- | Take a list of TensorStacks and group them together in new -- TensorStacks each containing bytesize number of Tensors (former TensorStacks) -- | The Registers of the new TensorStacks are bubblesorted, as usual -- | ==== __Examples__ --- >>> reduceTensorStacksSinglePass [([(0,13),(1,18)],ByteMem [[11,13],[15,18]]),([(0,14),(1,17)],ByteMem [[12,14],[16,17]]),([(0,3),(1,7)],ByteMem [[1,3],[5,7]]),([(0,4),(1,8)],ByteMem [[2,4],[6,8]])] 2 +-- >>> import Data.Tensort.Subalgorithms.Bubblesort (bubblesort) +-- >>> import Data.Tensort.Utils.MkTsProps (mkTsProps) +-- >>> reduceTensorStacksSinglePass (mkTsProps 2 bubblesort) [([(0,13),(1,18)],ByteMem [[11,13],[15,18]]),([(0,14),(1,17)],ByteMem [[12,14],[16,17]]),([(0,3),(1,7)],ByteMem [[1,3],[5,7]]),([(0,4),(1,8)],ByteMem [[2,4],[6,8]])] -- [([(0,7),(1,8)],TensorMem [([(0,3),(1,7)],ByteMem [[1,3],[5,7]]),([(0,4),(1,8)],ByteMem [[2,4],[6,8]])]),([(1,17),(0,18)],TensorMem [([(0,13),(1,18)],ByteMem [[11,13],[15,18]]),([(0,14),(1,17)],ByteMem [[12,14],[16,17]])])] -reduceTensorStacksSinglePass :: [TensorStack] -> TensortProps -> [TensorStack] -reduceTensorStacksSinglePass tensorStacks tsProps = foldr acc [] (splitEvery (bytesize tsProps) tensorStacks) +reduceTensorStacksSinglePass :: TensortProps -> [TensorStack] -> [TensorStack] +reduceTensorStacksSinglePass tsProps tensorStacks = foldr acc [] (splitEvery (bytesize tsProps) tensorStacks) where acc :: [TensorStack] -> [TensorStack] -> [TensorStack] - acc tensorStack newTensorStacks = newTensorStacks ++ [createTensor (TensorMem tensorStack) (subAlgorithm tsProps)] + acc tensorStack newTensorStacks = newTensorStacks ++ [fromSTensorBit (createTensor (subAlgorithm tsProps) (SMemoryBit (TensorMem tensorStack)))] + +reduceTensorStacksRSinglePass :: TensortProps -> [TensorStackR] -> [TensorStackR] +reduceTensorStacksRSinglePass tsProps tensorStacks = foldr acc [] (splitEvery (bytesize tsProps) tensorStacks) + where + acc :: [TensorStackR] -> [TensorStackR] -> [TensorStackR] + acc tensorStack newTensorStacks = newTensorStacks ++ [fromSTensorRec (createTensor (subAlgorithm tsProps) (SMemoryRec (TensorMemR tensorStack)))] diff --git a/src/Data/Tensort/Utils/Render.hs b/src/Data/Tensort/Utils/Render.hs --- a/src/Data/Tensort/Utils/Render.hs +++ b/src/Data/Tensort/Utils/Render.hs @@ -2,45 +2,73 @@ import Data.Maybe (isNothing) import Data.Tensort.Utils.Compose (createTensor) -import Data.Tensort.Utils.Types (Memory (..), SortAlg, Sortable (..), Tensor, TensorStack, fromJust, fromSortBit, Bit) +import Data.Tensort.Utils.Types (Bit, BitR, Memory (..), MemoryR (..), SBit (..), SMemory (..), STensor (..), STensorStack, SortAlg, Sortable (..), Tensor, TensorR, TensorStack, TensorStackR, fromJust, fromSTensorBit, fromSTensorRec, fromSortBit, fromSortRec) -- | Compile a sorted list of Bits from a list of TensorStacks -- | ==== __Examples__ --- >>> getSortedBitsFromTensor ([(0,5),(1,7)],ByteMem [[1,5],[3,7]]) --- [1,3,5,7] --- >>> getSortedBitsFromTensor ([(0,8),(1,18)],TensorMem [([(0,7),(1,8)],TensorMem [([(0,3),(1,7)],ByteMem [[1,3],[5,7]]),([(0,4),(1,8)],ByteMem [[2,4],[6,8]])]),([(1,17),(0,18)],TensorMem [([(0,13),(1,18)],ByteMem [[11,13],[15,18]]),([(0,14),(1,17)],ByteMem [[12,14],[16,17]])])]) --- [1,2,3,4,5,6,7,8,11,12,13,14,15,16,17,18] -getSortedBitsFromTensor :: TensorStack -> SortAlg -> [Bit] -getSortedBitsFromTensor tensorRaw subAlg = acc tensorRaw [] +-- >>> import Data.Tensort.Subalgorithms.Bubblesort (bubblesort) +-- >>> getSortedBitsFromTensor bubblesort (STensorBit ([(0,5),(1,7)],ByteMem [[1,5],[3,7]])) +-- [SBitBit 1,SBitBit 3,SBitBit 5,SBitBit 7] +-- >>> getSortedBitsFromTensor bubblesort (STensorBit ([(0,8),(1,18)],TensorMem [([(0,7),(1,8)],TensorMem [([(0,3),(1,7)],ByteMem [[1,3],[5,7]]),([(0,4),(1,8)],ByteMem [[2,4],[6,8]])]),([(1,17),(0,18)],TensorMem [([(0,13),(1,18)],ByteMem [[11,13],[15,18]]),([(0,14),(1,17)],ByteMem [[12,14],[16,17]])])])) +-- [SBitBit 1,SBitBit 2,SBitBit 3,SBitBit 4,SBitBit 5,SBitBit 6,SBitBit 7,SBitBit 8,SBitBit 11,SBitBit 12,SBitBit 13,SBitBit 14,SBitBit 15,SBitBit 16,SBitBit 17,SBitBit 18] +getSortedBitsFromTensor :: SortAlg -> STensorStack -> [SBit] +getSortedBitsFromTensor subAlg (STensorBit tensorRaw) = getSortedBitsFromTensorB subAlg tensorRaw +getSortedBitsFromTensor subAlg (STensorRec tensorRaw) = getSortedBitsFromTensorR subAlg tensorRaw + +getSortedBitsFromTensorB :: SortAlg -> TensorStack -> [SBit] +getSortedBitsFromTensorB subAlg tensorRaw = acc tensorRaw [] where - acc :: TensorStack -> [Bit] -> [Bit] + acc :: TensorStack -> [SBit] -> [SBit] acc tensor sortedBits = do - let (nextBit, tensor') = removeTopBitFromTensor tensor subAlg + let (nextBit, tensor') = removeTopBitFromTensor subAlg tensor + let nextBit' = SBitBit nextBit if isNothing tensor' - then nextBit : sortedBits + then nextBit' : sortedBits else do - acc (fromJust tensor') (nextBit : sortedBits) + acc (fromJust tensor') (nextBit' : sortedBits) +getSortedBitsFromTensorR :: SortAlg -> TensorStackR -> [SBit] +getSortedBitsFromTensorR subAlg tensorRaw = acc tensorRaw [] + where + acc :: TensorStackR -> [SBit] -> [SBit] + acc tensor sortedBits = do + let (nextBit, tensor') = removeTopBitFromTensorR subAlg tensor + let nextBit' = SBitRec nextBit + if isNothing tensor' + then nextBit' : sortedBits + else do + acc (fromJust tensor') (nextBit' : sortedBits) + -- | For use in compiling a list of Tensors into a sorted list of Bits -- -- | Removes the top Bit from a Tensor, rebalances the Tensor and returns -- the removed Bit along with the rebalanced Tensor -- | ==== __Examples__ --- >>> removeTopBitFromTensor ([(0,5),(1,7)],ByteMem [[1,5],[3,7]]) +-- >>> import Data.Tensort.Subalgorithms.Bubblesort (bubblesort) +-- >>> removeTopBitFromTensor bubblesort ([(0,5),(1,7)],ByteMem [[1,5],[3,7]]) -- (7,Just ([(1,3),(0,5)],ByteMem [[1,5],[3]])) -removeTopBitFromTensor :: Tensor -> SortAlg -> (Bit, Maybe Tensor) -removeTopBitFromTensor (register, memory) tsProps = do +removeTopBitFromTensor :: SortAlg -> Tensor -> (Bit, Maybe Tensor) +removeTopBitFromTensor subAlg (register, memory) = do let topRecord = last register let topAddress = fst topRecord - let (topBit, memory') = removeBitFromMemory memory topAddress tsProps + let (topBit, memory') = removeBitFromMemory subAlg memory topAddress if isNothing memory' then (topBit, Nothing) - else (topBit, Just (createTensor (fromJust memory') tsProps)) + else (topBit, Just (fromSTensorBit (createTensor subAlg (SMemoryBit (fromJust memory'))))) -removeBitFromMemory :: Memory -> Int -> SortAlg -> (Bit, Maybe Memory) -removeBitFromMemory (ByteMem bytes) i subAlg = do +removeTopBitFromTensorR :: SortAlg -> TensorR -> (BitR, Maybe TensorR) +removeTopBitFromTensorR subAlg (register, memory) = do + let topRecord = last register + let topAddress = fst topRecord + let (topBit, memory') = removeBitFromMemoryR subAlg memory topAddress + if isNothing memory' + then (topBit, Nothing) + else (topBit, Just (fromSTensorRec (createTensor subAlg (SMemoryRec (fromJust memory'))))) + +removeBitFromMemory :: SortAlg -> Memory -> Int -> (Bit, Maybe Memory) +removeBitFromMemory subAlg (ByteMem bytes) i = do let topByte = bytes !! i let topBit = last topByte let topByte' = init topByte @@ -57,9 +85,9 @@ let topByte'' = fromSortBit (subAlg (SortBit topByte')) let bytes' = take i bytes ++ [topByte''] ++ drop (i + 1) bytes (topBit, Just (ByteMem bytes')) -removeBitFromMemory (TensorMem tensors) i subAlg = do +removeBitFromMemory subAlg (TensorMem tensors) i = do let topTensor = tensors !! i - let (topBit, topTensor') = removeTopBitFromTensor topTensor subAlg + let (topBit, topTensor') = removeTopBitFromTensor subAlg topTensor if isNothing topTensor' then do let tensors' = take i tensors ++ drop (i + 1) tensors @@ -69,3 +97,34 @@ else do let tensors' = take i tensors ++ [fromJust topTensor'] ++ drop (i + 1) tensors (topBit, Just (TensorMem tensors')) + +removeBitFromMemoryR :: SortAlg -> MemoryR -> Int -> (BitR, Maybe MemoryR) +removeBitFromMemoryR subAlg (ByteMemR bytesR) i = do + let topByteR = bytesR !! i + let topBitR = last topByteR + let topByteR' = init topByteR + case length topByteR' of + 0 -> do + let bytesR' = take i bytesR ++ drop (i + 1) bytesR + if null bytesR' + then (topBitR, Nothing) + else (topBitR, Just (ByteMemR bytesR')) + 1 -> do + let bytesR' = take i bytesR ++ [topByteR'] ++ drop (i + 1) bytesR + (topBitR, Just (ByteMemR bytesR')) + _ -> do + let topByteR'' = fromSortRec (subAlg (SortRec topByteR')) + let bytesR' = take i bytesR ++ [topByteR''] ++ drop (i + 1) bytesR + (topBitR, Just (ByteMemR bytesR')) +removeBitFromMemoryR subAlg (TensorMemR tensorsR) i = do + let topTensorR = tensorsR !! i + let (topBitR, topTensorR') = removeTopBitFromTensorR subAlg topTensorR + if isNothing topTensorR' + then do + let tensorsR' = take i tensorsR ++ drop (i + 1) tensorsR + if null tensorsR' + then (topBitR, Nothing) + else (topBitR, Just (TensorMemR tensorsR')) + else do + let tensorsR' = take i tensorsR ++ [fromJust topTensorR'] ++ drop (i + 1) tensorsR + (topBitR, Just (TensorMemR tensorsR')) diff --git a/src/Data/Tensort/Utils/SimplifyRegister.hs b/src/Data/Tensort/Utils/SimplifyRegister.hs new file mode 100644 --- /dev/null +++ b/src/Data/Tensort/Utils/SimplifyRegister.hs @@ -0,0 +1,23 @@ +module Data.Tensort.Utils.SimplifyRegister + ( simplifyRegister, + applySortingFromSimplifiedRegister, + ) +where + +import qualified Data.Bifunctor +import Data.Tensort.Utils.Types (Record, RecordR) + +simplifyRegister :: [RecordR] -> [Record] +simplifyRegister = map (Data.Bifunctor.second snd) + +applySortingFromSimplifiedRegister :: [Record] -> [RecordR] -> [RecordR] +applySortingFromSimplifiedRegister sortedSimplifiedRegister unsortedRegiserR = do + let registerR = acc sortedSimplifiedRegister [] unsortedRegiserR + registerR + where + acc :: [Record] -> [RecordR] -> [RecordR] -> [RecordR] + acc [] sortedRegisterR _ = sortedRegisterR + acc (record : remainingRecords) sortedRegisterR unsortedRegiserR' = do + let i = fst record + let recordR = head (filter (\(i', _) -> i' == i) unsortedRegiserR') + acc remainingRecords (sortedRegisterR ++ [recordR]) unsortedRegiserR' diff --git a/src/Data/Tensort/Utils/Types.hs b/src/Data/Tensort/Utils/Types.hs --- a/src/Data/Tensort/Utils/Types.hs +++ b/src/Data/Tensort/Utils/Types.hs @@ -1,27 +1,52 @@ {-# LANGUAGE GADTs #-} +-- | This module provides types used in the Tensort package +-- +-- Since these packages are only for sorting Ints currently, every data +-- type is a structure of Ints module Data.Tensort.Utils.Types where +-- | TensortProps contains the Bytesize and SubAlgorithm used in a Tensort +-- algorithm data TensortProps = TensortProps {bytesize :: Int, subAlgorithm :: SortAlg} --- All the data types used in the Tensort and Tensort algorithms are --- defined here. Since these packages are only for sorting Ints currently, --- every data type is a structure of Ints - -- | A Bit is a single element of the list to be sorted. For -- our current purposes that means it is an Int --- | NOTE: To Self: at this point it's likely simple enough to refactor this --- to sort any Ord, not just Ints. Consider using the `Bit` type synonym --- in the code, then changing this to alias `Bit` to `Ord` or `a` +-- The definition of a Bit may be expanded in the future to include any Ord type Bit = Int +-- | This is a `Bit` type that is used when sorting Records in a recursive +-- Tensort variant +type BitR = Record + +-- | This is a conversion type that allows for sorting both Bits and Records. +-- It is useful in recursive Tensort variants +data SBit + = SBitBit Bit + | SBitRec Record + deriving (Show, Eq, Ord) + +-- | Converts an SBit to a Bit +fromSBitBit :: SBit -> Bit +fromSBitBit (SBitBit bit) = bit +fromSBitBit (SBitRec _) = error "From fromSBitBit: This is for sorting Bits - you gave me Records" + +-- | Converts an SBit to a Record +fromSBitRec :: SBit -> Record +fromSBitRec (SBitRec record) = record +fromSBitRec (SBitBit _) = error "From fromSBitRec: This is for sorting Records - you gave me Bits" + -- | A Byte is a list of Bits standardized to a fixed maximum length (Bytesize) -- | The length should be set either in or upstream of any function that uses -- Bytes type Byte = [Bit] +-- | This is a `Byte` type that is used when sorting Records in a recursive +-- Tensort variant +type ByteR = [Record] + -- | An Address is a index number pointing to data stored in Memory type Address = Int @@ -29,6 +54,10 @@ -- Tensor type TopBit = Bit +-- | This is a `TopBit` type that is used when sorting Records in a recursive +-- Tensort variant +type TopBitR = Record + -- | A Record is an element in a Tensor's Register -- containing an Address pointer and a TopBit value @@ -39,31 +68,153 @@ -- Tensor that the Record references type Record = (Address, TopBit) +-- | This is a `Record` type that is used when sorting Records in a recursive +-- Tensort variant +type RecordR = (Address, TopBitR) + +-- | This is a conversion type that allows for sorting both Records and Bits. +-- It is useful in recursive Tensort variants +data SRecord + = SRecordBit Record + | SRecordRec RecordR + deriving (Show, Eq, Ord) + +-- | Converts an SRecord to a Record +fromSRecordBit :: SRecord -> Record +fromSRecordBit (SRecordBit record) = record +fromSRecordBit (SRecordRec _) = error "From fromSRecordBit: This is for sorting Records - you gave me Bits" + +-- | Converts an SRecord to a RecordR +fromSRecordRec :: SRecord -> RecordR +fromSRecordRec (SRecordRec record) = record +fromSRecordRec (SRecordBit _) = error "From fromSRecordRec: This is for sorting Bits - you gave me Records" + +-- | This is a conversion type that allows for sorting both Records and Bits. +-- It is useful in recursive Tensort variants +data SRecords + = SRecordsBit [Record] + | SRecordsRec [RecordR] + deriving (Show, Eq, Ord) + +-- | Converts an SRecords to a list of Records +fromSRecordsBit :: SRecords -> [Record] +fromSRecordsBit (SRecordsBit records) = records +fromSRecordsBit (SRecordsRec _) = error "From fromSRecordsBit: This is for sorting Records - you gave me Bits" + +-- | Converts an SRecords to a list of RecordRs +fromSRecordsRec :: SRecords -> [RecordR] +fromSRecordsRec (SRecordsRec records) = records +fromSRecordsRec (SRecordsBit _) = error "From fromSRecordsRec: This is for sorting Bits - you gave me Records" + +-- | Converts a list of SRecords to a list of Records +fromSRecordArrayBit :: [SRecord] -> [Record] +fromSRecordArrayBit = map fromSRecordBit + +-- | Converts a list of SRecords to a list of RecordRs +fromSRecordArrayRec :: [SRecord] -> [RecordR] +fromSRecordArrayRec = map fromSRecordRec + -- | A Register is a list of Records allowing for easy access to data in a -- Tensor's Memory type Register = [Record] --- | We use a Sortable type sort between Bits and Records +-- | This is a `Register` type that is used when sorting Records in a recursive +-- Tensort variant +type RegisterR = [RecordR] --- | In the future this may be expanded to include other data types and allow --- for sorting other types of besides Ints. +-- | We use a Sortable type to sort Bits and Records data Sortable = SortBit [Bit] | SortRec [Record] deriving (Show, Eq, Ord) +-- | Converts a Sortable list to a list of Bits fromSortBit :: Sortable -> [Bit] fromSortBit (SortBit bits) = bits -fromSortBit (SortRec _) = error "This is for sorting Bits - you gave me Records" +fromSortBit (SortRec _) = error "From fromSortBit: This is for sorting Bits - you gave me Records" +-- | Converts a Sortable list to a list of Records fromSortRec :: Sortable -> [Record] fromSortRec (SortRec recs) = recs -fromSortRec (SortBit _) = error "This is for sorting Records - you gave me Bits" +fromSortRec (SortBit _) = error "From fromSortRec: This is for sorting Records - you gave me Bits" +-- | Converts a list of Bits to a Sortable +fromSBitBits :: [SBit] -> Sortable +fromSBitBits = SortBit . map fromSBitBit + +-- | Converts a list of Records to a Sortable +fromSBitRecs :: [SBit] -> Sortable +fromSBitRecs = SortRec . map fromSBitRec + +-- | This is a conversion type that allows for sorting both Bits and Records. +-- It is useful in recursive Tensort variants +data SBytes + = SBytesBit [Byte] + | SBytesRec [ByteR] + deriving (Show, Eq, Ord) + +-- | Converts an SBytes list to a list of Bytes +fromSBytesBit :: SBytes -> [[Bit]] +fromSBytesBit (SBytesBit bits) = bits +fromSBytesBit (SBytesRec _) = error "From fromSBytesBit: This is for sorting Bits - you gave me Records" + +-- | Converts an SBytes list to a list of ByteRs +fromSBytesRec :: SBytes -> [[Record]] +fromSBytesRec (SBytesRec recs) = recs +fromSBytesRec (SBytesBit _) = error "From fromSBytesRec: This is for sorting Records - you gave me Bits" + +-- | This is a conversion type that allows for sorting both Bits and Records. +-- It is useful in recursive Tensort variants +data STensor + = STensorBit Tensor + | STensorRec TensorR + deriving (Show, Eq, Ord) + +-- | This is a conversion type that allows for sorting both Bits and Records. +-- It is useful in recursive Tensort variants +data STensors + = STensorsBit [Tensor] + | STensorsRec [TensorR] + deriving (Show, Eq, Ord) + +-- | Converts an STensor to a Tensor +fromSTensorBit :: STensor -> Tensor +fromSTensorBit (STensorBit tensor) = tensor +fromSTensorBit (STensorRec _) = + error + "From fromSTensorBit: This is for sorting Tensors - you gave me Records" + +-- | Converts an STensor to a TensorR +fromSTensorRec :: STensor -> TensorR +fromSTensorRec (STensorRec tensor) = tensor +fromSTensorRec (STensorBit _) = + error + "From fromSTensorRec: This is for sorting Records - you gave me Tensors" + +-- | Converts an STensors list to a list of Tensors +fromSTensorsBit :: STensors -> [Tensor] +fromSTensorsBit (STensorsBit tensors) = tensors +fromSTensorsBit (STensorsRec _) = + error + "From fromSTensorsBit: This is for sorting Tensors - you gave me Records" + +-- | Converts an STensors list to a list of TensorRs +fromSTensorsRec :: STensors -> [TensorR] +fromSTensorsRec (STensorsRec tensors) = tensors +fromSTensorsRec (STensorsBit _) = + error + "From fromSTensorsRec: This is for sorting Records - you gave me Tensors" + +-- | A sorting algorithm is a function that takes a Sortable and returns a +-- sorted Sortable type SortAlg = Sortable -> Sortable +-- | SupersortProps consist of three sorting algorithms to adjuditcate between +-- and a SupersortStrat that does the adjudication type SupersortProps = (SortAlg, SortAlg, SortAlg, SupersortStrat) +-- | A SupersortStrat takes three Sortables and determines which of the three +-- is most likely to be in the correct order type SupersortStrat = (Sortable, Sortable, Sortable) -> Sortable -- | A Memory contains the data to be sorted, either in the form of Bytes or @@ -73,6 +224,30 @@ | TensorMem [Tensor] deriving (Show, Eq, Ord) +-- | This is a `Memory` type that is used when sorting Records in a recursive +-- Tensort variant +data MemoryR + = ByteMemR [ByteR] + | TensorMemR [TensorR] + deriving (Show, Eq, Ord) + +-- | This is a conversion type that allows for sorting both Bits and Records. +-- It is useful in recursive Tensort variants +data SMemory + = SMemoryBit Memory + | SMemoryRec MemoryR + deriving (Show, Eq, Ord) + +-- | Converts an SMemory to a Memory +fromSMemoryBit :: SMemory -> Memory +fromSMemoryBit (SMemoryBit memory) = memory +fromSMemoryBit (SMemoryRec _) = error "From fromSTensorsRec: This is for sorting Bits - you gave me Records" + +-- | Converts an SMemory to a MemoryR +fromSMemoryRec :: SMemory -> MemoryR +fromSMemoryRec (SMemoryRec memory) = memory +fromSMemoryRec (SMemoryBit _) = error "From fromSMemoryRec: This is for sorting Records - you gave me Bits" + -- | A Tensor contains data to be sorted in a structure allowing for -- easy access. It consists of a Register and its Memory. @@ -82,11 +257,29 @@ -- | The Register is a list of Records referencing the top Bits in Memory. type Tensor = (Register, Memory) +-- | This is a `Tensor` type that is used when sorting Records in a recursive +-- Tensort variant +type TensorR = (RegisterR, MemoryR) + -- | A TensorStack is a top-level Tensor. In the final stages of Tensort, the --- number of TensorStacks will equal the bytesize, but before that time there --- are expected to be many more TensorStacks. +-- number of TensorStacks will be equal to (or sometimes less than) the +-- bytesize, but before that time there are expected to be many more +-- TensorStacks. type TensorStack = Tensor +-- | This is a `TensorStack` type that is used when sorting Records in a recursive +-- Tensort variant +type TensorStackR = TensorR + +-- | This is a conversion type that allows for sorting both Tensors and Records. +-- It is useful in recursive Tensort variants +type STensorStack = STensor + +-- | This is a conversion type that allows for sorting both Tensors and Records. +-- It is useful in recursive Tensort variants +type STensorStacks = STensors + +-- | Convers a Maybe into a value or throws an error if the Maybe is Nothing fromJust :: Maybe a -> a fromJust (Just x) = x fromJust Nothing = error "fromJust: Nothing" diff --git a/src/Data/Tensort/Utils/WrapSortAlg.hs b/src/Data/Tensort/Utils/WrapSortAlg.hs new file mode 100644 --- /dev/null +++ b/src/Data/Tensort/Utils/WrapSortAlg.hs @@ -0,0 +1,19 @@ +-- | This module provides convenience functions to wrap sorting algorithms +-- that use the Sortable type so they can be used without worrying about +-- type conversion +module Data.Tensort.Utils.WrapSortAlg + ( wrapSortAlg, + ) +where + +import Data.Tensort.Utils.Types (Bit, SortAlg, Sortable (SortBit), fromSortBit) + +-- | Wraps a sorting algorithm that uses the Sortable type so it can be used +-- to sort Bits without worrying about type conversion + +-- | ==== __Examples__ +-- >>> import Data.Tensort.Robustsort (robustsortM) +-- >>> (wrapSortAlg robustsortM) [16, 23, 4, 8, 15, 42] +-- [4,8,15,16,23,42] +wrapSortAlg :: SortAlg -> ([Bit] -> [Bit]) +wrapSortAlg sortAlg xs = fromSortBit (sortAlg (SortBit xs)) diff --git a/tensort.cabal b/tensort.cabal --- a/tensort.cabal +++ b/tensort.cabal @@ -20,7 +20,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.2.0.3 +version: 1.0.0.0 tested-with: GHC==9.8.2, GHC==9.6.4, @@ -41,7 +41,7 @@ GHC==7.0.1, -- A short (one-line) description of the package. -synopsis: Tunable sorting for responsive robustness and beyond! +synopsis: Tunable sorting for responsive robustness and beyond -- A longer description of the package. description: A tunable tensor-based structure for sorting algorithms @@ -95,19 +95,23 @@ -- Modules exported by the library. exposed-modules: Data.Tensort, + Data.Robustsort, Data.Tensort.Tensort, Data.Tensort.Robustsort, - Data.Tensort.Utils.Types, Data.Tensort.Subalgorithms.Bubblesort, Data.Tensort.Subalgorithms.Exchangesort, + Data.Tensort.Subalgorithms.Rotationsort, Data.Tensort.Subalgorithms.Permutationsort, Data.Tensort.Subalgorithms.Bogosort, Data.Tensort.Subalgorithms.Supersort, Data.Tensort.Subalgorithms.Magicsort, Data.Tensort.OtherSorts.Mergesort, Data.Tensort.OtherSorts.Quicksort, - Data.Tensort.Utils.RandomizeList, Data.Tensort.Utils.Check, + Data.Tensort.Utils.MkTsProps, + Data.Tensort.Utils.RandomizeList, + Data.Tensort.Utils.Types, + Data.Tensort.Utils.WrapSortAlg, -- Modules included in this library but not exported. other-modules: Data.Tensort.Utils.Split, @@ -116,6 +120,7 @@ Data.Tensort.Utils.Compose, Data.Tensort.Utils.Reduce, Data.Tensort.Utils.Render, + Data.Tensort.Utils.SimplifyRegister, -- LANGUAGE extensions used by modules in this package. -- other-extensions: @@ -165,8 +170,10 @@ default-language: Haskell2010 -- Modules included in this executable, other than Main. - other-modules: TestCheck, - SortSpec, + other-modules: Test.QCheck, + Test.SortingAlgorithms, + Test.SortSpec, + Test.TestCheck, -- LANGUAGE extensions used by modules in this package. diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -1,91 +1,22 @@ +{-# OPTIONS_GHC -Wno-deferred-out-of-scope-variables #-} + module Main (main) where -import Data.Tensort.OtherSorts.Mergesort (mergesort) -import Data.Tensort.OtherSorts.Quicksort (quicksort) -import Data.Tensort.Robustsort (robustsortB, robustsortM, robustsortP) -import Data.Tensort.Subalgorithms.Bogosort (bogosort) -import Data.Tensort.Subalgorithms.Bubblesort (bubblesort) -import Data.Tensort.Subalgorithms.Exchangesort (exchangesort) -import Data.Tensort.Subalgorithms.Magicsort (magicsort) -import Data.Tensort.Subalgorithms.Permutationsort (permutationsort) -import Data.Tensort.Subalgorithms.Supersort (magicSuperStrat, mundaneSuperStrat, supersort) -import Data.Tensort.Tensort (mkTSProps, tensort, tensortB4, tensortBL) -import Data.Tensort.Utils.Types (Bit, Sortable) -import SortSpec (result_is_sorted_bits, result_is_sorted_custom_bitsize, result_is_sorted_records, result_is_sorted_records_short) -import TestCheck (check) +import Test.QCheck +import Test.SortSpec (result_is_sorted_custom_bitsize) +import Test.SortingAlgorithms +import Test.TestCheck (check) -- | This suite of QuickCheck tests contains a guard that will cause the test --- `suite to fail if any of the individual tests fail +-- suite to fail if any of the individual tests fail main :: IO () main = do + mapM_ qcheckSortable sortingAlgorithmsSortable + mapM_ qcheckSortableShort sortingAlgorithmsSortableShort + mapM_ qcheckSortableTiny sortingAlgorithmsSortableTiny + mapM_ qcheckBits sortingAlgorithmsBits putStrLn "Running test suite!" - putStrLn "Quicksort returns a sorted array..." - check (result_is_sorted_records quicksort) - putStrLn "True!" - putStrLn "Mergesort returns a sorted array..." - check (result_is_sorted_records mergesort) - putStrLn "True!" - putStrLn "Bubblesort returns a sorted array..." - check (result_is_sorted_records bubblesort) - putStrLn "True!" - putStrLn "Exchangesort returns a sorted array..." - check (result_is_sorted_records exchangesort) - putStrLn "True!" - putStrLn "Permutationsort returns a sorted array..." - check (result_is_sorted_records permutationsort) - putStrLn "True!" - putStrLn "Bogosort returns a sorted array..." - check (result_is_sorted_records_short bogosort) - putStrLn "True!" - putStrLn "Magicsort returns a sorted array..." - check (result_is_sorted_records_short magicsort) - putStrLn "True!" - putStrLn "Standard Logaritmic Tensort returns a sorted array..." - check (result_is_sorted_bits tensortBL) - putStrLn "True!" - putStrLn "Standard 4-Bit Tensort returns a sorted array..." - check (result_is_sorted_bits tensortB4) - putStrLn "True!" putStrLn "Standard Custom Bitsize Tensort returns a sorted array..." check result_is_sorted_custom_bitsize putStrLn "True!" - putStrLn "Standard Mundane Robustsort with Permutationsort adjudicator returns a sorted array..." - check (result_is_sorted_bits robustsortP) - putStrLn "True!" - putStrLn "Standard Mundane Robustsort with Bogosort adjudicator returns a sorted array..." - check (result_is_sorted_bits robustsortB) - putStrLn "True!" - putStrLn "Magic Robustsort returns a sorted array..." - check (result_is_sorted_bits robustsortM) - putStrLn "True!" - putStrLn "Custom Tensort returns a sorted array..." - check (result_is_sorted_bits tensortCustomExample) - putStrLn "True!" - putStrLn "Custom Mundane Supersort returns a sorted array..." - check (result_is_sorted_records_short supersortMundaneCustomExample) - putStrLn "True!" - putStrLn "Custom Magic Supersort returns a sorted array..." - check (result_is_sorted_records_short supersortMagicCustomExample) - putStrLn "True!" - putStrLn "Custom Mundane Robustsort returns a sorted array..." - check (result_is_sorted_bits robustsortMundaneCustomExample) - putStrLn "True!" - putStrLn "Custom Magic Robustsort returns a sorted array..." - check (result_is_sorted_bits robustsortMagicCustomExample) - putStrLn "True!" putStrLn "All tests pass!" - -tensortCustomExample :: [Bit] -> [Bit] -tensortCustomExample xs = tensort xs (mkTSProps 8 mergesort) - -supersortMundaneCustomExample :: Sortable -> Sortable -supersortMundaneCustomExample xs = supersort xs (quicksort, magicsort, bubblesort, mundaneSuperStrat) - -supersortMagicCustomExample :: Sortable -> Sortable -supersortMagicCustomExample xs = supersort xs (bogosort, permutationsort, magicsort, magicSuperStrat) - -robustsortMundaneCustomExample :: [Bit] -> [Bit] -robustsortMundaneCustomExample xs = tensort xs (mkTSProps 3 supersortMundaneCustomExample) - -robustsortMagicCustomExample :: [Bit] -> [Bit] -robustsortMagicCustomExample xs = tensort xs (mkTSProps 3 supersortMagicCustomExample) diff --git a/test/SortSpec.hs b/test/SortSpec.hs deleted file mode 100644 --- a/test/SortSpec.hs +++ /dev/null @@ -1,44 +0,0 @@ -module SortSpec - ( result_is_sorted_bits, - result_is_sorted_records, - result_is_sorted_records_short, - result_is_sorted_custom_bitsize, - ) -where - -import Data.Tensort.Tensort (tensortBN) -import Data.Tensort.Utils.Check (isSorted) -import Data.Tensort.Utils.Types (Bit, Record, SortAlg, Sortable (..)) -import Test.QuickCheck - -result_is_sorted_bits :: ([Bit] -> [Bit]) -> [Bit] -> Property -result_is_sorted_bits sort unsortedList = - within - 1000000 - ( (length unsortedList < 10) ==> - isSorted (SortBit (sort unsortedList)) - ) - -result_is_sorted_records :: SortAlg -> [Record] -> Property -result_is_sorted_records sort unsortedList = - within - 1000000 - ( (length unsortedList < 10) ==> - isSorted (sort (SortRec unsortedList)) - ) - -result_is_sorted_records_short :: SortAlg -> [Record] -> Property -result_is_sorted_records_short sort unsortedList = - within - 1000000 - ( (length unsortedList < 6) ==> - isSorted (sort (SortRec unsortedList)) - ) - -result_is_sorted_custom_bitsize :: Int -> [Bit] -> Property -result_is_sorted_custom_bitsize n unsortedList = - within - 1000000 - ( (length unsortedList < 15) && (n > 1) ==> - isSorted (SortBit (tensortBN n unsortedList)) - ) diff --git a/test/Test/QCheck.hs b/test/Test/QCheck.hs new file mode 100644 --- /dev/null +++ b/test/Test/QCheck.hs @@ -0,0 +1,42 @@ +module Test.QCheck + ( qcheckSortable, + qcheckSortableShort, + qcheckSortableTiny, + qcheckBits, + ) +where + +import Data.Tensort.Utils.Types (Bit, SortAlg) +import Test.SortSpec + ( result_is_sorted_bits, + result_is_sorted_bits_only, + result_is_sorted_records, + result_is_sorted_records_short, + result_is_sorted_records_tiny, + ) +import Test.TestCheck (check) + +qcheckSortable :: (SortAlg, String) -> IO () +qcheckSortable (sort, sortName) = do + putStrLn (sortName ++ " returns a sorted array..") + check (result_is_sorted_bits sort) + check (result_is_sorted_records sort) + putStrLn "True!" + +qcheckSortableShort :: (SortAlg, String) -> IO () +qcheckSortableShort (sort, sortName) = do + putStrLn (sortName ++ " returns a sorted array..") + check (result_is_sorted_records_short sort) + putStrLn "True!" + +qcheckSortableTiny :: (SortAlg, String) -> IO () +qcheckSortableTiny (sort, sortName) = do + putStrLn (sortName ++ " returns a sorted array..") + check (result_is_sorted_records_tiny sort) + putStrLn "True!" + +qcheckBits :: ([Bit] -> [Bit], String) -> IO () +qcheckBits (sort, sortName) = do + putStrLn (sortName ++ " returns a sorted array..") + check (result_is_sorted_bits_only sort) + putStrLn "True!" diff --git a/test/Test/SortSpec.hs b/test/Test/SortSpec.hs new file mode 100644 --- /dev/null +++ b/test/Test/SortSpec.hs @@ -0,0 +1,90 @@ +module Test.SortSpec + ( result_is_sorted_bits, + result_is_sorted_bits_short, + result_is_sorted_bits_tiny, + result_is_sorted_records, + result_is_sorted_records_short, + result_is_sorted_records_tiny, + result_is_sorted_custom_bitsize, + result_is_sorted_bits_only, + result_is_sorted_bits_only_short, + ) +where + +import Data.Tensort.Tensort (tensortBN) +import Data.Tensort.Utils.Check (isSorted) +import Data.Tensort.Utils.Types (Bit, Record, SortAlg, Sortable (..)) +import Test.QuickCheck + +result_is_sorted_bits :: SortAlg -> [Bit] -> Property +result_is_sorted_bits sort unsortedList = + within + 1000000 + ( (length unsortedList < 10) + ==> isSorted (sort (SortBit unsortedList)) + ) + +result_is_sorted_bits_short :: SortAlg -> [Bit] -> Property +result_is_sorted_bits_short sort unsortedList = + within + 1000000 + ( (length unsortedList < 6) + ==> isSorted (sort (SortBit unsortedList)) + ) + +result_is_sorted_bits_tiny :: SortAlg -> [Bit] -> Property +result_is_sorted_bits_tiny sort unsortedList = + within + 1000000 + ( (length unsortedList < 3) + ==> isSorted (sort (SortBit unsortedList)) + ) + +result_is_sorted_records :: SortAlg -> [Record] -> Property +result_is_sorted_records sort unsortedList = + within + 1000000 + ( (length unsortedList < 10) + ==> isSorted (sort (SortRec unsortedList)) + ) + +result_is_sorted_records_short :: SortAlg -> [Record] -> Property +result_is_sorted_records_short sort unsortedList = + within + 1000000 + ( (length unsortedList < 6) + ==> isSorted (sort (SortRec unsortedList)) + ) + +result_is_sorted_records_tiny :: SortAlg -> [Record] -> Property +result_is_sorted_records_tiny sort unsortedList = + within + 1000000 + ( (length unsortedList < 3) + ==> isSorted (sort (SortRec unsortedList)) + ) + +result_is_sorted_custom_bitsize :: Int -> [Bit] -> Property +result_is_sorted_custom_bitsize n unsortedList = + within + 1000000 + ( (length unsortedList < 15) + && (n > 1) + ==> isSorted (tensortBN n (SortBit unsortedList)) + ) + +result_is_sorted_bits_only :: ([Bit] -> [Bit]) -> [Bit] -> Property +result_is_sorted_bits_only sort unsortedList = + within + 1000000 + ( (length unsortedList < 10) + ==> isSorted (SortBit (sort unsortedList)) + ) + +result_is_sorted_bits_only_short :: ([Bit] -> [Bit]) -> [Bit] -> Property +result_is_sorted_bits_only_short sort unsortedList = + within + 1000000 + ( (length unsortedList < 6) + ==> isSorted (SortBit (sort unsortedList)) + ) diff --git a/test/Test/SortingAlgorithms.hs b/test/Test/SortingAlgorithms.hs new file mode 100644 --- /dev/null +++ b/test/Test/SortingAlgorithms.hs @@ -0,0 +1,134 @@ +module Test.SortingAlgorithms + ( sortingAlgorithmsSortable, + sortingAlgorithmsSortableShort, + sortingAlgorithmsSortableTiny, + sortingAlgorithmsBits, + ) +where + +import qualified Data.Robustsort + ( robustsortB, + robustsortM, + robustsortP, + robustsortRB, + robustsortRM, + robustsortRP, + ) +import qualified Data.Tensort (tensort) +import Data.Tensort.OtherSorts.Mergesort (mergesort) +import Data.Tensort.OtherSorts.Quicksort (quicksort) +import Data.Tensort.Robustsort + ( robustsortB, + robustsortM, + robustsortP, + robustsortRB, + robustsortRM, + robustsortRP, + ) +import Data.Tensort.Subalgorithms.Bogosort (bogosort) +import Data.Tensort.Subalgorithms.Bubblesort (bubblesort) +import Data.Tensort.Subalgorithms.Exchangesort (exchangesort) +import Data.Tensort.Subalgorithms.Magicsort (magicsort) +import Data.Tensort.Subalgorithms.Permutationsort (permutationsort) +import Data.Tensort.Subalgorithms.Rotationsort (rotationsort, rotationsortAmbi, rotationsortReverse, rotationsortReverseAmbi) +import Data.Tensort.Subalgorithms.Supersort + ( magicSuperStrat, + mundaneSuperStrat, + supersort, + ) +import Data.Tensort.Tensort (tensort, tensortB4, tensortBL) +import Data.Tensort.Utils.MkTsProps (mkTsProps) +import Data.Tensort.Utils.Types (Bit, SortAlg, Sortable) + +tensortCustomExample :: Sortable -> Sortable +tensortCustomExample = tensort (mkTsProps 8 mergesort) + +supersortMundaneCustomExample :: Sortable -> Sortable +supersortMundaneCustomExample = + supersort + ( quicksort, + magicsort, + bubblesort, + mundaneSuperStrat + ) + +supersortMagicCustomExample :: Sortable -> Sortable +supersortMagicCustomExample = + supersort + ( bogosort, + permutationsort, + magicsort, + magicSuperStrat + ) + +robustsortMundaneCustomExample :: Sortable -> Sortable +robustsortMundaneCustomExample = + tensort + (mkTsProps 3 supersortMundaneCustomExample) + +robustsortMagicCustomExample :: Sortable -> Sortable +robustsortMagicCustomExample = + tensort + (mkTsProps 3 supersortMagicCustomExample) + +sortingAlgorithmsSortable :: [(SortAlg, String)] +sortingAlgorithmsSortable = + [ (quicksort, "Quicksort"), + (mergesort, "Mergesort"), + (bubblesort, "Bubblesort"), + (exchangesort, "Exchangesort"), + (permutationsort, "Permutationsort"), + (tensortBL, "Standard Logaritmic Tensort"), + (tensortB4, "Standard 4-Bit Tensort"), + (tensortCustomExample, "Standard Custom Bitsize Tensort"), + (robustsortP, "Standard Mundane Robustsort with Permutationsort adjudicator"), + (robustsortB, "Standard Mundane Robustsort with Bogosort adjudicator"), + (robustsortM, "Magic Robustsort"), + (robustsortMundaneCustomExample, "Custom Mundane Robustsort"), + (robustsortMagicCustomExample, "Custom Magic Robustsort"), + (robustsortRP, "Recursive Mundane Robustsort with Permutationsort adjudicator"), + (robustsortRB, "Recursive Mundane Robustsort with Bogosort adjudicator"), + (robustsortRM, "Recursive Magic Robustsort") + ] + +sortingAlgorithmsSortableShort :: [(SortAlg, String)] +sortingAlgorithmsSortableShort = + [ (bogosort, "Bogosort"), + (magicsort, "Magicsort"), + (robustsortP, "Standard Mundane Robustsort with Permutationsort adjudicator"), + (robustsortB, "Standard Mundane Robustsort with Bogosort adjudicator"), + (robustsortM, "Magic Robustsort"), + (supersortMundaneCustomExample, "Custom Mundane Supersort"), + (supersortMagicCustomExample, "Custom Magic Supersort") + ] + +sortingAlgorithmsSortableTiny :: [(SortAlg, String)] +sortingAlgorithmsSortableTiny = + [ (rotationsort, "Rotationsort"), + (rotationsortReverse, "Reverse Rotationsort"), + (rotationsortAmbi, "Ambidextrous Rotationsort"), + (rotationsortReverseAmbi, "Reverse Ambidextrous Rotationsort") + ] + +sortingAlgorithmsBits :: [([Bit] -> [Bit], String)] +sortingAlgorithmsBits = + [ (Data.Tensort.tensort, "Top-level Tensort"), + ( Data.Robustsort.robustsortP, + "Top-level Mundane Robustsort with Permutationsort adjudicator" + ), + ( Data.Robustsort.robustsortB, + "Top-level Mundane Robustsort with Bogosort adjudicator" + ), + ( Data.Robustsort.robustsortM, + "Top-level Magic Robustsort" + ), + ( Data.Robustsort.robustsortRP, + "Top-level Recursive Mundane Robustsort with Permutationsort adjudicator" + ), + ( Data.Robustsort.robustsortRB, + "Top-level Recursive Mundane Robustsort with Bogosort adjudicator" + ), + ( Data.Robustsort.robustsortRM, + "Top-level Recursive Magic Robustsort" + ) + ] diff --git a/test/Test/TestCheck.hs b/test/Test/TestCheck.hs new file mode 100644 --- /dev/null +++ b/test/Test/TestCheck.hs @@ -0,0 +1,36 @@ +module Test.TestCheck (isPass, check) where + +import Control.Monad (unless) +import System.Exit +import Test.QuickCheck + +-- | Run a QuickCheck test and exit with a failure if it fails + +-- | This is used so that the testing suite will fail if any QuickCheck tests +-- fail + +-- | ==== __Examples__ +-- >>> check (1 == 1) +-- ... +-- >>> check (1 == 2) +-- ... +-- ...exit with failure +check :: (Testable prop) => prop -> IO () +check prop = do + result <- quickCheckWithResult stdArgs {maxDiscardRatio = 2000} prop + unless (isPass result) exitFailure + +-- | Returns True if a test passes, and False otherwise + +-- | ==== __Examples__ +-- >>> isPass (Success {}) +-- True +-- >>> isPass (GaveUp {}) +-- False +-- >>> isPass (Failure {}) +-- False +-- >>> isPass (_ {}) +-- False +isPass :: Result -> Bool +isPass (Success {}) = True +isPass _ = False diff --git a/test/TestCheck.hs b/test/TestCheck.hs deleted file mode 100644 --- a/test/TestCheck.hs +++ /dev/null @@ -1,36 +0,0 @@ -module TestCheck (isPass, check) where - -import Control.Monad (unless) -import System.Exit -import Test.QuickCheck - --- | Run a QuickCheck test and exit with a failure if it fails - --- | This is used so that the testing suite will fail if any QuickCheck tests --- fail - --- | ==== __Examples__ --- >>> check (1 == 1) --- ... --- >>> check (1 == 2) --- ... --- ...exit with failure -check :: (Testable prop) => prop -> IO () -check prop = do - result <- quickCheckWithResult stdArgs {maxDiscardRatio = 2000} prop - unless (isPass result) exitFailure - --- | Returns True if a test passes, and False otherwise - --- | ==== __Examples__ --- >>> isPass (Success {}) --- True --- >>> isPass (GaveUp {}) --- False --- >>> isPass (Failure {}) --- False --- >>> isPass (_ {}) --- False -isPass :: Result -> Bool -isPass (Success {}) = True -isPass _ = False