tensort (empty) → 0.1.0.0

raw patch · 25 files changed

+930/−0 lines, 25 filesdep +basedep +mtldep +random

Dependencies added: base, mtl, random, random-shuffle, tensort, time

Files

• CHANGELOG.md +5/−0
• LICENSE +21/−0
• app/Main.hs +74/−0
• src/Data/Tensort.hs +6/−0
• src/Data/Tensort/OtherSorts/Mergesort.hs +44/−0
• src/Data/Tensort/OtherSorts/Quicksort.hs +16/−0
• src/Data/Tensort/Robustsort.hs +33/−0
• src/Data/Tensort/Subalgorithms/Bogosort.hs +13/−0
• src/Data/Tensort/Subalgorithms/Bubblesort.hs +21/−0
• src/Data/Tensort/Subalgorithms/Magicsort.hs +16/−0
• src/Data/Tensort/Subalgorithms/Permutationsort.hs +23/−0
• src/Data/Tensort/Subalgorithms/ReverseExchangesort.hs +29/−0
• src/Data/Tensort/Subalgorithms/Supersort.hs +56/−0
• src/Data/Tensort/Tensort.hs +41/−0
• src/Data/Tensort/Utils/Check.hs +12/−0
• src/Data/Tensort/Utils/ComparisonFunctions.hs +29/−0
• src/Data/Tensort/Utils/Convert.hs +21/−0
• src/Data/Tensort/Utils/RandomizeList.hs +9/−0
• src/Data/Tensort/Utils/Reduce.hs +35/−0
• src/Data/Tensort/Utils/Render.hs +71/−0
• src/Data/Tensort/Utils/Split.hs +6/−0
• src/Data/Tensort/Utils/Tensor.hs +101/−0
• src/Data/Tensort/Utils/Types.hs +91/−0
• tensort.cabal +153/−0
• test/Main.hs +4/−0

@@ -0,0 +1,5 @@+# Revision history for tensort++## 0.1.0.0 -- 2024-05-30++* First version. Released to an eager world.

@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2024 Kyle Beechly++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.

@@ -0,0 +1,74 @@+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 (tensortBasic2Bit, tensortBasic3Bit, tensortBasic4Bit)+import Data.Tensort.Utils.RandomizeList (randomizeList)+import Data.Tensort.Utils.Types (Sortable (..), fromSortInt)+import Data.Time.Clock++unsortedInts :: [Int]+unsortedInts = [2, 5, 10, 4, 15, 11, 7, 14, 16, 6, 13, 3, 8, 9, 12, 1]++unsortedInts52 :: Sortable+unsortedInts52 = randomizeList (SortInt [1 .. 52]) 143++unsortedInts1000 :: Sortable+unsortedInts1000 = randomizeList (SortInt [1 .. 1000]) 143++unsortedInts10000 :: Sortable+unsortedInts10000 = randomizeList (SortInt [1 .. 10000]) 143++unsortedInts100000 :: Sortable+unsortedInts100000 = randomizeList (SortInt [1 .. 100000]) 143++main :: IO ()+main = do+  printTime unsortedInts52+  printTime unsortedInts1000+  printTime unsortedInts10000+  printTime unsortedInts100000++printTime :: Sortable -> IO ()+printTime l = do+  putStr " Algorithm   | Time         | n ="+  startTensort2Bit <- getCurrentTime+  putStrLn (" " ++ show (length (tensortBasic2Bit (fromSortInt l))))+  endTensort2Bit <- getCurrentTime+  putStr (" Tensort2Bit | " ++ show (diffUTCTime endTensort2Bit startTensort2Bit) ++ " | ")+  startTensort3Bit <- getCurrentTime+  putStrLn ("    " ++ show (length (tensortBasic3Bit (fromSortInt l))))+  endTensort3Bit <- getCurrentTime+  putStr (" Tensort3Bit | " ++ show (diffUTCTime endTensort3Bit startTensort3Bit) ++ " | ")+  startTensort4Bit <- getCurrentTime+  putStrLn ("    " ++ show (length (tensortBasic4Bit (fromSortInt l))))+  endTensort4Bit <- getCurrentTime+  putStr (" Tensort4Bit | " ++ show (diffUTCTime endTensort4Bit startTensort4Bit) ++ " | ")+  startRSortP <- getCurrentTime+  putStrLn ("    " ++ show (length (robustsortP (fromSortInt l))))+  endRSortP <- getCurrentTime+  putStr (" RobustsortP | " ++ show (diffUTCTime endRSortP startRSortP) ++ " | ")+  startRSortB <- getCurrentTime+  putStrLn ("    " ++ show (length (robustsortB (fromSortInt l))))+  endRSortB <- getCurrentTime+  putStr (" RobustsortB | " ++ show (diffUTCTime endRSortB startRSortB) ++ " | ")+  startRSortM <- getCurrentTime+  putStrLn ("    " ++ show (length (robustsortM (fromSortInt l))))+  endRSortM <- getCurrentTime+  putStr (" RobustsortM | " ++ show (diffUTCTime endRSortM startRSortM) ++ " | ")+  startMergesort <- getCurrentTime+  putStrLn ("    " ++ show (length (fromSortInt (mergesort l))))+  endMergesort <- getCurrentTime+  putStr (" Mergesort   | " ++ show (diffUTCTime endMergesort startMergesort) ++ " | ")+  startQuicksort <- getCurrentTime+  putStrLn ("    " ++ show (length (fromSortInt (quicksort l))))+  endQuicksort <- getCurrentTime+  putStr (" Quicksort   | " ++ show (diffUTCTime endQuicksort startQuicksort) ++ " | ")+  startBubblesort <- getCurrentTime+  putStrLn ("    " ++ show (length (fromSortInt (bubblesort l))))+  endBubblesort <- getCurrentTime+  putStr (" Bubblesort  | " ++ show (diffUTCTime endBubblesort startBubblesort) ++ " | ")+  putStrLn ("    " ++ show (length (fromSortInt (bubblesort l))))+  putStrLn "----------------------------------------------------------"

