import analysis.inner_product_space.pi_L2
import topology.paracompact

--OUTPUT 1
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  assume A : set (euclidean_space ℝ (fin n)),
  assume ha : is_open A,
  assume hc : is_open_cover A,

  --set B_0 = the empty set, and for each m ∈ ℕ, set B_m to be the ball of radius m centered at 0.
  have h1 : ∀ m : ℕ, is_open (ball (λ x, 0 : ℝ) m), from by auto [is_open_ball, is_subset_of_subset_top, is_subset_of_subset_empty],
  have h2 : ∀ (m : ℕ), ∃! x : ℝ, ∀ y : ℝ, ∃ (h1 : y ∈ ball (λ x, 0 : ℝ) m), x ∈ ball (λ x, 0 : ℝ) m, from by auto using [use 0, ball_zero],

  have h3 : ∃! B : ℕ → set (euclidean_space ℝ (fin n)), ∀ m : ℕ, (B m) = ball (λ x, 0 : ℝ) m, from by auto [h1, h2, exists_unique.exists, exists_unique.unique],

  -- Using h3, let (B_m) = the B from h3, and define
  --C_0 = {}, and for each m ∈ ℕ, define C_m to be the set of all open subsets of elements of A that intersect B_m but not B_{m-1}.
  have h4 : ∀ m : ℕ, ∃ Cm : set (euclidean_space ℝ (fin n)), ∀ A' : set (euclidean_space ℝ (fin n)), (A' ∈ A), Cm = A', from by auto [exists_unique.exists],
  have h5 : ∀ m : ℕ, ∃! Cm : set (euclidean_space ℝ (fin n)), ∀ A' : set (euclidean_space ℝ (fin n)), (A' ∈ A), Cm = A', from by auto [exists_unique.exists],

  have h6 : ∃! C : ℕ → set (euclidean_space ℝ (fin n)), ∀ m : ℕ, ∃! Cm : set (euclidean_space ℝ (fin n)), ∀ A' : set (euclidean_space ℝ (fin n)), (A' ∈ A), Cm = A', from by auto [h5, exists_unique.exists, exists_unique.unique],

  -- Using h6, let (C_m) = the C from h6, and define C = union C_m.
  have h7 : ∀ m : ℕ, is_open (C m), from by auto [exists_unique.exists, h6],
  have h8 : ∀ m : ℕ, C m ⊆ (euclidean_space ℝ (fin n)), from by auto [exists_unique.exists, h6],

  have h9 : ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, x ∈ C m, from begin
    assume x : euclidean_space ℝ (fin n),

    have h9_1 : ∃ m : ℕ, ∃ h1 : x ∈ ball (λ x, 0 : ℝ) m, from ℝn.exists_mem_ball x,
    have h9_2 : ∃ m : ℕ, ∃ h1 : x ∈ (ball (λ x, 0 : ℝ) m) ∧ (x ∉ ball (λ x, 0 : ℝ) (m - 1)), from by admit,
    have h9_3 : ∃ m : ℕ, ∃ h1 : x ∈ C m, from by admit,
    show ∃ m : ℕ, x ∈ C m, from by admit,
  end,

  have h10 : is_open_cover {C m | m ∈ ℕ} (euclidean_space ℝ (fin n)), from by admit,
  have h11 : is_open (euclidean_space ℝ (fin n)), from by admit,

  have h12 : ∀ Cm : set (euclidean_space ℝ (fin n)), ∃ A' : set (euclidean_space ℝ (fin n)), ∃ h1 : A' ∈ A, Cm ⊆ A', from by admit,
  have h13 : ∀ Cm1 Cm2, Cm1 ≠ Cm2 → Cm1 ∩ Cm2 = ∅, from by admit,

  have h14 : is_open_refinement (euclidean_space ℝ (fin n)) {C m | m ∈ ℕ} A, from by admit,

  show ∃! C : set (euclidean_space ℝ (fin n)), is_open C ∧ is_open_refinement (euclidean_space ℝ (fin n)) C A, from by admit,
end

--OUTPUT 2
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  let  h1 : paracompact_space (euclidean_space ℝ (fin n)), from by auto [euclidean_space.paracompact],
  exact h1,
end

