1 module Sorters 2 3 ( msort, msortwith 4 , oemerge, oemerges 5 , unimerge, unimerges 6 , diff, dsplit 7 , uniq, us 8 , Plug(..), unplug 9 ) 10 11 where 12 13 import Trace 14 15 infixl 5 `oemerge` 16 infixl 5 `unimerge` 17 18 msort :: Ord a => [a] -> [a] 19 msort = oemerges . runs -- todo: which is better? 20 -- mrgsort 21 22 23 -- utilities for sorting and merging ----------------------------------- 24 25 -- find runs 26 runs :: Ord a => [a] -> [[a]] 27 runs [] = [] 28 runs [x] = [[x]] 29 runs (x : xs) = 30 let rrs @ (r @ (y:_) : rs) = runs xs 31 in if x <= y then (x : r) : rs 32 else [x] : rrs 33 34 35 mrgsort :: Ord a => [a] -> [a] 36 mrgsort [] = []; mrgsort [x] = [x] 37 mrgsort [x,y] = if x < y then [x,y] else [y,x] 38 mrgsort xs = 39 let (as, bs) = conquer xs 40 in oemerge (mrgsort as) (mrgsort bs) 41 42 conquer [] = ([],[]) 43 conquer [x] = ([x], []) 44 conquer (x : y : zs) = let (as, bs) = conquer zs in (x : as, y : bs) 45 46 47 48 49 oemerge :: Ord a => [a] -> [a] -> [a] 50 -- keeps duplicates 51 oemerge [] ys = ys; oemerge xs [] = xs 52 oemerge xxs @ (x : xs) yys @ (y : ys) = 53 if x < y then x : oemerge xs yys else y : oemerge xxs ys 54 55 56 oemerges :: Ord a => [[a]] -> [a] 57 oemerges [] = [] 58 oemerges [xs] = xs 59 oemerges [xs,ys] = oemerge xs ys 60 oemerges xss = 61 let (ass, bss) = conquer xss 62 in oemerge (oemerges ass) (oemerges bss) 63 64 65 unimerge :: Ord a => [a] -> [a] -> [a] 66 -- removes duplicates 67 unimerge xs [] = xs; unimerge [] ys = ys 68 unimerge xxs @ (x : xs) yys @ (y : ys) = case compare x y of 69 LT -> x : unimerge xs yys 70 GT -> y : unimerge xxs ys 71 EQ -> x : unimerge xs ys 72 73 unimerges :: Ord a => [[a]] -> [a] 74 -- removes duplicates 75 unimerges [] = [] 76 unimerges [xs] = xs 77 unimerges [xs,ys] = unimerge xs ys 78 unimerges xss = 79 let (ass, bss) = conquer xss 80 in unimerge (unimerges ass) (unimerges bss) 81 82 83 84 85 uniq :: Ord a => [a] -> [a] 86 -- arg must be sorted already 87 uniq [] = []; uniq [x] = [x] 88 uniq (x : yys @ (y : ys)) 89 = (if x == y then id else (x :)) (uniq yys) 90 91 us :: Ord a => [a] -> [a] 92 us = uniq . msort 93 94 diff :: Ord a => [a] -> [a] -> [a] 95 -- diff xs ys = all x <- xs that are not in ys 96 -- args must be sorted, without duplicates 97 diff [] ys = []; diff xs [] = xs 98 diff xxs @ (x : xs) yys @ (y : ys) 99 | x == y = diff xs ys 100 | x < y = x : diff xs yys 101 | otherwise = diff xxs ys 102 103 dsplit :: Ord a => [a] -> [a] -> ([a],[a]) 104 -- dsplit xs ys = (as, bs) where as = xs intersect ys, bs = xs setminus ys 105 dsplit [] ys = ([], []) 106 dsplit xs [] = ([], xs) 107 dsplit xxs @ (x : xs) yys @ (y : ys) 108 | x == y = let (as, bs) = dsplit xs ys in (x : as, bs) 109 | x < y = let (as, bs) = dsplit xs yys in ( as, x : bs) 110 | otherwise = let (as, bs) = dsplit xxs ys in ( as, bs) 111 112 --------------------------------------------------------------------- 113 114 best :: Ord a => [a] -> [a] 115 best = take 1 . reverse . msort 116 117 --------------------------------------------------------------------- 118 119 asc :: Ord b => [(a, b)] -> [(a, b)] 120 -- show successive maxima, lazily 121 asc [] = [] 122 asc ((x, c) : xs) = (x, c) : asc [ (x', c') | (x', c') <- xs, c' > c ] 123 124 ascWith :: Ord b => (a -> b) -> [a] -> [a] 125 ascWith f xs = [ x | (x, c) <- asc [ (x, f x) | x <- xs ] ] 126 127 128 ----------------------------------------------------------------------- 129 130 data Plug a b = Plug a b deriving Show 131 132 instance Eq a => Eq (Plug a b) where Plug x _ == Plug y _ = x == y 133 instance Ord a => Ord (Plug a b) where Plug x _ < Plug y _ = x < y 134 135 unplug :: Plug a b -> b; unplug (Plug x y) = y 136 137 msortwith :: Ord b => (a -> b) -> [a] -> [a] 138 msortwith f xs = map unplug . msort $ [ Plug (f x) x | x <- xs ]