@@ -0,0 +1,6 @@+module Data.Tensort+  ( module Data.Tensort.Tensort,+  )+where++import Data.Tensort.Tensort

@@ -0,0 +1,44 @@+module Data.Tensort.OtherSorts.Mergesort (mergesort) where++import Data.Tensort.Utils.ComparisonFunctions (lessThanInt, lessThanRecord)+import Data.Tensort.Utils.Types (Record, Sortable (..))++mergesort :: Sortable -> Sortable+mergesort (SortInt xs) = SortInt (mergesortInts xs)+mergesort (SortRec xs) = SortRec (mergesortRecs xs)++mergesortInts :: [Int] -> [Int]+mergesortInts = mergeAllInts . map (: [])+  where+    mergeAllInts [] = []+    mergeAllInts [x] = x+    mergeAllInts [x, y] = mergeInts x y+    mergeAllInts remaningElements = mergeAllInts (mergePairs remaningElements)++    mergePairs (x : y : remaningElements) = mergeInts x y : mergePairs remaningElements+    mergePairs x = x++mergeInts :: [Int] -> [Int] -> [Int]+mergeInts [] y = y+mergeInts x [] = x+mergeInts (x : xs) (y : ys)+  | lessThanInt x y = x : mergeInts xs (y : ys)+  | otherwise = y : mergeInts (x : xs) ys++mergesortRecs :: [Record] -> [Record]+mergesortRecs = mergeAllRecs . map (: [])+  where+    mergeAllRecs [] = []+    mergeAllRecs [x] = x+    mergeAllRecs [x, y] = mergeRecs x y+    mergeAllRecs remaningElements = mergeAllRecs (mergePairs remaningElements)++    mergePairs (x : y : remaningElements) = mergeRecs x y : mergePairs remaningElements+    mergePairs x = x++mergeRecs :: [Record] -> [Record] -> [Record]+mergeRecs [] y = y+mergeRecs x [] = x+mergeRecs (x : xs) (y : ys)+  | lessThanRecord x y = x : mergeRecs xs (y : ys)+  | otherwise = y : mergeRecs (x : xs) ys

@@ -0,0 +1,16 @@+module Data.Tensort.OtherSorts.Quicksort (quicksort) where++import Data.Tensort.Utils.ComparisonFunctions (greaterThanInt, greaterThanRecord, lessThanOrEqualInt, lessThanOrEqualRecord)+import Data.Tensort.Utils.Types (Sortable (..), fromSortInt, fromSortRec)++quicksort :: Sortable -> Sortable+quicksort (SortInt []) = SortInt []+quicksort (SortInt (x : xs)) =+  let lowerPartition = quicksort (SortInt [a | a <- xs, lessThanOrEqualInt a x])+      upperPartition = quicksort (SortInt [a | a <- xs, greaterThanInt a x])+   in SortInt (fromSortInt lowerPartition ++ [x] ++ fromSortInt upperPartition)+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)