--OUTPUT 3
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  let  ℝ' := euclidean_space ℝ (fin n),
  let  0' :  ℝ' := ⟨0, by auto ⟩,
  let B m : set  ℝ' := {x :  ℝ' | ∥x - 0'∥ < m },
  have h1 : ∀ m : ℝ, B m = {x :  ℝ' | ∥x∥ < m }, from by auto
  {
    assume m,
    have h1 : ∀ (x :  ℝ'), x - 0' = x, from by auto [add_neg_self],
    have h2 : ∀ (x :  ℝ'), -(x - 0') = -x, from by auto [h1, neg_neg],
    have h3 : ∀ (x :  ℝ'), x - 0' = -(-x), from by auto [h2, neg_neg],
    have h4 : ∀ (x :  ℝ'), ∥x∥ < m ↔ ∥x - 0'∥ < m, from by auto [h1, norm_neg, eq_neg_iff_add_eq_zero, norm_eq_zero, eq_comm]
  },
  have h4 : ∀ m : ℝ, B m = {x :  ℝ' | ∥x∥ < m }, from by auto
  {
    assume m,
    have h1 : ∀ x :  ℝ', ∥x∥ < m ↔ ∥x - 0'∥ < m, from by auto [norm_eq_of_dist_eq],
    have h2 : ∀ x :  ℝ', x - 0' = x, from by auto [add_neg_self],
    have h3 : ∀ x :  ℝ', ∥x - 0'∥ < m ↔ ∥x∥ < m, from by auto [h1, h2],
    have h4 : ∀ x :  ℝ', ∥x∥ < m ↔ ∥x - 0'∥ < m :=
    begin
      assume x :  ℝ',
      show ∥x∥ < m ↔ ∥x - 0'∥ < m, from by auto [h2, h3],
    end,
    have h5 : B m = {x :  ℝ' | ∥x∥ < m }, from by auto [h4],
  },
  have h5 : is_open  ℝ' B := by auto [bball_eq_open_norm_lt, h4],
  have h6 : compact  ℝ' ℝ' B := by auto [compact_singleton],
  have h7 : ∀ m : ℝ, is_open  ℝ' (B m) := by auto [h5, h4],
  have h8 : ∀ m : ℝ, compact  ℝ' ℝ' (B m) := by auto [h6, h4],

  assume A : set (set  ℝ'),
  assume hA : open.is_open_cover  ℝ' A,
  let C' m : set (set  ℝ') := {s : set  ℝ' | ∃ U, (U ∈ A) ∧ s = B m ∩ U},
  have h9 : ∀ m : ℝ, C' m ⊆ A := by auto
  {
    assume m,
    have h1 : ∀ (s : set  ℝ') (U : set  ℝ'), (s ∈ C' m ↔ (U ∈ A ∧ s = B m ∩ U)), from by auto,
    have h2 : ∀ (s : set  ℝ') (U : set  ℝ'), (s ∈ C' m → (U ∈ A ∧ s = B m ∩ U)) :=
    begin
      assume (s : set  ℝ') (U : set  ℝ'),
      assume h1 : s ∈ C' m,
      show (U ∈ A ∧ s = B m ∩ U), from by auto [h1, h2],
    end,
    have h3 : ∀ (s : set  ℝ') (U : set  ℝ'), (U ∈ A ∧ s = B m ∩ U) → (s ∈ C' m) :=
    begin
      assume (s : set  ℝ') (U : set  ℝ'),
      assume h1 : U ∈ A ∧ s = B m ∩ U,
      show s ∈ C' m, from by auto [h1, h2],
    end,
    have h4 : ∀ (s : set  ℝ') (U : set  ℝ'), (s ∈ C' m ↔ s ∈ U), from by auto [h1, h2, h3, set.inter_subset_right],
    have h5 : ∀ (s : set  ℝ') (U : set  ℝ'), s ∈ C' m → s ∈ U := by auto
     {
      assume s : set  ℝ',
      assume U : set  ℝ',
      assume h1 : s ∈ C' m,
      show s ∈ U, from by auto [h1, h4],
    },
    have h6 : ∀ (s : set  ℝ') (U : set  ℝ'), (U ∈ A ∧ s = B m ∩ U) → s ∈ U := by auto
    {
      assume s : set  ℝ',
      assume U : set  ℝ',
      assume h1 : U ∈ A ∧ s = B m ∩ U,
      show s ∈ U, from by auto [h1, h4, h5, h3],
    },
    have h7 : ∀ (s : set  ℝ') (U : set  ℝ'), (U ∈ A ∧ s = B m ∩ U) → s ⊆ U := by auto
    {
      assume (s : set  ℝ'),
      assume (U : set  ℝ'),
      assume h1 : U ∈ A ∧ s = B m ∩ U,
      show s ⊆ U, from by auto [h1, h4, set.subset.refl],
    },
    have h8 : ∀ s : set  ℝ', (s ∈ C' m → s ⊆ U), from by auto
    {
      assume s : set  ℝ',
      assume h1 : s ∈ C' m,
      show s ⊆ U, from by auto [h1, h4, h7, h3],
    },
    have h9 : ∀ s : set  ℝ', (s ∈ C' m → s ⊆ B m ∩ U), from by auto
    {
      assume s : set  ℝ',
      assume h1 : s ∈ C' m,
      show s ⊆ B m ∩ U, from by auto [h1, h4],
    },
    have h10 : ∀ s : set  ℝ', (s ∈ C' m → s ⊆ s), from by auto
    {
      assume s : set  ℝ',
      assume h1 : s ∈ C' m,
      show s ⊆ s, from by auto [set.subset.refl],
    },
    have h11 : ∀ s : set  ℝ', s ∈ C' m → s ⊆ s := by auto
    {
      assume s : set  ℝ',
      assume h1 : s ∈ C' m,
      show s ⊆ s, from by auto [h10, h1],
    },
    have h12 : ∀ s : set  ℝ', s ∈ C' m → s ⊆ B m ∩ U := by auto
    {
      assume s : set  ℝ',
      assume h1 : s ∈ C' m,
      show s ⊆ B m ∩ U, from by auto [h9, h1],
    },
    have h13 : ∀ s : set  ℝ', s ∈ C' m → s
end --Needs more than 2000 tokens!

--OUTPUT 4
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  introv h1,
  have h2 : ∀ (m : ℕ), ∃ (α : ℝ), 0 < α ∧ α ≤ m, from begin
    simp,
    assumption,
  end,

  have h3 : ∀ (m : ℕ), ∃ (α : ℝ), 0 < α ∧ α < m + 1, from begin
    introv,
    have h4 : ∃ (α : ℝ), 0 < α ∧ α ≤ m, from by auto [h1],
    cases h4 with α h4,
    cases h4 with h4a h4b,
    have h5 : 0 < α + 1, from by linarith [zero_lt_one],
    have h6 : α + 1 ≤ m + 1, from by linarith [int.le_of_lt h4a],
    show ∃ (α : ℝ), 0 < α ∧ α < m + 1, from by auto [h5, h6, lt_add_one],
  end,

  have h7 : ∀ (m : ℕ), ∃ (α : ℝ), 0 < α ∧ m ≤ α, from begin
    introv,
    have h4 : ∃ (α : ℝ), 0 < α ∧ α ≤ m, from by auto [h1],
    cases h4 with α h4,
    cases h4 with h4a h4b,
    have h5 : 0 < α + 1, from by linarith [zero_lt_one],
    have h6 : m ≤ α + 1, from by linarith [int.le_of_lt h4a],
    show ∃ (α : ℝ), 0 < α ∧ m ≤ α, from by auto [h5, h6, le_add_one],
  end,

  have h8 : ∀ (m : ℕ), set.compact (ball (0 : ℝ^(fin n)) (m : ℝ)), from begin
    introv,
    have h9 : set.compact (set.image (λ x : ℝ, (pow_two x : ℝ)) (ball (0 : ℝ) m)), from by auto,
    let s : set (ℝ^(fin n)) := ball (0 : ℝ^(fin n)) m,
    set_option class.instance_max_depth 1000,
    have h10 : ∀ (x : ℝ^(fin n)), x ∈ s → x.val ∈ ball (0 : ℝ) m, from by auto,
    have h11 : (λ (x : ℝ^(fin n)), x.val) '' s = ball (0 : ℝ) m, from by auto [set.image_eq_preimage_of_inverse],
    have h12 : continuous (λ x : ℝ, pow_two x), from begin
      {
        have h13 : continuous (λ x : ℝ, x * x), from begin simp [continuous_at.continuous_at], end,
        have h14 : (λ x : ℝ, x * x) = (λ x : ℝ, x^2), from begin simp, end,
        have h15 : continuous (λ x : ℝ, x^2) at x, from by auto [h13, h14],
        have h16 : continuous (λ x : ℝ, x^2), from by auto [h15],
        assumption,
      },
    end,
    have h13 : (λ (p : ℝ^(fin n)), p.val) ∘ (λ (p : ℝ^(fin n)), p.val) = (λ (p : ℝ^(fin n)), p.val^2), from begin ext p, simp, end,
    have h14 : continuous ((λ (p : ℝ^(fin n)), p.val) ∘ (λ (p : ℝ^(fin n)), p.val)) at x, from by auto [h12, h13],
    have h15 : continuous ((λ (p : ℝ^(fin n)), p.val) ∘ (λ (p : ℝ^(fin n)), p.val)), from by auto [h14],
    have h16 : continuous ((λ (p : ℝ^(fin n)), p.val) ∘ (λ (p : ℝ^(fin n)), p.val) ∘ (λ (p : ℝ^(fin n)), (p.val))⁻¹), from by auto [h15, continuous_at.continuous_at, continuous.comp, continuous.comp],
    have h17 : continuous ((λ (p : ℝ^(fin n)), p.val^2) ∘ (λ (p : ℝ^(fin n)), (p.val))⁻¹) at x, from by auto [h13, h16],
    have h18 : continuous ((λ (p : ℝ^(fin n)), p.val^2) ∘ (λ (p : ℝ^(fin n)), (p.val))⁻¹), from by auto [h17],
    have h19 : continuous ((λ (p : ℝ^(fin n)), p.val^2) ∘ (λ (p : ℝ^(fin n)), (p.val))⁻¹) at x, from by auto [h18],
    have h20 : continuous ((λ (p : ℝ^(fin n)), p.val^2) ∘ (λ (p : ℝ^(fin n)), (p.val))⁻¹) at x, from by auto [h18],
    have h21 : continuous ((λ (p : ℝ^(fin n)), p.val^2) ∘ (λ (p : ℝ^(fin n)), (p.val))⁻¹) at x, from by auto [h18],
    have h22 : continuous ((λ (p : ℝ^(fin n)), p.val^2) ∘ (λ (p : ℝ^(fin n)), (p.val))⁻¹), from by auto [h20],
    have h23 : continuous ((λ (p : ℝ^(fin n)), p.val^2) ∘ (λ (p : ℝ^(fin n)), (p.val))⁻¹) at x, from by auto [h22],
    have h24 : continuous ((λ (p : ℝ^(fin n)), p.val^2) ∘ (λ (p : ℝ^(fin n)), (p.val))⁻¹), from by auto [h22],
    have h25 : continuous ((λ (p : ℝ^(fin n)), p.val^2) ∘ (λ (p : ℝ^(fin n)), (p.val))⁻¹) at x, from by auto [h24],
    have h26 : continuous ((λ (p : ℝ^(fin n)), p.val^2) ∘ (λ (p : ℝ^(fin n)), (p.val))⁻¹), from by auto [h24],
    have h27 : continuous ((λ (p : ℝ^(fin n)), p.val^2) ∘ (λ (p : ℝ^(fin n)), (p.val))⁻¹) at x, from by auto [h26],
    have h28 : continuous ((λ (p : ℝ^(fin n)), p.val^2) ∘ (λ (p : ℝ^(fin n)), (p.val))⁻¹) at x, from by auto [h26],
    have h29 : continuous ((λ (p : ℝ^(fin n)), p.val^2) ∘ (λ (p : ℝ^(fin n)), (p.val))⁻¹), from by auto [h28],
    have h30 : continuous ((λ (p : ℝ^(fin n)), p.val^2) ∘ (λ (p : ℝ^(fin n)), (p.val))⁻¹) at x, from by auto [h29],
    have h31 : continuous ((λ (p : ℝ^(fin n)), p.val^2) ∘ (λ (p : ℝ^(fin n)), (p.val
end --Needs more than 2000 tokens!

--OUTPUT 5
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  let B_0 : set ℝ := ∅,
  let B_m : ℕ → set ℝ, {
    have B_m_0 : B_m 0 = ∅, from by auto [B_m],
    intros m,
    intro B_m,
    have h1 : B_m = sBall' 0 m, from by auto [B_m, B_m_0, fin.eq_of_veq],
    unfold sBall',
    rw h1,
  },
  let C_m : ℕ → set (set (euclidean_space ℝ (fin n))), {
    let A : ℕ → set (euclidean_space ℝ (fin n)), {
      intros m,
      intro A,
      have h1 : A = A m, from fin.eq_of_veq,
      unfold A,
      rw h1,
    },
    intros m,
    apply set.sUnion,
    let A : set (set (euclidean_space ℝ (fin n))), from A m,
    let B_m' : set ℝ := B_m m,
    let B_m'_bar : set ℝ := closure B_m',
    let B_m'_bar_closure : closure B_m'_bar = B_m'_bar, from by auto [closure_closure],
    let B_m'_bar_compact : compact B_m'_bar, from by auto [real_compact_iff_closed_inter_compact, B_m'_bar_closure, real_compact_open_int, sBall'_open, open_sUnion, open_union, union_self],
    let B_m'_bar_compact_A : compact B_m'_bar ∩ ⋂₀ A = ⋂₀ A, from by auto [compact_inter_open_iff, open_sUnion, open_union, union_self, sBall'_open, B_m'_bar_closure, B_m'_bar_compact],
    have h3 : ∃a : set (euclidean_space ℝ (fin n)), a ∈ A, from by auto [fin.exists_self],
    have h4 : ∃a_fin : finite (B_m'_bar ∩ ⋂₀ A), ⋃  a_fin = (B_m'_bar ∩ ⋂₀ A), from by auto [compact_iff_finite_subcover, B_m'_bar_compact_A],
    let a_fin : finite (⋂₀ A ∩ B_m'_bar), from classical.some h4,
    let a_fin_cov : ⋃ a_fin = (B_m'_bar ∩ ⋂₀ A), from classical.some_spec h4,
    let a_fin_disjoint : ∀ (a b : euclidean_space ℝ (fin n)), a ∈ a_fin → b ∈ a_fin → a ≠ b → a ∩ b = ∅, from by auto [finite.disjoint_wlog],
    let a_fin_disjoint2 : ∀ (a a' : euclidean_space ℝ (fin n)), a ∈ a_fin → a' ∈ a_fin → a ≠ a' → a ∩ a' = ∅, from by auto [a_fin_disjoint],
    let a_fin_intersects_A : ∀ a : euclidean_space ℝ (fin n), a ∈ a_fin → a ∩ ⋂₀ A ≠ ∅, from by auto [finite.nonempty_inter_of_cover a_fin_cov],
    let a_fin_intersects_B_m'_bar : ∀ a : euclidean_space ℝ (fin n), a ∈ a_fin → a ∩ B_m'_bar ≠ ∅, from by auto [finite.nonempty_inter_of_cover a_fin_cov],
    let c_m_fin := ⟨ a_fin.to_set, a_fin_disjoint2 ⟩,
    let c_m_fin_intersects_A : ∀ a : set (euclidean_space ℝ (fin n)), a ∈ c_m_fin → a ∩ ⋂₀ A ≠ ∅, from by auto [c_m_fin, a_fin_intersects_A],
    let c_m_fin_intersects_B_m'_bar : ∀ a : set (euclidean_space ℝ (fin n)), a ∈ c_m_fin → a ∩ B_m'_bar ≠ ∅, from by auto [c_m_fin, a_fin_intersects_B_m'_bar],
    have h5 : ∃ c : set (euclidean_space ℝ (fin n)), c ∈ c_m_fin, from by auto [finite.exists_mem c_m_fin],
    have h6 : ∃ c_bar : set (euclidean_space ℝ (fin n)), c_bar ∈ c_m_fin, from h5,
    have h7 : ∃ c_bar' : set (euclidean_space ℝ (fin n)), c_bar' ∈ c_m_fin ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ c_bar' → x ⊆ ℝn ∖ B_m'_bar), from by auto [c_m_fin, c_m_fin_intersects_B_m'_bar, c_m_fin_intersects_A],
    let c_bar' : set (euclidean_space ℝ (fin n)), from classical.some h7,
    have h8 : c_bar' ∈ c_m_fin ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ c_bar' → x ⊆ ℝn ∖ B_m'_bar), from classical.some_spec h7,
    have h9 : c_bar' ∈ c_m_fin, from h8.left,
    have h10 : ∀ x : euclidean_space ℝ (fin n), x ∈ c_bar' → x ⊆ ℝn ∖ B_m'_bar, from h8.right,
    have h11 : ∃ c_bar'' : set (euclidean_space ℝ (fin n)), c_bar'' ∈ c_m_fin ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ c_bar'' → x ⊆ ℝn ∖ B_m'_bar) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ c_bar'' → x ∩ ⋂₀ A ≠ ∅), from by auto [c_m_fin, h6],
    let c_bar'' : set (euclidean_space ℝ (fin n)), from classical.some h11,
    have h12 : c_bar'' ∈ c_m_fin ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ c_bar'' → x ⊆ ℝn ∖ B_m'_bar) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ c_bar'' → x ∩ ⋂₀ A ≠ ∅), from classical.some_spec h11,
    have h13 : c_bar'' ∈ c_m_fin, from h12.left,
    have h14 : ∀ x : euclidean_space ℝ (fin n), x ∈ c_bar'' → x ⊆ ℝn ∖ B_m'_bar, from h12.left,
    have h15 : ∀ x : euclidean_space ℝ (fin n), x ∈ c_bar'' → x ∩ ⋂₀ A
end --Needs more than 2000 tokens!

--OUTPUT 6
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
    assume U : set (euclidean_space ℝ (fin n)) ,
    assume h1 : open U ,
    assume h2 : (U : set (euclidean_space ℝ (fin n))) = ⋃₀ U ,
    assume h3 : (⋃₀ U : set (euclidean_space ℝ (fin n))) = univ ,

    --prove existance of refinement first
    {
        let B0 : set (euclidean_space ℝ (fin n)) ,
        have h4 : B0 = {p : euclidean_space ℝ (fin n) | (p.1.to_set : set ℝ) = ∅} ,
        {
            have h5 : (B0 : set (euclidean_space ℝ (fin n))) = {p : euclidean_space ℝ (fin n) | (p.1.to_set : set ℝ) = ∅} := rfl,
            exact h5,
        },
        have h6 : ∀ n : ℕ , {p : euclidean_space ℝ (fin n) | (p.1.to_set : set ℝ) = {p.1 n | true}} = {p : euclidean_space ℝ (fin n) | (p.1.to_set : set ℝ) ⊆ {p.1 n | true}} ,
        {
            assume n : ℕ ,
            let A : set (euclidean_space ℝ (fin n)) ,
            have h7 : (A : set (euclidean_space ℝ (fin n))) = {p : euclidean_space ℝ (fin n) | (p.1.to_set : set ℝ) = {p.1 n | true}} ,
            {
                have h8 : (A : set (euclidean_space ℝ (fin n))) = {p : euclidean_space ℝ (fin n) | (p.1.to_set : set ℝ) = {p.1 n | true}} := rfl,
                exact h8,
            },
            have h9 : set.subset.trans A {p : euclidean_space ℝ (fin n) | (p.1.to_set : set ℝ) = {p.1 n | true}} ( {p : euclidean_space ℝ (fin n) | (p.1.to_set : set ℝ) ⊆ {p.1 n | true}}  ∩ {p : euclidean_space ℝ (fin n) | (p.1.to_set : set ℝ) = {p.1 n | true}} ) = A ,
            {
                have h10 : ( {p : euclidean_space ℝ (fin n) | (p.1.to_set : set ℝ) = {p.1 n | true}}  ∩ {p : euclidean_space ℝ (fin n) | (p.1.to_set : set ℝ) ⊆ {p.1 n | true}} ) = (A : set (euclidean_space ℝ (fin n))) := begin
                    have h11 : (A : set (euclidean_space ℝ (fin n))) ⊆ ( {p : euclidean_space ℝ (fin n) | (p.1.to_set : set ℝ) ⊆ {p.1 n | true}} ) := sorry,
                    have h12 : (A : set (euclidean_space ℝ (fin n))) ⊆ ( {p : euclidean_space ℝ (fin n) | (p.1.to_set : set ℝ) = {p.1 n | true}} ) := sorry,
                    exact set.inter_eq' A {p : euclidean_space ℝ (fin n) | (p.1.to_set : set ℝ) ⊆ {p.1 n | true}} {p : euclidean_space ℝ (fin n) | (p.1.to_set : set ℝ) = {p.1 n | true}} h11 h12,
                end,
                exact set.subset.antisymm (set.subset.trans A {p : euclidean_space ℝ (fin n) | (p.1.to_set : set ℝ) = {p.1 n | true}}  {p : euclidean_space ℝ (fin n) | (p.1.to_set : set ℝ) ⊆ {p.1 n | true}} ) h10,
            },
            exact h9,
        },
        have h7 : (B0 : set (euclidean_space ℝ (fin n))) = {p : euclidean_space ℝ (fin n) | ∀ n : ℕ, (p.1 n = 0)} := begin
            have h8 : ∀ p : euclidean_space ℝ (fin n), (p.1.to_set : set ℝ) ⊆ {p.1 n | true} := begin
                assume p : euclidean_space ℝ (fin n),
                have h9 : ∀ n : ℕ, (p.1.to_set : set ℝ) ⊆ {p.1 n | true} := begin
                    assume n : ℕ,
                    have h10 : ∀ (x : ℝ), ∀ (q : ℝ → Prop), ((p.1.to_set : set ℝ) ⊆ {p | q p}) := begin
                        assume x : ℝ,
                        have h11 : ∀ q : ℝ → Prop, ((p.1.to_set : set ℝ) ⊆ {p | q p}) := begin
                            assume q : ℝ → Prop,
                            have h12 : ∀ (a : ℝ), (a ∈ (p.1.to_set : set ℝ) → q a) := begin
                                assume a : ℝ,
                                assume h13 : a ∈ (p.1.to_set : set ℝ),
                                let h14 : euclidean_space ℝ (fin n) := begin
                                    let h15 : fin n := sorry,
                                    exact ⟨sorry, sorry⟩,
                                end,
                                have h15 : a ∈ {p.1 n | true} := sorry,
                                exact h15,
                            end,
                            exact ∀₀ x ∈ (p.1.to_set : set ℝ), q x,
                        end,
                        exact h11,
                    end,
                    exact h10,
                end,
                exact h9,
            end,
            have h8 : ∀ p : euclidean_space ℝ (fin n), (p.1.to_set : set ℝ) ⊆ {p.1 n | true} := begin
                assume p : euclidean_space ℝ (fin n),
                have h9 : ∀ n : ℕ, (p.1.to_set : set ℝ) ⊆ {p.1 n | true} := begin
                    assume n : ℕ,
                    have h10 : ∀ (x : ℝ), ∀ (q : ℝ → Prop), ((p.1.to_set : set ℝ) ⊆ {p | q p}) := begin
                        assume x : ℝ,
                        have h11 : ∀ q : ℝ → Prop, ((p.1.to_set : set ℝ) ⊆ {p | q p}) := begin
                            assume q : ℝ → Prop,
                            have h12 : ∀ (a : ℝ), (a ∈ (p.1.to_set : set ℝ) → q a) := begin
                                assume a : ℝ,
                                assume h13 : a ∈ (p.1.to_set : set ℝ),
                                let h14 : euclidean_space ℝ (fin n)
end --Needs more than 2000 tokens!

--OUTPUT 7
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  assume (U : set (euclidean_space ℝ (fin n))) (hU : U.is_open) (h1 : (⋃₀ U) = set.univ),
  let B₀ := ∅,
  have h2 : B₀ = ∅, from rfl,
  let B₁ := ball (euclidean_space ℝ (fin n)) 0 1,
  have h3 : B₁ = {x : euclidean_space ℝ (fin n) | x.norm < 1}, from rfl,
  have h4 : B₁ ⊆ univ, from by auto using euclidean_space.norm_nonneg,
  have h5 : B₁.compact, from by auto using [compact_of_euclidean_space, euclidean_space.dim_nonempty, dim_le_of_subset, euclidean_space.finset_dim_eq_nat_of_pos, euclidean_space.pos_dim_of_mem, set.finite_subset, finite_image],
  have h6 : ∀ (m : ℕ) (Bₘ : set (euclidean_space ℝ (fin n))), m > 0 → (Bₘ : set (euclidean_space ℝ (fin n))) ⊆ ball (euclidean_space ℝ (fin n)) 0 m → Bₘ.compact, from
    begin
      assume m : ℕ,
      assume Bₘ : set (euclidean_space ℝ (fin n)),
      assume hm : m > 0,
      assume hB : Bₘ ⊆ ball (euclidean_space ℝ (fin n)) 0 m,
      have h1 : euclidean_space.dim Bₘ ≤ m, from by auto [euclidean_space.dim_le_of_subset],
      have h2 : Bₘ ⊆ {x : euclidean_space ℝ (fin n) | x.norm < m + 1}, from by auto [ball_subset, hm, nat.succ_pos, zero_lt_one],
      have h3 : Bₘ ⊆ {x : euclidean_space ℝ (fin n) | x.norm < m + 1}, from by auto [h2, subset.trans],
      have h4 : {x : euclidean_space ℝ (fin n) | x.norm < m + 1} ⊆ {x : euclidean_space ℝ (fin n) | x.norm < m + 1}, from by auto [set.subset.refl],
      have h5 : Bₘ ⊆ {x : euclidean_space ℝ (fin n) | x.norm < m + 1}, from by auto [h3, h4, subset.trans],
      have h6 : {x : euclidean_space ℝ (fin n) | x.norm < m + 1} ⊆ univ, from by auto using [ball_le],
      have h7 : Bₘ ⊆ univ, from by auto [h5, subset.trans],
      have h8 : euclidean_space.dim Bₘ  ≤ n, from by auto [euclidean_space.pos_dim_of_mem, euclidean_space.finset_dim_eq_nat_of_pos, euclidean_space.dim_nonempty, euclidean_space.pos_dim_of_mem, euclidean_space.dim_le_of_subset, euclidean_space.finset_dim_eq_nat_of_pos, euclidean_space.pos_dim_of_mem, h7, set.finite_subset, finite_image, h1, finset.ssub_ssub_left, le_of_lt],
      show Bₘ.compact, from by auto using [compact_of_euclidean_space, euclidean_space.dim_nonempty, dim_le_of_subset, euclidean_space.finset_dim_eq_nat_of_pos, euclidean_space.pos_dim_of_mem, set.finite_subset, finite_image],
    end,
  have h7 : (B₁ : set (euclidean_space ℝ (fin n))) ⊆ ball (euclidean_space ℝ (fin n)) 0 1, from by auto [ball_le],
  have h8 : B₁.compact, from by auto [h6],
  let B₂ := ball (euclidean_space ℝ (fin n)) 0 2,
  have h9 : B₂ = {x : euclidean_space ℝ (fin n) | x.norm < 2}, from rfl,
  have h10 : B₂ ⊆ univ, from by auto using euclidean_space.norm_nonneg,
  have h11 : (B₂ : set (euclidean_space ℝ (fin n))) ⊆ ball (euclidean_space ℝ (fin n)) 0 2, from by auto [ball_le],
  have h12 : B₂.compact, from by auto [h6],
  let B₃ := ball (euclidean_space ℝ (fin n)) 0 3,
  have h13 : B₃ = {x : euclidean_space ℝ (fin n) | x.norm < 3}, from rfl,
  have h14 : B₃ ⊆ univ, from by auto using euclidean_space.norm_nonneg,
  have h15 : (B₃ : set (euclidean_space ℝ (fin n))) ⊆ ball (euclidean_space ℝ (fin n)) 0 3, from by auto [ball_le],
  have h16 : B₃.compact, from by auto [h6],

end

--OUTPUT 8
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  assume U : set (euclidean_space ℝ (fin n)),
  assume hU : is_open U,
  have h1 : ∃ B : ℕ → set (euclidean_space ℝ (fin n)), (∀ m : ℕ, is_open (B m)) ∧ (∀ m : ℕ, set.is_cover (B m)) ∧ (∀ x : euclidean_space ℝ (fin n), ∀ m : ℕ, m > 0 → ∃ k : ℕ, ∀ j : ℕ, B k x ∩ B j = ∅ → j > m)  ∧ (∀ m : ℕ, set.finite (set.Union (B m))), from by auto [is_cover_Union, is_cover_Union, is_cover_Union],
  let B : ℕ → set (euclidean_space ℝ (fin n)) := λ m, (λ x : euclidean_space ℝ (fin n), dist x 0 < m ∧ dist x 0 > m - 1)⁻¹' U,

  have h2 : ∀ m : ℕ, is_open (B m), from λ m : ℕ, by auto [set.inter_open, set.is_open_ball, set.is_open_ball],
  have h3 : ∀ m : ℕ, set.is_cover (B m), from λ m : ℕ, by auto [set.is_cover_ball, set.is_cover_ball, set.is_open_Union, set.is_open_Union, set.is_open_Union],

  have h4 : ∀ x : euclidean_space ℝ (fin n), ∀ m : ℕ, m > 0 → ∃ k : ℕ, ∀ j : ℕ, B k x ∩ B j = ∅ → j > m, from
  begin
    assume (x : euclidean_space ℝ (fin n)) (m : ℕ),
    assume hm : m > 0,
    have h4_1 : ∃ k : ℕ, ∀ j : ℕ, k > j → B k x ∩ B j = ∅, from by auto [set.inter_empty_iff_disjoint],
    show ∃ k : ℕ, ∀ j : ℕ, B k x ∩ B j = ∅ → j > m, from by auto [h4_1],
  end,

  have h5 : ∀ m : ℕ, set.finite (set.Union (B m)), from
  begin
    assume m : ℕ,
    have h5_1 : set.finite {z : euclidean_space ℝ (fin n) | set.mem_Union (B m) z}, from by auto [set.mem_Union, set.mem_Union, set.mem_Union, set.mem_Union, set.is_open_ball, set.is_open_ball, set.is_compact_ball, set.is_compact_ball, set.is_compact_Union, set.is_compact_Union, set.is_compact_Union, set.is_compact_Union, set.is_cover_Union, set.is_cover_Union, set.is_cover_Union, set.finite_compact_cover, set.finite_compact_cover, set.finite_compact_cover],
    show set.finite (set.Union (B m)), from by auto [h5_1],
  end,

  show ∃ C : set (euclidean_space ℝ (fin n)) → Prop, (∀ c : set (euclidean_space ℝ (fin n)), C c → is_open c) ∧ (∀ c : set (euclidean_space ℝ (fin n)), C c → set.is_cover c) ∧ (set.Union C) = univ ∧ (∀ x : euclidean_space ℝ (fin n), ∀ c₁ c₂ : set (euclidean_space ℝ (fin n)), C c₁ ∧ C c₂ ∧ x ∈ c₁ ∧ x ∈ c₂ → set.finite {c : set (euclidean_space ℝ (fin n)) | C c ∧ c ∩ c₁ ≠ ∅ ∧ c ∩ c₂ ≠ ∅}), from by auto [is_cover_Union, is_cover_Union, is_cover_Union, h2, h3, h4, h5],
end

--OUTPUT 9
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  have h1 : ∀ (m : ℕ) (a : ℝ), ∃ (M : ℕ) (A : ℝ), a + M*2⁻¹ ≤ A ∧ A + 2⁻¹ ≤ a + (M+1)*2⁻¹, from by auto [exists.intro (m:ℕ) (a + m*2⁻¹ : ℝ)],

  have h2 : ∀ (m : ℕ) (a : ℝ), ∃ (M : ℕ) (A : ℝ), a + M*2⁻¹ ≤ A ∧ A ≤ a + (M+1)*2⁻¹, from
  begin
    assume (m : ℕ) (a : ℝ),
    have h2a : ∃ (M : ℕ) (A : ℝ), a + M*2⁻¹ ≤ A ∧ A + 2⁻¹ ≤ a + (M+1)*2⁻¹, from by auto [h1],
    have h2b : ∃ (M : ℕ) (A : ℝ), a + M*2⁻¹ ≤ A ∧ A ≤ a + (M+1)*2⁻¹, from by auto [exists.intro (M : ℕ) (A - 2⁻¹ : ℝ), exists.unique.elim (h2a)],
    show ∃ (M : ℕ) (A : ℝ), a + M*2⁻¹ ≤ A ∧ A ≤ a + (M+1)*2⁻¹, from by auto [h2b],
  end,

  have h3 : ∀ (m : ℕ) (a : ℝ), ∃ (M : ℕ) (A : ℝ), a ≤ A ∧ A < a+m*2⁻¹, from
  begin
    assume (m : ℕ) (a : ℝ),
    have h3a : ∃ (M : ℕ) (A : ℝ), a + M*2⁻¹ ≤ A ∧ A ≤ a + (M+1)*2⁻¹, from by auto [h2],
    have h3b : ∃ (M : ℕ) (A : ℝ), a ≤ A ∧ A < a+m*2⁻¹, from by auto [exists.intro (M : ℕ) (A : ℝ), exists.unique.elim (h3a)],
    show ∃ (M : ℕ) (A : ℝ), a ≤ A ∧ A < a+m*2⁻¹, from by auto [h3b],
  end,

  have h4 : ∀ (m : ℕ) (a : ℝ) (b : ℝ), ∃ (M : ℕ) (A : ℝ), a ≤ A ∧ A < b, from
  begin
    assume (m : ℕ),
    assume (a : ℝ),
    assume (b : ℝ),
    have h4a : ∃ (M : ℕ) (A : ℝ), a ≤ A ∧ A < a + m*2⁻¹, from by auto [h3],
    have h4b : ∃ (M : ℕ) (A : ℝ), a ≤ A ∧ A < b, from by auto [exists.unique.elim (h4a)],
    show ∃ (M : ℕ) (A : ℝ), a ≤ A ∧ A < b, from by auto [h4b],
  end,

  have h5 : ∀ (v : fin n), ∃ (f : ℝ → ℝ), continuous f ∧ (∀ (m : ℕ) (a : ℝ), f a ≤ f (a + m*2⁻¹)) ∧ (∀ (m : ℕ), f (m * 2⁻¹) = 0) ∧ (∀ (m : ℕ) (a : ℝ), f a > 0 → f a ≥ f (a + m*2⁻¹)), from
  begin
    assume (v : fin n),
    have h5a : ∃ (f : ℝ → ℝ) (F : ℝ → ℝ), iso (euclidean_space ℝ (fin n)) (euclidean_space ℝ (fin n)) f F, from by auto [euclidean_iso],
    have h5b : ∃ (f : ℝ → ℝ), continuous f ∧ (∀ (m : ℕ) (a : ℝ), f a ≤ f (a + m*2⁻¹)) ∧ (∀ (m : ℕ), f (m * 2⁻¹) = 0) ∧ (∀ (m : ℕ) (a : ℝ), f a > 0 → f a ≥ f (a + m*2⁻¹)), from by auto [exists.unique.elim (h5a)],
    show ∃ (f : ℝ → ℝ), continuous f ∧ (∀ (m : ℕ) (a : ℝ), f a ≤ f (a + m*2⁻¹)) ∧ (∀ (m : ℕ), f (m * 2⁻¹) = 0) ∧ (∀ (m : ℕ) (a : ℝ), f a > 0 → f a ≥ f (a + m*2⁻¹)), from by auto [h5b],
  end,

  have h6 : ∀ (v : fin n), ∃ (f : ℝ → ℝ), continuous f ∧ (∀ (m : ℕ), f m = 0) ∧ (∀ (m : ℕ) (a : ℝ), f a ≤ f (a + m*2⁻¹)) ∧ (∀ (a : ℝ) (m : ℕ), f a > 0 → f a ≥ f (a + m*2⁻¹)), from
  begin
    assume (v : fin n),
    have h6a : ∃ (f : ℝ → ℝ), continuous f ∧ (∀ (m : ℕ), f m = 0) ∧ (∀ (m : ℕ) (a : ℝ), f a ≤ f (a + m*2⁻¹)) ∧ (∀ (a : ℝ) (m : ℕ), f a > 0 → f a ≥ f (a + m*2⁻¹)), from by auto [use (λ a : ℝ, -(f (a:ℝ)))],
    show ∃ (f : ℝ → ℝ), continuous f ∧ (∀ (m : ℕ), f m = 0) ∧ (∀ (m : ℕ) (a : ℝ), f a ≤ f (a + m*2⁻¹)) ∧ (∀ (a : ℝ) (m : ℕ), f a > 0 → f a ≥ f (a + m*2⁻¹)), from by auto [h6a],
  end,

  have h7 : ∀ (v : fin n), ∃ (f : ℝ → ℝ), continuous f ∧ (∀ (m : ℕ), f m = 0) ∧ (∀ (a : ℝ), f a ≤ 1) ∧ (∀ (a : ℝ) (m : ℕ), f a > 0 → f a ≥ f (a + m*2⁻¹)) ∧ (∀ (m : ℕ) (a : ℝ), f a ≤ f (a + m*2⁻¹)), from
  begin
    assume (v : fin n),
    have h7a : ∃ (f : ℝ → ℝ), continuous f ∧ (∀ (m : ℕ), f m = 0) ∧ (∀ (m : ℕ) (a : ℝ), f a ≤ f (a + m*2⁻¹)) ∧ (∀ (a : ℝ) (m : ℕ), f a >
end --Needs more than 2000 tokens!

--OUTPUT 10
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  have h1 : ∀ (A : set (fin n)), is_open A → A ∈ 𝓞 (euclidean_space ℝ (fin n)), from begin
    assume A hA, have h1 : ∀ B ∈ 𝓞 (euclidean_space ℝ (fin n)), B = λ x, x ∈ A, from begin
      assume B hB,
      have h2 : ∀ x : euclidean_space ℝ (fin n), x ∈ B ↔ x ∈ A, from by auto [],
      show B = λ x, x ∈ A, from funext h2
    end,
    show A ∈ 𝓞 (euclidean_space ℝ (fin n)), from h1 _ hA
  end,
  have h2 : (λ (x : ℝ), x < 1) ∈ 𝓞 ℝ, from by auto [],
  have h3 : (λ (x : ℝ), x < 2) ∈ 𝓞 ℝ, from by auto [],
  have h4 : ∀ (m : ℕ), (λ (x : ℝ), x < (m : ℝ)) ∈ 𝓞 ℝ, from by auto [],
  have h5 : ∀ (m : ℕ), (λ (x : ℝ), x ≤ m) ∈ 𝓞 ℕ, from by auto [],
  have h6 : (λ (x : ℝ), x ≤ 1) ∈ 𝓞 ℕ, from by auto [],
  have h7 : (λ (x : ℝ), x ≤ 2) ∈ 𝓞 ℕ, from by auto [],
  have h8 : ∀ (m : ℕ), (λ (x : ℝ), x ≤ m) ∈ 𝓞 ℕ, from by auto [],
  have h9 : ∀ (f : ℕ → ℝ), ∃! x : ℝ, ∀ (m : ℕ), f m < x, from by auto [],
  have h10 : ∀ (f : ℕ → ℕ), ∃! x : ℕ, ∀ (m : ℕ), f m ≤ x, from by auto [],
  have h11 : ∀ (f : ℕ → ℝ), ∀ (m : ℕ), {x : ℝ | x ≤ m ∧ f m ≤ x} ∈ 𝓞 ℝ, from by auto [],
  have h12 : ∀ (f : ℕ → ℕ), ∀ (m : ℕ), {x : ℕ | x ≤ m} ∈ 𝓞 ℕ, from by auto [],
  have h13 : ∀ (m : ℕ), ∃! x : ℝ, ∀ (i : ℕ), i ≤ m → (nth (extend f 0) i) < x, from by auto [],
  have h14 : ∀ (m : ℕ), {x : ℝ | x ≤ m ∧ (nth (extend f 0) m) ≤ x} ∈ 𝓞 ℝ, from by auto [],
  have h15 : ∀ (m : ℕ), {x : ℝ | x ≤ m} ∈ 𝓞 ℝ, from by auto [],
  have h16 : ∀ (m : ℕ), {x : ℕ | x ≤ m ∧ (nth (extend f 0) m) ≤ x} ∈ 𝓞 ℕ, from by auto [],
  have h17 : ∀ (m : ℕ), {x : ℕ | x ≤ m} ∈ 𝓞 ℕ, from by auto [],
  have h18 : ∀ (m : ℕ), {x : ℕ × ℝ | x.fst ≤ m} ∈ 𝓞 ℕ × ℝ, from by auto [],
  have h19 : ∀ (m : ℕ), {x : ℝ × ℕ | x.snd ≤ m} ∈ 𝓞 ℝ × ℕ, from by auto [],
  have h20 : ∀ (m : ℕ), {x : ℕ × ℕ | x.fst ≤ m ∧ (nth (extend f 0) x.snd) ≤ x.fst} ∈ 𝓞 ℕ × ℕ, from by auto [],
  have h21 : ∀ (m : ℕ), {x : ℝ × ℕ | x.fst ≤ m ∧ (nth (extend f 0) x.snd) ≤ x.fst} ∈ 𝓞 ℝ × ℕ, from by auto [],
  have h22 : ∀ (m : ℕ), {x : ℝ × ℝ | x.fst ≤ m ∧ (nth (extend f 0) x.snd) ≤ x.fst} ∈ 𝓞 ℝ × ℝ, from by auto [],
  have h23 : ∀ (m : ℕ), {x : ℝ × ℝ | x.fst ≤ m} ∈ 𝓞 ℝ × ℝ, from by auto [],
  have h24 : ∀ (m : ℕ), {x : ℕ × ℝ | x.snd ≤ m} ∈ 𝓞 ℕ × ℝ, from by auto [fst],
  have h25 : ∀ (m : ℕ), {x : ℝ × ℕ | x.snd ≤ m} ∈ 𝓞 ℝ × ℕ, from by auto [fst],
  have h26 : ∀ (m : ℕ), {x : ℝ × ℝ | x.snd ≤ m} ∈ 𝓞 ℝ × ℝ, from by auto [fst],
  have h27 : ∀ (m : ℕ), {x : ℝ | x ≤ m ∧ (nth (extend f 0) m) ≤ x} ∈ 𝓞 ℝ, from by auto [],
  have h28 : ∀ (m : ℕ), {x : ℕ | x ≤ m} ∈ 𝓞 ℕ, from by auto [],
  have h29 : ∀ (m : ℕ), {x : ℝ × ℝ | (λ (y : ℝ × ℝ), y.fst) x ≤ m ∧ (nth (extend f 0) (λ (y : ℝ × ℝ), y.snd) x) ≤ (λ (y : ℝ × ℝ), y.fst) x} ∈ 𝓞 ℝ × ℝ, from by auto [],
  have h30 : ∀ (m : ℕ), {x : ℝ × ℝ | (λ (y : ℝ × ℝ), y.fst) x ≤ m} ∈ 𝓞 ℝ × ℝ, from by auto [],
  have h31 : ∀ (m : ℕ), {x : ℝ × ℝ | (λ (y : ℝ × ℝ), y.snd) x ≤ m} ∈ 𝓞 ℝ × ℝ, from by auto [],
  have h32 : ∀ (m : ℕ), {x : ℝ × ℝ | (λ (y : ℕ × ℝ), y.snd) x ≤ m} ∈ 𝓞 ℕ × ℝ, from by auto [],
  have h33 : ∀ (m : ℕ), {x : ℝ × ℝ | (λ (y : ℝ × ℕ), y.snd) x ≤ m} ∈ 𝓞 ℝ × ℕ, from by auto [],
  have h34 : ∀ (m : ℕ), {x : ℝ × ℝ | (λ (y : ℝ × ℝ), y.snd) x ≤ m} ∈ 𝓞
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
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by auto [set.subset_of_mem_powerset, set.subset_of_mem_powerset],
  have h2 : (A ∩ B) ⊆ A, from by auto [set.inter_subset_left],
  have h3 : (A ∩ B) ⊆ S, from by auto [set.subset.trans],
  show (A ∩ B) ∈  𝒫 S, from by auto [set.mem_powerset],
end

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

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  calc (x + y)^2 = (x+y)*(x+y) : by auto [sq]
  ... = x*(x+y) + y*(x+y) : by auto [add_mul]
  ... = x*x + x*y + y*x + y*y : by auto [mul_comm, add_mul] using [ring]
  ... = x^2 + 2*x*y + y^2 : by auto [sq, mul_comm] using [ring]
end

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

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

Setting $b = a$, this becomes:

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

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

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

  have h3 : ∀ a : G, ∃! x : G, a * x = a, from by auto [h1],
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from by auto [h2],

  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from by auto [exists_unique.unique, h3, classical.some_spec, exists_unique.exists, mul_one],
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from by auto [exists_unique.unique, h4, classical.some_spec, exists_unique.exists, one_mul],

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

/--`theorem`
\mathbb{R}^n is paracompact
$\mathbb{R}^n$ is paracompact for all $n$.
`proof`
Let $\mathcal{A}$ be an open covering of $\mathbb{R}^n$. We now construct a locally finite open refinement $\mathcal{C}$ of $\mathcal{A}$ that covers $\mathbb{R}^n$. First, we define a collection of pen balls. Let $B_0 = \phi$, and for each $n \in \mathbb{N}$, let $B_m$ denote the ball of radius $m$
centered at 0. Given $m$, set $\Bar{B_m}$ is compact in $\mathbb{R}^n$ by the Heine-Borel theorem, so choose finitely many elements of $\mathcal{A}$ that cover $\Bar{B_m}$ and intersect each one with the open set $\mathbb{R}^n \setminus \Bar{B_{m - 1}}$, and let $\mathcal{C}_{m}$ denote this collection of open sets (each an open subset of an element of $\mathcal{A}$). So $\mathcal{C} = \bigcup_{m = 0}^{\infty} \mathcal{C}_m$ is an open refinement of $\mathcal{A}$. Note that $\mathcal{C}$ covers $\mathbb{R}^n$ since for any $x \in \mathbb{R}^n$, there is a smallest $m \in \mathbb{N}$ such that $x \in \Bar{B_{m}}$ (namely, some $m$ where $\rVert x \lVert \leq m \leq \rVert x \lVert + 1$), and so $x$ is an element of $\mathcal{C}_m$. Now collection $\mathcal{C}$ is locally finite since for given $x \in \mathbb{R}^n$, neighborhood $B_m$ intersects only finitely many elements of $\mathcal{C}$, namely those elements in collection $\mathcal{C}_1 \cup \mathcal{C}_2 \cup \cdots \mathcal{C}_m$. So $\mathcal{C}$ is a locally finite open refinement of $\mathcal{A}$ that covers $\mathbb{R}^n$, hence $\mathbb{R}^n$ is paracompact.

QED
-/
theorem  ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
FEW SHOT PROMPTS TO CODEX(END)-/


import game.sets.sets_level01
import data.set.basic
import tactic

namespace xena -- hide

variable X : Type -- hide

open_locale classical

theorem distr_dif_union (A B C : set X) : A \ (B ∪ C) = (A \ B) ∩ (A \ C):=
begin
  rw ext_iff,
  intro h,
  split,
  intro j,
  rw mem_inter_iff,
  split,
  cases j with r hr,
  split,
  exact r,
  simp_rw mem_union_iff at hr,
  push_neg at hr,
  cases hr with d hd,
  exact d,
  rw mem_sdiff_iff at j,
  cases j with f hf,
  simp_rw mem_union_iff at hf,
  push_neg at hf,
  cases hf with y hy,
  split,
  exact f,
  exact hy,
  intro n,
  rw mem_sdiff_iff,
  split,
  simp_rw mem_inter_iff at n,
  cases n with y hy,
  rw mem_sdiff_iff at hy,
  cases hy with t ht,
  exact t,
  rw mem_inter_iff at n,
  rw mem_sdiff_iff at n,
  rw mem_sdiff_iff at n,
  cases n with j hj,
  cases j with g hg,
  cases hj with r hr,
  rw mem_union_iff,
  push_neg,
  split,
  exact hg,
  exact hr,
end

end xena -- hide


import topology.subset_properties

lemma proper_of_compact_fibers {α β : Type*} [topological_space α] [topological_space β]
  (f : α → β) (h₁ : ∀ x, is_compact (f ⁻¹' {x})) (h₂ : is_closed_map f)
    {K : set β} (hK : is_compact K) : is_compact (f ⁻¹' K) :=
begin
  classical,
  simp_rw is_compact_iff_finite_subcover at h₁ ⊢ hK,
  intros ι U hU hU',
  have := λ (x : K),
    h₁ x U hU ((set.preimage_mono $ set.singleton_subset_iff.mpr x.2).trans hU'),
  choose ι' hι',
  let V : K → set β := λ x, (f '' (⋃ i ∈ ι' x, U i)ᶜ)ᶜ,
  have hV : ∀ x, is_open (V x),
  { intro x, rw is_open_compl_iff, apply h₂, rw is_closed_compl_iff,
    exact is_open_Union (λ i, is_open_Union $ λ _, hU i) },
  obtain ⟨t, ht⟩ := hK V hV _,
  swap,
  { intros x hx,
    by_contra h,
    simp_rw [set.mem_Union, set.mem_compl_iff] at h,
    push_neg at h,
    obtain ⟨y, hy, rfl⟩ := h ⟨x, hx⟩,
    exact hy (hι' ⟨_, hx⟩ (set.mem_singleton (f y))) },
  use t.bUnion ι',
  rintro x hx,
  obtain ⟨k, hkt, hkV⟩ := (set.mem_Union₂.mp $ ht hx),
  have : x ∈ ⋃ (i : ι) (H : i ∈ ι' k), U i,
  { contrapose hkV, rw [set.mem_compl_iff, not_not], exact ⟨_, hkV, rfl⟩ },
  obtain ⟨i, hi, hiU⟩ := (set.mem_Union₂.mp this),
  exact set.mem_Union₂_of_mem (finset.mem_bUnion.mpr ⟨k, hkt, hi⟩) hiU
end


import basic.conventional basic.non_comm

/-?
A gyrogroup (G, ⊕) is gyrocommutative if its binary operation obeys the gyrocommutative law
(G6) a ⊕ b = gyr[a, b](b ⊕ a) for all a, b ∈ G.
-/

-- Why does gyr not work anymore when I extend gyrogroup C?!?!?!

class gyrocomm_group (C : Type) extends gyrogroup C :=
--axiom 6: a ⊕ b = gyr[a, b](b ⊕ a) for all a, b ∈ G
(gyro_comm: ∀ (a b : C), a ⊙ b = gyr a b (b ⊙ a))
variables (C : Type) [gyrocomm_group C]
variables (a b c d : C)

lemma gyro_comm : ∀ (a b : C), a ⊙ b = gyrogroup.gyr a b (b ⊙ a) := gyrocomm_group.gyro_comm

def e : C := (0 : C)


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro, Patrick Massot
-/

import order.filter.pointwise
import group_theory.quotient_group
import topology.algebra.monoid
import topology.homeomorph

/-!
# Theory of topological groups

This file defines the following typeclasses:

* `topological_group`, `topological_add_group`: multiplicative and additive topological groups,
  i.e., groups with continuous `(*)` and `(⁻¹)` / `(+)` and `(-)`;

* `has_continuous_sub G` means that `G` has a continuous subtraction operation.

There is an instance deducing `has_continuous_sub` from `topological_group` but we use a separate
typeclass because, e.g., `ℕ` and `ℝ≥0` have continuous subtraction but are not additive groups.

We also define `homeomorph` versions of several `equiv`s: `homeomorph.mul_left`,
`homeomorph.mul_right`, `homeomorph.inv`, and prove a few facts about neighbourhood filters in
groups.

## Tags

topological space, group, topological group
-/

open classical set filter topological_space function
open_locale classical topological_space filter

universes u v w x
variables {α : Type u} {β : Type v} {G : Type w} {H : Type x}

section continuous_mul_group

/-!
### Groups with continuous multiplication

In this section we prove a few statements about groups with continuous `(*)`.
-/

variables [topological_space G] [group G] [has_continuous_mul G]

/-- Multiplication from the left in a topological group as a homeomorphism. -/
@[to_additive "Addition from the left in a topological additive group as a homeomorphism."]
protected def homeomorph.mul_left (a : G) : G ≃ₜ G :=
{ continuous_to_fun  := continuous_const.mul continuous_id,
  continuous_inv_fun := continuous_const.mul continuous_id,
  .. equiv.mul_left a }

@[simp, to_additive]
lemma homeomorph.coe_mul_left (a : G) : ⇑(homeomorph.mul_left a) = (*) a := rfl

@[to_additive]
lemma homeomorph.mul_left_symm (a : G) : (homeomorph.mul_left a).symm = homeomorph.mul_left a⁻¹ :=
by { ext, refl }

@[to_additive]
lemma is_open_map_mul_left (a : G) : is_open_map (λ x, a * x) :=
(homeomorph.mul_left a).is_open_map

@[to_additive]
lemma is_closed_map_mul_left (a : G) : is_closed_map (λ x, a * x) :=
(homeomorph.mul_left a).is_closed_map

/-- Multiplication from the right in a topological group as a homeomorphism. -/
@[to_additive "Addition from the right in a topological additive group as a homeomorphism."]
protected def homeomorph.mul_right (a : G) :
  G ≃ₜ G :=
{ continuous_to_fun  := continuous_id.mul continuous_const,
  continuous_inv_fun := continuous_id.mul continuous_const,
  .. equiv.mul_right a }

@[to_additive]
lemma is_open_map_mul_right (a : G) : is_open_map (λ x, x * a) :=
(homeomorph.mul_right a).is_open_map

@[to_additive]
lemma is_closed_map_mul_right (a : G) : is_closed_map (λ x, x * a) :=
(homeomorph.mul_right a).is_closed_map

@[to_additive]
lemma is_open_map_div_right (a : G) : is_open_map (λ x, x / a) :=
by simpa only [div_eq_mul_inv] using is_open_map_mul_right (a⁻¹)

@[to_additive]
lemma is_closed_map_div_right (a : G) : is_closed_map (λ x, x / a) :=
by simpa only [div_eq_mul_inv] using is_closed_map_mul_right (a⁻¹)

@[to_additive]
lemma discrete_topology_of_open_singleton_one (h : is_open ({1} : set G)) : discrete_topology G :=
begin
  rw ← singletons_open_iff_discrete,
  intro g,
  suffices : {g} = (λ (x : G), g⁻¹ * x) ⁻¹' {1},
  { rw this, exact (continuous_mul_left (g⁻¹)).is_open_preimage _ h, },
  simp only [mul_one, set.preimage_mul_left_singleton, eq_self_iff_true,
    inv_inv, set.singleton_eq_singleton_iff],
end
end continuous_mul_group

section topological_group

/-!
### Topological groups

A topological group is a group in which the multiplication and inversion operations are
continuous. Topological additive groups are defined in the same way. Equivalently, we can require
that the division operation `λ x y, x * y⁻¹` (resp., subtraction) is continuous.
-/

/-- A topological (additive) group is a group in which the addition and negation operations are
continuous. -/
class topological_add_group (G : Type u) [topological_space G] [add_group G]
  extends has_continuous_add G : Prop :=
(continuous_neg : continuous (λa:G, -a))

/-- A topological group is a group in which the multiplication and inversion operations are
continuous. -/
@[to_additive]
class topological_group (G : Type*) [topological_space G] [group G]
  extends has_continuous_mul G : Prop :=
(continuous_inv : continuous (has_inv.inv : G → G))

variables [topological_space G] [group G] [topological_group G]

export topological_group (continuous_inv)
export topological_add_group (continuous_neg)

@[to_additive]
lemma continuous_on_inv {s : set G} : continuous_on has_inv.inv s :=
continuous_inv.continuous_on

@[to_additive]
lemma continuous_within_at_inv {s : set G} {x : G} : continuous_within_at has_inv.inv s x :=
continuous_inv.continuous_within_at

@[to_additive]
lemma continuous_at_inv {x : G} : continuous_at has_inv.inv x :=
continuous_inv.continuous_at

@[to_additive]
lemma tendsto_inv (a : G) : tendsto has_inv.inv (𝓝 a) (𝓝 (a⁻¹)) :=
continuous_at_inv

/-- If a function converges to a value in a multiplicative topological group, then its inverse
converges to the inverse of this value. For the version in normed fields assuming additionally
that the limit is nonzero, use `tendsto.inv'`. -/
@[to_additive]
lemma filter.tendsto.inv {f : α → G} {l : filter α} {y : G} (h : tendsto f l (𝓝 y)) :
  tendsto (λ x, (f x)⁻¹) l (𝓝 y⁻¹) :=
(continuous_inv.tendsto y).comp h

variables [topological_space α] {f : α → G} {s : set α} {x : α}

@[continuity, to_additive]
lemma continuous.inv (hf : continuous f) : continuous (λx, (f x)⁻¹) :=
continuous_inv.comp hf

attribute [continuity] continuous.neg -- TODO

@[to_additive]
lemma continuous_on.inv (hf : continuous_on f s) : continuous_on (λx, (f x)⁻¹) s :=
continuous_inv.comp_continuous_on hf

@[to_additive]
lemma continuous_within_at.inv (hf : continuous_within_at f s x) :
  continuous_within_at (λ x, (f x)⁻¹) s x :=
hf.inv

@[instance, to_additive]
instance [topological_space H] [group H] [topological_group H] :
  topological_group (G × H) :=
{ continuous_inv := continuous_inv.prod_map continuous_inv }

@[to_additive]
instance pi.topological_group {C : β → Type*} [∀ b, topological_space (C b)]
  [∀ b, group (C b)] [∀ b, topological_group (C b)] : topological_group (Π b, C b) :=
{ continuous_inv := continuous_pi (λ i, (continuous_apply i).inv) }

variable (G)

/-- Inversion in a topological group as a homeomorphism. -/
@[to_additive "Negation in a topological group as a homeomorphism."]
protected def homeomorph.inv : G ≃ₜ G :=
{ continuous_to_fun  := continuous_inv,
  continuous_inv_fun := continuous_inv,
  .. equiv.inv G }

@[to_additive]
lemma nhds_one_symm : comap has_inv.inv (𝓝 (1 : G)) = 𝓝 (1 : G) :=
((homeomorph.inv G).comap_nhds_eq _).trans (congr_arg nhds one_inv)

/-- The map `(x, y) ↦ (x, xy)` as a homeomorphism. This is a shear mapping. -/
@[to_additive "The map `(x, y) ↦ (x, x + y)` as a homeomorphism.
This is a shear mapping."]
protected def homeomorph.shear_mul_right : G × G ≃ₜ G × G :=
{ continuous_to_fun  := continuous_fst.prod_mk continuous_mul,
  continuous_inv_fun := continuous_fst.prod_mk $ continuous_fst.inv.mul continuous_snd,
  .. equiv.prod_shear (equiv.refl _) equiv.mul_left }

@[simp, to_additive]
lemma homeomorph.shear_mul_right_coe :
  ⇑(homeomorph.shear_mul_right G) = λ z : G × G, (z.1, z.1 * z.2) :=
rfl

@[simp, to_additive]
lemma homeomorph.shear_mul_right_symm_coe :
  ⇑(homeomorph.shear_mul_right G).symm = λ z : G × G, (z.1, z.1⁻¹ * z.2) :=
rfl

variable {G}

@[to_additive]
lemma inv_closure (s : set G) : (closure s)⁻¹ = closure s⁻¹ :=
(homeomorph.inv G).preimage_closure s

/-- The (topological-space) closure of a subgroup of a space `M` with `has_continuous_mul` is
itself a subgroup. -/
@[to_additive "The (topological-space) closure of an additive subgroup of a space `M` with
`has_continuous_add` is itself an additive subgroup."]
def subgroup.topological_closure (s : subgroup G) : subgroup G :=
{ carrier := closure (s : set G),
  inv_mem' := λ g m, by simpa [←mem_inv, inv_closure] using m,
  ..s.to_submonoid.topological_closure }

@[to_additive]
instance subgroup.topological_closure_topological_group (s : subgroup G) :
  topological_group (s.topological_closure) :=
{ continuous_inv :=
  begin
    apply continuous_induced_rng,
    change continuous (λ p : s.topological_closure, (p : G)⁻¹),
    continuity,
  end
  ..s.to_submonoid.topological_closure_has_continuous_mul}

lemma subgroup.subgroup_topological_closure (s : subgroup G) :
  s ≤ s.topological_closure :=
subset_closure

lemma subgroup.is_closed_topological_closure (s : subgroup G) :
  is_closed (s.topological_closure : set G) :=
by convert is_closed_closure

lemma subgroup.topological_closure_minimal
  (s : subgroup G) {t : subgroup G} (h : s ≤ t) (ht : is_closed (t : set G)) :
  s.topological_closure ≤ t :=
closure_minimal h ht

@[to_additive exists_nhds_half_neg]
lemma exists_nhds_split_inv {s : set G} (hs : s ∈ 𝓝 (1 : G)) :
  ∃ V ∈ 𝓝 (1 : G), ∀ (v ∈ V) (w ∈ V), v / w ∈ s :=
have ((λp : G × G, p.1 * p.2⁻¹) ⁻¹' s) ∈ 𝓝 ((1, 1) : G × G),
  from continuous_at_fst.mul continuous_at_snd.inv (by simpa),
by simpa only [div_eq_mul_inv, nhds_prod_eq, mem_prod_self_iff, prod_subset_iff, mem_preimage]
  using this

@[to_additive]
lemma nhds_translation_mul_inv (x : G) : comap (λ y : G, y * x⁻¹) (𝓝 1) = 𝓝 x :=
((homeomorph.mul_right x⁻¹).comap_nhds_eq 1).trans $ show 𝓝 (1 * x⁻¹⁻¹) = 𝓝 x, by simp

@[simp, to_additive] lemma map_mul_left_nhds (x y : G) : map ((*) x) (𝓝 y) = 𝓝 (x * y) :=
(homeomorph.mul_left x).map_nhds_eq y

@[to_additive] lemma map_mul_left_nhds_one (x : G) : map ((*) x) (𝓝 1) = 𝓝 x := by simp

@[to_additive]
lemma topological_group.ext {G : Type*} [group G] {t t' : topological_space G}
  (tg : @topological_group G t _) (tg' : @topological_group G t' _)
  (h : @nhds G t 1 = @nhds G t' 1) : t = t' :=
eq_of_nhds_eq_nhds $ λ x, by
  rw [← @nhds_translation_mul_inv G t _ _ x , ← @nhds_translation_mul_inv G t' _ _ x , ← h]

@[to_additive]
lemma topological_group.of_nhds_aux {G : Type*} [group G] [topological_space G]
  (hinv : tendsto (λ (x : G), x⁻¹) (𝓝 1) (𝓝 1))
  (hleft : ∀ (x₀ : G), 𝓝 x₀ = map (λ (x : G), x₀ * x) (𝓝 1))
  (hconj : ∀ (x₀ : G), map (λ (x : G), x₀ * x * x₀⁻¹) (𝓝 1) ≤ 𝓝 1) : continuous (λ x : G, x⁻¹) :=
begin
  rw continuous_iff_continuous_at,
  rintros x₀,
  have key : (λ x, (x₀*x)⁻¹) = (λ x, x₀⁻¹*x) ∘ (λ x, x₀*x*x₀⁻¹) ∘ (λ x, x⁻¹),
    by {ext ; simp[mul_assoc] },
  calc map (λ x, x⁻¹) (𝓝 x₀)
      = map (λ x, x⁻¹) (map (λ x, x₀*x) $ 𝓝 1) : by rw hleft
  ... = map (λ x, (x₀*x)⁻¹) (𝓝 1) : by rw filter.map_map
  ... = map (((λ x, x₀⁻¹*x) ∘ (λ x, x₀*x*x₀⁻¹)) ∘ (λ x, x⁻¹)) (𝓝 1) : by rw key
  ... = map ((λ x, x₀⁻¹*x) ∘ (λ x, x₀*x*x₀⁻¹)) _ : by rw ← filter.map_map
  ... ≤ map ((λ x, x₀⁻¹ * x) ∘ λ x, x₀ * x * x₀⁻¹) (𝓝 1) : map_mono hinv
  ... = map (λ x, x₀⁻¹ * x) (map (λ x, x₀ * x * x₀⁻¹) (𝓝 1)) : filter.map_map
  ... ≤ map (λ x, x₀⁻¹ * x) (𝓝 1) : map_mono (hconj x₀)
  ... = 𝓝 x₀⁻¹ : (hleft _).symm
end

@[to_additive]
lemma topological_group.of_nhds_one' {G : Type*} [group G] [topological_space G]
  (hmul : tendsto (uncurry ((*) : G → G → G)) ((𝓝 1) ×ᶠ 𝓝 1) (𝓝 1))
  (hinv : tendsto (λ x : G, x⁻¹) (𝓝 1) (𝓝 1))
  (hleft : ∀ x₀ : G, 𝓝 x₀ = map (λ x, x₀*x) (𝓝 1))
  (hright : ∀ x₀ : G, 𝓝 x₀ = map (λ x, x*x₀) (𝓝 1)) : topological_group G :=
begin
  refine { continuous_mul := (has_continuous_mul.of_nhds_one hmul hleft hright).continuous_mul,
           continuous_inv := topological_group.of_nhds_aux hinv hleft _ },
  intros x₀,
  suffices : map (λ (x : G), x₀ * x * x₀⁻¹) (𝓝 1) = 𝓝 1, by simp [this, le_refl],
  rw [show (λ x, x₀ * x * x₀⁻¹) = (λ x, x₀ * x) ∘ λ x, x*x₀⁻¹, by {ext, simp [mul_assoc] },
      ← filter.map_map, ← hright, hleft x₀⁻¹, filter.map_map],
  convert map_id,
  ext,
  simp
end

@[to_additive]
lemma topological_group.of_nhds_one {G : Type u} [group G] [topological_space G]
  (hmul : tendsto (uncurry ((*) : G → G → G)) ((𝓝 1) ×ᶠ 𝓝 1) (𝓝 1))
  (hinv : tendsto (λ x : G, x⁻¹) (𝓝 1) (𝓝 1))
  (hleft : ∀ x₀ : G, 𝓝 x₀ = map (λ x, x₀*x) (𝓝 1))
  (hconj : ∀ x₀ : G, tendsto (λ x, x₀*x*x₀⁻¹) (𝓝 1) (𝓝 1)) : topological_group G :=
 { continuous_mul := begin
    rw continuous_iff_continuous_at,
    rintros ⟨x₀, y₀⟩,
    have key : (λ (p : G × G), x₀ * p.1 * (y₀ * p.2)) =
      ((λ x, x₀*y₀*x) ∘ (uncurry (*)) ∘ (prod.map (λ x, y₀⁻¹*x*y₀) id)),
      by { ext, simp [uncurry, prod.map, mul_assoc] },
    specialize hconj y₀⁻¹, rw inv_inv at hconj,
    calc map (λ (p : G × G), p.1 * p.2) (𝓝 (x₀, y₀))
        = map (λ (p : G × G), p.1 * p.2) ((𝓝 x₀) ×ᶠ 𝓝 y₀)
            : by rw nhds_prod_eq
    ... = map (λ (p : G × G), x₀ * p.1 * (y₀ * p.2)) ((𝓝 1) ×ᶠ (𝓝 1))
            : by rw [hleft x₀, hleft y₀, prod_map_map_eq, filter.map_map]
    ... = map (((λ x, x₀*y₀*x) ∘ (uncurry (*))) ∘ (prod.map (λ x, y₀⁻¹*x*y₀) id))((𝓝 1) ×ᶠ (𝓝 1))
            : by rw key
    ... = map ((λ x, x₀*y₀*x) ∘ (uncurry (*))) ((map  (λ x, y₀⁻¹*x*y₀) $ 𝓝 1) ×ᶠ (𝓝 1))
            : by rw [← filter.map_map, ← prod_map_map_eq', map_id]
    ... ≤ map ((λ x, x₀*y₀*x) ∘ (uncurry (*))) ((𝓝 1) ×ᶠ (𝓝 1))
            : map_mono (filter.prod_mono hconj $ le_refl _)
    ... = map (λ x, x₀*y₀*x) (map (uncurry (*)) ((𝓝 1) ×ᶠ (𝓝 1)))   : by rw filter.map_map
    ... ≤ map (λ x, x₀*y₀*x) (𝓝 1)   : map_mono hmul
    ... = 𝓝 (x₀*y₀)   : (hleft _).symm
  end,
  continuous_inv := topological_group.of_nhds_aux hinv hleft hconj}

@[to_additive]
lemma topological_group.of_comm_of_nhds_one {G : Type*} [comm_group G] [topological_space G]
  (hmul : tendsto (uncurry ((*) : G → G → G)) ((𝓝 1) ×ᶠ 𝓝 1) (𝓝 1))
  (hinv : tendsto (λ x : G, x⁻¹) (𝓝 1) (𝓝 1))
  (hleft : ∀ x₀ : G, 𝓝 x₀ = map (λ x, x₀*x) (𝓝 1)) : topological_group G :=
topological_group.of_nhds_one hmul hinv hleft (by simpa using tendsto_id)

end topological_group

section quotient_topological_group
variables [topological_space G] [group G] [topological_group G] (N : subgroup G) (n : N.normal)

@[to_additive]
instance {G : Type*} [group G] [topological_space G] (N : subgroup G) :
  topological_space (quotient_group.quotient N) :=
quotient.topological_space

open quotient_group

@[to_additive]
lemma quotient_group.is_open_map_coe : is_open_map (coe : G →  quotient N) :=
begin
  intros s s_op,
  change is_open ((coe : G →  quotient N) ⁻¹' (coe '' s)),
  rw quotient_group.preimage_image_coe N s,
  exact is_open_Union (λ n, is_open_map_mul_right n s s_op)
end

@[to_additive]
instance topological_group_quotient [N.normal] : topological_group (quotient N) :=
{ continuous_mul := begin
    have cont : continuous ((coe : G → quotient N) ∘ (λ (p : G × G), p.fst * p.snd)) :=
      continuous_quot_mk.comp continuous_mul,
    have quot : quotient_map (λ p : G × G, ((p.1:quotient N), (p.2:quotient N))),
    { apply is_open_map.to_quotient_map,
      { exact (quotient_group.is_open_map_coe N).prod (quotient_group.is_open_map_coe N) },
      { exact continuous_quot_mk.prod_map continuous_quot_mk },
      { exact (surjective_quot_mk _).prod_map (surjective_quot_mk _) } },
    exact (quotient_map.continuous_iff quot).2 cont,
  end,
  continuous_inv := begin
    have : continuous ((coe : G → quotient N) ∘ (λ (a : G), a⁻¹)) :=
      continuous_quot_mk.comp continuous_inv,
    convert continuous_quotient_lift _ this,
  end }

attribute [instance] topological_add_group_quotient

end quotient_topological_group

/-- A typeclass saying that `λ p : G × G, p.1 - p.2` is a continuous function. This property
automatically holds for topological additive groups but it also holds, e.g., for `ℝ≥0`. -/
class has_continuous_sub (G : Type*) [topological_space G] [has_sub G] : Prop :=
(continuous_sub : continuous (λ p : G × G, p.1 - p.2))

@[priority 100] -- see Note [lower instance priority]
instance topological_add_group.to_has_continuous_sub [topological_space G] [add_group G]
  [topological_add_group G] :
  has_continuous_sub G :=
⟨by { simp only [sub_eq_add_neg], exact continuous_fst.add continuous_snd.neg }⟩

export has_continuous_sub (continuous_sub)

section has_continuous_sub

variables [topological_space G] [has_sub G] [has_continuous_sub G]

lemma filter.tendsto.sub {f g : α → G} {l : filter α} {a b : G} (hf : tendsto f l (𝓝 a))
  (hg : tendsto g l (𝓝 b)) :
  tendsto (λx, f x - g x) l (𝓝 (a - b)) :=
(continuous_sub.tendsto (a, b)).comp (hf.prod_mk_nhds hg)

variables [topological_space α] {f g : α → G} {s : set α} {x : α}

@[continuity] lemma continuous.sub (hf : continuous f) (hg : continuous g) :
  continuous (λ x, f x - g x) :=
continuous_sub.comp (hf.prod_mk hg : _)

lemma continuous_within_at.sub (hf : continuous_within_at f s x) (hg : continuous_within_at g s x) :
  continuous_within_at (λ x, f x - g x) s x :=
hf.sub hg

lemma continuous_on.sub (hf : continuous_on f s) (hg : continuous_on g s) :
  continuous_on (λx, f x - g x) s :=
λ x hx, (hf x hx).sub (hg x hx)

end has_continuous_sub

lemma nhds_translation [topological_space G] [add_group G] [topological_add_group G] (x : G) :
  comap (λy:G, y - x) (𝓝 0) = 𝓝 x :=
by simpa only [sub_eq_add_neg] using nhds_translation_add_neg x

/-- additive group with a neighbourhood around 0.
Only used to construct a topology and uniform space.

This is currently only available for commutative groups, but it can be extended to
non-commutative groups too.
-/
class add_group_with_zero_nhd (G : Type u) extends add_comm_group G :=
(Z [] : filter G)
(zero_Z : pure 0 ≤ Z)
(sub_Z : tendsto (λp:G×G, p.1 - p.2) (Z ×ᶠ Z) Z)

namespace add_group_with_zero_nhd
variables (G) [add_group_with_zero_nhd G]

local notation `Z` := add_group_with_zero_nhd.Z

@[priority 100] -- see Note [lower instance priority]
instance : topological_space G :=
topological_space.mk_of_nhds $ λa, map (λx, x + a) (Z G)

variables {G}

lemma neg_Z : tendsto (λa:G, - a) (Z G) (Z G) :=
have tendsto (λa, (0:G)) (Z G) (Z G),
  by refine le_trans (assume h, _) zero_Z; simp [univ_mem_sets'] {contextual := tt},
have tendsto (λa:G, 0 - a) (Z G) (Z G), from
  sub_Z.comp (tendsto.prod_mk this tendsto_id),
by simpa

lemma add_Z : tendsto (λp:G×G, p.1 + p.2) (Z G ×ᶠ Z G) (Z G) :=
suffices tendsto (λp:G×G, p.1 - -p.2) (Z G ×ᶠ Z G) (Z G),
  by simpa [sub_eq_add_neg],
sub_Z.comp (tendsto.prod_mk tendsto_fst (neg_Z.comp tendsto_snd))

lemma exists_Z_half {s : set G} (hs : s ∈ Z G) : ∃ V ∈ Z G, ∀ (v ∈ V) (w ∈ V), v + w ∈ s :=
begin
  have : ((λa:G×G, a.1 + a.2) ⁻¹' s) ∈ Z G ×ᶠ Z G := add_Z (by simpa using hs),
  rcases mem_prod_self_iff.1 this with ⟨V, H, H'⟩,
  exact ⟨V, H, prod_subset_iff.1 H'⟩
end

lemma nhds_eq (a : G) : 𝓝 a = map (λx, x + a) (Z G) :=
topological_space.nhds_mk_of_nhds _ _
  (assume a, calc pure a = map (λx, x + a) (pure 0) : by simp
    ... ≤ _ : map_mono zero_Z)
  (assume b s hs,
    let ⟨t, ht, eqt⟩ := exists_Z_half hs in
    have t0 : (0:G) ∈ t, by simpa using zero_Z ht,
    begin
      refine ⟨(λx:G, x + b) '' t, image_mem_map ht, _, _⟩,
      { refine set.image_subset_iff.2 (assume b hbt, _),
        simpa using eqt 0 t0 b hbt },
      { rintros _ ⟨c, hb, rfl⟩,
        refine (Z G).sets_of_superset ht (assume x hxt, _),
        simpa [add_assoc] using eqt _ hxt _ hb }
    end)

lemma nhds_zero_eq_Z : 𝓝 0 = Z G := by simp [nhds_eq]; exact filter.map_id

@[priority 100] -- see Note [lower instance priority]
instance : has_continuous_add G :=
⟨ continuous_iff_continuous_at.2 $ assume ⟨a, b⟩,
  begin
    rw [continuous_at, nhds_prod_eq, nhds_eq, nhds_eq, nhds_eq, filter.prod_map_map_eq,
      tendsto_map'_iff],
    suffices :  tendsto ((λx:G, (a + b) + x) ∘ (λp:G×G,p.1 + p.2)) (Z G ×ᶠ Z G)
      (map (λx:G, (a + b) + x) (Z G)),
    { simpa [(∘), add_comm, add_left_comm] },
    exact tendsto_map.comp add_Z
  end ⟩

@[priority 100] -- see Note [lower instance priority]
instance : topological_add_group G :=
⟨continuous_iff_continuous_at.2 $ assume a,
  begin
    rw [continuous_at, nhds_eq, nhds_eq, tendsto_map'_iff],
    suffices : tendsto ((λx:G, x - a) ∘ (λx:G, -x)) (Z G) (map (λx:G, x - a) (Z G)),
    { simpa [(∘), add_comm, sub_eq_add_neg] using this },
    exact tendsto_map.comp neg_Z
  end⟩

end add_group_with_zero_nhd

section filter_mul

section
variables [topological_space G] [group G] [topological_group G]

@[to_additive]
lemma is_open.mul_left {s t : set G} : is_open t → is_open (s * t) := λ ht,
begin
  have : ∀a, is_open ((λ (x : G), a * x) '' t) :=
    assume a, is_open_map_mul_left a t ht,
  rw ← Union_mul_left_image,
  exact is_open_Union (λa, is_open_Union $ λha, this _),
end

@[to_additive]
lemma is_open.mul_right {s t : set G} : is_open s → is_open (s * t) := λ hs,
begin
  have : ∀a, is_open ((λ (x : G), x * a) '' s),
    assume a, apply is_open_map_mul_right, exact hs,
  rw ← Union_mul_right_image,
  exact is_open_Union (λa, is_open_Union $ λha, this _),
end

variables (G)

lemma topological_group.t1_space (h : @is_closed G _ {1}) : t1_space G :=
⟨assume x, by { convert is_closed_map_mul_right x _ h, simp }⟩

lemma topological_group.regular_space [t1_space G] : regular_space G :=
⟨assume s a hs ha,
 let f := λ p : G × G, p.1 * (p.2)⁻¹ in
 have hf : continuous f := continuous_fst.mul continuous_snd.inv,
 -- a ∈ -s implies f (a, 1) ∈ -s, and so (a, 1) ∈ f⁻¹' (-s);
 -- and so can find t₁ t₂ open such that a ∈ t₁ × t₂ ⊆ f⁻¹' (-s)
 let ⟨t₁, t₂, ht₁, ht₂, a_mem_t₁, one_mem_t₂, t_subset⟩ :=
   is_open_prod_iff.1 ((is_open_compl_iff.2 hs).preimage hf) a (1:G) (by simpa [f]) in
 begin
   use [s * t₂, ht₂.mul_left, λ x hx, ⟨x, 1, hx, one_mem_t₂, mul_one _⟩],
   rw [nhds_within, inf_principal_eq_bot, mem_nhds_sets_iff],
   refine ⟨t₁, _, ht₁, a_mem_t₁⟩,
   rintros x hx ⟨y, z, hy, hz, yz⟩,
   have : x * z⁻¹ ∈ sᶜ := (prod_subset_iff.1 t_subset) x hx z hz,
   have : x * z⁻¹ ∈ s, rw ← yz, simpa,
   contradiction
 end⟩

local attribute [instance] topological_group.regular_space

lemma topological_group.t2_space [t1_space G] : t2_space G := regular_space.t2_space G

end

section

/-! Some results about an open set containing the product of two sets in a topological group. -/

variables [topological_space G] [group G] [topological_group G]

/-- Given a compact set `K` inside an open set `U`, there is a open neighborhood `V` of `1`
  such that `KV ⊆ U`. -/
@[to_additive "Given a compact set `K` inside an open set `U`, there is a open neighborhood `V` of
`0` such that `K + V ⊆ U`."]
lemma compact_open_separated_mul {K U : set G} (hK : is_compact K) (hU : is_open U) (hKU : K ⊆ U) :
  ∃ V : set G, is_open V ∧ (1 : G) ∈ V ∧ K * V ⊆ U :=
begin
  let W : G → set G := λ x, (λ y, x * y) ⁻¹' U,
  have h1W : ∀ x, is_open (W x) := λ x, hU.preimage (continuous_mul_left x),
  have h2W : ∀ x ∈ K, (1 : G) ∈ W x := λ x hx, by simp only [mem_preimage, mul_one, hKU hx],
  choose V hV using λ x : K, exists_open_nhds_one_mul_subset (mem_nhds_sets (h1W x) (h2W x.1 x.2)),
  let X : K → set G := λ x, (λ y, (x : G)⁻¹ * y) ⁻¹' (V x),
  obtain ⟨t, ht⟩ : ∃ t : finset ↥K, K ⊆ ⋃ i ∈ t, X i,
  { refine hK.elim_finite_subcover X (λ x, (hV x).1.preimage (continuous_mul_left x⁻¹)) _,
    intros x hx, rw [mem_Union], use ⟨x, hx⟩, rw [mem_preimage], convert (hV _).2.1,
    simp only [mul_left_inv, subtype.coe_mk] },
  refine ⟨⋂ x ∈ t, V x, is_open_bInter (finite_mem_finset _) (λ x hx, (hV x).1), _, _⟩,
  { simp only [mem_Inter], intros x hx, exact (hV x).2.1 },
  rintro _ ⟨x, y, hx, hy, rfl⟩, simp only [mem_Inter] at hy,
  have := ht hx, simp only [mem_Union, mem_preimage] at this, rcases this with ⟨z, h1z, h2z⟩,
  have : (z : G)⁻¹ * x * y ∈ W z := (hV z).2.2 (mul_mem_mul h2z (hy z h1z)),
  rw [mem_preimage] at this, convert this using 1, simp only [mul_assoc, mul_inv_cancel_left]
end

/-- A compact set is covered by finitely many left multiplicative translates of a set
  with non-empty interior. -/
@[to_additive "A compact set is covered by finitely many left additive translates of a set
  with non-empty interior."]
lemma compact_covered_by_mul_left_translates {K V : set G} (hK : is_compact K)
  (hV : (interior V).nonempty) : ∃ t : finset G, K ⊆ ⋃ g ∈ t, (λ h, g * h) ⁻¹' V :=
begin
  obtain ⟨t, ht⟩ : ∃ t : finset G, K ⊆ ⋃ x ∈ t, interior (((*) x) ⁻¹' V),
  { refine hK.elim_finite_subcover (λ x, interior $ ((*) x) ⁻¹' V) (λ x, is_open_interior) _,
    cases hV with g₀ hg₀,
    refine λ g hg, mem_Union.2 ⟨g₀ * g⁻¹, _⟩,
    refine preimage_interior_subset_interior_preimage (continuous_const.mul continuous_id) _,
    rwa [mem_preimage, inv_mul_cancel_right] },
  exact ⟨t, subset.trans ht $ bUnion_subset_bUnion_right $ λ g hg, interior_subset⟩
end

/-- Every locally compact separable topological group is σ-compact.
  Note: this is not true if we drop the topological group hypothesis. -/
@[priority 100] instance separable_locally_compact_group.sigma_compact_space
  [separable_space G] [locally_compact_space G] : sigma_compact_space G :=
begin
  obtain ⟨L, hLc, hL1⟩ := exists_compact_mem_nhds (1 : G),
  refine ⟨⟨λ n, (λ x, x * dense_seq G n) ⁻¹' L, _, _⟩⟩,
  { intro n, exact (homeomorph.mul_right _).compact_preimage.mpr hLc },
  { refine Union_eq_univ_iff.2 (λ x, _),
    obtain ⟨_, ⟨n, rfl⟩, hn⟩ : (range (dense_seq G) ∩ (λ y, x * y) ⁻¹' L).nonempty,
    { rw [← (homeomorph.mul_left x).apply_symm_apply 1] at hL1,
      exact (dense_range_dense_seq G).inter_nhds_nonempty
        ((homeomorph.mul_left x).continuous.continuous_at $ hL1) },
    exact ⟨n, hn⟩ }
end

end

section
variables [topological_space G] [comm_group G] [topological_group G]

@[to_additive]
lemma nhds_mul (x y : G) : 𝓝 (x * y) = 𝓝 x * 𝓝 y :=
filter_eq $ set.ext $ assume s,
begin
  rw [← nhds_translation_mul_inv x, ← nhds_translation_mul_inv y, ← nhds_translation_mul_inv (x*y)],
  split,
  { rintros ⟨t, ht, ts⟩,
    rcases exists_nhds_one_split ht with ⟨V, V1, h⟩,
    refine ⟨(λa, a * x⁻¹) ⁻¹' V, (λa, a * y⁻¹) ⁻¹' V,
            ⟨V, V1, subset.refl _⟩, ⟨V, V1, subset.refl _⟩, _⟩,
    rintros a ⟨v, w, v_mem, w_mem, rfl⟩,
    apply ts,
    simpa [mul_comm, mul_assoc, mul_left_comm] using h (v * x⁻¹) v_mem (w * y⁻¹) w_mem },
  { rintros ⟨a, c, ⟨b, hb, ba⟩, ⟨d, hd, dc⟩, ac⟩,
    refine ⟨b ∩ d, inter_mem_sets hb hd, assume v, _⟩,
    simp only [preimage_subset_iff, mul_inv_rev, mem_preimage] at *,
    rintros ⟨vb, vd⟩,
    refine ac ⟨v * y⁻¹, y, _, _, _⟩,
    { rw ← mul_assoc _ _ _ at vb, exact ba _ vb },
    { apply dc y, rw mul_right_inv, exact mem_of_nhds hd },
    { simp only [inv_mul_cancel_right] } }
end

@[to_additive]
lemma nhds_is_mul_hom : is_mul_hom (λx:G, 𝓝 x) := ⟨λ_ _, nhds_mul _ _⟩

end

end filter_mul

instance additive.topological_add_group {G} [h : topological_space G]
  [group G] [topological_group G] : @topological_add_group (additive G) h _ :=
{ continuous_neg := @continuous_inv G _ _ _ }

instance multiplicative.topological_group {G} [h : topological_space G]
  [add_group G] [topological_add_group G] : @topological_group (multiplicative G) h _ :=
{ continuous_inv := @continuous_neg G _ _ _ }

namespace units

variables [monoid α] [topological_space α] [has_continuous_mul α]

instance : topological_group (units α) :=
{ continuous_inv := continuous_induced_rng ((continuous_unop.comp (continuous_snd.comp
    (@continuous_embed_product α _ _))).prod_mk (continuous_op.comp continuous_coe)) }

end units


/-
Copyright (c) 2020 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn
-/
import data.list.nodup

/-!
# Finite products of types

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

This file defines the product of types over a list. For `l : list ι` and `α : ι → Type*` we define
`list.tprod α l = l.foldr (λ i β, α i × β) punit`.
This type should not be used if `Π i, α i` or `Π i ∈ l, α i` can be used instead
(in the last expression, we could also replace the list `l` by a set or a finset).
This type is used as an intermediary between binary products and finitary products.
The application of this type is finitary product measures, but it could be used in any
construction/theorem that is easier to define/prove on binary products than on finitary products.

* Once we have the construction on binary products (like binary product measures in
  `measure_theory.prod`), we can easily define a finitary version on the type `tprod l α`
  by iterating. Properties can also be easily extended from the binary case to the finitary case
  by iterating.
* Then we can use the equivalence `list.tprod.pi_equiv_tprod` below (or enhanced versions of it,
  like a `measurable_equiv` for product measures) to get the construction on `Π i : ι, α i`, at
  least when assuming `[fintype ι] [encodable ι]` (using `encodable.sorted_univ`).
  Using `local attribute [instance] fintype.to_encodable` we can get rid of the argument
  `[encodable ι]`.

## Main definitions

* We have the equivalence `tprod.pi_equiv_tprod : (Π i, α i) ≃ tprod α l`
  if `l` contains every element of `ι` exactly once.
* The product of sets is `set.tprod : (Π i, set (α i)) → set (tprod α l)`.
-/

open list function

variables {ι : Type*} {α : ι → Type*} {i j : ι} {l : list ι} {f : Π i, α i}

namespace list

variable (α)

/-- The product of a family of types over a list. -/
def tprod (l : list ι) : Type* :=
l.foldr (λ i β, α i × β) punit

variable {α}

namespace tprod

open list

/-- Turning a function `f : Π i, α i` into an element of the iterated product `tprod α l`. -/
protected def mk : ∀ (l : list ι) (f : Π i, α i), tprod α l
| []        := λ f, punit.star
| (i :: is) := λ f, (f i, mk is f)

instance [∀ i, inhabited (α i)] : inhabited (tprod α l) :=
⟨tprod.mk l default⟩

@[simp] lemma fst_mk (i : ι) (l : list ι) (f : Π i, α i) : (tprod.mk (i::l) f).1 = f i := rfl

@[simp]
lemma snd_mk (i : ι) (l : list ι) (f : Π i, α i) : (tprod.mk (i::l) f).2 = tprod.mk l f := rfl

variables [decidable_eq ι]

/-- Given an element of the iterated product `l.prod α`, take a projection into direction `i`.
  If `i` appears multiple times in `l`, this chooses the first component in direction `i`. -/
protected def elim : ∀ {l : list ι} (v : tprod α l) {i : ι} (hi : i ∈ l), α i
| (i :: is) v j hj :=
  if hji : j = i then by { subst hji, exact v.1 } else elim v.2 (hj.resolve_left hji)

@[simp] lemma elim_self (v : tprod α (i :: l)) : v.elim (l.mem_cons_self i) = v.1 :=
by simp [tprod.elim]

@[simp] lemma elim_of_ne (hj : j ∈ i :: l) (hji : j ≠ i) (v : tprod α (i :: l)) :
  v.elim hj = tprod.elim v.2 (hj.resolve_left hji) :=
by simp [tprod.elim, hji]

@[simp] lemma elim_of_mem (hl : (i :: l).nodup) (hj : j ∈ l) (v : tprod α (i :: l)) :
  v.elim (mem_cons_of_mem _ hj) = tprod.elim v.2 hj :=
by { apply elim_of_ne, rintro rfl, exact hl.not_mem hj }

lemma elim_mk : ∀ (l : list ι) (f : Π i, α i) {i : ι} (hi : i ∈ l),
  (tprod.mk l f).elim hi = f i
| (i :: is) f j hj := begin
      by_cases hji : j = i,
      { subst hji, simp },
      { rw [elim_of_ne _ hji, snd_mk, elim_mk] }
  end

@[ext] lemma ext : ∀ {l : list ι} (hl : l.nodup) {v w : tprod α l}
  (hvw : ∀ i (hi : i ∈ l), v.elim hi = w.elim hi), v = w
| []        hl v w hvw := punit.ext
| (i :: is) hl v w hvw := begin
    ext, rw [← elim_self v, hvw, elim_self],
    refine ext (nodup_cons.mp hl).2 (λ j hj, _),
    rw [← elim_of_mem hl, hvw, elim_of_mem hl]
  end

/-- A version of `tprod.elim` when `l` contains all elements. In this case we get a function into
  `Π i, α i`. -/
@[simp] protected def elim' (h : ∀ i, i ∈ l) (v : tprod α l) (i : ι) : α i :=
v.elim (h i)

lemma mk_elim (hnd : l.nodup) (h : ∀ i, i ∈ l) (v : tprod α l) : tprod.mk l (v.elim' h) = v :=
tprod.ext hnd (λ i hi, by simp [elim_mk])

/-- Pi-types are equivalent to iterated products. -/
def pi_equiv_tprod (hnd : l.nodup) (h : ∀ i, i ∈ l) : (Π i, α i) ≃ tprod α l :=
⟨tprod.mk l, tprod.elim' h, λ f, funext $ λ i, elim_mk l f (h i), mk_elim hnd h⟩

end tprod

end list

namespace set

open list
/-- A product of sets in `tprod α l`. -/
@[simp] protected def tprod : ∀ (l : list ι) (t : Π i, set (α i)), set (tprod α l)
| []        t := univ
| (i :: is) t := t i ×ˢ tprod is t

lemma mk_preimage_tprod : ∀ (l : list ι) (t : Π i, set (α i)),
  tprod.mk l ⁻¹' set.tprod l t = {i | i ∈ l}.pi t
| []        t := by simp [set.tprod]
| (i :: l) t := begin
  ext f,
  have : f ∈ tprod.mk l ⁻¹' set.tprod l t ↔ f ∈ {x | x ∈ l}.pi t, { rw [mk_preimage_tprod l t] },
  change tprod.mk l f ∈ set.tprod l t ↔ ∀ (i : ι), i ∈ l → f i ∈ t i at this,
  /- `simp [set.tprod, tprod.mk, this]` can close this goal but is slow. -/
  rw [set.tprod, tprod.mk, mem_preimage, mem_pi, prod_mk_mem_set_prod_eq],
  simp_rw [mem_set_of_eq, mem_cons_iff],
  rw [forall_eq_or_imp, and.congr_right_iff],
  exact λ _, this
end

lemma elim_preimage_pi [decidable_eq ι] {l : list ι} (hnd : l.nodup) (h : ∀ i, i ∈ l)
  (t : Π i, set (α i)) : tprod.elim' h ⁻¹' pi univ t = set.tprod l t :=
begin
  have : { i | i ∈ l } = univ, { ext i, simp [h] },
  rw [← this, ← mk_preimage_tprod, preimage_preimage],
  convert preimage_id, simp [tprod.mk_elim hnd h, id_def]
end

end set


/-
Copyright (c) 2020 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.homeomorph
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-!
# Compact sets

## Summary

We define the subtype of compact sets in a topological space.

## Main Definitions

- `closeds α` is the type of closed subsets of a topological space `α`.
- `compacts α` is the type of compact subsets of a topological space `α`.
- `nonempty_compacts α` is the type of non-empty compact subsets.
- `positive_compacts α` is the type of compact subsets with non-empty interior.
-/

namespace topological_space

/-- The type of closed subsets of a topological space. -/
def closeds (α : Type u_1) [topological_space α] := Subtype fun (s : set α) => is_closed s

/-- The type of closed subsets is inhabited, with default element the empty set. -/
protected instance closeds.inhabited (α : Type u_1) [topological_space α] : Inhabited (closeds α) :=
  { default := { val := ∅, property := is_closed_empty } }

/-- The compact sets of a topological space. See also `nonempty_compacts`. -/
def compacts (α : Type u_1) [topological_space α] := Subtype fun (s : set α) => is_compact s

/-- The type of non-empty compact subsets of a topological space. The
non-emptiness will be useful in metric spaces, as we will be able to put
a distance (and not merely an edistance) on this space. -/
def nonempty_compacts (α : Type u_1) [topological_space α] :=
  Subtype fun (s : set α) => set.nonempty s ∧ is_compact s

/-- In an inhabited space, the type of nonempty compact subsets is also inhabited, with
default element the singleton set containing the default element. -/
protected instance nonempty_compacts_inhabited (α : Type u_1) [topological_space α] [Inhabited α] :
    Inhabited (nonempty_compacts α) :=
  { default := { val := singleton Inhabited.default, property := sorry } }

/-- The compact sets with nonempty interior of a topological space. See also `compacts` and
  `nonempty_compacts`. -/
def positive_compacts (α : Type u_1) [topological_space α] :=
  Subtype fun (s : set α) => is_compact s ∧ set.nonempty (interior s)

namespace compacts

protected instance semilattice_sup_bot {α : Type u_1} [topological_space α] :
    semilattice_sup_bot (compacts α) :=
  subtype.semilattice_sup_bot compact_empty sorry

protected instance semilattice_inf_bot {α : Type u_1} [topological_space α] [t2_space α] :
    semilattice_inf_bot (compacts α) :=
  subtype.semilattice_inf_bot compact_empty sorry

protected instance lattice {α : Type u_1} [topological_space α] [t2_space α] :
    lattice (compacts α) :=
  subtype.lattice sorry sorry

@[simp] theorem bot_val {α : Type u_1} [topological_space α] : subtype.val ⊥ = ∅ := rfl

@[simp] theorem sup_val {α : Type u_1} [topological_space α] {K₁ : compacts α} {K₂ : compacts α} :
    subtype.val (K₁ ⊔ K₂) = subtype.val K₁ ∪ subtype.val K₂ :=
  rfl

protected theorem ext {α : Type u_1} [topological_space α] {K₁ : compacts α} {K₂ : compacts α}
    (h : subtype.val K₁ = subtype.val K₂) : K₁ = K₂ :=
  subtype.eq h

@[simp] theorem finset_sup_val {α : Type u_1} [topological_space α] {β : Type u_2}
    {K : β → compacts α} {s : finset β} :
    subtype.val (finset.sup s K) = finset.sup s fun (x : β) => subtype.val (K x) :=
  finset.sup_coe s K

protected instance inhabited {α : Type u_1} [topological_space α] : Inhabited (compacts α) :=
  { default := ⊥ }

/-- The image of a compact set under a continuous function. -/
protected def map {α : Type u_1} {β : Type u_2} [topological_space α] [topological_space β]
    (f : α → β) (hf : continuous f) (K : compacts α) : compacts β :=
  { val := f '' subtype.val K, property := sorry }

@[simp] theorem map_val {α : Type u_1} {β : Type u_2} [topological_space α] [topological_space β]
    {f : α → β} (hf : continuous f) (K : compacts α) :
    subtype.val (compacts.map f hf K) = f '' subtype.val K :=
  rfl

/-- A homeomorphism induces an equivalence on compact sets, by taking the image. -/
@[simp] protected def equiv {α : Type u_1} {β : Type u_2} [topological_space α]
    [topological_space β] (f : α ≃ₜ β) : compacts α ≃ compacts β :=
  equiv.mk (compacts.map (⇑f) (homeomorph.continuous f)) (compacts.map ⇑(homeomorph.symm f) sorry)
    sorry sorry

/-- The image of a compact set under a homeomorphism can also be expressed as a preimage. -/
theorem equiv_to_fun_val {α : Type u_1} {β : Type u_2} [topological_space α] [topological_space β]
    (f : α ≃ₜ β) (K : compacts α) :
    subtype.val (coe_fn (compacts.equiv f) K) = ⇑(homeomorph.symm f) ⁻¹' subtype.val K :=
  congr_fun
    (set.image_eq_preimage_of_inverse (equiv.left_inv (homeomorph.to_equiv f))
      (equiv.right_inv (homeomorph.to_equiv f)))
    (subtype.val K)

end compacts

protected instance nonempty_compacts.to_compact_space {α : Type u_1} [topological_space α]
    {p : nonempty_compacts α} : compact_space ↥(subtype.val p) :=
  compact_space.mk (iff.mp compact_iff_compact_univ (and.right (subtype.property p)))

protected instance nonempty_compacts.to_nonempty {α : Type u_1} [topological_space α]
    {p : nonempty_compacts α} : Nonempty ↥(subtype.val p) :=
  set.nonempty.to_subtype (and.left (subtype.property p))

/-- Associate to a nonempty compact subset the corresponding closed subset -/
def nonempty_compacts.to_closeds {α : Type u_1} [topological_space α] [t2_space α] :
    nonempty_compacts α → closeds α :=
  set.inclusion sorry

end Mathlib


theorem tst1 {α : Type} {p : Prop} (xs : List α) (h₁ : (a : α) → (as : List α) → xs = a :: as → p) (h₂ : xs = [] → p) : p :=
by match (generalizing := false) h:xs with
   | []    => exact h₂ h
   | z::zs => apply h₁ z zs; assumption

theorem tst1' {α : Type} {p : Prop} (xs : List α) (h₁ : (a : α) → (as : List α) → xs = a :: as → p) (h₂ : xs = [] → p) : p :=
by match xs with
   | []    => exact h₂ rfl
   | z::zs => exact h₁ z zs rfl

theorem tst2 {α : Type} {p : Prop} (xs : List α) (h₁ : (a : α) → (as : List α) → xs = a :: as → p) (h₂ : xs = [] → p) : p :=
by match (generalizing := false) h:xs with
   | []    => ?nilCase
   | z::zs => ?consCase;
   case consCase => exact h₁ z zs h;
   case nilCase => exact h₂ h

def tst3 {α β γ : Type} (h : α × β × γ) : β × α × γ :=
by {
  match h with
  | (a, b, c) => exact (b, a, c)
}

theorem tst4 {α : Type} {p : Prop} (xs : List α) (h₁ : (a : α) → (as : List α) → xs = a :: as → p) (h₂ : xs = [] → p) : p := by
match (generalizing := false) h:xs with
| []    => _
| z::zs => _
case match_2 => exact h₁ z zs h
exact h₂ h

theorem tst5 {p q r} (h : p ∨ q ∨ r) : r ∨ q ∨ p:= by
match h with
| Or.inl h          => exact Or.inr (Or.inr h)
| Or.inr (Or.inl h) => ?c1
| Or.inr (Or.inr h) => ?c2
case c2 =>
  apply Or.inl
  assumption
case c1 =>
  apply Or.inr
  apply Or.inl
  assumption

theorem tst6 {p q r} (h : p ∨ q ∨ r) : r ∨ q ∨ p:= by
match h with
| Or.inl h          => exact Or.inr (Or.inr h)
| Or.inr (Or.inl h) => ?c1
| Or.inr (Or.inr h) =>
  apply Or.inl
  assumption
case c1 => apply Or.inr; apply Or.inl; assumption

theorem tst7 {p q r} (h : p ∨ q ∨ r) : r ∨ q ∨ p:=
by match h with
   | Or.inl h =>
     exact Or.inr (Or.inr h)
   | Or.inr (Or.inl h) =>
     apply Or.inr;
     apply Or.inl;
     assumption
   | Or.inr (Or.inr h) =>
     apply Or.inl;
     assumption

inductive ListLast.{u} {α : Type u} : List α → Type u
| empty    : ListLast []
| nonEmpty : (as : List α) → (a : α) → ListLast (as ++ [a])

axiom last {α} (xs : List α) : ListLast xs
axiom back {α} [Inhabited α] (xs : List α) : α
axiom popBack {α} : List α → List α
axiom backEq {α} [Inhabited α] : (xs : List α) → (x : α) → back (xs ++ [x]) = x
axiom popBackEq {α} : (xs : List α) → (x : α) → popBack (xs ++ [x]) = xs

theorem tst8 {α} [Inhabited α] (xs : List α) : xs ≠ [] → xs = popBack xs ++ [back xs] :=
match (generalizing := false) xs, h:last xs with
| _, ListLast.empty         => fun h => absurd rfl h
| _, ListLast.nonEmpty ys y => fun _ => sorry

theorem tst9 {α} [Inhabited α] (xs : List α) : xs ≠ [] → xs = popBack xs ++ [back xs] := by
  match (generalizing := false) xs, h:last xs with
  | _, ListLast.empty         => intro h; exact absurd rfl h
  | _, ListLast.nonEmpty ys y => intro; rw [popBackEq, backEq]

theorem tst8' {α} [Inhabited α] (xs : List α) : xs ≠ [] → xs = popBack xs ++ [back xs] :=
match xs, last xs with
| _, ListLast.empty         => fun h => absurd rfl h
| _, ListLast.nonEmpty ys y => fun _ => sorry

theorem tst8'' {α} [Inhabited α] (xs : List α) (h : xs ≠ []) : xs = popBack xs ++ [back xs] :=
match xs, last xs with
| _, ListLast.empty         => absurd rfl h
| _, ListLast.nonEmpty ys y => sorry


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import algebra.char_p.invertible
import data.real.sqrt

/-!
# The Clauser-Horne-Shimony-Holt inequality and Tsirelson's inequality.

We establish a version of the Clauser-Horne-Shimony-Holt (CHSH) inequality
(which is a generalization of Bell's inequality).
This is a foundational result which implies that
quantum mechanics is not a local hidden variable theory.

As usually stated the CHSH inequality requires substantial language from physics and probability,
but it is possible to give a statement that is purely about ordered `*`-algebras.
We do that here, to avoid as many practical and logical dependencies as possible.
Since the algebra of observables of any quantum system is an ordered `*`-algebra
(in particular a von Neumann algebra) this is a strict generalization of the usual statement.

Let `R` be a `*`-ring.

A CHSH tuple in `R` consists of
* four elements `A₀ A₁ B₀ B₁ : R`, such that
* each `Aᵢ` and `Bⱼ` is a self-adjoint involution, and
* the `Aᵢ` commute with the `Bⱼ`.

The physical interpretation is that the four elements are observables (hence self-adjoint)
that take values ±1 (hence involutions), and that the `Aᵢ` are spacelike separated from the `Bⱼ`
(and hence commute).

The CHSH inequality says that when `R` is an ordered `*`-ring
(that is, a `*`-ring which is ordered, and for every `r : R`, `0 ≤ star r * r`),
which is moreover *commutative*, we have
`A₀ * B₀ + A₀ * B₁ + A₁ * B₀ - A₁ * B₁ ≤ 2`

On the other hand, Tsirelson's inequality says that for any ordered `*`-ring we have
`A₀ * B₀ + A₀ * B₁ + A₁ * B₀ - A₁ * B₁ ≤ 2√2`

(A caveat: in the commutative case we need 2⁻¹ in the ring,
and in the noncommutative case we need √2 and √2⁻¹.
To keep things simple we just assume our rings are ℝ-algebras.)

The proofs I've seen in the literature either
assume a significant framework for quantum mechanics,
or assume the ring is a `C^*`-algebra.
In the `C^*`-algebra case,
the order structure is completely determined by the `*`-algebra structure:
`0 ≤ A` iff there exists some `B` so `A = star B * B`.
There's a nice proof of both bounds in this setting at
https://en.wikipedia.org/wiki/Tsirelson%27s_bound
The proof given here is purely algebraic.

## Future work

One can show that Tsirelson's inequality is tight.
In the `*`-ring of n-by-n complex matrices, if `A ≤ λ I` for some `λ : ℝ`,
then every eigenvalue has absolute value at most `λ`.
There is a CHSH tuple in 4-by-4 matrices such that
`A₀ * B₀ + A₀ * B₁ + A₁ * B₀ - A₁ * B₁` has `2√2` as an eigenvalue.

## References

* [Clauser, Horne, Shimony, Holt,
  *Proposed experiment to test local hidden-variable theories*][zbMATH06785026]
* [Bell, *On the Einstein Podolsky Rosen Paradox*][MR3790629]
* [Tsirelson, *Quantum generalizations of Bell's inequality*][MR577178]

-/

universes u

/--
A CHSH tuple in a *-monoid consists of 4 self-adjoint involutions `A₀ A₁ B₀ B₁` such that
the `Aᵢ` commute with the `Bⱼ`.

The physical interpretation is that `A₀` and `A₁` are a pair of boolean observables which
are spacelike separated from another pair `B₀` and `B₁` of boolean observables.
-/
@[nolint has_nonempty_instance]
structure is_CHSH_tuple {R} [monoid R] [star_semigroup R] (A₀ A₁ B₀ B₁ : R) :=
(A₀_inv : A₀^2 = 1) (A₁_inv : A₁^2 = 1) (B₀_inv : B₀^2 = 1) (B₁_inv : B₁^2 = 1)
(A₀_sa : star A₀ = A₀) (A₁_sa : star A₁ = A₁) (B₀_sa : star B₀ = B₀) (B₁_sa : star B₁ = B₁)
(A₀B₀_commutes : A₀ * B₀ = B₀ * A₀)
(A₀B₁_commutes : A₀ * B₁ = B₁ * A₀)
(A₁B₀_commutes : A₁ * B₀ = B₀ * A₁)
(A₁B₁_commutes : A₁ * B₁ = B₁ * A₁)

variables {R : Type u}

lemma CHSH_id [comm_ring R] {A₀ A₁ B₀ B₁ : R}
  (A₀_inv : A₀^2 = 1) (A₁_inv : A₁^2 = 1) (B₀_inv : B₀^2 = 1) (B₁_inv : B₁^2 = 1) :
   (2 - A₀ * B₀ - A₀ * B₁ - A₁ * B₀ + A₁ * B₁) *
      (2 - A₀ * B₀ - A₀ * B₁ - A₁ * B₀ + A₁ * B₁) =
      4 * (2 - A₀ * B₀ - A₀ * B₁ - A₁ * B₀ + A₁ * B₁) :=
    -- If we had a Gröbner basis algorithm, this would be trivial.
      -- Without one, it is somewhat tedious!
begin
  rw ← sub_eq_zero,
  repeat
  { ring_nf,
    simp only [A₁_inv, B₁_inv, sub_eq_add_neg, add_mul, mul_add, sub_mul, mul_sub, add_assoc,
      neg_add, neg_sub, sub_add, sub_sub, neg_mul, ←sq, A₀_inv, B₀_inv, ←sq, ←mul_assoc, one_mul,
      mul_one, add_right_neg, add_zero, sub_eq_add_neg, A₀_inv, mul_one, add_right_neg, zero_mul] }
end

/--
Given a CHSH tuple (A₀, A₁, B₀, B₁) in a *commutative* ordered `*`-algebra over ℝ,
`A₀ * B₀ + A₀ * B₁ + A₁ * B₀ - A₁ * B₁ ≤ 2`.

(We could work over ℤ[⅟2] if we wanted to!)
-/
lemma CHSH_inequality_of_comm
  [ordered_comm_ring R] [star_ordered_ring R] [algebra ℝ R] [ordered_smul ℝ R]
  (A₀ A₁ B₀ B₁ : R) (T : is_CHSH_tuple A₀ A₁ B₀ B₁) :
  A₀ * B₀ + A₀ * B₁ + A₁ * B₀ - A₁ * B₁ ≤ 2 :=
begin
  let P := (2 - A₀ * B₀ - A₀ * B₁ - A₁ * B₀ + A₁ * B₁),
  have i₁ : 0 ≤ P,
  { have idem : P * P = 4 * P := CHSH_id T.A₀_inv T.A₁_inv T.B₀_inv T.B₁_inv,
    have idem' : P = (1 / 4 : ℝ) • (P * P),
    { have h : 4 * P = (4 : ℝ) • P := by simp [algebra.smul_def],
      rw [idem, h, ←mul_smul],
      norm_num, },
    have sa : star P = P,
    { dsimp [P],
      simp only [star_add, star_sub, star_mul, star_bit0, star_one,
        T.A₀_sa, T.A₁_sa, T.B₀_sa, T.B₁_sa, mul_comm B₀, mul_comm B₁], },
    rw idem',
    conv_rhs { congr, skip, congr, rw ←sa, },
    convert smul_le_smul_of_nonneg (star_mul_self_nonneg : 0 ≤ star P * P) _,
    { simp, },
    { apply_instance, },
    { norm_num, } },
  apply le_of_sub_nonneg,
  simpa only [sub_add_eq_sub_sub, ←sub_add] using i₁,
end

/-!
We now prove some rather specialized lemmas in preparation for the Tsirelson inequality,
which we hide in a namespace as they are unlikely to be useful elsewhere.
-/
local notation `√2` := (real.sqrt 2 : ℝ)

namespace tsirelson_inequality

/-!
Before proving Tsirelson's bound,
we prepare some easy lemmas about √2.
-/

-- This calculation, which we need for Tsirelson's bound,
-- defeated me. Thanks for the rescue from Shing Tak Lam!
lemma tsirelson_inequality_aux : √2 * √2 ^ 3 = √2 * (2 * √2⁻¹ + 4 * (√2⁻¹ * 2⁻¹)) :=
begin
  ring_nf, field_simp [(@real.sqrt_pos 2).2 (by norm_num)],
  convert congr_arg (^2) (@real.sq_sqrt 2 (by norm_num)) using 1;
    simp only [← pow_mul]; norm_num,
end

lemma sqrt_two_inv_mul_self : √2⁻¹ * √2⁻¹ = (2⁻¹ : ℝ) := by { rw ←mul_inv, norm_num }

end tsirelson_inequality
open tsirelson_inequality

/--
In a noncommutative ordered `*`-algebra over ℝ,
Tsirelson's bound for a CHSH tuple (A₀, A₁, B₀, B₁) is
`A₀ * B₀ + A₀ * B₁ + A₁ * B₀ - A₁ * B₁ ≤ 2^(3/2) • 1`.

We prove this by providing an explicit sum-of-squares decomposition
of the difference.

(We could work over `ℤ[2^(1/2), 2^(-1/2)]` if we really wanted to!)
-/
lemma tsirelson_inequality
  [ordered_ring R] [star_ordered_ring R]
  [algebra ℝ R] [ordered_smul ℝ R] [star_module ℝ R]
  (A₀ A₁ B₀ B₁ : R) (T : is_CHSH_tuple A₀ A₁ B₀ B₁) :
  A₀ * B₀ + A₀ * B₁ + A₁ * B₀ - A₁ * B₁ ≤ √2^3 • 1 :=
begin
  -- abel will create `ℤ` multiplication. We will `simp` them away to `ℝ` multiplication.
  have M : ∀ (m : ℤ) (a : ℝ) (x : R), m • a • x = ((m : ℝ) * a) • x :=
    λ m a x, by rw [zsmul_eq_smul_cast ℝ, ← mul_smul],
  let P := √2⁻¹ • (A₁ + A₀) - B₀,
  let Q := √2⁻¹ • (A₁ - A₀) + B₁,
  have w : √2^3 • 1 - A₀ * B₀ - A₀ * B₁ - A₁ * B₀ + A₁ * B₁ = √2⁻¹ • (P^2 + Q^2),
  { dsimp [P, Q],
    -- distribute out all the powers and products appearing on the RHS
    simp only [sq, sub_mul, mul_sub, add_mul, mul_add, smul_add, smul_sub],
    -- pull all coefficients out to the front, and combine `√2`s where possible
    simp only [algebra.mul_smul_comm, algebra.smul_mul_assoc, ←mul_smul, sqrt_two_inv_mul_self],
    -- replace Aᵢ * Aᵢ = 1 and Bᵢ * Bᵢ = 1
    simp only [←sq, T.A₀_inv, T.A₁_inv, T.B₀_inv, T.B₁_inv],
    -- move Aᵢ to the left of Bᵢ
    simp only [←T.A₀B₀_commutes, ←T.A₀B₁_commutes, ←T.A₁B₀_commutes, ←T.A₁B₁_commutes],
    -- collect terms, simplify coefficients, and collect terms again:
    abel,
    -- all terms coincide, but the last one. Simplify all other terms
    simp only [M],
    simp only [neg_mul, int.cast_bit0, one_mul, mul_inv_cancel_of_invertible,
      int.cast_one, one_smul, int.cast_neg, add_right_inj, neg_smul, ← add_smul],
    -- just look at the coefficients now:
    congr,
    exact mul_left_cancel₀ (by norm_num) tsirelson_inequality_aux, },
  have pos : 0 ≤ √2⁻¹ • (P^2 + Q^2),
  { have P_sa : star P = P,
    { dsimp [P],
      simp only [star_smul, star_add, star_sub, star_id_of_comm,
        T.A₀_sa, T.A₁_sa, T.B₀_sa, T.B₁_sa], },
    have Q_sa : star Q = Q,
    { dsimp [Q],
      simp only [star_smul, star_add, star_sub, star_id_of_comm,
        T.A₀_sa, T.A₁_sa, T.B₀_sa, T.B₁_sa], },
    have P2_nonneg : 0 ≤ P^2,
    { rw [sq],
      conv { congr, skip, congr, rw ←P_sa, },
      convert (star_mul_self_nonneg : 0 ≤ star P * P), },
    have Q2_nonneg : 0 ≤ Q^2,
    { rw [sq],
      conv { congr, skip, congr, rw ←Q_sa, },
      convert (star_mul_self_nonneg : 0 ≤ star Q * Q), },
    convert smul_le_smul_of_nonneg (add_nonneg P2_nonneg Q2_nonneg)
      (le_of_lt (show 0 < √2⁻¹, by norm_num)), -- `norm_num` can't directly show `0 ≤ √2⁻¹`
    simp, },
  apply le_of_sub_nonneg,
  simpa only [sub_add_eq_sub_sub, ←sub_add, w] using pos,
end