-- | This module provides variations of the Tensort algorithm using the
--   Sortable type
module Data.Tensort.Tensort
  ( tensort,
    tensortB4,
    tensortBN,
    tensortBL,
  )
where

import Data.Tensort.Subalgorithms.Bubblesort (bubblesort)
import Data.Tensort.Utils.Compose (createInitialTensors)
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 (Sortable (..), TensortProps (..), fromSBitBits, fromSBitRecs)

-- | Sort a list of Sortables using a custom Tensort algorithm
--
-- | Takes TensortProps and a Sortable and returns a sorted Sortable

-- | ==== __Examples__
-- >>> 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 :: TensortProps -> Sortable -> Sortable
tensort TensortProps
_ (SortBit []) = [Int] -> Sortable
SortBit []
tensort TensortProps
_ (SortBit [Int
x]) = [Int] -> Sortable
SortBit [Int
x]
tensort TensortProps
tsProps (SortBit [Int
x, Int
y]) = TensortProps -> Sortable -> Sortable
subAlgorithm TensortProps
tsProps ([Int] -> Sortable
SortBit [Int
x, Int
y])
tensort TensortProps
tsProps (SortBit [Int]
xs) = do
  let bits :: Sortable
bits = Int -> Sortable -> Sortable
randomizeList Int
143 ([Int] -> Sortable
SortBit [Int]
xs)
  let bytes :: SBytes
bytes = TensortProps -> Sortable -> SBytes
rawToBytes TensortProps
tsProps Sortable
bits
  let tensorStacks :: STensors
tensorStacks = TensortProps -> SBytes -> STensors
createInitialTensors TensortProps
tsProps SBytes
bytes
  let topTensor :: STensorStack
topTensor = TensortProps -> STensors -> STensorStack
reduceTensorStacks TensortProps
tsProps STensors
tensorStacks
  [SBit] -> Sortable
fromSBitBits ((Sortable -> Sortable) -> STensorStack -> [SBit]
getSortedBitsFromTensor (TensortProps -> Sortable -> Sortable
subAlgorithm TensortProps
tsProps) STensorStack
topTensor)
tensort TensortProps
_ (SortRec []) = [Record] -> Sortable
SortRec []
tensort TensortProps
_ (SortRec [Record
x]) = [Record] -> Sortable
SortRec [Record
x]
tensort TensortProps
tsProps (SortRec [Record
x, Record
y]) = TensortProps -> Sortable -> Sortable
subAlgorithm TensortProps
tsProps ([Record] -> Sortable
SortRec [Record
x, Record
y])
tensort TensortProps
tsProps (SortRec [Record]
xs) = do
  let recs :: Sortable
recs = Int -> Sortable -> Sortable
randomizeList Int
143 ([Record] -> Sortable
SortRec [Record]
xs)
  let bytes :: SBytes
bytes = TensortProps -> Sortable -> SBytes
rawToBytes TensortProps
tsProps Sortable
recs
  let tensorStacks :: STensors
tensorStacks = TensortProps -> SBytes -> STensors
createInitialTensors TensortProps
tsProps SBytes
bytes
  let topTensor :: STensorStack
topTensor = TensortProps -> STensors -> STensorStack
reduceTensorStacks TensortProps
tsProps STensors
tensorStacks
  [SBit] -> Sortable
fromSBitRecs ((Sortable -> Sortable) -> STensorStack -> [SBit]
getSortedBitsFromTensor (TensortProps -> Sortable -> Sortable
subAlgorithm TensortProps
tsProps) STensorStack
topTensor)

-- | Sort a list of Sortables using a Standard Tensort algorithm with a 4-Bit
--   Bytesize

-- | ==== __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 :: Sortable -> Sortable
tensortB4 = TensortProps -> Sortable -> Sortable
tensort (Int -> (Sortable -> Sortable) -> TensortProps
mkTsProps Int
4 Sortable -> Sortable
bubblesort)

-- | Sort a list of Sortables using a Standard Tensort algorithm with a custom
--   Bytesize

-- | ==== __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 :: Int -> Sortable -> Sortable
tensortBN Int
n = TensortProps -> Sortable -> Sortable
tensort (Int -> (Sortable -> Sortable) -> TensortProps
mkTsProps Int
n Sortable -> Sortable
bubblesort)

-- | 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 :: Sortable -> Sortable
tensortBL Sortable
xs = TensortProps -> Sortable -> Sortable
tensort (Int -> (Sortable -> Sortable) -> TensortProps
mkTsProps (Sortable -> Int
calculateBytesize Sortable
xs) Sortable -> Sortable
bubblesort) Sortable
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 :: Sortable -> Int
calculateBytesize (SortBit [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)
calculateBytesize (SortRec [Record]
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 ([Record] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Record]
xs)) :: Double)