1 module Sort where 2 import List (partition) 3 -- trying various sorts 4 5 quickSort :: Ord a => [a] -> [a] 6 quickSort2 :: Ord a => [a] -> [a] 7 quickerSort :: Ord a => [a] -> [a] 8 insertSort :: Ord a => [a] -> [a] 9 treeSort :: Ord a => [a] -> [a] 10 treeSort2 :: Ord a => [a] -> [a] 11 heapSort :: Ord a => [a] -> [a] 12 mergeSort :: Ord a => [a] -> [a] 13 14 quickSort [] = [] 15 quickSort (x:xs) = (quickSort lo) ++ (x : quickSort hi) 16 where 17 lo = [ y | y <- xs, y <= x ] 18 hi = [ y | y <- xs, y > x ] 19 20 -- the same thing, w/ "partition" [whose implementation I don't trust] 21 quickSort2 [] = [] 22 quickSort2 (x:xs) = (quickSort2 lo) ++ (x : quickSort2 hi) 23 where 24 (lo, hi) = partition ((>=) x) xs 25 26 -- tail-recursive, etc., "quicker sort" [as per Meira thesis] 27 quickerSort [] = [] 28 quickerSort [x] = [x] 29 quickerSort (x:xs) = split x [] [] xs 30 where 31 split x lo hi [] = quickerSort lo ++ (x : quickerSort hi) 32 split x lo hi (y:ys) | y <= x = split x (y:lo) hi ys 33 | True = split x lo (y:hi) ys 34 35 ------------------------------------------------------------- 36 -- as per Meira thesis 37 38 insertSort [] = [] 39 insertSort (x:xs) = trins [] [x] xs 40 where 41 trins :: Ord a => [a] -> [a] -> [a] -> [a] 42 43 trins rev [] (y:ys) = trins [] ((reverse rev) ++ [y]) ys 44 trins rev xs [] = (reverse rev) ++ xs 45 trins rev (x:xs) (y:ys) | x < y = trins (x:rev) xs (y:ys) 46 | True = trins [] (reverse rev ++ (y:x:xs)) ys 47 48 ------------------------------------------------------------- 49 -- again, as per Meira thesis 50 51 data Tree a = Tip | Branch a (Tree a) (Tree a) deriving () 52 53 treeSort = readTree . mkTree 54 where 55 mkTree :: Ord a => [a] -> Tree a 56 mkTree = foldr to_tree Tip 57 where 58 to_tree :: Ord a => a -> Tree a -> Tree a 59 to_tree x Tip = Branch x Tip Tip 60 to_tree x (Branch y l r) | x <= y = Branch y (to_tree x l) r 61 | True = Branch y l (to_tree x r) 62 63 readTree :: Ord a => Tree a -> [a] 64 readTree Tip = [] 65 readTree (Branch x l r) = readTree l ++ (x : readTree r) 66 67 -- try it w/ bushier trees 68 69 data Tree2 a = Tip2 | Twig2 a | Branch2 a (Tree2 a) (Tree2 a) deriving () 70 71 treeSort2 = readTree . mkTree 72 where 73 mkTree :: Ord a => [a] -> Tree2 a 74 mkTree = foldr to_tree Tip2 75 where 76 to_tree :: Ord a => a -> Tree2 a -> Tree2 a 77 to_tree x Tip2 = Twig2 x 78 to_tree x (Twig2 y) | x <= y = Branch2 y (Twig2 x) Tip2 79 | True = Branch2 y Tip2 (Twig2 x) 80 to_tree x (Branch2 y l r) | x <= y = Branch2 y (to_tree x l) r 81 | True = Branch2 y l (to_tree x r) 82 83 readTree :: Ord a => Tree2 a -> [a] 84 readTree Tip2 = [] 85 readTree (Twig2 x) = [x] 86 readTree (Branch2 x l r) = readTree l ++ (x : readTree r) 87 88 ------------------------------------------------------------- 89 -- ditto, Meira thesis 90 91 heapSort xs = clear (heap (0::Int) xs) 92 where 93 heap :: Ord a => Int -> [a] -> Tree a 94 heap k [] = Tip 95 heap k (x:xs) = to_heap k x (heap (k+(1::Int)) xs) 96 97 to_heap :: Ord a => Int -> a -> Tree a -> Tree a 98 to_heap k x Tip = Branch x Tip Tip 99 to_heap k x (Branch y l r) | x <= y && odd k = Branch x (to_heap (div2 k) y l) r 100 | x <= y = Branch x l (to_heap (div2 k) y r) 101 | odd k = Branch y (to_heap (div2 k) x l) r 102 | True = Branch y l (to_heap (div2 k) x r) 103 104 clear :: Ord a => Tree a -> [a] 105 clear Tip = [] 106 clear (Branch x l r) = x : clear (mix l r) 107 108 mix :: Ord a => Tree a -> Tree a -> Tree a 109 mix Tip r = r 110 mix l Tip = l 111 mix t1@(Branch x l1 r1) t2@(Branch y l2 r2) | x <= y = Branch x (mix l1 r1) t2 112 | True = Branch y t1 (mix l2 r2) 113 114 div2 :: Int -> Int 115 div2 k = k `div` 2 116 117 ------------------------------------------------------------- 118 -- ditto, Meira thesis 119 120 mergeSort = merge_lists . (runsplit []) 121 where 122 runsplit :: Ord a => [a] -> [a] -> [[a]] 123 runsplit [] [] = [] 124 runsplit run [] = [run] 125 runsplit [] (x:xs) = runsplit [x] xs 126 runsplit [r] (x:xs) | x > r = runsplit [r,x] xs 127 runsplit rl@(r:rs) (x:xs) | x <= r = runsplit (x:rl) xs 128 | True = rl : (runsplit [x] xs) 129 130 merge_lists :: Ord a => [[a]] -> [a] 131 merge_lists [] = [] 132 merge_lists (x:xs) = merge x (merge_lists xs) 133 134 merge :: Ord a => [a] -> [a] -> [a] 135 merge [] ys = ys 136 merge xs [] = xs 137 merge xl@(x:xs) yl@(y:ys) | x == y = x : y : (merge xs ys) 138 | x < y = x : (merge xs yl) 139 | True = y : (merge xl ys) 140