-- | 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 :: Sortable -> Sortable
bogosort = Int -> Sortable -> Sortable
bogosortSeeded Int
143

-- | 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 :: Int -> Sortable -> Sortable
bogosortSeeded Int
seed Sortable
xs
  | Sortable -> Bool
isSorted Sortable
xs = Sortable
xs
  | Bool
otherwise = Int -> Sortable -> Sortable
bogosortSeeded (Int
seed Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> Sortable -> Sortable
randomizeList Int
seed Sortable
xs)