diff options
author | Jed Barber <jjbarber@y7mail.com> | 2015-10-22 14:05:21 +1100 |
---|---|---|
committer | Jed Barber <jjbarber@y7mail.com> | 2015-10-22 14:05:21 +1100 |
commit | 0a48ed023ea65d75851ba2a4151100602695a2fd (patch) | |
tree | d3e5b41e148475d5d7aeca164a9ebc8bc99becdd /sort/pancake.hs | |
parent | 7dbbe1156c9489151dca6760b1021db426caf84e (diff) |
Cleaning up source a bit
Diffstat (limited to 'sort/pancake.hs')
-rw-r--r-- | sort/pancake.hs | 33 |
1 files changed, 33 insertions, 0 deletions
diff --git a/sort/pancake.hs b/sort/pancake.hs new file mode 100644 index 0000000..2bfdb4a --- /dev/null +++ b/sort/pancake.hs @@ -0,0 +1,33 @@ +module Pancake ( + pancakeSort + ) where + + + +pancakeSort :: Ord a => [a] -> [a] +pancakeSort [] = [] +pancakeSort cakeStack = + let selectedCake = indexOfLargest cakeStack + cakeStack' = (doFlip (length cakeStack)) . (doFlip selectedCake) $ cakeStack + in (pancakeSort (init cakeStack')) ++ [last cakeStack'] + + + +indexOfLargest :: Ord a => [a] -> Int +indexOfLargest (x:xs) = + let f m i j y = if length y == 0 + then i + else if (head y) > m + then f (head y) j (j+1) (tail y) + else f m i (j+1) (tail y) + in f x 0 1 xs + + + +doFlip :: Int -> [a] -> [a] +doFlip depth list = + let prefix = take (depth + 1) list + rest = drop (depth + 1) list + in (reverse prefix) ++ rest + + |