diff options
author | Jed Barber <jjbarber@y7mail.com> | 2015-10-18 13:19:48 +1100 |
---|---|---|
committer | Jed Barber <jjbarber@y7mail.com> | 2015-10-18 13:19:48 +1100 |
commit | faeec19d3a971efdc94e86c5fc2d59239b04e84a (patch) | |
tree | 57e3f911660bf506594b72df1fab4301cfebaa03 /sort/pancakesort.hs | |
parent | 63c3043200de6b28a8c192f1b5625940435ea55e (diff) |
Added shell, stooge, pancake sorts
Diffstat (limited to 'sort/pancakesort.hs')
-rw-r--r-- | sort/pancakesort.hs | 30 |
1 files changed, 30 insertions, 0 deletions
diff --git a/sort/pancakesort.hs b/sort/pancakesort.hs new file mode 100644 index 0000000..30993ba --- /dev/null +++ b/sort/pancakesort.hs @@ -0,0 +1,30 @@ + + + +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 + + |