~ubuntu-branches/ubuntu/wily/coq-doc/wily

« back to all changes in this revision

Viewing changes to theories/FSets/FSetEqProperties.v

  • Committer: Bazaar Package Importer
  • Author(s): Stéphane Glondu, Stéphane Glondu, Samuel Mimram
  • Date: 2010-01-07 22:50:39 UTC
  • mfrom: (1.2.2 upstream)
  • Revision ID: james.westby@ubuntu.com-20100107225039-n3cq82589u0qt0s2
Tags: 8.2pl1-1
[ Stéphane Glondu ]
* New upstream release (Closes: #563669)
  - remove patches
* Packaging overhaul:
  - use git, advertise it in Vcs-* fields of debian/control
  - use debhelper 7 and dh with override
  - use source format 3.0 (quilt)
* debian/control:
  - set Maintainer to d-o-m, set Uploaders to Sam and myself
  - add Homepage field
  - bump Standards-Version to 3.8.3
* Register PDF documentation into doc-base
* Add debian/watch
* Update debian/copyright

[ Samuel Mimram ]
* Change coq-doc's description to mention that it provides documentation in
  pdf format, not postscript, closes: #543545.

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
(***********************************************************************)
 
2
(*  v      *   The Coq Proof Assistant  /  The Coq Development Team    *)
 
3
(* <O___,, *        INRIA-Rocquencourt  &  LRI-CNRS-Orsay              *)
 
4
(*   \VV/  *************************************************************)
 
5
(*    //   *      This file is distributed under the terms of the      *)
 
6
(*         *       GNU Lesser General Public License Version 2.1       *)
 
7
(***********************************************************************)
 
8
 
 
9
(* $Id: FSetEqProperties.v 11720 2008-12-28 07:12:15Z letouzey $ *)
 
10
 
 
11
(** * Finite sets library *)
 
12
 
 
13
(** This module proves many properties of finite sets that 
 
14
    are consequences of the axiomatization in [FsetInterface] 
 
15
    Contrary to the functor in [FsetProperties] it uses 
 
16
    sets operations instead of predicates over sets, i.e.
 
17
    [mem x s=true] instead of [In x s], 
 
18
    [equal s s'=true] instead of [Equal s s'], etc. *)
 
19
 
 
20
Require Import FSetProperties Zerob Sumbool Omega DecidableTypeEx.
 
21
 
 
22
Module WEqProperties_fun (Import E:DecidableType)(M:WSfun E).
 
23
Module Import MP := WProperties_fun E M.
 
24
Import FM Dec.F.
 
25
Import M.
 
26
 
 
27
Definition Add := MP.Add.
 
28
 
 
29
Section BasicProperties. 
 
30
 
 
31
(** Some old specifications written with boolean equalities. *) 
 
32
 
 
33
Variable s s' s'': t.
 
34
Variable x y z : elt.
 
35
 
 
36
Lemma mem_eq: 
 
37
  E.eq x y -> mem x s=mem y s.
 
38
Proof. 
 
39
intro H; rewrite H; auto.
 
40
Qed.
 
41
 
 
42
Lemma equal_mem_1: 
 
43
  (forall a, mem a s=mem a s') -> equal s s'=true.
 
44
Proof. 
 
45
intros; apply equal_1; unfold Equal; intros.
 
46
do 2 rewrite mem_iff; rewrite H; tauto.
 
47
Qed.
 
48
 
 
49
Lemma equal_mem_2: 
 
50
  equal s s'=true -> forall a, mem a s=mem a s'.
 
51
Proof. 
 
52
intros; rewrite (equal_2 H); auto.
 
53
Qed.
 
54
 
 
55
Lemma subset_mem_1: 
 
56
  (forall a, mem a s=true->mem a s'=true) -> subset s s'=true.
 
57
Proof. 
 
58
intros; apply subset_1; unfold Subset; intros a.
 
59
do 2 rewrite mem_iff; auto.
 
60
Qed.
 
61
 
 
62
Lemma subset_mem_2: 
 
63
  subset s s'=true -> forall a, mem a s=true -> mem a s'=true.
 
64
Proof. 
 
65
intros H a; do 2 rewrite <- mem_iff; apply subset_2; auto.
 
66
Qed.
 
67
  
 
68
Lemma empty_mem: mem x empty=false.
 
69
Proof. 
 
70
rewrite <- not_mem_iff; auto with set.
 
71
Qed.
 
72
 
 
73
Lemma is_empty_equal_empty: is_empty s = equal s empty.
 
74
Proof. 
 
75
apply bool_1; split; intros.
 
76
auto with set.
 
77
rewrite <- is_empty_iff; auto with set.
 
78
Qed.
 
79
  
 
80
Lemma choose_mem_1: choose s=Some x -> mem x s=true.
 
81
Proof.  
 
82
auto with set.
 
83
Qed.
 
84
 
 
85
Lemma choose_mem_2: choose s=None -> is_empty s=true.
 
86
Proof.
 
87
auto with set.
 
88
Qed.
 
89
 
 
90
Lemma add_mem_1: mem x (add x s)=true.
 
91
Proof.
 
92
auto with set.
 
93
Qed.  
 
94
 
 
95
Lemma add_mem_2: ~E.eq x y -> mem y (add x s)=mem y s.
 
96
Proof. 
 
97
apply add_neq_b.
 
98
Qed.
 
99
 
 
100
Lemma remove_mem_1: mem x (remove x s)=false.
 
101
Proof. 
 
102
rewrite <- not_mem_iff; auto with set.
 
103
Qed. 
 
104
 
 
105
Lemma remove_mem_2: ~E.eq x y -> mem y (remove x s)=mem y s.
 
106
Proof. 
 
107
apply remove_neq_b.
 
108
Qed.
 
109
 
 
110
Lemma singleton_equal_add: 
 
111
  equal (singleton x) (add x empty)=true.
 
112
Proof.
 
113
rewrite (singleton_equal_add x); auto with set.
 
114
Qed.  
 
115
 
 
116
Lemma union_mem: 
 
117
  mem x (union s s')=mem x s || mem x s'.
 
118
Proof. 
 
119
apply union_b.
 
120
Qed.
 
121
 
 
122
Lemma inter_mem: 
 
123
  mem x (inter s s')=mem x s && mem x s'.
 
124
Proof. 
 
125
apply inter_b.
 
126
Qed.
 
127
 
 
128
Lemma diff_mem: 
 
129
  mem x (diff s s')=mem x s && negb (mem x s').
 
130
Proof. 
 
131
apply diff_b.
 
132
Qed.
 
133
 
 
134
(** properties of [mem] *)
 
135
 
 
136
Lemma mem_3 : ~In x s -> mem x s=false.
 
137
Proof.
 
138
intros; rewrite <- not_mem_iff; auto.
 
139
Qed.
 
140
 
 
141
Lemma mem_4 : mem x s=false -> ~In x s.
 
142
Proof.
 
143
intros; rewrite not_mem_iff; auto.
 
144
Qed.
 
145
 
 
146
(** Properties of [equal] *) 
 
147
 
 
148
Lemma equal_refl: equal s s=true.
 
149
Proof.
 
150
auto with set.
 
151
Qed.
 
152
 
 
153
Lemma equal_sym: equal s s'=equal s' s.
 
154
Proof.
 
155
intros; apply bool_1; do 2 rewrite <- equal_iff; intuition.
 
156
Qed.
 
157
 
 
158
Lemma equal_trans: 
 
159
 equal s s'=true -> equal s' s''=true -> equal s s''=true.
 
160
Proof.
 
161
intros; rewrite (equal_2 H); auto.
 
162
Qed.
 
163
 
 
164
Lemma equal_equal: 
 
165
 equal s s'=true -> equal s s''=equal s' s''.
 
166
Proof.
 
167
intros; rewrite (equal_2 H); auto.
 
168
Qed.
 
169
 
 
170
Lemma equal_cardinal: 
 
171
 equal s s'=true -> cardinal s=cardinal s'.
 
172
Proof.
 
173
auto with set.
 
174
Qed.
 
175
 
 
176
(* Properties of [subset] *)
 
177
 
 
178
Lemma subset_refl: subset s s=true. 
 
179
Proof.
 
180
auto with set.
 
181
Qed.
 
182
 
 
183
Lemma subset_antisym: 
 
184
 subset s s'=true -> subset s' s=true -> equal s s'=true.
 
185
Proof.
 
186
auto with set.
 
187
Qed.
 
188
 
 
189
Lemma subset_trans: 
 
190
 subset s s'=true -> subset s' s''=true -> subset s s''=true.
 
191
Proof.
 
192
do 3 rewrite <- subset_iff; intros.
 
193
apply subset_trans with s'; auto.
 
194
Qed.
 
195
 
 
196
Lemma subset_equal: 
 
197
 equal s s'=true -> subset s s'=true.
 
198
Proof.
 
199
auto with set.
 
200
Qed.
 
201
 
 
202
(** Properties of [choose] *)
 
203
 
 
204
Lemma choose_mem_3: 
 
205
 is_empty s=false -> {x:elt|choose s=Some x /\ mem x s=true}.
 
206
Proof.
 
207
intros.
 
208
generalize (@choose_1 s) (@choose_2 s).
 
209
destruct (choose s);intros.
 
210
exists e;auto with set.
 
211
generalize (H1 (refl_equal None)); clear H1.
 
212
intros; rewrite (is_empty_1 H1) in H; discriminate.
 
213
Qed.
 
214
 
 
215
Lemma choose_mem_4: choose empty=None.
 
216
Proof.
 
217
generalize (@choose_1 empty).
 
218
case (@choose empty);intros;auto.
 
219
elim (@empty_1 e); auto.
 
220
Qed.
 
221
 
 
222
(** Properties of [add] *)
 
223
 
 
224
Lemma add_mem_3: 
 
225
 mem y s=true -> mem y (add x s)=true.
 
226
Proof.
 
227
auto with set.
 
228
Qed.
 
229
 
 
230
Lemma add_equal: 
 
231
 mem x s=true -> equal (add x s) s=true.
 
232
Proof.
 
233
auto with set.
 
234
Qed.
 
235
 
 
236
(** Properties of [remove] *)
 
237
 
 
238
Lemma remove_mem_3: 
 
239
 mem y (remove x s)=true -> mem y s=true.
 
240
Proof.
 
241
rewrite remove_b; intros H;destruct (andb_prop _ _ H); auto.
 
242
Qed.
 
243
 
 
244
Lemma remove_equal: 
 
245
 mem x s=false -> equal (remove x s) s=true.
 
246
Proof.
 
247
intros; apply equal_1; apply remove_equal.
 
248
rewrite not_mem_iff; auto.
 
249
Qed.
 
250
 
 
251
Lemma add_remove: 
 
252
 mem x s=true -> equal (add x (remove x s)) s=true.
 
253
Proof.
 
254
intros; apply equal_1; apply add_remove; auto with set.
 
255
Qed.
 
256
 
 
257
Lemma remove_add: 
 
258
 mem x s=false -> equal (remove x (add x s)) s=true.
 
259
Proof.
 
260
intros; apply equal_1; apply remove_add; auto.
 
261
rewrite not_mem_iff; auto.
 
262
Qed.
 
263
 
 
264
(** Properties of [is_empty] *)
 
265
 
 
266
Lemma is_empty_cardinal: is_empty s = zerob (cardinal s).
 
267
Proof.
 
268
intros; apply bool_1; split; intros.
 
269
rewrite MP.cardinal_1; simpl; auto with set.
 
270
assert (cardinal s = 0) by (apply zerob_true_elim; auto).
 
271
auto with set.
 
272
Qed.
 
273
 
 
274
(** Properties of [singleton] *)
 
275
 
 
276
Lemma singleton_mem_1: mem x (singleton x)=true.
 
277
Proof.
 
278
auto with set.
 
279
Qed.
 
280
 
 
281
Lemma singleton_mem_2: ~E.eq x y -> mem y (singleton x)=false.
 
282
Proof.
 
283
intros; rewrite singleton_b.
 
284
unfold eqb; destruct (E.eq_dec x y); intuition.
 
285
Qed.
 
286
 
 
287
Lemma singleton_mem_3: mem y (singleton x)=true -> E.eq x y.
 
288
Proof.
 
289
intros; apply singleton_1; auto with set.
 
290
Qed.
 
291
 
 
292
(** Properties of [union] *)
 
293
 
 
294
Lemma union_sym:
 
295
 equal (union s s') (union s' s)=true.
 
296
Proof.
 
297
auto with set.
 
298
Qed.
 
299
 
 
300
Lemma union_subset_equal: 
 
301
 subset s s'=true -> equal (union s s') s'=true.
 
302
Proof.
 
303
auto with set.
 
304
Qed.
 
305
 
 
306
Lemma union_equal_1: 
 
307
 equal s s'=true-> equal (union s s'') (union s' s'')=true.
 
308
Proof.
 
309
auto with set.
 
310
Qed.
 
311
 
 
312
Lemma union_equal_2: 
 
313
 equal s' s''=true-> equal (union s s') (union s s'')=true.
 
314
Proof.
 
315
auto with set.
 
316
Qed.
 
317
 
 
318
Lemma union_assoc: 
 
319
 equal (union (union s s') s'') (union s (union s' s''))=true.
 
320
Proof.
 
321
auto with set.
 
322
Qed.
 
323
 
 
324
Lemma add_union_singleton: 
 
325
 equal (add x s) (union (singleton x) s)=true.
 
326
Proof.
 
327
auto with set.
 
328
Qed.
 
329
 
 
330
Lemma union_add: 
 
331
 equal (union (add x s) s') (add x (union s s'))=true.
 
332
Proof.
 
333
auto with set.
 
334
Qed.
 
335
 
 
336
(* caracterisation of [union] via [subset] *)
 
337
 
 
338
Lemma union_subset_1: subset s (union s s')=true.
 
339
Proof.
 
340
auto with set.
 
341
Qed.
 
342
 
 
343
Lemma union_subset_2: subset s' (union s s')=true.
 
344
Proof.
 
345
auto with set.
 
346
Qed.
 
347
 
 
348
Lemma union_subset_3:
 
349
 subset s s''=true -> subset s' s''=true -> 
 
350
  subset (union s s') s''=true.
 
351
Proof.
 
352
intros; apply subset_1; apply union_subset_3; auto with set.
 
353
Qed.
 
354
 
 
355
(** Properties of [inter] *) 
 
356
 
 
357
Lemma inter_sym: equal (inter s s') (inter s' s)=true.
 
358
Proof.
 
359
auto with set.
 
360
Qed.
 
361
 
 
362
Lemma inter_subset_equal: 
 
363
 subset s s'=true -> equal (inter s s') s=true.
 
364
Proof.
 
365
auto with set.
 
366
Qed.
 
367
 
 
368
Lemma inter_equal_1: 
 
369
 equal s s'=true -> equal (inter s s'') (inter s' s'')=true.
 
370
Proof.
 
371
auto with set.
 
372
Qed.
 
373
 
 
374
Lemma inter_equal_2: 
 
375
 equal s' s''=true -> equal (inter s s') (inter s s'')=true.
 
