« back to all changes in this revision
Viewing changes to src/UU/DData/IntSet.hs
- browse files at revision 12
- compare with another revision
- download diff
- download tarball
- view history from revision 12
- Committer: Bazaar Package Importer
- Author(s): Joachim Breitner
- Date: 2011-06-04 00:54:17 UTC
- mfrom: (9.1.2 sid)
- Revision ID: james.westby@ubuntu.com-20110604005417-4uxlka1134z0ig1w
Tags: 0.9.13-1
New upstream release
- files removed:
- src/UU/DData
- files modified:
- debian/changelog
added
removed
src/UU/DData/IntSet.hs
1
{-# OPTIONS -cpp -fglasgow-exts #-}
2
--------------------------------------------------------------------------------
3
{-| Module : IntSet
4
Copyright : (c) Daan Leijen 2002
5
License : BSD-style
6
7
Maintainer : daan@cs.uu.nl
8
Stability : provisional
9
Portability : portable
10
11
An efficient implementation of integer sets.
12
13
1) The 'filter' function clashes with the "Prelude".
14
If you want to use "IntSet" unqualified, this function should be hidden.
15
16
> import Prelude hiding (filter)
17
> import IntSet
18
19
Another solution is to use qualified names.
20
21
> import qualified IntSet
22
>
23
> ... IntSet.fromList [1..5]
24
25
Or, if you prefer a terse coding style:
26
27
> import qualified IntSet as S
28
>
29
> ... S.fromList [1..5]
30
31
2) The implementation is based on /big-endian patricia trees/. This data structure
32
performs especially well on binary operations like 'union' and 'intersection'. However,
33
my benchmarks show that it is also (much) faster on insertions and deletions when
34
compared to a generic size-balanced set implementation (see "Set").
35
36
* Chris Okasaki and Andy Gill, \"/Fast Mergeable Integer Maps/\",
37
Workshop on ML, September 1998, pages 77--86, <http://www.cse.ogi.edu/~andy/pub/finite.htm>
38
39
* D.R. Morrison, \"/PATRICIA -- Practical Algorithm To Retrieve Information
40
Coded In Alphanumeric/\", Journal of the ACM, 15(4), October 1968, pages 514--534.
41
42
3) Many operations have a worst-case complexity of /O(min(n,W))/. This means that the
43
operation can become linear in the number of elements
44
with a maximum of /W/ -- the number of bits in an 'Int' (32 or 64).
45
-}
46
---------------------------------------------------------------------------------}
47
module UU.DData.IntSet (
48
-- * Set type
49
IntSet -- instance Eq,Show
50
51
-- * Operators
52
, (\\)
53
54
-- * Query
55
, isEmpty
56
, size
57
, member
58
, subset
59
, properSubset
60
61
-- * Construction
62
, empty
63
, single
64
, insert
65
, delete
66
67
-- * Combine
68
, union, unions
69
, difference
70
, intersection
71
72
-- * Filter
73
, filter
74
, partition
75
, split
76
, splitMember
77
78
-- * Fold
79
, fold
80
81
-- * Conversion
82
-- ** List
83
, elems
84
, toList
85
, fromList
86
87
-- ** Ordered list
88
, toAscList
89
, fromAscList
90
, fromDistinctAscList
91
92
-- * Debugging
93
, showTree
94
, showTreeWith
95
) where
96
97
98
import Prelude hiding (lookup,filter)
99
import Bits
100
import Int
101
102
{-
103
import QuickCheck
104
import List (nub,sort)
105
import qualified List
106
-}
107
108
109
#ifdef __GLASGOW_HASKELL__
110
{--------------------------------------------------------------------
111
GHC: use unboxing to get @shiftRL@ inlined.
112
--------------------------------------------------------------------}
113
#if __GLASGOW_HASKELL__ >= 503
114
import GHC.Word
115
import GHC.Exts ( Word(..), Int(..), shiftRL# )
116
#else
117
import Word
118
import GlaExts ( Word(..), Int(..), shiftRL# )
119
#endif
120
121
122
type Nat = Word
123
124
natFromInt :: Int -> Nat
125
natFromInt i = fromIntegral i
126
127
intFromNat :: Nat -> Int
128
intFromNat w = fromIntegral w
129
130
shiftRL :: Nat -> Int -> Nat
131
shiftRL (W# x) (I# i)
132
= W# (shiftRL# x i)
133
134
#elif __HUGS__
135
{--------------------------------------------------------------------
136
Hugs:
137
* raises errors on boundary values when using 'fromIntegral'
138
but not with the deprecated 'fromInt/toInt'.
139
* Older Hugs doesn't define 'Word'.
140
* Newer Hugs defines 'Word' in the Prelude but no operations.
141
--------------------------------------------------------------------}
142
import Word
143
144
type Nat = Word32 -- illegal on 64-bit platforms!
145
146
natFromInt :: Int -> Nat
147
natFromInt i = fromInt i
148
149
intFromNat :: Nat -> Int
150
intFromNat w = toInt w
151
152
shiftRL :: Nat -> Int -> Nat
153
shiftRL x i = shiftR x i
154
155
#else
156
{--------------------------------------------------------------------
157
'Standard' Haskell
158
* A "Nat" is a natural machine word (an unsigned Int)
159
--------------------------------------------------------------------}
160
import Word
161
162
type Nat = Word
163
164
natFromInt :: Int -> Nat
165
natFromInt i = fromIntegral i
166
167
intFromNat :: Nat -> Int
168
intFromNat w = fromIntegral w
169
170
shiftRL :: Nat -> Int -> Nat
171
shiftRL w i = shiftR w i
172
173
#endif
174
175
infixl 9 \\ --
176
177
{--------------------------------------------------------------------
178
Operators
179
--------------------------------------------------------------------}
180
(\\) :: IntSet -> IntSet -> IntSet
181
m1 \\ m2 = difference m1 m2
182
183
{--------------------------------------------------------------------
184
Types
185
--------------------------------------------------------------------}
186
data IntSet = Nil
187
| Tip !Int
188
| Bin !Prefix !Mask !IntSet !IntSet
189
190
type Prefix = Int
191
type Mask = Int
192
193
{--------------------------------------------------------------------
194
Query
195
--------------------------------------------------------------------}
196
isEmpty :: IntSet -> Bool
197
isEmpty Nil = True
198
isEmpty other = False
199
200
size :: IntSet -> Int
201
size t
202
= case t of
203
Bin p m l r -> size l + size r
204
Tip y -> 1
205
Nil -> 0
206
207
member :: Int -> IntSet -> Bool
208
member x t
209
= case t of
210
Bin p m l r
211
| nomatch x p m -> False
212
| zero x m -> member x l
213
| otherwise -> member x r
214
Tip y -> (x==y)
215
Nil -> False
216
217
lookup :: Int -> IntSet -> Maybe Int
218
lookup x t
219
= case t of
220
Bin p m l r
221
| nomatch x p m -> Nothing
222
| zero x m -> lookup x l
223
| otherwise -> lookup x r
224
Tip y
225
| (x==y) -> Just y
226
| otherwise -> Nothing
227
Nil -> Nothing
228
229
{--------------------------------------------------------------------
230
Construction
231
--------------------------------------------------------------------}
232
empty :: IntSet
233
empty
234
= Nil
235
236
single :: Int -> IntSet
237
single x
238
= Tip x
239
240
{--------------------------------------------------------------------
241
Insert
242
--------------------------------------------------------------------}
243
insert :: Int -> IntSet -> IntSet
244
insert x t
245
= case t of
246
Bin p m l r
247
| nomatch x p m -> join x (Tip x) p t
248
| zero x m -> Bin p m (insert x l) r
249
| otherwise -> Bin p m l (insert x r)
250
Tip y
251
| x==y -> Tip x
252
| otherwise -> join x (Tip x) y t
253
Nil -> Tip x
254
255
insertR :: Int -> IntSet -> IntSet
256
insertR x t
257
= case t of
258
Bin p m l r
259
| nomatch x p m -> join x (Tip x) p t
260
| zero x m -> Bin p m (insert x l) r
261
| otherwise -> Bin p m l (insert x r)
262
Tip y
263
| x==y -> t
264
| otherwise -> join x (Tip x) y t
265
Nil -> Tip x
266
267
delete :: Int -> IntSet -> IntSet
268
delete x t
269
= case t of
270
Bin p m l r
271
| nomatch x p m -> t
272
| zero x m -> bin p m (delete x l) r
273
| otherwise -> bin p m l (delete x r)
274
Tip y
275
| x==y -> Nil
276
| otherwise -> t
277
Nil -> Nil
278
279
280
{--------------------------------------------------------------------
281
Union
282
--------------------------------------------------------------------}
283
unions :: [IntSet] -> IntSet
284
unions xs
285
= foldlStrict union empty xs
286
287
288
union :: IntSet -> IntSet -> IntSet
289
union t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
290
| shorter m1 m2 = union1
291
| shorter m2 m1 = union2
292
| p1 == p2 = Bin p1 m1 (union l1 l2) (union r1 r2)
293
| otherwise = join p1 t1 p2 t2
294
where
295
union1 | nomatch p2 p1 m1 = join p1 t1 p2 t2
296
| zero p2 m1 = Bin p1 m1 (union l1 t2) r1
297
| otherwise = Bin p1 m1 l1 (union r1 t2)
298
299
union2 | nomatch p1 p2 m2 = join p1 t1 p2 t2
300
| zero p1 m2 = Bin p2 m2 (union t1 l2) r2
301
| otherwise = Bin p2 m2 l2 (union t1 r2)
302
303
union (Tip x) t = insert x t
304
union t (Tip x) = insertR x t -- right bias
305
union Nil t = t
306
union t Nil = t
307
308
309
{--------------------------------------------------------------------
310
Difference
311
--------------------------------------------------------------------}
312
difference :: IntSet -> IntSet -> IntSet
313
difference t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
314
| shorter m1 m2 = difference1
315
| shorter m2 m1 = difference2
316
| p1 == p2 = bin p1 m1 (difference l1 l2) (difference r1 r2)
317
| otherwise = t1
318
where
319
difference1 | nomatch p2 p1 m1 = t1
320
| zero p2 m1 = bin p1 m1 (difference l1 t2) r1
321
| otherwise = bin p1 m1 l1 (difference r1 t2)
322
323
difference2 | nomatch p1 p2 m2 = t1
324
| zero p1 m2 = difference t1 l2
325
| otherwise = difference t1 r2
326
327
difference t1@(Tip x) t2
328
| member x t2 = Nil
329
| otherwise = t1
330
331
difference Nil t = Nil
332
difference t (Tip x) = delete x t
333
difference t Nil = t
334
335
336
337
{--------------------------------------------------------------------
338
Intersection
339
--------------------------------------------------------------------}
340
intersection :: IntSet -> IntSet -> IntSet
341
intersection t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
342
| shorter m1 m2 = intersection1
343
| shorter m2 m1 = intersection2
344
| p1 == p2 = bin p1 m1 (intersection l1 l2) (intersection r1 r2)
345
| otherwise = Nil
346
where
347
intersection1 | nomatch p2 p1 m1 = Nil
348
| zero p2 m1 = intersection l1 t2
349
| otherwise = intersection r1 t2
350
351
intersection2 | nomatch p1 p2 m2 = Nil
352
| zero p1 m2 = intersection t1 l2
353
| otherwise = intersection t1 r2
354
355
intersection t1@(Tip x) t2
356
| member x t2 = t1
357
| otherwise = Nil
358
intersection t (Tip x)
359
= case lookup x t of
360
Just y -> Tip y
361
Nothing -> Nil
362
intersection Nil t = Nil
363
intersection t Nil = Nil
364
365
366
367
{--------------------------------------------------------------------
368
Subset
369
--------------------------------------------------------------------}
370
properSubset :: IntSet -> IntSet -> Bool
371
properSubset t1 t2
372
= case subsetCmp t1 t2 of
373
LT -> True
374
ge -> False
375
376
subsetCmp t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
377
| shorter m1 m2 = GT
378
| shorter m2 m1 = subsetCmpLt
379
| p1 == p2 = subsetCmpEq
380
| otherwise = GT -- disjoint
381
where
382
subsetCmpLt | nomatch p1 p2 m2 = GT
383
| zero p1 m2 = subsetCmp t1 l2
384
| otherwise = subsetCmp t1 r2
385
subsetCmpEq = case (subsetCmp l1 l2, subsetCmp r1 r2) of
386
(GT,_ ) -> GT
387
(_ ,GT) -> GT
388
(EQ,EQ) -> EQ
389
other -> LT
390
391
subsetCmp (Bin p m l r) t = GT
392
subsetCmp (Tip x) (Tip y)
393
| x==y = EQ
394
| otherwise = GT -- disjoint
395
subsetCmp (Tip x) t
396
| member x t = LT
397
| otherwise = GT -- disjoint
398
subsetCmp Nil Nil = EQ
399
subsetCmp Nil t = LT
400
401
subset :: IntSet -> IntSet -> Bool
402
subset t1@(Bin p1 m1 l1 r1) t2@(Bin p2 m2 l2 r2)
403
| shorter m1 m2 = False
404
| shorter m2 m1 = match p1 p2 m2 && (if zero p1 m2 then subset t1 l2
405
else subset t1 r2)
406
| otherwise = (p1==p2) && subset l1 l2 && subset r1 r2
407
subset (Bin p m l r) t = False
408
subset (Tip x) t = member x t
409
subset Nil t = True
410
411
412
{--------------------------------------------------------------------
413
Filter
414
--------------------------------------------------------------------}
415
filter :: (Int -> Bool) -> IntSet -> IntSet
416
filter pred t
417
= case t of
418
Bin p m l r
419
-> bin p m (filter pred l) (filter pred r)
420
Tip x
421
| pred x -> t
422
| otherwise -> Nil
423
Nil -> Nil
424
425
partition :: (Int -> Bool) -> IntSet -> (IntSet,IntSet)
426
partition pred t
427
= case t of
428
Bin p m l r
429
-> let (l1,l2) = partition pred l
430
(r1,r2) = partition pred r
431
in (bin p m l1 r1, bin p m l2 r2)
432
Tip x
433
| pred x -> (t,Nil)
434
| otherwise -> (Nil,t)
435
Nil -> (Nil,Nil)
436
437
438
split :: Int -> IntSet -> (IntSet,IntSet)
439
split x t
440
= case t of
441
Bin p m l r
442
| zero x m -> let (lt,gt) = split x l in (lt,union gt r)
443
| otherwise -> let (lt,gt) = split x r in (union l lt,gt)
444
Tip y
445
| x>y -> (t,Nil)
446
| x<y -> (Nil,t)
447
| otherwise -> (Nil,Nil)
448
Nil -> (Nil,Nil)
449
450
splitMember :: Int -> IntSet -> (Bool,IntSet,IntSet)
451
splitMember x t
452
= case t of
453
Bin p m l r
454
| zero x m -> let (found,lt,gt) = splitMember x l in (found,lt,union gt r)
455
| otherwise -> let (found,lt,gt) = splitMember x r in (found,union l lt,gt)
456
Tip y
457
| x>y -> (False,t,Nil)
458
| x<y -> (False,Nil,t)
459
| otherwise -> (True,Nil,Nil)
460
Nil -> (False,Nil,Nil)
461
462
463
{--------------------------------------------------------------------
464
Fold
465
--------------------------------------------------------------------}
466
--
467
fold :: (Int -> b -> b) -> b -> IntSet -> b
468
fold f z t
469
= foldR f z t
470
471
foldR :: (Int -> b -> b) -> b -> IntSet -> b
472
foldR f z t
473
= case t of
474
Bin p m l r -> foldR f (foldR f z r) l
475
Tip x -> f x z
476
Nil -> z
477
478
{--------------------------------------------------------------------
479
List variations
480
--------------------------------------------------------------------}
481
elems :: IntSet -> [Int]
482
elems s
483
= toList s
484
485
{--------------------------------------------------------------------
486
Lists
487
--------------------------------------------------------------------}
488
toList :: IntSet -> [Int]
489
toList t
490
= fold (:) [] t
491
492
toAscList :: IntSet -> [Int]
493
toAscList t
494
= -- NOTE: the following algorithm only works for big-endian trees
495
let (pos,neg) = span (>=0) (foldR (:) [] t) in neg ++ pos
496
497
fromList :: [Int] -> IntSet
498
fromList xs
499
= foldlStrict ins empty xs
500
where
501
ins t x = insert x t
502
503
fromAscList :: [Int] -> IntSet
504
fromAscList xs
505
= fromList xs
506
507
fromDistinctAscList :: [Int] -> IntSet
508
fromDistinctAscList xs
509
= fromList xs
510
511
512
{--------------------------------------------------------------------
513
Eq
514
--------------------------------------------------------------------}
515
instance Eq IntSet where
516
t1 == t2 = equal t1 t2
517
t1 /= t2 = nequal t1 t2
518
519
equal :: IntSet -> IntSet -> Bool
520
equal (Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)
521
= (m1 == m2) && (p1 == p2) && (equal l1 l2) && (equal r1 r2)
522
equal (Tip x) (Tip y)
523
= (x==y)
524
equal Nil Nil = True
525
equal t1 t2 = False
526
527
nequal :: IntSet -> IntSet -> Bool
528
nequal (Bin p1 m1 l1 r1) (Bin p2 m2 l2 r2)
529
= (m1 /= m2) || (p1 /= p2) || (nequal l1 l2) || (nequal r1 r2)
530
nequal (Tip x) (Tip y)
531
= (x/=y)
532
nequal Nil Nil = False
533
nequal t1 t2 = True
534
535
{--------------------------------------------------------------------
536
Show
537
--------------------------------------------------------------------}
538
instance Show IntSet where
539
showsPrec d s = showSet (toList s)
540
541
showSet :: [Int] -> ShowS
542
showSet []
543
= showString "{}"
544
showSet (x:xs)
545
= showChar '{' . shows x . showTail xs
546
where
547
showTail [] = showChar '}'
548
showTail (x:xs) = showChar ',' . shows x . showTail xs
549
550
{--------------------------------------------------------------------
551
Debugging
552
--------------------------------------------------------------------}
553
showTree :: IntSet -> String
554
showTree s
555
= showTreeWith True False s
556
557
558
{- | /O(n)/. The expression (@showTreeWith hang wide map@) shows
559
the tree that implements the set. If @hang@ is
560
@True@, a /hanging/ tree is shown otherwise a rotated tree is shown. If
561
@wide@ is true, an extra wide version is shown.
562
-}
563
showTreeWith :: Bool -> Bool -> IntSet -> String
564
showTreeWith hang wide t
565
| hang = (showsTreeHang wide [] t) ""
566
| otherwise = (showsTree wide [] [] t) ""
567
568
showsTree :: Bool -> [String] -> [String] -> IntSet -> ShowS
569
showsTree wide lbars rbars t
570
= case t of
571
Bin p m l r
572
-> showsTree wide (withBar rbars) (withEmpty rbars) r .
573
showWide wide rbars .
574
showsBars lbars . showString (showBin p m) . showString "\n" .
575
showWide wide lbars .
576
showsTree wide (withEmpty lbars) (withBar lbars) l
577
Tip x
578
-> showsBars lbars . showString " " . shows x . showString "\n"
579
Nil -> showsBars lbars . showString "|\n"
580
581
showsTreeHang :: Bool -> [String] -> IntSet -> ShowS
582
showsTreeHang wide bars t
583
= case t of
584
Bin p m l r
585
-> showsBars bars . showString (showBin p m) . showString "\n" .
586
showWide wide bars .
587
showsTreeHang wide (withBar bars) l .
588
showWide wide bars .
589
showsTreeHang wide (withEmpty bars) r
590
Tip x
591
-> showsBars bars . showString " " . shows x . showString "\n"
592
Nil -> showsBars bars . showString "|\n"
593
594
showBin p m
595
= "*" -- ++ show (p,m)
596
597
showWide wide bars
598
| wide = showString (concat (reverse bars)) . showString "|\n"
599
| otherwise = id
600
601
showsBars :: [String] -> ShowS
602
showsBars bars
603
= case bars of
604
[] -> id
605
_ -> showString (concat (reverse (tail bars))) . showString node
606
607
node = "+--"
608
withBar bars = "| ":bars
609
withEmpty bars = " ":bars
610
611
612
{--------------------------------------------------------------------
613
Helpers
614
--------------------------------------------------------------------}
615
{--------------------------------------------------------------------
616
Join
617
--------------------------------------------------------------------}
618
join :: Prefix -> IntSet -> Prefix -> IntSet -> IntSet
619
join p1 t1 p2 t2
620
| zero p1 m = Bin p m t1 t2
621
| otherwise = Bin p m t2 t1
622
where
623
m = branchMask p1 p2
624
p = mask p1 m
625
626
{--------------------------------------------------------------------
627
@bin@ assures that we never have empty trees within a tree.
628
--------------------------------------------------------------------}
629
bin :: Prefix -> Mask -> IntSet -> IntSet -> IntSet
630
bin p m l Nil = l
631
bin p m Nil r = r
632
bin p m l r = Bin p m l r
633
634
635
{--------------------------------------------------------------------
636
Endian independent bit twiddling
637
--------------------------------------------------------------------}
638
zero :: Int -> Mask -> Bool
639
zero i m
640
= (natFromInt i) .&. (natFromInt m) == 0
641
642
nomatch,match :: Int -> Prefix -> Mask -> Bool
643
nomatch i p m
644
= (mask i m) /= p
645
646
match i p m
647
= (mask i m) == p
648
649
mask :: Int -> Mask -> Prefix
650
mask i m
651
= maskW (natFromInt i) (natFromInt m)
652
653
654
{--------------------------------------------------------------------
655
Big endian operations
656
--------------------------------------------------------------------}
657
maskW :: Nat -> Nat -> Prefix
658
maskW i m
659
= intFromNat (i .&. (complement (m-1) `xor` m))
660
661
shorter :: Mask -> Mask -> Bool
662
shorter m1 m2
663
= (natFromInt m1) > (natFromInt m2)
664
665
branchMask :: Prefix -> Prefix -> Mask
666
branchMask p1 p2
667
= intFromNat (highestBitMask (natFromInt p1 `xor` natFromInt p2))
668
669
{----------------------------------------------------------------------
670
Finding the highest bit (mask) in a word [x] can be done efficiently in
671
three ways:
672
* convert to a floating point value and the mantissa tells us the
673
[log2(x)] that corresponds with the highest bit position. The mantissa
674
is retrieved either via the standard C function [frexp] or by some bit
675
twiddling on IEEE compatible numbers (float). Note that one needs to
676
use at least [double] precision for an accurate mantissa of 32 bit
677
numbers.
678
* use bit twiddling, a logarithmic sequence of bitwise or's and shifts (bit).
679
* use processor specific assembler instruction (asm).
680
681
The most portable way would be [bit], but is it efficient enough?
682
I have measured the cycle counts of the different methods on an AMD
683
Athlon-XP 1800 (~ Pentium III 1.8Ghz) using the RDTSC instruction:
684
685
highestBitMask: method cycles
686
--------------
687
frexp 200
688
float 33
689
bit 11
690
asm 12
691
692
highestBit: method cycles
693
--------------
694
frexp 195
695
float 33
696
bit 11
697
asm 11
698
699
Wow, the bit twiddling is on today's RISC like machines even faster
700
than a single CISC instruction (BSR)!
701
----------------------------------------------------------------------}
702
703
{----------------------------------------------------------------------
704
[highestBitMask] returns a word where only the highest bit is set.
705
It is found by first setting all bits in lower positions than the
706
highest bit and than taking an exclusive or with the original value.
707
Allthough the function may look expensive, GHC compiles this into
708
excellent C code that subsequently compiled into highly efficient
709
machine code. The algorithm is derived from Jorg Arndt's FXT library.
710
----------------------------------------------------------------------}
711
highestBitMask :: Nat -> Nat
712
highestBitMask x
713
= case (x .|. shiftRL x 1) of
714
x -> case (x .|. shiftRL x 2) of
715
x -> case (x .|. shiftRL x 4) of
716
x -> case (x .|. shiftRL x 8) of
717
x -> case (x .|. shiftRL x 16) of
718
x -> case (x .|. shiftRL x 32) of -- for 64 bit platforms
719
x -> (x `xor` (shiftRL x 1))
720
721
722
{--------------------------------------------------------------------
723
Utilities
724
--------------------------------------------------------------------}
725
foldlStrict f z xs
726
= case xs of
727
[] -> z
728
(x:xx) -> let z' = f z x in seq z' (foldlStrict f z' xx)
729
730
731
{-
732
{--------------------------------------------------------------------
733
Testing
734
--------------------------------------------------------------------}
735
testTree :: [Int] -> IntSet
736
testTree xs = fromList xs
737
test1 = testTree [1..20]
738
test2 = testTree [30,29..10]
739
test3 = testTree [1,4,6,89,2323,53,43,234,5,79,12,9,24,9,8,423,8,42,4,8,9,3]
740
741
{--------------------------------------------------------------------
742
QuickCheck
743
--------------------------------------------------------------------}
744
qcheck prop
745
= check config prop
746
where
747
config = Config
748
{ configMaxTest = 500
749
, configMaxFail = 5000
750
, configSize = \n -> (div n 2 + 3)
751
, configEvery = \n args -> let s = show n in s ++ [ '\b' | _ <- s ]
752
}
753
754
755
{--------------------------------------------------------------------
756
Arbitrary, reasonably balanced trees
757
--------------------------------------------------------------------}
758
instance Arbitrary IntSet where
759
arbitrary = do{ xs <- arbitrary
760
; return (fromList xs)
761
}
762
763
764
{--------------------------------------------------------------------
765
Single, Insert, Delete
766
--------------------------------------------------------------------}
767
prop_Single :: Int -> Bool
768
prop_Single x
769
= (insert x empty == single x)
770
771
prop_InsertDelete :: Int -> IntSet -> Property
772
prop_InsertDelete k t
773
= not (member k t) ==> delete k (insert k t) == t
774
775
776
{--------------------------------------------------------------------
777
Union
778
--------------------------------------------------------------------}
779
prop_UnionInsert :: Int -> IntSet -> Bool
780
prop_UnionInsert x t
781
= union t (single x) == insert x t
782
783
prop_UnionAssoc :: IntSet -> IntSet -> IntSet -> Bool
784
prop_UnionAssoc t1 t2 t3
785
= union t1 (union t2 t3) == union (union t1 t2) t3
786
787
prop_UnionComm :: IntSet -> IntSet -> Bool
788
prop_UnionComm t1 t2
789
= (union t1 t2 == union t2 t1)
790
791
prop_Diff :: [Int] -> [Int] -> Bool
792
prop_Diff xs ys
793
= toAscList (difference (fromList xs) (fromList ys))
794
== List.sort ((List.\\) (nub xs) (nub ys))
795
796
prop_Int :: [Int] -> [Int] -> Bool
797
prop_Int xs ys
798
= toAscList (intersection (fromList xs) (fromList ys))
799
== List.sort (nub ((List.intersect) (xs) (ys)))
800
801
{--------------------------------------------------------------------
802
Lists
803
--------------------------------------------------------------------}
804
prop_Ordered
805
= forAll (choose (5,100)) $ \n ->
806
let xs = [0..n::Int]
807
in fromAscList xs == fromList xs
808
809
prop_List :: [Int] -> Bool
810
prop_List xs
811
= (sort (nub xs) == toAscList (fromList xs))
812
-}
813
Loggerhead is a web-based interface for Breezy
Version: 2.0.1