diff options
Diffstat (limited to 'lib/Data')
-rw-r--r-- | lib/Data/List/Merge.hs | 78 |
1 files changed, 78 insertions, 0 deletions
diff --git a/lib/Data/List/Merge.hs b/lib/Data/List/Merge.hs new file mode 100644 index 0000000..30853d9 --- /dev/null +++ b/lib/Data/List/Merge.hs | |||
@@ -0,0 +1,78 @@ | |||
1 | module Data.List.Merge where | ||
2 | |||
3 | -- | Ordinary Ord-based sorted list merge. | ||
4 | -- | ||
5 | -- TODO: verify fusion. | ||
6 | mergeL :: Ord a => [a] -> [a] -> [a] | ||
7 | mergeL as bs = mergeLists (mergeData compare as bs) const as bs | ||
8 | |||
9 | -- | Merge lists based on pre-computed comparison results. Use 'mergeData' to | ||
10 | -- perform the comparisons. | ||
11 | mergeLists :: [(Int,Ordering)] -- ^ comparison results. | ||
12 | -> (a -> a -> a) -- ^ combining function applied when 'EQ' is encountered. | ||
13 | -> [a] -- ^ sorted list | ||
14 | -> [a] -- ^ sorted list | ||
15 | -> [a] -- ^ merged sorted list | ||
16 | mergeLists ((n,LT):os) f xs ys = ls ++ mergeLists os f xs' ys | ||
17 | where | ||
18 | (ls,xs') = splitAt n xs | ||
19 | mergeLists ((n,EQ):os) f xs ys = es ++ mergeLists os f xs' ys' | ||
20 | where | ||
21 | (les,xs') = splitAt n xs | ||
22 | (res,ys') = splitAt n ys | ||
23 | es = zipWith f les res | ||
24 | mergeLists ((n,GT):os) f xs ys = gs ++ mergeLists os f xs ys' | ||
25 | where | ||
26 | (gs,ys') = splitAt n ys | ||
27 | mergeLists [] _ [] ys = ys | ||
28 | mergeLists [] _ xs [] = xs | ||
29 | mergeLists [] _ _ _ = error "mergeLists: insufficient data." -- xs ++ ys | ||
30 | |||
31 | -- | Inverse to 'mergeLists': given a list of comparison results, partition a | ||
32 | -- list into the parts necessary for 'mergeLists' to recreate it. | ||
33 | splitLists :: [(Int,Ordering)] -> [a] -> ([a],[a]) | ||
34 | splitLists ((n,LT):os) xs = (ls ++ lls, rrs) | ||
35 | where | ||
36 | (ls,xs') = splitAt n xs | ||
37 | (lls,rrs) = splitLists os xs' | ||
38 | splitLists ((n,EQ):os) xs = (es ++ lls, es ++ rrs) | ||
39 | where | ||
40 | (es,xs') = splitAt n xs | ||
41 | (lls,rrs) = splitLists os xs' | ||
42 | splitLists ((n,GT):os) xs = (lls, rs ++ rrs) | ||
43 | where | ||
44 | (rs,xs') = splitAt n xs | ||
45 | (lls,rrs) = splitLists os xs' | ||
46 | splitLists [] xs = (xs,xs) | ||
47 | |||
48 | |||
49 | -- | mergeData | ||
50 | -- | ||
51 | -- > mergeData compare [1,3,5] [2,2,4,6] ==> [(1,LT),(2,GT),(1,LT),(1,GT),(1,LT),(1,GT)] | ||
52 | -- | ||
53 | -- Given a comparison function and two sorted lists, 'mergeData' will return | ||
54 | -- a RLE compressed (run-length encoded) list of the comparison results | ||
55 | -- encountered while merging the lists. | ||
56 | -- | ||
57 | -- This data is enough information to perform the merge without doing the | ||
58 | -- comparisons or to reverse a merged list back to two sorted lists. | ||
59 | -- | ||
60 | -- When one list is exhausted, the length of the remaining list is returned | ||
61 | -- as a run-length for LT or GT depending on whether the left list or the | ||
62 | -- right list has elements. | ||
63 | mergeData :: (a -> a -> Ordering) -> [a] -> [a] -> [(Int,Ordering)] | ||
64 | mergeData comp (x:xs) (y:ys) | ||
65 | | comp x y == LT = case mergeData comp xs (y:ys) of | ||
66 | (n,LT):zs -> let n'=n+1 in n' `seq` (n',LT):zs | ||
67 | zs -> (1,LT):zs | ||
68 | | comp x y == EQ = case mergeData comp xs ys of | ||
69 | (n,EQ):zs -> let n'=n+1 in n' `seq` (n',EQ):zs | ||
70 | zs -> (1,EQ):zs | ||
71 | | otherwise = case mergeData comp (x:xs) ys of | ||
72 | (n,GT):zs -> let n'=n+1 in n' `seq` (n',GT):zs | ||
73 | zs -> (1,GT):zs | ||
74 | mergeData _ [] [] = [] | ||
75 | mergeData _ [] ys = (length ys, GT) : [] | ||
76 | mergeData _ xs [] = (length xs, LT) : [] | ||
77 | |||
78 | |||