-- | This module provides the magicsort function for sorting lists using the
--   Sortable type
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 (..))

-- | Takes a Sortable and returns a sorted Sortable
--
--   Adjudicates between three other sorting algorithms to return a robust
--   solution

-- | ==== __Examples__
-- >>> magicsort (SortBit [16, 23, 4, 8, 15, 42])
-- SortBit [4,8,15,16,23,42]
--
-- >>> magicsort (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)]
magicsort :: Sortable -> Sortable
magicsort :: Sortable -> Sortable
magicsort Sortable
xs = do
  let result1 :: Sortable
result1 = Sortable -> Sortable
permutationsort Sortable
xs
  let result2 :: Sortable
result2 = Sortable -> Sortable
bogosort Sortable
xs
  if Sortable -> Sortable -> Bool
verifyResults Sortable
result1 Sortable
result2
    then Sortable
result1
    else Sortable -> Sortable
magicsort Sortable
xs

verifyResults :: Sortable -> Sortable -> Bool
verifyResults :: Sortable -> Sortable -> Bool
verifyResults (SortBit [Bit]
xs) (SortBit [Bit]
ys) = [Bit]
xs [Bit] -> [Bit] -> Bool
forall a. Eq a => a -> a -> Bool
== [Bit]
ys
verifyResults (SortRec [Record]
xs) (SortRec [Record]
ys) = (Record -> Bit) -> [Record] -> [Bit]
forall a b. (a -> b) -> [a] -> [b]
map Record -> Bit
forall a b. (a, b) -> b
snd [Record]
xs [Bit] -> [Bit] -> Bool
forall a. Eq a => a -> a -> Bool
== (Record -> Bit) -> [Record] -> [Bit]
forall a b. (a -> b) -> [a] -> [b]
map Record -> Bit
forall a b. (a, b) -> b
snd [Record]
ys
verifyResults (SortBit [Bit]
_) (SortRec [Record]
_) = Bool
False
verifyResults (SortRec [Record]
_) (SortBit [Bit]
_) = Bool
False