@@ -0,0 +1,33 @@+module Data.Tensort.Robustsort+  ( robustsortP,+    robustsortB,+    robustsortM,+  )+where++import Data.Tensort.Subalgorithms.Bogosort (bogosort)+import Data.Tensort.Subalgorithms.Bubblesort (bubblesort)+import Data.Tensort.Subalgorithms.Magicsort (magicsort)+import Data.Tensort.Subalgorithms.Permutationsort (permutationsort)+import Data.Tensort.Subalgorithms.ReverseExchangesort (reverseExchangesort)+import Data.Tensort.Subalgorithms.Supersort (magicSuperStrat, mundaneSuperStrat, supersort)+import Data.Tensort.Tensort (mkTSProps, tensort)+import Data.Tensort.Utils.Types (Sortable)++robustsortP :: [Int] -> [Int]+robustsortP xs = tensort xs (mkTSProps 3 supersortP)++supersortP :: Sortable -> Sortable+supersortP xs = supersort xs (bubblesort, reverseExchangesort, permutationsort, mundaneSuperStrat)++robustsortB :: [Int] -> [Int]+robustsortB xs = tensort xs (mkTSProps 3 supersortB)++supersortB :: Sortable -> Sortable+supersortB xs = supersort xs (bubblesort, reverseExchangesort, bogosort, mundaneSuperStrat)++robustsortM :: [Int] -> [Int]+robustsortM xs = tensort xs (mkTSProps 3 supersortM)++supersortM :: Sortable -> Sortable+supersortM xs = supersort xs (bubblesort, reverseExchangesort, magicsort, magicSuperStrat)

@@ -0,0 +1,13 @@+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 (..))++bogosort :: Sortable -> Sortable+bogosort xs = bogosortSeeded xs 143++bogosortSeeded :: Sortable -> Int -> Sortable+bogosortSeeded xs seed+  | isSorted xs = xs+  | otherwise = bogosortSeeded (randomizeList xs seed) (seed + 1)

@@ -0,0 +1,21 @@+module Data.Tensort.Subalgorithms.Bubblesort (bubblesort) where++import Data.Tensort.Utils.ComparisonFunctions (lessThanInt, lessThanRecord)+import Data.Tensort.Utils.Types (Record, Sortable (..))++bubblesort :: Sortable -> Sortable+bubblesort (SortInt ints) = SortInt (foldr acc [] ints)+  where+    acc :: Int -> [Int] -> [Int]+    acc x xs = bubblesortSinglePass x xs lessThanInt+bubblesort (SortRec recs) = SortRec (foldr acc [] recs)+  where+    acc :: Record -> [Record] -> [Record]+    acc x xs = bubblesortSinglePass x xs lessThanRecord++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

@@ -0,0 +1,16 @@+module Data.Tensort.Subalgorithms.Magicsort+  ( magicsort,+  )+where++import Data.Tensort.Subalgorithms.Bogosort (bogosort)+import Data.Tensort.Subalgorithms.Permutationsort (permutationsort)+import Data.Tensort.Utils.Types (Sortable)++magicsort :: Sortable -> Sortable+magicsort xs = do+  let result1 = permutationsort xs+  let result2 = bogosort xs+  if result1 == result2+    then result1+    else magicsort xs

@@ -0,0 +1,23 @@+module Data.Tensort.Subalgorithms.Permutationsort (permutationsort) where++import Data.List (permutations)+import Data.Tensort.Utils.Check (isSorted)+import Data.Tensort.Utils.Types (Record, Sortable (..), fromSortInt, fromSortRec)++permutationsort :: Sortable -> Sortable+permutationsort (SortInt xs) = SortInt (acc (permutations x) [])+  where+    x = xs+    acc :: [[Int]] -> [Int] -> [Int]+    acc [] unsortedPermutations = fromSortInt (permutationsort (SortInt unsortedPermutations))+    acc (permutation : remainingPermutations) unsortedPermutations+      | isSorted (SortInt permutation) = permutation+      | otherwise = acc remainingPermutations unsortedPermutations+permutationsort (SortRec xs) = SortRec (acc (permutations x) [])+  where+    x = xs+    acc :: [[Record]] -> [Record] -> [Record]+    acc [] unsortedPermutations = fromSortRec (permutationsort (SortRec unsortedPermutations))+    acc (permutation : remainingPermutations) unsortedPermutations+      | isSorted (SortRec permutation) = permutation+      | otherwise = acc remainingPermutations unsortedPermutations

