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.RandomizeList (randomizeList)
import Data.Tensort.Utils.Reduce (reduceTensorStacks)
import Data.Tensort.Utils.Render (getSortedBitsFromTensor)
import Data.Tensort.Utils.Types (Bit, SortAlg, Sortable (..), TensortProps (..), fromSortBit)

-- | Sort a list of Bits 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 :: [Bit] -> TensortProps -> [Bit]
tensort :: [Int] -> TensortProps -> [Int]
tensort [] TensortProps
_ = []
tensort [Int]
xs TensortProps
tsProps = do
  let bits :: Sortable
bits = Sortable -> Int -> Sortable
randomizeList ([Int] -> Sortable
SortBit [Int]
xs) Int
143
  let bytes :: [[Int]]
bytes = [Int] -> TensortProps -> [[Int]]
rawBitsToBytes (Sortable -> [Int]
fromSortBit Sortable
bits) TensortProps
tsProps
  let tensorStacks :: [Tensor]
tensorStacks = [[Int]] -> TensortProps -> [Tensor]
createInitialTensors [[Int]]
bytes TensortProps
tsProps
  let topTensor :: Tensor
topTensor = [Tensor] -> TensortProps -> Tensor
reduceTensorStacks [Tensor]
tensorStacks TensortProps
tsProps
  Tensor -> SortAlg -> [Int]
getSortedBitsFromTensor Tensor
topTensor (TensortProps -> SortAlg
subAlgorithm TensortProps
tsProps)

mkTSProps :: Int -> SortAlg -> TensortProps
mkTSProps :: Int -> SortAlg -> TensortProps
mkTSProps Int
bSize SortAlg
subAlg = TensortProps {bytesize :: Int
bytesize = Int
bSize, subAlgorithm :: SortAlg
subAlgorithm = SortAlg
subAlg}

tensortB4 :: [Bit] -> [Bit]
tensortB4 :: [Int] -> [Int]
tensortB4 [Int]
xs = [Int] -> TensortProps -> [Int]
tensort [Int]
xs (Int -> SortAlg -> TensortProps
mkTSProps Int
4 SortAlg
bubblesort)

tensortBN :: Int -> [Bit] -> [Bit]
tensortBN :: Int -> [Int] -> [Int]
tensortBN Int
n [Int]
xs = [Int] -> TensortProps -> [Int]
tensort [Int]
xs (Int -> SortAlg -> TensortProps
mkTSProps Int
n SortAlg
bubblesort)

tensortBL :: [Bit] -> [Bit]
tensortBL :: [Int] -> [Int]
tensortBL [] = []
tensortBL [Int
x] = [Int
x]
tensortBL [Int
x, Int
y] = if Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
y then [Int
x, Int
y] else [Int
y, Int
x]
tensortBL [Int]
xs = [Int] -> TensortProps -> [Int]
tensort [Int]
xs (Int -> SortAlg -> TensortProps
mkTSProps ([Int] -> Int
calculateBytesize [Int]
xs) SortAlg
bubblesort)

calculateBytesize :: [Bit] -> Int
calculateBytesize :: [Int] -> Int
calculateBytesize [Int]
xs = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Double -> Double
forall a. Floating a => a -> a
log (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
xs)) :: Double)