1{-# LANGUAGE ScopedTypeVariables, TemplateHaskell #-}
2module Main where
3
4--------------------------------------------------------------------------
5-- imports
6
7import Test.QuickCheck
8
9import Data.List
10  ( sort
11  )
12
13--------------------------------------------------------------------------
14-- merge sort
15
16msort :: Ord a => [a] -> [a]
17msort xs = merging [ [x] | x <- xs ]
18
19merging :: Ord a => [[a]] -> [a]
20merging []   = []
21merging [xs] = xs
22merging xss  = merging (sweep xss)
23
24sweep :: Ord a => [[a]] -> [[a]]
25sweep []          = []
26sweep [xs]        = [xs]
27sweep (xs:ys:xss) = merge xs ys : sweep xss
28
29merge :: Ord a => [a] -> [a] -> [a]
30merge xs     []     = xs
31merge []     ys     = ys
32merge (x:xs) (y:ys)
33  | x <= y          = x : merge xs (y:ys)
34  | otherwise       = y : merge (x:xs) ys
35
36--------------------------------------------------------------------------
37-- example properties
38
39ordered :: Ord a => [a] -> Bool
40ordered []       = True
41ordered [x]      = True
42ordered (x:y:xs) = x <= y && ordered (y:xs)
43
44prop_Merge xs (ys :: [Int]) =
45  ordered xs && ordered ys ==>
46    collect (length xs + length ys) $
47    ordered (xs `merge` ys)
48
49--  collect (sort [length xs, length ys]) $
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69--------------------------------------------------------------------------
70-- quantificiation
71
72--prop_Merge (Ordered xs) (Ordered (ys :: [Int])) =
73--  ordered (xs `merge` ys)
74
75
76
77
78
79
80
81
82
83
84
85
86
87--  classify (length xs `min` length ys >= 5) "not trivial" $
88--  cover (length xs `min` length ys >= 5) 70 "not trivial" $
89
90{-
91  shrink (Ordered xs) =
92    [ Ordered xs'
93    | xs' <- shrink xs
94    , ordered xs'
95    ]
96-}
97
98--------------------------------------------------------------------------
99-- merging
100
101prop_Merging (xss :: [OrderedList Int]) =
102  ordered (merging [ xs | Ordered xs <- xss ])
103
104
105
106
107
108
109
110--  mapSize (`div` 2) $ \(xss :: [OrderedList Int]) ->
111
112return []
113main = $quickCheckAll
114
115--------------------------------------------------------------------------
116-- the end.
117