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_of_irrational_orbit
{α : Type*} [linear_ordered_field α] [decidable_linear_ordered_comm_ring α]
(α : α) [ha : ¬ is_rat α]
: ∃ (B : ℤ → set α), ∀ i, ∀ j, i ≠ j → B i ≠ B j ∧ ∀ x ∈ B i, ∀ y ∈ B j, x - y ∈ B (i - j)
:=
begin
  -- consider $S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}$
  let S := λ (i : ℤ), {x : α | ∃ y : ℤ, x = i * α - y},
  let B := S,

  -- Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$.
  -- If this were not true, then
  -- $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j}$

  have h1  : ∀ i j : ℤ, i ≠ j → B i ≠ B j, from begin
       assume i j : ℤ,
       assume h1 : i ≠ j,
       have h2 : ¬ ∃ x : α, ∃ y : α, i * α - y = j * α - x, from
               begin
                assume h3,
                cases h3 with x h4,
                cases h4 with y h5,
                rw h5,
                have h6 : i - j ≠ 0, from by {contradict h1, linarith,},
                have h7 : i * α - y = (i - j) * α + j * α - x,
                by {rw mul_sub_right_distrib, rw sub_add_eq_add_sub, ring},
                have h8 : i - j ≠ 0, from by {rw [← @add_mul α 0 (-j) i] at h7,
                                               have h9 : i * 0 - y + j * α - x = 0, from zero_add y,
                                               rw [h7,h9,mul_zero], simp,},
                have h9 : i * α - y -(j * α - x) = (i - j) * α - 0, from sub_add_eq_add_sub h7,
                have h10 : (i - j)⁻¹ ≠ 0, from inv_ne_zero h8,
                have h11 : (i - j)⁻¹ * ((i - j) * α - 0) = (i - j)⁻¹ * ((i - j) * α - (j * α - x) - y),
                by {rw h9, rw sub_zero,},
                rw h11, rw mul_comm, rw mul_assoc,
                have h12 : (i - j)⁻¹ * ((i - j) * α) = (i - j)⁻¹ * (i - j) * α, from mul_comm _ ((i - j) * α),
                have h13 : (i - j)⁻¹ * ((i - j) * α) - ((i - j)⁻¹ * y) - (i - j)⁻¹ * (j * α - x) =
                           (i - j)⁻¹ * (i - j) * α - (i - j)⁻¹ * y - (i - j)⁻¹ * (j * α - x),
                from by {rw [← sub_sub,zero_sub]},
                rw h13 at h11,
                rw h12 at h11,
                have h14 : (i - j)⁻¹ * (i - j) = 1, from mul_inv_cancel h8,
                rw h14 at h11,
                have h15 : 1 * α - (i - j)⁻¹ * y - (i - j)⁻¹ * (j * α - x) = α - (i - j)⁻¹ * y - (i - j)⁻¹ * (j * α - x), from rfl,
                rw h15 at h11,
                have h16 : α - (i - j)⁻¹ * y - (i - j)⁻¹ * (j * α - x) = α - (i - j)⁻¹ * (y + (j * α - x)),
                from by {rw [← mul_one ((i - j)⁻¹), ← mul_add], ring},
                rw h16 at h11,
                have h17 : (i - j)⁻¹ * (y + (j * α - x)) = (i - j)⁻¹ * y + (i - j)⁻¹ * (j * α - x), from mul_add _ _ _,
                rw h17 at h11,
                have h18 : α - (i - j)⁻¹ * y - (i - j)⁻¹ * (j * α - x) = α - (i - j)⁻¹ * (y + (j * α - x)), from rfl,
                rw h18 at h11,
                rw h17 at h11,
                rw h11,
                rw sub_self, linarith,
               end,
       exact and.intro,
       {
        assume h3 : x ∈ B i,
        cases h3 with y h4,
        have h5 : x ∈ B j, from by {existsi y, rw h4,},
        have h6 : y ∈ B j, from by {existsi y, rw h4,},
        exact absurd h2 (h1 (B i) (B j) h5 h6),
       },
       {
        assume h3 : y ∈ B i,
        cases h3 with y h4,
        have h5 : x ∈ B j, from by {existsi y, rw h4,},
        have h6 : y ∈ B j, from by {existsi y, rw h4,},
        exact absurd h2 (h1 (B i) (B j) h5 h6),
       }
    end,

  -- $S$ is an infinite subset of $\left[0,1\right]$.
  have h2 : ∀ i : ℤ, S i ≠ ∅,
  from assume i : ℤ, by {existsi 0, rw sub_zero},

  --By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$.
  have h3 : ∀ (x : α), x ∈ [0, 1] → ∀ (ε : α), ε > 0 → ∃ y : ℤ, ∃ z : ℤ, ((i ≠ j) → (y ∈ S i ∧ z ∈ S j)) ∧ |x - (i * α - y) - (j * α - z)| < ε,
  from by {
    assume x : α,
    assume h3 : x ∈ [0, 1],
    assume ε : α,
    assume h4 : ε > 0,
    let y : ℤ := 0,
    let z : ℤ := 0,
    let h5 : ∀ i j : ℤ, i ≠ j → y ∈ S i ∧ z ∈ S j, from by {
      assume i j : ℤ,
      assume h5 : i ≠ j,
      split,
      {
        have h6 : y ∈ S i, from by {existsi y, rw sub_zero,},
        exact h6,
      },
      {
        have h7 : z ∈ S j, from by {existsi z, rw sub_zero,},
        exact h7,
      }
    },
    have h6 : |x - (i * α - y) - (j * α - z)| = |x - i * α + y - j * α + z|
end --Needs more than 2000 tokens!

--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 α] : ∀ ε : ℝ, ε > 0 → ∃ x y ∈ set.range (λ n : ℕ, n * α), abs (x - y) < ε := begin
  assume (ε : ℝ) hε,

  have h : ∀ i j : ℕ, ¬ (set.fintype.card (set.range ((λ (n : ℕ), n * α))) ≤ ((j : ℕ) - (i : ℕ))) ∨ (i * α - j * α) = 0 , from (assume i j : ℕ, by {
    rw [set.card_range,set.card_le_iff_finite,set.fintype.finite_subset],
    show (λ (n : ℕ), n * α) '' (((i : ℕ) : finset ℕ) ⊆ (j : finset ℕ)), from by {
      use ((i : ℕ) : finset ℕ), rintro x ⟨h1, h2⟩,
      existsi (x - i),
      split; try { exact add_sub_cancel' h2 },
      simp [h1,h2],
      },
      }),

  have h0 : ∀ i j : ℕ, (set.fintype.card (set.range ((λ (n : ℕ), n * α))) ≤ ((j : ℕ) - (i : ℕ))) → (i * α - j * α) ≠ 0 , from (assume i j : ℕ, by {
    rw [set.card_range,set.card_le_iff_finite,set.fintype.finite_subset],
    intro h1, exact not_of_imp_not (h i j) h1,
  }),

  have h1 : ∀ i j : ℕ, (set.fintype.card (set.range ((λ (n : ℕ), n * α))) ≤ ((j : ℕ) - (i : ℕ))) → (j * α - i * α) ≠ 0 ,
  from (assume i j : ℕ, by {
    rw [← neg_eq_zero, ← sub_eq_add_neg],
    apply h0,
  }),

  let seq_limit : (ℕ → ℝ) → ℝ → Prop := λ (u : ℕ → ℝ) (l : ℝ), ∀ ε > 0, ∃ N, ∀ n > N, |u n - l| < ε in
  have h2 : seq_limit (λ n : ℕ, n * α) 0, from (assume (b : ℝ) h,
  show ∃ (N : ℕ), ∀ (n : ℕ), N < n → |(n : ℕ) * α - b| < b, from by {
    cases classical.em (b = 0) with h3 h3,
    use (0 : ℕ),
    assume n h4,
    use (abs (n * α)), rw [h3, abs_zero], linarith,
    use (⌊abs b⌋ : ℕ),
    rintro n h5,
    rw [← sub_eq_add_neg, ← abs_of_nonneg],
    apply lt_of_le_of_lt,
    rw [← abs_of_nonneg],
    apply lt_of_le_of_lt,
    apply abs_nonneg (n * α),
    calc abs (n * α) ≤ (n : ℕ) * (abs b) : abs_mul_le_mul_abs
    ... ≤ (⌊abs b⌋ : ℕ) * (abs b) : mul_le_mul_right _ h5
    ... < abs b + 1 : mul_lt_mul_of_pos_left _ (lt_add_one _)
    ... = abs b : by simp,
  }),

  have h3 : ∀ x y : ℝ, x ∈ set.range (λ n : ℕ, n * α) → y ∈ set.range (λ n : ℕ, n * α) → x ≠ y → x - y ≠ 0 ∧ y - x ≠ 0, from (assume (x y : ℝ) h4 h5 h6, by {
    cases h4 with i h4, cases h5 with j h5,
    split,
    apply h0 i j, exact h4,
    apply h1 j i, exact h5,
  }),

  have h4 : ∀ x y : ℝ, x ∈ set.range (λ n : ℕ, n * α) → y ∈ set.range (λ n : ℕ, n * α) → x ≠ y → abs (x - y) ≠ 0, from (assume (x y : ℝ) h5 h6 h7, by {
    cases h5 with i h5, cases h6 with j h6,
    have h8 : ∀ x y : ℝ, x ≠ y ∧ y ≠ x → abs x ≠ 0 ∧ abs y ≠ 0, from (assume (x y : ℝ) h9, by {
      split,
      intro h10,
      cases h9.1,
      symmetry at h10, exact h10 h10,
      intro h11,
      cases h9.2,
      symmetry at h11, exact h11 h11,
    }),
    apply h8, split,
    apply h0 i j, exact h5,
    apply h1 j i, exact h6,
  }),

  have h5 : ∀ x y : ℝ, x ∈ set.range (λ n : ℕ, n * α) → y ∈ set.range (λ n : ℕ, n * α) → x ≠ y → abs (x - y) ≠ 0 ∧ abs (y - x) ≠ 0, from (assume (x y : ℝ) h7 h8 h9, by {
    cases h7 with i h7, cases h8 with j h8,
    split,
    apply h0 i j, exact h7,
    apply h1 j i, exact h8,
  }),

  have h6 : ∀ x y : ℝ, x ∈ set.range (λ n : ℕ, n * α) → y ∈ set.range (λ n : ℕ, n * α) → x ≠ y → abs (x - y) ≈ abs (y - x), from (assume (x y : ℝ) h7 h8 h9, by {
    cases h7 with i h7, cases h8 with j h8,
    show abs (x - y) ≈ abs (y - x), from by {
      have h10 : x - y ≠ 0 ∧ y - x ≠ 0, from by {
        apply h5, apply h7, apply h8, exact h9,
      },
      apply abs_abs_sub,
      split; exact h10.1,
    }
  }),

  have h7 : ∀ (x y : ℝ) (ε : ℝ), x ∈ set.range (λ n : ℕ, n * α) → y ∈ set.range (λ n : ℕ, n * α) → x ≠ y → ε > 0 → abs (x - y) < ε → abs (y - x) < ε, from (assume (x y : ℝ) (ε : ℝ) h7 h8 h9 h10 h11, by {
    cases h7 with i h7, cases h8 with j h8,
    cases h6 x y _ _ h9 with h12 h13,
    have h14 : abs (x - y) ≈ abs (y - x), from h12,
    have h15 : abs (y - x) ≈ abs (x - y), from h13,
    have h16 : abs ((x - y) + (y - x)) = abs (x - y
end --Needs more than 2000 tokens!

--OUTPUT 3
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=irrational_orbit_dense (α : ℝ) (hα : ¬(is_irrat α)) :
∀ (ε : ℝ) (hε : ε > 0), ∃ N : ℤ, ∀ (x : ℤ), (N*x)%Z ∈ ℤ → x ∈ ℤ → ε > (abs (α*x%Z - IZR (N*x)%Z)) ∧ ε ≥ (abs (α*x%Z - IZR (N*x)%Z)) :=
begin
  intros ε hε, have h1 : (∃ (l : ℤ), ε > IZR l),
  from exists_rat_btwn ε (by norm_num : (0:ℝ) < ε),
  cases h1 with l hl,
  let N := l+1, use N,
  intros x x_int hx_int,
  have h1 := abs_lt_of_lt_sub_left hl,
  have h2 : abs (α * x - IZR (N * x)) = abs (α * x - IZR (N * x - 1)),
  from begin
    rw sub_succ, rw sub_self,
    have h2 : (0:ℝ) < abs (α * x), { rw [mul_comm α x, ← abs_mul], exact abs_pos_iff.mpr (mul_self_pos α⁻¹) },
    have h3 : (0:ℝ) < ε + 1, simpa [add_comm, hε],
    have h4 := by linarith,
    have h5 := abs_mul_le_iff α x ε h2,
    have h6 := abs_mul_le_iff α x (ε + 1) h3,
    have h7 : abs (α * x) ≤ (ε + 1) * abs x,
    from by linarith,
    show abs ((α * x - IZR (N * x)) - (-1)) ≤ abs (α * x - IZR (N * x - 1)),
    from by linarith,
  end,
  have h3 : IZR (N*x)%Z ∈ {a | ∃ (b : ℤ), a = IZR b},
  from begin
    refine (exists_int_of_int_pos _).mpr _,
    exact (mul_self_pos N).mpr (pos_of_ne_zero (by linarith)),
  end,
  have h4 : IZR (N*x)%Z <= α * x ∧ (α * x) < IZR (N*x)%Z + 1,
  from by {
    rw mul_comm α x,have h4 := rat_btwn_of_abs_lt (by linarith) h3 (by linarith),
    refine ⟨le_of_lt h4.left, h4.right⟩,
  },
  let y := α * x - IZR (N*x)%Z,
  have h5 : IZR (N*x)%Z ≤ α * x ∧ y < 1,
  from by linarith,
  have h6 : abs y < IZR (N*x)%Z,
  from abs_lt_of_lt_sub_left h5,
  have h7 : abs y < N*x,
  from by linarith,
  have h8 := by linarith,
  have h9 := by linarith,
  split; linarith,
end

--OUTPUT 4
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_of_irrational_orbit {α : Type*} (α : ℝ) (h : ¬ (α ∈ ℚ)) : ∀ x ∈ set.range (λ n : ℤ, (n : ℝ) * α), x ∈ Ioo 0 1 :=
begin
  -- Let $\alpha$ be an irrational number.
  assume A : set α,
  assume h2 : ¬ ∀ (x : ℝ), ∃ (n : ℤ), x = n * α,
  assume (x : α) (hx : x ∈ set.range (λ (n : ℤ), (n : ℝ) * α)),

  -- Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$.
  have h3 : ∀ (i j : ℤ), ¬ (i ≠ j ∧ ((λ (n : ℤ), fractional_part (n * α)) i = (λ (n : ℤ), fractional_part (n * α)) j)),
  from assume (i j : ℤ) (h3 : i ≠ j ∧ ((λ (n : ℤ), fractional_part (n * α)) i = (λ (n : ℤ), fractional_part (n * α)) j)),

  --If this were not true, then $$ i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor, $$Using floor of real number

  begin
  have h4 : ∀ (n : ℤ), fractional_part (n * α) = (n * α) - (floor (n * α)), from
  begin
    assume n,
    have nat_lt_add_of_pos_left : ∀ a b : ℝ, 0 < a → a < b + a, from assume (a b : ℝ) (h_pos : 0 < a), by linarith,
    have nat_lt_add_of_pos_right : ∀ a b : ℝ, 0 < b → a < b + a, from assume (a b : ℝ) (h_pos : 0 < b), by linarith,
    have nat_le_add_of_le_left : ∀ a b : ℝ, a ≤ b → a ≤ b + a, from assume (a b : ℝ) (h_le : a ≤ b), by linarith,
    have nat_le_add_of_le_right : ∀ a b : ℝ, b ≤ a → b ≤ a + b, from assume (a b : ℝ) (h_le : b ≤ a), by linarith,
    have nat_add_le_of_le_add : ∀ a b c : ℝ, a ≤ b → a + c ≤ b + c, from assume (a b c : ℝ) (h_le : a ≤ b), by linarith,
    calc
      (fractional_part (n * α)) = (n * α) - (n * α) ∩ (nat) : (fractional_part_nat_eq_sub _ _)
      ... = (n * α) - (n * α) ∩ (Ioc 0 1) : by {congr, rw @interval_nat, }
      ... = (n * α) - (n * α) ∩ (Icc 0 1) : le_antisymm (by {apply nat_le_add_of_le_left, rw mul_pos (nat_le_add_of_le_right _ _ (by linarith)), exact h_pos *α, })
      (le_floor (n * α)) : by {rw (floor_eq_of_nat_le _ _ h_le), rw (floor_eq_of_nat_le _ _ (by {apply nat_le_add_of_le_left, rw mul_pos (nat_le_add_of_le_right _ _ (by linarith)), exact h_pos *α, })), reflexivity}
      ... = (n * α) - floor (n * α) :
      (set.inter_eq_self_of_subset (set.inter_subset_inter (set.preimage_subset_preimage_iff.mp $
      (show (λ (x : ℝ), _) ⁻¹' _ ⊆ (λ (x : ℝ), _) ⁻¹' _, from dec_trivial)) show (λ (x : ℝ), _) ⁻¹' _ ⊆ (λ (x : ℝ), _) ⁻¹' _, from dec_trivial) rfl)
      ... = (n * α) - floor ((n * α) + (1 : ℝ)) : by {rw (add_sub_cancel'.mp ((nat_add_le_of_le_add _ _ _ (by {apply nat_le_add_of_le_left, rw mul_pos (nat_le_add_of_le_right _ _ (by linarith)), exact h_pos *α, }))).symm), reflexivity}
      ... = (n * α) - floor ((n * α) + (1 : ℝ)) : by {rw (add_sub_cancel'.mp ((nat_add_le_of_le_add _ _ _ (by {apply nat_le_add_of_le_left, rw mul_pos (nat_le_add_of_le_right _ _ (by linarith)), exact h_pos *α, }))).symm), reflexivity}
      ... = (n * α) - ((n * α) + ((n * α) + (1 : ℝ) - (n * α))) : by {rw (sub_add_cancel' (n * α)), reflexivity}
      ... = (n * α) - ((n * α) + ((n * α) + (1 : ℝ) - (n * α))) : by {rw (sub_add_cancel' (n * α)), reflexivity}
      ... = (n * α) - ((n * α) + 1) : by {rw add_sub_cancel', reflexivity}
      ... = (n * α) - 1 - (n * α) : by {rw nat_sub_sub_cancel', reflexivity}
      ... = -1 : by {rw ← nat_sub_sub_eq_sub_sub_sub},
  end,

  --which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$.
  by_contradiction h3c,
  have h4 : rational_distinct.to_real α = (real.floor (i * α) - real.floor (j * α)) / (i - j) := (fractional_part_eq_sub.mp h3.left).right,
  have h5 : rational_distinct.to_real α = (real.floor (i * α) - real.floor (j * α)) / (i - j) := by rw ← h4,
  have h6 : (α : ℝ) = (real.floor (i * α) - real.floor (j * α)) / (i - j) := by rw ← h5,
  have h7 : (α : ℝ) = (real.floor (i * α) - real.floor (j * α)) / (i - j) := by rw ← h6,
  have h8 : (α : ℝ) = ((i : ℝ) * α - real.floor (j * α)) / (i - j) := by {rw [←mul_assoc, ←mul_sub_right_distrib], apply nat_sub_sub_eq_sub_sub_sub },
  have h9 : (α : ℝ) = (i * α - real.floor (j * α)) / (i - j) := by rw ← h8,
  have h10 : (α : ℝ) = ((i : ℝ) * α - real.floor (
end --Needs more than 2000 tokens!

--OUTPUT 5
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_of_irrational_orbit : ∀ {α : Type u} [inhabited α] [linear_order α] [total_order α] [preorder α] [linear_ordered_ring α] (irra : α) (below : α) (above : α),
  irra ≠ 0 → ∃ i : ℤ, ∃ j : ℤ, i ≠ j ∧ irra * i ≠ irra * j :=
begin
  assume (α : Type u) [inhabited α] [linear_order α] [total_order α] [preorder α] [linear_ordered_ring α] (irra : α) (below : α) (above : α) (h_irra_not_zero : irra ≠ 0),

  cases exists_ne_zero_and_ne_zero_of_mul_eq_zero (irra * irra) with i h_irra_and_i,
  cases h_irra_and_i with h_irra_not_zero h_irra_not_zero_and_i,
  cases h_irra_not_zero_and_i with h_i_not_zero h_irra_neq_i,

  use irra * i + 1,
  use irra * i,
  split,
    show irra * (irra * i + 1) ≠ irra * irra * i, from by {
      rw ← mul_assoc,
      rw ← mul_assoc irra irra i,
      ring,
      simp [h_irra_not_zero, h_i_not_zero, h_irra_neq_i],
    },
    show irra * i ≠ irra * irra * i, from by {
      rw ← mul_assoc irra irra i,
      ring,
      simp [h_irra_not_zero, h_i_not_zero, h_irra_neq_i],
    },
end

--OUTPUT 6
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_irrational_orbit (x : ℝ) (h1 : irrational x) :
∀ a b ∈ ℕ, a ≠ b → (int.fract a * x) ≠ (int.fract b * x) :=
begin
  assume b c hb hc,
  assume h2 : (int.fract b * x) = (int.fract c * x),
  --By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$.
  have h3 : ∃ x, ∀ ε > 0, ∃ c, ∃ c', c ≠ c' ∧ |x - c| < ε ∧ |x - c'| < ε, from classical.by_contradiction $
  assume H : ∀ x : ℝ, ¬ (∀ (ε : ℝ) (hp : 0 < ε), ∃ (c c' : ℝ), c ≠ c' ∧ |x - c| < ε ∧ |x - c'| < ε),
    have H₂ : ∀ x : ℝ, ∀ (ε : ℝ) (hp : 0 < ε), ∃ (c : ℝ), ∀ (c' : ℝ), |c - c'| ≥ ε ∨ c' = c,
    from begin
        assume x ε hp,
        obtain ⟨ε₁, h_ε₁⟩ : (0 < ε / 2), from rat.exists_pos_half ε hp,
        cases H x ⟨ε₁, h_ε₁⟩ with c Hc,
        use c,
        intros c' hc',
        cases (Hc c' (hc'.elim not_le_of_gt h_ε₁)),
        exact (show ε / 2 < ε, by exact lt_of_lt_of_le h_ε₁ (le_of_lt hp)),
        exact ‹c ≠ c'›,
    end,
    have H₃ : ∀ x : ℝ, ∀ (ε : ℝ) (hp : 0 < ε), ∃ (c : ℝ), ∀ (c' : ℝ), |c' - c| ≥ ε ∨ c' = c,
    from begin
        assume x ε hp,
        obtain ⟨c, hc⟩ : ∃ (c : ℝ), ∀ (c' : ℝ), |c - c'| ≥ ε ∨ c' = c, from H₂ x ε hp,
        use c,
        intro c',
        cases hc c' with h h,
        use h,
        exact h,
    end,
    have H₄ : ∀ x : ℝ, ∀ (ε : ℝ) (hp : 0 < ε), ∃ (c : ℝ), ∃ (c' : ℝ), c ≠ c' ∧ |x - c| < ε ∧ |x - c'| < ε,
    from begin
        assume x ε hp,
        obtain ⟨c, hc⟩ : ∃ (c : ℝ), ∀ (c' : ℝ), |c' - c| ≥ ε ∨ c' = c, from H₃ x ε hp,
        obtain ⟨c'₁, hc'₁⟩ : c' ≠ c, from not_iff_not_of_iff hc,
        obtain ⟨c'₂, hc'₂⟩ : c' ≠ c, from not_iff_not_of_iff hc,
        have h_c'₁_c'₂ : c'₁ ≠ c'₂ := not_iff_not_of_iff (hc c'₁) c'₂ hc'₁,
        have h_c_c'₁ : c'₁ ≠ c := not_iff_not_of_iff (hc c'₂) c'₁ hc'₂,
        use c'₁, use c'₂,
        split,
        exact h_c'₁_c'₂,
        split,
        exact lt_of_not_ge h_c_c'₁,
        exact lt_of_not_ge h_c'₁_c'₂,
    end,
    obtain ⟨c, hc⟩ : ∃ (c : ℝ), ∃ (c' : ℝ), c ≠ c' ∧ 0 < c ∧ 0 < c', from H₄ 0 1 (by norm_num),
    obtain ⟨c', hc'⟩ : ∃ (c' : ℝ), c ≠ c' ∧ 0 < c' ∧ 0 < c', from H₄ 0 c.val (show 0 < c.val, from hc.right.left),
    obtain ⟨h₁, h₂⟩ : c ≠ c' ∧ 0 < c' ∧ 0 < c, from hc',
    obtain ⟨h₃, h₄⟩ : c ≠ c' ∧ 0 < c ∧ 0 < c', from hc,
    have hc_hc' : c < c' ∨ c' < c, from or_iff_not_imp_left.mp h₁,
    obtain ⟨ε, h_ε⟩ : 0 < c - c' ∨ 0 < c' - c, from (by linarith) hc_hc',
    obtain ⟨ε₁, h_ε₁⟩ : 0 < ε ∨ 0 < ε, from lt_or_lt_of_le_or_le h_ε,
    cases ε with ε,
    cases ε_property with ne ne,
    exact absurd ne dec_trivial,
    cases ε_property with ne ne,
    exact absurd ne dec_trivial,
    have h₅ : ε = ε₁, from sub_eq_zero.mp (ε_property (lt_of_le_of_lt h_ε₁ h_ε₂)),
    have H₆ : ∀ (x : ℝ) (h₁ : x ≠ 0), ¬ (∃ (c c' : ℝ), c ≠ c' ∧ 0 < c ∧ 0 < c'), from
    by {
      assume x h₁ h₂,
      obtain ⟨c, hc⟩ : ∃ (c : ℝ), c ≠ 0 ∧ 0 < c, from (exists_ne_zero_and_lt 0).mp h₂,
      obtain ⟨c', hc'⟩ : ∃ (c' : ℝ), c ≠ c' ∧ 0 < c, from hc,
      obtain ⟨h_hc', h_hc⟩ : c ≠ c' ∧ 0 < c, from hc',
      have h' : c ≠ c', from (eq_of_mul_eq_mul_right h₁).mp h_hc.right,
      exact absurd h_hc'.left h',
    },
    obtain ⟨c, hc⟩ : ∃ (c : ℝ), c ≠ 0 ∧ 0 < c, from H₆ ε h_ε₁,
    obtain ⟨h_hc, hc'⟩ : c ≠ 0 ∧ 0 < c, from hc,
    have hc₁ : 0 < ε, from ‹0 < c›,
    have H₇ : ∃ (c c' : ℝ), c ≠ c' ∧ 0 < c ∧ 0 < c', from H₆ ε h_hc,
    have h₈ : ∃ (c c' : ℝ), c ≠ c' ∧ 0 < c ∧ 0 < c
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 :=irrational_orbit (α : ℝ) (hαirr : irrational α) : ∃ N : ℤ, ∀ (n : ℕ), ∃ i ∈ {i : ℤ | ∃ N : ℕ, i = N * N} , |i*α - (n : ℕ)| < 1/2^(n+1) := sorry

/--`theorem`
A Closure Property
Let $\struct {G, \circ}$ be a group.

Let $A$ be a subset of $G$.

Suppose that $\forall a, b \in A: a \circ b \in A$.

Then $A$ is a subgroup of $G$.

`proof`
From $a \circ b^{-1} \in A$ for all $a, b \in A$ we have:
:$\forall a : A: a^{-1} \in A$

Hence $A$ is a submonoid.

From $a, a^{-1} \in A$ for all $a \in A$ we have:
:$\forall a: A: a = a^{-1}^{-1}$

Hence $A$ is a group.
{{qed}}
-/
theorem closure_property_group {G : Type*} [group G] (A : set G) (h1 : ∀ a b ∈ A, a * b ∈ A) : is_subgroup A :=
begin
  -- Group has Latin Square Property
  have h2 : ∀ a b : G, ∃! x : G, a * x = b, from by {
    assume a b : G, use a⁻¹ * b, obviously, },
  have h3 : ∀ a b : G, ∃! y : G, y * a = b, from by {
    assume a b : G, use b * a⁻¹, obviously, },

  -- From $a \circ b^{-1} \in A$ for all $a, b \in A$ we have $\forall a : A: a^{-1} \in A$
  have h4 : ∀ a ∈ A, a⁻¹ ∈ A, from assume (a : G) (h0 : a ∈ A),
  have h5 : (a⁻¹*a) ∈ A, from h1 a⁻¹ a h0,
  have h6 : ∃! x : G, a * x = a⁻¹ * a, from h2 a (a⁻¹ * a),
  have h7 : a⁻¹ = classical.some (h6).exists, from exists_unique.unique (h6)
    (classical.some_spec (exists_unique.exists (h6)))
    (classical.some_spec (exists_unique.exists (h6))),
  show a⁻¹ ∈ A, from h4 a h5,

  -- Hence $A$ is a submonoid.
  have h8 : is_submonoid A, from {one_mem := by rw [← one_inv, h4 (1 : G) (set.one_mem A)],
    mul_mem := assume a b h9 h10, show a * b ∈ A,
    from h1 a b (h9) (h10)},

  -- From $a, a^{-1} \in A$ for all $a \in A$ we have $\forall a: A: a = a^{-1}^{-1}$
  have h9 : ∀ a : G, a⁻¹⁻¹ = a, from assume (a : G) (h10 : a ∈ A), by {
    have h11 : a⁻¹ ∈ A, from h4 a h10,
    have h12 : ∃! x : G, x * a⁻¹ = a⁻¹, from h3 a⁻¹ (a⁻¹),
    have h13 : a⁻¹⁻¹ = classical.some (h12).exists, from exists_unique.unique (h12)
      (classical.some_spec (exists_unique.exists (h12)))
      (classical.some_spec (exists_unique.exists (h12))),
    rw h13},

  -- Hence $A$ is a group.
  exact is_subgroup.mk h8 h9
end

--OUTPUT 8
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=irrational_orbit_density (α : ℝ) (hα : irrational α) :
∀ y : ℝ, ∃ (x : ℝ) (N : ℤ), 0 ≤ x ∧ x ≤ 1 ∧ N*x ≤ y ∧ y < (N+1)*x :=
begin
  assume (y : ℝ),
  -- there are infinitely many distinct multiples of $\alpha$
  have h : ∀ n : ℤ, n ≠ 0 → ∃ m : ℤ, m ≠ n, from by {
    assume n,
    assume hn : n ≠ 0,
    by_contra h,
    have h' : n = 0, from ne_of_gt (abs_pos_of_ne_zero) h,
    contradiction,
  },

  have h2 : ∀ m n : ℤ, m ≠ n → m*α ≠ n*α, from by {
    assume m n,
    assume hmn : m ≠ n,
    assume hmn2 : m*α = n*α,
    have h1 : (m-n)*α = 0, from calc
      (m-n)*α = m*α - n*α : by ring
              ... = 0 : by exact hmn2,
    -- we cannot have that $(m-n)*\alpha$ = 0, because $\alpha$ is irrational
    have h2 : (m-n) = 0, from mul_eq_zero.mp h1,
    have h3 : m = n, from eq_of_sub_eq_zero h2,
    contradiction,
  },

  have h3 : ∀ m n : ℤ, m ≠ n → ¬(⟨m*α,1⟩ = ⟨n*α,1⟩), from by {
    assume m n,
    assume hmn : m ≠ n,
    assume hmn2 : ⟨m*α,1⟩ = ⟨n*α,1⟩,
    have h2 : m*α = n*α, from (rat.num_denom m*α).symm.trans hmn2,
    contradiction,
  },

  have h4 : ∀ m n : ℤ, m ≠ n → ∀ N : ℕ, ¬(⟨m*α,1⟩ = ⟨n*α,1⟩ + ⟨(m-n)*α,1⟩/2^N), from by {
    assume m n,
    assume hmn : m ≠ n,
    assume N,
    assume hmn2 : ⟨m*α,1⟩ = ⟨n*α,1⟩ + ⟨(m-n)*α,1⟩/2^N,
    have h1 : ⟨m*α,1⟩ = ⟨n*α,1⟩ + 0,
    from rat.add_eq_of_eq_of_eq_of_eq_zero_of_le (rat.add_le_add_iff_right.mp (rat.num_denom _).mp) (by ring) (by refl),
    have h2 : ⟨m*α,1⟩ = ⟨n*α,1⟩, from eq_of_sub_eq_zero (by linarith),
    have h3 : m*α = n*α, from (rat.num_denom _).symm.trans h2,
    exact hmn h3,
  },

  -- there are infinitely many distinct pairs of multiples of $\alpha$
  have h5 : ∀ n : ℤ, n ≠ 0 → ∃ m k : ℤ, m ≠ n ∧ k ≠ n, from by {
    assume n,
    assume hn : n ≠ 0,
    cases h n hn with m hm,
    cases h m (ne.symm hm) with k hk,
    use [m,k],
    rw ← hk,
    repeat {split};
    show m ≠ n, from hm,
    show k ≠ n, from hn,
  },

  -- 0 is a limit point of the orbit
  have h6 : (∀ ε > 0, ∃ n : ℤ, n ≠ 0 ∧ ((nat.floor(n*ε))/n) ≤ 0 ∧ (0 ≤ ((nat.floor(n*α*n))/n))), from by {
    assume ε,
    assume hε : ε > 0,
    cases h5 1 (by linarith) with m hm,
    cases h5 1 (by linarith) with k hk,
    use [m,k],
    split,
    exact hm.left,
    rw ← div_mul_cancel,
    swap,
    {
      by_contra h,
      rw [← hm.right, ← hk.right] at h,
      cases h,
    },
    rw [← add_le_add, ← add_le_add],
    have h2 : ∀ n : ℤ, n ≠ 0 → 0 ≤ nat.floor(n*α*n), from by {
      assume n,
      assume hn : n ≠ 0,
      by_contra h,
      have h3 : n*α*n = 0, from mul_eq_zero.mp (by linarith),
      have h4 : n = 0, from eq_zero_of_mul_self_right (rat.num_denom n*α*n) (by linarith),
      contradiction,
    },
    split,
    {
      exact h2 m hm.left,
    },
    {
      exact h2 k hk.left,
    }
  },

  -- let's find $N$ such that $N*x ≤ y$ and such that $y < (N+1)*x$
  have h7 : ∃ N : ℤ,  N*(⟨1,1⟩/2^(nat.floor(2^1*ε) + 1)) ≤ ⟨y,1⟩ ∧
         ⟨y,1⟩ < (N+1)*(⟨1,1⟩/2^(nat.floor(2^1*ε) + 1)) ∧
         ∀ (p q : ℤ), q ≠ 0 → p ≠ N → p ≠ N+1 →
            ¬((⟨p*α,1⟩ ≤ ⟨y,1⟩ + ⟨1/2^(nat.floor(2^1*ε) + 1),1⟩) ∧
            (⟨y,1⟩ + ⟨1/2^(nat.floor(2^1*ε) + 1),1⟩ < ⟨q*α,1⟩)) :=
  begin
    have h8 : ∃ m n : ℤ, m ≠ n, from h5 1 (by linarith),
    cases h8 with m h8,
    cases h8 with n hn,
    use [m,n],
    split,
    {
      cases lt_or_le.mp (lt_add_one m) with hm hm,
      {
        have h9 := h6 (1/2^(nat.floor(2^1*ε) + 1)),
        cases h9 (by linarith) with k hk,
        cases hk with hk hk,
        cases hk with hk₁ hk₂,
        cases hk₂ with hk₂ hk₄,
        cases hk₄ with hk₄ hk₅,

        have h20 : n*α ≠ k*α, from h2 n k hn.left,
        have h21 : m*α ≠ k*α, from h2 m k hn.right,
        have h22 : m*α ≠ n*α, from hn.left,
        have h23 : k*α ≠ n*α, from h2 k n hk₁,
        have h24 : k*
end --Needs more than 2000 tokens!

--OUTPUT 9
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_of_irrational_orbit {α : Type*} [linear_ordered_field α] :
∀ (α : α), α ≠ 0 → ∀ s : set α, s ⊆ (λ i : ℤ, i * α) '' range ℤ → ∃ i : ℤ, i * α ∈ s :=
begin
  assume (α : α) H s h1,
  cases (exists_nat_gt (0 : α)) with N hN,
  have h2 : ∀ m n : ℤ, m ≠ n → (m : α) * α - ⌊(m : α) * α⌋ ≠ (n : α) * α - ⌊(n : α) * α⌋,
  {
    assume m n hmneq,
    have h3 : m * α - ⌊m * α⌋ = n * α - ⌊n * α⌋ → m * α - ⌊m * α⌋ = 0,
    {
      assume h mneq,
      rw [← sub_eq_zero, ← sub_eq_zero, ← sub_eq_zero, ← h, int.cast_sub, int.cast_sub, int.cast_sub, sub_eq_zero],
    },
    have h4 : (m : α) - (n : α) = 0 → ((m : α) * α - ⌊(m : α) * α⌋) - ((n : α) * α - ⌊(n : α) * α⌋) = 0,
    {
      assume h,
      have h5 : (m : α) * α - ⌊(m : α) * α⌋ = (n : α) * α - ⌊(n : α) * α⌋ ↔ (m : α) = (n : α),
      {
        rw [eq_comm, ← eq_comm (⌊(m : α) * α⌋), ← eq_comm (⌊(n : α) * α⌋), ← sub_eq_zero, ← sub_eq_zero, ← sub_eq_zero, ← h, int.cast_sub, int.cast_sub, int.cast_sub, sub_eq_zero],
        split,
        assume h6,
        linarith,
        assume h7,
        linarith,
      },
      rw [← h5],
      have h8 : m - n = 0, from int.cast_inj h7,
      have h9 : m * α - ⌊m * α⌋ = n * α - ⌊n * α⌋, from h5.mp h7,
      simp [h8, h9],
    },
    have h6 : (m : α) - (n : α) = 0 ↔ m = n, from eq_comm (m - n) 0,
    have h7 : m ≠ n ↔ (m : α) - (n : α) ≠ 0, from eq_comm (m : α) (n : α),
    exact h7.mp (mt h4.mpr (h6.mp h7.mpr mneq)),
  },
  have h3 : ∀ m n : ℤ, m ≠ n → (λ (i : ℤ), i * α - ⌊i * α⌋) m ≠ (λ (i : ℤ), i * α - ⌊i * α⌋) n,
  {
    assume m n hmneq,
    have h4 : (λ i : ℤ, i * α) m ≠ (λ i : ℤ, i * α) n,
    {
      rw [← eq_comm (m * α) (n * α), ← eq_comm (m : α) (n : α), ← int.cast_inj hmneq, int.cast_mul, int.cast_mul],
      exact hmneq,
    },
    have h5 : (λ i : ℤ, (i - ⌊i * α⌋) * α) m ≠ (λ i : ℤ, (i - ⌊i * α⌋) * α) n,
    {
      rw [← int.cast_add, int.cast_mul, int.cast_mul, int.cast_add, int.cast_comm m, int.cast_comm n],
      exact h4,
    },
    exact h5,
  },
  have h4 : (λ (i : ℤ), i * α - ⌊i * α⌋) '' range ℤ = (λ (i : ℤ), i * α) '' range ℤ,
  {
    simp,
  },
  have h5 : (λ i : ℤ, i * α - ⌊i * α⌋) '' range ℤ = (λ i : ℤ, i * α) '' range ℤ,
  {
    rw ← h4,
  },
  have h6 : (λ i : ℤ, i * α - ⌊i * α⌋) '' range ℤ ⊆ s,
  {
    rw h5,
    from set.image_subset h1,
  },
  have h7 : ∃ i : ℤ, (λ i : ℤ, i * α - ⌊i * α⌋) i ∈ s,
  {
    rw [h5],
    from set.exists_mem_image s,
  },
  cases h7 with i hi,
  use i,
  show (λ i : ℤ, i * α) i ∈ s,
  {
    simp,
    exact hi,
  },
end

--OUTPUT 10
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=density_of_irrational_orbit {α : Type*} [decidable_eq α] [linear_order α] [decidable_linear_order α] [add_comm_group α] [order_bot α] [densely_ordered α] [∀ a b c : α, (a ≤ b) ∧ (b ≤ c) → (a ≤ c)] [∀ a b : α, a ≤ b ∨ b ≤ a] {β : Type*} [comm_ring β] [decidable_eq β] [inhabited β] [∀ a b c : β, (a ≤ b) ∧ (b ≤ c) → (a ≤ c)] [∀ a b : β, a ≤ b ∨ b ≤ a] {γ : Type*} [no_zero_divisors β] [inhabited γ] [add_comm_group γ] [decidable_eq γ] [order_bot γ] [∀ a b c : γ, (a ≤ b) ∧ (b ≤ c) → (a ≤ c)] [∀ a b : γ, a ≤ b ∨ b ≤ a] {δ : Type*} [add_comm_group δ] [decidable_eq δ] [has_zero δ] {δ₀ : Type*} [add_comm_group δ₀] [decidable_eq δ₀] [has_zero δ₀] [has_one δ₀] [is_submonoid δ₀] {δ₁ : Type*} [add_comm_group δ₁] [decidable_eq δ₁] [has_one δ₁] [is_submonoid δ₁] [∀ a b : δ₁, a ≤ b ∨ b ≤ a] {δ₂ : Type*} [add_comm_group δ₂] [decidable_eq δ₂] [add_comm_monoid δ₂] [has_one δ₂] {δ₃ : Type*} [add_comm_group δ₃] [decidable_eq δ₃] [add_comm_monoid δ₃] [has_one δ₃] [has_inv δ₃] [is_submonoid δ₃] {δ₄ : Type*} [add_comm_group δ₄] [decidable_eq δ₄] [add_comm_monoid δ₄] [has_one δ₄] [has_inv δ₄] [is_submonoid δ₄] {δ₅ : Type*} [add_comm_group δ₅] [decidable_eq δ₅] [add_comm_monoid δ₅] [has_one δ₅] [has_inv δ₅] {δ₆ : Type*} [add_comm_group δ₆] [decidable_eq δ₆] [add_comm_monoid δ₆] [has_one δ₆] [has_inv δ₆] {δ₇ : Type*} [add_comm_group δ₇] [decidable_eq δ₇] [add_comm_monoid δ₇] [has_one δ₇] [has_inv δ₇] {δ₈ : Type*} [add_comm_group δ₈] [decidable_eq δ₈] [add_comm_monoid δ₈] [has_one δ₈] [has_inv δ₈] {δ₉ : Type*} [add_comm_group δ₉] [decidable_eq δ₉] [add_comm_monoid δ₉] [has_one δ₉] [has_inv δ₉] {η : Type*} [decidable_eq η] [linear_order η] [dedekind_order η] {η₀ : Type*} [add_comm_group η₀] [decidable_eq η₀] {η₁ : Type*} [add_comm_group η₁] [decidable_eq η₁] {η₂ : Type*} [add_comm_group η₂] [decidable_eq η₂] {η₃ : Type*} [add_comm_group η₃] [decidable_eq η₃] {η₄ : Type*} [add_comm_group η₄] [decidable_eq η₄] {η₅ : Type*} [add_comm_group η₅] [decidable_eq η₅] {η₆ : Type*} [add_comm_group η₆] [decidable_eq η₆] {η₇ : Type*} [add_comm_group η₇] [decidable_eq η₇] {η₈ : Type*} [add_comm_group η₈] [decidable_eq η₈] {η₉ : Type*} [add_comm_group η₉] [decidable_eq η₉] {θ : Type*} [add_comm_group θ] [order_bot θ] [decidable_eq θ] [∀ a b : θ, a ≤ b ∨ b ≤ a] {θ₀ : Type*} [add_comm_group θ₀] [order_bot θ₀] [decidable_eq θ₀] [∀ a b : θ₀, a ≤ b ∨ b ≤ a] {θ₁ : Type*} [add_comm_group θ₁] [order_bot θ₁] [decidable_eq θ₁] [∀ a b : θ₁, a ≤ b ∨ b ≤ a] {θ₂ : Type*} [add_comm_group θ₂] [order_bot θ₂] [decidable_eq θ₂] [∀ a b : θ₂, a ≤ b ∨ b ≤ a] {θ₃ : Type*} [add_comm_group θ₃] [order_bot θ₃] [decidable_eq θ₃] [∀ a b : θ₃, a ≤ b ∨ b ≤ a] {θ₄ : Type*} [add_comm_group θ₄] [order_bot θ₄] [decidable_eq θ₄] [∀ a b : θ₄, a ≤ b ∨ b ≤ a] {θ₅ : Type*} [add_comm_group θ₅] [order_bot θ₅] [decidable_eq θ₅] [∀ a b : θ₅, a ≤ b ∨ b ≤ a] {θ₆ : Type*} [add_comm_group θ₆] [order_bot θ₆] [decidable_eq θ₆] [∀ a b : θ₆, a ≤ b ∨ b ≤ a] {θ₇ : Type*} [add_comm_group θ₇] [order_bot θ₇] [decidable_eq θ₇] [∀ a b : θ₇, a ≤ b ∨ b ≤ a] {θ₈ : Type*} [add_comm_group θ₈] [order_bot θ₈] [decidable_eq θ₈] [∀ a b : θ₈, a ≤ b ∨ b ≤ a] {θ₉ : Type*} [add_comm_group θ₉] [order_bot θ₉] [decidable_
end --Needs more than 2000 tokens!

/- 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 {split,apply set.subset_of_mem_powerset,exact hA,apply set.subset_of_mem_powerset,exact hB},
  -- Then $(A ∩ B) ⊆ A$, by intersection of set is a subset
  have h2 : (A ∩ B) ⊆ A, from by apply set.inter_subset_left,
  -- Then $(A ∩ B) ⊆ S$, by subset relation is transitive
  have h3 : (A ∩ B) ⊆ S, from by {apply set.subset.trans h2 h1.left},
  -- Hence $(A ∩ B) ∈  𝒫 S$, by power set definition
  show (A ∩ B) ∈  𝒫 S, from by {apply set.mem_powerset h3},
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 rw sq
  -- distributive property of multiplication over addition gives:
  ... = x*(x+y) + y*(x+y) : by rw add_mul
  -- applying the above property further gives:
  ... = x*x + x*y + y*x + y*y : by {rw [mul_comm x (x+y),mul_comm y (x+y)], rw [add_mul,add_mul], ring}
  -- rearranging the terms using commutativity and adding gives:
  ... = x^2 + 2*x*y + y^2 : by {repeat {rw ← sq}, rw mul_comm y x, 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 {
    assume a b : G, use a⁻¹ * b, obviously, },
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by {
    assume a b : G, use b * a⁻¹, obviously, },

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

  -- 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 assume a :G,
    exists_unique.unique (h3 a) (classical.some_spec (exists_unique.exists (h3 a)))
    (mul_one a),
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from assume a : G,
    exists_unique.unique (h4 a) (classical.some_spec (exists_unique.exists (h4 a))) (one_mul a),

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (hident : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a).exists, from assume (a : G),
        exists_unique.unique (h3 a) (hident a).right
        (classical.some_spec (exists_unique.exists (h3 a))),
      have h9 : ∀ a : G, e = classical.some (h4 a).exists, from assume (a : G),
        exists_unique.unique (h4 a) (hident a).left
        (classical.some_spec (exists_unique.exists (h4 a))),
      show e = (1 : G), from eq.trans (h9 e) (h6 _),
    },
    exact ⟨by obviously, h7⟩,
  }
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
  {
    intro x0,
    have h6 : |x0 - l| < ε ↔ ((x0 - l) < ε) ∧ ((l - x0) < ε),
    from abs_sub_lt_iff, rw h6,
    split,
    rintro ⟨ S_1, S_2 ⟩,
    split; linarith,
    rintro ⟨ S_3, S_4 ⟩,
    split; 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 {
    assume n h,
    split,
    exact lt_of_le_of_lt (le_max_left N1 N2) h,
    exact lt_of_le_of_lt (le_max_right N1 N2) h,
  },

  --$\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 {
    intros n h12,
    split,
    {

      have h13 := (h8 n (h10 n h12).left), rw h5 (y n) at h13,
      split,
      exact h13.left,
      exact (h4 n).left,
    },
    {
      have h14 := (h9 n (h10 n h12).right),rw h5 (z n) at h14,
      split,
      exact (h4 n).right,
      exact h14.right,
    },

  },

  --$\forall n > N: l - \epsilon < x_n < l + \epsilon$
  have h15 : ∀ n > N, ((l - ε) < (x n)) ∧ ((x n) < (l+ε)),
  from by {
    intros n1 h16, cases (h11 n1 h16);
    split; linarith,
  },

  --So $\forall n > N: \size {x_n - l} < \epsilon$
  --Hence the result
  show  ∀ (n : ℕ), n > N → |x n - l| < ε,
  from by {
    intros n h17,
    cases h5 (x n) with h18 h19,
    apply h19, exact h15 n h17,
  },
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)-/


/-
Copyright (c) 2022 Joseph Hua. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Bhavik Mehta, Johan Commelin, Reid Barton, Rob Lewis, Joseph Hua
-/
import category_theory.limits.final
import category_theory.functor.reflects_isomorphisms

/-!
# Algebras of endofunctors
This file defines algebras of an endofunctor,
and provides the category instance for them.
This extends to Eilenberg-Moore (co)algebras for a (co)monad.
It also defines the forgetful functor from the category of algebras.
It is shown that the structure map of the initial algebra of an endofunctor
is an isomorphism.
-/

universes v u

namespace category_theory
namespace endofunctor

variables {C : Type u} [category.{v} C]

/-- An algebra of an endofunctor; `str` stands for "structure morphism" -/
structure algebra (F : C ⥤ C) :=
(A : C)
(str : F.obj A ⟶ A)

instance [inhabited C] : inhabited (algebra (𝟭 C)) := ⟨⟨ default , 𝟙 _ ⟩⟩

namespace algebra

variables {F : C ⥤ C} (A : algebra F) {A₀ A₁ A₂ : algebra F}

/-
```
        str
   F A₀ -----> A₀
    |          |
F f |          | f
    V          V
   F A₁ -----> A₁
        str
```
-/
/-- A morphism between algebras of endofunctor `F` -/
@[ext] structure hom (A₀ A₁ : algebra F) :=
(f : A₀.1 ⟶ A₁.1)
(h' : F.map f ≫ A₁.str = A₀.str ≫ f . obviously)

restate_axiom hom.h'
attribute [simp, reassoc] hom.h
namespace hom

/-- The identity morphism of an algebra of endofunctor `F` -/
def id : hom A A := { f := 𝟙 _ }

instance : inhabited (hom A A) := ⟨{ f := 𝟙 _ }⟩

/-- The composition of morphisms between algebras of endofunctor `F` -/
def comp (f : hom A₀ A₁) (g : hom A₁ A₂) : hom A₀ A₂ := { f := f.1 ≫ g.1 }

end hom

instance (F : C ⥤ C) : category_struct (algebra F) :=
{ hom := hom,
  id := hom.id,
  comp := @hom.comp _ _ _ }

@[simp] lemma id_eq_id : algebra.hom.id A = 𝟙 A := rfl

@[simp] lemma id_f : (𝟙 _ : A ⟶ A).1 = 𝟙 A.1 := rfl

variables {A₀ A₁ A₂} (f : A₀ ⟶ A₁) (g : A₁ ⟶ A₂)

@[simp] lemma comp_eq_comp : algebra.hom.comp f g = f ≫ g := rfl

@[simp] lemma comp_f : (f ≫ g).1 = f.1 ≫ g.1 := rfl

/-- Algebras of an endofunctor `F` form a category -/
instance (F : C ⥤ C) : category (algebra F) := {}

/--
To construct an isomorphism of algebras, it suffices to give an isomorphism of the As which
commutes with the structure morphisms.
-/
@[simps]
def iso_mk (h : A₀.1 ≅ A₁.1) (w : F.map h.hom ≫ A₁.str = A₀.str ≫ h.hom) : A₀ ≅ A₁ :=
{ hom := { f := h.hom },
  inv :=
  { f := h.inv,
    h' := by { rw [h.eq_comp_inv, category.assoc, ←w, ←functor.map_comp_assoc], simp } } }

/-- The forgetful functor from the category of algebras, forgetting the algebraic structure. -/
@[simps] def forget (F : C ⥤ C) : algebra F ⥤ C :=
{ obj := λ A, A.1,
  map := λ A B f, f.1 }

/-- An algebra morphism with an underlying isomorphism hom in `C` is an algebra isomorphism. -/
lemma iso_of_iso (f : A₀ ⟶ A₁) [is_iso f.1] : is_iso f :=
⟨⟨{ f := inv f.1,
    h' := by { rw [is_iso.eq_comp_inv f.1, category.assoc, ← f.h], simp } }, by tidy⟩⟩

instance forget_reflects_iso : reflects_isomorphisms (forget F) :=
{ reflects := λ A B, iso_of_iso }

instance forget_faithful : faithful (forget F) := {}

/--
From a natural transformation `α : G → F` we get a functor from
algebras of `F` to algebras of `G`.
-/
@[simps]
def functor_of_nat_trans {F G : C ⥤ C} (α : G ⟶ F) : algebra F ⥤ algebra G :=
{ obj := λ A,
  { A := A.1,
    str := α.app A.1 ≫ A.str },
  map := λ A₀ A₁ f,
  { f := f.1 } }

/-- The identity transformation induces the identity endofunctor on the category of algebras. -/
@[simps {rhs_md := semireducible}]
def functor_of_nat_trans_id :
  functor_of_nat_trans (𝟙 F) ≅ 𝟭 _ :=
nat_iso.of_components
  (λ X, iso_mk (iso.refl _) (by { dsimp, simp, }))
  (λ X Y f, by { ext, dsimp, simp })

/-- A composition of natural transformations gives the composition of corresponding functors. -/
@[simps {rhs_md := semireducible}]
def functor_of_nat_trans_comp {F₀ F₁ F₂ : C ⥤ C} (α : F₀ ⟶ F₁) (β : F₁ ⟶ F₂) :
  functor_of_nat_trans (α ≫ β) ≅
    functor_of_nat_trans β ⋙ functor_of_nat_trans α :=
nat_iso.of_components
  (λ X, iso_mk (iso.refl _) (by { dsimp, simp }))
  (λ X Y f, by { ext, dsimp, simp })

/--
If `α` and `β` are two equal natural transformations, then the functors of algebras induced by them
are isomorphic.
We define it like this as opposed to using `eq_to_iso` so that the components are nicer to prove
lemmas about.
-/
@[simps {rhs_md := semireducible}]
def functor_of_nat_trans_eq {F G : C ⥤ C} {α β : F ⟶ G} (h : α = β) :
  functor_of_nat_trans α ≅ functor_of_nat_trans β :=
nat_iso.of_components
  (λ X, iso_mk (iso.refl _) (by { dsimp, simp [h] }))
  (λ X Y f, by { ext, dsimp, simp })

/--
Naturally isomorphic endofunctors give equivalent categories of algebras.
Furthermore, they are equivalent as categories over `C`, that is,
we have `equiv_of_nat_iso h ⋙ forget = forget`.
-/
@[simps]
def equiv_of_nat_iso {F G : C ⥤ C} (α : F ≅ G) :
  algebra F ≌ algebra G :=
{ functor := functor_of_nat_trans α.inv,
  inverse := functor_of_nat_trans α.hom,
  unit_iso :=
    functor_of_nat_trans_id.symm ≪≫
    functor_of_nat_trans_eq (by simp) ≪≫
    functor_of_nat_trans_comp _ _,
  counit_iso :=
    (functor_of_nat_trans_comp _ _).symm ≪≫
    functor_of_nat_trans_eq (by simp) ≪≫
    functor_of_nat_trans_id }.

namespace initial

variables {A} (h : limits.is_initial A)

/-- The inverse of the structure map of an initial algebra -/
@[simp] def str_inv : A.1 ⟶ F.obj A.1 := (h.to ⟨ F.obj A.1 , F.map A.str ⟩).1

lemma left_inv' : (⟨str_inv h ≫ A.str⟩ : A ⟶ A) = 𝟙 A :=
limits.is_initial.hom_ext h _ (𝟙 A)

lemma left_inv : str_inv h ≫ A.str = 𝟙 _ := congr_arg hom.f (left_inv' h)

lemma right_inv : A.str ≫ str_inv h = 𝟙 _ :=
by { rw [str_inv, ← (h.to ⟨ F.obj A.1 , F.map A.str ⟩).h,
  ← F.map_id, ← F.map_comp], congr, exact (left_inv h) }

/--
The structure map of the inital algebra is an isomorphism,
hence endofunctors preserve their initial algebras
-/

end initial
end algebra
end endofunctor
end category_theory


/-
Copyright (c) 2021 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import data.finset.locally_finite

/-!
# Intervals as multisets

This file provides basic results about all the `multiset.Ixx`, which are defined in
`order.locally_finite`.
-/

variables {α : Type*}

namespace multiset
section preorder
variables [preorder α] [locally_finite_order α] {a b c : α}

lemma nodup_Icc : (Icc a b).nodup := finset.nodup _
lemma nodup_Ico : (Ico a b).nodup := finset.nodup _
lemma nodup_Ioc : (Ioc a b).nodup := finset.nodup _
lemma nodup_Ioo : (Ioo a b).nodup := finset.nodup _

@[simp] lemma Icc_eq_zero_iff : Icc a b = 0 ↔ ¬a ≤ b :=
by rw [Icc, finset.val_eq_zero, finset.Icc_eq_empty_iff]

@[simp] lemma Ico_eq_zero_iff : Ico a b = 0 ↔ ¬a < b :=
by rw [Ico, finset.val_eq_zero, finset.Ico_eq_empty_iff]

@[simp] lemma Ioc_eq_zero_iff : Ioc a b = 0 ↔ ¬a < b :=
by rw [Ioc, finset.val_eq_zero, finset.Ioc_eq_empty_iff]

@[simp] lemma Ioo_eq_zero_iff [densely_ordered α] : Ioo a b = 0 ↔ ¬a < b :=
by rw [Ioo, finset.val_eq_zero, finset.Ioo_eq_empty_iff]

alias Icc_eq_zero_iff ↔ _ Icc_eq_zero
alias Ico_eq_zero_iff ↔ _ Ico_eq_zero
alias Ioc_eq_zero_iff ↔ _ Ioc_eq_zero

@[simp] lemma Ioo_eq_zero (h : ¬a < b) : Ioo a b = 0 :=
eq_zero_iff_forall_not_mem.2 $ λ x hx, h ((mem_Ioo.1 hx).1.trans (mem_Ioo.1 hx).2)

@[simp] lemma Icc_eq_zero_of_lt (h : b < a) : Icc a b = 0 := Icc_eq_zero h.not_le
@[simp] lemma Ico_eq_zero_of_le (h : b ≤ a) : Ico a b = 0 := Ico_eq_zero h.not_lt
@[simp] lemma Ioc_eq_zero_of_le (h : b ≤ a) : Ioc a b = 0 := Ioc_eq_zero h.not_lt
@[simp] lemma Ioo_eq_zero_of_le (h : b ≤ a) : Ioo a b = 0 := Ioo_eq_zero h.not_lt

variables (a)

@[simp] lemma Ico_self : Ico a a = 0 := by rw [Ico, finset.Ico_self, finset.empty_val]
@[simp] lemma Ioc_self : Ioc a a = 0 := by rw [Ioc, finset.Ioc_self, finset.empty_val]
@[simp] lemma Ioo_self : Ioo a a = 0 := by rw [Ioo, finset.Ioo_self, finset.empty_val]

variables {a b c}

lemma left_mem_Icc : a ∈ Icc a b ↔ a ≤ b := finset.left_mem_Icc
lemma left_mem_Ico : a ∈ Ico a b ↔ a < b := finset.left_mem_Ico
lemma right_mem_Icc : b ∈ Icc a b ↔ a ≤ b := finset.right_mem_Icc
lemma right_mem_Ioc : b ∈ Ioc a b ↔ a < b := finset.right_mem_Ioc

@[simp] lemma left_not_mem_Ioc : a ∉ Ioc a b := finset.left_not_mem_Ioc
@[simp] lemma left_not_mem_Ioo : a ∉ Ioo a b := finset.left_not_mem_Ioo
@[simp] lemma right_not_mem_Ico : b ∉ Ico a b := finset.right_not_mem_Ico
@[simp] lemma right_not_mem_Ioo : b ∉ Ioo a b := finset.right_not_mem_Ioo

lemma Ico_filter_lt_of_le_left [decidable_pred (< c)] (hca : c ≤ a) :
  (Ico a b).filter (λ x, x < c) = ∅ :=
by { rw [Ico, ←finset.filter_val, finset.Ico_filter_lt_of_le_left hca], refl }

lemma Ico_filter_lt_of_right_le [decidable_pred (< c)] (hbc : b ≤ c) :
  (Ico a b).filter (λ x, x < c) = Ico a b :=
by rw [Ico, ←finset.filter_val, finset.Ico_filter_lt_of_right_le hbc]

lemma Ico_filter_lt_of_le_right [decidable_pred (< c)] (hcb : c ≤ b) :
  (Ico a b).filter (λ x, x < c) = Ico a c :=
by { rw [Ico, ←finset.filter_val, finset.Ico_filter_lt_of_le_right hcb], refl }

lemma Ico_filter_le_of_le_left [decidable_pred ((≤) c)] (hca : c ≤ a) :
  (Ico a b).filter (λ x, c ≤ x) = Ico a b :=
by rw [Ico, ←finset.filter_val, finset.Ico_filter_le_of_le_left hca]

lemma Ico_filter_le_of_right_le [decidable_pred ((≤) b)] :
  (Ico a b).filter (λ x, b ≤ x) = ∅ :=
by { rw [Ico, ←finset.filter_val, finset.Ico_filter_le_of_right_le], refl }

lemma Ico_filter_le_of_left_le [decidable_pred ((≤) c)] (hac : a ≤ c) :
  (Ico a b).filter (λ x, c ≤ x) = Ico c b :=
by { rw [Ico, ←finset.filter_val, finset.Ico_filter_le_of_left_le hac], refl }

end preorder

section partial_order
variables [partial_order α] [locally_finite_order α] {a b : α}

@[simp] lemma Icc_self (a : α) : Icc a a = {a} := by rw [Icc, finset.Icc_self, finset.singleton_val]

lemma Ico_cons_right (h : a ≤ b) : b ::ₘ (Ico a b) = Icc a b :=
by { classical,
  rw [Ico, ←finset.insert_val_of_not_mem right_not_mem_Ico, finset.Ico_insert_right h], refl }

lemma Ioo_cons_left (h : a < b) : a ::ₘ (Ioo a b) = Ico a b :=
by { classical,
  rw [Ioo, ←finset.insert_val_of_not_mem left_not_mem_Ioo, finset.Ioo_insert_left h], refl }

lemma Ico_disjoint_Ico {a b c d : α} (h : b ≤ c) : (Ico a b).disjoint (Ico c d) :=
λ x hab hbc, by { rw mem_Ico at hab hbc, exact hab.2.not_le (h.trans hbc.1) }

@[simp] lemma Ico_inter_Ico_of_le [decidable_eq α] {a b c d : α} (h : b ≤ c) :
  Ico a b ∩ Ico c d = 0 :=
multiset.inter_eq_zero_iff_disjoint.2 $ Ico_disjoint_Ico h

lemma Ico_filter_le_left {a b : α} [decidable_pred (≤ a)] (hab : a < b) :
  (Ico a b).filter (λ x, x ≤ a) = {a} :=
by { rw [Ico, ←finset.filter_val, finset.Ico_filter_le_left hab], refl }

lemma card_Ico_eq_card_Icc_sub_one (a b : α) : (Ico a b).card = (Icc a b).card - 1 :=
finset.card_Ico_eq_card_Icc_sub_one _ _

lemma card_Ioc_eq_card_Icc_sub_one (a b : α) : (Ioc a b).card = (Icc a b).card - 1 :=
finset.card_Ioc_eq_card_Icc_sub_one _ _

lemma card_Ioo_eq_card_Ico_sub_one (a b : α) : (Ioo a b).card = (Ico a b).card - 1 :=
finset.card_Ioo_eq_card_Ico_sub_one _ _

lemma card_Ioo_eq_card_Icc_sub_two (a b : α) : (Ioo a b).card = (Icc a b).card - 2 :=
finset.card_Ioo_eq_card_Icc_sub_two _ _

end partial_order

section linear_order
variables [linear_order α] [locally_finite_order α] {a b c d : α}

lemma Ico_subset_Ico_iff {a₁ b₁ a₂ b₂ : α} (h : a₁ < b₁) :
  Ico a₁ b₁ ⊆ Ico a₂ b₂ ↔ a₂ ≤ a₁ ∧ b₁ ≤ b₂ :=
finset.Ico_subset_Ico_iff h

lemma Ico_add_Ico_eq_Ico {a b c : α} (hab : a ≤ b) (hbc : b ≤ c) :
  Ico a b + Ico b c = Ico a c :=
by rw [add_eq_union_iff_disjoint.2 (Ico_disjoint_Ico le_rfl), Ico, Ico, Ico, ←finset.union_val,
  finset.Ico_union_Ico_eq_Ico hab hbc]

lemma Ico_inter_Ico : Ico a b ∩ Ico c d = Ico (max a c) (min b d) :=
by rw [Ico, Ico, Ico, ←finset.inter_val, finset.Ico_inter_Ico]

@[simp] lemma Ico_filter_lt (a b c : α) : (Ico a b).filter (λ x, x < c) = Ico a (min b c) :=
by rw [Ico, Ico, ←finset.filter_val, finset.Ico_filter_lt]

@[simp] lemma Ico_filter_le (a b c : α) : (Ico a b).filter (λ x, c ≤ x) = Ico (max a c) b :=
by rw [Ico, Ico, ←finset.filter_val, finset.Ico_filter_le]

@[simp] lemma Ico_sub_Ico_left (a b c : α) : Ico a b - Ico a c = Ico (max a c) b :=
by rw [Ico, Ico, Ico, ←finset.sdiff_val, finset.Ico_diff_Ico_left]

@[simp] lemma Ico_sub_Ico_right (a b c : α) : Ico a b - Ico c b = Ico a (min b c) :=
by rw [Ico, Ico, Ico, ←finset.sdiff_val, finset.Ico_diff_Ico_right]

end linear_order

section ordered_cancel_add_comm_monoid
variables [ordered_cancel_add_comm_monoid α] [has_exists_add_of_le α] [locally_finite_order α]

lemma map_add_left_Icc (a b c : α) : (Icc a b).map ((+) c) = Icc (c + a) (c + b) :=
by { classical, rw [Icc, Icc, ←finset.image_add_left_Icc, finset.image_val,
    ((finset.nodup _).map $ add_right_injective c).dedup] }

lemma map_add_left_Ico (a b c : α) : (Ico a b).map ((+) c) = Ico (c + a) (c + b) :=
by { classical, rw [Ico, Ico, ←finset.image_add_left_Ico, finset.image_val,
    ((finset.nodup _).map $ add_right_injective c).dedup] }

lemma map_add_left_Ioc (a b c : α) : (Ioc a b).map ((+) c) = Ioc (c + a) (c + b) :=
by { classical, rw [Ioc, Ioc, ←finset.image_add_left_Ioc, finset.image_val,
    ((finset.nodup _).map $ add_right_injective c).dedup] }

lemma map_add_left_Ioo (a b c : α) : (Ioo a b).map ((+) c) = Ioo (c + a) (c + b) :=
by { classical, rw [Ioo, Ioo, ←finset.image_add_left_Ioo, finset.image_val,
    ((finset.nodup _).map $ add_right_injective c).dedup] }

lemma map_add_right_Icc (a b c : α) : (Icc a b).map (λ x, x + c) = Icc (a + c) (b + c) :=
by { simp_rw add_comm _ c, exact map_add_left_Icc _ _ _ }

lemma map_add_right_Ico (a b c : α) : (Ico a b).map (λ x, x + c) = Ico (a + c) (b + c) :=
by { simp_rw add_comm _ c, exact map_add_left_Ico _ _ _ }

lemma map_add_right_Ioc (a b c : α) : (Ioc a b).map (λ x, x + c) = Ioc (a + c) (b + c) :=
by { simp_rw add_comm _ c, exact map_add_left_Ioc _ _ _ }

lemma map_add_right_Ioo (a b c : α) : (Ioo a b).map (λ x, x + c) = Ioo (a + c) (b + c) :=
by { simp_rw add_comm _ c, exact map_add_left_Ioo _ _ _ }

end ordered_cancel_add_comm_monoid
end multiset


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

! This file was ported from Lean 3 source module algebra.order.archimedean
! leanprover-community/mathlib commit 6f413f3f7330b94c92a5a27488fdc74e6d483a78
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Int.LeastGreatest
import Mathlib.Data.Rat.Floor
import Mathlib.Algebra.Order.Field.Power

/-!
# Archimedean groups and fields.

This file defines the archimedean property for ordered groups and proves several results connected
to this notion. Being archimedean means that for all elements `x` and `y>0` there exists a natural
number `n` such that `x ≤ n • y`.

## Main definitions

* `Archimedean` is a typeclass for an ordered additive commutative monoid to have the archimedean
  property.
* `Archimedean.floorRing` defines a floor function on an archimedean linearly ordered ring making
  it into a `floorRing`.

## Main statements

* `ℕ`, `ℤ`, and `ℚ` are archimedean.
-/

open Int Set

variable {α : Type _}

/-- An ordered additive commutative monoid is called `Archimedean` if for any two elements `x`, `y`
such that `0 < y`, there exists a natural number `n` such that `x ≤ n • y`. -/
class Archimedean (α) [OrderedAddCommMonoid α] : Prop where
  /-- For any two elements `x`, `y` such that `0 < y`, there exists a natural number `n`
  such that `x ≤ n • y`. -/
  arch : ∀ (x : α) {y : α}, 0 < y → ∃ n : ℕ, x ≤ n • y
#align archimedean Archimedean

instance OrderDual.archimedean [OrderedAddCommGroup α] [Archimedean α] : Archimedean αᵒᵈ :=
  ⟨fun x y hy =>
    let ⟨n, hn⟩ := Archimedean.arch (-ofDual x) (neg_pos.2 hy)
    ⟨n, by rwa [neg_nsmul, neg_le_neg_iff] at hn⟩⟩
#align order_dual.archimedean OrderDual.archimedean

section LinearOrderedAddCommGroup

variable [LinearOrderedAddCommGroup α] [Archimedean α]

/-- An archimedean decidable linearly ordered `AddCommGroup` has a version of the floor: for
`a > 0`, any `g` in the group lies between some two consecutive multiples of `a`. -/
theorem existsUnique_zsmul_near_of_pos {a : α} (ha : 0 < a) (g : α) :
    ∃! k : ℤ, k • a ≤ g ∧ g < (k + 1) • a := by
  let s : Set ℤ := { n : ℤ | n • a ≤ g }
  obtain ⟨k, hk : -g ≤ k • a⟩ := Archimedean.arch (-g) ha
  have h_ne : s.Nonempty := ⟨-k, by simpa using neg_le_neg hk⟩
  obtain ⟨k, hk⟩ := Archimedean.arch g ha
  have h_bdd : ∀ n ∈ s, n ≤ (k : ℤ) := by
    intro n hn
    apply (zsmul_le_zsmul_iff ha).mp
    rw [← coe_nat_zsmul] at hk
    exact le_trans hn hk
  obtain ⟨m, hm, hm'⟩ := Int.exists_greatest_of_bdd ⟨k, h_bdd⟩ h_ne
  have hm'' : g < (m + 1) • a := by
    contrapose! hm'
    exact ⟨m + 1, hm', lt_add_one _⟩
  refine' ⟨m, ⟨hm, hm''⟩, fun n hn => (hm' n hn.1).antisymm <| Int.le_of_lt_add_one _⟩
  rw [← zsmul_lt_zsmul_iff ha]
  exact lt_of_le_of_lt hm hn.2
#align exists_unique_zsmul_near_of_pos existsUnique_zsmul_near_of_pos

theorem existsUnique_zsmul_near_of_pos' {a : α} (ha : 0 < a) (g : α) :
    ∃! k : ℤ, 0 ≤ g - k • a ∧ g - k • a < a := by
  simpa only [sub_nonneg, add_zsmul, one_zsmul, sub_lt_iff_lt_add'] using
    existsUnique_zsmul_near_of_pos ha g
#align exists_unique_zsmul_near_of_pos' existsUnique_zsmul_near_of_pos'

theorem existsUnique_sub_zsmul_mem_Ico {a : α} (ha : 0 < a) (b c : α) :
    ∃! m : ℤ, b - m • a ∈ Set.Ico c (c + a) := by
  simpa only [mem_Ico, le_sub_iff_add_le, zero_add, add_comm c, sub_lt_iff_lt_add', add_assoc] using
    existsUnique_zsmul_near_of_pos' ha (b - c)
#align exists_unique_sub_zsmul_mem_Ico existsUnique_sub_zsmul_mem_Ico

theorem existsUnique_add_zsmul_mem_Ico {a : α} (ha : 0 < a) (b c : α) :
    ∃! m : ℤ, b + m • a ∈ Set.Ico c (c + a) :=
  (Equiv.neg ℤ).bijective.existsUnique_iff.2 <| by
    simpa only [Equiv.neg_apply, mem_Ico, neg_zsmul, ← sub_eq_add_neg, le_sub_iff_add_le, zero_add,
      add_comm c, sub_lt_iff_lt_add', add_assoc] using existsUnique_zsmul_near_of_pos' ha (b - c)
#align exists_unique_add_zsmul_mem_Ico existsUnique_add_zsmul_mem_Ico

theorem existsUnique_add_zsmul_mem_Ioc {a : α} (ha : 0 < a) (b c : α) :
    ∃! m : ℤ, b + m • a ∈ Set.Ioc c (c + a) :=
  (Equiv.addRight (1 : ℤ)).bijective.existsUnique_iff.2 <| by
    simpa only [add_zsmul, sub_lt_iff_lt_add', le_sub_iff_add_le', ← add_assoc, and_comm, mem_Ioc,
      Equiv.coe_addRight, one_zsmul, add_le_add_iff_right] using
      existsUnique_zsmul_near_of_pos ha (c - b)
#align exists_unique_add_zsmul_mem_Ioc existsUnique_add_zsmul_mem_Ioc

theorem existsUnique_sub_zsmul_mem_Ioc {a : α} (ha : 0 < a) (b c : α) :
    ∃! m : ℤ, b - m • a ∈ Set.Ioc c (c + a) :=
  (Equiv.neg ℤ).bijective.existsUnique_iff.2 <| by
    simpa only [Equiv.neg_apply, neg_zsmul, sub_neg_eq_add] using
      existsUnique_add_zsmul_mem_Ioc ha b c
#align exists_unique_sub_zsmul_mem_Ioc existsUnique_sub_zsmul_mem_Ioc

end LinearOrderedAddCommGroup

theorem exists_nat_gt [StrictOrderedSemiring α] [Archimedean α] (x : α) : ∃ n : ℕ, x < n :=
  let ⟨n, h⟩ := Archimedean.arch x zero_lt_one
  ⟨n + 1, lt_of_le_of_lt (by rwa [← nsmul_one]) (Nat.cast_lt.2 (Nat.lt_succ_self _))⟩
#align exists_nat_gt exists_nat_gt

theorem exists_nat_ge [StrictOrderedSemiring α] [Archimedean α] (x : α) : ∃ n : ℕ, x ≤ n := by
  nontriviality α
  exact (exists_nat_gt x).imp fun n => le_of_lt
#align exists_nat_ge exists_nat_ge

theorem add_one_pow_unbounded_of_pos [StrictOrderedSemiring α] [Archimedean α] (x : α) {y : α}
    (hy : 0 < y) : ∃ n : ℕ, x < (y + 1) ^ n :=
  have : 0 ≤ 1 + y := add_nonneg zero_le_one hy.le
  let ⟨n, h⟩ := Archimedean.arch x hy
  ⟨n,
    calc
      x ≤ n • y := h
      _ = n * y := nsmul_eq_mul _ _
      _ < 1 + n * y := lt_one_add _
      _ ≤ (1 + y) ^ n :=
        one_add_mul_le_pow' (mul_nonneg hy.le hy.le) (mul_nonneg this this)
          (add_nonneg zero_le_two hy.le) _
      _ = (y + 1) ^ n := by rw [add_comm]
      ⟩
#align add_one_pow_unbounded_of_pos add_one_pow_unbounded_of_pos

section StrictOrderedRing

variable [StrictOrderedRing α] [Archimedean α]

theorem pow_unbounded_of_one_lt (x : α) {y : α} (hy1 : 1 < y) : ∃ n : ℕ, x < y ^ n :=
  sub_add_cancel y 1 ▸ add_one_pow_unbounded_of_pos _ (sub_pos.2 hy1)
#align pow_unbounded_of_one_lt pow_unbounded_of_one_lt

theorem exists_int_gt (x : α) : ∃ n : ℤ, x < n :=
  let ⟨n, h⟩ := exists_nat_gt x
  ⟨n, by rwa [Int.cast_ofNat]⟩
#align exists_int_gt exists_int_gt

theorem exists_int_lt (x : α) : ∃ n : ℤ, (n : α) < x :=
  let ⟨n, h⟩ := exists_int_gt (-x)
  ⟨-n, by rw [Int.cast_neg]; exact neg_lt.1 h⟩
#align exists_int_lt exists_int_lt

theorem exists_floor (x : α) : ∃ fl : ℤ, ∀ z : ℤ, z ≤ fl ↔ (z : α) ≤ x := by
  haveI := Classical.propDecidable
  have : ∃ ub : ℤ, (ub : α) ≤ x ∧ ∀ z : ℤ, (z : α) ≤ x → z ≤ ub :=
    Int.exists_greatest_of_bdd
      (let ⟨n, hn⟩ := exists_int_gt x
      ⟨n, fun z h' => Int.cast_le.1 <| le_trans h' <| le_of_lt hn⟩)
      (let ⟨n, hn⟩ := exists_int_lt x
      ⟨n, le_of_lt hn⟩)
  refine' this.imp fun fl h z => _
  cases' h with h₁ h₂
  exact ⟨fun h => le_trans (Int.cast_le.2 h) h₁, h₂ z⟩
#align exists_floor exists_floor

end StrictOrderedRing

section LinearOrderedRing

variable [LinearOrderedRing α] [Archimedean α]

/-- Every x greater than or equal to 1 is between two successive
natural-number powers of every y greater than one. -/
theorem exists_nat_pow_near {x : α} {y : α} (hx : 1 ≤ x) (hy : 1 < y) :
    ∃ n : ℕ, y ^ n ≤ x ∧ x < y ^ (n + 1) := by
  have h : ∃ n : ℕ, x < y ^ n := pow_unbounded_of_one_lt _ hy
  classical exact
      let n := Nat.find h
      have hn : x < y ^ n := Nat.find_spec h
      have hnp : 0 < n :=
        pos_iff_ne_zero.2 fun hn0 => by rw [hn0, pow_zero] at hn; exact not_le_of_gt hn hx
      have hnsp : Nat.pred n + 1 = n := Nat.succ_pred_eq_of_pos hnp
      have hltn : Nat.pred n < n := Nat.pred_lt (ne_of_gt hnp)
      ⟨Nat.pred n, le_of_not_lt (Nat.find_min h hltn), by rwa [hnsp]⟩
#align exists_nat_pow_near exists_nat_pow_near

end LinearOrderedRing

section LinearOrderedField

variable [LinearOrderedField α] [Archimedean α] {x y ε : α}

/-- Every positive `x` is between two successive integer powers of
another `y` greater than one. This is the same as `exists_mem_Ioc_zpow`,
but with ≤ and < the other way around. -/
theorem exists_mem_Ico_zpow (hx : 0 < x) (hy : 1 < y) : ∃ n : ℤ, x ∈ Ico (y ^ n) (y ^ (n + 1)) := by
  classical exact
      let ⟨N, hN⟩ := pow_unbounded_of_one_lt x⁻¹ hy
      have he : ∃ m : ℤ, y ^ m ≤ x :=
        ⟨-N,
          le_of_lt
            (by
              rw [zpow_neg y ↑N, zpow_ofNat]
              exact (inv_lt hx (lt_trans (inv_pos.2 hx) hN)).1 hN)⟩
      let ⟨M, hM⟩ := pow_unbounded_of_one_lt x hy
      have hb : ∃ b : ℤ, ∀ m, y ^ m ≤ x → m ≤ b :=
        ⟨M, fun m hm =>
          le_of_not_lt fun hlt =>
            not_lt_of_ge (zpow_le_of_le hy.le hlt.le)
              (lt_of_le_of_lt hm (by rwa [← zpow_ofNat] at hM))⟩
      let ⟨n, hn₁, hn₂⟩ := Int.exists_greatest_of_bdd hb he
      ⟨n, hn₁, lt_of_not_ge fun hge => not_le_of_gt (Int.lt_succ _) (hn₂ _ hge)⟩
#align exists_mem_Ico_zpow exists_mem_Ico_zpow

/-- Every positive `x` is between two successive integer powers of
another `y` greater than one. This is the same as `exists_mem_Ico_zpow`,
but with ≤ and < the other way around. -/
theorem exists_mem_Ioc_zpow (hx : 0 < x) (hy : 1 < y) : ∃ n : ℤ, x ∈ Ioc (y ^ n) (y ^ (n + 1)) :=
  let ⟨m, hle, hlt⟩ := exists_mem_Ico_zpow (inv_pos.2 hx) hy
  have hyp : 0 < y := lt_trans zero_lt_one hy
  ⟨-(m + 1), by rwa [zpow_neg, inv_lt (zpow_pos_of_pos hyp _) hx], by
    rwa [neg_add, neg_add_cancel_right, zpow_neg, le_inv hx (zpow_pos_of_pos hyp _)]⟩
#align exists_mem_Ioc_zpow exists_mem_Ioc_zpow

/-- For any `y < 1` and any positive `x`, there exists `n : ℕ` with `y ^ n < x`. -/
theorem exists_pow_lt_of_lt_one (hx : 0 < x) (hy : y < 1) : ∃ n : ℕ, y ^ n < x := by
  by_cases y_pos : y ≤ 0
  · use 1
    simp only [pow_one]
    linarith
  rw [not_le] at y_pos
  rcases pow_unbounded_of_one_lt x⁻¹ (one_lt_inv y_pos hy) with ⟨q, hq⟩
  exact ⟨q, by rwa [inv_pow, inv_lt_inv hx (pow_pos y_pos _)] at hq⟩
#align exists_pow_lt_of_lt_one exists_pow_lt_of_lt_one

/-- Given `x` and `y` between `0` and `1`, `x` is between two successive powers of `y`.
This is the same as `exists_nat_pow_near`, but for elements between `0` and `1` -/
theorem exists_nat_pow_near_of_lt_one (xpos : 0 < x) (hx : x ≤ 1) (ypos : 0 < y) (hy : y < 1) :
    ∃ n : ℕ, y ^ (n + 1) < x ∧ x ≤ y ^ n := by
  rcases exists_nat_pow_near (one_le_inv_iff.2 ⟨xpos, hx⟩) (one_lt_inv_iff.2 ⟨ypos, hy⟩) with
    ⟨n, hn, h'n⟩
  refine' ⟨n, _, _⟩
  · rwa [inv_pow, inv_lt_inv xpos (pow_pos ypos _)] at h'n
  · rwa [inv_pow, inv_le_inv (pow_pos ypos _) xpos] at hn
#align exists_nat_pow_near_of_lt_one exists_nat_pow_near_of_lt_one

theorem exists_rat_gt (x : α) : ∃ q : ℚ, x < q :=
  let ⟨n, h⟩ := exists_nat_gt x
  ⟨n, by rwa [Rat.cast_coe_nat]⟩
#align exists_rat_gt exists_rat_gt

theorem exists_rat_lt (x : α) : ∃ q : ℚ, (q : α) < x :=
  let ⟨n, h⟩ := exists_int_lt x
  ⟨n, by rwa [Rat.cast_coe_int]⟩
#align exists_rat_lt exists_rat_lt

theorem exists_rat_btwn {x y : α} (h : x < y) : ∃ q : ℚ, x < q ∧ (q : α) < y := by
  cases' exists_nat_gt (y - x)⁻¹ with n nh
  cases' exists_floor (x * n) with z zh
  refine' ⟨(z + 1 : ℤ) / n, _⟩
  have n0' := (inv_pos.2 (sub_pos.2 h)).trans nh
  have n0 := Nat.cast_pos.1 n0'
  rw [Rat.cast_div_of_ne_zero, Rat.cast_coe_nat, Rat.cast_coe_int, div_lt_iff n0']
  refine' ⟨(lt_div_iff n0').2 <| (lt_iff_lt_of_le_iff_le (zh _)).1 (lt_add_one _), _⟩
  rw [Int.cast_add, Int.cast_one]
  refine' lt_of_le_of_lt (add_le_add_right ((zh _).1 le_rfl) _) _
  rwa [← lt_sub_iff_add_lt', ← sub_mul, ← div_lt_iff' (sub_pos.2 h), one_div]
  · rw [Rat.coe_int_den, Nat.cast_one]
    exact one_ne_zero
  · intro H
    rw [Rat.coe_nat_num, Int.cast_ofNat, Nat.cast_eq_zero] at H
    subst H
    cases n0
  · rw [Rat.coe_nat_den, Nat.cast_one]
    exact one_ne_zero
#align exists_rat_btwn exists_rat_btwn

theorem le_of_forall_rat_lt_imp_le (h : ∀ q : ℚ, (q : α) < x → (q : α) ≤ y) : x ≤ y :=
  le_of_not_lt fun hyx =>
    let ⟨_, hy, hx⟩ := exists_rat_btwn hyx
    hy.not_le <| h _ hx
#align le_of_forall_rat_lt_imp_le le_of_forall_rat_lt_imp_le

theorem le_of_forall_lt_rat_imp_le (h : ∀ q : ℚ, y < q → x ≤ q) : x ≤ y :=
  le_of_not_lt fun hyx =>
    let ⟨_, hy, hx⟩ := exists_rat_btwn hyx
    hx.not_le <| h _ hy
#align le_of_forall_lt_rat_imp_le le_of_forall_lt_rat_imp_le

theorem eq_of_forall_rat_lt_iff_lt (h : ∀ q : ℚ, (q : α) < x ↔ (q : α) < y) : x = y :=
  (le_of_forall_rat_lt_imp_le fun q hq => ((h q).1 hq).le).antisymm <|
    le_of_forall_rat_lt_imp_le fun q hq => ((h q).2 hq).le
#align eq_of_forall_rat_lt_iff_lt eq_of_forall_rat_lt_iff_lt

theorem eq_of_forall_lt_rat_iff_lt (h : ∀ q : ℚ, x < q ↔ y < q) : x = y :=
  (le_of_forall_lt_rat_imp_le fun q hq => ((h q).2 hq).le).antisymm <|
    le_of_forall_lt_rat_imp_le fun q hq => ((h q).1 hq).le
#align eq_of_forall_lt_rat_iff_lt eq_of_forall_lt_rat_iff_lt

theorem exists_nat_one_div_lt {ε : α} (hε : 0 < ε) : ∃ n : ℕ, 1 / (n + 1 : α) < ε := by
  cases' exists_nat_gt (1 / ε) with n hn
  use n
  rw [div_lt_iff, ← div_lt_iff' hε]
  · apply hn.trans
    simp [zero_lt_one]
  · exact n.cast_add_one_pos
#align exists_nat_one_div_lt exists_nat_one_div_lt

theorem exists_pos_rat_lt {x : α} (x0 : 0 < x) : ∃ q : ℚ, 0 < q ∧ (q : α) < x := by
  simpa only [Rat.cast_pos] using exists_rat_btwn x0
#align exists_pos_rat_lt exists_pos_rat_lt

theorem exists_rat_near (x : α) (ε0 : 0 < ε) : ∃ q : ℚ, |x - q| < ε :=
  let ⟨q, h₁, h₂⟩ :=
    exists_rat_btwn <| ((sub_lt_self_iff x).2 ε0).trans ((lt_add_iff_pos_left x).2 ε0)
  ⟨q, abs_sub_lt_iff.2 ⟨sub_lt_comm.1 h₁, sub_lt_iff_lt_add.2 h₂⟩⟩
#align exists_rat_near exists_rat_near

end LinearOrderedField

section LinearOrderedField

variable [LinearOrderedField α]

theorem archimedean_iff_nat_lt : Archimedean α ↔ ∀ x : α, ∃ n : ℕ, x < n :=
  ⟨@exists_nat_gt α _, fun H =>
    ⟨fun x y y0 =>
      (H (x / y)).imp fun n h => le_of_lt <| by rwa [div_lt_iff y0, ← nsmul_eq_mul] at h⟩⟩
#align archimedean_iff_nat_lt archimedean_iff_nat_lt

theorem archimedean_iff_nat_le : Archimedean α ↔ ∀ x : α, ∃ n : ℕ, x ≤ n :=
  archimedean_iff_nat_lt.trans
    ⟨fun H x => (H x).imp fun _ => le_of_lt, fun H x =>
      let ⟨n, h⟩ := H x
      ⟨n + 1, lt_of_le_of_lt h (Nat.cast_lt.2 (lt_add_one _))⟩⟩
#align archimedean_iff_nat_le archimedean_iff_nat_le

theorem archimedean_iff_int_lt : Archimedean α ↔ ∀ x : α, ∃ n : ℤ, x < n :=
  ⟨@exists_int_gt α _, by
    rw [archimedean_iff_nat_lt]
    intro h x
    obtain ⟨n, h⟩ := h x
    refine' ⟨n.toNat, h.trans_le _⟩
    exact_mod_cast Int.self_le_toNat _⟩
#align archimedean_iff_int_lt archimedean_iff_int_lt

theorem archimedean_iff_int_le : Archimedean α ↔ ∀ x : α, ∃ n : ℤ, x ≤ n :=
  archimedean_iff_int_lt.trans
    ⟨fun H x => (H x).imp fun _ => le_of_lt, fun H x =>
      let ⟨n, h⟩ := H x
      ⟨n + 1, lt_of_le_of_lt h (Int.cast_lt.2 (lt_add_one _))⟩⟩
#align archimedean_iff_int_le archimedean_iff_int_le

theorem archimedean_iff_rat_lt : Archimedean α ↔ ∀ x : α, ∃ q : ℚ, x < q :=
  ⟨@exists_rat_gt α _, fun H =>
    archimedean_iff_nat_lt.2 fun x =>
      let ⟨q, h⟩ := H x
      ⟨⌈q⌉₊,
        lt_of_lt_of_le h <| by
          simpa only [Rat.cast_coe_nat] using (@Rat.cast_le α _ _ _).2 (Nat.le_ceil _)⟩⟩
#align archimedean_iff_rat_lt archimedean_iff_rat_lt

theorem archimedean_iff_rat_le : Archimedean α ↔ ∀ x : α, ∃ q : ℚ, x ≤ q :=
  archimedean_iff_rat_lt.trans
    ⟨fun H x => (H x).imp fun _ => le_of_lt, fun H x =>
      let ⟨n, h⟩ := H x
      ⟨n + 1, lt_of_le_of_lt h (Rat.cast_lt.2 (lt_add_one _))⟩⟩
#align archimedean_iff_rat_le archimedean_iff_rat_le

end LinearOrderedField

instance : Archimedean ℕ :=
  ⟨fun n m m0 => ⟨n, by
    rw [← mul_one n, smul_eq_mul, mul_assoc, one_mul m]
    exact Nat.mul_le_mul_left n (by linarith)⟩⟩

instance : Archimedean ℤ :=
  ⟨fun n m m0 =>
    ⟨n.toNat,
      le_trans (Int.self_le_toNat _) <| by
        simpa only [nsmul_eq_mul, zero_add, mul_one] using
          mul_le_mul_of_nonneg_left (Int.add_one_le_iff.2 m0) (Int.ofNat_zero_le n.toNat)⟩⟩

instance : Archimedean ℚ :=
  archimedean_iff_rat_le.2 fun q => ⟨q, by rw [Rat.cast_id]⟩

/-- A linear ordered archimedean ring is a floor ring. This is not an `instance` because in some
cases we have a computable `floor` function. -/
noncomputable def Archimedean.floorRing (α) [LinearOrderedRing α] [Archimedean α] : FloorRing α :=
  FloorRing.ofFloor α (fun a => Classical.choose (exists_floor a)) fun z a =>
    (Classical.choose_spec (exists_floor a) z).symm
#align archimedean.floor_ring Archimedean.floorRing

-- see Note [lower instance priority]
/-- A linear ordered field that is a floor ring is archimedean. -/
instance (priority := 100) FloorRing.archimedean (α) [LinearOrderedField α] [FloorRing α] :
    Archimedean α := by
  rw [archimedean_iff_int_le]
  exact fun x => ⟨⌈x⌉, Int.le_ceil x⟩
#align floor_ring.archimedean FloorRing.archimedean


/-
Copyright (c) 2021 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen
-/
import algebra.big_operators.basic
import data.fintype.fin
/-!
# Big operators and `fin`

Some results about products and sums over the type `fin`.
-/

open_locale big_operators

open finset

namespace fin

-- `to_additive` version of `prod_filter_zero_lt`, can't be autogenerated because
-- of the `0` in the statement
lemma sum_filter_zero_lt {M : Type*} [add_comm_monoid M] {n : ℕ} {v : fin n.succ → M} :
  ∑ i in univ.filter (λ (i : fin n.succ), 0 < i), v i = ∑ (j : fin n), v j.succ :=
by rw [univ_filter_zero_lt, sum_map, rel_embedding.coe_fn_to_embedding, coe_succ_embedding]

@[to_additive]
lemma prod_filter_zero_lt {M : Type*} [comm_monoid M] {n : ℕ} {v : fin n.succ → M} :
  ∏ i in univ.filter (λ (i : fin n.succ), 0 < i), v i = ∏ (j : fin n), v j.succ :=
by rw [univ_filter_zero_lt, finset.prod_map, rel_embedding.coe_fn_to_embedding, coe_succ_embedding]

-- `to_additive` version of `prod_filter_succ_lt`, can't be autogenerated because
-- of a `1` appearing in the proof
lemma sum_filter_succ_lt {M : Type*} [add_comm_monoid M] {n : ℕ} (j : fin n) (v : fin n.succ → M) :
  ∑ i in univ.filter (λ i, j.succ < i), v i =
    ∑ j in univ.filter (λ i, j < i), v j.succ :=
by rw [univ_filter_succ_lt, finset.sum_map, rel_embedding.coe_fn_to_embedding, coe_succ_embedding]

@[to_additive]
lemma prod_filter_succ_lt {M : Type*} [comm_monoid M] {n : ℕ} (j : fin n) (v : fin n.succ → M) :
  ∏ i in univ.filter (λ i, j.succ < i), v i =
    ∏ j in univ.filter (λ i, j < i), v j.succ :=
by rw [univ_filter_succ_lt, finset.prod_map, rel_embedding.coe_fn_to_embedding, coe_succ_embedding]

end fin


/-
Copyright (c) 2021 Yaël Dillies, Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Bhavik Mehta
-/
import analysis.convex.basic
import linear_algebra.affine_space.affine_subspace
import combinatorics.simplicial_complex.to_move.default

open set

variables {E : Type*} [add_comm_group E] [module ℝ E] {x y : E} {A B C D : set E} {c : set (set E)}

def convex_join (A B : set E) :
  set E :=
A ∪ B ∪ ⋃ a b (ha : a ∈ A) (hb : b ∈ B), open_segment a b

/-The three other possible defs of `convex_join`. They are *not* equivalent.

This one is the weakest, not even respecting
`convex_hull (A ∪ B) = convex_join (convex_hull A) (convex_hull B)` as it doesn't cope well with
`A = ∅` or `B = ∅`.

def convex_join (A B : set E) :
  set E :=
⋃ a b (ha : a ∈ A) (hb : b ∈ B), segment a b

That one is stronger than the one I went for. It respects
`convex_hull (A ∪ B) = convex_join (convex_hull A) (convex_hull B)` and even adds some segments, but
doesn't unfold nicely as it breaks into four cases `(a ∈ A ∨ a ∈ B) ∧ (b ∈ A ∨ b ∈ B)` two of which
are hard but essentially the same.

def convex_join (A B : set E) :
  set E :=
⋃ a b (ha : a ∈ A ∪ B) (hb : b ∈ A ∪ B), segment a b
-/

lemma mem_convex_join_iff :
  x ∈ convex_join A B ↔ x ∈ A ∪ B ∨ ∃ a b : E, a ∈ A ∧ b ∈ B ∧ x ∈ open_segment a b :=
begin
  unfold convex_join,
  simp,
end

lemma convex_join_comm (A B : set E) :
  convex_join A B = convex_join B A :=
begin
  ext x,
  rw [mem_convex_join_iff, mem_convex_join_iff, union_comm],
  split;
  { rintro (hx | ⟨a, b, ha, hb, hx⟩),
    { left,
      exact hx },
    right,
    rw open_segment_symm at hx,
    exact ⟨b, a, hb, ha, hx⟩ }
end

lemma subset_convex_join_left (A B : set E) :
  A ⊆ convex_join A B :=
begin
  rintro x hx,
  left,
  left,
  exact hx,
end

lemma subset_convex_join_right (A B : set E) :
  B ⊆ convex_join A B :=
begin
  rintro x hx,
  left,
  right,
  exact hx,
end

lemma convex_join_subset_convex_join_left (hAB : A ⊆ B) (C : set E) :
  convex_join A C ⊆ convex_join B C :=
begin
  rintro x (hx | hx),
  { left,
    exact union_subset_union_left C hAB hx },
  right,
  simp only [mem_Union] at ⊢ hx,
  obtain ⟨a, c, ha, hc, hx⟩ := hx,
  exact ⟨a, c, hAB ha, hc, hx⟩,
end

lemma convex_join_subset_convex_join_right (A : set E) (hBC : B ⊆ C) :
  convex_join A B ⊆ convex_join A C :=
begin
  rw [convex_join_comm, convex_join_comm A C],
  exact convex_join_subset_convex_join_left hBC A,
end

lemma convex_join_subset_convex_join (hAC : A ⊆ C) (hBD : B ⊆ D) :
  convex_join A B ⊆ convex_join C D :=
subset.trans (convex_join_subset_convex_join_left hAC B)
  (convex_join_subset_convex_join_right C hBD)

lemma union_subset_convex_join (A B : set E) :
  A ∪ B ⊆ convex_join A B :=
union_subset (subset_convex_join_left A B) (subset_convex_join_right A B)

lemma convex_join_empty :
  convex_join A ∅ = A :=
begin
  unfold convex_join,
  rw union_empty,
  simp only [Union_false, Union_empty, union_empty],
end

lemma empty_convex_join :
  convex_join ∅ B = B :=
begin
  rw convex_join_comm,
  exact convex_join_empty,
end

lemma segment_subset_convex_join {a b : E} (ha : a ∈ A) (hb : b ∈ B) :
  segment a b ⊆ convex_join A B :=
begin
  rintro x hx,
  obtain rfl | rfl | hx := eq_left_or_right_or_mem_open_segment_of_mem_segment hx,
  { exact subset_convex_join_left A B ha },
  { exact subset_convex_join_right A B hb },
  right,
  simp only [mem_Union],
  exact ⟨a, b, ha, hb, hx⟩,
end

lemma convex_join_eq_of_nonempty (hA : A.nonempty) (hB : B.nonempty) :
  convex_join A B = ⋃ a b (ha : a ∈ A) (hb : b ∈ B), segment a b :=
begin
  ext x,
  simp only [mem_convex_join_iff, mem_Union],
  split,
  { rintro ((hx | hx) | ⟨a, b, ha, hb, hx⟩),
    { obtain ⟨b, hb⟩ := hB,
      exact ⟨x, b, hx, hb, left_mem_segment x b⟩ },
    { obtain ⟨a, ha⟩ := hA,
      exact ⟨a, x, ha, hx, right_mem_segment a x⟩ },
    exact ⟨a, b, ha, hb, open_segment_subset_segment a b hx⟩ },
  rintro ⟨a, b, ha, hb, hx⟩,
  obtain rfl | (rfl | hx) := eq_left_or_right_or_mem_open_segment_of_mem_segment hx,
  { left,
    exact subset_union_left _ _ ha },
  { left,
    exact subset_union_right _ _ hb },
  right,
  exact ⟨a, b, ha, hb, hx⟩,
end

lemma convex_hull_quadruple {a b c d : E} :
  convex_join (segment a b) (segment c d) = convex_hull {a, b, c, d} :=
begin
  rw [finite.convex_hull_eq, convex_join_eq_of_nonempty ⟨a, left_mem_segment _ _⟩
    ⟨c, left_mem_segment _ _⟩],
  swap,
  { simp only [finite.insert, finite_singleton] },
  ext x,
  simp only [mem_Union],
  split,
  { rintro ⟨y, z, ⟨ya, yb, hya, hyb, hyab, hy⟩, ⟨zc, zd, hzc, hzd, hzcd, hz⟩,
      ⟨xy, xz, hxy, hxz, hxyz, hx⟩⟩,
    sorry
  },
  rintro ⟨w, hw₀, hw₁, hx⟩,
  rw ←hx,
  let y := (1 - (w b)/(w a + w b)) • a + ((w b)/(w a + w b)) • b,
  let z := (1 - (w d)/(w c + w d)) • c + ((w d)/(w c + w d)) • d,
  have hwa : 0 ≤ w a := hw₀ a (by simp only [true_or, eq_self_iff_true, mem_insert_iff]),
  have hwb : 0 ≤ w b := hw₀ b (by simp only [true_or, or_true, eq_self_iff_true, mem_insert_iff]),
  have hwc : 0 ≤ w c := hw₀ c (by simp only [true_or, or_true, eq_self_iff_true, mem_insert_iff]),
  have hwd : 0 ≤ w d := hw₀ d (by simp only [or_true, eq_self_iff_true, mem_insert_iff,
    mem_singleton_iff]),
  have hwab : 0 ≤ w a + w b := add_nonneg hwa hwb,
  have hwcd : 0 ≤ w c + w d := add_nonneg hwc hwd,
  have hy : y ∈ segment a b,
  { refine ⟨(1 - (w b)/(w a + w b)), ((w b)/(w a + w b)), _, _, _, rfl⟩,
    { rw sub_nonneg,
      exact div_le_one_of_le ((le_add_iff_nonneg_left _).2 hwa) hwab },
    { exact div_nonneg hwb hwab },
    exact sub_add_cancel 1 _ },
  have hz : z ∈ segment c d,
  { refine ⟨(1 - (w d)/(w c + w d)), ((w d)/(w c + w d)), _, _, _, rfl⟩,
    { rw sub_nonneg,
      exact div_le_one_of_le ((le_add_iff_nonneg_left _).2 hwc) hwcd },
    { exact div_nonneg hwd hwcd },
    exact sub_add_cancel 1 _ },
  refine ⟨y, z, hy, hz, w a + w b, w c + w d, hwab, hwcd, _, _⟩,
  {
    rw ← hw₁,
    sorry,
  },
  sorry
  /-cases A.eq_empty_or_nonempty with hAemp hAnemp,
  { rw [hAemp, empty_convex_join],
    exact hB },
  cases B.eq_empty_or_nonempty with hBemp hBnemp,
  { rw [hBemp, convex_join_empty],
    exact hA },
  rw convex_join_eq_of_nonempty hAnemp hBnemp,
  rintro x y hx hy wx wy hwx hwy hwxy,
  simp only [mem_Union] at ⊢ hy hx,
  obtain ⟨ax, bx, hax, hbx, wax, wbx, hwax, hwbx, hwabx, hx⟩ := hx,
  obtain ⟨ay, b_y, hay, hby, way, wby, hway, hwby, hwaby, hy⟩ := hy,
  let az := (1 - wy*way/(wx*wax + wy*way)) • ax + (wy*way/(wx*wax + wy*way)) • ay,
  let bz := (1 - wy*wby/(wx*wbx + wy*wby)) • bx + (wy*wby/(wx*wbx + wy*wby)) • b_y,
  have da_nonneg : 0 ≤ wx*wax + wy*way := add_nonneg (mul_nonneg hwx hwax) (mul_nonneg hwy hway),
  have db_nonneg : 0 ≤ wx*wbx + wy*wby := add_nonneg (mul_nonneg hwx hwbx) (mul_nonneg hwy hwby),
  have haz : az ∈ A,
  { apply hA hax hay,
    { rw sub_nonneg,
      exact div_le_one_of_le ((le_add_iff_nonneg_left _).2 (mul_nonneg hwx hwax)) da_nonneg },
    { exact div_nonneg (mul_nonneg hwy hway) da_nonneg },
    exact sub_add_cancel 1 _ },
  have hbz : bz ∈ B,
  { apply hB hbx hby,
    { rw sub_nonneg,
      exact div_le_one_of_le ((le_add_iff_nonneg_left _).2 (mul_nonneg hwx hwbx)) db_nonneg },
    { exact div_nonneg (mul_nonneg hwy hwby) db_nonneg },
    exact sub_add_cancel 1 _ },
  refine ⟨az, bz, haz, hbz, wx * wax + wy * way, wx * wbx + wy * wby, da_nonneg, db_nonneg, _, _⟩,
  {
    calc
      wx * wax + wy * way + (wx * wbx + wy * wby)
          = wx * (wax + wbx) + wy * (way + wby) : by ring
      ... = 1 : by rw [hwabx, hwaby, mul_one, mul_one, hwxy]
  },
  rw [←hx, ←hy],
  simp,-/
  /-rw convex_iff_open_segment_subset at ⊢ hB hA,
  simp only [mem_convex_join_iff, mem_Union],
  rintro x y ((hx | hx) | ⟨a, b, ha, hb, hx⟩) hy, --((hy | hy) | ⟨a, b, ha, hb, hy⟩)
  {
    obtain ((hy | hy) | ⟨a, b, ha, hb, hy⟩) := hy,
    exact subset.trans (hA hx hy) (subset_convex_join_left A B),
  },
  {
    rintro z hz,
    simp only [mem_convex_join_iff, mem_Union],
    right,
    exact ⟨x, y, hx, hy, hz⟩,
  },
  {

  }-/
end

lemma convex_hull_triple {a b c : E} :
  convex_join (segment a b) {c} = convex_hull {a, b, c} :=
by rw [←pair_eq_singleton, ←convex_hull_quadruple, segment_same, pair_eq_singleton]

lemma convex_convex_join (hA : convex A) (hB : convex B) :
  convex (convex_join A B) :=
begin
  cases A.eq_empty_or_nonempty with hAemp hAnemp,
  { rw [hAemp, empty_convex_join],
    exact hB },
  cases B.eq_empty_or_nonempty with hBemp hBnemp,
  { rw [hBemp, convex_join_empty],
    exact hA },
  rw convex_join_eq_of_nonempty hAnemp hBnemp,
  rw convex_iff_segment_subset at ⊢ hB hA,
  rintro x y hx hy z hz,
  simp only [mem_Union] at ⊢ hy hx,
  obtain ⟨ax, bx, hax, hbx, hx⟩ := hx,
  obtain ⟨ay, b_y, hay, hby, hy⟩ := hy,
  have h : z ∈ convex_join (segment ax ay) (segment bx b_y),
  { have triv : ({ax, ay, bx, b_y} : set E) = {ax, bx, ay, b_y} := by simp only [set.insert_comm],
    rw [convex_hull_quadruple, triv, ←convex_hull_quadruple],
    exact segment_subset_convex_join hx hy hz },
  rw convex_join_eq_of_nonempty ⟨ax, left_mem_segment _ _⟩ ⟨bx, left_mem_segment _ _⟩ at h,
  simp only [mem_Union] at h,
  obtain ⟨az, bz, haz, hbz, hz⟩ := h,
  exact ⟨az, bz, hA hax hay haz, hB hbx hby hbz, hz⟩,
end

lemma convex_join_subset_convex_hull_union (A B : set E) :
  convex_join A B ⊆ convex_hull (A ∪ B) :=
begin
  cases A.eq_empty_or_nonempty with hAemp hAnemp,
  { rw [hAemp, empty_union, empty_convex_join],
    exact subset_convex_hull B },
  cases B.eq_empty_or_nonempty with hBemp hBnemp,
  { rw [hBemp, union_empty, convex_join_empty],
    exact subset_convex_hull A },
  rw convex_join_eq_of_nonempty hAnemp hBnemp,
  rintro x hx,
  simp only [mem_Union] at hx,
  obtain ⟨a, b, ha, hb, hx⟩ := hx,
  exact convex_iff_segment_subset.1 (convex_convex_hull _) (convex_hull_mono
    (subset_union_left _ _) (subset_convex_hull A ha)) (convex_hull_mono (subset_union_right _ _)
    (subset_convex_hull B hb)) hx,
end

lemma convex_hull_union_of_convex (hA : convex A) (hB : convex B) :
  convex_hull (A ∪ B) = convex_join A B :=
begin
  apply (convex_hull_min (union_subset_convex_join A B) (convex_convex_join hA hB)).antisymm,
  exact (convex_join_subset_convex_hull_union A B),
end

lemma convex_hull_union (A B : set E) :
  convex_hull (A ∪ B) = convex_join (convex_hull A) (convex_hull B) :=
begin
  rw [←convex_hull_convex_hull_union, ←convex_hull_self_union_convex_hull],
  exact convex_hull_union_of_convex (convex_convex_hull A) (convex_convex_hull B),
end

lemma convex_hull_insert (hA : A.nonempty) :
  convex_hull (insert x A) = ⋃ a ∈ convex_hull A, segment x a :=
begin
  rw [insert_eq, ←convex_hull_self_union_convex_hull, convex_hull_union_of_convex
  (convex_singleton x) (convex_convex_hull A), convex_join_eq_of_nonempty (singleton_nonempty x)
  (convex_hull_nonempty_iff.2 hA)],
  ext x,
  simp,
end

lemma convex_join_min {A B C : set E} (hAC : A ⊆ C) (hBC : B ⊆ C) (hC : convex C) :
  convex_join A B ⊆ C :=
begin
  refine subset.trans (convex_join_subset_convex_join (subset_convex_hull A) (subset_convex_hull B))
    _,
  rw ←convex_hull_union,
  exact convex_hull_min (union_subset hAC hBC) hC,
end


/-
Copyright (c) 2021 Christopher Hoskin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Christopher Hoskin
-/
import algebra.module.basic
import tactic.abel

/-!
# Symmetrized algebra

A commutative multiplication on a real or complex space can be constructed from any multiplication
by "symmetrization" i.e
$$
a \circ b = \frac{1}{2}(ab + ba)
$$

We provide the symmetrized version of a type `α` as `sym_alg α`, with notation `αˢʸᵐ`.

## Implementation notes

The approach taken here is inspired by algebra.opposites. We use Oxford Spellings
(IETF en-GB-oxendict).

## References

* [Hanche-Olsen and Størmer, Jordan Operator Algebras][hancheolsenstormer1984]
-/

open function

/--
The symmetrized algebra has the same underlying space as the original algebra.
-/
def sym_alg (α : Type*) : Type* := α

postfix `ˢʸᵐ`:std.prec.max_plus := sym_alg

namespace sym_alg

variables {α : Type*}

/-- The element of `sym_alg α` that represents `a : α`. -/
@[pattern,pp_nodot]
def sym : α → αˢʸᵐ := id

/-- The element of `α` represented by `x : αˢʸᵐ`. -/
@[pp_nodot]
def unsym : αˢʸᵐ → α := id

@[simp]

@[simp] lemma sym_comp_unsym : (sym : α → αˢʸᵐ) ∘ unsym = id := rfl
@[simp] lemma unsym_comp_sym : (unsym : αˢʸᵐ → α) ∘ sym = id := rfl

/-- The canonical bijection between `α` and `αˢʸᵐ`. -/
@[simps apply symm_apply { fully_applied := ff }]
def sym_equiv : α ≃ αˢʸᵐ := ⟨sym, unsym, unsym_sym, sym_unsym⟩

lemma sym_bijective : bijective (sym : α → αˢʸᵐ) := sym_equiv.bijective
lemma unsym_bijective : bijective (unsym : αˢʸᵐ → α) := sym_equiv.symm.bijective
lemma sym_injective : injective (sym : α → αˢʸᵐ) := sym_bijective.injective
lemma sym_surjective : surjective (sym : α → αˢʸᵐ) := sym_bijective.surjective
lemma unsym_injective : injective (unsym : αˢʸᵐ → α) := unsym_bijective.injective
lemma unsym_surjective : surjective (unsym : αˢʸᵐ → α) := unsym_bijective.surjective

@[simp] lemma sym_inj {a b : α} : sym a = sym b ↔ a = b := sym_injective.eq_iff
@[simp] lemma unsym_inj {a b : αˢʸᵐ} : unsym a = unsym b ↔ a = b := unsym_injective.eq_iff

instance [nontrivial α] : nontrivial αˢʸᵐ := sym_injective.nontrivial
instance [inhabited α] : inhabited αˢʸᵐ := ⟨sym default⟩
instance [subsingleton α] : subsingleton αˢʸᵐ := unsym_injective.subsingleton
instance [unique α] : unique αˢʸᵐ := unique.mk' _
instance [is_empty α] : is_empty αˢʸᵐ := function.is_empty unsym

@[to_additive]
instance [has_one α] : has_one αˢʸᵐ := { one := sym 1 }

instance [has_add α] : has_add αˢʸᵐ :=
{ add := λ a b, sym (unsym a + unsym b) }

instance [has_sub α] : has_sub αˢʸᵐ := { sub := λ a b, sym (unsym a - unsym b) }

instance [has_neg α] : has_neg αˢʸᵐ :=
{ neg := λ a, sym (-unsym a) }

/- Introduce the symmetrized multiplication-/
instance [has_add α] [has_mul α] [has_one α] [invertible (2 : α)] : has_mul (αˢʸᵐ) :=
{ mul := λ a b, sym (⅟2 * (unsym a * unsym b + unsym b * unsym a)) }

@[to_additive] instance [has_inv α] : has_inv αˢʸᵐ :=
{ inv := λ a, sym $ (unsym a)⁻¹ }

instance (R : Type*) [has_scalar R α] : has_scalar R αˢʸᵐ :=
{ smul := λ r a, sym (r • unsym a) }

@[simp, to_additive] lemma sym_one [has_one α] : sym (1 : α) = 1 := rfl
@[simp, to_additive] lemma unsym_one [has_one α] : unsym (1 : αˢʸᵐ) = 1 := rfl

@[simp] lemma sym_add [has_add α] (a b : α) : sym (a + b) = sym a + sym b := rfl
@[simp] lemma unsym_add [has_add α] (a b : αˢʸᵐ) : unsym (a + b) = unsym a + unsym b := rfl

@[simp] lemma sym_sub [has_sub α] (a b : α) : sym (a - b) = sym a - sym b := rfl
@[simp] lemma unsym_sub [has_sub α] (a b : αˢʸᵐ) : unsym (a - b) = unsym a - unsym b := rfl

@[simp] lemma sym_neg [has_neg α] (a : α) : sym (-a) = -sym a := rfl
@[simp] lemma unsym_neg [has_neg α] (a : αˢʸᵐ) : unsym (-a) = -unsym a := rfl

lemma mul_def [has_add α] [has_mul α] [has_one α] [invertible (2 : α)] (a b : αˢʸᵐ) :
  a * b = sym (⅟2*(unsym a * unsym b + unsym b * unsym a)) := by refl

lemma unsym_mul [has_mul α] [has_add α] [has_one α] [invertible (2 : α)] (a b : αˢʸᵐ) :
  unsym (a * b) = ⅟2*(unsym a * unsym b + unsym b * unsym a) := by refl

lemma sym_mul_sym [has_mul α] [has_add α] [has_one α] [invertible (2 : α)] (a b : α) :
  sym a * sym b = sym (⅟2*(a * b + b * a)) :=
rfl

@[simp, to_additive] lemma sym_inv [has_inv α] (a : α) : sym (a⁻¹) = (sym a)⁻¹ := rfl
@[simp, to_additive] lemma unsym_inv [has_inv α] (a : αˢʸᵐ) : unsym (a⁻¹) = (unsym a)⁻¹ := rfl

@[simp] lemma sym_smul {R : Type*} [has_scalar R α] (c : R) (a : α) : sym (c • a) = c • sym a := rfl
@[simp] lemma unsym_smul {R : Type*} [has_scalar R α] (c : R) (a : αˢʸᵐ) :
  unsym (c • a) = c • unsym a := rfl

@[simp, to_additive] lemma unsym_eq_one_iff [has_one α] (a : αˢʸᵐ) : a.unsym = 1 ↔ a = 1 :=
unsym_injective.eq_iff' rfl

@[simp, to_additive] lemma sym_eq_one_iff [has_one α] (a : α) : sym a = 1 ↔ a = 1 :=
sym_injective.eq_iff' rfl

@[to_additive] lemma unsym_ne_one_iff [has_one α] (a : αˢʸᵐ) : a.unsym ≠ (1 : α) ↔ a ≠ (1 : αˢʸᵐ) :=
not_congr $ unsym_eq_one_iff a

@[to_additive] lemma sym_ne_one_iff [has_one α] (a : α) : sym a ≠ (1 : αˢʸᵐ) ↔ a ≠ (1 : α) :=
not_congr $ sym_eq_one_iff a

instance [add_comm_semigroup α] : add_comm_semigroup (αˢʸᵐ) :=
unsym_injective.add_comm_semigroup _ unsym_add

instance [add_monoid α] : add_monoid (αˢʸᵐ) :=
unsym_injective.add_monoid _ unsym_zero unsym_add (λ _ _, rfl)

instance [add_group α] : add_group (αˢʸᵐ) :=
unsym_injective.add_group _ unsym_zero
  unsym_add unsym_neg unsym_sub (λ _ _, rfl) (λ _ _, rfl)

instance [add_comm_monoid α] : add_comm_monoid (αˢʸᵐ) :=
{ ..sym_alg.add_comm_semigroup, ..sym_alg.add_monoid }

instance [add_comm_group α] : add_comm_group (αˢʸᵐ) :=
{ ..sym_alg.add_comm_monoid, ..sym_alg.add_group }

instance {R : Type*} [semiring R] [add_comm_monoid α] [module R α] : module R αˢʸᵐ :=
function.injective.module R ⟨unsym, unsym_zero, unsym_add⟩ unsym_injective unsym_smul

instance [has_mul α] [has_add α] [has_one α] [invertible (2 : α)] (a : α) [invertible a] :
  invertible (sym a) :=
{ inv_of := sym (⅟a),
  inv_of_mul_self := begin
    rw [sym_mul_sym, mul_inv_of_self, inv_of_mul_self, ←bit0, inv_of_mul_self, sym_one],
  end,
  mul_inv_of_self := begin
    rw [sym_mul_sym, mul_inv_of_self, inv_of_mul_self, ←bit0, inv_of_mul_self, sym_one],
  end }

@[simp] lemma inv_of_sym [has_mul α] [has_add α] [has_one α] [invertible (2 : α)] (a : α)
  [invertible a] : ⅟(sym a) = sym (⅟a) := rfl

instance [semiring α] [invertible (2 : α)] : non_assoc_semiring (αˢʸᵐ) :=
{ one := 1,
  mul := (*),
  zero := (0),
  zero_mul := λ _, by rw [mul_def, unsym_zero, zero_mul, mul_zero, add_zero, mul_zero, sym_zero],
  mul_zero := λ _, by rw [mul_def, unsym_zero, zero_mul, mul_zero, add_zero, mul_zero, sym_zero],
  mul_one := λ _, by rw [mul_def, unsym_one, mul_one, one_mul, ←two_mul, inv_of_mul_self_assoc,
                         sym_unsym],
  one_mul := λ _, by rw [mul_def, unsym_one, mul_one, one_mul, ←two_mul, inv_of_mul_self_assoc,
                         sym_unsym],
  left_distrib := λ a b c, match a, b, c with
    | sym a, sym b, sym c := begin
      rw [sym_mul_sym, sym_mul_sym, ←sym_add, sym_mul_sym, ←sym_add, mul_add a, add_mul _ _ a,
        add_add_add_comm, mul_add],
    end
  end,
  right_distrib := λ a b c, match a, b, c with
    | sym a, sym b, sym c := begin
      rw [sym_mul_sym, sym_mul_sym, ←sym_add, sym_mul_sym, ←sym_add, mul_add c, add_mul _ _ c,
        add_add_add_comm, mul_add],
    end
  end,
  ..sym_alg.add_comm_monoid, }

/-- The symmetrization of a real (unital, associative) algebra is a non-associative ring. -/
instance [ring α] [invertible (2 : α)] : non_assoc_ring (αˢʸᵐ) :=
{ ..sym_alg.non_assoc_semiring,
  ..sym_alg.add_comm_group, }

/-! The squaring operation coincides for both multiplications -/

lemma unsym_mul_self [semiring α] [invertible (2 : α)] (a : αˢʸᵐ) :
  unsym (a*a) = unsym a * unsym a :=
by rw [mul_def, unsym_sym, ←two_mul, inv_of_mul_self_assoc]

lemma sym_mul_self [semiring α] [invertible (2 : α)] (a : α) : sym (a*a) = sym a * sym a :=
by rw [sym_mul_sym, ←two_mul, inv_of_mul_self_assoc]

lemma mul_comm [has_mul α] [add_comm_semigroup α] [has_one α] [invertible (2 : α)] (a b : αˢʸᵐ) :
  a * b = b * a :=
by rw [mul_def, mul_def, add_comm]

end sym_alg


/-
Copyright (c) 2021 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import data.finset.prod
import data.sym.sym2

/-!
# Symmetric powers of a finset

This file defines the symmetric powers of a finset as `finset (sym α n)` and `finset (sym2 α)`.

## Main declarations

* `finset.sym`: The symmetric power of a finset. `s.sym n` is all the multisets of cardinality `n`
  whose elements are in `s`.
* `finset.sym2`: The symmetric square of a finset. `s.sym2` is all the pairs whose elements are in
  `s`.

## TODO

`finset.sym` forms a Galois connection between `finset α` and `finset (sym α n)`. Similar for
`finset.sym2`.
-/

namespace finset
variables {α : Type*} [decidable_eq α] {s t : finset α} {a b : α}

lemma is_diag_mk_of_mem_diag {a : α × α} (h : a ∈ s.diag) : sym2.is_diag ⟦a⟧ :=
(sym2.is_diag_iff_proj_eq _).2 ((mem_diag _ _).1 h).2

lemma not_is_diag_mk_of_mem_off_diag {a : α × α} (h : a ∈ s.off_diag) : ¬ sym2.is_diag ⟦a⟧ :=
by { rw sym2.is_diag_iff_proj_eq, exact ((mem_off_diag _ _).1 h).2.2 }

section sym2
variables {m : sym2 α}

/-- Lifts a finset to `sym2 α`. `s.sym2` is the finset of all pairs with elements in `s`. -/
protected def sym2 (s : finset α) : finset (sym2 α) := (s.product s).image quotient.mk

@[simp] lemma mem_sym2_iff : m ∈ s.sym2 ↔ ∀ a ∈ m, a ∈ s :=
begin
  refine mem_image.trans
    ⟨_, λ h, ⟨m.out, mem_product.2 ⟨h _ m.out_fst_mem, h _ m.out_snd_mem⟩, m.out_eq⟩⟩,
  rintro ⟨⟨a, b⟩, h, rfl⟩,
  rw sym2.ball,
  rwa mem_product at h,
end

lemma mk_mem_sym2_iff : ⟦(a, b)⟧ ∈ s.sym2 ↔ a ∈ s ∧ b ∈ s := by rw [mem_sym2_iff, sym2.ball]

@[simp] lemma sym2_empty : (∅ : finset α).sym2 = ∅ := rfl

@[simp] lemma sym2_eq_empty : s.sym2 = ∅ ↔ s = ∅ :=
by rw [finset.sym2, image_eq_empty, product_eq_empty, or_self]

@[simp] lemma sym2_nonempty : s.sym2.nonempty ↔ s.nonempty :=
by rw [finset.sym2, nonempty.image_iff, nonempty_product, and_self]

alias sym2_nonempty ↔ _ finset.nonempty.sym2

attribute [protected] finset.nonempty.sym2

@[simp] lemma sym2_univ [fintype α] : (univ : finset α).sym2 = univ := rfl

@[simp] lemma sym2_singleton (a : α) : ({a} : finset α).sym2 = {sym2.diag a} :=
by rw [finset.sym2, singleton_product_singleton, image_singleton, sym2.diag]

@[simp] lemma diag_mem_sym2_iff : sym2.diag a ∈ s.sym2 ↔ a ∈ s := mk_mem_sym2_iff.trans $ and_self _

@[simp] lemma sym2_mono (h : s ⊆ t) : s.sym2 ⊆ t.sym2 :=
λ m he, mem_sym2_iff.2 $ λ a ha, h $ mem_sym2_iff.1 he _ ha

lemma image_diag_union_image_off_diag :
  s.diag.image quotient.mk ∪ s.off_diag.image quotient.mk = s.sym2 :=
by { rw [←image_union, diag_union_off_diag], refl }

end sym2

section sym
variables {n : ℕ} {m : sym α n}

/-- Lifts a finset to `sym α n`. `s.sym n` is the finset of all unordered tuples of cardinality `n`
with elements in `s`. -/
protected def sym (s : finset α) : Π n, finset (sym α n)
| 0       := {∅}
| (n + 1) := s.sup $ λ a, (sym n).image $ _root_.sym.cons a

@[simp] lemma sym_zero : s.sym 0 = {∅} := rfl
@[simp] lemma sym_succ : s.sym (n + 1) = s.sup (λ a, (s.sym n).image $ sym.cons a) := rfl

@[simp] lemma mem_sym_iff : m ∈ s.sym n ↔ ∀ a ∈ m, a ∈ s :=
begin
  induction n with n ih,
  { refine mem_singleton.trans ⟨_, λ _, sym.eq_nil_of_card_zero _⟩,
    rintro rfl,
    exact λ a ha, ha.elim },
  refine mem_sup.trans  ⟨_, λ h, _⟩,
  { rintro ⟨a, ha, he⟩ b hb,
    rw mem_image at he,
    obtain ⟨m, he, rfl⟩ := he,
    rw sym.mem_cons at hb,
    obtain rfl | hb := hb,
    { exact ha },
    { exact ih.1 he _ hb } },
  { obtain ⟨a, m, rfl⟩ := m.exists_eq_cons_of_succ,
    exact ⟨a, h _ $ sym.mem_cons_self _ _,
      mem_image_of_mem _ $ ih.2 $ λ b hb, h _ $ sym.mem_cons_of_mem hb⟩ }
end

@[simp] lemma sym_empty (n : ℕ) : (∅ : finset α).sym (n + 1) = ∅ := rfl

lemma repeat_mem_sym (ha : a ∈ s) (n : ℕ) : sym.repeat a n ∈ s.sym n :=
mem_sym_iff.2 $ λ b hb, by rwa (sym.mem_repeat.1 hb).2

protected

@[simp] lemma sym_singleton (a : α) (n : ℕ) : ({a} : finset α).sym n = {sym.repeat a n} :=
eq_singleton_iff_nonempty_unique_mem.2 ⟨(singleton_nonempty _).sym n,
  λ s hs, sym.eq_repeat_iff.2 $ λ b hb, eq_of_mem_singleton $ mem_sym_iff.1 hs _ hb⟩

lemma eq_empty_of_sym_eq_empty (h : s.sym n = ∅) : s = ∅ :=
begin
  rw ←not_nonempty_iff_eq_empty at ⊢ h,
  exact λ hs, h (hs.sym _),
end

@[simp] lemma sym_eq_empty : s.sym n = ∅ ↔ n ≠ 0 ∧ s = ∅ :=
begin
  cases n,
  { exact iff_of_false (singleton_ne_empty _) (λ h, (h.1 rfl).elim) },
  { refine ⟨λ h, ⟨n.succ_ne_zero, eq_empty_of_sym_eq_empty h⟩, _⟩,
    rintro ⟨_, rfl⟩,
    exact sym_empty _ }
end

@[simp] lemma sym_nonempty : (s.sym n).nonempty ↔ n = 0 ∨ s.nonempty :=
by simp_rw [nonempty_iff_ne_empty, ne.def, sym_eq_empty, not_and_distrib, not_ne_iff]

alias sym2_nonempty ↔ _ finset.nonempty.sym2

attribute [protected] finset.nonempty.sym2

@[simp] lemma sym_univ [fintype α] (n : ℕ) : (univ : finset α).sym n = univ :=
eq_univ_iff_forall.2 $ λ s, mem_sym_iff.2 $ λ a _, mem_univ _

@[simp] lemma sym_mono (h : s ⊆ t) (n : ℕ): s.sym n ⊆ t.sym n :=
λ m hm, mem_sym_iff.2 $ λ a ha, h $ mem_sym_iff.1 hm _ ha

@[simp] lemma sym_inter (s t : finset α) (n : ℕ) : (s ∩ t).sym n = s.sym n ∩ t.sym n :=
by { ext m, simp only [mem_inter, mem_sym_iff, imp_and_distrib, forall_and_distrib] }

@[simp] lemma sym_union (s t : finset α) (n : ℕ) : s.sym n ∪ t.sym n ⊆ (s ∪ t).sym n :=
union_subset (sym_mono (subset_union_left s t) n) (sym_mono (subset_union_right s t) n)

end sym
end finset