376
Proof.
 
377
auto with set.
 
378
Qed.
 
379
 
 
380
Lemma inter_assoc: 
 
381
 equal (inter (inter s s') s'') (inter s (inter s' s''))=true.
 
382
Proof.
 
383
auto with set.
 
384
Qed.
 
385
 
 
386
Lemma union_inter_1: 
 
387
 equal (inter (union s s') s'') (union (inter s s'') (inter s' s''))=true.
 
388
Proof.
 
389
auto with set.
 
390
Qed.
 
391
 
 
392
Lemma union_inter_2: 
 
393
 equal (union (inter s s') s'') (inter (union s s'') (union s' s''))=true.
 
394
Proof.
 
395
auto with set.
 
396
Qed.
 
397
 
 
398
Lemma inter_add_1: mem x s'=true -> 
 
399
 equal (inter (add x s) s') (add x (inter s s'))=true.
 
400
Proof.
 
401
auto with set.
 
402
Qed.
 
403
 
 
404
Lemma inter_add_2: mem x s'=false -> 
 
405
 equal (inter (add x s) s') (inter s s')=true.
 
406
Proof.
 
407
intros; apply equal_1; apply inter_add_2.
 
408
rewrite not_mem_iff; auto.
 
409
Qed.
 
410
 
 
411
(* caracterisation of [union] via [subset] *)
 
