@@ -40,76 +40,42 @@ Section EmbedNaturals.
4040
4141 (*Proofs that embed and unembed are inverses of each other. *)
4242
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.
4944 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.
5351 Qed .
5452
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))).
5754 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.
8056 Qed .
8157
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))).
8359 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 .
11264
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 .
11379
11480End EmbedNaturals.
11581
0 commit comments