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