Section CANTOR_PAIRING.
Fixpoint sum_from_0_to (n : nat) {struct n} : nat :=
match n with
| O => 0
| S n' => n + sum_from_0_to n'
end.
Fixpoint cp (n : nat) {struct n} : nat * nat :=
match n with
| O => (O, O)
| S n' =>
match cp n' with
| (O, y) => (S y, O)
| (S x, y) => (x, S y)
end
end.
Definition cpInv (x : nat) (y : nat) : nat :=
sum_from_0_to (x + y) + y.
Proof with lia || eauto.
induction n as [ | n IH]; simpl...
destruct (cp n) as [x y] eqn: H_OBS. simpl in *. destruct x as [ | x']; subst n; cbn.
- repeat rewrite add_0_r...
- rewrite add_comm with (n := x'). simpl. rewrite add_comm with (m := x')...
Qed.
Proof with lia || eauto.
unfold cpInv. remember (x + y) as z eqn: z_eq. revert y x z_eq. induction z as [ | z IH].
- simpl; ii. destruct x as [ | x'], y as [ | y']...
- induction y as [ | y IHy]; ii.
+ rewrite z_eq. rewrite add_0_r with (n := x). rewrite add_0_r with (n := x) in z_eq. subst x.
rewrite add_0_r with (n := sum_from_0_to (S z)). simpl. rewrite <- add_comm. erewrite -> IH with (x := 0)...
+ assert (claim1 : z = x + y) by lia. subst z. clear z_eq. rename x into n, y into m. rewrite add_comm with (m := S m).
assert (claim2 : S (n + m) = (S n) + m) by lia. apply IHy in claim2.
simpl in *. rewrite add_comm. simpl. destruct (cp (n + m + sum_from_0_to (n + m) + m)) as [x y] eqn: H_OBS.
destruct x as [ | x']; inv claim2...
Qed.
End CANTOR_PAIRING.
Proof with try (lia || now (firstorder; eauto)).
assert (claim1 : a = b * (a / b) + (a mod b)) by now eapply (Nat.div_mod a b); lia.
assert (claim2 : 0 <= a mod b /\ a mod b < b) by now eapply (Nat.mod_bound_pos a b); lia.
assert (claim3 : ~ q > a / b).
{ intros H_false. pose proof (proj1 (greater_than_iff q (a / b)) H_false) as [z q_eq].
enough (so_we_obatain: b * q + r >= b * S (a / b) + r)...
}
assert (claim4 : ~ q < a / b).
{ intros H_false. pose proof (proj1 (greater_than_iff (a / b) q) H_false) as [z a_div_b_eq].
enough (so_we_obtain: b * q + a mod b >= b * S (a / b) + a mod b)...
}
enough (therefore : q = a / b)...
Qed.
Proof with lia || eauto.
pose proof (lemma1 := @Nat.div_mod). pose proof (lemma2 := @greater_than_iff). split.
- intros [H_a H_r_bound].
assert (claim1 : a = b * (a / b) + (a mod b))...
assert (claim2 : 0 <= a mod b /\ a mod b < b).
{ eapply (Nat.mod_bound_pos a b)... }
assert (claim3 : a >= r)...
enough (claim4 : ~ q > a / b). enough (claim5: ~ q < a / b). enough (claim6: q = a / b)...
+ split... replace (a - r) with (q * b)... symmetry; eapply Nat.div_mul...
+ intros H_false. pose proof (proj1 (lemma2 (a / b) q) H_false) as [x Hx]...
+ intros H_false. pose proof (proj1 (lemma2 q (a / b)) H_false) as [x Hx]...
- intros [H_q [H_r H_a_ge_r]].
pose proof (claim1 := Nat.mod_bound_pos a b). split...
assert (claim2 : r < b)... assert (claim3 := Nat.div_mod a b b_ne_0).
rewrite <- H_r in claim3. enough (claim4: q = a / b)...
rewrite H_q; symmetry. eapply Nat.div_unique with (r := 0)...
Qed.

Theorem sqrt2irrat (p : nat) (q : nat)
: (p = 0 /\ q = 0) <-> (p * p = 2 * q * q).