@@ -0,0 +1,29 @@+module Data.Tensort.Subalgorithms.ReverseExchangesort (reverseExchangesort) where++import Data.Tensort.Utils.ComparisonFunctions (greaterThanInt, greaterThanRecord)+import Data.Tensort.Utils.Types (Sortable (..))++reverseExchangesort :: Sortable -> Sortable+reverseExchangesort (SortInt ints) = SortInt (reverseExchangesortIterable ints (length ints - 1) (length ints - 2) greaterThanInt)+reverseExchangesort (SortRec recs) = SortRec (reverseExchangesortIterable recs (length recs - 1) (length recs - 2) greaterThanRecord)++reverseExchangesortIterable :: [a] -> Int -> Int -> (a -> a -> Bool) -> [a]+reverseExchangesortIterable xs i j greaterThan = do+  if i < 1+    then xs+    else+      if j < 0+        then reverseExchangesortIterable xs (i - 1) (i - 2) greaterThan+        else+          if greaterThan (xs !! j) (xs !! i)+            then reverseExchangesortIterable (swap xs i j) i (j - 1) greaterThan+            else reverseExchangesortIterable xs i (j - 1) greaterThan++swap :: [a] -> Int -> Int -> [a]+swap xs i j = do+  let x = xs !! i+  let y = xs !! j+  let left = take j xs+  let middle = take (i - j - 1) (drop (j + 1) xs)+  let right = drop (i + 1) xs+  left ++ [y] ++ middle ++ [x] ++ right

@@ -0,0 +1,56 @@+module Data.Tensort.Subalgorithms.Supersort+  ( supersort,+    mundaneSuperStrat,+    magicSuperStrat,+  )+where++import Data.Tensort.Utils.Types (SortAlg, Sortable (..), SupersortStrat)++supersort :: Sortable -> (SortAlg, SortAlg, SortAlg, SupersortStrat) -> Sortable+supersort xs (subAlg1, subAlg2, subAlg3, superStrat) = do+  let result1 = subAlg1 xs+  let result2 = subAlg2 xs+  if result1 == result2+    then result1+    else superStrat (result1, result2, subAlg3 xs)++mundaneSuperStrat :: SupersortStrat+mundaneSuperStrat (SortInt result1, SortInt result2, SortInt result3) = do+  if result1 == result3 || result2 == result3+    then SortInt result3+    else+      if last result1 == last result2 || last result1 == last result3+        then SortInt result1+        else+          if last result2 == last result3+            then SortInt result2+            else SortInt 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."++magicSuperStrat :: SupersortStrat+magicSuperStrat (SortInt result1, SortInt result2, SortInt result3) = do+  if last result1 == last result3 || last result2 == last result3+    then SortInt result3+    else+      if last result1 == last result2+        then SortInt result1+        else SortInt 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."

@@ -0,0 +1,41 @@+module Data.Tensort.Tensort+  ( tensort,+    tensortBasic2Bit,+    tensortBasic3Bit,+    tensortBasic4Bit,+    mkTSProps,+  )+where++import Data.Tensort.Subalgorithms.Bubblesort (bubblesort)+import Data.Tensort.Utils.Convert (rawBitsToBytes)+import Data.Tensort.Utils.RandomizeList (randomizeList)+import Data.Tensort.Utils.Reduce (reduceTensorStacks)+import Data.Tensort.Utils.Render (getSortedBitsFromMetastack)+import Data.Tensort.Utils.Tensor (getTensorStacksFromBytes)+import Data.Tensort.Utils.Types (Sortable (..), TensortProps (..), fromSortInt)++mkTSProps :: Int -> (Sortable -> Sortable) -> TensortProps+mkTSProps bSize subAlg = TensortProps {bytesize = bSize, subAlgorithm = subAlg}++tensortBasic2Bit :: [Int] -> [Int]+tensortBasic2Bit xs = tensort xs (mkTSProps 2 bubblesort)++tensortBasic3Bit :: [Int] -> [Int]+tensortBasic3Bit xs = tensort xs (mkTSProps 3 bubblesort)++tensortBasic4Bit :: [Int] -> [Int]+tensortBasic4Bit xs = tensort xs (mkTSProps 4 bubblesort)++-- | Sort a list of Ints using the Tensort algorithm++-- | ==== __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 :: [Int] -> TensortProps -> [Int]+tensort xs tsProps = do+  let bits = randomizeList (SortInt xs) 143+  let bytes = rawBitsToBytes (fromSortInt bits) tsProps+  let tensorStacks = getTensorStacksFromBytes bytes tsProps+  let metastack = reduceTensorStacks tensorStacks tsProps+  getSortedBitsFromMetastack metastack (subAlgorithm tsProps)

