@@ -40,76 +40,42 @@ Section EmbedNaturals.
40
40
41
41
(*Proofs that embed and unembed are inverses of each other. *)
42
42
43
- Lemma gauss_sum_sn (n : nat) : (gauss_sum (S n)) = ((S n) + gauss_sum n).
44
- Proof .
45
- apply idpath.
46
- Qed .
47
-
48
- Lemma natplusS (n m : nat) : n + S m = S (n + m).
43
+ Lemma embedinv (n : nat) : (embed (unembed n)) = n.
49
44
Proof .
50
- induction (pathsinv0 (natpluscomm n (S m))).
51
- induction (pathsinv0 (natpluscomm n m)).
52
- apply idpath.
45
+ induction n as [|n IH]. reflexivity.
46
+ simpl. revert IH. destruct (unembed n) as [x y].
47
+ case x as [|x]; intro Hx; rewrite <- Hx; unfold embed; simpl.
48
+ - rewrite natplusr0. apply idpath.
49
+ - rewrite natpluscomm, (natpluscomm y (S x)).
50
+ simpl. rewrite (natpluscomm y (S (x + y + gauss_sum (x + y)))). apply maponpaths. simpl. apply maponpaths. rewrite (natpluscomm x y). apply idpath.
53
51
Qed .
54
52
55
-
56
- Lemma embedsn (m : nat) : (embed (0,, S m)) = ((S (S m)) + embed (0,, m)).
53
+ Lemma embed0x (x y : nat) : (embed (S x,, 0) = S (embed (0,, x))).
57
54
Proof .
58
- induction m.
59
- - apply idpath.
60
- - unfold embed. simpl.
61
- induction (pathsinv0 (natplusr0 m)).
62
- induction (pathsinv0 (natplusS m (S (m + S (m + gauss_sum (m)))))).
63
- apply idpath.
64
- Qed .
65
-
66
- Lemma embedmsn (n m : nat) : (embed (n,, S m)) = ((S (S (n + m)) + embed (n,, m))).
67
- Proof .
68
- unfold embed.
69
- simpl.
70
- induction (pathsinv0 (natplusS m (m + n + gauss_sum (m + n)))).
71
- repeat apply maponpaths.
72
- induction (pathsinv0 (natpluscomm n m)).
73
- induction ( (natplusassoc m (m + n) (gauss_sum (m + n)))).
74
- induction (natplusassoc m m n).
75
- induction (natplusassoc (m + n) m (gauss_sum (m + n))).
76
- apply (maponpaths (λ x, add x (gauss_sum (m + n)))).
77
- induction (pathsinv0 (natplusassoc m m n)), (pathsinv0 (natplusassoc m n m)).
78
- apply (maponpaths (add m)).
79
- apply natpluscomm.
55
+ unfold embed; simpl; rewrite natplusr0. apply idpath.
80
56
Qed .
81
57
82
- Lemma natnmto0 (n m : nat) : n + m = 0 → n = 0.
58
+ Lemma embedsxy (x y : nat) : (embed (x,, S y) = S (embed (S x,, y))).
83
59
Proof .
84
- intros eq.
85
- induction n.
86
- - apply idpath.
87
- - apply fromempty.
88
- exact (negpathssx0 _ eq).
89
- Qed .
90
-
91
- Lemma embed0 (n : nat × nat) : (embed n) = 0 → n = (0,, 0).
92
- Proof .
93
- induction n as [[|?] [|?]].
94
- - intros. apply idpath.
95
- - unfold embed. simpl. intros. apply fromempty. exact (negpathssx0 _ X).
96
- - unfold embed. simpl. intros. apply fromempty. exact (negpathssx0 _ X).
97
- - unfold embed. simpl. intros. apply fromempty. exact (negpathssx0 _ X).
98
- Defined .
99
-
100
- Lemma embedinv (n : nat) : (embed (unembed n)) = n.
101
- Proof .
102
- assert (eq : ∏ (m : nat × nat), unembed n = m → n = embed m).
103
- - admit.
104
- - rewrite <- (eq (unembed n)); apply idpath; apply idpath.
105
- Admitted .
106
-
107
- Lemma unembedinv (n : nat × nat) : (unembed (embed n)) = n.
108
- Proof .
109
- (* TODO *)
110
- Admitted .
111
-
60
+ unfold embed; simpl.
61
+ rewrite natplusnsm, (natplusnsm y x); simpl.
62
+ rewrite natplusnsm. apply idpath.
63
+ Qed .
112
64
65
+ Lemma unembedinv (mn : nat × nat) : (unembed (embed mn)) = mn.
66
+ Proof .
67
+ assert (∏ (n : nat), embed mn = n → unembed n = mn).
68
+ - intro n. revert mn. induction n as [|n IH].
69
+ + intros [[|?][|?]]; intro H; inversion H; apply idpath.
70
+ + intros [x [|y]]; simpl.
71
+ * case x as [| x]; simpl; intro H.
72
+ inversion H.
73
+ rewrite (IH (0,, x)); [reflexivity |].
74
+ revert H. rewrite embed0x. intros H; apply invmaponpathsS. apply H. exact x.
75
+ * intro H. rewrite (IH (S x,, y)); [reflexivity| ].
76
+ apply invmaponpathsS. rewrite <- embedsxy. exact H.
77
+ - apply X. apply idpath.
78
+ Qed .
113
79
114
80
End EmbedNaturals.
115
81
0 commit comments