import data.real.irrational
import topology.basic
import algebra.order.floor

--OUTPUT 1
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_irrational_orbit (α : ℝ) (h1 : ¬(∃ a : ℚ, α = a)) :
let seq_limit : (ℕ → ℝ) → ℝ → Prop :=  λ (u : ℕ → ℝ) (l : ℝ), ∀ ε > 0, ∃ N, ∀ n > N, |u n - l| < ε in
let S := λ i : ℤ, (i * α) % 1 in
(∀ y : ℝ, y ∈ set.range S) →
(∃ x : ℝ, seq_limit S x) →
∀ y : ℝ, y ∈ set.range S → seq_limit S y :=
begin
  assume (h2 : ∀ y : ℝ, y ∈ set.range S) (h3 : ∃ x : ℝ, seq_limit S x) (y : ℝ) (h4 : y ∈ set.range S),

  --By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$. One can thus find pairs of elements of $S$ that are arbitrarily close. Since (the absolute value of) the difference of any two elements of $S$ is also an element of $S$, it follows that $0$ is a limit point of $S$.
  have h5 : ∃ x : ℝ, seq_limit S x, from h3,
  have h6 : ∀ ε > 0, ∃ N : ℕ, ∀ n > N, |(n * α) % 1 - 0| < ε, from by auto [mul_zero],
  have h7 : ∀ ε > 0, ∃ N : ℕ, ∀ n > N, |((n * α) % 1 - (n * α) % 1)| < ε, from by auto [sub_self],
  have h8 : ∀ ε > 0, ∃ N : ℕ, ∀ n > N, |((n * α) % 1 - 0)| < ε, from by auto [h6, h7] using [sub_self],
  have h9 : ∃ x : ℝ, seq_limit S x, from by auto [h8],

  --To show that $S$ is dense in $[0, 1]$, consider $y \in[0,1]$, and $\epsilon>0$. Then by selecting $x \in S$ such that $\{x\}<\epsilon$ (which exists as $0$ is a limit point), and $N$ such that $N \cdot\{x\} \leq y<(N+1) \cdot\{x\}$, we get: $|y-\{N x\}|<\epsilon$.
  have h10 : ∀ (y : ℝ), y ∈ set.range S → seq_limit S y, from by auto [h9, h2],
  show seq_limit S y, from by auto [h10, h4],
end

--OUTPUT 2
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_of_irrational_orbit (α : ℝ) [irrational α] : (∀ n : ℤ, ∃ m : ℤ, n < m ∧ (↑m : ℝ) * α - n * α < 1) :=
begin
  --Let $\alpha$ be an irrational number.
  assume (α : ℝ) (h1 : irrational α),

  --Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$.
  have h2 : ∀ i j : ℤ, i ≠ j → (↑i : ℝ) * α - (↑i : ℤ) ≠ (↑j : ℝ) * α - (↑j : ℤ), from by auto [irrational, sub_eq_iff_eq_add, sub_eq_iff_eq_add, not_lt, not_lt, mul_self_ne_zero],

  --If this were not true, then
  --$$i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor,$$
  --which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$.
  have h3 : ∀ i j : ℤ, i ≠ j → (↑i : ℝ) * α = (↑j : ℝ) * α → (↑i : ℝ) * α - (↑i : ℤ) = (↑j : ℝ) * α - (↑j : ℤ) → α = (↑i : ℝ) * α - (↑i : ℤ) → α = (↑j : ℝ) * α - (↑j : ℤ) → α ∈ ℚ, from by auto [sub_eq_iff_eq_add, sub_eq_iff_eq_add, add_sub_cancel, add_sub_cancel, mul_self_eq_one, eq_comm, mul_eq_of_rat],

  --Hence,
  --$$S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}$$
  --is an infinite subset of $\left[0,1\right]$.
  have h4 : ∀ i : ℤ, (↑i : ℝ) * α - (↑i : ℤ) ∈ [0, 1], from by auto [sub_nonneg, sub_le_iff_le_add],
  have h5 : ∀ i : ℤ, ∃ m : ℤ, i < m ∧ (↑m : ℝ) * α - i * α < 1, from by auto [sub_lt_iff_lt_add, sub_lt_iff_lt_add, lt_add_one],

  --By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$. One can thus find pairs of elements of $S$ that are arbitrarily close. Since (the absolute value of) the difference of any two elements of $S$ is also an element of $S$, it follows that $0$ is a limit point of $S$.
  have h6 : ∀ y : ℝ, y ∈ [0, 1] → ∃ x : ℝ, x ∈ set.range (λ (i : ℤ), (↑i : ℝ) * α - (↑i : ℤ)) ∧ (∀ ε > (0 : ℝ), ∃ N : ℤ, ∀ n > N, |x - (↑n : ℝ) * α + (↑n : ℤ)| < ε), from by auto [sub_nonneg, sub_le_iff_le_add],

  --To show that $S$ is dense in $[0, 1]$, consider $y \in[0,1]$, and $\epsilon>0$.
  have h7 : ∀ (y : ℝ) (ε : ℝ), y ∈ [0, 1] → ε > 0 → ∃ N : ℤ, ∀ n > N, |y - (↑n : ℝ) * α + (↑n : ℤ)| < ε, from by auto [sub_lt_iff_lt_add, sub_lt_iff_lt_add, lt_add_one],

  --Then by selecting $x \in S$ such that $\{x\}<\epsilon$ (which exists as $0$ is a limit point), and $N$ such that $N \cdot\{x\} \leq y<(N+1) \cdot\{x\}$, we get: $|y-\{N x\}|<\epsilon$.
  have h8 : ∀ (y : ℝ) (ε : ℝ), y ∈ [0, 1] → ε > 0 → ∃ N : ℤ, ∀ n > N, |y - (↑n : ℝ) * α + (↑n : ℤ)| < ε, from by auto [sub_lt_iff_lt_add, sub_lt_iff_lt_add, lt_add_one],

  --QED
  show ∀ n : ℤ, ∃ m : ℤ, n < m ∧ (↑m : ℝ) * α - n * α < 1, from by auto [h5] using [h2, h3, h4, h5, h6, h7, h8],
end

--OUTPUT 3
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_irrational (α : ℝ) : (irrational α) → ∀ ε > 0, ∃ N : ℤ, ∀ i > N, |(i : ℤ) • α - (i : ℤ) • α - (i : ℤ)| < ε :=
begin
  assume h1 ε h2,

  --Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$. If this were not true, then
  have h3 : ∀ i j : ℤ, i ≠ j → (i : ℤ) • α - ((i : ℤ) • α).floor ≠ ((j : ℤ) • α - ((j : ℤ) • α).floor),
  from by auto [irrational, h1, sub_floor_eq_sub_sub_floor, sub_sub_sub_cancel, sub_sub_sub_of_sub_sub, sub_sub_sub_of_sub_sub, sub_sub_sub_of_sub_sub, sub_sub_sub_of_sub_sub],

  --$i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor$, which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$.
  have h4 : ∀ i j : ℤ, i ≠ j → (i : ℤ) • α - ((i : ℤ) • α).floor = ((j : ℤ) • α - ((j : ℤ) • α).floor) → α ∈ ℚ,
  from by auto [irrational, h1, sub_floor_eq_sub_sub_floor, sub_sub_sub_cancel, sub_sub_sub_of_sub_sub, sub_sub_sub_of_sub_sub, sub_sub_sub_of_sub_sub, sub_sub_sub_of_sub_sub],

  --Hence, $S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}$ is an infinite subset of $\left[0,1\right]$.
  have h5 : (∃ n : ℤ, n • α - n • α - n ≠ 0) ∧ (∀ n : ℤ, n • α - n • α - n = 0 → n = 0),
  from by auto [irrational, h1, sub_floor_eq_sub_sub_floor, sub_sub_sub_cancel, sub_sub_sub_of_sub_sub, sub_sub_sub_of_sub_sub, sub_sub_sub_of_sub_sub, sub_sub_sub_of_sub_sub],
  have h6 : ∀ n : ℤ, n • α - n • α - n ≠ 0, from by auto [h5],
  have h7 : ∀ n : ℤ, n • α - n • α - n = 0 → n = 0, from by auto [h5],
  have h8 : ∃ n : ℤ, n • α - n • α - n ≠ 0, from by auto [h5],

  --By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$.
  have h9 : ∃ x : ℝ, x ∈ set.Ico 0 1 ∧ ∀ ε > 0, ∃ N : ℤ, ∀ i > N, |(i : ℤ) • α - (i : ℤ) • α - (i : ℤ) - x| < ε,
  from by auto [irrational, h1, sub_floor_eq_sub_sub_floor, sub_sub_sub_cancel, sub_sub_sub_of_sub_sub, sub_sub_sub_of_sub_sub, sub_sub_sub_of_sub_sub, sub_sub_sub_of_sub_sub],

  --One can thus find pairs of elements of $S$ that are arbitrarily close.
  have h10 : ∀ ε > 0, ∃ N : ℤ, ∀ i > N, |(i : ℤ) • α - (i : ℤ) • α - (i : ℤ) - x| < ε, from by auto [h9],

  --Since (the absolute value of) the difference of any two elements of $S$ is also an element of $S$, it follows that $0$ is a limit point of $S$.
  have h11 : ∀ ε > 0, ∃ N : ℤ, ∀ i > N, |(i : ℤ) • α - (i : ℤ) • α - (i : ℤ) - 0| < ε, from by auto [h10],

  --To show that $S$ is dense in $[0, 1]$, consider $y \in[0,1]$, and $\epsilon>0$.
  have h12 : ∀ y : ℝ, y ∈ set.Ico 0 1 → ∀ ε > 0, ∃ N : ℤ, ∀ i > N, |(i : ℤ) • α - (i : ℤ) • α - (i : ℤ) - y| < ε,
  from by auto [irrational, h1, sub_floor_eq_sub_sub_floor, sub_sub_sub_cancel, sub_sub_sub_of_sub_sub, sub_sub_sub_of_sub_sub, sub_sub_sub_of_sub_sub, sub_sub_sub_of_sub_sub],

  --Then by selecting $x \in S$ such that $\{x\}<\epsilon$ (which exists as $0$ is a limit point), and $N$ such that $N \cdot\{x\} \leq y<(N+1) \cdot\{x\}$, we get: $|y-\{N x\}|<\epsilon$.
  have h13 : ∀ y : ℝ, y ∈ set.Ico 0 1 → ∃ x : ℝ, x ∈ set.Ico 0 1 ∧ ∃ N : ℤ, x < ε ∧ N • x ≤ y ∧ y < (N + 1) • x,
  from by auto [irrational, h1, sub_floor_eq_sub_sub_floor, sub_sub_sub_cancel, sub_sub_sub_of_sub_sub, sub_sub_sub_of_sub_sub, sub_sub_sub_of_sub_sub, sub_sub_sub_of_sub_sub],

  --$\exists x \in S: \{x\}<\epsilon$
  have h14 : ∃ x : ℝ, x ∈ set.Ico 0 1 ∧ ∃ N : ℤ, x < ε ∧ N • x ≤ y ∧ y < (N + 1) • x, from by auto [h12, h2],
  cases h14 with x h14,
  cases h14 with h15 h16,
  cases h16 with N h16,
  cases h16 with h17 h18,

  --$N \cdot\{x\} \leq y<(N+1) \cdot\{x\}$
  have h19 : N • x ≤ y ∧ y < (N + 1) • x, from by auto [h16, h18].1,

  --$|y-\{N x\}|<\epsilon$
  have h20 : |y - (N • x - N • x - N)| < ε, from by auto [h14, h16, h18, h19],

  --$\{N x\}$ is in $S$
  have h21 : ∃ n : ℤ, n • α - n • α - n ≠ 0, from by auto [h8],
  have h22 : ∀ n : ℤ, n • α - n • α - n
end --Needs more than 2000 tokens!

--OUTPUT 4
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_of_irrational_orbit (a : ℝ) (ha : a ∉ ℚ) : ∀ ε : ℝ, ε > 0 → ∃ N : ℤ, ∃ x : ℝ, x ∈ set.Ico 0 1 ∧ |N * a - x| < ε :=
begin
  assume ε hε,
  have h1 : ∀ (i j : ℤ), i ≠ j → ((i * a) % 1) ≠ ((j * a) % 1),
  from by auto [floor_add, floor_mul, rat.cast_ne_zero, ha, floor_eq_iff] using [linarith],

  have h2 : ∀ i : ℤ, (i * a) % 1 ∈ set.Ico 0 1, from by auto [floor_add, floor_mul, rat.cast_ne_zero, floor_eq_iff, floor_le_iff, floor_lt_iff, mod_def] using [linarith],

  have h3 : ∃ r : ℝ, r ∈ set.Ico 0 1 ∧ r ∈ {(i * a) % 1 | i : ℤ}, from by auto [h2] using [exists_intro],

  cases h3 with r hr,
  cases hr with hr1 hr2,
  have h4 : ∀ i : ℤ, ∃ j : ℤ, i ≠ j ∧ ((i * a) % 1) = ((j * a) % 1), from by auto [hr2, exists_intro],

  have h5 : ∀ i : ℤ, ∃ j : ℤ, i ≠ j ∧ ((i * a) % 1) ≠ ((j * a) % 1), from by auto [h1, h4],

  have h6 : ∃ infinite_set : set ℤ, ∀ i : ℤ, ∃ j : ℤ, i ≠ j ∧ ((i * a) % 1) ≠ ((j * a) % 1), from by auto [exists_intro] using [h5],

  --By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$.
  --One can thus find pairs of elements of $S$ that are arbitrarily close.
  --Since (the absolute value of) the difference of any two elements of $S$ is also an element of $S$, it follows that $0$ is a limit point of $S$.
  have h7 : ∃ r : ℝ, ∃ infinite_set : set ℤ, r ∈ set.Ico 0 1 ∧ r ∈ infinite_set ∧
  (∀ i : ℤ, ∃ j : ℤ, i ≠ j ∧ ((i * a) % 1) ≠ ((j * a) % 1)) ∧
  ∀ ε : ℝ, ε > 0 → ∃ N : ℤ, ∃ x : ℝ, x ∈ infinite_set ∧ |r - x| < ε,
  from by auto [exists_intro] using [h3, h6],

  cases h7 with r hr,
  cases hr with infinite_set hr,
  cases hr with hr1 hr2,
  cases hr2 with h8 hr3,
  cases hr3 with h9 hr4,
  cases hr4 with h10 hr5,

  --To show that $S$ is dense in $[0, 1]$, consider $y \in[0,1]$, and $\epsilon>0$.
  --Then by selecting $x \in S$ such that $\{x\}<\epsilon$ (which exists as $0$ is a limit point), and $N$ such that $N \cdot\{x\} \leq y<(N+1) \cdot\{x\}$, we get: $|y-\{N x\}|<\epsilon$.
  have h11 : ∀ ε : ℝ, ε > 0 → ∃ N : ℤ, ∃ x : ℝ, x ∈ infinite_set ∧ x ∈ set.Ico 0 1 ∧ |r - x| < ε,
  from by auto [h9] using [h10],

  have h12 : ∀ y : ℝ, y ∈ set.Ico 0 1 → ∃ N : ℤ, ∃ x : ℝ, x ∈ infinite_set ∧ x ∈ set.Ico 0 1 ∧ |y - x| < ε,
  from by auto [h11],

  have h13 : ∃ N : ℤ, ∃ x : ℝ, x ∈ infinite_set ∧ x ∈ set.Ico 0 1 ∧ |r - x| < ε,
  from by auto [h12, hr1],

  cases h13 with N h13,
  cases h13 with x h13,
  cases h13 with h13 h14,
  cases h14 with h14 h15,

  have h16 : ∃ N : ℤ, ∃ x : ℝ, x ∈ set.Ico 0 1 ∧ |N * a - x| < ε,
  from by auto [h13, h2],

  show ∃ N : ℤ, ∃ x : ℝ, x ∈ set.Ico 0 1 ∧ |N * a - x| < ε,
  from by auto [h16],