@@ -0,0 +1,12 @@+module Data.Tensort.Utils.Check (isSorted) where++import Data.Tensort.Utils.ComparisonFunctions (lessThanInt, lessThanRecord)+import Data.Tensort.Utils.Types (Sortable (..))++isSorted :: Sortable -> Bool+isSorted (SortInt []) = True+isSorted (SortInt [_]) = True+isSorted (SortInt (x : y : remainingElements)) = lessThanInt x y && isSorted (SortInt (y : remainingElements))+isSorted (SortRec []) = True+isSorted (SortRec [_]) = True+isSorted (SortRec (x : y : remainingElements)) = lessThanRecord x y && isSorted (SortRec (y : remainingElements))

@@ -0,0 +1,29 @@+module Data.Tensort.Utils.ComparisonFunctions+  ( lessThanInt,+    lessThanRecord,+    greaterThanInt,+    greaterThanRecord,+    lessThanOrEqualInt,+    lessThanOrEqualRecord,+  )+where++import Data.Tensort.Utils.Types (Record)++lessThanInt :: Int -> Int -> Bool+lessThanInt x y = x < y++lessThanRecord :: Record -> Record -> Bool+lessThanRecord x y = snd x < snd y++greaterThanInt :: Int -> Int -> Bool+greaterThanInt x y = x > y++greaterThanRecord :: Record -> Record -> Bool+greaterThanRecord x y = snd x > snd y++lessThanOrEqualInt :: Int -> Int -> Bool+lessThanOrEqualInt x y = x <= y++lessThanOrEqualRecord :: Record -> Record -> Bool+lessThanOrEqualRecord x y = snd x <= snd y

@@ -0,0 +1,21 @@+module Data.Tensort.Utils.Convert (rawBitsToBytes) where++import Data.Tensort.Utils.Split (splitEvery)+import Data.Tensort.Utils.Types (Byte, Sortable (..), TensortProps (..), fromSortInt)++-- | Convert a list of Bits to a list of Bytes of given bytesize, bubblesorting+--   each byte.++-- | ==== __Examples__+--   >>> rawBitsToBytes [5,1,3,7,8,2,4,6] 4+--   [[2,4,6,8],[1,3,5,7]]+-- rawBitsToBytes :: [Int] -> Int -> [Byte]+-- rawBitsToBytes bits bytesize = foldr acc [] (splitEvery bytesize bits)+--   where+--     acc :: [Int] -> [Byte] -> [Byte]+--     acc byte bytes = bytes ++ [fromSortInt (bubblesort (SortInt byte))]+rawBitsToBytes :: [Int] -> TensortProps -> [Byte]+rawBitsToBytes bits tsProps = foldr acc [] (splitEvery (bytesize tsProps) bits)+  where+    acc :: [Int] -> [Byte] -> [Byte]+    acc byte bytes = bytes ++ [fromSortInt (subAlgorithm tsProps (SortInt byte))]

@@ -0,0 +1,9 @@+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 (SortInt xs) seed = SortInt (shuffle' xs (length xs) (mkStdGen seed))+randomizeList (SortRec xs) seed = SortRec (shuffle' xs (length xs) (mkStdGen seed))

