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.
Proof with try lia.
assert (forall P : nat -> Prop,
(forall n : nat, (forall m : nat, m < n -> P m) -> P n) ->
forall n, P n
) as STRONG_INDUCTION.
{ intros P IH_claim n. eapply IH_claim with (n := n).
induction n as [ | n IH]; simpl...
intros m m_lt_S_n. eapply IH_claim with (n := m).
intros i i_lt_S_m. eapply IH with (m := i)...
}
split; [lia | revert p q].
assert (lemma1 : forall n : nat, n mod 2 = 1 <-> (exists k : nat, n = 2 * k + 1)).
{ intros n. split.
- pose proof (Nat.div_mod n 2) as H1. intros H2.
rewrite H2 in H1. exists (n / 2)...
- intros [k ->]. eapply div_mod_uniqueness with (q := k)...
}
assert (lemma2 : forall n : nat, n mod 2 = 0 <-> (exists k : nat, n = 2 * k)).
{ intros n. split.
- pose proof (Nat.div_mod n 2) as H1. intros H2.
rewrite H2, Nat.add_0_r in H1. exists (n / 2)...
- intros [k ->]. eapply div_mod_uniqueness with (q := k)...
}
assert (lemma3 : forall n : nat, n mod 2 = 0 \/ n mod 2 = 1).
{ intros n. pose proof (Nat.mod_bound_pos n 2) as H1... }
assert (lemma4 : 0 <> 1)...
assert (claim1 : forall p : nat, forall q : nat, p * p = 2 * q * q -> p mod 2 = 0).
{ intros p q pp_eq_2qq.
enough (to_show: p mod 2 <> 1) by now pose proof (lemma3 p) as H2; lia...
intros H_contradiction. pose proof (proj1 (lemma1 p) H_contradiction) as [k H2]...
}
- intros p q pp_eq_2qq. enough (p_eq_0: p = 0)... revert p q pp_eq_2qq.
induction p as [p IH] using @STRONG_INDUCTION. unnw. ii.
pose proof (proj1 (lemma2 p) (claim1 p q pp_eq_2qq)) as [p' p_eq_2p'].
assert (p <= 0 \/ p > 0) as [p_le_0 | p_gt_0]...
assert (p_gt_p' : p' < p)...
assert (H1 : q * q = 2 * p' * p')...
pose proof (proj1 (lemma2 q) (claim1 q p' H1)) as [q' p_eq_2q'].
assert (H2 : p' * p' = 2 * q' * q')...
assert (therefore: p' = 0) by exact (IH p' p_gt_p' q' H2)...
Qed.
Proof with lia || eauto.
revert a b q b_ne_0 a_b_q_r. induction r as [r IH] using lt_wf_ind.
i. assert (r < b \/ r >= b) as [r_lt_b | r_ge_b] by lia.
- pose proof (div_mod_inv a b q r b_ne_0) as [H1 H2].
pose proof (H1 (conj a_b_q_r r_lt_b)) as [H3 [H4 H5]].
clear H1 H2. rename H3 into H1, H4 into H2, H5 into H3.
rewrite <- H2. clear IH a q a_b_q_r H1 H2 H3.
pose proof (div_mod_inv r b 0 r b_ne_0) as [? ?]...
- pose proof (Nat.mod_bound_pos r b) as H0.
assert (H1 : r - b < r)... clear H0.
pose proof (IH (r - b) H1 a b (q + 1) b_ne_0) as IH'.
assert (H2 : a = b * (q + 1) + (r - b))...
pose proof (IH' H2) as H3. rewrite H3.
remember (r - b) as r' eqn: H_r'.
assert (H_r: r = r' + b)... subst r.
rename r' into r; clear H_r' IH'.
symmetry. eapply IH with (q := 1)...
Qed.
Proof with lia || eauto.
revert b b_ne_0. induction n as [n IH] using lt_wf_ind.
i. assert (n <= b \/ n > b) as [H_le | H_gt] by lia.
- pose proof (Nat.div_mod n b b_ne_0) as H. rewrite H at 2...
- transitivity ((n mod b) + b)... enough (n mod b <= n - b)...
erewrite mod_congruence_r with (q := 1) (r := n - b)... eapply IH...
Qed.

Lemma mod_eq_elim (a1 : nat) (a2 : nat) (b : nat)
(b_ne_0 : b <> 0)
(H_mod_eq : a1 mod b = a2 mod b)
: exists q1, exists q2, a1 + b * q1 = a2 + b * q2.