end

--OUTPUT 5
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_of_irrational_orbit (α : ℝ) (h : α ≠ 0) : ∀ x ∈ {i | i ∈ ℤ} → {i // i ∈ ℤ}, ∃ N ∈ ℕ, |x - N * α| < (1 : ℝ) :=
begin
  assume (x : ℤ) (hx : x ∈ {i | i ∈ ℤ} → {i // i ∈ ℤ}),
  show ∃ (N : ℕ), N ∈ ℕ ∧ x - N * α < 1 ∧ -x + N * α < 1,
  from by auto [rat_of_int_nonneg, rat_of_int_pos, lt_sub_left_iff_add_lt, mul_lt_one_iff, one_lt_mul_iff, sub_lt_iff_lt_add, lt_sub_iff_add_lt, nat.cast_lt, nat.cast_le, nat.cast_ne_zero, nat.cast_pos, ne.symm, ne.def, ne_of_lt, int.cast_lt, int.cast_ne_zero, int.cast_pos, int.cast_le, int.coe_nat_lt, int.coe_nat_le, int.coe_nat_ne_zero, int.coe_nat_pos, int.coe_nat_zero, int.coe_nat_one, int.coe_nat_bit0, int.coe_nat_bit1, int.coe_nat_succ, int.coe_nat_add, int.coe_nat_mul, int.coe_nat_sub, int.coe_nat_div, int.coe_nat_mod, nat.succ_le_iff, nat.le_succ_iff, nat.succ_lt_iff, nat.lt_succ_iff, nat.succ_pos, nat.zero_lt_iff_pos, nat.pos_iff_ne_zero, nat.pos_iff_ne_zero_and_ne_one, nat.zero_lt_one, nat.lt_add_iff_pos_right, nat.lt_add_iff_pos_left, nat.add_lt_iff_pos_right, nat.add_lt_iff_pos_left, nat.lt_mul_iff_pos_right, nat.lt_mul_iff_pos_left, nat.mul_lt_mul, nat.mul_lt_mul_of_pos_left, nat.mul_lt_mul_of_pos_right, nat.mul_lt_mul_of_pos_of_pos, int.le_add_iff_nonneg_right, int.le_add_iff_nonneg_left, int.add_le_iff_nonneg_right, int.add_le_iff_nonneg_left, int.lt_add_iff_pos_right, int.lt_add_iff_pos_left, int.add_lt_iff_pos_right, int.add_lt_iff_pos_left, int.lt_mul_iff_pos_right, int.lt_mul_iff_pos_left, int.mul_lt_mul, int.mul_lt_mul_of_pos_left, int.mul_lt_mul_of_pos_right, int.mul_lt_mul_of_pos_of_pos, int.neg_mul_eq_neg_mul_symm, neg_mul_eq_neg_mul_symm, int.neg_mul_eq_mul_neg, int.mul_neg_eq_neg_mul, int.neg_mul_eq_neg_mul, int.neg_mul_eq_mul_neg, int.mul_neg_eq_neg_mul, int.left_distrib, int.right_distrib, int.left_distrib, int.right_distrib, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs, int.right_abs, int.left_abs,
end --Needs more than 2000 tokens!

--OUTPUT 6
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_irrational_orbit (α : ℝ) : irrational α → ∃ (S : set ℝ), dense_subset S ∧ ∀ s ∈ S, ∃ n : ℤ, (s = (n : ℝ) * α % 1) :=
begin
  assume h1 : irrational α,
  use {s : ℝ | ∃ n : ℤ, s = (n : ℝ) * α % 1},
  have h2 : ∀ i j : ℤ, i ≠ j → (i : ℝ) * α % 1 ≠ (j : ℝ) * α % 1, from by auto [h1, irrational_iff_not_rat],

  have h3 : ∀ s : ℝ, ∃ n : ℤ, (s = (n : ℝ) * α % 1) → ∃ (N : ℤ), ∀ n : ℤ, n > N → (n : ℝ) * α % 1 ≠ s, from by auto [not_lt],

  have h4 : ∀ s : ℝ, ∃ (N : ℤ), ∀ n : ℤ, n > N → (n : ℝ) * α % 1 ≠ s, from by auto [h3],

  have h5 : ∀ s : ℝ, ∃ (N : ℤ), ∀ n : ℤ, n > N → (n : ℝ) * α % 1 ≠ s → s ∈ {s : ℝ | ∃ n : ℤ, s = (n : ℝ) * α % 1}, from by auto [],

  have h6 : {s : ℝ | ∃ n : ℤ, s = (n : ℝ) * α % 1} = {s : ℝ | ∃ (N : ℤ), ∀ n : ℤ, n > N → (n : ℝ) * α % 1 ≠ s}, from by auto [set.ext],

  have h7 : ∀ (a : ℝ) (ε : ℝ), ε > 0 → ∃ b : ℝ, b ≠ a ∧ b ∈ {s : ℝ | ∃ n : ℤ, s = (n : ℝ) * α % 1} ∧ abs (b - a) < ε, from by auto [h2, h3, h4, h5, h6, exists_lt_and_lt, exists_ne_and_lt, exists_ne_and_lt, exists_ne_and_lt, exists_ne_and_lt, lt_trans],

  have h8 : ∀ (a : ℝ) (ε : ℝ), ε > 0 → ∃ b : ℝ, b ≠ a ∧ b ∈ {s : ℝ | ∃ n : ℤ, s = (n : ℝ) * α % 1} ∧ abs (b - a) < ε → a ∈ closure {s : ℝ | ∃ n : ℤ, s = (n : ℝ) * α % 1}, from by auto [closure_iff_nhds_neq_bot],

  have h9 : ∀ (a : ℝ) (ε : ℝ), ε > 0 → a ∈ closure {s : ℝ | ∃ n : ℤ, s = (n : ℝ) * α % 1}, from by auto [h7, h8],

  have h10 : ∀ (a : ℝ) (ε : ℝ), ε > 0 → a ∈ closure {s : ℝ | ∃ n : ℤ, s = (n : ℝ) * α % 1} → ∃ b : ℝ, b ≠ a ∧ b ∈ {s : ℝ | ∃ n : ℤ, s = (n : ℝ) * α % 1} ∧ abs (b - a) < ε, from by auto [closure_iff_nhds_neq_bot],

  have h11 : ∀ (a : ℝ) (ε : ℝ), ε > 0 → ∃ b : ℝ, b ≠ a ∧ b ∈ {s : ℝ | ∃ n : ℤ, s = (n : ℝ) * α % 1} ∧ abs (b - a) < ε, from by auto [h9, h10],

  have h12 : ∀ (a : ℝ) (ε : ℝ), ε > 0 → ∃ b : ℝ, b ≠ a ∧ b ∈ {s : ℝ | ∃ n : ℤ, s = (n : ℝ) * α % 1} ∧ abs (b - a) < ε → ∃ (N : ℤ), ∀ n : ℤ, n > N → (n : ℝ) * α % 1 ≠ a, from by auto [h5, h6, h11],

  have h13 : ∀ (a : ℝ) (ε : ℝ), ε > 0 → ∃ (N : ℤ), ∀ n : ℤ, n > N → (n : ℝ) * α % 1 ≠ a, from by auto [h11, h12],

  have h14 : ∀ s : ℝ, ∃ (N : ℤ), ∀ n : ℤ, n > N → (n : ℝ) * α % 1 ≠ s → s ∈ {s : ℝ | ∃ n : ℤ, s = (n : ℝ) * α % 1}, from by auto [],

  have h15 : {s : ℝ | ∃ n : ℤ, s = (n : ℝ) * α % 1} = {s : ℝ | ∃ (N : ℤ), ∀ n : ℤ, n > N → (n : ℝ) * α % 1 ≠ s}, from by auto [set.ext],

  have h16 : ∀ (a : ℝ) (ε : ℝ), ε > 0 → ∃ b : ℝ, b ≠ a ∧ b ∈ {s : ℝ | ∃ n : ℤ, s = (n : ℝ) * α % 1} ∧ abs (b - a) < ε, from by auto [h2, h3, h4, h5, h6, exists_lt_and_lt, exists_ne_and_lt, exists_ne_and_lt, exists_ne_and_lt, exists_ne_and_lt, lt_trans],

  have h17 : ∀ (a : ℝ) (ε : ℝ), ε > 0 → ∃ b : ℝ, b ≠ a ∧ b ∈ {s : ℝ | ∃ n : ℤ, s = (n : ℝ) * α % 1} ∧ abs (b - a) < ε → a ∈ closure {s : ℝ | ∃ n : ℤ, s = (n : ℝ) * α % 1}, from by auto [closure_iff_nhds_neq_bot],

  have h18 : ∀ (a : ℝ) (ε : ℝ), ε > 0 → a ∈ closure {s : ℝ | ∃ n : ℤ, s = (n : ℝ) * α % 1}, from by auto [h16, h17],

  have h19 : ∀ (a : ℝ) (ε : ℝ), ε > 0 → a ∈ closure {s : ℝ | ∃ n : ℤ, s = (n : ℝ) * α % 1} → ∃ b : ℝ, b ≠ a ∧ b ∈ {s : ℝ | ∃ n : ℤ, s = (n : ℝ) * α % 1} ∧ abs (b - a) < ε, from by auto [closure_iff_nhds_neq_bot],

  have h20 : ∀ (a : ℝ) (ε : ℝ), ε > 0 → ∃ b : ℝ, b ≠ a ∧ b ∈ {s : ℝ | ∃ n : ℤ, s = (n
end --Needs more than 2000 tokens!

--OUTPUT 7
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=dense_irrational_orbit (α : ℝ) (hα : ¬(∃ (q : ℚ), α = q)) : ∀ (ε : ℝ), ε > 0 → ∃ (x : ℤ), abs (x - α) < ε ∧ 0 < abs α :=
begin
  assume ε,
  assume hε : ε > 0,
  have h1 : ∀ (p q : ℤ), p ≠ q → abs (p - q) ≥ 1, from by auto [abs_of_nonneg],
  have h2 : ∀ (x : ℤ), ∃ (y : ℤ), abs (x - α) < 1 / abs α ∧ 0 < abs α, from by auto [hα, abs_pos_of_ne_zero, h1, abs_sub_lt_iff, abs_of_nonneg],
  cases h2 (floor α) with (y : ℤ) (h3 : abs (floor α - α) < 1 / abs α ∧ 0 < abs α),
  have h4 : floor α < y, from by auto [floor_lt, abs_lt_iff_lt_sub_left, h3.left, abs_of_nonneg, abs_pos_iff],
  have h5 : abs (y - α) < 1 / abs α, from by auto [abs_lt_iff_lt_sub_left, h3.left, abs_of_nonneg, abs_pos_iff],
  have h6 : y - α ≥ 0, from by auto [h5, abs_sub_lt_iff, abs_of_nonneg, abs_pos_iff],
  use y,
  have h7 : abs α ≠ 0, from by auto [h3.right, abs_pos_iff],
  have h8 : abs α > 0, from by auto [h3.right, abs_pos_iff],
  have h9 : abs α * ε > 0, from by auto [mul_pos, hε, h8],
  have h10 : abs α * ε > 0, from by auto [mul_pos, hε, h8],
  have h11 : 1 / abs α > 0, from by auto [h7, div_pos],
  have h12 : 1 / abs α < ε, from by auto [h10, h11, div_lt_iff'],
  have h13 : abs (y - α) < ε, from by auto [h5, h12],
  show abs (y - α) < ε ∧ 0 < abs α, from by auto [h3.right, h13],
end

--OUTPUT 8
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_irrational_orbit (α : ℝ) :
  ∀ ε > 0, ∃ N : ℕ, ∀ n > N, ∃ m : ℤ, (m : ℝ) * α - (m : ℝ) ≠ n * α - (n : ℝ) :=
begin
  --Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$.
  assume ε,
  assume h1 : ε > 0,
  let S : set ℝ := {(i:ℤ):ℝ | ∃ (m:ℤ), m * α - m = i * α - i},
  show ∃ (N : ℕ), ∀ (n : ℕ), n > N → ∃ (m : ℤ), m * α - m ≠ n * α - n, from
  begin
    --By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$.
    have h2 : ∃ (l : ℝ), l ∈ [0, 1] ∧ l = l, from by auto [bounded_real.real_complete],

    --One can thus find pairs of elements of $S$ that are arbitrarily close.
    have h3 : ∀ (ε : ℝ), ε > 0 → ∃ (a b : ℝ), a ≠ b ∧ a ∈ S ∧ b ∈ S ∧ (a - b) < ε, from by auto [calc_trans, exists_pair_of_limit_points],

    --Since (the absolute value of) the difference of any two elements of $S$ is also an element of $S$, it follows that $0$ is a limit point of $S$.
    have h4 : ∀ (ε : ℝ), ε > 0 → ∃ (a : ℝ), a ∈ S ∧ abs a < ε, from
    begin
      assume ε,
      assume h4 : ε > 0,
      cases h3 ε h4 with a h5,
      cases h5 with b h6,
      cases h6 with h7 h8,
      cases h8 with h9 h10,
      cases h10 with h11 h12,

      --$|y-\{N x\}|<\epsilon$.
      show ∃ (a : ℝ), a ∈ S ∧ abs a < ε, from
      begin
        have h13 : a - b ≠ 0, from by auto [h7],
        have h14 : (abs (a - b)) ∈ S, from by auto [set.mem_set_of_eq, h9, h11, h13],
        have h15 : (abs (a - b)) < ε, from by auto [h12],
        show ∃ (a : ℝ), a ∈ S ∧ abs a < ε, from by auto [h14, h15],
      end,
    end,

    --To show that $S$ is dense in $[0, 1]$, consider $y \in[0,1]$, and $\epsilon>0$. Then by selecting $x \in S$ such that $\{x\}<\epsilon$ (which exists as $0$ is a limit point), and $N$ such that $N \cdot\{x\} \leq y<(N+1) \cdot\{x\}$, we get: $|y-\{N x\}|<\epsilon$.
    have h5 : ∀ (y : ℝ), y ∈ [0, 1] → ∃ (N : ℕ), ∀ (n : ℕ), n > N → ∃ (m : ℤ), m * α - m ≠ n * α - n, from
    begin
      assume y,
      assume h5 : y ∈ [0, 1],
      show ∃ (N : ℕ), ∀ (n : ℕ), n > N → ∃ (m : ℤ), m * α - m ≠ n * α - n, from
      begin
        cases h4 ε h1 with x h6,
        cases h6 with h7 h8,
        cases h8 with h9 h10,
        cases h10 with h11 h12,

        have h13 : ∃ (N : ℕ), y < (N : ℝ) * x, from by auto [exists_lt_mul_self],
        cases h13 with N h14,
        cases h14 with h15 h16,

        have h17 : ∃ (N : ℕ), (N : ℝ) * x < y + 1, from by auto [exists_lt_mul_self],
        cases h17 with N h18,
        cases h18 with h19 h20,

        let N := max N N,
        use N,

        show ∀ (n : ℕ), n > N → ∃ (m : ℤ), m * α - m ≠ n * α - n, from
        begin
          assume n,
          assume h21 : n > N,
          --$N \cdot\{x\} \leq y<(N+1) \cdot\{x\}$, we get: $|y-\{N x\}|<\epsilon$.
          have h22 : (n : ℝ) * x < y + 1, from by auto [h20, h21, le_max_left],
          have h23 : y < (n : ℝ) * x, from by auto [h15, h21, le_max_right],

          have h24 : n * α - n ≠ x * α - x, from by auto [h7],
          show ∃ (m : ℤ), m * α - m ≠ n * α - n, from by auto [h24],
        end,
      end,
    end,

    show ∃ (N : ℕ), ∀ (n : ℕ), n > N → ∃ (m : ℤ), m * α - m ≠ n * α - n, from
    begin
      cases h2 with l h2,
      cases h2 with h2 h3,
      cases h5 l h2 with N h4,
      use N,
      show ∀ (n : ℕ), n > N → ∃ (m : ℤ), m * α - m ≠ n * α - n, from h4,
    end,
  end,
end

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  -- $A$ and $B$ are sets. $A$ and $B$ belong to power set of $S$
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  -- Then $A ⊆ S$ and $B ⊆ S$, by power set definition
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by auto [set.subset_of_mem_powerset, set.subset_of_mem_powerset],
  -- Then $(A ∩ B) ⊆ A$, by intersection of set is a subset
  have h2 : (A ∩ B) ⊆ A, from by auto [set.inter_subset_left],
  -- Then $(A ∩ B) ⊆ S$, by subset relation is transitive
  have h3 : (A ∩ B) ⊆ S, from by auto [set.subset.trans],
  -- Hence $(A ∩ B) ∈  𝒫 S$, by power set definition
  show (A ∩ B) ∈  𝒫 S, from by auto [set.mem_powerset],
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  -- expand the power
  calc (x + y)^2 = (x+y)*(x+y) : by auto [sq]
  -- distributive property of multiplication over addition gives:
  ... = x*(x+y) + y*(x+y) : by auto [add_mul]
  -- applying the above property further gives:
  ... = x*x + x*y + y*x + y*y : by auto [mul_comm, add_mul] using [ring]
  -- rearranging the terms using commutativity and adding gives:
  ... = x^2 + 2*x*y + y^2 : by auto [sq, mul_comm] using [ring]
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  -- Group has Latin Square Property
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from by auto using [use (a⁻¹ * b)],
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by auto using [use b * a⁻¹],

  -- Setting $b = a$, this becomes:
  have h3 : ∀ a : G, ∃! x : G, a * x = a, from by auto [h1],
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from by auto [h2],

  -- These $x$ and $y$ are both $(1 : G)$, by definition of identity element
  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from by auto [exists_unique.unique, h3, classical.some_spec, exists_unique.exists, mul_one],
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from by auto [exists_unique.unique, h4, classical.some_spec, exists_unique.exists, one_mul],

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by auto [h3, h4, exists_unique.unique, classical.some_spec, exists_unique.exists] using [use (1 : G)],
end

/--`theorem`
Squeeze Theorem for Real Numbers
Let $\sequence {x_n}$, $\sequence {y_n}$ and $\sequence {z_n}$ be sequences in $\R$.

Let $\sequence {y_n}$ and $\sequence {z_n}$ both be convergent to the following limit:
:$\ds \lim_{n \mathop \to \infty} y_n = l, \lim_{n \mathop \to \infty} z_n = l$

Suppose that:
:$\forall n \in \N: y_n \le x_n \le z_n$

Then:
:$x_n \to l$ as $n \to \infty$
that is:
:$\ds \lim_{n \mathop \to \infty} x_n = l$

`proof`
From Negative of Absolute Value:
:$\size {x - l} < \epsilon \iff l - \epsilon < x < l + \epsilon$

Let $\epsilon > 0$.

We need to prove that:
:$\exists N: \forall n > N: \size {x_n - l} < \epsilon$

As $\ds \lim_{n \mathop \to \infty} y_n = l$ we know that:
:$\exists N_1: \forall n > N_1: \size {y_n - l} < \epsilon$

As $\ds \lim_{n \mathop \to \infty} z_n = l$ we know that:
:$\exists N_2: \forall n > N_2: \size {z_n - l} < \epsilon$

Let $N = \max \set {N_1, N_2}$.

Then if $n > N$, it follows that $n > N_1$ and $n > N_2$.

So:
:$\forall n > N: l - \epsilon < y_n < l + \epsilon$
:$\forall n > N: l - \epsilon < z_n < l + \epsilon$

But:
:$\forall n \in \N: y_n \le x_n \le z_n$

So:
:$\forall n > N: l - \epsilon < y_n \le x_n \le z_n < l + \epsilon$

and so:
:$\forall n > N: l - \epsilon < x_n < l + \epsilon$

So:
:$\forall n > N: \size {x_n - l} < \epsilon$

Hence the result.
{{qed}}

-/
theorem squeeze_theorem_real_numbers (x y z : ℕ → ℝ) (l : ℝ) :
let seq_limit : (ℕ → ℝ) → ℝ → Prop :=  λ (u : ℕ → ℝ) (l : ℝ), ∀ ε > 0, ∃ N, ∀ n > N, |u n - l| < ε in
 seq_limit y l → seq_limit z l →  (∀ n : ℕ, (y n) ≤ (x n) ∧ (x n) ≤ (z n)) → seq_limit x l :=
begin
  assume seq_limit (h2 : seq_limit y l) (h3 : seq_limit z l) (h4 : ∀ (n : ℕ), y n ≤ x n ∧ x n ≤ z n) (ε),

  --From Negative of Absolute Value: $\size {x - l} < \epsilon \iff l - \epsilon < x < l + \epsilon$
  have h5 : ∀ x, |x - l| < ε ↔ (((l - ε) < x) ∧ (x < (l + ε))),
  from by auto [abs_sub_lt_iff] using [linarith],

  --Let $\epsilon > 0$.
  assume (h7 : ε > 0),

  --As $\ds \lim_{n \mathop \to \infty} y_n = l$ we know that $\exists N_1: \forall n > N_1: \size {y_n - l} < \epsilon$
  cases h2 ε h7 with N1 h8,

  --As $\ds \lim_{n \mathop \to \infty} z_n = l$ we know that $\exists N_2: \forall n > N_2: \size {z_n - l} < \epsilon$
  cases h3 ε h7 with N2 h9,

  --Let $N = \max \set {N_1, N_2}$.
  let N := max N1 N2,
  use N,

  --Then if $n > N$, it follows that $n > N_1$ and $n > N_2$.
  have h10 : ∀ n > N, n > N1 ∧ n > N2 := by auto [lt_of_le_of_lt, le_max_left, le_max_right],

  --$\forall n > N: l - \epsilon < y_n < l + \epsilon$
  --$\forall n > N: l - \epsilon < z_n < l + \epsilon$
  --$\forall n \in \N: y_n \le x_n \le z_n$
  --So $\forall n > N: l - \epsilon < y_n \le x_n \le z_n < l + \epsilon$
  have h11 : ∀ n > N, (((l - ε) < (y n)) ∧ ((y n) ≤ (x n))) ∧ (((x n) ≤ (z n)) ∧ ((z n) < l+ε)),
  from by auto [h8, h10, h5, h9],

  --$\forall n > N: l - \epsilon < x_n < l + \epsilon$
  have h15 : ∀ n > N, ((l - ε) < (x n)) ∧ ((x n) < (l+ε)),
  from by auto [h11] using [linarith],

  --So $\forall n > N: \size {x_n - l} < \epsilon$
  --Hence the result
  show  ∀ (n : ℕ), n > N → |x n - l| < ε,
  from by auto [h5, h15],

end

/--`theorem`
Density of irrational orbit
The fractional parts of the integer multiples of an irrational number form a dense subset of the unit interval
`proof`
Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$. If this were not true, then
$$
i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor,
$$
which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$. Hence,
$$
S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}
$$
is an infinite subset of $\left[0,1\right]$.

By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$. One can thus find pairs of elements of $S$ that are arbitrarily close. Since (the absolute value of) the difference of any two elements of $S$ is also an element of $S$, it follows that $0$ is a limit point of $S$.

To show that $S$ is dense in $[0, 1]$, consider $y \in[0,1]$, and $\epsilon>0$. Then by selecting $x \in S$ such that $\{x\}<\epsilon$ (which exists as $0$ is a limit point), and $N$ such that $N \cdot\{x\} \leq y<(N+1) \cdot\{x\}$, we get: $|y-\{N x\}|<\epsilon$.

QED
-/
theorem
FEW SHOT PROMPTS TO CODEX(END)-/


import MyNat

open MyNat

example (P Q : Type) (p : P) (h : P -> Q) : Q := by
  exact h p

example : ℕ -> ℕ := by
  intro n
  exact 3 * n + 2

example (P Q R S T U: Type)
  (p : P)
  (h : P → Q)
  (i : Q → R)
  (j : Q → T)
  (k : S → T)
  (l : T → U)
  : U := by
  have q := h p
  have t := j q
  have u := l t
  exact u

example (P Q R S T U: Type)
  (p : P)
  (h : P → Q)
  (i : Q → R)
  (j : Q → T)
  (k : S → T)
  (l : T → U)
  : U := by
  apply l
  apply j
  apply h
  exact p

example (P Q : Type) : P → (Q → P) := by
  intro p _
  exact p

example (P Q R : Type) : (P → (Q → R)) → ((P → Q) → (P → R)) := by
  intro a b c
  have q := b c
  have r := a c q
  exact r

example (P Q F : Type) : (P → Q) → ((Q → F) → (P → F)) := by
  intro a b c
  apply b
  apply a
  exact c

example (P Q : Type) : (P → Q) → ((Q → empty) → (P → empty)) := by
  intro a b c
  apply b
  apply a
  exact c

example (A B C D E F G H I J K L : Type)
(f1 : A → B) (f2 : B → E) (f3 : E → D) (f4 : D → A) (f5 : E → F)
(f6 : F → C) (f7 : B → C) (f8 : F → G) (f9 : G → J) (f10 : I → J)
(f11 : J → I) (f12 : I → H) (f13 : E → H) (f14 : H → K) (f15 : I → L)
 : A → L := by
  intro a
  exact f15 (f11 (f9 (f8 (f5 (f2 (f1 a))))))


/-
Copyright (c) 2021 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen
-/
import number_theory.class_number.admissible_abs
import number_theory.class_number.finite
import number_theory.number_field

/-!
# Class numbers of number fields

This file defines the class number of a number field as the (finite) cardinality of
the class group of its ring of integers. It also proves some elementary results
on the class number.

## Main definitions
- `number_field.class_number`: the class number of a number field is the (finite)
cardinality of the class group of its ring of integers
-/

namespace number_field

variables (K : Type*) [field K] [number_field K]

namespace ring_of_integers

noncomputable instance : fintype (class_group (ring_of_integers K) K) :=
class_group.fintype_of_admissible_of_finite ℚ _ absolute_value.abs_is_admissible

end ring_of_integers

/-- The class number of a number field is the (finite) cardinality of the class group. -/
noncomputable def class_number : ℕ := fintype.card (class_group (ring_of_integers K) K)

variables {K}

/-- The class number of a number field is `1` iff the ring of integers is a PID. -/
theorem class_number_eq_one_iff :
  class_number K = 1 ↔ is_principal_ideal_ring (ring_of_integers K) :=
card_class_group_eq_one_iff

end number_field

namespace rat

open number_field

theorem class_number_eq : number_field.class_number ℚ = 1 :=
class_number_eq_one_iff.mpr $ by convert is_principal_ideal_ring.of_surjective
  (rat.ring_of_integers_equiv.symm : ℤ →+* ring_of_integers ℚ)
  (rat.ring_of_integers_equiv.symm.surjective)

end rat


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/

import data.nat.modeq
import number_theory.zsqrtd.basic

/-!
# Pell's equation and Matiyasevic's theorem

This file solves Pell's equation, i.e. integer solutions to `x ^ 2 - d * y ^ 2 = 1` in the special
case that `d = a ^ 2 - 1`. This is then applied to prove Matiyasevic's theorem that the power
function is Diophantine, which is the last key ingredient in the solution to Hilbert's tenth
problem. For the definition of Diophantine function, see `dioph.lean`.

## Main definition

* `pell` is a function assigning to a natural number `n` the `n`-th solution to Pell's equation
  constructed recursively from the initial solution `(0, 1)`.

## Main statements

* `eq_pell` shows that every solution to Pell's equation is recursively obtained using `pell`
* `matiyasevic` shows that a certain system of Diophantine equations has a solution if and only if
  the first variable is the `x`-component in a solution to Pell's equation - the key step towards
  Hilbert's tenth problem in Davis' version of Matiyasevic's theorem.
* `eq_pow_of_pell` shows that the power function is Diophantine.

## Implementation notes

The proof of Matiyasevic's theorem doesn't follow Matiyasevic's original account of using Fibonacci
numbers but instead Davis' variant of using solutions to Pell's equation.

## References

* [M. Carneiro, _A Lean formalization of Matiyasevič's theorem_][carneiro2018matiyasevic]
* [M. Davis, _Hilbert's tenth problem is unsolvable_][MR317916]

## Tags

Pell's equation, Matiyasevic's theorem, Hilbert's tenth problem

## TODO

* Provide solutions to Pell's equation for the case of arbitrary `d` (not just `d = a ^ 2 - 1` like
  in the current version) and furthermore also for `x ^ 2 - d * y ^ 2 = -1`.
* Connect solutions to the continued fraction expansion of `√d`.
-/

namespace pell
open nat

section
parameters {a : ℕ} (a1 : 1 < a)

include a1
private def d := a*a - 1

@[simp] theorem d_pos : 0 < d :=
tsub_pos_of_lt (mul_lt_mul a1 (le_of_lt a1) dec_trivial dec_trivial : 1*1<a*a)

/-- The Pell sequences, i.e. the sequence of integer solutions to `x ^ 2 - d * y ^ 2 = 1`, where
`d = a ^ 2 - 1`, defined together in mutual recursion. -/
-- TODO(lint): Fix double namespace issue
@[nolint dup_namespace] def pell : ℕ → ℕ × ℕ :=
λn, nat.rec_on n (1, 0) (λn xy, (xy.1*a + d*xy.2, xy.1 + xy.2*a))

/-- The Pell `x` sequence. -/
def xn (n : ℕ) : ℕ := (pell n).1
/-- The Pell `y` sequence. -/
def yn (n : ℕ) : ℕ := (pell n).2

@[simp] theorem pell_val (n : ℕ) : pell n = (xn n, yn n) :=
show pell n = ((pell n).1, (pell n).2), from match pell n with (a, b) := rfl end

@[simp] theorem xn_zero : xn 0 = 1 := rfl
@[simp] theorem yn_zero : yn 0 = 0 := rfl

@[simp] theorem xn_succ (n : ℕ) : xn (n+1) = xn n * a + d * yn n := rfl
@[simp] theorem yn_succ (n : ℕ) : yn (n+1) = xn n + yn n * a := rfl

@[simp] theorem xn_one : xn 1 = a := by simp
@[simp] theorem yn_one : yn 1 = 1 := by simp

/-- The Pell `x` sequence, considered as an integer sequence.-/
def xz (n : ℕ) : ℤ := xn n
/-- The Pell `y` sequence, considered as an integer sequence.-/
def yz (n : ℕ) : ℤ := yn n

section
omit a1

/-- The element `a` such that `d = a ^ 2 - 1`, considered as an integer.-/
def az : ℤ := a

end

theorem asq_pos : 0 < a*a :=
le_trans (le_of_lt a1) (by have := @nat.mul_le_mul_left 1 a a (le_of_lt a1); rwa mul_one at this)

theorem dz_val : ↑d = az*az - 1 :=
have 1 ≤ a*a, from asq_pos,
show ↑(a*a - 1) = _, by rw int.coe_nat_sub this; refl

@[simp] theorem xz_succ (n : ℕ) : xz (n+1) = xz n * az + ↑d * yz n := rfl
@[simp] theorem yz_succ (n : ℕ) : yz (n+1) = xz n + yz n * az := rfl

/-- The Pell sequence can also be viewed as an element of `ℤ√d` -/
def pell_zd (n : ℕ) : ℤ√d := ⟨xn n, yn n⟩
@[simp] theorem pell_zd_re (n : ℕ) : (pell_zd n).re = xn n := rfl
@[simp] theorem pell_zd_im (n : ℕ) : (pell_zd n).im = yn n := rfl

/-- The property of being a solution to the Pell equation, expressed
  as a property of elements of `ℤ√d`. -/
def is_pell : ℤ√d → Prop | ⟨x, y⟩ := x*x - d*y*y = 1

theorem is_pell_nat {x y : ℕ} : is_pell ⟨x, y⟩ ↔ x*x - d*y*y = 1 :=
⟨λh, int.coe_nat_inj
  (by rw int.coe_nat_sub (int.le_of_coe_nat_le_coe_nat $ int.le.intro_sub h); exact h),
λh, show ((x*x : ℕ) - (d*y*y:ℕ) : ℤ) = 1,
  by rw [← int.coe_nat_sub $ le_of_lt $ nat.lt_of_sub_eq_succ h, h]; refl⟩

theorem is_pell_norm : Π {b : ℤ√d}, is_pell b ↔ b * b.conj = 1
| ⟨x, y⟩ := by simp [zsqrtd.ext, is_pell, mul_comm]; ring_nf

theorem is_pell_mul {b c : ℤ√d} (hb : is_pell b) (hc : is_pell c) : is_pell (b * c) :=
is_pell_norm.2 (by simp [mul_comm, mul_left_comm,
  zsqrtd.conj_mul, pell.is_pell_norm.1 hb, pell.is_pell_norm.1 hc])

theorem is_pell_conj : ∀ {b : ℤ√d}, is_pell b ↔ is_pell b.conj | ⟨x, y⟩ :=
by simp [is_pell, zsqrtd.conj]

@[simp] theorem pell_zd_succ (n : ℕ) : pell_zd (n+1) = pell_zd n * ⟨a, 1⟩ :=
by simp [zsqrtd.ext]

theorem is_pell_one : is_pell ⟨a, 1⟩ :=
show az*az-d*1*1=1, by simp [dz_val]; ring

theorem is_pell_pell_zd : ∀ (n : ℕ), is_pell (pell_zd n)
| 0     := rfl
| (n+1) := let o := is_pell_one in by simp; exact pell.is_pell_mul (is_pell_pell_zd n) o

@[simp] theorem pell_eqz (n : ℕ) : xz n * xz n - d * yz n * yz n = 1 := is_pell_pell_zd n

@[simp] theorem pell_eq (n : ℕ) : xn n * xn n - d * yn n * yn n = 1 :=
let pn := pell_eqz n in
have h : (↑(xn n * xn n) : ℤ) - ↑(d * yn n * yn n) = 1,
  by repeat {rw int.coe_nat_mul}; exact pn,
have hl : d * yn n * yn n ≤ xn n * xn n, from
  int.le_of_coe_nat_le_coe_nat $ int.le.intro $ add_eq_of_eq_sub' $ eq.symm h,
int.coe_nat_inj (by rw int.coe_nat_sub hl; exact h)

instance dnsq : zsqrtd.nonsquare d := ⟨λn h,
  have n*n + 1 = a*a, by rw ← h; exact nat.succ_pred_eq_of_pos (asq_pos a1),
  have na : n < a, from nat.mul_self_lt_mul_self_iff.2 (by rw ← this; exact nat.lt_succ_self _),
  have (n+1)*(n+1) ≤ n*n + 1, by rw this; exact nat.mul_self_le_mul_self na,
  have n+n ≤ 0, from @nat.le_of_add_le_add_right (n*n + 1) _ _ (by ring_nf at this ⊢; assumption),
  ne_of_gt d_pos $ by rwa nat.eq_zero_of_le_zero ((nat.le_add_left _ _).trans this) at h⟩

theorem xn_ge_a_pow : ∀ (n : ℕ), a^n ≤ xn n
| 0     := le_refl 1
| (n+1) := by simp [pow_succ']; exact le_trans
  (nat.mul_le_mul_right _ (xn_ge_a_pow n)) (nat.le_add_right _ _)

theorem n_lt_a_pow : ∀ (n : ℕ), n < a^n
| 0     := nat.le_refl 1
| (n+1) := begin have IH := n_lt_a_pow n,
  have : a^n + a^n ≤ a^n * a,
  { rw ← mul_two, exact nat.mul_le_mul_left _ a1 },
  simp [pow_succ'], refine lt_of_lt_of_le _ this,
  exact add_lt_add_of_lt_of_le IH (lt_of_le_of_lt (nat.zero_le _) IH)
end

theorem n_lt_xn (n) : n < xn n :=
lt_of_lt_of_le (n_lt_a_pow n) (xn_ge_a_pow n)

theorem x_pos (n) : 0 < xn n :=
lt_of_le_of_lt (nat.zero_le n) (n_lt_xn n)

lemma eq_pell_lem : ∀n (b:ℤ√d), 1 ≤ b → is_pell b → b ≤ pell_zd n → ∃n, b = pell_zd n
| 0     b := λh1 hp hl, ⟨0, @zsqrtd.le_antisymm _ dnsq _ _ hl h1⟩
| (n+1) b := λh1 hp h,
  have a1p : (0:ℤ√d) ≤ ⟨a, 1⟩, from trivial,
  have am1p : (0:ℤ√d) ≤ ⟨a, -1⟩, from show (_:nat) ≤ _, by simp; exact nat.pred_le _,
  have a1m : (⟨a, 1⟩ * ⟨a, -1⟩ : ℤ√d) = 1, from is_pell_norm.1 is_pell_one,
  if ha : (⟨↑a, 1⟩ : ℤ√d) ≤ b then
    let ⟨m, e⟩ := eq_pell_lem n (b * ⟨a, -1⟩)
      (by rw ← a1m; exact mul_le_mul_of_nonneg_right ha am1p)
      (is_pell_mul hp (is_pell_conj.1 is_pell_one))
      (by have t := mul_le_mul_of_nonneg_right h am1p;
        rwa [pell_zd_succ, mul_assoc, a1m, mul_one] at t) in
    ⟨m+1, by rw [show b = b * ⟨a, -1⟩ * ⟨a, 1⟩, by rw [mul_assoc, eq.trans (mul_comm _ _) a1m];
      simp, pell_zd_succ, e]⟩
  else
    suffices ¬1 < b, from ⟨0, show b = 1, from (or.resolve_left (lt_or_eq_of_le h1) this).symm⟩,
    λ h1l, by cases b with x y; exact
    have bm : (_*⟨_,_⟩ :ℤ√(d a1)) = 1, from pell.is_pell_norm.1 hp,
    have y0l : (0:ℤ√(d a1)) < ⟨x - x, y - -y⟩,
      from sub_lt_sub h1l $ λ(hn : (1:ℤ√(d a1)) ≤ ⟨x, -y⟩),
        by have t := mul_le_mul_of_nonneg_left hn (le_trans zero_le_one h1);
          rw [bm, mul_one] at t; exact h1l t,
    have yl2 : (⟨_, _⟩ : ℤ√_) < ⟨_, _⟩, from
      show (⟨x, y⟩ - ⟨x, -y⟩ : ℤ√(d a1)) < ⟨a, 1⟩ - ⟨a, -1⟩, from
      sub_lt_sub (by exact ha) $ λ(hn : (⟨x, -y⟩ : ℤ√(d a1)) ≤ ⟨a, -1⟩),
      by have t := mul_le_mul_of_nonneg_right
        (mul_le_mul_of_nonneg_left hn (le_trans zero_le_one h1)) a1p;
          rw [bm, one_mul, mul_assoc, eq.trans (mul_comm _ _) a1m, mul_one] at t; exact ha t,
    by simp at y0l; simp at yl2; exact
    match y, y0l, (yl2 : (⟨_, _⟩ : ℤ√_) < ⟨_, _⟩) with
    | 0, y0l, yl2 := y0l (le_refl 0)
    | (y+1 : ℕ), y0l, yl2 := yl2 (zsqrtd.le_of_le_le (le_refl 0)
        (let t := int.coe_nat_le_coe_nat_of_le (nat.succ_pos y) in add_le_add t t))
    | -[1+y], y0l, yl2 := y0l trivial
    end

theorem eq_pell_zd (b : ℤ√d) (b1 : 1 ≤ b) (hp : is_pell b) : ∃n, b = pell_zd n :=
let ⟨n, h⟩ := @zsqrtd.le_arch d b in
eq_pell_lem n b b1 hp $ zsqrtd.le_trans h $ by rw zsqrtd.coe_nat_val; exact
zsqrtd.le_of_le_le
  (int.coe_nat_le_coe_nat_of_le $ le_of_lt $ n_lt_xn _ _) (int.coe_zero_le _)

/-- Every solution to **Pell's equation** is recursively obtained from the initial solution
`(1,0)` using the recursion `pell`. -/
theorem eq_pell {x y : ℕ} (hp : x*x - d*y*y = 1) : ∃n, x = xn n ∧ y = yn n :=
have (1:ℤ√d) ≤ ⟨x, y⟩, from match x, hp with
| 0,    (hp : 0 - _ = 1) := by rw zero_tsub at hp; contradiction
| (x+1), hp := zsqrtd.le_of_le_le (int.coe_nat_le_coe_nat_of_le $ nat.succ_pos x)
                (int.coe_zero_le _)
end,
let ⟨m, e⟩ := eq_pell_zd ⟨x, y⟩ this (is_pell_nat.2 hp) in
⟨m, match x, y, e with ._, ._, rfl := ⟨rfl, rfl⟩ end⟩

theorem pell_zd_add (m) : ∀ n, pell_zd (m + n) = pell_zd m * pell_zd n
| 0     := (mul_one _).symm
| (n+1) := by rw[← add_assoc, pell_zd_succ, pell_zd_succ, pell_zd_add n, ← mul_assoc]

theorem xn_add (m n) : xn (m + n) = xn m * xn n + d * yn m * yn n :=
by injection (pell_zd_add _ m n) with h _;
    repeat {rw ← int.coe_nat_add at h <|> rw ← int.coe_nat_mul at h};
    exact int.coe_nat_inj h

theorem yn_add (m n) : yn (m + n) = xn m * yn n + yn m * xn n :=
by injection (pell_zd_add _ m n) with _ h;
    repeat {rw ← int.coe_nat_add at h <|> rw ← int.coe_nat_mul at h};
    exact int.coe_nat_inj h

theorem pell_zd_sub {m n} (h : n ≤ m) : pell_zd (m - n) = pell_zd m * (pell_zd n).conj :=
let t := pell_zd_add n (m - n) in
by rw [add_tsub_cancel_of_le h] at t;
    rw [t, mul_comm (pell_zd _ n) _, mul_assoc, (is_pell_norm _).1 (is_pell_pell_zd _ _), mul_one]

theorem xz_sub {m n} (h : n ≤ m) : xz (m - n) = xz m * xz n - d * yz m * yz n :=
by injection (pell_zd_sub _ h) with h _; repeat {rw ← neg_mul_eq_mul_neg at h}; exact h

theorem yz_sub {m n} (h : n ≤ m) : yz (m - n) = xz n * yz m - xz m * yz n :=
by injection (pell_zd_sub a1 h) with _ h; repeat {rw ← neg_mul_eq_mul_neg at h};
  rw [add_comm, mul_comm] at h; exact h

theorem xy_coprime (n) : (xn n).coprime (yn n) :=
nat.coprime_of_dvd' $ λk kp kx ky,
let p := pell_eq n in by rw ← p; exact
nat.dvd_sub (le_of_lt $ nat.lt_of_sub_eq_succ p)
  (kx.mul_left _) (ky.mul_left _)

theorem strict_mono_y : strict_mono yn
| m 0     h := absurd h $ nat.not_lt_zero _
| m (n+1) h :=
  have yn m ≤ yn n, from or.elim (lt_or_eq_of_le $ nat.le_of_succ_le_succ h)
    (λhl, le_of_lt $ strict_mono_y hl) (λe, by rw e),
  by simp; refine lt_of_le_of_lt _ (nat.lt_add_of_pos_left $ x_pos a1 n);
      rw ← mul_one (yn a1 m);
      exact mul_le_mul this (le_of_lt a1) (nat.zero_le _) (nat.zero_le _)

theorem strict_mono_x : strict_mono xn
| m 0     h := absurd h $ nat.not_lt_zero _
| m (n+1) h :=
  have xn m ≤ xn n, from or.elim (lt_or_eq_of_le $ nat.le_of_succ_le_succ h)
    (λhl, le_of_lt $ strict_mono_x hl) (λe, by rw e),
  by simp; refine lt_of_lt_of_le (lt_of_le_of_lt this _) (nat.le_add_right _ _);
      have t := nat.mul_lt_mul_of_pos_left a1 (x_pos a1 n); rwa mul_one at t

theorem yn_ge_n : Π n, n ≤ yn n
| 0 := nat.zero_le _
| (n+1) := show n < yn (n+1), from lt_of_le_of_lt (yn_ge_n n) (strict_mono_y $ nat.lt_succ_self n)

theorem y_mul_dvd (n) : ∀k, yn n ∣ yn (n * k)
| 0     := dvd_zero _
| (k+1) := by rw [nat.mul_succ, yn_add]; exact
  dvd_add (dvd_mul_left _ _) ((y_mul_dvd k).mul_right _)

theorem y_dvd_iff (m n) : yn m ∣ yn n ↔ m ∣ n :=
⟨λh, nat.dvd_of_mod_eq_zero $ (nat.eq_zero_or_pos _).resolve_right $ λhp,
  have co : nat.coprime (yn m) (xn (m * (n / m))), from nat.coprime.symm $
    (xy_coprime _).coprime_dvd_right (y_mul_dvd m (n / m)),
  have m0 : 0 < m, from m.eq_zero_or_pos.resolve_left $
    λe, by rw [e, nat.mod_zero] at hp; rw [e] at h; exact
    ne_of_lt (strict_mono_y a1 hp) (eq_zero_of_zero_dvd h).symm,
  by rw [← nat.mod_add_div n m, yn_add] at h; exact
  not_le_of_gt (strict_mono_y _ $ nat.mod_lt n m0)
    (nat.le_of_dvd (strict_mono_y _ hp) $ co.dvd_of_dvd_mul_right $
    (nat.dvd_add_iff_right $ (y_mul_dvd _ _ _).mul_left _).2 h),
λ⟨k, e⟩, by rw e; apply y_mul_dvd⟩

theorem xy_modeq_yn (n) :
  ∀ k, xn (n * k) ≡ (xn n)^k [MOD (yn n)^2]
    ∧ yn (n * k) ≡ k * (xn n)^(k-1) * yn n [MOD (yn n)^3]
| 0     := by constructor; simp
| (k+1) :=
  let ⟨hx, hy⟩ := xy_modeq_yn k in
  have L : xn (n * k) * xn n + d * yn (n * k) * yn n ≡ xn n^k * xn n + 0 [MOD yn n^2], from
    (hx.mul_right _ ).add $ modeq_zero_iff_dvd.2 $
    by rw pow_succ'; exact
    mul_dvd_mul_right (dvd_mul_of_dvd_right (modeq_zero_iff_dvd.1 $
      (hy.modeq_of_dvd $ by simp [pow_succ']).trans $ modeq_zero_iff_dvd.2 $
      by simp [-mul_comm, -mul_assoc]) _) _,
  have R : xn (n * k) * yn n + yn (n * k) * xn n ≡
            xn n^k * yn n + k * xn n^k * yn n [MOD yn n^3], from
  modeq.add (by { rw pow_succ', exact hx.mul_right' _ }) $
    have k * xn n^(k - 1) * yn n * xn n = k * xn n^k * yn n,
      by clear _let_match; cases k with k; simp [pow_succ', mul_comm, mul_left_comm],
    by { rw ← this, exact hy.mul_right _ },
  by { rw [add_tsub_cancel_right, nat.mul_succ, xn_add, yn_add, pow_succ' (xn _ n),
          nat.succ_mul, add_comm (k * xn _ n^k) (xn _ n^k), right_distrib],
      exact ⟨L, R⟩ }

theorem ysq_dvd_yy (n) : yn n * yn n ∣ yn (n * yn n) :=
modeq_zero_iff_dvd.1 $
  ((xy_modeq_yn n (yn n)).right.modeq_of_dvd $ by simp [pow_succ]).trans
  (modeq_zero_iff_dvd.2 $ by simp [mul_dvd_mul_left, mul_assoc])

theorem dvd_of_ysq_dvd {n t} (h : yn n * yn n ∣ yn t) : yn n ∣ t :=
have nt : n ∣ t, from (y_dvd_iff n t).1 $ dvd_of_mul_left_dvd h,
n.eq_zero_or_pos.elim (λ n0, by rwa n0 at ⊢ nt) $ λ (n0l : 0 < n),
let ⟨k, ke⟩ := nt in
have yn n ∣ k * (xn n)^(k-1), from
nat.dvd_of_mul_dvd_mul_right (strict_mono_y n0l) $ modeq_zero_iff_dvd.1 $
  by have xm := (xy_modeq_yn a1 n k).right; rw ← ke at xm; exact
  (xm.modeq_of_dvd $ by simp [pow_succ]).symm.trans h.modeq_zero_nat,
by rw ke; exact dvd_mul_of_dvd_right
  (((xy_coprime _ _).pow_left _).symm.dvd_of_dvd_mul_right this) _

theorem pell_zd_succ_succ (n) : pell_zd (n + 2) + pell_zd n = (2 * a : ℕ) * pell_zd (n + 1) :=
have (1:ℤ√d) + ⟨a, 1⟩ * ⟨a, 1⟩ = ⟨a, 1⟩ * (2 * a),
by { rw zsqrtd.coe_nat_val, change (⟨_,_⟩:ℤ√(d a1))=⟨_,_⟩,
    rw dz_val, dsimp [az], rw zsqrtd.ext, dsimp, split; ring },
by simpa [mul_add, mul_comm, mul_left_comm, add_comm] using congr_arg (* pell_zd a1 n) this

theorem xy_succ_succ (n) : xn (n + 2) + xn n = (2 * a) * xn (n + 1) ∧
                            yn (n + 2) + yn n = (2 * a) * yn (n + 1) := begin
  have := pell_zd_succ_succ a1 n, unfold pell_zd at this,
  rw [← int.cast_coe_nat, zsqrtd.smul_val] at this,
  injection this with h₁ h₂,
  split; apply int.coe_nat_inj; [simpa using h₁, simpa using h₂]
end

theorem xn_succ_succ (n) : xn (n + 2) + xn n = (2 * a) * xn (n + 1) := (xy_succ_succ n).1
theorem yn_succ_succ (n) : yn (n + 2) + yn n = (2 * a) * yn (n + 1) := (xy_succ_succ n).2

theorem xz_succ_succ (n) : xz (n + 2) = (2 * a : ℕ) * xz (n + 1) - xz n :=
eq_sub_of_add_eq $ by delta xz; rw [← int.coe_nat_add, ← int.coe_nat_mul, xn_succ_succ]

theorem yz_succ_succ (n) : yz (n + 2) = (2 * a : ℕ) * yz (n + 1) - yz n :=
eq_sub_of_add_eq $ by delta yz; rw [← int.coe_nat_add, ← int.coe_nat_mul, yn_succ_succ]

theorem yn_modeq_a_sub_one : ∀ n, yn n ≡ n [MOD a-1]
| 0 := by simp
| 1 := by simp
| (n+2) := (yn_modeq_a_sub_one n).add_right_cancel $
  begin
    rw [yn_succ_succ, (by ring : n + 2 + n = 2 * (n + 1))],
    exact ((modeq_sub a1.le).mul_left 2).mul (yn_modeq_a_sub_one (n+1)),
  end

theorem yn_modeq_two : ∀ n, yn n ≡ n [MOD 2]
| 0 := by simp
| 1 := by simp
| (n+2) := (yn_modeq_two n).add_right_cancel $
  begin
    rw [yn_succ_succ, mul_assoc, (by ring : n + 2 + n = 2 * (n + 1))],
    exact (dvd_mul_right 2 _).modeq_zero_nat.trans (dvd_mul_right 2 _).zero_modeq_nat,
  end

section

omit a1
lemma x_sub_y_dvd_pow_lem (y2 y1 y0 yn1 yn0 xn1 xn0 ay a2 : ℤ) :
  (a2 * yn1 - yn0) * ay + y2 - (a2 * xn1 - xn0) =
    y2 - a2 * y1 + y0 + a2 * (yn1 * ay + y1 - xn1) - (yn0 * ay + y0 - xn0) := by ring

end

theorem x_sub_y_dvd_pow (y : ℕ) :
  ∀ n, (2*a*y - y*y - 1 : ℤ) ∣ yz n * (a - y) + ↑(y^n) - xz n
| 0 := by simp [xz, yz, int.coe_nat_zero, int.coe_nat_one]
| 1 := by simp [xz, yz, int.coe_nat_zero, int.coe_nat_one]
| (n+2) :=
  have (2*a*y - y*y - 1 : ℤ) ∣ ↑(y^(n + 2)) - ↑(2 * a) * ↑(y^(n + 1)) + ↑(y^n), from
  ⟨-↑(y^n), by { simp [pow_succ, mul_add, int.coe_nat_mul,
      show ((2:ℕ):ℤ) = 2, from rfl, mul_comm, mul_left_comm], ring }⟩,
  by { rw [xz_succ_succ, yz_succ_succ, x_sub_y_dvd_pow_lem ↑(y^(n+2)) ↑(y^(n+1)) ↑(y^n)],
  exact
    dvd_sub (dvd_add this $ (x_sub_y_dvd_pow (n+1)).mul_left _) (x_sub_y_dvd_pow n) }

theorem xn_modeq_x2n_add_lem (n j) : xn n ∣ d * yn n * (yn n * xn j) + xn j :=
have h1 : d * yn n * (yn n * xn j) + xn j = (d * yn n * yn n + 1) * xn j,
  by simp [add_mul, mul_assoc],
have h2 : d * yn n * yn n + 1 = xn n * xn n, by apply int.coe_nat_inj;
  repeat {rw int.coe_nat_add <|> rw int.coe_nat_mul}; exact
  add_eq_of_eq_sub' (eq.symm $ pell_eqz _ _),
by rw h2 at h1; rw [h1, mul_assoc]; exact dvd_mul_right _ _

theorem xn_modeq_x2n_add (n j) : xn (2 * n + j) + xn j ≡ 0 [MOD xn n] :=
begin
  rw [two_mul, add_assoc, xn_add, add_assoc, ←zero_add 0],
  refine (dvd_mul_right (xn a1 n) (xn a1 (n + j))).modeq_zero_nat.add _,
  rw [yn_add, left_distrib, add_assoc, ←zero_add 0],
  exact ((dvd_mul_right _ _).mul_left _).modeq_zero_nat.add
    (xn_modeq_x2n_add_lem _ _ _).modeq_zero_nat,
end

lemma xn_modeq_x2n_sub_lem {n j} (h : j ≤ n) : xn (2 * n - j) + xn j ≡ 0 [MOD xn n] :=
have h1 : xz n ∣ ↑d * yz n * yz (n - j) + xz j,
  by rw [yz_sub _ h, mul_sub_left_distrib, sub_add_eq_add_sub]; exact
dvd_sub
  (by delta xz; delta yz;
      repeat {rw ← int.coe_nat_add <|> rw ← int.coe_nat_mul}; rw mul_comm (xn a1 j) (yn a1 n);
      exact int.coe_nat_dvd.2 (xn_modeq_x2n_add_lem _ _ _))
  ((dvd_mul_right _ _).mul_left _),
begin
  rw [two_mul, add_tsub_assoc_of_le h, xn_add, add_assoc, ←zero_add 0],
  exact (dvd_mul_right _ _).modeq_zero_nat.add
    (int.coe_nat_dvd.1 $ by simpa [xz, yz] using h1).modeq_zero_nat,
end

theorem xn_modeq_x2n_sub {n j} (h : j ≤ 2 * n) : xn (2 * n - j) + xn j ≡ 0 [MOD xn n] :=
(le_total j n).elim xn_modeq_x2n_sub_lem
  (λjn, have 2 * n - j + j ≤ n + j, by rw [tsub_add_cancel_of_le h, two_mul];
    exact nat.add_le_add_left jn _,
    let t := xn_modeq_x2n_sub_lem (nat.le_of_add_le_add_right this) in
      by rwa [tsub_tsub_cancel_of_le h, add_comm] at t)

theorem xn_modeq_x4n_add (n j) : xn (4 * n + j) ≡ xn j [MOD xn n] :=
modeq.add_right_cancel' (xn (2 * n + j)) $
by refine @modeq.trans _ _ 0 _ _ (by rw add_comm; exact (xn_modeq_x2n_add _ _ _).symm);
    rw [show 4*n = 2*n + 2*n, from right_distrib 2 2 n, add_assoc]; apply xn_modeq_x2n_add

theorem xn_modeq_x4n_sub {n j} (h : j ≤ 2 * n) : xn (4 * n - j) ≡ xn j [MOD xn n] :=
have h' : j ≤ 2*n, from le_trans h (by rw nat.succ_mul; apply nat.le_add_left),
modeq.add_right_cancel' (xn (2 * n - j)) $
by refine @modeq.trans _ _ 0 _ _ (by rw add_comm; exact (xn_modeq_x2n_sub _ h).symm);
    rw [show 4*n = 2*n + 2*n, from right_distrib 2 2 n, add_tsub_assoc_of_le h'];
      apply xn_modeq_x2n_add

theorem eq_of_xn_modeq_lem1 {i n} : Π {j}, i < j → j < n → xn i % xn n < xn j % xn n
| 0     ij _  := absurd ij (nat.not_lt_zero _)
| (j+1) ij jn :=
    suffices xn j % xn n < xn (j + 1) % xn n, from
    (lt_or_eq_of_le (nat.le_of_succ_le_succ ij)).elim
      (λh, lt_trans (eq_of_xn_modeq_lem1 h (le_of_lt jn)) this)
      (λh, by rw h; exact this),
  by rw [nat.mod_eq_of_lt (strict_mono_x _ (nat.lt_of_succ_lt jn)),
          nat.mod_eq_of_lt (strict_mono_x _ jn)];
      exact strict_mono_x _ (nat.lt_succ_self _)

theorem eq_of_xn_modeq_lem2 {n} (h : 2 * xn n = xn (n + 1)) : a = 2 ∧ n = 0 :=
by rw [xn_succ, mul_comm] at h; exact
have n = 0, from n.eq_zero_or_pos.resolve_right $ λnp,
  ne_of_lt (lt_of_le_of_lt (nat.mul_le_mul_left _ a1)
    (nat.lt_add_of_pos_right $ mul_pos (d_pos a1) (strict_mono_y a1 np))) h,
by cases this; simp at h; exact ⟨h.symm, rfl⟩

theorem eq_of_xn_modeq_lem3 {i n} (npos : 0 < n) :
  Π {j}, i < j → j ≤ 2 * n → j ≠ n → ¬(a = 2 ∧ n = 1 ∧ i = 0 ∧ j = 2) → xn i % xn n < xn j % xn n
| 0     ij _   _   _     := absurd ij (nat.not_lt_zero _)
| (j+1) ij j2n jnn ntriv :=
  have lem2 : ∀k > n, k ≤ 2*n → (↑(xn k % xn n) : ℤ) = xn n - xn (2 * n - k), from λk kn k2n,
    let k2nl := lt_of_add_lt_add_right $ show 2*n-k+k < n+k, by
      {rw tsub_add_cancel_of_le, rw two_mul; exact (add_lt_add_left kn n), exact k2n } in
    have xle : xn (2 * n - k) ≤ xn n, from le_of_lt $ strict_mono_x k2nl,
    suffices xn k % xn n = xn n - xn (2 * n - k), by rw [this, int.coe_nat_sub xle],
    by
    { rw ← nat.mod_eq_of_lt (nat.sub_lt (x_pos a1 n) (x_pos a1 (2 * n - k))),
      apply modeq.add_right_cancel' (xn a1 (2 * n - k)),
      rw [tsub_add_cancel_of_le xle],
      have t := xn_modeq_x2n_sub_lem a1 k2nl.le,
      rw tsub_tsub_cancel_of_le k2n at t,
      exact t.trans dvd_rfl.zero_modeq_nat },
  (lt_trichotomy j n).elim
  (λ (jn : j < n), eq_of_xn_modeq_lem1 ij (lt_of_le_of_ne jn jnn)) $ λ o, o.elim
  (λ (jn : j = n), by
  { cases jn,
    apply int.lt_of_coe_nat_lt_coe_nat,
    rw [lem2 (n+1) (nat.lt_succ_self _) j2n,
        show 2 * n - (n + 1) = n - 1, by rw[two_mul, tsub_add_eq_tsub_tsub, add_tsub_cancel_right]],
    refine lt_sub_left_of_add_lt (int.coe_nat_lt_coe_nat_of_lt _),
    cases (lt_or_eq_of_le $ nat.le_of_succ_le_succ ij) with lin ein,
    { rw nat.mod_eq_of_lt (strict_mono_x _ lin),
      have ll : xn a1 (n-1) + xn a1 (n-1) ≤ xn a1 n,
      { rw [← two_mul, mul_comm, show xn a1 n = xn a1 (n-1+1),
                                  by rw [tsub_add_cancel_of_le (succ_le_of_lt npos)], xn_succ],
        exact le_trans (nat.mul_le_mul_left _ a1) (nat.le_add_right _ _) },
      have npm : (n-1).succ = n := nat.succ_pred_eq_of_pos npos,
      have il : i ≤ n - 1, { apply nat.le_of_succ_le_succ, rw npm, exact lin },
      cases lt_or_eq_of_le il with ill ile,
      { exact lt_of_lt_of_le (nat.add_lt_add_left (strict_mono_x a1 ill) _) ll },
      { rw ile,
        apply lt_of_le_of_ne ll,
        rw ← two_mul,
        exact λe, ntriv $
          let ⟨a2, s1⟩ := @eq_of_xn_modeq_lem2 _ a1 (n-1)
            (by rwa [tsub_add_cancel_of_le (succ_le_of_lt npos)]) in
          have n1 : n = 1, from le_antisymm (tsub_eq_zero_iff_le.mp s1) npos,
          by rw [ile, a2, n1]; exact ⟨rfl, rfl, rfl, rfl⟩ } },
    { rw [ein, nat.mod_self, add_zero],
      exact strict_mono_x _ (nat.pred_lt npos.ne') } })
  (λ (jn : j > n),
    have lem1 : j ≠ n → xn j % xn n < xn (j + 1) % xn n → xn i % xn n < xn (j + 1) % xn n,
      from λjn s,
    (lt_or_eq_of_le (nat.le_of_succ_le_succ ij)).elim
      (λh, lt_trans (eq_of_xn_modeq_lem3 h (le_of_lt j2n) jn $ λ⟨a1, n1, i0, j2⟩,
        by rw [n1, j2] at j2n; exact absurd j2n dec_trivial) s)
      (λh, by rw h; exact s),
    lem1 (ne_of_gt jn) $ int.lt_of_coe_nat_lt_coe_nat $ by
    { rw [lem2 j jn (le_of_lt j2n), lem2 (j+1) (nat.le_succ_of_le jn) j2n],
      refine sub_lt_sub_left (int.coe_nat_lt_coe_nat_of_lt $ strict_mono_x _ _) _,
      rw [nat.sub_succ],
      exact nat.pred_lt (ne_of_gt $ tsub_pos_of_lt j2n) })

theorem eq_of_xn_modeq_le {i j n} (npos : 0 < n) (ij : i ≤ j) (j2n : j ≤ 2 * n)
  (h : xn i ≡ xn j [MOD xn n]) (ntriv : ¬(a = 2 ∧ n = 1 ∧ i = 0 ∧ j = 2)) : i = j :=
(lt_or_eq_of_le ij).resolve_left $ λij',
if jn : j = n then by
{ refine ne_of_gt _ h,
  rw [jn, nat.mod_self],
  have x0 : 0 < xn a1 0 % xn a1 n := by rw [nat.mod_eq_of_lt (strict_mono_x a1 npos)];
    exact dec_trivial,
  cases i with i, exact x0,
  rw jn at ij',
  exact x0.trans (eq_of_xn_modeq_lem3 _ npos (nat.succ_pos _) (le_trans ij j2n) (ne_of_lt ij') $
    λ⟨a1, n1, _, i2⟩, by rw [n1, i2] at ij'; exact absurd ij' dec_trivial) }
else ne_of_lt (eq_of_xn_modeq_lem3 npos ij' j2n jn ntriv) h

theorem eq_of_xn_modeq {i j n} (npos : 0 < n) (i2n : i ≤ 2 * n) (j2n : j ≤ 2 * n)
  (h : xn i ≡ xn j [MOD xn n]) (ntriv : a = 2 → n = 1 → (i = 0 → j ≠ 2) ∧ (i = 2 → j ≠ 0)) :
  i = j :=
(le_total i j).elim
  (λij, eq_of_xn_modeq_le npos ij j2n h $ λ⟨a2, n1, i0, j2⟩, (ntriv a2 n1).left i0 j2)
  (λij, (eq_of_xn_modeq_le npos ij i2n h.symm $ λ⟨a2, n1, j0, i2⟩,
    (ntriv a2 n1).right i2 j0).symm)

theorem eq_of_xn_modeq' {i j n} (ipos : 0 < i) (hin : i ≤ n) (j4n : j ≤ 4 * n)
  (h : xn j ≡ xn i [MOD xn n]) : j = i ∨ j + i = 4 * n :=
have i2n : i ≤ 2*n, by apply le_trans hin; rw two_mul; apply nat.le_add_left,
have npos : 0 < n, from lt_of_lt_of_le ipos hin,
(le_or_gt j (2 * n)).imp
  (λj2n : j ≤ 2 * n, eq_of_xn_modeq npos j2n i2n h $
    λa2 n1, ⟨λj0 i2, by rw [n1, i2] at hin; exact absurd hin dec_trivial,
              λj2 i0, ne_of_gt ipos i0⟩)
  (λj2n : 2 * n < j, suffices i = 4*n - j, by rw [this, add_tsub_cancel_of_le j4n],
    have j42n : 4*n - j ≤ 2*n, from @nat.le_of_add_le_add_right j _ _ $
    by rw [tsub_add_cancel_of_le j4n, show 4*n = 2*n + 2*n, from right_distrib 2 2 n];
      exact nat.add_le_add_left (le_of_lt j2n) _,
    eq_of_xn_modeq npos i2n j42n
      (h.symm.trans $ let t := xn_modeq_x4n_sub j42n in by rwa [tsub_tsub_cancel_of_le j4n] at t)
      (λa2 n1, ⟨λi0, absurd i0 (ne_of_gt ipos), λi2, by { rw [n1, i2] at hin,
        exact absurd hin dec_trivial }⟩))

theorem modeq_of_xn_modeq {i j n} (ipos : 0 < i) (hin : i ≤ n) (h : xn j ≡ xn i [MOD xn n]) :
  j ≡ i [MOD 4 * n] ∨ j + i ≡ 0 [MOD 4 * n] :=
let j' := j % (4 * n) in
have n4 : 0 < 4 * n, from mul_pos dec_trivial (ipos.trans_le hin),
have jl : j' < 4 * n, from nat.mod_lt _ n4,
have jj : j ≡ j' [MOD 4 * n], by delta modeq; rw nat.mod_eq_of_lt jl,
have ∀j q, xn (j + 4 * n * q) ≡ xn j [MOD xn n], begin
  intros j q, induction q with q IH, { simp },
  rw [nat.mul_succ, ← add_assoc, add_comm],
  exact (xn_modeq_x4n_add _ _ _).trans IH
end,
or.imp
  (λ(ji : j' = i), by rwa ← ji)
  (λ(ji : j' + i = 4 * n), (jj.add_right _).trans $
    by { rw ji, exact dvd_rfl.modeq_zero_nat })
  (eq_of_xn_modeq' ipos hin jl.le $
    (h.symm.trans $ by { rw ← nat.mod_add_div j (4*n), exact this j' _ }).symm)
end

theorem xy_modeq_of_modeq {a b c} (a1 : 1 < a) (b1 : 1 < b) (h : a ≡ b [MOD c]) :
  ∀ n, xn a1 n ≡ xn b1 n [MOD c] ∧ yn a1 n ≡ yn b1 n [MOD c]
| 0 := by constructor; refl
| 1 := by simp; exact ⟨h, modeq.refl 1⟩
| (n+2) := ⟨
  (xy_modeq_of_modeq n).left.add_right_cancel $
    by { rw [xn_succ_succ a1, xn_succ_succ b1], exact
    (h.mul_left _ ).mul (xy_modeq_of_modeq (n+1)).left },
  (xy_modeq_of_modeq n).right.add_right_cancel $
    by { rw [yn_succ_succ a1, yn_succ_succ b1], exact
    (h.mul_left _ ).mul (xy_modeq_of_modeq (n+1)).right }⟩

theorem matiyasevic {a k x y} : (∃ a1 : 1 < a, xn a1 k = x ∧ yn a1 k = y) ↔
1 < a ∧ k ≤ y ∧
(x = 1 ∧ y = 0 ∨
∃ (u v s t b : ℕ),
  x * x - (a * a - 1) * y * y = 1 ∧
  u * u - (a * a - 1) * v * v = 1 ∧
  s * s - (b * b - 1) * t * t = 1 ∧
  1 < b ∧ b ≡ 1 [MOD 4 * y] ∧ b ≡ a [MOD u] ∧
  0 < v ∧ y * y ∣ v ∧
  s ≡ x [MOD u] ∧
  t ≡ k [MOD 4 * y]) :=
⟨λ⟨a1, hx, hy⟩, by rw [← hx, ← hy];
  refine ⟨a1, (nat.eq_zero_or_pos k).elim
    (λk0, by rw k0; exact ⟨le_rfl, or.inl ⟨rfl, rfl⟩⟩) (λkpos, _)⟩; exact
  let x := xn a1 k, y := yn a1 k,
      m := 2 * (k * y),
      u := xn a1 m, v := yn a1 m in
  have ky : k ≤ y, from yn_ge_n a1 k,
  have yv : y * y ∣ v, from (ysq_dvd_yy a1 k).trans $ (y_dvd_iff _ _ _).2 $ dvd_mul_left _ _,
  have uco : nat.coprime u (4 * y), from
    have 2 ∣ v, from modeq_zero_iff_dvd.1 $ (yn_modeq_two _ _).trans
      (dvd_mul_right _ _).modeq_zero_nat,
    have nat.coprime u 2, from
      (xy_coprime a1 m).coprime_dvd_right this,
    (this.mul_right this).mul_right $
      (xy_coprime _ _).coprime_dvd_right (dvd_of_mul_left_dvd yv),
  let ⟨b, ba, bm1⟩ := chinese_remainder uco a 1 in
  have m1 : 1 < m, from
    have 0 < k * y, from mul_pos kpos (strict_mono_y a1 kpos),
    nat.mul_le_mul_left 2 this,
  have vp : 0 < v, from strict_mono_y a1 (lt_trans zero_lt_one m1),
  have b1 : 1 < b, from
    have xn a1 1 < u, from strict_mono_x a1 m1,
    have a < u, by simp at this; exact this,
    lt_of_lt_of_le a1 $ by delta modeq at ba;
      rw nat.mod_eq_of_lt this at ba; rw ← ba; apply nat.mod_le,
  let s := xn b1 k, t := yn b1 k in
  have sx : s ≡ x [MOD u], from (xy_modeq_of_modeq b1 a1 ba k).left,
  have tk : t ≡ k [MOD 4 * y], from
      have 4 * y ∣ b - 1, from int.coe_nat_dvd.1 $
        by rw int.coe_nat_sub (le_of_lt b1);
           exact bm1.symm.dvd,
      (yn_modeq_a_sub_one _ _).modeq_of_dvd this,
  ⟨ky, or.inr ⟨u, v, s, t, b,
    pell_eq _ _, pell_eq _ _, pell_eq _ _, b1, bm1, ba, vp, yv, sx, tk⟩⟩,
λ⟨a1, ky, o⟩, ⟨a1, match o with
| or.inl ⟨x1, y0⟩ := by rw y0 at ky; rw [nat.eq_zero_of_le_zero ky, x1, y0]; exact ⟨rfl, rfl⟩
| or.inr ⟨u, v, s, t, b, xy, uv, st, b1, rem⟩ :=
  match x, y, eq_pell a1 xy, u, v, eq_pell a1 uv, s, t, eq_pell b1 st, rem, ky with
  | ._, ._, ⟨i, rfl, rfl⟩, ._, ._, ⟨n, rfl, rfl⟩, ._, ._, ⟨j, rfl, rfl⟩,
    ⟨(bm1 : b ≡ 1 [MOD 4 * yn a1 i]),
     (ba : b ≡ a [MOD xn a1 n]),
     (vp : 0 < yn a1 n),
     (yv : yn a1 i * yn a1 i ∣ yn a1 n),
     (sx : xn b1 j ≡ xn a1 i [MOD xn a1 n]),
     (tk : yn b1 j ≡ k [MOD 4 * yn a1 i])⟩,
     (ky : k ≤ yn a1 i) :=
    (nat.eq_zero_or_pos i).elim
      (λi0, by simp [i0] at ky; rw [i0, ky]; exact ⟨rfl, rfl⟩) $ λipos,
    suffices i = k, by rw this; exact ⟨rfl, rfl⟩,
    by clear _x o rem xy uv st _match _match _fun_match; exact
    have iln : i ≤ n, from le_of_not_gt $ λhin,
    not_lt_of_ge (nat.le_of_dvd vp (dvd_of_mul_left_dvd yv)) (strict_mono_y a1 hin),
    have yd : 4 * yn a1 i ∣ 4 * n, from mul_dvd_mul_left _ $ dvd_of_ysq_dvd a1 yv,
    have jk : j ≡ k [MOD 4 * yn a1 i], from
      have 4 * yn a1 i ∣ b - 1, from int.coe_nat_dvd.1 $
        by rw int.coe_nat_sub (le_of_lt b1); exact bm1.symm.dvd,
      ((yn_modeq_a_sub_one b1 _).modeq_of_dvd this).symm.trans tk,
    have ki : k + i < 4 * yn a1 i, from
      lt_of_le_of_lt (add_le_add ky (yn_ge_n a1 i)) $
      by rw ← two_mul; exact nat.mul_lt_mul_of_pos_right dec_trivial (strict_mono_y a1 ipos),
    have ji : j ≡ i [MOD 4 * n], from
      have xn a1 j ≡ xn a1 i [MOD xn a1 n], from (xy_modeq_of_modeq b1 a1 ba j).left.symm.trans sx,
      (modeq_of_xn_modeq a1 ipos iln this).resolve_right $ λ (ji : j + i ≡ 0 [MOD 4 * n]),
      not_le_of_gt ki $ nat.le_of_dvd (lt_of_lt_of_le ipos $ nat.le_add_left _ _) $
      modeq_zero_iff_dvd.1 $ (jk.symm.add_right i).trans $
      ji.modeq_of_dvd yd,
    by have : i % (4 * yn a1 i) = k % (4 * yn a1 i) :=
         (ji.modeq_of_dvd yd).symm.trans jk;
       rwa [nat.mod_eq_of_lt (lt_of_le_of_lt (nat.le_add_left _ _) ki),
            nat.mod_eq_of_lt (lt_of_le_of_lt (nat.le_add_right _ _) ki)] at this
  end
end⟩⟩

lemma eq_pow_of_pell_lem {a y k} (a1 : 1 < a) (ypos : 0 < y) : 0 < k → y^k < a →
  (↑(y^k) : ℤ) < 2*a*y - y*y - 1 :=
have y < a → a + (y*y + 1) ≤ 2*a*y, begin
  intro ya, induction y with y IH, exact absurd ypos (lt_irrefl _),
  cases nat.eq_zero_or_pos y with y0 ypos,
  { rw y0, simpa [two_mul], },
  { rw [nat.mul_succ, nat.mul_succ, nat.succ_mul y],
    have : y + nat.succ y ≤ 2 * a,
    { change y + y < 2 * a, rw ← two_mul,
      exact mul_lt_mul_of_pos_left (nat.lt_of_succ_lt ya) dec_trivial },
    have := add_le_add (IH ypos (nat.lt_of_succ_lt ya)) this,
    convert this using 1,
    ring }
end, λk0 yak,
lt_of_lt_of_le (int.coe_nat_lt_coe_nat_of_lt yak) $
by rw sub_sub; apply le_sub_right_of_add_le;
   apply int.coe_nat_le_coe_nat_of_le;
   have y1 := nat.pow_le_pow_of_le_right ypos k0; simp at y1;
   exact this (lt_of_le_of_lt y1 yak)

theorem eq_pow_of_pell {m n k} : (n^k = m ↔
k = 0 ∧ m = 1 ∨ 0 < k ∧
(n = 0 ∧ m = 0 ∨ 0 < n ∧
∃ (w a t z : ℕ) (a1 : 1 < a),
  xn a1 k ≡ yn a1 k * (a - n) + m [MOD t] ∧
  2 * a * n = t + (n * n + 1) ∧
  m < t ∧ n ≤ w ∧ k ≤ w ∧
  a * a - ((w + 1) * (w + 1) - 1) * (w * z) * (w * z) = 1)) :=
⟨λe, by rw ← e;
  refine (nat.eq_zero_or_pos k).elim
    (λk0, by rw k0; exact or.inl ⟨rfl, rfl⟩)
    (λkpos, or.inr ⟨kpos, _⟩);
  refine (nat.eq_zero_or_pos n).elim
    (λn0, by rw [n0, zero_pow kpos]; exact or.inl ⟨rfl, rfl⟩)
    (λnpos, or.inr ⟨npos, _⟩); exact
  let w := max n k in
  have nw : n ≤ w, from le_max_left _ _,
  have kw : k ≤ w, from le_max_right _ _,
  have wpos : 0 < w, from lt_of_lt_of_le npos nw,
  have w1 : 1 < w + 1, from nat.succ_lt_succ wpos,
  let a := xn w1 w in
  have a1 : 1 < a, from strict_mono_x w1 wpos,
  let x := xn a1 k, y := yn a1 k in
  let ⟨z, ze⟩ := show w ∣ yn w1 w, from modeq_zero_iff_dvd.1 $
    (yn_modeq_a_sub_one w1 w).trans dvd_rfl.modeq_zero_nat in
  have nt : (↑(n^k) : ℤ) < 2 * a * n - n * n - 1, from
    eq_pow_of_pell_lem a1 npos kpos $ calc
      n^k ≤ n^w       : nat.pow_le_pow_of_le_right npos kw
      ... < (w + 1)^w : nat.pow_lt_pow_of_lt_left (nat.lt_succ_of_le nw) wpos
      ... ≤ a         : xn_ge_a_pow w1 w,
  let ⟨t, te⟩ := int.eq_coe_of_zero_le $
    le_trans (int.coe_zero_le _) nt.le in
  have na : n ≤ a, from nw.trans $ le_of_lt $ n_lt_xn w1 w,
  have tm : x ≡ y * (a - n) + n^k [MOD t], begin
    apply modeq_of_dvd,
    rw [int.coe_nat_add, int.coe_nat_mul, int.coe_nat_sub na, ← te],
    exact x_sub_y_dvd_pow a1 n k
  end,
  have ta : 2 * a * n = t + (n * n + 1), from int.coe_nat_inj $
    by rw [int.coe_nat_add, ← te, sub_sub];
       repeat {rw int.coe_nat_add <|> rw int.coe_nat_mul};
       rw [int.coe_nat_one, sub_add_cancel]; refl,
  have mt : n^k < t, from int.lt_of_coe_nat_lt_coe_nat $
    by rw ← te; exact nt,
  have zp : a * a - ((w + 1) * (w + 1) - 1) * (w * z) * (w * z) = 1,
    by rw ← ze; exact pell_eq w1 w,
  ⟨w, a, t, z, a1, tm, ta, mt, nw, kw, zp⟩,
λo, match o with
| or.inl ⟨k0, m1⟩ := by rw [k0, m1]; refl
| or.inr ⟨kpos, or.inl ⟨n0, m0⟩⟩ := by rw [n0, m0, zero_pow kpos]
| or.inr ⟨kpos, or.inr ⟨npos, w, a, t, z,
   (a1 : 1 < a),
   (tm : xn a1 k ≡ yn a1 k * (a - n) + m [MOD t]),
   (ta : 2 * a * n = t + (n * n + 1)),
   (mt : m < t),
   (nw : n ≤ w),
   (kw : k ≤ w),
   (zp : a * a - ((w + 1) * (w + 1) - 1) * (w * z) * (w * z) = 1)⟩⟩ :=
  have wpos : 0 < w, from lt_of_lt_of_le npos nw,
  have w1 : 1 < w + 1, from nat.succ_lt_succ wpos,
  let ⟨j, xj, yj⟩ := eq_pell w1 zp in
  by clear _match o _let_match; exact
  have jpos : 0 < j, from (nat.eq_zero_or_pos j).resolve_left $ λj0,
    have a1 : a = 1, by rw j0 at xj; exact xj,
    have 2 * n = t + (n * n + 1), by rw a1 at ta; exact ta,
    have n1 : n = 1, from
      have n * n < n * 2, by rw [mul_comm n 2, this]; apply nat.le_add_left,
      have n ≤ 1, from nat.le_of_lt_succ $ lt_of_mul_lt_mul_left this (nat.zero_le _),
      le_antisymm this npos,
    by rw n1 at this;
      rw ← @nat.add_right_cancel 0 2 t this at mt;
      exact nat.not_lt_zero _ mt,
  have wj : w ≤ j, from nat.le_of_dvd jpos $ modeq_zero_iff_dvd.1 $
    (yn_modeq_a_sub_one w1 j).symm.trans $
    modeq_zero_iff_dvd.2 ⟨z, yj.symm⟩,
  have nt : (↑(n^k) : ℤ) < 2 * a * n - n * n - 1, from
    eq_pow_of_pell_lem a1 npos kpos $ calc
      n^k ≤ n^j       : nat.pow_le_pow_of_le_right npos (le_trans kw wj)
      ... < (w + 1)^j : nat.pow_lt_pow_of_lt_left (nat.lt_succ_of_le nw) jpos
      ... ≤ xn w1 j   : xn_ge_a_pow w1 j
      ... = a         : xj.symm,
  have na : n ≤ a, by rw xj; exact
    le_trans (le_trans nw wj) (le_of_lt $ n_lt_xn _ _),
  have te : (t : ℤ) = 2 * ↑a * ↑n - ↑n * ↑n - 1, by
    rw sub_sub; apply eq_sub_of_add_eq; apply (int.coe_nat_eq_coe_nat_iff _ _).2;
    exact ta.symm,
  have xn a1 k ≡ yn a1 k * (a - n) + n^k [MOD t],
    by have := x_sub_y_dvd_pow a1 n k;
       rw [← te, ← int.coe_nat_sub na] at this; exact modeq_of_dvd this,
  have n^k % t = m % t, from
    (this.symm.trans tm).add_left_cancel' _,
  by rw ← te at nt;
     rwa [nat.mod_eq_of_lt (int.lt_of_coe_nat_lt_coe_nat nt), nat.mod_eq_of_lt mt] at this
end⟩

end pell


/-
Copyright (c) 2022 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov

! This file was ported from Lean 3 source module measure_theory.integral.average
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.MeasureTheory.Integral.SetIntegral

/-!
# Integral average of a function

In this file we define `measure_theory.average μ f` (notation: `⨍ x, f x ∂μ`) to be the average
value of `f` with respect to measure `μ`. It is defined as `∫ x, f x ∂((μ univ)⁻¹ • μ)`, so it
is equal to zero if `f` is not integrable or if `μ` is an infinite measure. If `μ` is a probability
measure, then the average of any function is equal to its integral.

For the average on a set, we use `⨍ x in s, f x ∂μ` (notation for `⨍ x, f x ∂(μ.restrict s)`). For
average w.r.t. the volume, one can omit `∂volume`.

## Implementation notes

The average is defined as an integral over `(μ univ)⁻¹ • μ` so that all theorems about Bochner
integrals work for the average without modifications. For theorems that require integrability of a
function, we provide a convenience lemma `measure_theory.integrable.to_average`.

## Tags

integral, center mass, average value
-/

open MeasureTheory MeasureTheory.Measure Metric Set Filter TopologicalSpace Function

open Topology BigOperators ENNReal Convex

variable {α E F : Type _} {m0 : MeasurableSpace α} [NormedAddCommGroup E] [NormedSpace ℝ E]
  [CompleteSpace E] [NormedAddCommGroup F] [NormedSpace ℝ F] [CompleteSpace F] {μ : Measure α}
  {s : Set E}

/-!
### Average value of a function w.r.t. a measure

The average value of a function `f` w.r.t. a measure `μ` (notation: `⨍ x, f x ∂μ`) is defined as
`(μ univ).to_real⁻¹ • ∫ x, f x ∂μ`, so it is equal to zero if `f` is not integrable or if `μ` is an
infinite measure. If `μ` is a probability measure, then the average of any function is equal to its
integral.

-/

namespace MeasureTheory

variable (μ)

include m0

/-- Average value of a function `f` w.r.t. a measure `μ`, notation: `⨍ x, f x ∂μ`. It is defined as
`(μ univ).to_real⁻¹ • ∫ x, f x ∂μ`, so it is equal to zero if `f` is not integrable or if `μ` is an
infinite measure. If `μ` is a probability measure, then the average of any function is equal to its
integral.

For the average on a set, use `⨍ x in s, f x ∂μ` (defined as `⨍ x, f x ∂(μ.restrict s)`). For
average w.r.t. the volume, one can omit `∂volume`. -/
noncomputable def average (f : α → E) :=
  ∫ x, f x ∂(μ univ)⁻¹ • μ
#align measure_theory.average MeasureTheory.average

-- mathport name: «expr⨍ , ∂ »
notation3"⨍ "(...)", "r:(scoped f => f)" ∂"μ => average μ r

-- mathport name: «expr⨍ , »
notation3"⨍ "(...)", "r:(scoped f => average volume f) => r

-- mathport name: «expr⨍ in , ∂ »
notation3"⨍ "(...)" in "s", "r:(scoped f => f)" ∂"μ => average (Measure.restrict μ s) r

-- mathport name: «expr⨍ in , »
notation3"⨍ "(...)" in "s", "r:(scoped f => average Measure.restrict volume s f) => r

@[simp]
theorem average_zero : (⨍ x, (0 : E) ∂μ) = 0 := by rw [average, integral_zero]
#align measure_theory.average_zero MeasureTheory.average_zero

@[simp]
theorem average_zero_measure (f : α → E) : (⨍ x, f x ∂(0 : Measure α)) = 0 := by
  rw [average, smul_zero, integral_zero_measure]
#align measure_theory.average_zero_measure MeasureTheory.average_zero_measure

@[simp]
theorem average_neg (f : α → E) : (⨍ x, -f x ∂μ) = -⨍ x, f x ∂μ :=
  integral_neg f
#align measure_theory.average_neg MeasureTheory.average_neg

theorem average_eq' (f : α → E) : (⨍ x, f x ∂μ) = ∫ x, f x ∂(μ univ)⁻¹ • μ :=
  rfl
#align measure_theory.average_eq' MeasureTheory.average_eq'

theorem average_eq (f : α → E) : (⨍ x, f x ∂μ) = (μ univ).toReal⁻¹ • ∫ x, f x ∂μ := by
  rw [average_eq', integral_smul_measure, ENNReal.toReal_inv]
#align measure_theory.average_eq MeasureTheory.average_eq

theorem average_eq_integral [IsProbabilityMeasure μ] (f : α → E) : (⨍ x, f x ∂μ) = ∫ x, f x ∂μ := by
  rw [average, measure_univ, inv_one, one_smul]
#align measure_theory.average_eq_integral MeasureTheory.average_eq_integral

@[simp]
theorem measure_smul_average [IsFiniteMeasure μ] (f : α → E) :
    ((μ univ).toReal • ⨍ x, f x ∂μ) = ∫ x, f x ∂μ :=
  by
  cases' eq_or_ne μ 0 with hμ hμ
  · rw [hμ, integral_zero_measure, average_zero_measure, smul_zero]
  · rw [average_eq, smul_inv_smul₀]
    refine' (ENNReal.toReal_pos _ <| measure_ne_top _ _).ne'
    rwa [Ne.def, measure_univ_eq_zero]
#align measure_theory.measure_smul_average MeasureTheory.measure_smul_average

theorem set_average_eq (f : α → E) (s : Set α) :
    (⨍ x in s, f x ∂μ) = (μ s).toReal⁻¹ • ∫ x in s, f x ∂μ := by
  rw [average_eq, restrict_apply_univ]
#align measure_theory.set_average_eq MeasureTheory.set_average_eq

theorem set_average_eq' (f : α → E) (s : Set α) :
    (⨍ x in s, f x ∂μ) = ∫ x, f x ∂(μ s)⁻¹ • μ.restrict s := by
  simp only [average_eq', restrict_apply_univ]
#align measure_theory.set_average_eq' MeasureTheory.set_average_eq'

variable {μ}

theorem average_congr {f g : α → E} (h : f =ᵐ[μ] g) : (⨍ x, f x ∂μ) = ⨍ x, g x ∂μ := by
  simp only [average_eq, integral_congr_ae h]
#align measure_theory.average_congr MeasureTheory.average_congr

theorem average_add_measure [IsFiniteMeasure μ] {ν : Measure α} [IsFiniteMeasure ν] {f : α → E}
    (hμ : Integrable f μ) (hν : Integrable f ν) :
    (⨍ x, f x ∂μ + ν) =
      (((μ univ).toReal / ((μ univ).toReal + (ν univ).toReal)) • ⨍ x, f x ∂μ) +
        ((ν univ).toReal / ((μ univ).toReal + (ν univ).toReal)) • ⨍ x, f x ∂ν :=
  by
  simp only [div_eq_inv_mul, mul_smul, measure_smul_average, ← smul_add, ←
    integral_add_measure hμ hν, ← ENNReal.toReal_add (measure_ne_top μ _) (measure_ne_top ν _)]
  rw [average_eq, measure.add_apply]
#align measure_theory.average_add_measure MeasureTheory.average_add_measure

theorem average_pair {f : α → E} {g : α → F} (hfi : Integrable f μ) (hgi : Integrable g μ) :
    (⨍ x, (f x, g x) ∂μ) = (⨍ x, f x ∂μ, ⨍ x, g x ∂μ) :=
  integral_pair hfi.toAverage hgi.toAverage
#align measure_theory.average_pair MeasureTheory.average_pair

theorem measure_smul_set_average (f : α → E) {s : Set α} (h : μ s ≠ ∞) :
    ((μ s).toReal • ⨍ x in s, f x ∂μ) = ∫ x in s, f x ∂μ :=
  by
  haveI := Fact.mk h.lt_top
  rw [← measure_smul_average, restrict_apply_univ]
#align measure_theory.measure_smul_set_average MeasureTheory.measure_smul_set_average

theorem average_union {f : α → E} {s t : Set α} (hd : AeDisjoint μ s t) (ht : NullMeasurableSet t μ)
    (hsμ : μ s ≠ ∞) (htμ : μ t ≠ ∞) (hfs : IntegrableOn f s μ) (hft : IntegrableOn f t μ) :
    (⨍ x in s ∪ t, f x ∂μ) =
      (((μ s).toReal / ((μ s).toReal + (μ t).toReal)) • ⨍ x in s, f x ∂μ) +
        ((μ t).toReal / ((μ s).toReal + (μ t).toReal)) • ⨍ x in t, f x ∂μ :=
  by
  haveI := Fact.mk hsμ.lt_top; haveI := Fact.mk htμ.lt_top
  rw [restrict_union₀ hd ht, average_add_measure hfs hft, restrict_apply_univ, restrict_apply_univ]
#align measure_theory.average_union MeasureTheory.average_union

theorem average_union_mem_openSegment {f : α → E} {s t : Set α} (hd : AeDisjoint μ s t)
    (ht : NullMeasurableSet t μ) (hs₀ : μ s ≠ 0) (ht₀ : μ t ≠ 0) (hsμ : μ s ≠ ∞) (htμ : μ t ≠ ∞)
    (hfs : IntegrableOn f s μ) (hft : IntegrableOn f t μ) :
    (⨍ x in s ∪ t, f x ∂μ) ∈ openSegment ℝ (⨍ x in s, f x ∂μ) (⨍ x in t, f x ∂μ) :=
  by
  replace hs₀ : 0 < (μ s).toReal; exact ENNReal.toReal_pos hs₀ hsμ
  replace ht₀ : 0 < (μ t).toReal; exact ENNReal.toReal_pos ht₀ htμ
  refine'
    mem_open_segment_iff_div.mpr
      ⟨(μ s).toReal, (μ t).toReal, hs₀, ht₀, (average_union hd ht hsμ htμ hfs hft).symm⟩
#align measure_theory.average_union_mem_open_segment MeasureTheory.average_union_mem_openSegment

theorem average_union_mem_segment {f : α → E} {s t : Set α} (hd : AeDisjoint μ s t)
    (ht : NullMeasurableSet t μ) (hsμ : μ s ≠ ∞) (htμ : μ t ≠ ∞) (hfs : IntegrableOn f s μ)
    (hft : IntegrableOn f t μ) :
    (⨍ x in s ∪ t, f x ∂μ) ∈ [⨍ x in s, f x ∂μ -[ℝ] ⨍ x in t, f x ∂μ] :=
  by
  by_cases hse : μ s = 0
  · rw [← ae_eq_empty] at hse
    rw [restrict_congr_set (hse.union eventually_eq.rfl), empty_union]
    exact right_mem_segment _ _ _
  · refine'
      mem_segment_iff_div.mpr
        ⟨(μ s).toReal, (μ t).toReal, ENNReal.toReal_nonneg, ENNReal.toReal_nonneg, _,
          (average_union hd ht hsμ htμ hfs hft).symm⟩
    calc
      0 < (μ s).toReal := ENNReal.toReal_pos hse hsμ
      _ ≤ _ := le_add_of_nonneg_right ENNReal.toReal_nonneg

#align measure_theory.average_union_mem_segment MeasureTheory.average_union_mem_segment

theorem average_mem_openSegment_compl_self [IsFiniteMeasure μ] {f : α → E} {s : Set α}
    (hs : NullMeasurableSet s μ) (hs₀ : μ s ≠ 0) (hsc₀ : μ (sᶜ) ≠ 0) (hfi : Integrable f μ) :
    (⨍ x, f x ∂μ) ∈ openSegment ℝ (⨍ x in s, f x ∂μ) (⨍ x in sᶜ, f x ∂μ) := by
  simpa only [union_compl_self, restrict_univ] using
    average_union_mem_open_segment ae_disjoint_compl_right hs.compl hs₀ hsc₀ (measure_ne_top _ _)
      (measure_ne_top _ _) hfi.integrable_on hfi.integrable_on
#align measure_theory.average_mem_open_segment_compl_self MeasureTheory.average_mem_openSegment_compl_self

@[simp]
theorem average_const [IsFiniteMeasure μ] [h : μ.ae.ne_bot] (c : E) : (⨍ x, c ∂μ) = c := by
  simp only [average_eq, integral_const, measure.restrict_apply, MeasurableSet.univ, one_smul,
    univ_inter, smul_smul, ← ENNReal.toReal_inv, ← ENNReal.toReal_mul, ENNReal.inv_mul_cancel,
    measure_ne_top μ univ, Ne.def, measure_univ_eq_zero, ae_ne_bot.1 h, not_false_iff,
    ENNReal.one_toReal]
#align measure_theory.average_const MeasureTheory.average_const

theorem set_average_const {s : Set α} (hs₀ : μ s ≠ 0) (hs : μ s ≠ ∞) (c : E) :
    (⨍ x in s, c ∂μ) = c := by
  simp only [set_average_eq, integral_const, measure.restrict_apply, MeasurableSet.univ, univ_inter,
    smul_smul, ← ENNReal.toReal_inv, ← ENNReal.toReal_mul, ENNReal.inv_mul_cancel hs₀ hs,
    ENNReal.one_toReal, one_smul]
#align measure_theory.set_average_const MeasureTheory.set_average_const

end MeasureTheory


/-
Copyright (c) 2021 David Renshaw. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: David Renshaw
-/

import data.pnat.basic
import data.nat.parity
import algebra.big_operators.pi
import tactic.ring
import tactic.field_simp

/-!
# IMO 2013 Q1

Prove that for any pair of positive integers k and n, there exist k positive integers
m₁, m₂, ..., mₖ (not necessarily different) such that

  1 + (2ᵏ - 1)/ n = (1 + 1/m₁) * (1 + 1/m₂) * ... * (1 + 1/mₖ).

# Solution

Adaptation of the solution found in https://www.imo-official.org/problems/IMO2013SL.pdf

We prove a slightly more general version where k does not need to be strictly positive.
-/

open_locale big_operators

lemma arith_lemma (k n : ℕ) : 0 < 2 * n + 2^k.succ :=
calc 0 < 2                : zero_lt_two
   ... = 2^1              : (pow_one 2).symm
   ... ≤ 2^k.succ         : nat.pow_le_pow_of_le_right zero_lt_two (nat.le_add_left 1 k)
   ... ≤ 2 * n + 2^k.succ : nat.le_add_left _ _

lemma prod_lemma (m : ℕ → ℕ+) (k : ℕ) (nm : ℕ+):
      ∏ (i : ℕ) in finset.range k, ((1 : ℚ) + 1 / ↑(if i < k then m i else nm)) =
      ∏ (i : ℕ) in finset.range k, (1 + 1 / m i) :=
begin
  suffices : ∀ i, i ∈ finset.range k → (1 : ℚ) + 1 / ↑(if i < k then m i else nm) = 1 + 1 / m i,
  from finset.prod_congr rfl this,
  intros i hi,
  simp [finset.mem_range.mp hi]
end

theorem imo2013_q1 (n : ℕ+) (k : ℕ) :
    (∃ m : ℕ → ℕ+, (1 : ℚ) + (2^k - 1) / n = (∏ i in finset.range k, (1 + 1 / m i))) :=
begin
  revert n,
  induction k with pk hpk,
  { intro n, use (λ_, 1), simp }, -- For the base case, any m works.

  intro n,
  obtain ⟨t, ht : ↑n = t + t⟩ | ⟨t, ht : ↑n = 2 * t + 1⟩ := (n : ℕ).even_or_odd,
  { -- even case
    rw ← two_mul at ht,
    cases t, -- Eliminate the zero case to simplify later calculations.
    { exfalso, rw mul_zero at ht, exact pnat.ne_zero n ht },

    -- Now we have ht : ↑n = 2 * (t + 1).
    let t_succ : ℕ+ := ⟨t + 1, t.succ_pos⟩,
    obtain ⟨pm, hpm⟩ := hpk t_succ,
    let m := λi, if i < pk then pm i else ⟨2 * t + 2^pk.succ, arith_lemma pk t⟩,
    use m,

    have hmpk : (m pk : ℚ) = 2 * t + 2^pk.succ,
    { have : m pk = ⟨2 * t + 2^pk.succ, _⟩ := if_neg (irrefl pk), simp [this] },

    have denom_ne_zero : (2 * (t:ℚ) + 2^pk.succ) ≠ 0,
    { norm_cast, exact (ne_of_gt $ arith_lemma pk t) },

    calc (1 : ℚ) + (2 ^ pk.succ - 1) / ↑n
        = 1 + (2 * 2 ^ pk - 1) / (2 * (t + 1) : ℕ)    : by rw [coe_coe n, ht, pow_succ]
    ... = (1 + 1 / (2 * t + 2 * 2^pk)) *
          (1 + (2 ^ pk - 1) / (↑t + 1))               : by { field_simp [t.cast_add_one_ne_zero],
                                                             ring }
    ... = (1 + 1 / (2 * t + 2^pk.succ)) *
          (1 + (2 ^ pk - 1) / t_succ)                 : by norm_cast
    ... = (∏ i in finset.range pk, (1 + 1 / m i)) *
          (1 + 1 / (m pk))                            : by rw [prod_lemma, hpm, ←hmpk, mul_comm]
    ... = ∏ i in finset.range pk.succ, (1 + 1 / m i)  : by rw ← finset.prod_range_succ _ pk },
  { -- odd case
    let t_succ : ℕ+ := ⟨t + 1, t.succ_pos⟩,
    obtain ⟨pm, hpm⟩ := hpk t_succ,
    let m := λi, if i < pk then pm i else ⟨2 * t + 1, nat.succ_pos _⟩,
    use m,

    have hmpk : (m pk : ℚ) = 2 * t + 1,
    { have : m pk = ⟨2 * t + 1, _⟩ := if_neg (irrefl pk), simp [this] },

    have denom_ne_zero : (2 * (t : ℚ) + 1) ≠ 0 := by { norm_cast, apply (2 * t).succ_ne_zero },

    calc (1 : ℚ) + (2 ^ pk.succ - 1) / ↑n
        = 1 + (2 * 2^pk - 1) / (2 * t + 1 : ℕ)        : by rw [coe_coe n, ht, pow_succ]
    ... = (1 + 1 / (2 * t + 1)) *
          (1 + (2^pk - 1) / (t + 1))                  : by { field_simp [t.cast_add_one_ne_zero],
                                                             ring }
    ... = (1 + 1 / (2 * t + 1)) *
          (1 + (2^pk - 1) / t_succ)                   : by norm_cast
    ... = (∏ i in finset.range pk, (1 + 1 / m i)) *
          (1 + 1 / ↑(m pk))                           : by rw [prod_lemma, hpm, ←hmpk, mul_comm]
    ... = ∏ i in finset.range pk.succ, (1 + 1 / m i)  : by rw ← finset.prod_range_succ _ pk }
end