@@ -0,0 +1,35 @@+module Data.Tensort.Utils.Reduce (reduceTensorStacks) where++import Data.Tensort.Utils.Split (splitEvery)+import Data.Tensort.Utils.Tensor (createTensorStack)+import Data.Tensort.Utils.Types (TensorStack, TensortProps (..))++-- | Take a list of TensorStacks and group them together in new+--   TensorStacks, each containing bytesize number of Tensors (former+--   TensorStacks), until the number of TensorStacks is equal to the bytesize++-- | 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+  if length newTensorStacks <= bytesize tsProps+    then createTensorStack newTensorStacks (subAlgorithm tsProps)+    else reduceTensorStacks newTensorStacks tsProps++-- | 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+-- [([(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)+  where+    acc :: [TensorStack] -> [TensorStack] -> [TensorStack]+    acc tensorStack newTensorStacks = newTensorStacks ++ [createTensorStack tensorStack (subAlgorithm tsProps)]

@@ -0,0 +1,71 @@+module Data.Tensort.Utils.Render (getSortedBitsFromMetastack) where++import Data.Maybe (isNothing)+import Data.Tensort.Utils.Tensor (createTensor)+import Data.Tensort.Utils.Types (Memory (..), SortAlg, Sortable (..), Tensor, TensorStack, fromJust, fromSortInt)++-- | Compile a sorted list of Bits from a list of TensorStacks++-- | ==== __Examples__+--  >>> getSortedBitsFromMetastack ([(0,5),(1,7)],ByteMem [[1,5],[3,7]])+--  [1,3,5,7]+--  >>> getSortedBitsFromMetastack ([(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]+getSortedBitsFromMetastack :: TensorStack -> SortAlg -> [Int]+getSortedBitsFromMetastack metastackRaw subAlg = acc metastackRaw []+  where+    acc :: TensorStack -> [Int] -> [Int]+    acc metastack sortedBits = do+      let (nextBit, metastack') = removeTopBitFromTensor metastack subAlg+      if isNothing metastack'+        then nextBit : sortedBits+        else do+          acc (fromJust metastack') (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]])+--   (7,Just ([(1,3),(0,5)],ByteMem [[1,5],[3]]))+removeTopBitFromTensor :: Tensor -> SortAlg -> (Int, Maybe Tensor)+removeTopBitFromTensor (register, memory) tsProps = do+  let topRecord = last register+  let topAddress = fst topRecord+  let (topBit, memory') = removeBitFromMemory memory topAddress tsProps+  if isNothing memory'+    then (topBit, Nothing)+    else (topBit, Just (createTensor (fromJust memory') tsProps))++removeBitFromMemory :: Memory -> Int -> SortAlg -> (Int, Maybe Memory)+removeBitFromMemory (ByteMem bytes) i subAlg = do+  let topByte = bytes !! i+  let topBit = last topByte+  let topByte' = init topByte+  case length topByte' of+    0 -> do+      let bytes' = take i bytes ++ drop (i + 1) bytes+      if null bytes'+        then (topBit, Nothing)+        else (topBit, Just (ByteMem bytes'))+    1 -> do+      let bytes' = take i bytes ++ [topByte'] ++ drop (i + 1) bytes+      (topBit, Just (ByteMem bytes'))+    _ -> do+      let topByte'' = fromSortInt (subAlg (SortInt topByte'))+      let bytes' = take i bytes ++ [topByte''] ++ drop (i + 1) bytes+      (topBit, Just (ByteMem bytes'))+removeBitFromMemory (TensorMem tensors) i subAlg = do+  let topTensor = tensors !! i+  let (topBit, topTensor') = removeTopBitFromTensor topTensor subAlg+  if isNothing topTensor'+    then do+      let tensors' = take i tensors ++ drop (i + 1) tensors+      if null tensors'+        then (topBit, Nothing)+        else (topBit, Just (TensorMem tensors'))+    else do+      let tensors' = take i tensors ++ [fromJust topTensor'] ++ drop (i + 1) tensors+      (topBit, Just (TensorMem tensors'))

@@ -0,0 +1,6 @@+module Data.Tensort.Utils.Split (splitEvery) where++-- | Split a list into chunks of a given size.+splitEvery :: Int -> [a] -> [[a]]+splitEvery _ [] = []+splitEvery n xs = take n xs : splitEvery n (drop n xs)

@@ -0,0 +1,101 @@+module Data.Tensort.Utils.Tensor+  ( getTensorStacksFromBytes,+    createTensor,+    getTensorFromBytes,+    createTensorStack,+  )+where++import Data.Tensort.Utils.Split (splitEvery)+import Data.Tensort.Utils.Types (Byte, Memory (..), Record, SortAlg, Sortable (..), Tensor, TensorStack, TensortProps (..), fromSortRec)++-- | Convert a list of Bytes to a list of TensorStacks.++-- | This is accomplished by making a Tensor for each Byte, converting that+--   Tensor into a TensorStack (these are equivalent terms - see type+--   definitions for more info) and collating the TensorStacks into a list++-- | ==== __Examples__+--  >>> getTensorStacksFromBytes [[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]])]+getTensorStacksFromBytes :: [Byte] -> TensortProps -> [TensorStack]+getTensorStacksFromBytes bytes tsProps = foldr acc [] (splitEvery (bytesize tsProps) bytes)+  where+    acc :: [Byte] -> [TensorStack] -> [TensorStack]+    acc byte tensorStacks = tensorStacks ++ [getTensorFromBytes byte (subAlgorithm tsProps)]++-- | Create a Tensor from a Memory+--   Aliases to getTensorFromBytes for ByteMem and createTensorStack for+--   TensorMem++-- | I expect to refactor to simplify this before initial release+createTensor :: Memory -> SortAlg -> Tensor+createTensor (ByteMem bytes) subAlg = getTensorFromBytes bytes subAlg+createTensor (TensorMem tensors) subAlg = createTensorStack tensors subAlg++-- | Convert a list of Bytes to a Tensor++-- | We do this by loading the list of Bytes into the new Tensor's Memory+--   and adding a sorted Register containing References to each Byte in Memory++-- | Each Record contains an Address pointing to the index of the referenced+--   Byte and a TopBit containing the value of the last (i.e. highest) Bit in+--   the referenced Byte++-- | The Register is bubblesorted 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+  let register = acc bytes [] 0+  let register' = fromSortRec (subAlg (SortRec register))+  (register', ByteMem bytes)+  where+    acc :: [Byte] -> [Record] -> Int -> [Record]+    acc [] register _ = register+    acc ([] : remainingBytes) register i = acc remainingBytes register (i + 1)+    acc (byte : remainingBytes) register i = acc remainingBytes (register ++ [(i, last byte)]) (i + 1)++-- | Create a TensorStack with the collated and bubblesorted References from the+--   Tensors as the Register and the original Tensors as the data++-- | ==== __Examples__+-- >>> createTensorStack [([(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]])])+createTensorStack :: [Tensor] -> SortAlg -> TensorStack+createTensorStack tensors subAlg = (fromSortRec (subAlg (SortRec (getRegisterFromTensors tensors))), TensorMem tensors)++-- | For each Tensor, produces a Record by combining the top bit of the+--  Tensor with an index value for its Address++-- | Note that this output is not sorted. Sorting is done in the+--   createTensorStack 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 []+  where+    acc :: [Tensor] -> [Record] -> [Record]+    acc [] records = records+    acc (([], _) : remainingTensors) records = acc remainingTensors records+    acc (tensor : remainingTensors) records = acc remainingTensors (records ++ [(i, getTopBitFromTensorStack tensor)])+      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+--   of the Tensor referenced in the last record of the last Tensor of...+--   and so on until you reach the top level of the TensorStack++-- | 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 -> Int+getTopBitFromTensorStack (register, _) = snd (last register)

@@ -0,0 +1,91 @@+{-# LANGUAGE GADTs #-}++module Data.Tensort.Utils.Types where++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++--   I know this might sound confusing, but in a recursive algorithm like this+--   it's helpful to have different names for the same type of data depending+--   on how it's being used, while still being able to use the same data in+--   multiple contexts++-- | A Bit is a single element of the list to be sorted. For+--   our current purposes that means it is an Int+type Bit = Int++-- | 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]++-- | An Address is a index number pointing to data stored in Memory+type Address = Int++-- | A TopBit contains a copy of the last (i.e. highest) Bit in a Byte or+--   Tensor+type TopBit = Bit++-- | A Record is an element in a Tensor or Metatensor's Register+--   containing an Address pointer and a TopBit value++-- | A Record's Address is an index number pointing to a Byte or Tensor in+--   the Tensor/Metatensor's Memory++-- | A Record's TopBit is a copy of the last (i.e. highest) Bit in the Byte or+--   Tensor that the Record references+type Record = (Address, TopBit)++-- | A Register is a list of Records allowing for easy access to data in a+--   Tensor or Metatensor's Memory+type Register = [Record]++-- | We use a Sortable type sort between Ints and Records++-- | In the future this may be expanded to include other data types and allow+--   for sorting other types of besides Ints+data Sortable+  = SortInt [Int]+  | SortRec [Record]+  deriving (Show, Eq, Ord)++fromSortInt :: Sortable -> [Int]+fromSortInt (SortInt ints) = ints+fromSortInt (SortRec _) = error "This is for sorting Integers - you gave me Records"++fromSortRec :: Sortable -> [Record]+fromSortRec (SortRec recs) = recs+fromSortRec (SortInt _) = error "This is for sorting Records - you gave me Integers"++type SortAlg = Sortable -> Sortable++type SupersortProps = (SortAlg, SortAlg, SortAlg, SupersortStrat)++type SupersortStrat = (Sortable, Sortable, Sortable) -> Sortable++-- | A Memory contains the data to be sorted, either in the form of Bytes or+--   Tensors+data Memory+  = ByteMem [Byte]+  | TensorMem [Tensor]+  deriving (Show, Eq, Ord)++-- | A Tensor is a Metatensor that only contains Bytes in its memory+-- | The Memory is a list of the Bytes or Tensors that the Tensor+--   contains.++-- | The Register is a list of Records referencing the top Bits in Memory+type Tensor = (Register, Memory)++-- | 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+type TensorStack = Tensor++fromJust :: Maybe a -> a+fromJust (Just x) = x+fromJust Nothing = error "fromJust: Nothing"

@@ -0,0 +1,153 @@+cabal-version:      3.4+-- The cabal-version field refers to the version of the .cabal specification,+-- and can be different from the cabal-install (the tool) version and the+-- Cabal (the library) version you are using. As such, the Cabal (the library)+-- version used must be equal or greater than the version stated in this field.+-- Starting from the specification version 2.2, the cabal-version field must be+-- the first thing in the cabal file.++-- Initial package description 'tensort' generated by+-- 'cabal init'. For further documentation, see:+--   http://haskell.org/cabal/users-guide/+--+-- The name of the package.+name:               tensort++-- The package version.+-- See the Haskell package versioning policy (PVP) for standards+-- guiding when and how versions should be incremented.+-- https://pvp.haskell.org+-- PVP summary:     +-+------- breaking API changes+--                  | | +----- non-breaking API additions+--                  | | | +--- code changes with no API change+version:            0.1.0.0++-- A short (one-line) description of the package.+synopsis:           Reasonably robust sorting in O(n log n) time++-- A longer description of the package.+description:        An exploration of robustness in algorithms for sorting integers, inspired by [Beyond Efficiency](https://www.cs.unm.edu/~ackley/be-201301131528.pdf) by David H. Ackley++-- The license under which the package is released.+license:            MIT++-- The file containing the license text.+license-file:       LICENSE++-- The package author(s).+author:             Kyle Beechly++-- An email address to which users can send suggestions, bug reports, and patches.+maintainer:         contact@kaBeech.com++-- A copyright notice.+copyright:          2024 Kyle Beechly++category:           Math,+                    Data++build-type:         Simple++-- Extra doc files to be distributed with the package, such as a CHANGELOG or a README.+extra-doc-files:    CHANGELOG.md++-- Extra source files to be distributed with the package, such as examples, or a tutorial module.+-- extra-source-files:++common warnings+    ghc-options: -Wall++library+    -- Import common warning flags.+    import:           warnings++    -- Modules exported by the library.+    exposed-modules:  Data.Tensort,+                      Data.Tensort.Tensort,+                      Data.Tensort.Robustsort,+                      Data.Tensort.Utils.Types,+                      Data.Tensort.Subalgorithms.Bubblesort,+                      Data.Tensort.Subalgorithms.ReverseExchangesort,+                      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,++    -- Modules included in this library but not exported.+    other-modules:    Data.Tensort.Utils.Check,+                      Data.Tensort.Utils.Split,+                      Data.Tensort.Utils.ComparisonFunctions,+                      Data.Tensort.Utils.Convert,+                      Data.Tensort.Utils.Tensor,+                      Data.Tensort.Utils.Reduce,+                      Data.Tensort.Utils.Render,++    -- LANGUAGE extensions used by modules in this package.+    -- other-extensions:++    -- Other library packages from which modules are imported.+    build-depends:    base ^>=4.18.2.0,+                      mtl >= 2.3.1 && < 2.4,+                      random >= 1.2.1 && < 1.3,+                      random-shuffle >= 0.0.4 && < 0.1,++    -- Directories containing source files.+    hs-source-dirs:   src++    -- Base language which the package is written in.+    default-language: Haskell2010++executable tensort+    -- Import common warning flags.+    import:           warnings++    -- .hs or .lhs file containing the Main module.+    main-is:          Main.hs++    -- Modules included in this executable, other than Main.+    -- other-modules:++    -- LANGUAGE extensions used by modules in this package.+    -- other-extensions:++    -- Other library packages from which modules are imported.+    build-depends:+        base ^>=4.18.2.0,+        tensort,+        time >= 1.12.2 && < 1.13,++    -- Directories containing source files.+    hs-source-dirs:   app++    -- Base language which the package is written in.+    default-language: Haskell2010++test-suite tensort-test+    -- Import common warning flags.+    import:           warnings++    -- Base language which the package is written in.+    default-language: Haskell2010++    -- Modules included in this executable, other than Main.+    -- other-modules:++    -- LANGUAGE extensions used by modules in this package.+    -- other-extensions:++    -- The interface type and version of the test suite.+    type:             exitcode-stdio-1.0++    -- Directories containing source files.+    hs-source-dirs:   test++    -- The entrypoint to the test suite.+    main-is:          Main.hs++    -- Test dependencies.+    build-depends:+        base ^>=4.18.2.0,+        tensort

@@ -0,0 +1,4 @@+module Main (main) where++main :: IO ()+main = putStrLn "Test suite not yet implemented."