-- | 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
  ( 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 :: Sortable -> Sortable
bubblesort (SortBit [Bit]
bits) =
  [Bit] -> Sortable
SortBit
    ( (Bit -> Bit -> Bool) -> [Bit] -> Bit -> Bit -> [Bit]
forall a. Ord a => (a -> a -> Bool) -> [a] -> Bit -> Bit -> [a]
bublesortIterable Bit -> Bit -> Bool
greaterThanBit [Bit]
bits Bit
0 ([Bit] -> Bit
forall a. [a] -> Bit
forall (t :: * -> *) a. Foldable t => t a -> Bit
length [Bit]
bits)
    )
bubblesort (SortRec [Record]
recs) =
  [Record] -> Sortable
SortRec
    ( (Record -> Record -> Bool) -> [Record] -> Bit -> Bit -> [Record]
forall a. Ord a => (a -> a -> Bool) -> [a] -> Bit -> Bit -> [a]
bublesortIterable Record -> Record -> Bool
greaterThanRecord [Record]
recs Bit
0 ([Record] -> Bit
forall a. [a] -> Bit
forall (t :: * -> *) a. Foldable t => t a -> Bit
length [Record]
recs)
    )

bublesortIterable :: (Ord a) => (a -> a -> Bool) -> [a] -> Int -> Int -> [a]
bublesortIterable :: forall a. Ord a => (a -> a -> Bool) -> [a] -> Bit -> Bit -> [a]
bublesortIterable a -> a -> Bool
greaterThan [a]
xs Bit
currentIndex Bit
i
  | [a] -> Bit
forall a. [a] -> Bit
forall (t :: * -> *) a. Foldable t => t a -> Bit
length [a]
xs Bit -> Bit -> Bool
forall a. Ord a => a -> a -> Bool
< Bit
2 = [a]
xs
  | Bit
i Bit -> Bit -> Bool
forall a. Ord a => a -> a -> Bool
< Bit
1 =
      [a]
xs
  | Bit
currentIndex Bit -> Bit -> Bool
forall a. Ord a => a -> a -> Bool
> [a] -> Bit
forall a. [a] -> Bit
forall (t :: * -> *) a. Foldable t => t a -> Bit
length [a]
xs Bit -> Bit -> Bit
forall a. Num a => a -> a -> a
- Bit
2 =
      (a -> a -> Bool) -> [a] -> Bit -> Bit -> [a]
forall a. Ord a => (a -> a -> Bool) -> [a] -> Bit -> Bit -> [a]
bublesortIterable a -> a -> Bool
greaterThan [a]
xs Bit
0 (Bit
i Bit -> Bit -> Bit
forall a. Num a => a -> a -> a
- Bit
1)
  | Bool
otherwise =
      let left :: [a]
left = Bit -> [a] -> [a]
forall a. Bit -> [a] -> [a]
take Bit
currentIndex [a]
xs
          right :: [a]
right = Bit -> [a] -> [a]
forall a. Bit -> [a] -> [a]
drop (Bit
currentIndex Bit -> Bit -> Bit
forall a. Num a => a -> a -> a
+ Bit
2) [a]
xs
          x :: a
x = [a]
xs [a] -> Bit -> a
forall a. HasCallStack => [a] -> Bit -> a
!! Bit
currentIndex
          y :: a
y = [a]
xs [a] -> Bit -> a
forall a. HasCallStack => [a] -> Bit -> a
!! (Bit
currentIndex Bit -> Bit -> Bit
forall a. Num a => a -> a -> a
+ Bit
1)
          leftElemGreater :: Bool
leftElemGreater = a -> a -> Bool
greaterThan a
x a
y
          swappedXs :: [a]
swappedXs = [a]
left [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
y] [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
x] [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
right
       in if Bool
leftElemGreater
            then (a -> a -> Bool) -> [a] -> Bit -> Bit -> [a]
forall a. Ord a => (a -> a -> Bool) -> [a] -> Bit -> Bit -> [a]
bublesortIterable a -> a -> Bool
greaterThan [a]
swappedXs (Bit
currentIndex Bit -> Bit -> Bit
forall a. Num a => a -> a -> a
+ Bit
1) Bit
i
            else (a -> a -> Bool) -> [a] -> Bit -> Bit -> [a]
forall a. Ord a => (a -> a -> Bool) -> [a] -> Bit -> Bit -> [a]
bublesortIterable a -> a -> Bool
greaterThan [a]
xs (Bit
currentIndex Bit -> Bit -> Bit
forall a. Num a => a -> a -> a
+ Bit
1) Bit
i