Sort Stack


In [1]:
import Data.List (foldl')

In [2]:
{-# LANGUAGE ScopedTypeVariables #-}

In [3]:
sortStack :: forall a. Ord a => [a] -> [a]
sortStack [] = []
sortStack (a:as) = (r:esult)
    where
        moveStack :: [a] -> [a] -> [a]
        moveStack = foldl' (flip (:))

        sortStack' :: ([a], [a], a, Int) -> Maybe Int -> ([a], [a], a, Int)

        sortStack' ([], ys, e, depth) Nothing
            | depth /= 0 = sortStack' (eft, [], l, 0) $ Just (pred depth)
            | otherwise = (eft, [], l, depth)
            where
                (l:eft) = moveStack [] (e:ys)

        sortStack' (xs, [], e, depth) (Just 0) = (xs, [], e, depth)
        
        sortStack' (x:xs, ys, e, depth) limit
            | maybe False (depth >=) limit =
                let 
                    (l:eft) = moveStack (e:x:xs) ys 
                in
                    sortStack' (eft, [], l, 0) $ fmap pred limit
            | x > e =
                sortStack' (xs, e:ys, x, succ depth) limit
            | otherwise =
                sortStack' (xs, x:ys, e, succ depth) limit
                
        (esult, _, r, _) = sortStack' (as, [], a, 0) Nothing

In [4]:
sortStack []
sortStack [1]
sortStack [2, 1]
sortStack [3, 2, 1]


[]
[1]
[1,2]
[1,2,3]

Tests


In [5]:
import Test.QuickCheck

In [6]:
import Data.List (sort)

In [7]:
testSortStack :: [Int] -> Bool
testSortStack xs =
    sort xs == sortStack xs

In [8]:
quickCheck testSortStack


+++ OK, passed 100 tests.