412
 
 
413
Lemma inter_subset_1: subset (inter s s') s=true.
 
414
Proof.
 
415
auto with set.
 
416
Qed.
 
417
 
 
418
Lemma inter_subset_2: subset (inter s s') s'=true.
 
419
Proof.
 
420
auto with set.
 
421
Qed.
 
422
 
 
423
Lemma inter_subset_3:
 
424
 subset s'' s=true -> subset s'' s'=true -> 
 
425
  subset s'' (inter s s')=true.
 
426
Proof.
 
427
intros; apply subset_1; apply inter_subset_3; auto with set.
 
428
Qed.
 
429
 
 
430
(** Properties of [diff] *)
 
431
 
 
432
Lemma diff_subset: subset (diff s s') s=true.
 
433
Proof.
 
434
auto with set.
 
435
Qed.
 
436
 
 
437
Lemma diff_subset_equal:
 
438
 subset s s'=true -> equal (diff s s') empty=true.
 
439
Proof.
 
440
auto with set.
 
441
Qed.
 
442
 
 
443
Lemma remove_inter_singleton: 
 
444
 equal (remove x s) (diff s (singleton x))=true.
 
445
Proof.
 
446
auto with set.
 
447
Qed.
 
448
 
 
449
Lemma diff_inter_empty:
 
450
 equal (inter (diff s s') (inter s s')) empty=true. 
 
451
Proof.
 
452
auto with set.
 
453
Qed.
 
454
 
 
455
Lemma diff_inter_all: 
 
456
 equal (union (diff s s') (inter s s')) s=true.
 
457
Proof.
 
458
auto with set.
 
459
Qed.
 
460
 
 
461
End BasicProperties.
 
462
 
 
463
Hint Immediate empty_mem is_empty_equal_empty add_mem_1
 
464
   remove_mem_1 singleton_equal_add union_mem inter_mem
 
465
   diff_mem equal_sym add_remove remove_add : set. 
 
466
Hint Resolve equal_mem_1 subset_mem_1 choose_mem_1
 
467
   choose_mem_2 add_mem_2 remove_mem_2 equal_refl equal_equal
 
468
   subset_refl subset_equal subset_antisym
 
469
   add_mem_3 add_equal remove_mem_3 remove_equal : set.
 
470
 
 
471
 
 
472
(** General recursion principle *)
 
473
 
 
474
Lemma set_rec:  forall (P:t->Type),
 
475
 (forall s s', equal s s'=true -> P s -> P s') -> 
 
476
 (forall s x, mem x s=false -> P s -> P (add x s)) -> 
 
477
 P empty -> forall s, P s.
 
478
Proof.
 
479
intros.
 
480
apply set_induction; auto; intros.
 
481
apply X with empty; auto with set.
 
482
apply X with (add x s0); auto with set.
 
483
apply equal_1; intro a; rewrite add_iff; rewrite (H0 a); tauto.
 
484
apply X0; auto with set; apply mem_3; auto.
 
485
Qed.
 
486
 
 
487
(** Properties of [fold] *)
 
488
 
 
489
Lemma exclusive_set : forall s s' x,
 
490
 ~(In x s/\In x s') <-> mem x s && mem x s'=false.
 
491
Proof.
 
492
intros; do 2 rewrite mem_iff.
 
493
destruct (mem x s); destruct (mem x s'); intuition.
 
494
Qed.
 
495
 
 
496
Section Fold. 
 
497
Variables (A:Type)(eqA:A->A->Prop)(st:Equivalence eqA).
 
498
Variables (f:elt->A->A)(Comp:compat_op E.eq eqA f)(Ass:transpose eqA f).
 
499
Variables (i:A).
 
500
Variables (s s':t)(x:elt).
 
501
 
 
502
Lemma fold_empty: (fold f empty i) = i.
 
503
Proof. 
 
504
apply fold_empty; auto.
 
505
Qed.
 
506
 
 
507
Lemma fold_equal: 
 
508
 equal s s'=true -> eqA (fold f s i) (fold f s' i).
 
509
Proof. 
 
510
intros; apply fold_equal with (eqA:=eqA); auto with set.
 
511
Qed.
 
512
   
 
513
Lemma fold_add: 
 
514
 mem x s=false -> eqA (fold f (add x s) i) (f x (fold f s i)).
 
515
Proof. 
 
516
intros; apply fold_add with (eqA:=eqA); auto.
 
517
rewrite not_mem_iff; auto.
 
518
Qed.
 
519
 
 
520
Lemma add_fold: 
 
521
  mem x s=true -> eqA (fold f (add x s) i) (fold f s i).
 
522
Proof.
 
523
intros; apply add_fold with (eqA:=eqA); auto with set.
 
524
Qed.
 
525
 
 
526
Lemma remove_fold_1: 
 
527
 mem x s=true -> eqA (f x (fold f (remove x s) i)) (fold f s i).
 
528
Proof.
 
529
intros; apply remove_fold_1 with (eqA:=eqA); auto with set.
 
530
Qed.
 
531
 
 
532
Lemma remove_fold_2: 
 
533
 mem x s=false -> eqA (fold f (remove x s) i) (fold f s i).
 
534
Proof.
 
535
intros; apply remove_fold_2 with (eqA:=eqA); auto.
 
536
rewrite not_mem_iff; auto.
 
537
Qed.
 
538
 
 
539
Lemma fold_union: 
 
540
 (forall x, mem x s && mem x s'=false) -> 
 
541
 eqA (fold f (union s s') i) (fold f s (fold f s' i)).
 
542
Proof.
 
543
intros; apply fold_union with (eqA:=eqA); auto.
 
544
intros; rewrite exclusive_set; auto.
 
545
Qed.
 
546
 
 
547
End Fold.
 
548
 
 
549
(** Properties of [cardinal] *)
 
550
 
 
551
Lemma add_cardinal_1: 
 
552
 forall s x, mem x s=true -> cardinal (add x s)=cardinal s.
 
553
Proof.
 
554
auto with set.
 
555
Qed.
 
556
 
 
557
Lemma add_cardinal_2: 
 
558
 forall s x, mem x s=false -> cardinal (add x s)=S (cardinal s).
 
559
Proof.
 
560
intros; apply add_cardinal_2; auto.
 
561
rewrite not_mem_iff; auto.
 
562
Qed.
 
563
 
 
564
Lemma remove_cardinal_1: 
 
565
 forall s x, mem x s=true -> S (cardinal (remove x s))=cardinal s.
 
566
Proof.
 
567
intros; apply remove_cardinal_1; auto with set.
 
568
Qed.
 
569
 
 
570
Lemma remove_cardinal_2: 
 
571
 forall s x, mem x s=false -> cardinal (remove x s)=cardinal s.
 
572
Proof.
 
573
intros; apply Equal_cardinal; apply equal_2; auto with set.
 
574
Qed.
 
575
 
 
576
Lemma union_cardinal: 
 
577
 forall s s', (forall x, mem x s && mem x s'=false) -> 
 
578
 cardinal (union s s')=cardinal s+cardinal s'.
 
579
Proof.
 
580
intros; apply union_cardinal; auto; intros.
 
581
rewrite exclusive_set; auto.
 
582
Qed.
 
583
 
 
584
Lemma subset_cardinal: 
 
585
 forall s s', subset s s'=true -> cardinal s<=cardinal s'.
 
586
Proof.
 
587
intros; apply subset_cardinal; auto with set.
 
588
Qed.
 
589
 
 
590
Section Bool.
 
591
 
 
592
(** Properties of [filter] *)
 
593
 
 
594
Variable f:elt->bool.
 
595
Variable Comp: compat_bool E.eq f.
 
596
 
 
597
Let Comp' : compat_bool E.eq (fun x =>negb (f x)).
 
598
Proof.
 
599
unfold compat_bool in *; intros; f_equal; auto.
 
600
Qed.
 
601
 
 
602
Lemma filter_mem: forall s x, mem x (filter f s)=mem x s && f x.
 
603
Proof. 
 
604
intros; apply filter_b; auto.
 
605
Qed.
 
606
 
 
607
Lemma for_all_filter: 
 
608
 forall s, for_all f s=is_empty (filter (fun x => negb (f x)) s).
 
609
Proof. 
 
610
intros; apply bool_1; split; intros.
 
611
apply is_empty_1.
 
612
unfold Empty; intros. 
 
613
rewrite filter_iff; auto.
 
614
red; destruct 1.
 
615
rewrite <- (@for_all_iff s f) in H; auto.
 
616
rewrite (H a H0) in H1; discriminate.
 
617
apply for_all_1; auto; red; intros.
 
618
revert H; rewrite <- is_empty_iff.
 
619
unfold Empty; intro H; generalize (H x); clear H.
 
620
rewrite filter_iff; auto.
 
621
destruct (f x); auto.
 
622
Qed.
 
623
 
 
624
Lemma exists_filter : 
 
625
 forall s, exists_ f s=negb (is_empty (filter f s)).
 
626
Proof. 
 
627
intros; apply bool_1; split; intros. 
 
628
destruct (exists_2 Comp H) as (a,(Ha1,Ha2)).
 
629
apply bool_6.
 
630
red; intros; apply (@is_empty_2 _ H0 a); auto with set.
 
631
generalize (@choose_1 (filter f s)) (@choose_2 (filter f s)).
 
632
destruct (choose (filter f s)).
 
633
intros H0 _; apply exists_1; auto.
 
634
exists e; generalize (H0 e); rewrite filter_iff; auto.
 
635
intros _ H0.
 
636
rewrite (is_empty_1 (H0 (refl_equal None))) in H; auto; discriminate.
 
637
Qed.
 
638
 
 
639
Lemma partition_filter_1: 
 
640
 forall s, equal (fst (partition f s)) (filter f s)=true.
 
641
Proof. 
 
642
auto with set.
 
643
Qed.
 
644
 
 
645
Lemma partition_filter_2: 
 
646
 forall s, equal (snd (partition f s)) (filter (fun x => negb (f x)) s)=true.
 
647
Proof. 
 
648
auto with set.
 
649
Qed.
 
650
 
 
651
Lemma filter_add_1 : forall s x, f x = true -> 
 
652
 filter f (add x s) [=] add x (filter f s). 
 
653
Proof.
 
654
red; intros; set_iff; do 2 (rewrite filter_iff; auto); set_iff.
 
655
intuition.
 
656
rewrite <- H; apply Comp; auto.
 
657
Qed.
 
658
 
 
659
Lemma filter_add_2 : forall s x, f x = false -> 
 
660
 filter f (add x s) [=] filter f s. 
 
661
Proof.
 
662
red; intros; do 2 (rewrite filter_iff; auto); set_iff.
 
663
intuition.
 
664
assert (f x = f a) by (apply Comp; auto).
 
665
rewrite H in H1; rewrite H2 in H1; discriminate.
 
666
Qed.
 
667
 
 
668
Lemma add_filter_1 : forall s s' x, 
 
669
 f x=true -> (Add x s s') -> (Add x (filter f s) (filter f s')).
 
670
Proof.
 
671
unfold Add, MP.Add; intros.
 
672
repeat rewrite filter_iff; auto.
 
673
rewrite H0; clear H0.
 
674
assert (E.eq x y -> f y = true) by 
 
675
 (intro H0; rewrite <- (Comp _ _ H0); auto).
 
676
tauto.
 
677
Qed.
 
678
 
 
679
Lemma add_filter_2 : forall s s' x, 
 
680
 f x=false -> (Add x s s') -> filter f s [=] filter f s'.
 
681
Proof.
 
682
unfold Add, MP.Add, Equal; intros.
 
683
repeat rewrite filter_iff; auto.
 
684
rewrite H0; clear H0.
 
685
assert (f a = true -> ~E.eq x a).
 
686
 intros H0 H1.
 
687
 rewrite (Comp _ _ H1) in H.
 
688
 rewrite H in H0; discriminate.
 
689
tauto. 
 
690
Qed.
 
691
 
 
692
Lemma union_filter: forall f g, (compat_bool E.eq f) -> (compat_bool E.eq g) ->
 
693
  forall s, union (filter f s) (filter g s) [=] filter (fun x=>orb (f x) (g x)) s.
 
694
Proof.
 
695
clear Comp' Comp f.
 
696
intros.
 
697
assert (compat_bool E.eq (fun x => orb (f x) (g x))).
 
698
  unfold compat_bool; intros.
 
699
  rewrite (H x y H1);  rewrite (H0 x y H1); auto.
 
700
unfold Equal; intros; set_iff; repeat rewrite filter_iff; auto.
 
701
assert (f a || g a = true <-> f a = true \/ g a = true).
 
702
  split; auto with bool.
 
703
  intro H3; destruct (orb_prop _ _ H3); auto.
 
704
tauto.
 
705
Qed.
 
706
 
 
707
Lemma filter_union: forall s s', filter f (union s s') [=] union (filter f s) (filter f s').
 
708
Proof.
 
709
unfold Equal; intros; set_iff; repeat rewrite filter_iff; auto; set_iff; tauto.
 
710
Qed.
 
711
 
 
712
(** Properties of [for_all] *)
 
713
 
 
714
Lemma for_all_mem_1: forall s, 
 
715
 (forall x, (mem x s)=true->(f x)=true) -> (for_all f s)=true.
 
716
Proof.
 
717
intros.
 
718
rewrite for_all_filter; auto.
 
719
rewrite is_empty_equal_empty.
 
720
apply equal_mem_1;intros.
 
721
rewrite filter_b; auto.
 
722
rewrite empty_mem.
 
723
generalize (H a); case (mem a s);intros;auto.
 
724
rewrite H0;auto.
 
725
Qed.
 
726
 
 
727
Lemma for_all_mem_2: forall s, 
 
728
 (for_all f s)=true -> forall x,(mem x s)=true -> (f x)=true. 
 
729
Proof.
 
730
intros.
 
731
rewrite for_all_filter in H; auto.
 
732
rewrite is_empty_equal_empty in H.
 
733
generalize (equal_mem_2 _ _ H x).
 
734
rewrite filter_b; auto.
 
735
rewrite empty_mem.
 
736
rewrite H0; simpl;intros.
 
737
replace true with (negb false);auto;apply negb_sym;auto.
 
738
Qed.
 
739
 
 
740
Lemma for_all_mem_3: 
 
741
 forall s x,(mem x s)=true -> (f x)=false -> (for_all f s)=false.
 
742
Proof.
 
743
intros.
 
744
apply (bool_eq_ind (for_all f s));intros;auto.
 
745
rewrite for_all_filter in H1; auto.
 
746
rewrite is_empty_equal_empty in H1.
 
747
generalize (equal_mem_2 _ _ H1 x).
 
748
rewrite filter_b; auto.
 
749
rewrite empty_mem.
 
750
rewrite H.
 
751
rewrite H0.
 
752
simpl;auto.
 
753
Qed.
 
754
 
 
755
Lemma for_all_mem_4: 
 
756
 forall s, for_all f s=false -> {x:elt | mem x s=true /\ f x=false}.
 
757
Proof.
 
758
intros.
 
759
rewrite for_all_filter in H; auto.
 
760
destruct (choose_mem_3 _ H) as (x,(H0,H1));intros.
 
761
exists x.
 
762
rewrite filter_b in H1; auto.
 
763
elim (andb_prop _ _ H1).
 
764
split;auto.
 
765
replace false with (negb true);auto;apply negb_sym;auto.
 
766
Qed.
 
767
 
 
768
(** Properties of [exists] *)
 
769
 
 
770
Lemma for_all_exists: 
 
771
 forall s, exists_ f s = negb (for_all (fun x =>negb (f x)) s).
 
772
Proof.
 
773
intros.
 
774
rewrite for_all_b; auto.
 
775
rewrite exists_b; auto.
 
776
induction (elements s); simpl; auto.
 
777
destruct (f a); simpl; auto.
 
778
Qed.
 
779
 
 
780
End Bool.
 
781
Section Bool'.
 
782
 
 
783
Variable f:elt->bool.
 
784
Variable Comp: compat_bool E.eq f.
 
785
 
 
786
Let Comp' : compat_bool E.eq (fun x =>negb (f x)).
 
787
Proof.
 
788
unfold compat_bool in *; intros; f_equal; auto.
 
789
Qed.
 
790
 
 
791
Lemma exists_mem_1: 
 
792
 forall s, (forall x, mem x s=true->f x=false) -> exists_ f s=false.
 
793
Proof.
 
794
intros.
 
795
rewrite for_all_exists; auto.
 
796
rewrite for_all_mem_1;auto with bool.
 
797
intros;generalize (H x H0);intros. 
 
798
symmetry;apply negb_sym;simpl;auto.
 
799
Qed.
 
800
 
 
801
Lemma exists_mem_2: 
 
802
 forall s, exists_ f s=false -> forall x, mem x s=true -> f x=false. 
 
803
Proof.
 
804
intros.
 
805
rewrite for_all_exists in H; auto.
 
806
replace false with (negb true);auto;apply negb_sym;symmetry.
 
807
rewrite (for_all_mem_2 (fun x => negb (f x)) Comp' s);simpl;auto.
 
808
replace true with (negb false);auto;apply negb_sym;auto.
 
809
Qed.
 
810
 
 
811
Lemma exists_mem_3: 
 
812
 forall s x, mem x s=true -> f x=true -> exists_ f s=true.
 
813
Proof.
 
814
intros.
 
815
rewrite for_all_exists; auto.
 
816
symmetry;apply negb_sym;simpl.
 
817
apply for_all_mem_3 with x;auto.
 
818
rewrite H0;auto.
 
819
Qed.
 
820
 
 
821
Lemma exists_mem_4: 
 
822
 forall s, exists_ f s=true -> {x:elt | (mem x s)=true /\ (f x)=true}.
 
823
Proof.
 
824
intros.
 
825
rewrite for_all_exists in H; auto.
 
826
elim (for_all_mem_4 (fun x =>negb (f x)) Comp' s);intros.
 
827
elim p;intros.
 
828
exists x;split;auto.
 
829
replace true with (negb false);auto;apply negb_sym;auto.
 
830
replace false with (negb true);auto;apply negb_sym;auto.
 
831
Qed.
 
832
 
 
833
End Bool'.
 
834
 
 
835
Section Sum.
 
836
 
 
837
(** Adding a valuation function on all elements of a set. *)
 
838
 
 
839
Definition sum (f:elt -> nat)(s:t) := fold (fun x => plus (f x)) s 0. 
 
840
Notation compat_opL := (compat_op E.eq (@Logic.eq _)).
 
841
Notation transposeL := (transpose (@Logic.eq _)).
 
842
 
 
843
Lemma sum_plus : 
 
844
  forall f g, compat_nat E.eq f -> compat_nat E.eq g -> 
 
845
    forall s, sum (fun x =>f x+g x) s = sum f s + sum g s.
 
846
Proof.
 
847
unfold sum.
 
848
intros f g Hf Hg.
 
849
assert (fc : compat_opL (fun x:elt =>plus (f x))).  auto.
 
850
assert (ft : transposeL (fun x:elt =>plus (f x))). red; intros; omega.
 
851
assert (gc : compat_opL (fun x:elt => plus (g x))). auto.
 
852
assert (gt : transposeL (fun x:elt =>plus (g x))). red; intros; omega.
 
853
assert (fgc : compat_opL (fun x:elt =>plus ((f x)+(g x)))). auto.
 
854
assert (fgt : transposeL (fun x:elt=>plus ((f x)+(g x)))). red; intros; omega.
 
855
assert (st : Equivalence (@Logic.eq nat)) by (split; congruence).
 
856
intros s;pattern s; apply set_rec.
 
857
intros.
 
858
rewrite <- (fold_equal _ _ st _ fc ft 0 _ _ H).
 
859
rewrite <- (fold_equal _ _ st _ gc gt 0 _ _ H).
 
860
rewrite <- (fold_equal _ _ st _ fgc fgt 0 _ _ H); auto.
 
861
intros; do 3 (rewrite (fold_add _ _ st);auto).
 
862
rewrite H0;simpl;omega.
 
863
do 3 rewrite fold_empty;auto.
 
864
Qed.
 
865
 
 
866
Lemma sum_filter : forall f, (compat_bool E.eq f) -> 
 
867
  forall s, (sum (fun x => if f x then 1 else 0) s) = (cardinal (filter f s)).
 
868
Proof.
 
869
unfold sum; intros f Hf.
 
870
assert (st : Equivalence (@Logic.eq nat)) by (split; congruence).
 
871
assert (cc : compat_opL (fun x => plus (if f x then 1 else 0))). 
 
872
 red; intros.
 
873
 rewrite (Hf x x' H); auto.
 
874
assert (ct : transposeL (fun x => plus (if f x then 1 else 0))).
 
875
 red; intros; omega.
 
876
intros s;pattern s; apply set_rec.
 
877
intros.
 
878
change elt with E.t.
 
879
rewrite <- (fold_equal _ _ st _ cc ct 0 _ _ H).
 
880
rewrite <- (MP.Equal_cardinal (filter_equal Hf (equal_2 H))); auto.
 
881
intros; rewrite (fold_add _ _ st _ cc ct); auto.
 
882
generalize (@add_filter_1 f Hf s0 (add x s0) x) (@add_filter_2 f Hf s0 (add x s0) x) .
 
883
assert (~ In x (filter f s0)).
 
884
 intro H1; rewrite (mem_1 (filter_1 Hf H1)) in H; discriminate H.
 
885
case (f x); simpl; intros.
 
886
rewrite (MP.cardinal_2 H1 (H2 (refl_equal true) (MP.Add_add s0 x))); auto.
 
887
rewrite <- (MP.Equal_cardinal (H3 (refl_equal false) (MP.Add_add s0 x))); auto.
 
888
intros; rewrite fold_empty;auto.
 
889
rewrite MP.cardinal_1; auto.
 
890
unfold Empty; intros.
 
891
rewrite filter_iff; auto; set_iff; tauto.
 
892
Qed.
 
893
 
 
894
Lemma fold_compat : 
 
895
  forall (A:Type)(eqA:A->A->Prop)(st:Equivalence eqA)
 
896
  (f g:elt->A->A),
 
897
  (compat_op E.eq eqA f) -> (transpose eqA f) -> 
 
898
  (compat_op E.eq eqA g) -> (transpose eqA g) -> 
 
899
  forall (i:A)(s:t),(forall x:elt, (In x s) -> forall y, (eqA (f x y) (g x y))) -> 
 
900
  (eqA (fold f s i) (fold g s i)).
 
901
Proof.
 
902
intros A eqA st f g fc ft gc gt i.
 
903
intro s; pattern s; apply set_rec; intros.
 
904
transitivity (fold f s0 i).
 
905
apply fold_equal with (eqA:=eqA); auto.
 
906
rewrite equal_sym; auto.
 
907
transitivity (fold g s0 i).
 
908
apply H0; intros; apply H1; auto with set.
 
909
elim  (equal_2 H x); auto with set; intros.
 
910
apply fold_equal with (eqA:=eqA); auto with set.
 
911
transitivity (f x (fold f s0 i)).
 
912
apply fold_add with (eqA:=eqA); auto with set.
 
913
transitivity (g x (fold f s0 i)); auto with set.
 
914
transitivity (g x (fold g s0 i)); auto with set.
 
915
symmetry; apply fold_add with (eqA:=eqA); auto.
 
916
do 2 rewrite fold_empty; reflexivity.
 
917
Qed.
 
918
 
 
919
Lemma sum_compat : 
 
920
  forall f g, compat_nat E.eq f -> compat_nat E.eq g -> 
 
921
  forall s, (forall x, In x s -> f x=g x) -> sum f s=sum g s.
 
922
intros.
 
923
unfold sum; apply (fold_compat _ (@Logic.eq nat)); auto.
 
924
red; intros; omega.
 
925
red; intros; omega.
 
926
Qed.
 
927
 
 
928
End Sum.
 
929
 
 
930
End WEqProperties_fun.
 
931
 
 
932
(** Now comes variants for self-contained weak sets and for full sets.
 
933
    For these variants, only one argument is necessary. Thanks to
 
934
    the subtyping [WS<=S], the [EqProperties] functor which is meant to be
 
935
    used on modules [(M:S)] can simply be an alias of [WEqProperties]. *)
 
936
 
 
937
Module WEqProperties (M:WS) := WEqProperties_fun M.E M.
 
938
Module EqProperties := WEqProperties.