-
Notifications
You must be signed in to change notification settings - Fork 0
Expand file tree
/
Copy pathIndProp.v
More file actions
1850 lines (1630 loc) · 51 KB
/
Copy pathIndProp.v
File metadata and controls
1850 lines (1630 loc) · 51 KB
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
Set Warnings "-notation-overridden".
From LF Require Export Logic.
From LF Require Export Basics.
From LF Require Export Lists.
From LF Require Export Poly.
From Stdlib Require Import Lia.
(* inductively defined propositions *)
(* you define a proposition by giving rules for proving it, and Coq treats those rules as constructors that build proof terms. *)
(* EXAMPLE : THE COLLATZ CONJECTURE *)
(* csf -> Collatz step functions *)
Fixpoint div2 (n : nat) : nat :=
match n with
| 0 => 0
| 1 => 0
| S ( S n) => S ( div2 n)
end.
Definition csf (n : nat) : nat :=
if even n then div2 n
else (3 * n) + 1.
Fail Fixpoint reaches1_in (n : nat) : nat :=
if n=? 1 then 0
else 1 + reaches1_in (csf n).
Fail Fixpoint Collatz_holds_for (n : nat) : Prop :=
match n with
| 0 => False
| 1 => True
| _ => if even n then Collatz_holds_for (div2 n)
else Collatz_holds_for ((3 * n) + 1)
end.
Inductive Collatz_holds_for : nat -> Prop :=
| Chf_one : Collatz_holds_for 1
| Chf_even (n : nat) : even n = true ->
Collatz_holds_for (div2 n) ->
Collatz_holds_for n
| Chf_odd (n : nat) : even n = false ->
Collatz_holds_for ((3*n + 1)) ->
Collatz_holds_for n.
Example Collatz_holds_for_12 : Collatz_holds_for 12.
Proof.
apply Chf_even. reflexivity. simpl.
apply Chf_even. reflexivity. simpl.
apply Chf_odd. reflexivity. simpl.
apply Chf_even. reflexivity. simpl.
apply Chf_odd. reflexivity. simpl.
apply Chf_even. reflexivity. simpl.
apply Chf_even. reflexivity. simpl.
apply Chf_even. reflexivity. simpl.
apply Chf_even. reflexivity. simpl.
apply Chf_one.
Qed.
Conjecture collatz : forall n, n <> 0 -> Collatz_holds_for n.
(* EXAMPLE : BINARY RELATION FOR COMPARING NUMBERS *)
Inductive le : nat -> nat -> Prop :=
| le_n (n : nat) : le n n
| le_S (n m : nat) : le n m -> le n ( S m).
Notation "n <= m" := (le n m) (at level 70).
Example le_3_5 : 3 <= 5.
Proof.
apply le_S. apply le_S. apply le_n.
Qed.
(* EXAMPLE : TRANSITIVE CLOSURE *)
Inductive clos_trans { X : Type} (R : X -> X -> Prop) : X -> X -> Prop :=
| t_step ( x y : X) :
R x y ->
clos_trans R x y
| t_trans ( x y z : X) :
clos_trans R x y ->
clos_trans R y z ->
clos_trans R x z.
Inductive Person : Type := Sage | Cleo | Ridley | Moss.
Inductive parent_of : Person -> Person -> Prop :=
| po_SC : parent_of Sage Cleo
| po_SR : parent_of Sage Ridley
| po_CM : parent_of Cleo Moss.
Definition ancestor_of : Person -> Person -> Prop :=
clos_trans parent_of.
Example ancestor_of_ex : ancestor_of Sage Moss.
Proof.
unfold ancestor_of. apply t_trans with Cleo.
- apply t_step. apply po_SC.
- apply t_step. apply po_CM.
Qed.
(* EXAMPLE : REFLEXIVE AND TRANSITIVE CLOSURE *)
Inductive clos_refl_trans { X : Type} (R : X -> X -> Prop) : X -> X -> Prop :=
| rt_step (x y : X) :
R x y ->
clos_refl_trans R x y
| rt_refl ( x : X) :
clos_refl_trans R x x
| rt_trans ( x y z : X ) :
clos_refl_trans R x y ->
clos_refl_trans R y z ->
clos_refl_trans R x z.
Definition cs ( n m : nat) : Prop := csf n = m.
Check cs.
Definition cms n m := clos_refl_trans cs n m.
Check cms.
(* Exercise : clos_refl_trans_sym *)
Inductive clos_refl_trans_sym { X : Type} (R : X -> X -> Prop) : X -> X -> Prop :=
| rts_step (x y : X) :
R x y ->
clos_refl_trans_sym R x y
| rts_refl ( x : X) :
clos_refl_trans_sym R x x
| rts_sym ( x y : X) :
clos_refl_trans_sym R x y ->
clos_refl_trans_sym R y x
| rts_trans ( x y z : X ) :
clos_refl_trans_sym R x y ->
clos_refl_trans_sym R y z ->
clos_refl_trans_sym R x z.
(* had to import these notations, no idea why [a;b;c] was showing error *)
Notation "x :: l" := (cons x l)
(at level 60, right associativity).
Notation "[ ]" := nil.
Notation "[ x ; .. ; y ]" := (cons x .. (cons y nil) ..).
(* EXAMPLE : PERMUTATIONS *)
Inductive Perm3 {X : Type} : list X -> list X -> Prop :=
| perm3_swap12 (a b c : X) :
Perm3 [a;b;c] [b;a;c]
| perm3_swap23 (a b c : X) :
Perm3 [a;b;c] [a;c;b]
| perm3_trans (l1 l2 l3 : list X) :
Perm3 l1 l2 -> Perm3 l2 l3 -> Perm3 l1 l3.
(* EXAMPLE : EVENNESS ( YET AGAIN ) *)
Inductive ev : nat -> Prop :=
| ev_0 : ev 0
| ev_SS (n : nat ) ( H : ev n) : ev ( S ( S n)).
Check ev.
Check ev_0.
Check (ev 5).
Check ev_SS.
Fail Inductive wrong_ev (n : nat) : Prop :=
| wrong_ev_0 : wrong_ev 0
| wrong_ev_SS (H: wrong_ev n) : wrong_ev (S (S n)).
Module EvPlayground.
Inductive ev : nat -> Prop :=
| ev_0 : ev 0
| ev_SS : forall (n : nat), ev n -> ev (S (S n)).
End EvPlayground.
Theorem ev_4 : ev 4.
Proof.
apply ev_SS. apply ev_SS. apply ev_0.
Qed.
Theorem ev_4' : ev 4.
Proof.
apply (ev_SS 2 ( ev_SS 0 ev_0)).
Qed.
Theorem ev_plus4 : forall n, ev n -> ev ( 4 + n).
Proof.
intros n.
simpl.
intros H.
apply ev_SS.
apply ev_SS.
apply H.
Qed.
Theorem ev_double : forall n,
ev ( double n).
Proof.
intros.
induction n as [ | n' IHn'].
- simpl. apply ev_0.
- simpl. apply ev_SS. apply IHn'.
Qed.
(* Constructing Evidence for Permutations *)
Lemma Perm3_rev : Perm3 [1;2;3] [3;2;1].
Proof.
apply perm3_trans with (l2 := [2;3;1]).
- apply perm3_trans with (l2 := [2;1;3]).
+ apply perm3_swap12.
+ apply perm3_swap23.
- apply perm3_swap12.
Qed.
Lemma Perm3_rev' : Perm3 [1;2;3] [3;2;1].
Proof.
apply (perm3_trans _ [2;3;1] _
(perm3_trans _ [2;1;3] _
(perm3_swap12 _ _ _)
(perm3_swap23 _ _ _))
(perm3_swap12 _ _ _)).
Qed.
Lemma Perm3_ex1 : Perm3 [1;2;3] [2;3;1].
Proof.
apply perm3_trans with (l2 := [2;1;3]).
- apply perm3_swap12.
- apply perm3_swap23.
Qed.
Lemma Perm3_refl : forall (X : Type ) (a b c : X ),
Perm3 [a;b;c] [a;b;c].
Proof.
intros.
apply perm3_trans with (l2 := [b;a;c]).
- apply perm3_swap12.
- apply perm3_swap12.
Qed.
(* ################################################################# *)
(* USING EVIDENCE IN PROOFS *)
Theorem ev_inversion : forall (n : nat),
ev n ->
(n = 0) \/ (exists n', n = S (S n') /\ ev n').
Proof.
intros n E. destruct E as [ | n' E'] eqn:EE.
- (* E = ev_0 : ev 0 *)
left. reflexivity.
- (* E = ev_SS n' E' : ev (S (S n')) *)
right. exists n'. split. reflexivity. apply E'.
Qed.
(* Theorem le_inversion : forall (n m : nat),
le n m ->
(n = m) \/ (exists m', m = S m' /\ le n m').
Proof.
intros n m E.
destruct E as [| m' E'] eqn:EE.
- left. reflexivity.
- right. exists m'. split.
reflexivity. apply E'.
Qed. *)
Theorem evSS_ev : forall n, ev (S (S n)) -> ev n.
Proof.
intros n E. apply ev_inversion in E. destruct E as [H0|H1].
- discriminate H0.
- destruct H1 as [n' [Hnn' E']]. injection Hnn' as Hnn'.
rewrite Hnn'. apply E'.
Qed.
Theorem evSS_ev' : forall n,
ev (S (S n)) -> ev n.
Proof.
intros n E. inversion E as [| n' E' Hnn'].
(* We are in the [E = ev_SS n' E'] case now. *)
apply E'.
Qed.
Theorem one_not_even : ~ ev 1.
Proof.
intros H. apply ev_inversion in H. destruct H as [ | [m [Hm _]]].
- discriminate H.
- discriminate Hm.
Qed.
Theorem one_not_even' : ~ ev 1.
Proof. intros H. inversion H. Qed.
Theorem SSSSev__even : forall n,
ev (S (S (S (S n)))) -> ev n.
Proof.
intros n H. inversion H as [| n0 H0 Heq0]. inversion H0 as [| n1 H1 Heq1].
apply H1.
Qed.
Theorem ev5_nonsense :
ev 5 -> 2 + 2 = 9.
Proof.
intros H.
inversion H as [| n0 H0 Heq0].
inversion H0 as [| n1 H1 Heq1].
inversion H1.
Qed.
Theorem inversion_ex1 : forall (n m o : nat),
[n; m] = [o; o] -> [n] = [m].
Proof.
intros n m o H. inversion H. reflexivity. Qed.
Theorem inversion_ex2 : forall (n : nat),
S n = O -> 2 + 2 = 5.
Proof.
intros n contra. inversion contra. Qed.
Lemma ev_Even_firsttry : forall n,
ev n -> Even n.
Proof.
unfold Even.
intros n E. inversion E as [EQ' | n' E' EQ'].
- (* E = ev_0 *) exists 0. reflexivity.
- assert (H: (exists k', n' = double k')
-> (exists n0, S (S n') = double n0)).
{ intros [k' EQ'']. exists (S k'). simpl.
rewrite <- EQ''. reflexivity. }
apply H.
generalize dependent E'.
Abort.
(* ================================================================= *)
(* INDUCTION ON EVIDENCE *)
Lemma ev_Even : forall n,
ev n -> Even n.
Proof.
unfold Even. intros n E.
induction E as [|n' E' IH].
- (* E = ev_0 *)
exists 0. reflexivity.
- (* E = ev_SS n' E', with IH : Even n' *)
destruct IH as [k Hk]. rewrite Hk.
exists (S k). simpl. reflexivity.
Qed.
Theorem ev_Even_iff : forall n,
ev n <-> Even n.
Proof.
intros n. split.
- (* -> *) apply ev_Even.
- (* <- *) unfold Even. intros [k Hk]. rewrite Hk. apply ev_double.
Qed.
Theorem ev_sum : forall n m, ev n -> ev m -> ev (n + m).
Proof.
intros n m En Em.
induction En.
- apply Em.
- simpl. apply ev_SS. apply IHEn.
Qed.
(** [] *)
Theorem ev_ev__ev : forall n m,
ev (n+m) -> ev n -> ev m.
Proof.
intros n m.
intros E1 E2.
induction E2.
- apply E1.
- simpl in E1. inversion E1 as [| sum E3 H]. apply (IHE2 E3).
Qed.
Theorem ev_plus_plus : forall n m p,
ev (n+m) -> ev (n+p) -> ev (m+p).
Proof.
intros n m p Enm Enp.
apply ev_ev__ev with (n + n).
- assert (ev ((n + m) + (n + p))) as H.
{ apply ev_sum. apply Enm. apply Enp. }
rewrite add_comm with n m in H.
rewrite <- add_assoc with m n (n + p) in H.
rewrite add_assoc with n n p in H.
rewrite add_comm with (n + n) p in H.
rewrite add_assoc with m p (n + n) in H.
rewrite add_comm with (m + p) (n + n) in H.
apply H.
- rewrite <- double_plus. apply ev_double.
Qed.
(* ------------ MULTIPLE INDUCTION HYPOTHESES ------------- *)
Inductive ev' : nat -> Prop :=
| ev'_0 : ev' 0
| ev'_2 : ev' 2
| ev'_sum n m (Hn : ev' n) (Hm : ev' m) : ev' (n + m).
Theorem ev'_ev : forall n, ev' n <-> ev n.
Proof.
intros n.
split.
- intros H. induction H.
+ apply ev_0.
+ apply ev_SS. apply ev_0.
+ apply ev_sum. apply IHev'1. apply IHev'2.
- intros H. induction H.
+ apply ev'_0.
+ rewrite <- plus_1_l with (S n). rewrite <- plus_n_Sm. rewrite <- plus_1_l.
rewrite add_assoc. apply ev'_sum.
* apply ev'_2.
* apply IHev.
Qed.
Module Perm3Reminder.
Inductive Perm3 {X : Type} : list X -> list X -> Prop :=
| perm3_swap12 (a b c : X) :
Perm3 [a;b;c] [b;a;c]
| perm3_swap23 (a b c : X) :
Perm3 [a;b;c] [a;c;b]
| perm3_trans (l1 l2 l3 : list X) :
Perm3 l1 l2 -> Perm3 l2 l3 -> Perm3 l1 l3.
End Perm3Reminder.
Lemma Perm3_symm : forall (X : Type) (l1 l2 : list X),
Perm3 l1 l2 -> Perm3 l2 l1.
Proof.
intros X l1 l2 E.
induction E as [a b c | a b c | l1 l2 l3 E12 IH12 E23 IH23].
- apply perm3_swap12.
- apply perm3_swap23.
- apply (perm3_trans _ l2 _).
* apply IH23.
* apply IH12.
Qed.
Lemma Perm3_In : forall (X : Type) (x : X) (l1 l2 : list X),
Perm3 l1 l2 -> In x l1 -> In x l2.
Proof.
intros X x l1 l2 HPerm HIn.
induction HPerm.
- simpl.
destruct HIn as [E|HIn'].
+ right. left. apply E.
+ inversion HIn' as [E|HIn''].
* left. apply E.
* inversion HIn'' as [E|contra].
** right. right. left. apply E.
** destruct contra.
- simpl.
destruct HIn as [E|HIn'].
+ left. apply E.
+ inversion HIn' as [E|HIn''].
* right. right. left. apply E.
* inversion HIn'' as [E|contra].
** right. left. apply E.
** destruct contra.
- simpl.
apply IHHPerm2. apply IHHPerm1. apply HIn.
Qed.
Lemma Perm3_NotIn : forall (X : Type) (x : X) (l1 l2 : list X),
Perm3 l1 l2 -> ~In x l1 -> ~In x l2.
Proof.
intros X x l1 l2 HPerm HNotIn contra.
apply HNotIn.
apply Perm3_In with (l1:=l2).
- apply Perm3_symm. apply HPerm.
- apply contra.
Qed.
Example Perm3_example2 : ~ Perm3 [1;2;3] [1;2;4].
Proof.
intros contra.
assert (H: In 3 [1;2;4]).
{ apply Perm3_In with (l1:=[1;2;3]). apply contra. simpl. right. right. left. reflexivity. }
destruct H as [|H1]. discriminate.
destruct H1 as [|H2]. discriminate.
destruct H2 as [|H3]. discriminate.
destruct H3.
Qed.
(* ################################################################# *)
(* -------------- EXERCISING WITH INDUCTIVE RELATIONS -------------------- *)
Module Playground.
Inductive le : nat -> nat -> Prop :=
| le_n (n : nat) : le n n
| le_S (n m : nat) (H : le n m) : le n (S m).
Notation "n <= m" := (le n m).
Theorem test_le1 :
3 <= 3.
Proof.
(* WORKED IN CLASS *)
apply le_n. Qed.
Theorem test_le2 :
3 <= 6.
Proof.
(* WORKED IN CLASS *)
apply le_S. apply le_S. apply le_S. apply le_n. Qed.
Theorem test_le3 :
(2 <= 1) -> 2 + 2 = 5.
Proof.
(* WORKED IN CLASS *)
intros H. inversion H. inversion H2. Qed.
Definition lt (n m : nat) := le (S n) m.
Notation "n < m" := (lt n m).
Definition ge (m n : nat) : Prop := le n m.
Notation "m >= n" := (ge m n).
Lemma le_trans : forall m n o, m <= n -> n <= o -> m <= o.
Proof.
intros m n o Emn Eno.
induction Eno.
- apply Emn.
- apply le_S. apply IHEno. apply Emn.
Qed.
Theorem O_le_n : forall n,
0 <= n.
Proof.
intros n.
induction n.
- apply le_n.
- apply (le_S 0 n IHn).
Qed.
Theorem n_le_m__Sn_le_Sm : forall n m,
n <= m -> S n <= S m.
Proof.
intros n m H.
induction H.
- apply le_n.
- apply le_S. apply IHle.
Qed.
Theorem Sn_le_Sm__n_le_m : forall n m,
S n <= S m -> n <= m.
Proof.
intros n m H.
inversion H as [Heq | m' H' Heq].
- apply le_n.
- apply (le_trans n (S n) m).
+ apply le_S. apply le_n.
+ apply Heq.
Qed.
Theorem le_plus_l : forall a b,
a <= a + b.
Proof.
intros a b.
induction b.
- rewrite add_0_r. apply le_n.
- rewrite <- plus_n_Sm. apply (le_S a (a + b) IHb).
Qed.
Theorem plus_le : forall n1 n2 m,
n1 + n2 <= m ->
n1 <= m /\ n2 <= m.
Proof.
intros n1 n2 m H.
split.
- apply (le_trans n1 (n1 + n2) m).
+ apply le_plus_l.
+ apply H.
- apply (le_trans n2 (n1 + n2) m).
+ rewrite add_comm. apply le_plus_l.
+ apply H.
Qed.
Theorem plus_le_cases : forall n m p q,
n + m <= p + q -> n <= p \/ m <= q.
Proof.
induction n.
- left. apply O_le_n.
- intros. destruct p.
+ right. apply plus_le in H.
destruct H as [H1 H2].
rewrite plus_O_n in H1.
apply H2.
+ simpl in H.
rewrite plus_n_Sm with n m in H.
rewrite plus_n_Sm with p q in H.
apply IHn in H. destruct H.
* left. apply n_le_m__Sn_le_Sm. apply H.
* right. apply Sn_le_Sm__n_le_m. apply H.
Qed.
Theorem plus_le_compat_l : forall n m p,
n <= m ->
p + n <= p + m.
Proof.
intros n m p.
induction p.
- intros. rewrite plus_O_n. rewrite plus_O_n. apply H.
- intros. simpl. apply n_le_m__Sn_le_Sm. apply (IHp H).
Qed.
Theorem plus_le_compat_r : forall n m p,
n <= m ->
n + p <= m + p.
Proof.
intros n m p H.
rewrite add_comm with n p.
rewrite add_comm with m p.
apply plus_le_compat_l.
apply H.
Qed.
Theorem le_plus_trans : forall n m p,
n <= m ->
n <= m + p.
Proof.
intros n m p.
generalize dependent n.
generalize dependent m.
induction p.
- intros. rewrite add_comm. rewrite plus_O_n. apply H.
- intros. destruct H.
+ apply le_plus_l.
+ simpl.
apply IHp in H.
apply le_S in H. rewrite plus_n_Sm in H.
apply (le_S n (m + S p) H).
Qed.
Theorem lt_ge_cases : forall n m,
n < m \/ n >= m.
Proof.
intros n m.
destruct m.
- right. apply O_le_n.
- induction n.
+ left. apply n_le_m__Sn_le_Sm. apply O_le_n.
+ destruct IHn.
* destruct H.
right. apply le_n.
left. apply n_le_m__Sn_le_Sm. apply H.
* right. apply le_S. apply H.
Qed.
Theorem n_lt_m__n_le_m : forall n m,
n < m ->
n <= m.
Proof.
intros n m H.
unfold lt in H.
apply (le_trans n (S n) m).
- apply le_S. apply le_n.
- apply H.
Qed.
Theorem plus_lt : forall n1 n2 m,
n1 + n2 < m ->
n1 < m /\ n2 < m.
Proof.
intros n1 n2 m H.
unfold lt in H.
split.
- apply (le_trans (S n1) (S (n1 + n2)) m).
+ apply n_le_m__Sn_le_Sm. apply le_plus_l.
+ apply H.
- apply (le_trans (S n2) (S (n1 + n2)) m).
+ apply n_le_m__Sn_le_Sm. rewrite add_comm. apply le_plus_l.
+ apply H.
Qed.
Theorem leb_complete : forall n m,
n <=? m = true -> n <= m.
Proof.
intros n m.
generalize dependent m.
induction n.
- intros. apply O_le_n.
- intros. destruct m.
+ discriminate.
+ simpl in H. apply IHn in H. apply n_le_m__Sn_le_Sm. apply H.
Qed.
Theorem leb_correct : forall n m,
n <= m ->
n <=? m = true.
Proof.
intros n m.
generalize dependent n.
induction m.
- intros. inversion H. reflexivity.
- destruct n.
+ reflexivity.
+ intros. apply Sn_le_Sm__n_le_m in H. apply (IHm n H).
Qed.
Theorem leb_iff : forall n m,
n <=? m = true <-> n <= m.
Proof.
intros n m.
split.
- apply leb_complete.
- apply leb_correct.
Qed.
Theorem leb_true_trans : forall n m o,
n <=? m = true -> m <=? o = true -> n <=? o = true.
Proof.
intros n m o Hnm Hmo.
apply leb_complete in Hnm.
apply leb_complete in Hmo.
apply leb_correct.
apply le_trans with m.
apply Hnm. apply Hmo.
Qed.
Module R.
Inductive R : nat -> nat -> nat -> Prop :=
| c1 : R 0 0 0
| c2 m n o (H : R m n o ) : R (S m) n (S o)
| c3 m n o (H : R m n o ) : R m (S n) (S o)
| c4 m n o (H : R (S m) (S n) (S (S o))) : R m n o
| c5 m n o (H : R m n o ) : R n m o
.
Definition fR : nat -> nat -> nat := plus.
Theorem R_equiv_fR : forall m n o, R m n o <-> fR m n = o.
Proof.
intros m n o.
split.
- intros H. induction H.
+ reflexivity.
+ simpl. rewrite IHR. reflexivity.
+ simpl. rewrite add_comm. simpl. rewrite add_comm. unfold fR in IHR. rewrite IHR. reflexivity.
+ simpl in IHR. injection IHR as IHR.
rewrite add_comm in IHR. simpl in IHR. injection IHR as IHR.
rewrite add_comm in IHR. apply IHR.
+ unfold fR in *. rewrite add_comm. apply IHR.
- generalize dependent o. generalize dependent n.
induction m as [| m' IHm].
+ intros n o H. simpl in H. subst.
induction o as [| o' IHn].
* apply c1.
* apply c3. apply IHn.
+ intros n o H. simpl in H. subst.
apply c2. apply IHm. reflexivity.
Qed.
End R.
Inductive subseq : list nat -> list nat -> Prop :=
| subseq0 l : subseq [] l
| subseq1 x l1 l2 (H : subseq l1 l2) : subseq (x :: l1) (x :: l2)
| subseq2 x l1 l2 (H : subseq l1 l2) : subseq l1 (x :: l2)
.
Theorem subseq_refl : forall (l : list nat), subseq l l.
Proof.
induction l as [| x l IH].
- apply subseq0.
- apply (subseq1 x l l IH).
Qed.
Theorem subseq_app : forall (l1 l2 l3 : list nat),
subseq l1 l2 ->
subseq l1 (l2 ++ l3).
Proof.
intros.
induction H as [| x l1 l2 H IH | x l1 l2 H IH].
- apply subseq0.
- simpl. apply (subseq1 x l1 (l2 ++ l3) IH).
- simpl. apply (subseq2 x l1 (l2 ++ l3) IH).
Qed.
Theorem subseq_trans : forall (l1 l2 l3 : list nat),
subseq l1 l2 ->
subseq l2 l3 ->
subseq l1 l3.
Proof.
intros l1 l2 l3 H12 H23.
generalize dependent l1.
induction H23 as [| x l2 l3 H23 IH | x l2 l3 H23 IH].
- intros.
assert (l1 = []) as Hl1. inversion H12. reflexivity.
rewrite Hl1. apply subseq0.
- intros. inversion H12 as [| x' l1' l2' H12' | x' l1' l2' H12'].
+ apply subseq0.
+ apply (subseq1 x l1' l3 (IH l1' H12')).
+ apply (subseq2 x l1 l3 (IH l1 H12')).
- intros. apply (subseq2 x l1 l3 (IH l1 H12)).
Qed.
Inductive total_relation : nat -> nat -> Prop :=
| total_rel : forall n m, total_relation n m.
Theorem total_relation_is_total : forall n m, total_relation n m.
Proof.
intros n m. apply total_rel.
Qed.
Inductive empty_relation : nat -> nat -> Prop := .
Theorem empty_relation_is_empty : forall n m, ~ empty_relation n m.
Proof.
intros n m H.
inversion H.
Qed.
(* CASE STUDY : REGULAR EXPRESSIONS *)
Inductive reg_exp (T : Type) : Type :=
| EmptySet
| EmptyStr
| Char (t : T)
| App (r1 r2 : reg_exp T)
| Union (r1 r2 : reg_exp T)
| Star (r : reg_exp T).
Arguments EmptySet {T}.
Arguments EmptyStr {T}.
Arguments Char {T} _.
Arguments App {T} _ _.
Arguments Union {T} _ _.
Arguments Star {T} _.
Reserved Notation "s =~ re" (at level 80).
Inductive exp_match {T} : list T -> reg_exp T -> Prop :=
| MEmpty : [] =~ EmptyStr
| MChar x : [x] =~ (Char x)
| MApp s1 re1 s2 re2
(H1 : s1 =~ re1)
(H2 : s2 =~ re2)
: (s1 ++ s2) =~ (App re1 re2)
| MUnionL s1 re1 re2
(H1 : s1 =~ re1)
: s1 =~ (Union re1 re2)
| MUnionR s2 re1 re2
(H2 : s2 =~ re2)
: s2 =~ (Union re1 re2)
| MStar0 re : [] =~ (Star re)
| MStarApp s1 s2 re
(H1 : s1 =~ re)
(H2 : s2 =~ (Star re))
: (s1 ++ s2) =~ (Star re)
where "s =~ re" := (exp_match s re).
Example reg_exp_ex1 : [1] =~ Char 1.
Proof.
apply MChar.
Qed.
Check MApp [1;2].
Example reg_exp_ex2 : [1;2] =~ App (Char 1) (Char 2).
Proof.
apply (MApp [1]).
- apply MChar.
- apply MChar.
Qed.
Example reg_exp_ex3 : ~([1;2] =~ Char 1).
Proof.
intros H. inversion H.
Qed.
Fixpoint reg_exp_of_list {T} (l : list T) :=
match l with
| [] => EmptyStr
| x :: l' => App (Char x) (reg_exp_of_list l')
end.
Example reg_exp_ex4 : [1;2;3] =~ reg_exp_of_list [1;2;3].
Proof.
simpl. apply (MApp [1]).
{ apply MChar. }
apply (MApp [2]).
{ apply MChar. }
apply (MApp [3]).
{ apply MChar. }
apply MEmpty.
Qed.
Lemma MStar1 :
forall T s (re : reg_exp T) ,
s =~ re ->
s =~ Star re.
Proof.
intros T s re H.
rewrite <- (app_nil_r _ s).
apply MStarApp.
- apply H.
- apply MStar0.
Qed.
Lemma EmptySet_is_empty : forall T ( s : list T),
~(s =~ EmptySet).
Proof.
intros T s.
unfold not. intros. inversion H.
Qed.
Lemma MUnion' : forall T (s : list T) (re1 re2 : reg_exp T),
s =~ re1 \/ s =~ re2 ->
s =~ Union re1 re2.
Proof.
intros.
destruct H.
- apply MUnionL. apply H.
- apply MUnionR. apply H.
Qed.
Lemma MStar' : forall T (ss : list (list T)) (re : reg_exp T),
(forall s, In s ss -> s =~ re) ->
fold app ss [] =~ Star re.
Proof.
intros.
induction ss as [ | s1 ss IHss'].
- simpl. apply MStar0.
- simpl. apply MStarApp.
+ apply H. left. reflexivity.
+ apply IHss'. intros. apply H. right. apply H0.
Qed.
Definition EmptyStr' {T:Type} := @Star T (EmptySet).
Theorem EmptyStr_not_needed : forall T (s : list T),
s =~ EmptyStr <-> s =~ EmptyStr'.
Proof.
intros. split.
- intros.
destruct s.
+ apply MStar0.
+ inversion H.
- intros.
destruct s.
+ apply MEmpty.
+ inversion H. inversion H2.
Qed.
Fixpoint re_chars {T} (re : reg_exp T) : list T :=
match re with
| EmptySet => []
| EmptyStr => []
| Char x => [x]
| App re1 re2 => re_chars re1 ++ re_chars re2
| Union re1 re2 => re_chars re1 ++ re_chars re2
| Star re => re_chars re
end.
Theorem in_re_match : forall T (s : list T) (re : reg_exp T) (x : T),
s =~ re ->
In x s ->
In x (re_chars re).
Proof.
intros T s re x HMatch Hin.
induction HMatch
as [ | x'
| s1 re1 s2 re2 Hmatch1 IH1 Hmatch2 IH2
| s1 re1 re2 Hmatch IH | s2 re1 re2 Hmatch IH
| re | s1 s2 re Hmatch1 IH1 Hmatch2 IH2].
- simpl in Hin. destruct Hin.
- simpl. simpl in Hin. apply Hin.
- simpl.
rewrite In_app_iff in Hin.
destruct Hin as [ Hin | Hin].
+ rewrite In_app_iff. left. apply (IH1 Hin).
+ rewrite In_app_iff. right. apply (IH2 Hin).
- simpl. rewrite In_app_iff. left. apply (IH Hin).
- simpl. rewrite In_app_iff. right. apply (IH Hin).
- simpl. destruct Hin.
- simpl. rewrite In_app_iff in Hin.
destruct Hin as [Hin | Hin].
+ apply (IH1 Hin).
+ apply (IH2 Hin).
Qed.
Fixpoint re_not_empty {T : Type} (re : reg_exp T) : bool :=
match re with
| EmptySet => false
| EmptyStr => true
| Char _ => true
| App re1 re2 => (re_not_empty re1) && (re_not_empty re2)
| Union re1 re2 => (re_not_empty re1) || (re_not_empty re2)
| Star _ => true
end.
Theorem andb_true_iff : forall b1 b2:bool,
b1 && b2 = true <-> b1 = true /\ b2 = true.
Proof.