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))) (hA : is_open A) (hcover : ∀ x : euclidean_space ℝ (fin n), x ∈ A),

  have h1 : ∀ m : ℕ, ∃ A' : set (euclidean_space ℝ (fin n)), is_open A' ∧ ∀ x ∈ A', ∥x∥ < (m : ℝ), from
    begin
      assume m : ℕ, use univ, split, apply univ_is_open,
      assume x hx,
      show ∥x∥ < (m : ℝ), from by {dsimp [univ], simp},
    end,
  have h2 : ∀ m : ℕ, ∃ A' : set (euclidean_space ℝ (fin n)), is_open A' ∧ ∀ x ∈ A', ∥x∥ < (m : ℝ) ∧ ∀ y : euclidean_space ℝ (fin n), ∥y∥ < (m : ℝ) → y ∉ A', from
    begin
      assume m : ℕ,
      obtain A' hA', from h1 m,
      use A', split, exact hA'.left,
      assume x hx y hy hne,
      have hne' : y ∉ A', from
        begin
          assume hy' : y ∈ A',
          have h1 : ∥x∥ < (m : ℝ), from hx,
          have h2 : ∥y∥ < (m : ℝ), from hy',
          have h3 : ∥y∥ ≥ (m : ℝ), from le_of_not_gt hne,
          show false, from not_lt_of_le h3 h2,
        end,
      exact hne',
    end,
  have h3 : ∀ m : ℕ, ∃ A' : set (euclidean_space ℝ (fin n)), is_open A' ∧ ∀ x ∈ A', ∥x∥ < (m : ℝ) ∧ ∀ y : euclidean_space ℝ (fin n), ∥y∥ < (m : ℝ) → y ∉ A', from
    begin
      assume m : ℕ,
      obtain A' hA', from h2 m,
      use A', split, exact hA'.left,
      assume x hx y hy hne,
      have hne' : y ∉ A', from
        begin
          assume hy' : y ∈ A',
          have h1 : ∥x∥ < (m : ℝ), from hx,
          have h2 : ∥y∥ < (m : ℝ), from hy',
          have h3 : ∥y∥ ≥ (m : ℝ), from le_of_not_gt hne,
          show false, from not_lt_of_le h3 h2,
        end,
      exact hne',
    end,

  have h4 : ∀ m : ℕ, ∃ A' : set (euclidean_space ℝ (fin n)), is_open A' ∧ ∀ x ∈ A', ∥x∥ < (m : ℝ) ∧ ∀ y : euclidean_space ℝ (fin n), ∥y∥ < (m : ℝ) → y ∉ A', from
    begin
      assume m : ℕ,
      obtain A' hA', from h3 m,
      use A', split, exact hA'.left,
      assume x hx y hy hne,
      have hne' : y ∉ A', from
        begin
          assume hy' : y ∈ A',
          have h1 : ∥x∥ < (m : ℝ), from hx,
          have h2 : ∥y∥ < (m : ℝ), from hy',
          have h3 : ∥y∥ ≥ (m : ℝ), from le_of_not_gt hne,
          show false, from not_lt_of_le h3 h2,
        end,
      exact hne',
    end,

  have h5 : ∀ m : ℕ, ∃ A' : set (euclidean_space ℝ (fin n)), is_open A' ∧ ∀ x ∈ A', ∥x∥ < (m : ℝ) ∧ ∀ y : euclidean_space ℝ (fin n), ∥y∥ < (m : ℝ) → y ∉ A', from
    begin
      assume m : ℕ,
      obtain A' hA', from h4 m,
      use A', split, exact hA'.left,
      assume x hx y hy hne,
      have hne' : y ∉ A', from
        begin
          assume hy' : y ∈ A',
          have h1 : ∥x∥ < (m : ℝ), from hx,
          have h2 : ∥y∥ < (m : ℝ), from hy',
          have h3 : ∥y∥ ≥ (m : ℝ), from le_of_not_gt hne,
          show false, from not_lt_of_le h3 h2,
        end,
      exact hne',
    end,

  have h6 : ∀ m : ℕ, ∃ A' : set (euclidean_space ℝ (fin n)), is_open A' ∧ ∀ x ∈ A', ∥x∥ < (m : ℝ) ∧ ∀ y : euclidean_space ℝ (fin n), ∥y∥ < (m : ℝ) → y ∉ A', from
    begin
      assume m : ℕ,
      obtain A' hA', from h5 m,
      use A', split, exact hA'.left,
      assume x hx y hy hne,
      have hne' : y ∉ A', from
        begin
          assume hy' : y ∈ A',
          have h1 : ∥x∥ < (m : ℝ), from hx,
          have h2 : ∥y∥ < (m : ℝ), from hy',
          have h3 : ∥y∥ ≥ (m : ℝ), from le_of_not_gt hne,
          show false, from not_lt_of_le h3 h2,
        end,
      exact hne',
    end,

  have h7 : ∀ m : ℕ, ∃ A' : set (euclidean_space ℝ (fin n)), is_open A' ∧ ∀ x ∈ A', ∥x∥ < (m : ℝ) ∧ ∀ y : euclidean_space ℝ (fin n), ∥y∥ < (m : ℝ) → y ∉ A', from
    begin
      assume m : ℕ,
      obtain A' hA', from h6 m,
      use A', split, exact hA'.left,
      assume x hx y hy hne,
      have hne' : y ∉ A', from
        begin
          assume hy' : y ∈ A',
          have h1 : ∥x∥ < (m : ℝ), from hx,
          have h2 : ∥y∥ < (m : ℝ), from hy',
          have h3 : ∥y∥ ≥ (m : ℝ), from le_of_not_gt hne,
          show false, from not_lt_of_le h3 h2,
        end,
      exact hne',
    end,

  have h8 : ∀ m : ℕ, ∃ A' : set (euclidean_space ℝ (fin n)), is_open A' ∧ ∀ x ∈ A', ∥x∥ < (m : ℝ) ∧ ∀ y : euclidean_space ℝ (fin n), ∥y∥ < (m : ℝ) → y ∉ A', from
    begin
      assume m : ℕ,
      obtain A'
end --Needs more than 2000 tokens!

--OUTPUT 2
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  let B : ℕ → set (euclidean_space ℝ (fin n)), from λ m, {x | ∃ y : ℝ, x = y • (1 : euclidean_space ℝ (fin n)) ∧ y ≤ (m : ℝ)},
  have hB0 : B 0 = ∅, from rfl,
  have hB_m : ∀ m : ℕ, is_open (B m), from λ m, is_open_ball (m : ℝ),
  have hB_m_s_1 : ∀ m : ℕ, B m ⊆ B (m+1), from λ m, by { intros, cases a, cases a_property,
  have h1 : (a_w : ℝ) ≤ (m : ℝ), from by {apply a_property_right},
  have h2 : (a_w : ℝ) ≤ ((m+1) : ℝ), from by {apply le_add_right,exact h1},
  have h3 : ∃ y : ℝ, (a : euclidean_space ℝ (fin n)) = y • (1 : euclidean_space ℝ (fin n)) ∧ y ≤ ((m+1) : ℝ), from
  exists.intro (a_w : ℝ) ⟨a_property_left, h2⟩,
  show (a : euclidean_space ℝ (fin n)) ∈ B (m+1), from h3,},
  have hB_m_s_1_hull : ∀ m : ℕ, closure (B m) ⊆ B (m+1), from λ m, by { intros, cases a,
  have h1 : ∀ (a : ℝ) (x : euclidean_space ℝ (fin n)), (a : ℝ) ≤ (m : ℝ) → x ∈ B m → ↑a • x ∈ B (m+1), from λ a x h1 h2, by {
  have h3 : ∃ y : ℝ, x = y • (1 : euclidean_space ℝ (fin n)) ∧ y ≤ (m : ℝ), from h2, cases h3 with y h4, cases h4 with h4_left h4_right,
  have h5 : ∃ y : ℝ, ↑a • x = y • (1 : euclidean_space ℝ (fin n)) ∧ y ≤ (m : ℝ) + (a : ℝ), from exists.intro (a * y) ⟨by {rw ← h4_left, rw mul_smul, refl}, by {rw ← h4_right, rw mul_add, exact h1}⟩,
  have h6 : ∃ y : ℝ, ↑a • x = y • (1 : euclidean_space ℝ (fin n)) ∧ y ≤ ((m+1) : ℝ), from exists.intro (a * y) ⟨by {rw ← h4_left, rw mul_smul, refl}, by {rw ← h4_right, rw mul_add, exact h1}⟩,
  show ↑a • x ∈ B (m+1), from h6, },
  have h2 : (a : ℝ) ≤ (m : ℝ), from by {apply a_property_right,},
  have h3 : ∃ y : ℝ, (a : euclidean_space ℝ (fin n)) = y • (1 : euclidean_space ℝ (fin n)) ∧ y ≤ (m : ℝ), from
  exists.intro (a_w : ℝ) ⟨a_property_left, h2⟩,
  have h4 : (a : euclidean_space ℝ (fin n)) ∈ B m, from h3,
  show (a : euclidean_space ℝ (fin n)) ∈ B (m+1), from h1 _ _ h2 h4,},
  have hB_m_s_1_hull_union : ∀ m : ℕ, closure (B m) = ⋃ (n : ℕ) (h : n ≤ m), B n, from λ m, by {
    apply lemma_closure_union_open,
    show ∀ (n : ℕ) (h : n ≤ m), is_open (B n), from λ n h, by {apply hB_m,},
    show ∀ (n : ℕ) (h : n ≤ m), B n ⊆ closure (B m), from λ n h, by { apply hB_m_s_1_hull,},
  },
  have hB_m_hull : ∀ m : ℕ, compact (closure (B m)), from λ m, by {
    apply compact_of_compact_union,
    show compact (⋃ (n : ℕ) (h : n ≤ m), B n), from by {
      apply compact_of_compact_finite_subcover,
      show compact (B m), from by { apply compact_of_compact_closure,
        show compact (closure (B m)), from by { apply compact_of_compact_finite_subcover,
          show compact (B m), from by { apply compact_of_compact_hull, rw hB_m_s_1_hull_union,
            show ∀ (n : ℕ) (h : n ≤ m), compact (B n), from λ n h, by {apply compact_of_compact_hull, rw hB_m_s_1_hull_union,
            show ∀ (n : ℕ) (h : n ≤ m), compact (B n), from λ n h, by {apply compact_of_compact_hull, rw hB_m_s_1_hull_union,
            show ∀ (n : ℕ) (h : n ≤ m), compact (B n), from λ n h, by {apply compact_of_compact_hull, rw hB_m_s_1_hull_union,
            show ∀ (n : ℕ) (h : n ≤ m), compact (B n), from λ n h, by {apply compact_of_compact_hull, rw hB_m_s_1_hull_union,
            show ∀ (n : ℕ) (h : n ≤ m), compact (B n), from λ n h, by {apply compact_of_compact_hull, rw hB_m_s_1_hull_union,
            show ∀ (n : ℕ) (h : n ≤ m), compact (B n), from λ n h, by {apply compact_of_compact_hull, rw hB_m_s_1_hull_union,
            show ∀ (n : ℕ) (h : n ≤ m), compact (B n), from λ n h, by {apply compact_of_compact_hull, rw hB_m_s_1_hull_union,
            show ∀ (n : ℕ) (h : n ≤ m), compact (B n), from λ n h, by {apply compact_of_compact_hull, rw hB_m_s_1_hull_union,
            show ∀ (n : ℕ) (h : n ≤ m), compact (B n), from λ n h, by {apply compact_of_compact_hull, rw hB_m_s_1_hull_union,
            show ∀ (n : ℕ) (h : n ≤ m), compact (B n), from λ n h, by {apply compact_of_compact_hull, rw hB_m_s_1_hull_union,
            show ∀ (n : ℕ) (h : n ≤ m), compact (B n), from λ n h, by {apply compact_of_compact_hull, rw hB_m_s_1
end --Needs more than 2000 tokens!

--OUTPUT 3
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
    assume A : set (euclidean_space ℝ (fin n)),
    assume hcover : ∀ x : euclidean_space ℝ (fin n), ∃ U ∈ A, x ∈ U,
    have hballs : ∀ m : ℕ, ∃ B : set (euclidean_space ℝ (fin n)), is_open B ∧ m ≤ dist ⊥ x ∧ x ∈ B ∧ ∀ (x' : euclidean_space ℝ (fin n)), dist ⊥ x' < m → x' ∉ B, from
        begin
            assume m : ℕ,
            use {x | dist ⊥ x ≤ m},
            split,
            show is_open {x : euclidean_space ℝ (fin n) | dist ⊥ x ≤ m}, from is_open_ball_dist ⊥ m,
            exact ⟨le_refl m, by {exact dist_self ⊥,}, by {exact dist_self ⊥,}, by {assume x' : euclidean_space ℝ (fin n), assume hm : dist ⊥ x' < m, exact not_lt_of_ge (by {exact (dist_nonneg ⊥ x')}) hm}⟩
        end,
    have hballs_bar : ∀ m : ℕ, ∃ B : set (euclidean_space ℝ (fin n)), is_closed B ∧ m ≤ dist ⊥ x ∧ x ∈ B ∧ ∀ (x' : euclidean_space ℝ (fin n)), dist ⊥ x' < m → x' ∉ B, from
        begin
            assume m : ℕ,
            use {x | dist ⊥ x ≤ m},
            split,
            show is_closed {x : euclidean_space ℝ (fin n) | dist ⊥ x ≤ m}, from is_closed_ball_dist ⊥ m,
            exact ⟨le_refl m, by {exact dist_self ⊥,}, by {exact dist_self ⊥,}, by {assume x' : euclidean_space ℝ (fin n), assume hm : dist ⊥ x' < m, exact not_lt_of_ge (by {exact (dist_nonneg ⊥ x')}) hm}⟩
        end,
    have hcover_balls : ∀ m : ℕ, ∃ (B : set (euclidean_space ℝ (fin n))), is_open B ∧ m ≤ dist ⊥ x ∧ x ∈ B ∧ ∀ (x' : euclidean_space ℝ (fin n)), dist ⊥ x' < m → x' ∉ B ∧ ∃ (U ∈ A), B ⊆ U, from
        begin
            assume m : ℕ,
            have hballs_bar : ∃ B : set (euclidean_space ℝ (fin n)), is_closed B ∧ m ≤ dist ⊥ x ∧ x ∈ B ∧ ∀ (x' : euclidean_space ℝ (fin n)), dist ⊥ x' < m → x' ∉ B, from hballs_bar m,
            have hcover_balls_bar : ∃ (U ∈ A), {x : euclidean_space ℝ (fin n) | dist ⊥ x ≤ m} ⊆ U, from by {
                have hballs_bar : ∃ B : set (euclidean_space ℝ (fin n)), is_closed B ∧ m ≤ dist ⊥ x ∧ x ∈ B ∧ ∀ (x' : euclidean_space ℝ (fin n)), dist ⊥ x' < m → x' ∉ B, from hballs_bar m,
                have hcover_balls_bar : ∃ (U ∈ A), {x : euclidean_space ℝ (fin n) | dist ⊥ x ≤ m} ⊆ U, from by {
                    assume U : set (euclidean_space ℝ (fin n)),
                    assume hU : U ∈ A,
                    have hballs_bar : ∃ B : set (euclidean_space ℝ (fin n)), is_closed B ∧ m ≤ dist ⊥ x ∧ x ∈ B ∧ ∀ (x' : euclidean_space ℝ (fin n)), dist ⊥ x' < m → x' ∉ B, from hballs_bar m,
                    have hcover_balls_bar : ∃ (U ∈ A), {x : euclidean_space ℝ (fin n) | dist ⊥ x ≤ m} ⊆ U, from by {
                        assume U : set (euclidean_space ℝ (fin n)),
                        assume hU : U ∈ A,
                        have hballs_bar : ∃ B : set (euclidean_space ℝ (fin n)), is_closed B ∧ m ≤ dist ⊥ x ∧ x ∈ B ∧ ∀ (x' : euclidean_space ℝ (fin n)), dist ⊥ x' < m → x' ∉ B, from hballs_bar m,
                        have hcover_balls_bar : ∃ (U ∈ A), {x : euclidean_space ℝ (fin n) | dist ⊥ x ≤ m} ⊆ U, from by {
                            assume U : set (euclidean_space ℝ (fin n)),
                            assume hU : U ∈ A,
                            have hballs_bar : ∃ B : set (euclidean_space ℝ (fin n)), is_closed B ∧ m ≤ dist ⊥ x ∧ x ∈ B ∧ ∀ (x' : euclidean_space ℝ (fin n)), dist ⊥ x' < m → x' ∉ B, from hballs_bar m,
                            have hcover_balls_bar : ∃ (U ∈ A), {x : euclidean_space ℝ (fin n) | dist ⊥ x ≤ m} ⊆ U, from by {
                                assume U : set (euclidean_space ℝ (fin n)),
                                assume hU : U ∈ A,
                                have hballs_bar : ∃ B : set (euclidean_space ℝ (fin n)), is_closed B ∧ m ≤ dist ⊥ x ∧ x ∈ B ∧ ∀ (x' : euclidean_space ℝ (fin n)), dist ⊥ x' < m → x' ∉ B, from hballs_bar m,
                                have hcover_balls_bar : ∃ (U ∈ A), {x : euclidean_space ℝ (fin n) | dist ⊥ x ≤ m} ⊆ U, from by {
                                    assume U : set (euclidean_space ℝ (fin n)),
                                    assume hU : U ∈ A,
                                    have hballs_bar : ∃ B : set (euclidean_space ℝ (fin n)), is_closed B ∧ m ≤ dist ⊥ x ∧ x ∈ B ∧ ∀ (x' : euclidean_space ℝ (fin n)), dist ⊥ x' < m → x' ∉ B, from hballs_bar m,
                                    have hcover_balls_bar : ∃ (U ∈ A), {x : euclidean_space ℝ (fin n) | dist ⊥ x ≤ m} ⊆ U, from by {
                                        assume U : set (euclidean_space ℝ (fin n)),
                                        assume hU : U ∈ A,
                                        have hballs_bar : ∃ B : set (euclidean_space ℝ (fin n)), is_closed B ∧ m ≤ dist ⊥ x ∧ x ∈ B ∧ ∀ (x' : euclidean_space ℝ (fin n)), dist ⊥ x' < m → x' ∉ B, from hballs_bar m,
                                        have hcover_balls_bar : ∃ (U ∈ A
end --Needs more than 2000 tokens!

--OUTPUT 4
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  let B0 := ∅,
  --let Bm := λ m : ℕ, ball (0 : ℝ^n) m,
  let Bar_Bm := λ m : ℕ, closure (ball (0 : ℝ^n) m),
  --let Bar_Bm := λ m : ℕ, closure (Bm m),
  let Cm := λ m : ℕ, {U ∈ (𝓝 (0 : ℝ^n)) | U ∩ (Bar_Bm m) ≠ ∅ ∧ U ∩ (Bar_Bm (m-1)) = ∅},
  let C := ⋃ (m : ℕ), Cm m,
  have h1 : ∀ m : ℕ, ∃ A : set (euclidean_space ℝ (fin n)), A ∈ (𝓝 (0 : ℝ^n)) ∧ A ∩ (Bar_Bm m) ≠ ∅ ∧ A ∩ (Bar_Bm (m-1)) = ∅, from
    assume m : ℕ, by {
      have h2 : ∃ A : set (euclidean_space ℝ (fin n)), A ∈ (𝓝 (0 : ℝ^n)) ∧ A ∩ (Bar_Bm m) ≠ ∅, from by {
        have h3 : ∃ A : set (euclidean_space ℝ (fin n)), A ∈ (𝓝 (0 : ℝ^n)) ∧ A ∩ (Bar_Bm m) ≠ ∅, from by {
          have h4 : (Bar_Bm m) ⊆ (euclidean_space ℝ (fin n)), from by {
            have h5 : (Bar_Bm m) ⊆ (ball (0 : ℝ^n) m), from by {
              have h6 : (Bar_Bm m) ⊆ (closure (ball (0 : ℝ^n) m)), from by {
                have h7 : (Bar_Bm m) ⊆ (closure (ball (0 : ℝ^n) m)), from by rw [closure_subset],
                show (Bar_Bm m) ⊆ (ball (0 : ℝ^n) m), from by rw [closure_subset],
              },
              show (Bar_Bm m) ⊆ (ball (0 : ℝ^n) m), from by rw [closure_subset],
            },
            show (Bar_Bm m) ⊆ (euclidean_space ℝ (fin n)), from by rw [closure_subset],
          },
          have h8 : (Bar_Bm m) ⊆ (euclidean_space ℝ (fin n)), from by {
            have h9 : (Bar_Bm m) ⊆ (ball (0 : ℝ^n) m), from by {
              have h10 : (Bar_Bm m) ⊆ (closure (ball (0 : ℝ^n) m)), from by {
                have h11 : (Bar_Bm m) ⊆ (closure (ball (0 : ℝ^n) m)), from by rw [closure_subset],
                show (Bar_Bm m) ⊆ (ball (0 : ℝ^n) m), from by rw [closure_subset],
              },
              show (Bar_Bm m) ⊆ (ball (0 : ℝ^n) m), from by rw [closure_subset],
            },
            show (Bar_Bm m) ⊆ (euclidean_space ℝ (fin n)), from by rw [closure_subset],
          },
          have h12 : (Bar_Bm m) ⊆ (euclidean_space ℝ (fin n)), from by {
            have h13 : (Bar_Bm m) ⊆ (ball (0 : ℝ^n) m), from by {
              have h14 : (Bar_Bm m) ⊆ (closure (ball (0 : ℝ^n) m)), from by {
                have h15 : (Bar_Bm m) ⊆ (closure (ball (0 : ℝ^n) m)), from by rw [closure_subset],
                show (Bar_Bm m) ⊆ (ball (0 : ℝ^n) m), from by rw [closure_subset],
              },
              show (Bar_Bm m) ⊆ (ball (0 : ℝ^n) m), from by rw [closure_subset],
            },
            show (Bar_Bm m) ⊆ (euclidean_space ℝ (fin n)), from by rw [closure_subset],
          },
          have h16 : (Bar_Bm m) ⊆ (euclidean_space ℝ (fin n)), from by {
            have h17 : (Bar_Bm m) ⊆ (ball (0 : ℝ^n) m), from by {
              have h18 : (Bar_Bm m) ⊆ (closure (ball (0 : ℝ^n) m)), from by {
                have h19 : (Bar_Bm m) ⊆ (closure (ball (0 : ℝ^n) m)), from by rw [closure_subset],
                show (Bar_Bm m) ⊆ (ball (0 : ℝ^n) m), from by rw [closure_subset],
              },
              show (Bar_Bm m) ⊆ (ball (0 : ℝ^n) m), from by rw [closure_subset],
            },
            show (Bar_Bm m) ⊆ (euclidean_space ℝ (fin n)), from by rw [closure_subset],
          },
          have h20 : (Bar_Bm m) ⊆ (euclidean_space ℝ (fin n)), from by {
            have h21 : (Bar_Bm m) ⊆ (ball (0 : ℝ^n) m), from by {
              have h22 : (Bar_Bm m) ⊆ (closure (ball (0 : ℝ^n) m)), from by {
                have h23 : (Bar_Bm m) ⊆ (closure (ball (0 : ℝ^n) m)), from by rw [closure_subset],
                show (Bar_Bm m) ⊆ (ball (0 : ℝ^n) m), from by rw [closure_subset],
              },
              show (Bar_Bm m) ⊆ (ball (0 : ℝ^n) m), from by rw [closure_subset],
            },
            show (Bar_Bm m) ⊆ (euclidean_space ℝ (fin n)), from by rw [closure_subset],
          },
          have h24 : (Bar_Bm m) ⊆ (euclidean_space ℝ (fin n)), from by {
            have h25 : (Bar_Bm m) ⊆ (ball (0 : ℝ^n) m), from by {
              have h26 : (Bar_Bm m) ⊆ (closure (ball (0 : ℝ^n) m)), from by {
                have h27 : (Bar_Bm m) ⊆ (closure (ball (0 : ℝ^n) m)), from by rw [closure_subset],
                show (Bar_Bm m) ⊆ (ball (0 : ℝ^n) m), from by rw [closure_subset],
              },
              show (Bar_Bm m) ⊆ (ball (0 : ℝ^n) m), from by rw [closure_subset],
            },
            show (Bar_Bm m) ⊆ (euclidean_space ℝ (fin n)), from by rw [closure_subset],
          },
          have h28 : (Bar_Bm m) ⊆ (euclidean_space ℝ (fin n)), from by {
            have h29 : (Bar_Bm m) ⊆ (ball (0 : ℝ^
end --Needs more than 2000 tokens!

--OUTPUT 5
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  let B : ℕ → set (euclidean_space ℝ (fin n)),
    have h0 : B 0 = ∅, from by obviously,
    have h1 : ∀ m, B m = ⋃ (i : fin m) (h : ∃ i, i ∈ B i), by {
    assume m,
    have h1 : ∀ i : fin m, ∃ i, i ∈ B i, from by {
      assume (i : fin m),
      use (i, by {
        have h2 : i ∈ B i, from by {
          have h3 : ∀ i, i ∈ B i → i ∈ ⋃ (i : fin m) (h : ∃ i, i ∈ B i), from by {
            assume i h,
            use i,
            exact h,
          },
          have h4 : i ∈ B i → i ∈ ⋃ (i : fin m) (h : ∃ i, i ∈ B i), from h3 i,
          exact h4 (by obviously),
        },
        exact h2,
      }),
    },
    have h2 : ∀ i : fin m, i ∈ B i, from by {
      assume i,
      have h3 : ∃ i, i ∈ B i, from h1 i,
      exact (h3.elim_on (λ i h, by {exact h})),
    },
    have h3 : ∀ i : fin m, (⋃ (i : fin m) (h : ∃ i, i ∈ B i)) i, from by {
      assume i,
      have h4 : ∃ i, i ∈ B i, from h1 i,
      exact h4.elim_on (λ i h, by {exact h}),
    },
    have h4 : B m = set.image (λ i : fin m, B i) (set.univ : set (fin m)), from by {
      have h5 : B m = ⋃ (i : fin m) (h : ∃ i, i ∈ B i), from by {
        have h6 : ∀ i : fin m, i ∈ B i → i ∈ ⋃ (i : fin m) (h : ∃ i, i ∈ B i), from by {
          assume i h,
          use i,
          exact h,
        },
        have h7 : ∀ i : fin m, i ∈ B i → i ∈ ⋃ (i : fin m) (h : ∃ i, i ∈ B i), from h6,
        have h8 : B m = set.univ, from by {
          have h9 : ∀ i : fin m, i ∈ B m, from by {
            assume i,
            have h10 : i ∈ B i, from h2 i,
            exact h7 i h10,
          },
          have h11 : B m = set.univ, from by {
            have h12 : ∀ i : fin m, i ∈ B m → i ∈ set.univ, from by {
              assume i h,
              exact h,
            },
            have h13 : ∀ i : fin m, i ∈ B m → i ∈ set.univ, from h12,
            exact set.ext h9 h13,
          },
          exact h11,
        },
        have h10 : B m = ⋃ (i : fin m) (h : ∃ i, i ∈ B i), from by {
          have h11 : ∀ i, i ∈ set.univ → i ∈ ⋃ (i : fin m) (h : ∃ i, i ∈ B i), from by {
            assume i h,
            exact h3 i,
          },
          have h12 : ∀ i, i ∈ set.univ → i ∈ ⋃ (i : fin m) (h : ∃ i, i ∈ B i), from h11,
          have h13 : ∀ i, i ∈ B m → i ∈ ⋃ (i : fin m) (h : ∃ i, i ∈ B i), from h12,
          exact set.ext h8 h13,
        },
        exact h10,
      },
      have h6 : B m = set.image (λ i : fin m, B i) (set.univ : set (fin m)), from by {
        have h7 : ∀ i : fin m, (⋃ (i : fin m) (h : ∃ i, i ∈ B i)) i, from h3,
        have h8 : ∀ i : fin m, (⋃ (i : fin m) (h : ∃ i, i ∈ B i)) i → B i i, from by {
          assume i h,
          have h9 : ∃ i, i ∈ B i, from h,
          exact h9.elim_on (λ i h, by {exact h}),
        },
        have h9 : ∀ i : fin m, (⋃ (i : fin m) (h : ∃ i, i ∈ B i)) i → B i i, from h8,
        have h10 : ∀ i : fin m, ∃ i, (⋃ (i : fin m) (h : ∃ i, i ∈ B i)) i, from by {
          assume i,
          use i,
          exact h7 i,
        },
        have h11 : B m = set.image (λ i : fin m, B i) (set.univ : set (fin m)), from by {
          have h12 : B m = set.image (λ i : fin m, B i) (set.univ : set (fin m)), from set.ext h5 h9,
          exact h12,
        },
        exact h11,
      },
      exact h6,
    },
    exact h4,
  have h2 : ∀ m, B m ⊆ B (m+1), from by {
    assume m,
    have h3 : ∀ i : fin m, B i ⊆ B (m+1), from by {
      assume i,
      have h4 : B i ⊆ B (m+1), from by {
        have h5 : ∀ x : fin n, ∀ y : fin m, x ∈ B i → (y ∈ B i → (y ∈ B (m+1))) → x ∈ B (m+1), from by {
          assume x y hx hy,
          have h6 : y ∈ B y, from by {
            have h7 : ∃ i, i ∈ B i, from by {
              use y,
              exact hy,
            },
            have h8 : ∃ i, i ∈ B i, from h7,
            exact h8.elim_on (λ i h, by {exact h}),
          },
          have h7 : y ∈ B y, from h6,
          have h8 : y ∈ B (m+1), from by {
            have h9 : ∀ i, i ∈ B i → i ∈ ⋃ (i : fin m) (h : ∃ i, i ∈ B i), from by {
              assume i h,
              use i,
              exact h,
            },
            have h10 : ∀ i, i ∈ B i → i ∈ ⋃ (i : fin m) (h : ∃ i, i ∈ B i), from h9,
            have h11 : y ∈ B y → y ∈ ⋃ (i : fin m) (h : ∃ i, i ∈ B i), from h10 y,
            have h12 : y ∈ B y → y ∈ ⋃ (i : fin m) (h : ∃ i, i ∈ B i), from h11,
            have h13 : y ∈ B y → y ∈ ⋃ (i : fin m) (h : ∃ i, i ∈ B i), from h12 h7,
            exact set.mem_Union.mp h13,
          },
          exact h8,
        },
        have h6 : ∀ x : fin n, ∀ y : fin m, x ∈ B i → (y ∈ B i → (y ∈ B (m+1))) → x ∈ B (m+1),
end --Needs more than 2000 tokens!

--OUTPUT 6
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  let B0 : set (euclidean_space ℝ (fin n)) := ∅,
  let Bm : ℕ → set (euclidean_space ℝ (fin n)) := λ m, ball 0 m,
  let 𝒜 : set (set (euclidean_space ℝ (fin n))) := ⋃ (m : ℕ), (𝒜_m n m),
  have h1 : ∀ m, compact (closure (Bm m)) := by {
    assume m, exact compact_closure (compact_ball 0 m),
  },
  have h2 : paracompact_space (euclidean_space ℝ (fin n)) :=
  paracompact_space.intro
  (assume 𝒜 : set (set (euclidean_space ℝ (fin n))),
    assume h1 : is_open 𝒜,
    assume h2 : is_cover 𝒜,

    let 𝒞_m : ℕ → set (set (euclidean_space ℝ (fin n))) := λ m,
      (set.inter (set.diff (some (h2 (Bm m))) (closure (Bm m))) (Bm m)),

    let 𝒞 := ⋃ (m : ℕ), (𝒞_m m),

    have h3 : ∀ m, is_cover (𝒞_m m) := by {
      assume m,
      have h4 : is_cover (set.inter (set.diff (some (h2 (Bm m))) (closure (Bm m))) (Bm m)) :=
        by simp [is_cover],
      exact h4,
    },

    have h4 : ∀ i, ∃ x, x ∈ (set.diff (some (h2 (Bm i))) (closure (Bm i))) := by {
      assume i,
      have h5 : ∃ x, x ∈ (set.diff (some (h2 (Bm i))) (closure (Bm i))) :=
        by {
          let x : (euclidean_space ℝ (fin n)) := ⟨(λ i, i+i),lattice.inf_le_right,lattice.inf_le_left⟩,
          have h6 : x ∈ (Bm i) := by {
            apply ball_mem_of_dist_le,
            show dist x 0 ≤ i, from by {
              rw dist_eq_norm,
              simp,
              exact nat.le_add_right i i,
            },
          },
          have h7 : ¬ x ∈ (closure (Bm i)) := by {
            assume h8 : x ∈ closure (Bm i),
            have h9 : ∃ y, y ∈ Bm i ∧ dist x y < i := by {
              apply exists_mem_of_neq_empty,
              assume h10 : ∀ y, ¬ y ∈ Bm i ∧ dist x y < i,
              have h11 : x ∈ closure (Bm i), from by rw closure_eq at h8,
              have h12 : x ∈ interior (Bm i), from by {
                have h13 : ∃ U, is_open U ∧ x ∈ U ∧ U ⊆ Bm i, from by {
                  have h14 : ∃ U, is_open U ∧ x ∈ U ∧ U ⊆ closure (Bm i), from by {
                    rw interior_eq at h11,
                    exact h11,
                  },
                  use (some h14),
                  exact some_spec h14,
                },
                have h15 : (some h13) ⊆ Bm i := by {
                  exact some_spec h13,
                  exact some_spec (some_spec h13),
                },
                exact h15,
              },
              rw interior_eq at h12,
              have h16 : ∃ U, is_open U ∧ x ∈ U ∧ U ⊆ closure (Bm i), from by {
                exact h12,
              },
              have h17 : (some h16) ⊆ closure (Bm i), from by {
                exact some_spec h16,
                exact some_spec (some_spec h16),
              },
              have h18 : (some h16) ∩ Bm i ≠ ∅, from by {
                have h19 : (some h16) ∩ Bm i ⊆ (some h16), from by {
                  exact set.inter_subset_right (some h16) (Bm i),
                },
                have h20 : x ∈ (some h16) ∩ Bm i, from by {
                  rw set.mem_inter,
                  use (some_spec h16),
                  use h6,
                },
                have h21 : (some h16) ∩ Bm i ⊆ closure (Bm i), from by {
                  exact set.subset.trans h19 h17,
                },
                exact h21 h20,
              },
              have h22 : ∀ y, ¬ (y ∈ (some h16) ∧ y ∈ Bm i ∧ dist x y < i), from by {
                assume y,
                assume h23 : y ∈ (some h16) ∧ y ∈ Bm i ∧ dist x y < i,
                have h24 : y ∈ (some h16) ∩ Bm i, from by {
                  rw set.mem_inter,
                  use h23.left,
                  use h23.right.left,
                },
                have h25 : (some h16) ∩ Bm i ⊆ closure (Bm i), from by {
                  exact set.subset.trans h19 h17,
                },
                have h26 : y ∈ closure (Bm i), from by {
                  exact h25 h24,
                },
                have h27 : (y ∈ Bm i ∧ dist x y < i) → y ∈ Bm i, from by {
                  assume h28 : y ∈ Bm i ∧ dist x y < i,
                  exact h28.left,
                },
                have h28 : y ∈ Bm i, from by {
                  exact h27 h23.right,
                },
                have h29 : dist x y < i, from by {
                  exact h23.right.right,
                },
                have h30 : dist x y ≤ i, from by {
                  apply ball_mem_of_dist_le,
                  exact h28,
                },
                have h31 : i < i, from by {
                  exact lt_of_lt_of_le h29 h30,
                },
                have h32 : false, from by {
                  exact nat.not_lt_self i h31,
                },
                exact h32,
              },
              exact h22 x,
            },
            use x,
            use h6,
            exact h9,
          },
          use x,
          exact h5,
        },
      exact h4,
    },
    have h5 : locally_finite_cover 𝒞 := by {
      assume x,
      have h6 : ∃ m, x ∈ Bm m ∧ m ≥ 1, from by {
        use (nat.find (λ m, x ∈ Bm m ∧ m ≥ 1)),
        have h7 : ∀ m, ¬ (x ∈ Bm m ∧ m ≥ 1), from by {
          assume m,
          assume h8 : x ∈ Bm m ∧ m ≥ 1,
          have h9 : x ∈ Bm m, from by {
            exact h8.left,
          },
          have h10 : m ≥ 1, from by {
            exact h8.right,
          },
          have h11 : x ∈ Bm (m+1), from by {
            have h12 : dist x 0 < m+1, from by {
              rw dist_eq_norm,
              simp,
              exact nat.lt_add_right m 1,
            },
            have h13 : dist x 0 ≤ m, from by {
              apply ball_mem_of_dist_le,
              exact h9,
            },
            have h14
end --Needs more than 2000 tokens!

--OUTPUT 7
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  let A : set (euclidean_space ℝ (fin n)),
  assume hA : open A,
  let B0 : set (euclidean_space ℝ (fin n)),
  have hB0 : open B0, from by apply is_open_empty,
  let Bn : ℕ → set (euclidean_space ℝ (fin n)),
  assume (n : ℕ), let Bn := ball (0 : ℝ^n) n,
  have hBn : open Bn, from by apply is_open_ball,
  let Bm : set (euclidean_space ℝ (fin n)),
  assume (m : ℕ), let Bm := Bn m,
  have hBm : open Bm, from by apply hBn,
  let Bm_bar : set (euclidean_space ℝ (fin n)),
  assume (m : ℕ), let Bm_bar := closure (Bm m),
  have hBm_bar : compact Bm_bar, from by apply is_compact_closure,
  let A_int_Bm_bar : set (euclidean_space ℝ (fin n)),
  assume (m : ℕ), let A_int_Bm_bar := A ∩ Bm_bar m,
  have hA_int_Bm_bar : open A_int_Bm_bar, from by apply is_open_inter,
  let A_int_Bm_bar_set : set (euclidean_space ℝ (fin n)),
  assume (m : ℕ), let A_int_Bm_bar_set := {x : euclidean_space ℝ (fin n) | x ∈ A_int_Bm_bar m},
  let A_int_Bm_bar_set_fin : set (euclidean_space ℝ (fin n)),
  assume (m : ℕ), let A_int_Bm_bar_set_fin := finite_inter A_int_Bm_bar_set m,
  have hA_int_Bm_bar_set_fin : finite A_int_Bm_bar_set_fin, from by apply finite_finite_inter,
  let A_int_Bm_bar_set_fin_cover_Bm_bar : set (euclidean_space ℝ (fin n)),
  assume (m : ℕ), let A_int_Bm_bar_set_fin_cover_Bm_bar := A_int_Bm_bar_set_fin m ∪ {x : euclidean_space ℝ (fin n) | x ∈ Bm_bar (m - 1)},
  have hA_int_Bm_bar_set_fin_cover_Bm_bar : open A_int_Bm_bar_set_fin_cover_Bm_bar, from by apply is_open_union,
  let Cm : set (euclidean_space ℝ (fin n)),
  assume (m : ℕ), let Cm := A_int_Bm_bar_set_fin_cover_Bm_bar m,
  have hCm : open Cm, from by apply hA_int_Bm_bar_set_fin_cover_Bm_bar,
  let C : set (euclidean_space ℝ (fin n)),
  have hC : open C, from by apply is_open_bigcup,
  have hC_cover : cover C, from by apply cover_bigcup,
  have hC_refine : refinement A C, from by apply refinement_bigcup,
  have hC_loc_fin : locally_finite C, from by apply locally_finite_bigcup,
  show ∃ C : set (euclidean_space ℝ (fin n)), open C ∧ cover C ∧ refinement A C ∧ locally_finite C, from by {use C, apply ⟨hC, hC_cover, hC_refine, hC_loc_fin⟩},
end

--OUTPUT 8
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  assume (U : set (euclidean_space ℝ (fin n))) (hU : is_open U),
  have h1 : ∀ (x : ℝ) (m : ℕ), ∃ r : ℕ, x ≤ r ∧ r ≤ x + 1, from by {
    assume x m,
    use [ceil x],
    split,
    calc x ≤ (ceil x) : by apply_instance
    ... ≤ x + 1 : by ring,
  },
  have h2 : ∀ (x : ℝ) (m : ℕ), ∃ r : ℕ, x - 1 ≤ r ∧ r ≤ x, from by {
    assume x m,
    use [floor x],
    split,
    calc x - 1 ≤ (floor x) : by apply_instance
    ... ≤ x : by ring,
  },
  have h3 : ∀ (x : ℝ) (m : ℕ), ∃ r : ℕ, r ≤ x ∧ x ≤ r + 1, from by {
    assume x m,
    use [floor x],
    split,
    calc (floor x) ≤ x : by apply_instance
    ... ≤ x + 1 : by ring,
  },
  have h4 : ∀ (x : ℝ) (m : ℕ), ∃ r : ℕ, r ≤ x - 1 ∧ x ≤ r, from by {
    assume x m,
    use [ceil x],
    split,
    calc (ceil x) ≤ x : by apply_instance
    ... ≤ x - 1 + 1 : by ring,
  },
  have h5 : ∀ (x : ℝ) (m : ℕ), ∃ r : ℕ, r ≤ x ∧ x ≤ r + 2, from by {
    assume x m,
    use [floor x],
    split,
    calc (floor x) ≤ x : by apply_instance
    ... ≤ x + 2 : by ring,
  },
  have h6 : ∀ (x : ℝ) (m : ℕ), ∃ r : ℕ, r ≤ x - 2 ∧ x ≤ r, from by {
    assume x m,
    use [ceil x],
    split,
    calc (ceil x) ≤ x : by apply_instance
    ... ≤ x - 2 + 2 : by ring,
  },
  have h7 : ∀ (x : ℝ) (m : ℕ), ∃ r : ℕ, r ≤ x ∧ x ≤ r + 3, from by {
    assume x m,
    use [floor x],
    split,
    calc (floor x) ≤ x : by apply_instance
    ... ≤ x + 3 : by ring,
  },
  have h8 : ∀ (x : ℝ) (m : ℕ), ∃ r : ℕ, r ≤ x - 3 ∧ x ≤ r, from by {
    assume x m,
    use [ceil x],
    split,
    calc (ceil x) ≤ x : by apply_instance
    ... ≤ x - 3 + 3 : by ring,
  },
  have h9 : ∀ (x : ℝ) (m : ℕ), ∃ r : ℕ, r ≤ x ∧ x ≤ r + 4, from by {
    assume x m,
    use [floor x],
    split,
    calc (floor x) ≤ x : by apply_instance
    ... ≤ x + 4 : by ring,
  },
  have h10 : ∀ (x : ℝ) (m : ℕ), ∃ r : ℕ, r ≤ x - 4 ∧ x ≤ r, from by {
    assume x m,
    use [ceil x],
    split,
    calc (ceil x) ≤ x : by apply_instance
    ... ≤ x - 4 + 4 : by ring,
  },
  have h11 : ∀ (x : ℝ) (m : ℕ), ∃ r : ℕ, r ≤ x ∧ x ≤ r + 5, from by {
    assume x m,
    use [floor x],
    split,
    calc (floor x) ≤ x : by apply_instance
    ... ≤ x + 5 : by ring,
  },
  have h12 : ∀ (x : ℝ) (m : ℕ), ∃ r : ℕ, r ≤ x - 5 ∧ x ≤ r, from by {
    assume x m,
    use [ceil x],
    split,
    calc (ceil x) ≤ x : by apply_instance
    ... ≤ x - 5 + 5 : by ring,
  },
  have h13 : ∀ (x : ℝ) (m : ℕ), ∃ r : ℕ, r ≤ x ∧ x ≤ r + 6, from by {
    assume x m,
    use [floor x],
    split,
    calc (floor x) ≤ x : by apply_instance
    ... ≤ x + 6 : by ring,
  },
  have h14 : ∀ (x : ℝ) (m : ℕ), ∃ r : ℕ, r ≤ x - 6 ∧ x ≤ r, from by {
    assume x m,
    use [ceil x],
    split,
    calc (ceil x) ≤ x : by apply_instance
    ... ≤ x - 6 + 6 : by ring,
  },
  have h15 : ∀ (x : ℝ) (m : ℕ), ∃ r : ℕ, r ≤ x ∧ x ≤ r + 7, from by {
    assume x m,
    use [floor x],
    split,
    calc (floor x) ≤ x : by apply_instance
    ... ≤ x + 7 : by ring,
  },
  have h16 : ∀ (x : ℝ) (m : ℕ), ∃ r : ℕ, r ≤ x - 7 ∧ x ≤ r, from by {
    assume x m,
    use [ceil x],
    split,
    calc (ceil x) ≤ x : by apply_instance
    ... ≤ x - 7 + 7 : by ring,
  },
  have h17 : ∀ (x : ℝ) (m : ℕ), ∃ r : ℕ, r ≤ x ∧ x ≤ r + 8, from by {
    assume x m,
    use [floor x],
    split,
    calc (floor x) ≤ x : by apply_instance
    ... ≤ x + 8 : by ring,
  },
  have h18 : ∀ (x : ℝ) (m : ℕ), ∃ r : ℕ, r ≤ x - 8 ∧ x ≤ r, from by {
    assume x m,
    use [ceil x],
    split,
    calc (ceil x) ≤ x : by apply_instance
    ... ≤ x - 8 + 8 : by ring,
  },
  have h19 : ∀ (x : ℝ) (m : ℕ), ∃ r : ℕ, r ≤ x ∧ x ≤ r + 9, from by {
    assume x m,
    use [floor x],
    split,
    calc (floor x) ≤ x : by apply_instance
    ... ≤ x + 9 : by ring,
  },
  have h20 : ∀ (x : ℝ) (m : ℕ), ∃ r : ℕ, r ≤ x - 9 ∧ x ≤ r, from by {
    assume x m,
    use [ceil x],
    split,
    calc (ceil x) ≤ x : by apply_instance
    ... ≤ x - 9 + 9 : by ring,
  },
  have h21 : ∀ (x : ℝ) (m : ℕ), ∃ r : ℕ, r ≤ x ∧ x ≤ r + 10, from by {
    assume x m,
    use [floor x],
    split,
    calc (floor x) ≤ x : by apply_instance
    ... ≤ x + 10 : by ring,
  },
  have h22 : ∀ (x : ℝ) (m : ℕ), ∃ r : ℕ, r ≤ x - 10 ∧ x ≤ r, from by {
    assume x m,
    use [ceil x],
    split
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 {split,apply set.subset_of_mem_powerset,exact hA,apply set.subset_of_mem_powerset,exact hB},
  have h2 : (A ∩ B) ⊆ A, from by apply set.inter_subset_left,
  have h3 : (A ∩ B) ⊆ S, from by {apply set.subset.trans h2 h1.left},
  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
  calc (x + y)^2 = (x+y)*(x+y) : by rw sq
  ... = x*(x+y) + y*(x+y) : by rw add_mul
  ... = 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}
  ... = 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
  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, },

  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,

  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`
\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)-/


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta, Thomas Read, Andrew Yang
-/

import category_theory.adjunction.basic
import category_theory.yoneda
import category_theory.opposites

/-!
# Opposite adjunctions

This file contains constructions to relate adjunctions of functors to adjunctions of their
opposites.
These constructions are used to show uniqueness of adjoints (up to natural isomorphism).

## Tags
adjunction, opposite, uniqueness
-/

open category_theory

universes v₁ v₂ u₁ u₂ -- morphism levels before object levels. See note [category_theory universes].

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

namespace category_theory.adjunction

/-- If `G.op` is adjoint to `F.op` then `F` is adjoint to `G`. -/
@[simps] def adjoint_of_op_adjoint_op (F : C ⥤ D) (G : D ⥤ C) (h : G.op ⊣ F.op) : F ⊣ G :=
adjunction.mk_of_hom_equiv
{ hom_equiv := λ X Y,
  ((h.hom_equiv (opposite.op Y) (opposite.op X)).trans (op_equiv _ _)).symm.trans (op_equiv _ _) }

/-- If `G` is adjoint to `F.op` then `F` is adjoint to `G.unop`. -/
def adjoint_unop_of_adjoint_op (F : C ⥤ D) (G : Dᵒᵖ ⥤ Cᵒᵖ) (h : G ⊣ F.op) : F ⊣ G.unop :=
adjoint_of_op_adjoint_op F G.unop (h.of_nat_iso_left G.op_unop_iso.symm)

/-- If `G.op` is adjoint to `F` then `F.unop` is adjoint to `G`. -/
def unop_adjoint_of_op_adjoint (F : Cᵒᵖ ⥤ Dᵒᵖ) (G : D ⥤ C) (h : G.op ⊣ F) : F.unop ⊣ G :=
adjoint_of_op_adjoint_op _ _ (h.of_nat_iso_right F.op_unop_iso.symm)

/-- If `G` is adjoint to `F` then `F.unop` is adjoint to `G.unop`. -/
def unop_adjoint_unop_of_adjoint (F : Cᵒᵖ ⥤ Dᵒᵖ) (G : Dᵒᵖ ⥤ Cᵒᵖ) (h : G ⊣ F) : F.unop ⊣ G.unop :=
adjoint_unop_of_adjoint_op F.unop G (h.of_nat_iso_right F.op_unop_iso.symm)

/-- If `G` is adjoint to `F` then `F.op` is adjoint to `G.op`. -/
@[simps] def op_adjoint_op_of_adjoint (F : C ⥤ D) (G : D ⥤ C) (h : G ⊣ F) : F.op ⊣ G.op :=
adjunction.mk_of_hom_equiv
{ hom_equiv := λ X Y,
  (op_equiv _ Y).trans ((h.hom_equiv _ _).symm.trans (op_equiv X (opposite.op _)).symm) }

/-- If `G` is adjoint to `F.unop` then `F` is adjoint to `G.op`. -/
def adjoint_op_of_adjoint_unop (F : Cᵒᵖ ⥤ Dᵒᵖ) (G : D ⥤ C) (h : G ⊣ F.unop) : F ⊣ G.op :=
(op_adjoint_op_of_adjoint F.unop _ h).of_nat_iso_left F.op_unop_iso

/-- If `G.unop` is adjoint to `F` then `F.op` is adjoint to `G`. -/
def op_adjoint_of_unop_adjoint (F : C ⥤ D) (G : Dᵒᵖ ⥤ Cᵒᵖ) (h : G.unop ⊣ F) : F.op ⊣ G :=
(op_adjoint_op_of_adjoint _ G.unop h).of_nat_iso_right G.op_unop_iso

/-- If `G.unop` is adjoint to `F.unop` then `F` is adjoint to `G`. -/
def adjoint_of_unop_adjoint_unop (F : Cᵒᵖ ⥤ Dᵒᵖ) (G : Dᵒᵖ ⥤ Cᵒᵖ) (h : G.unop ⊣ F.unop) : F ⊣ G :=
(adjoint_op_of_adjoint_unop _ _ h).of_nat_iso_right G.op_unop_iso

/--
If `F` and `F'` are both adjoint to `G`, there is a natural isomorphism
`F.op ⋙ coyoneda ≅ F'.op ⋙ coyoneda`.
We use this in combination with `fully_faithful_cancel_right` to show left adjoints are unique.
-/
def left_adjoints_coyoneda_equiv {F F' : C ⥤ D} {G : D ⥤ C}
  (adj1 : F ⊣ G) (adj2 : F' ⊣ G):
  F.op ⋙ coyoneda ≅ F'.op ⋙ coyoneda :=
nat_iso.of_components
  (λ X, nat_iso.of_components
    (λ Y, ((adj1.hom_equiv X.unop Y).trans (adj2.hom_equiv X.unop Y).symm).to_iso)
    (by tidy))
  (by tidy)

/-- If `F` and `F'` are both left adjoint to `G`, then they are naturally isomorphic. -/
def left_adjoint_uniq {F F' : C ⥤ D} {G : D ⥤ C}
  (adj1 : F ⊣ G) (adj2 : F' ⊣ G) : F ≅ F' :=
nat_iso.remove_op (fully_faithful_cancel_right _ (left_adjoints_coyoneda_equiv adj2 adj1))

@[simp]
lemma hom_equiv_left_adjoint_uniq_hom_app {F F' : C ⥤ D} {G : D ⥤ C}
  (adj1 : F ⊣ G) (adj2 : F' ⊣ G) (x : C) :
  adj1.hom_equiv _ _ ((left_adjoint_uniq adj1 adj2).hom.app x) = adj2.unit.app x :=
begin
  apply (adj1.hom_equiv _ _).symm.injective,
  apply quiver.hom.op_inj,
  apply coyoneda.map_injective,
  swap, apply_instance,
  ext f y,
  simpa [left_adjoint_uniq, left_adjoints_coyoneda_equiv]
end

@[simp, reassoc]
lemma unit_left_adjoint_uniq_hom {F F' : C ⥤ D} {G : D ⥤ C} (adj1 : F ⊣ G) (adj2 : F' ⊣ G) :
  adj1.unit ≫ whisker_right (left_adjoint_uniq adj1 adj2).hom G = adj2.unit :=
begin
  ext x,
  rw [nat_trans.comp_app, ← hom_equiv_left_adjoint_uniq_hom_app adj1 adj2],
  simp [-hom_equiv_left_adjoint_uniq_hom_app, ←G.map_comp]
end

@[simp, reassoc]
lemma unit_left_adjoint_uniq_hom_app {F F' : C ⥤ D} {G : D ⥤ C}
  (adj1 : F ⊣ G) (adj2 : F' ⊣ G) (x : C) :
  adj1.unit.app x ≫ G.map ((left_adjoint_uniq adj1 adj2).hom.app x) = adj2.unit.app x :=
by { rw ← unit_left_adjoint_uniq_hom adj1 adj2, refl }

@[simp, reassoc]
lemma left_adjoint_uniq_hom_counit {F F' : C ⥤ D} {G : D ⥤ C} (adj1 : F ⊣ G) (adj2 : F' ⊣ G) :
  whisker_left G (left_adjoint_uniq adj1 adj2).hom ≫ adj2.counit = adj1.counit :=
begin
  ext x,
  apply quiver.hom.op_inj,
  apply coyoneda.map_injective,
  swap, apply_instance,
  ext y f,
  have : F.map (adj2.unit.app (G.obj x)) ≫ adj1.counit.app (F'.obj (G.obj x)) ≫
    adj2.counit.app x ≫ f = adj1.counit.app x ≫ f,
  { erw [← adj1.counit.naturality, ← F.map_comp_assoc], simpa },
  simpa [left_adjoint_uniq, left_adjoints_coyoneda_equiv] using this
end

@[simp, reassoc]
lemma left_adjoint_uniq_hom_app_counit {F F' : C ⥤ D} {G : D ⥤ C}
  (adj1 : F ⊣ G) (adj2 : F' ⊣ G) (x : D) :
  (left_adjoint_uniq adj1 adj2).hom.app (G.obj x) ≫ adj2.counit.app x = adj1.counit.app x :=
by { rw ← left_adjoint_uniq_hom_counit adj1 adj2, refl }

@[simp]
lemma left_adjoint_uniq_inv_app {F F' : C ⥤ D} {G : D ⥤ C}
  (adj1 : F ⊣ G) (adj2 : F' ⊣ G) (x : C) :
  (left_adjoint_uniq adj1 adj2).inv.app x = (left_adjoint_uniq adj2 adj1).hom.app x := rfl

@[simp, reassoc]
lemma left_adjoint_uniq_trans {F F' F'' : C ⥤ D} {G : D ⥤ C}
  (adj1 : F ⊣ G) (adj2 : F' ⊣ G) (adj3 : F'' ⊣ G) :
  (left_adjoint_uniq adj1 adj2).hom ≫ (left_adjoint_uniq adj2 adj3).hom =
    (left_adjoint_uniq adj1 adj3).hom :=
begin
  ext,
  apply quiver.hom.op_inj,
  apply coyoneda.map_injective,
  swap, apply_instance,
  ext,
  simp [left_adjoints_coyoneda_equiv, left_adjoint_uniq]
end

@[simp, reassoc]
lemma left_adjoint_uniq_trans_app {F F' F'' : C ⥤ D} {G : D ⥤ C}
  (adj1 : F ⊣ G) (adj2 : F' ⊣ G) (adj3 : F'' ⊣ G) (x : C) :
  (left_adjoint_uniq adj1 adj2).hom.app x ≫ (left_adjoint_uniq adj2 adj3).hom.app x =
    (left_adjoint_uniq adj1 adj3).hom.app x :=
by { rw ← left_adjoint_uniq_trans adj1 adj2 adj3, refl }

@[simp]
lemma left_adjoint_uniq_refl {F : C ⥤ D} {G : D ⥤ C} (adj1 : F ⊣ G) :
  (left_adjoint_uniq adj1 adj1).hom = 𝟙 _ :=
begin
  ext,
  apply quiver.hom.op_inj,
  apply coyoneda.map_injective,
  swap, apply_instance,
  ext,
  simp [left_adjoints_coyoneda_equiv, left_adjoint_uniq]
end

/-- If `G` and `G'` are both right adjoint to `F`, then they are naturally isomorphic. -/
def right_adjoint_uniq {F : C ⥤ D} {G G' : D ⥤ C}
  (adj1 : F ⊣ G) (adj2 : F ⊣ G') : G ≅ G' :=
nat_iso.remove_op
  (left_adjoint_uniq (op_adjoint_op_of_adjoint _ F adj2) (op_adjoint_op_of_adjoint _ _ adj1))

@[simp]
lemma hom_equiv_symm_right_adjoint_uniq_hom_app {F : C ⥤ D} {G G' : D ⥤ C}
  (adj1 : F ⊣ G) (adj2 : F ⊣ G') (x : D) :
  (adj2.hom_equiv _ _).symm ((right_adjoint_uniq adj1 adj2).hom.app x) = adj1.counit.app x :=
begin
  apply quiver.hom.op_inj,
  convert hom_equiv_left_adjoint_uniq_hom_app
    (op_adjoint_op_of_adjoint _ F adj2) (op_adjoint_op_of_adjoint _ _ adj1) (opposite.op x),
  simpa
end

@[simp, reassoc]
lemma unit_right_adjoint_uniq_hom_app {F : C ⥤ D} {G G' : D ⥤ C}
  (adj1 : F ⊣ G) (adj2 : F ⊣ G') (x : C) :
  adj1.unit.app x ≫ (right_adjoint_uniq adj1 adj2).hom.app (F.obj x) = adj2.unit.app x :=
begin
  apply quiver.hom.op_inj,
  convert left_adjoint_uniq_hom_app_counit
    (op_adjoint_op_of_adjoint _ _ adj2) (op_adjoint_op_of_adjoint _ _ adj1) (opposite.op x),
  all_goals { simpa }
end

@[simp, reassoc]
lemma unit_right_adjoint_uniq_hom {F : C ⥤ D} {G G' : D ⥤ C} (adj1 : F ⊣ G) (adj2 : F ⊣ G') :
  adj1.unit ≫ whisker_left F (right_adjoint_uniq adj1 adj2).hom = adj2.unit :=
by { ext x, simp }

@[simp, reassoc]
lemma right_adjoint_uniq_hom_app_counit {F : C ⥤ D} {G G' : D ⥤ C}
  (adj1 : F ⊣ G) (adj2 : F ⊣ G') (x : D) :
  F.map ((right_adjoint_uniq adj1 adj2).hom.app x) ≫ adj2.counit.app x = adj1.counit.app x :=
begin
  apply quiver.hom.op_inj,
  convert unit_left_adjoint_uniq_hom_app
    (op_adjoint_op_of_adjoint _ _ adj2) (op_adjoint_op_of_adjoint _ _ adj1) (opposite.op x),
  all_goals { simpa }
end

@[simp, reassoc]
lemma right_adjoint_uniq_hom_counit {F : C ⥤ D} {G G' : D ⥤ C} (adj1 : F ⊣ G) (adj2 : F ⊣ G') :
  whisker_right (right_adjoint_uniq adj1 adj2).hom F ≫ adj2.counit = adj1.counit :=
by { ext, simp }

@[simp]
lemma right_adjoint_uniq_inv_app {F : C ⥤ D} {G G' : D ⥤ C}
  (adj1 : F ⊣ G) (adj2 : F ⊣ G') (x : D) :
  (right_adjoint_uniq adj1 adj2).inv.app x = (right_adjoint_uniq adj2 adj1).hom.app x := rfl

@[simp, reassoc]
lemma right_adjoint_uniq_trans_app {F : C ⥤ D} {G G' G'' : D ⥤ C}
  (adj1 : F ⊣ G) (adj2 : F ⊣ G') (adj3 : F ⊣ G'') (x : D) :
  (right_adjoint_uniq adj1 adj2).hom.app x ≫ (right_adjoint_uniq adj2 adj3).hom.app x =
    (right_adjoint_uniq adj1 adj3).hom.app x :=
begin
  apply quiver.hom.op_inj,
  exact left_adjoint_uniq_trans_app (op_adjoint_op_of_adjoint _ _ adj3)
    (op_adjoint_op_of_adjoint _ _ adj2) (op_adjoint_op_of_adjoint _ _ adj1) (opposite.op x)
end

@[simp, reassoc]
lemma right_adjoint_uniq_trans {F : C ⥤ D} {G G' G'' : D ⥤ C}
  (adj1 : F ⊣ G) (adj2 : F ⊣ G') (adj3 : F ⊣ G'') :
  (right_adjoint_uniq adj1 adj2).hom ≫ (right_adjoint_uniq adj2 adj3).hom =
    (right_adjoint_uniq adj1 adj3).hom :=
by { ext, simp }

@[simp]
lemma right_adjoint_uniq_refl {F : C ⥤ D} {G : D ⥤ C} (adj1 : F ⊣ G) :
  (right_adjoint_uniq adj1 adj1).hom = 𝟙 _ :=
by { delta right_adjoint_uniq, simp }

/--
Given two adjunctions, if the left adjoints are naturally isomorphic, then so are the right
adjoints.
-/
def nat_iso_of_left_adjoint_nat_iso {F F' : C ⥤ D} {G G' : D ⥤ C}
  (adj1 : F ⊣ G) (adj2 : F' ⊣ G') (l : F ≅ F') :
  G ≅ G' :=
right_adjoint_uniq adj1 (adj2.of_nat_iso_left l.symm)

/--
Given two adjunctions, if the right adjoints are naturally isomorphic, then so are the left
adjoints.
-/
def nat_iso_of_right_adjoint_nat_iso {F F' : C ⥤ D} {G G' : D ⥤ C}
  (adj1 : F ⊣ G) (adj2 : F' ⊣ G') (r : G ≅ G') :
  F ≅ F' :=
left_adjoint_uniq adj1 (adj2.of_nat_iso_right r.symm)

end category_theory.adjunction


import classes.context_sensitive.basics.definition

variables {T : Type} {g : CS_grammar T}

/-- The relation `CS_derives` is reflexive. -/
lemma CS_deri_self {w : list (symbol T g.nt)} :
  CS_derives g w w :=
relation.refl_trans_gen.refl

lemma CS_deri_of_tran {v w : list (symbol T g.nt)} :
  CS_transforms g v w → CS_derives g v w :=
relation.refl_trans_gen.single

/-- The relation `CS_derives` is transitive. -/
lemma CS_deri_of_deri_deri {u v w : list (symbol T g.nt)}
    (huv : CS_derives g u v) (hvw : CS_derives g v w) :
  CS_derives g u w :=
relation.refl_trans_gen.trans huv hvw

lemma CS_deri_of_deri_tran {u v w : list (symbol T g.nt)}
    (huv : CS_derives g u v) (hvw : CS_transforms g v w) :
  CS_derives g u w :=
CS_deri_of_deri_deri huv (CS_deri_of_tran hvw)

lemma CS_deri_of_tran_deri {u v w : list (symbol T g.nt)}
    (huv : CS_transforms g u v) (hvw : CS_derives g v w) :
  CS_derives g u w :=
CS_deri_of_deri_deri (CS_deri_of_tran huv) hvw

lemma CS_tran_or_id_of_deri {u w : list (symbol T g.nt)} (ass : CS_derives g u w) :
  (u = w) ∨
  (∃ v : list (symbol T g.nt), (CS_transforms g u v) ∧ (CS_derives g v w)) :=
relation.refl_trans_gen.cases_head ass


/-
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 (CMU)
-/
import tactic.core

section
universe u

@[user_attribute]
meta def monotonicity : user_attribute :=
{ name := `monotonicity, descr := "Monotonicity rules for predicates" }

lemma monotonicity.pi {α : Sort u} {p q : α → Prop} (h : ∀a, implies (p a) (q a)) :
  implies (Πa, p a) (Πa, q a) :=
assume h' a, h a (h' a)

lemma monotonicity.imp {p p' q q' : Prop} (h₁ : implies p' q') (h₂ : implies q p) :
  implies (p → p') (q → q') :=
assume h, h₁ ∘ h ∘ h₂

@[monotonicity]
lemma monotonicity.const (p : Prop) : implies p p := id

@[monotonicity]
lemma monotonicity.true (p : Prop) : implies p true := assume _, trivial

@[monotonicity]
lemma monotonicity.false (p : Prop) : implies false p := false.elim

@[monotonicity]
lemma monotonicity.exists {α : Sort u} {p q : α → Prop} (h : ∀a, implies (p a) (q a)) :
  implies (∃a, p a) (∃a, q a) :=
exists_imp_exists h

@[monotonicity]
lemma monotonicity.and {p p' q q' : Prop} (hp : implies p p') (hq : implies q q') :
  implies (p ∧ q) (p' ∧ q') :=
and.imp hp hq

@[monotonicity]
lemma monotonicity.or {p p' q q' : Prop} (hp : implies p p') (hq : implies q q') :
  implies (p ∨ q) (p' ∨ q') :=
or.imp hp hq

@[monotonicity]
lemma monotonicity.not {p q : Prop} (h : implies p q) :
  implies (¬ q) (¬ p) :=
mt h

end

namespace tactic
open expr tactic

/- TODO: use backchaining -/
private meta def mono_aux (ns : list name) (hs : list expr) : tactic unit := do
  intros,
  (do
    `(implies %%p %%q) ← target,
    (do is_def_eq p q, eapplyc `monotone.const) <|>
    (do
      (expr.pi pn pbi pd pb) ← whnf p,
      (expr.pi qn qbi qd qb) ← whnf q,
      sort u ← infer_type pd,
      (do is_def_eq pd qd,
        let p' := expr.lam pn pbi pd pb,
        let q' := expr.lam qn qbi qd qb,
        eapply ((const `monotonicity.pi [u] : expr) pd p' q'),
        skip) <|>
      (do guard $ u = level.zero ∧ is_arrow p ∧ is_arrow q,
        let p' := pb.lower_vars 0 1,
        let q' := qb.lower_vars 0 1,
        eapply ((const `monotonicity.imp []: expr) pd p' qd q'),
        skip))) <|>
  first (hs.map $ λh,
    apply_core h {md := transparency.none, new_goals := new_goals.non_dep_only} >> skip) <|>
  first (ns.map $ λn, do c ← mk_const n,
    apply_core c {md := transparency.none, new_goals := new_goals.non_dep_only}, skip),
  all_goals' mono_aux

meta def mono (e : expr) (hs : list expr) : tactic unit := do
  t ← target,
  t' ← infer_type e,
  ns ← attribute.get_instances `monotonicity,
  ((), p) ← solve_aux `(implies %%t' %%t) (mono_aux ns hs),
  exact (p e)

end tactic

/-
The coinductive predicate `pred`:

  coinductive {u} pred (A) : a → Prop
  | r : ∀A b, pred A p

where
  `u` is a list of universe parameters
  `A` is a list of global parameters
  `pred` is a list predicates to be defined
  `a` are the indices for each `pred`
  `r` is a list of introduction rules for each `pred`
  `b` is a list of parameters for each rule in `r` and `pred`
  `p` is are the instances of `a` using `A` and `b`

`pred` is compiled to the following defintions:

  inductive {u} pred.functional (A) ([pred'] : a → Prop) : a → Prop
  | r : ∀a [f], b[pred/pred'] → pred.functional a [f] p

  lemma {u} pred.functional.mono (A) ([pred₁] [pred₂] : a → Prop) [(h : ∀b, pred₁ b → pred₂ b)] :
    ∀p, pred.functional A pred₁ p → pred.functional A pred₂ p

  def {u} pred_i (A) (a) : Prop :=
  ∃[pred'], (Λi, ∀a, pred_i a → pred_i.functional A [pred] a) ∧ pred'_i a

  lemma {u} pred_i.corec_functional (A) [Λi, C_i : a_i → Prop]
    [Λi, h : ∀a, C_i a → pred_i.functional A C_i a] :
    ∀a, C_i a → pred_i A a

  lemma {u} pred_i.destruct (A) (a) : pred A a → pred.functional A [pred A] a

  lemma {u} pred_i.construct (A) : ∀a, pred_i.functional A [pred A] a → pred_i A a

  lemma {u} pred_i.cases_on (A) (C : a → Prop) {a} (h : pred_i a) [Λi, ∀a, b → C p] → C a

  lemma {u} pred_i.corec_on (A) [(C : a → Prop)] (a) (h : C_i a)
    [Λi, h_i : ∀a, C_i a → [V j ∃b, a = p]] : pred_i A a

  lemma {u} pred.r (A) (b) : pred_i A p
-/

namespace tactic
open level expr tactic

namespace add_coinductive_predicate

/- private -/ meta structure coind_rule : Type :=
(orig_nm  : name)
(func_nm  : name)
(type     : expr)
(loc_type : expr)
(args     : list expr)
(loc_args : list expr)
(concl    : expr)
(insts    : list expr)

/- private -/ meta structure coind_pred : Type :=
(u_names  : list name)
(params   : list expr)
(pd_name  : name)
(type     : expr)
(intros   : list coind_rule)
(locals   : list expr)
(f₁ f₂    : expr)
(u_f      : level)

namespace coind_pred

meta def u_params (pd : coind_pred) : list level :=
pd.u_names.map param

meta def f₁_l (pd : coind_pred) : expr :=
pd.f₁.app_of_list pd.locals

meta def f₂_l (pd : coind_pred) : expr :=
pd.f₂.app_of_list pd.locals

meta def pred (pd : coind_pred) : expr :=
const pd.pd_name pd.u_params

meta def func (pd : coind_pred) : expr :=
const (pd.pd_name ++ "functional") pd.u_params

meta def func_g (pd : coind_pred) : expr :=
pd.func.app_of_list $ pd.params

meta def pred_g (pd : coind_pred) : expr :=
pd.pred.app_of_list $ pd.params

meta def impl_locals (pd : coind_pred) : list expr :=
pd.locals.map to_implicit_binder

meta def impl_params (pd : coind_pred) : list expr :=
pd.params.map to_implicit_binder

meta def le (pd : coind_pred) (f₁ f₂ : expr) : expr :=
(imp (f₁.app_of_list pd.locals) (f₂.app_of_list pd.locals)).pis pd.impl_locals

meta def corec_functional (pd : coind_pred) : expr :=
const (pd.pd_name ++ "corec_functional") pd.u_params

meta def mono (pd : coind_pred) : expr :=
const (pd.func.const_name ++ "mono") pd.u_params

meta def rec' (pd : coind_pred) : tactic expr :=
do let c := pd.func.const_name ++ "rec",
   env  ← get_env,
   decl ← env.get c,
   let num := decl.univ_params.length,
   return (const c $ if num = pd.u_params.length then pd.u_params else level.zero :: pd.u_params)
  -- ^^ `rec`'s universes are not always `u_params`, e.g. eq, wf, false

meta def construct (pd : coind_pred) : expr :=
const (pd.pd_name ++ "construct") pd.u_params

meta def destruct (pd : coind_pred) : expr :=
const (pd.pd_name ++ "destruct") pd.u_params

meta def add_theorem (pd : coind_pred) (n : name) (type : expr) (tac : tactic unit) : tactic expr :=
add_theorem_by n pd.u_names type tac

end coind_pred

end add_coinductive_predicate

open add_coinductive_predicate

/-- compact_relation bs as_ps: Product a relation of the form:
  R := λ as, ∃ bs, Λ_i a_i = p_i[bs]
This relation is user visible, so we compact it by removing each `b_j` where a `p_i = b_j`, and
hence `a_i = b_j`. We need to take care when there are `p_i` and `p_j` with `p_i = p_j = b_k`. -/
meta def compact_relation :
  list expr → list (expr × expr) → list expr × list (expr × expr)
| [] ps      := ([], ps)
| (list.cons b bs) ps :=
  match ps.span (λap:expr × expr, ¬ ap.2 =ₐ b) with
    | (_, [])           := let (bs, ps) := compact_relation bs ps in (b::bs, ps)
    | (ps₁, list.cons (a, _) ps₂) := let i := a.instantiate_local b.local_uniq_name in
      compact_relation (bs.map i) ((ps₁ ++ ps₂).map (λ⟨a, p⟩, (a, i p)))
  end

meta def add_coinductive_predicate
  (u_names : list name) (params : list expr) (preds : list $ expr × list expr) : command := do
  let params_names := params.map local_pp_name,
  let u_params := u_names.map param,

  pre_info ← preds.mmap (λ⟨c, is⟩, do
    (ls, t) ← open_pis c.local_type,
    (is_def_eq t `(Prop) <|>
      fail (format! "Type of {c.local_pp_name} is not Prop. Currently only " ++
                    "coinductive predicates are supported.")),
    let n := if preds.length = 1 then "" else "_" ++ c.local_pp_name.last_string,
    f₁ ← mk_local_def (mk_simple_name $ "C" ++ n) c.local_type,
    f₂ ← mk_local_def (mk_simple_name $ "C₂" ++ n) c.local_type,
    return (ls, (f₁, f₂))),

  let fs := pre_info.map prod.snd,
  let fs₁ := fs.map prod.fst,
  let fs₂ := fs.map prod.snd,

  pds ← (preds.zip pre_info).mmap (λ⟨⟨c, is⟩, ls, f₁, f₂⟩, do
    sort u_f ← infer_type f₁ >>= infer_type,
    let pred_g := λc:expr, (const c.local_uniq_name u_params : expr).app_of_list params,
    intros ← is.mmap (λi, do
      (args, t') ← open_pis i.local_type,
      (name.mk_string sub p) ← return i.local_uniq_name,
      let loc_args := args.map $ λe, (fs₁.zip preds).foldl (λ(e:expr) ⟨f, c, _⟩,
        e.replace_with (pred_g c) f) e,
      let t' := t'.replace_with (pred_g c) f₂,
      return { tactic.add_coinductive_predicate.coind_rule .
        orig_nm  := i.local_uniq_name,
        func_nm  := (p ++ "functional") ++ sub,
        type     := i.local_type,
        loc_type := t'.pis loc_args,
        concl    := t',
        loc_args := loc_args,
        args     := args,
        insts    := t'.get_app_args }),
    return { tactic.add_coinductive_predicate.coind_pred .
      pd_name := c.local_uniq_name, type := c.local_type, f₁ := f₁, f₂ := f₂, u_f := u_f,
      intros := intros, locals := ls, params := params, u_names := u_names }),

  /- Introduce all functionals -/
  pds.mmap' (λpd:coind_pred, do
    let func_f₁ := pd.func_g.app_of_list $ fs₁,
    let func_f₂ := pd.func_g.app_of_list $ fs₂,

    /- Define functional for `pd` as inductive predicate -/
    func_intros ← pd.intros.mmap (λr:coind_rule, do
      let t := instantiate_local pd.f₂.local_uniq_name (pd.func_g.app_of_list fs₁) r.loc_type,
      return (r.func_nm, r.orig_nm, t.pis $ params ++ fs₁)),
    add_inductive pd.func.const_name u_names
      (params.length + preds.length) (pd.type.pis $ params ++ fs₁)
        (func_intros.map $ λ⟨t, _, r⟩, (t, r)),

    /- Prove monotonicity rule -/
    mono_params ← pds.mmap (λpd, do
      h ← mk_local_def `h $ pd.le pd.f₁ pd.f₂,
      return [pd.f₁, pd.f₂, h]),
    pd.add_theorem (pd.func.const_name ++ "mono")
      ((pd.le func_f₁ func_f₂).pis $ params ++ mono_params.join)
      (do
      ps ← intro_lst $ params.map expr.local_pp_name,
      fs ← pds.mmap (λpd, do
        [f₁, f₂, h] ← intro_lst [pd.f₁.local_pp_name, pd.f₂.local_pp_name, `h],
        -- the type of h' reduces to h
        let h' := local_const h.local_uniq_name h.local_pp_name h.local_binding_info $
          (((const `implies [] : expr) (f₁.app_of_list pd.locals)
            (f₂.app_of_list pd.locals)).pis pd.locals).instantiate_locals $
          (ps.zip params).map $ λ⟨lv, p⟩, (p.local_uniq_name, lv),
        return (f₂, h')),
      m ← pd.rec',
      eapply $ m.app_of_list ps, -- somehow `induction` / `cases` doesn't work?
      func_intros.mmap' (λ⟨n, pp_n, t⟩, solve1 $ do
        bs ← intros,
        ms ← apply_core
          ((const n u_params).app_of_list $ ps ++ fs.map prod.fst) {new_goals := new_goals.all},
        params ← (ms.zip bs).enum.mfilter (λ⟨n, m, d⟩, bnot <$> is_assigned m.2),
        params.mmap' (λ⟨n, m, d⟩, mono d (fs.map prod.snd) <|>
          fail format! "failed to prove montonoicity of {n+1}. parameter of intro-rule {pp_n}")))),

  pds.mmap' (λpd, do
    let func_f := λpd:coind_pred, pd.func_g.app_of_list $ pds.map coind_pred.f₁,

    /- define final predicate -/
    pred_body ← mk_exists_lst (pds.map coind_pred.f₁) $
      mk_and_lst $ (pds.map $ λpd, pd.le pd.f₁ (func_f pd)) ++ [pd.f₁.app_of_list pd.locals],
    add_decl $ mk_definition pd.pd_name u_names (pd.type.pis $ params) $
      pred_body.lambdas $ params ++ pd.locals,

    /- prove `corec_functional` rule -/
    hs ← pds.mmap $ λpd:coind_pred, mk_local_def `hc $ pd.le pd.f₁ (func_f pd),
    pd.add_theorem (pd.pred.const_name ++ "corec_functional")
      ((pd.le pd.f₁ pd.pred_g).pis $ params ++ fs₁ ++ hs)
      (do
      intro_lst $ params.map local_pp_name,
      fs ← intro_lst $ fs₁.map local_pp_name,
      hs ← intro_lst $ hs.map local_pp_name,
      ls ← intro_lst $ pd.locals.map local_pp_name,
      h ← intro `h,
      whnf_target,
      fs.mmap' existsi,
      hs.mmap' (λf, econstructor >> exact f),
      exact h)),

  let func_f := λpd : coind_pred, pd.func_g.app_of_list $ pds.map coind_pred.pred_g,

  /- prove `destruct` rules -/
  pds.enum.mmap' (λ⟨n, pd⟩, do
    let destruct := pd.le pd.pred_g (func_f pd),
    pd.add_theorem (pd.pred.const_name ++ "destruct") (destruct.pis params) (do
      ps ← intro_lst $ params.map local_pp_name,
      ls ← intro_lst $ pd.locals.map local_pp_name,
      h ← intro `h,
      (fs, h, _) ← elim_gen_prod pds.length h [] [],
      (hs, h, _) ← elim_gen_prod pds.length h [] [],
      eapply $ pd.mono.app_of_list ps,
      pds.mmap' (λpd:coind_pred, focus1 $ do
        eapply $ pd.corec_functional,
        focus $ hs.map exact),
      some h' ← return $ hs.nth n,
      eapply h',
      exact h)),

  /- prove `construct` rules -/
  pds.mmap' (λpd,
    pd.add_theorem (pd.pred.const_name ++ "construct")
      ((pd.le (func_f pd) pd.pred_g).pis params) (do
      ps ← intro_lst $ params.map local_pp_name,
      let func_pred_g := λpd:coind_pred,
        pd.func.app_of_list $ ps ++ pds.map (λpd:coind_pred, pd.pred.app_of_list ps),
      eapply $ pd.corec_functional.app_of_list $ ps ++ pds.map func_pred_g,
      pds.mmap' (λpd:coind_pred, solve1 $ do
        eapply $ pd.mono.app_of_list ps,
        pds.mmap' (λpd, solve1 $ eapply (pd.destruct.app_of_list ps) >> skip)))),

  /- prove `cases_on` rules -/
  pds.mmap' (λpd, do
    let C := pd.f₁.to_implicit_binder,
    h ← mk_local_def `h $ pd.pred_g.app_of_list pd.locals,
    rules ← pd.intros.mmap (λr:coind_rule, do
      mk_local_def (mk_simple_name r.orig_nm.last_string) $ (C.app_of_list r.insts).pis r.args),
    cases_on ← pd.add_theorem (pd.pred.const_name ++ "cases_on")
      ((C.app_of_list pd.locals).pis $ params ++ [C] ++ pd.impl_locals ++ [h] ++ rules)
      (do
        ps ← intro_lst $ params.map local_pp_name,
        C  ← intro `C,
        ls ← intro_lst $ pd.locals.map local_pp_name,
        h  ← intro `h,
        rules  ← intro_lst $ rules.map local_pp_name,
        func_rec ← pd.rec',
        eapply $ func_rec.app_of_list $ ps ++ pds.map (λpd, pd.pred.app_of_list ps) ++ [C] ++ rules,
        eapply $ pd.destruct,
        exact h),
    set_basic_attribute `elab_as_eliminator cases_on.const_name),

  /- prove `corec_on` rules -/
  pds.mmap' (λpd, do
    rules ← pds.mmap (λpd, do
      intros ← pd.intros.mmap (λr, do
        let (bs, eqs) := compact_relation r.loc_args $ pd.locals.zip r.insts,
        eqs ← eqs.mmap (λ⟨l, i⟩, do
          sort u ← infer_type l.local_type,
          return $ (const `eq [u] : expr) l.local_type i l),
        match bs, eqs with
        | [], [] := return ((0, 0), mk_true)
        | _, []  := prod.mk (bs.length, 0) <$> mk_exists_lst bs.init bs.ilast.local_type
        | _, _   := prod.mk (bs.length, eqs.length) <$> mk_exists_lst bs (mk_and_lst eqs)
        end),
      let shape  := intros.map prod.fst,
      let intros := intros.map prod.snd,
      prod.mk shape <$>
        mk_local_def (mk_simple_name $ "h_" ++ pd.pd_name.last_string)
          (((pd.f₁.app_of_list pd.locals).imp (mk_or_lst intros)).pis pd.locals)),
    let shape := rules.map prod.fst,
    let rules := rules.map prod.snd,
    h ← mk_local_def `h $ pd.f₁.app_of_list pd.locals,
    pd.add_theorem (pd.pred.const_name ++ "corec_on")
      ((pd.pred_g.app_of_list $ pd.locals).pis $ params ++ fs₁ ++ pd.impl_locals ++ [h] ++ rules)
      (do
        ps ← intro_lst $ params.map local_pp_name,
        fs ← intro_lst $ fs₁.map local_pp_name,
        ls ← intro_lst $ pd.locals.map local_pp_name,
        h  ← intro `h,
        rules  ← intro_lst $ rules.map local_pp_name,
        eapply $ pd.corec_functional.app_of_list $ ps ++ fs,
        (pds.zip $ rules.zip shape).mmap (λ⟨pd, hr, s⟩, solve1 $ do
          ls ← intro_lst $ pd.locals.map local_pp_name,
          h' ← intro `h,
          h' ← note `h' none $ hr.app_of_list ls h',
          match s.length with
          | 0     := induction h' >> skip -- h' : false
          | (n+1) := do
            hs ← elim_gen_sum n h',
            (hs.zip $ pd.intros.zip s).mmap' (λ⟨h, r, n_bs, n_eqs⟩, solve1 $ do
              (as, h, _) ← elim_gen_prod (n_bs - (if n_eqs = 0 then 1 else 0)) h [] [],
              if n_eqs > 0 then do
                (eqs, eq', _) ← elim_gen_prod (n_eqs - 1) h [] [],
                (eqs ++ [eq']).mmap' subst
              else skip,
              eapply ((const r.func_nm u_params).app_of_list $ ps ++ fs),
              iterate assumption)
          end),
        exact h)),

  /- prove constructors -/
  pds.mmap' (λpd, pd.intros.mmap' (λr,
    pd.add_theorem r.orig_nm (r.type.pis params) $ do
      ps ← intro_lst $ params.map local_pp_name,
      bs ← intros,
      eapply $ pd.construct,
      exact $ (const r.func_nm u_params).app_of_list $
        ps ++ pds.map (λpd, pd.pred.app_of_list ps) ++ bs)),

  pds.mmap' (λpd:coind_pred, set_basic_attribute `irreducible pd.pd_name),

  try triv -- we setup a trivial goal for the tactic framework

setup_tactic_parser

@[user_command]
meta def coinductive_predicate (meta_info : decl_meta_info) (_ : parse $ tk "coinductive") :
  lean.parser unit := do
{ decl ← inductive_decl.parse meta_info,
  add_coinductive_predicate decl.u_names decl.params $ decl.decls.map $ λ d, (d.sig, d.intros),
  decl.decls.mmap' $ λ d, do
  { get_env >>= λ env, set_env $ env.add_namespace d.name,
    meta_info.attrs.apply d.name,
    d.attrs.apply d.name,
    some doc_string ← pure meta_info.doc_string | skip,
    add_doc_string d.name doc_string } }

/-- Prepares coinduction proofs. This tactic constructs the coinduction invariant from
the quantifiers in the current goal.

Current version: do not support mutual inductive rules -/
meta def coinduction (rule : expr) (ns : list name) : tactic unit := focus1 $
do
  ctxts' ← intros,
  ctxts ← ctxts'.mmap (λv,
    local_const v.local_uniq_name v.local_pp_name v.local_binding_info <$> infer_type v),
  mvars ← apply_core rule {approx := ff, new_goals := new_goals.all},
  -- analyse relation
  g ← list.head <$> get_goals,
  (list.cons _ m_is) ← return $ mvars.drop_while (λv, v.2 ≠ g),
  tgt ← target,
  (is, ty) ← open_pis tgt,
  -- construct coinduction predicate
  (bs, eqs) ← compact_relation ctxts <$>
    ((is.zip m_is).mmap (λ⟨i, m⟩, prod.mk i <$> instantiate_mvars m.2)),
  solve1 (do
    eqs ← mk_and_lst <$> eqs.mmap (λ⟨i, m⟩,
      mk_app `eq [m, i] >>= instantiate_mvars)
    <|> do { x ← mk_psigma (eqs.map prod.fst),
             y ← mk_psigma (eqs.map prod.snd),
             t ← infer_type x,
             mk_mapp `eq [t,x,y] },
    rel ← mk_exists_lst bs eqs,
    exact (rel.lambdas is)),
  -- prove predicate
  solve1 (do
    target >>= instantiate_mvars >>= change,
    -- TODO: bug in existsi & constructor when mvars in hyptohesis
    bs.mmap existsi,
    iterate' (econstructor >> skip)),

  -- clean up remaining coinduction steps
  all_goals' (do
    ctxts'.reverse.mmap clear,
    target >>= instantiate_mvars >>= change, -- TODO: bug in subst when mvars in hyptohesis
    is ← intro_lst $ is.map expr.local_pp_name,
    h ← intro1,
    (_, h, ns) ← elim_gen_prod (bs.length - (if eqs.length = 0 then 1 else 0)) h [] ns,
    (match eqs with
    | [] := clear h
    | (e::eqs) := do
      (hs, h, ns) ← elim_gen_prod eqs.length h [] ns,
      (h::(hs.reverse) : list _).mfoldl (λ (hs : list name) (h : expr),
        do [(_,hs',σ)] ← cases_core h hs,
           clear (h.instantiate_locals σ),
           pure $ hs.drop hs'.length) ns,
      skip
    end))

namespace interactive
open interactive interactive.types expr lean.parser
local postfix `?`:9001 := optional
local postfix (name := parser.many) *:9001 := many

meta def coinduction (corec_name : parse ident)
  (ns : parse with_ident_list)
  (revert : parse $ (tk "generalizing" *> ident*)?) : tactic unit := do
  rule ← mk_const corec_name,
  locals ← mmap tactic.get_local $ revert.get_or_else [],
  revert_lst locals,
  tactic.coinduction rule ns,
  skip

end interactive

end tactic


import analysis.analytic.composition
import analysis.inner_product_space.basic
import analysis.normed_space.pi_Lp
import analysis.calculus.iterated_deriv
import analysis.calculus.mean_value
import analysis.calculus.implicit
import measure_theory.integral.bochner
import measure_theory.measure.lebesgue
import linear_algebra.matrix.trace

namespace lftcm

noncomputable theory

open real
open_locale topological_space filter classical real

/-!
# Derivatives

Lean can automatically compute some simple derivatives using `simp` tactic.
-/

example : deriv (λ x : ℝ, x^5) 6 = 5 * 6^4 := sorry

example (x₀ : ℝ) (h₀ : x₀ ≠ 0) : deriv (λ x:ℝ, 1 / x) x₀ = -1 / x₀^2 := sorry

example : deriv sin π = -1 := sorry

-- Sometimes you need `ring` and/or `field_simp` after `simp`
example (x₀ : ℝ) (h : x₀ ≠ 0) :
  deriv (λ x : ℝ, exp(x^2) / x^5) x₀ = (2 * x₀^2 - 5) * exp (x₀^2) / x₀^6 :=
begin
  have : x₀^5 ≠ 0, { sorry },
  simp [this],
  sorry
end

example (a b x₀ : ℝ) (h : x₀ ≠ 1) :
  deriv (λ x, (a * x + b) / (x - 1)) x₀ = -(a + b) / (x₀ - 1)^2 :=
begin
  sorry
end

-- Currently `simp` is unable to solve the next example.
-- A PR that will make this example provable `by simp` would be very welcome!
example : iterated_deriv 7 (λ x, sin (tan x) - tan (sin x)) 0 = -168 := sorry

variables (m n : Type) [fintype m] [fintype n]

-- Generalizations of the next two instances should go to `analysis/normed_space/basic`
instance : normed_add_comm_group (matrix m n ℝ) := pi.normed_add_comm_group
instance : normed_space ℝ (matrix m n ℝ) := pi.normed_space

/-- Trace of a matrix as a continuous linear map. -/
def matrix.trace_clm : matrix n n ℝ →L[ℝ] ℝ :=
(matrix.trace_linear_map n ℝ ℝ).mk_continuous (fintype.card n)
begin
  sorry
end

-- Another hard exercise that would make a very good PR
example :
  has_fderiv_at (λ m : matrix n n ℝ, m.det) (matrix.trace_clm n) 1 :=
begin
  sorry
end

end lftcm

#check deriv

#check has_fderiv_at

example (y : ℝ) : has_deriv_at (λ x : ℝ, 2 * x + 5) 2 y :=
begin
  have := ((has_deriv_at_id y).const_mul 2).add_const 5,
  rwa [mul_one] at this,
end

example (y : ℝ) : deriv (λ x : ℝ, 2 * x + 5) y = 2 := by simp

#check exists_has_deriv_at_eq_slope

#check exists_deriv_eq_slope

open set topological_space

namespace measure_theory

variables {α E : Type*} [measurable_space α] [normed_add_comm_group E] [normed_space ℝ E]
  [measurable_space E] [borel_space E] [complete_space E] [second_countable_topology E]
  {μ : measure α} {f : α → E}

#check integral

#check ∫ x : ℝ, x ^ 2

#check ∫ x in Icc (0:ℝ) 1, x^2

#check ∫ x, f x ∂μ

#check integral_add

#check integral_add_measure

#check integral_union

lemma integral_sdiff (f : α → E) (hfm : measurable f) {s t : set α}
  (hs : measurable_set s) (ht : measurable_set t) (hst : s ⊆ t)
  (hfi : integrable f $ μ.restrict t) :
  ∫ x in t \ s, f x ∂μ = ∫ x in t, f x ∂μ - ∫ x in s, f x ∂μ :=
begin
  -- hint: apply `integral_union` to `s` and `t \ s`
  sorry
end

lemma integral_Icc_sub_Icc_of_le [linear_order α] [topological_space α] [order_topology α]
  [borel_space α] {x y z : α} (hxy : x ≤ y) (hyz : y ≤ z)
  {f : α → ℝ} (hfm : measurable f) (hfi : integrable f (μ.restrict $ Icc x z)) :
  ∫ a in Icc x z, f a ∂μ - ∫ a in Icc x y, f a ∂μ = ∫ a in Ioc y z, f a ∂μ :=
begin
  rw [sub_eq_iff_eq_add', ← integral_union, Icc_union_Ioc_eq_Icc];
  sorry
end

#check set_integral_const

end measure_theory

open measure_theory

theorem FTC {f : ℝ → ℝ} {x y : ℝ} (hy : continuous_at f y) (h : x < y)
  (hfm : measurable f)
  (hfi : integrable f (volume.restrict $ Icc x y)) :
  has_deriv_at (λ z, ∫ a in Icc x z, f a) (f y) y :=
begin
  have A : has_deriv_within_at (λ z, ∫ a in Icc x z, f a) (f y) (Ici y) y,
  { rw [has_deriv_within_at_iff_tendsto, metric.tendsto_nhds_within_nhds],
    intros ε ε0,
    rw [metric.continuous_at_iff] at hy,
    rcases hy ε ε0 with ⟨δ, δ0, hδ⟩,
    use [δ, δ0],
    intros z hyz hzδ,
    rw [integral_Icc_sub_Icc_of_le, dist_zero_right, real.norm_eq_abs, abs_mul, abs_of_nonneg, abs_of_nonneg],
    all_goals {sorry } },
  have B : has_deriv_within_at (λ z, ∫ a in Icc x z, f a) (f y) (Iic y) y,
  { sorry },
  have := B.union A,
  simpa using this
end


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Bhavik Mehta
-/
import category_theory.monad.basic
import category_theory.adjunction.basic

/-!
# Eilenberg-Moore (co)algebras for a (co)monad

This file defines Eilenberg-Moore (co)algebras for a (co)monad,
and provides the category instance for them.

Further it defines the adjoint pair of free and forgetful functors, respectively
from and to the original category, as well as the adjoint pair of forgetful and
cofree functors, respectively from and to the original category.

## References
* [Riehl, *Category theory in context*, Section 5.2.4][riehl2017]
-/

namespace category_theory
open category

universes v₁ u₁ -- morphism levels before object levels. See note [category_theory universes].

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

namespace monad

/-- An Eilenberg-Moore algebra for a monad `T`.
    cf Definition 5.2.3 in [Riehl][riehl2017]. -/
structure algebra (T : monad C) : Type (max u₁ v₁) :=
(A : C)
(a : (T : C ⥤ C).obj A ⟶ A)
(unit' : T.η.app A ≫ a = 𝟙 A . obviously)
(assoc' : T.μ.app A ≫ a = (T : C ⥤ C).map a ≫ a . obviously)

restate_axiom algebra.unit'
restate_axiom algebra.assoc'
attribute [reassoc] algebra.unit algebra.assoc

namespace algebra
variables {T : monad C}

/-- A morphism of Eilenberg–Moore algebras for the monad `T`. -/
@[ext] structure hom (A B : algebra T) :=
(f : A.A ⟶ B.A)
(h' : (T : C ⥤ C).map f ≫ B.a = A.a ≫ f . obviously)

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

namespace hom

/-- The identity homomorphism for an Eilenberg–Moore algebra. -/
def id (A : algebra T) : hom A A :=
{ f := 𝟙 A.A }

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

/-- Composition of Eilenberg–Moore algebra homomorphisms. -/
def comp {P Q R : algebra T} (f : hom P Q) (g : hom Q R) : hom P R :=
{ f := f.f ≫ g.f }

end hom

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

@[simp] lemma comp_eq_comp {A A' A'' : algebra T} (f : A ⟶ A') (g : A' ⟶ A'') :
  algebra.hom.comp f g = f ≫ g := rfl
@[simp] lemma id_eq_id (A : algebra T) :
  algebra.hom.id A = 𝟙 A := rfl

@[simp]

/-- The category of Eilenberg-Moore algebras for a monad.
    cf Definition 5.2.4 in [Riehl][riehl2017]. -/
instance EilenbergMoore : category (algebra T) := {}.

/--
To construct an isomorphism of algebras, it suffices to give an isomorphism of the carriers which
commutes with the structure morphisms.
-/
@[simps]
def iso_mk {A B : algebra T} (h : A.A ≅ B.A) (w : (T : C ⥤ C).map h.hom ≫ B.a = A.a ≫ h.hom) :
  A ≅ B :=
{ hom := { f := h.hom },
  inv :=
  { f := h.inv,
    h' := by { rw [h.eq_comp_inv, category.assoc, ←w, ←functor.map_comp_assoc], simp } } }

end algebra

variables (T : monad C)

/-- The forgetful functor from the Eilenberg-Moore category, forgetting the algebraic structure. -/
@[simps] def forget : algebra T ⥤ C :=
{ obj := λ A, A.A,
  map := λ A B f, f.f }

/-- The free functor from the Eilenberg-Moore category, constructing an algebra for any object. -/
@[simps] def free : C ⥤ algebra T :=
{ obj := λ X,
  { A := T.obj X,
    a := T.μ.app X,
    assoc' := (T.assoc _).symm },
  map := λ X Y f,
  { f := T.map f,
    h' := T.μ.naturality _ } }

instance [inhabited C] : inhabited (algebra T) :=
⟨(free T).obj default⟩

/-- The adjunction between the free and forgetful constructions for Eilenberg-Moore algebras for
  a monad. cf Lemma 5.2.8 of [Riehl][riehl2017]. -/
-- The other two `simps` projection lemmas can be derived from these two, so `simp_nf` complains if
-- those are added too
@[simps unit counit]
def adj : T.free ⊣ T.forget :=
adjunction.mk_of_hom_equiv
{ hom_equiv := λ X Y,
  { to_fun := λ f, T.η.app X ≫ f.f,
    inv_fun := λ f,
    { f := T.map f ≫ Y.a,
      h' := by { dsimp, simp [←Y.assoc, ←T.μ.naturality_assoc] } },
    left_inv := λ f, by { ext, dsimp, simp },
    right_inv := λ f,
    begin
      dsimp only [forget_obj, monad_to_functor_eq_coe],
      rw [←T.η.naturality_assoc, Y.unit],
      apply category.comp_id,
    end }}

/--
Given an algebra morphism whose carrier part is an isomorphism, we get an algebra isomorphism.
-/
lemma algebra_iso_of_iso {A B : algebra T} (f : A ⟶ B) [is_iso f.f] : is_iso f :=
⟨⟨{ f := inv f.f,
    h' := by { rw [is_iso.eq_comp_inv f.f, category.assoc, ← f.h], simp } }, by tidy⟩⟩

instance forget_reflects_iso : reflects_isomorphisms T.forget :=
{ reflects := λ A B, algebra_iso_of_iso T }

instance forget_faithful : faithful T.forget := {}

instance : is_right_adjoint T.forget := ⟨T.free, T.adj⟩
@[simp] lemma left_adjoint_forget : left_adjoint T.forget = T.free := rfl
@[simp] lemma of_right_adjoint_forget : adjunction.of_right_adjoint T.forget = T.adj := rfl

/--
Given a monad morphism from `T₂` to `T₁`, we get a functor from the algebras of `T₁` to algebras of
`T₂`.
-/
@[simps]
def algebra_functor_of_monad_hom {T₁ T₂ : monad C} (h : T₂ ⟶ T₁) :
  algebra T₁ ⥤ algebra T₂ :=
{ obj := λ A,
  { A := A.A,
    a := h.app A.A ≫ A.a,
    unit' := by { dsimp, simp [A.unit] },
    assoc' := by { dsimp, simp [A.assoc] } },
  map := λ A₁ A₂ f,
  { f := f.f } }

/--
The identity monad morphism induces the identity functor from the category of algebras to itself.
-/
@[simps {rhs_md := semireducible}]
def algebra_functor_of_monad_hom_id {T₁ : monad C} :
  algebra_functor_of_monad_hom (𝟙 T₁) ≅ 𝟭 _ :=
nat_iso.of_components
  (λ X, algebra.iso_mk (iso.refl _) (by { dsimp, simp, }))
  (λ X Y f, by { ext, dsimp, simp })

/--
A composition of monad morphisms gives the composition of corresponding functors.
-/
@[simps {rhs_md := semireducible}]
def algebra_functor_of_monad_hom_comp {T₁ T₂ T₃ : monad C} (f : T₁ ⟶ T₂) (g : T₂ ⟶ T₃) :
  algebra_functor_of_monad_hom (f ≫ g) ≅
    algebra_functor_of_monad_hom g ⋙ algebra_functor_of_monad_hom f :=
nat_iso.of_components
  (λ X, algebra.iso_mk (iso.refl _) (by { dsimp, simp }))
  (λ X Y f, by { ext, dsimp, simp })

/--
If `f` and `g` are two equal morphisms of monads, 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 algebra_functor_of_monad_hom_eq {T₁ T₂ : monad C} {f g : T₁ ⟶ T₂} (h : f = g) :
  algebra_functor_of_monad_hom f ≅ algebra_functor_of_monad_hom g :=
nat_iso.of_components
  (λ X, algebra.iso_mk (iso.refl _) (by { dsimp, simp [h] }))
  (λ X Y f, by { ext, dsimp, simp })

/--
Isomorphic monads give equivalent categories of algebras. Furthermore, they are equivalent as
categories over `C`, that is, we have `algebra_equiv_of_iso_monads h ⋙ forget = forget`.
-/
@[simps]
def algebra_equiv_of_iso_monads {T₁ T₂ : monad C} (h : T₁ ≅ T₂) :
  algebra T₁ ≌ algebra T₂ :=
{ functor := algebra_functor_of_monad_hom h.inv,
  inverse := algebra_functor_of_monad_hom h.hom,
  unit_iso :=
    algebra_functor_of_monad_hom_id.symm ≪≫
    algebra_functor_of_monad_hom_eq (by simp) ≪≫
    algebra_functor_of_monad_hom_comp _ _,
  counit_iso :=
    (algebra_functor_of_monad_hom_comp _ _).symm ≪≫
    algebra_functor_of_monad_hom_eq (by simp) ≪≫
    algebra_functor_of_monad_hom_id }

@[simp] lemma algebra_equiv_of_iso_monads_comp_forget {T₁ T₂ : monad C} (h : T₁ ⟶ T₂) :
  algebra_functor_of_monad_hom h ⋙ forget _ = forget _ :=
rfl

end monad

namespace comonad

/-- An Eilenberg-Moore coalgebra for a comonad `T`. -/
@[nolint has_inhabited_instance]
structure coalgebra (G : comonad C) : Type (max u₁ v₁) :=
(A : C)
(a : A ⟶ (G : C ⥤ C).obj A)
(counit' : a ≫ G.ε.app A = 𝟙 A . obviously)
(coassoc' : a ≫ G.δ.app A = a ≫ G.map a . obviously)

restate_axiom coalgebra.counit'
restate_axiom coalgebra.coassoc'
attribute [reassoc] coalgebra.counit coalgebra.coassoc

namespace coalgebra
variables {G : comonad C}

/-- A morphism of Eilenberg-Moore coalgebras for the comonad `G`. -/
@[ext, nolint has_inhabited_instance] structure hom (A B : coalgebra G) :=
(f : A.A ⟶ B.A)
(h' : A.a ≫ (G : C ⥤ C).map f = f ≫ B.a . obviously)

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

namespace hom

/-- The identity homomorphism for an Eilenberg–Moore coalgebra. -/
def id (A : coalgebra G) : hom A A :=
{ f := 𝟙 A.A }

/-- Composition of Eilenberg–Moore coalgebra homomorphisms. -/
def comp {P Q R : coalgebra G} (f : hom P Q) (g : hom Q R) : hom P R :=
{ f := f.f ≫ g.f }

end hom

/-- The category of Eilenberg-Moore coalgebras for a comonad. -/
instance : category_struct (coalgebra G) :=
{ hom := hom,
  id := hom.id,
  comp := @hom.comp _ _ _ }

@[simp] lemma comp_eq_comp {A A' A'' : coalgebra G} (f : A ⟶ A') (g : A' ⟶ A'') :
  coalgebra.hom.comp f g = f ≫ g := rfl
@[simp] lemma id_eq_id (A : coalgebra G) :
  coalgebra.hom.id A = 𝟙 A := rfl

@[simp] lemma id_f (A : coalgebra G) : (𝟙 A : A ⟶ A).f = 𝟙 A.A := rfl
@[simp] lemma comp_f {A A' A'' : coalgebra G} (f : A ⟶ A') (g : A' ⟶ A'') :
  (f ≫ g).f = f.f ≫ g.f := rfl

/-- The category of Eilenberg-Moore coalgebras for a comonad. -/
instance EilenbergMoore : category (coalgebra G) := {}.

/--
To construct an isomorphism of coalgebras, it suffices to give an isomorphism of the carriers which
commutes with the structure morphisms.
-/
@[simps]
def iso_mk {A B : coalgebra G} (h : A.A ≅ B.A) (w : A.a ≫ (G : C ⥤ C).map h.hom = h.hom ≫ B.a) :
  A ≅ B :=
{ hom := { f := h.hom },
  inv :=
  { f := h.inv,
    h' := by { rw [h.eq_inv_comp, ←reassoc_of w, ←functor.map_comp], simp } } }

end coalgebra

variables (G : comonad C)

/-- The forgetful functor from the Eilenberg-Moore category, forgetting the coalgebraic
structure. -/
@[simps] def forget : coalgebra G ⥤ C :=
{ obj := λ A, A.A,
  map := λ A B f, f.f }

/-- The cofree functor from the Eilenberg-Moore category, constructing a coalgebra for any
object. -/
@[simps] def cofree : C ⥤ coalgebra G :=
{ obj := λ X,
  { A := G.obj X,
    a := G.δ.app X,
    coassoc' := (G.coassoc _).symm },
  map := λ X Y f,
  { f := G.map f,
    h' := (G.δ.naturality _).symm } }

/--
The adjunction between the cofree and forgetful constructions for Eilenberg-Moore coalgebras
for a comonad.
-/
-- The other two `simps` projection lemmas can be derived from these two, so `simp_nf` complains if
-- those are added too
@[simps unit counit]
def adj : G.forget ⊣ G.cofree :=
adjunction.mk_of_hom_equiv
{ hom_equiv := λ X Y,
  { to_fun := λ f,
    { f := X.a ≫ G.map f,
      h' := by { dsimp, simp [←coalgebra.coassoc_assoc] } },
    inv_fun := λ g, g.f ≫ G.ε.app Y,
    left_inv := λ f,
      by { dsimp, rw [category.assoc, G.ε.naturality, functor.id_map, X.counit_assoc] },
    right_inv := λ g,
    begin
      ext1, dsimp,
      rw [functor.map_comp, g.h_assoc, cofree_obj_a, comonad.right_counit],
      apply comp_id,
    end }}

/--
Given a coalgebra morphism whose carrier part is an isomorphism, we get a coalgebra isomorphism.
-/
lemma coalgebra_iso_of_iso {A B : coalgebra G} (f : A ⟶ B) [is_iso f.f] : is_iso f :=
⟨⟨{ f := inv f.f,
    h' := by { rw [is_iso.eq_inv_comp f.f, ←f.h_assoc], simp } }, by tidy⟩⟩

instance forget_reflects_iso : reflects_isomorphisms G.forget :=
{ reflects := λ A B, coalgebra_iso_of_iso G }

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

instance : is_left_adjoint G.forget := ⟨_, G.adj⟩
@[simp] lemma right_adjoint_forget : right_adjoint G.forget = G.cofree := rfl
@[simp] lemma of_left_adjoint_forget : adjunction.of_left_adjoint G.forget = G.adj := rfl

end comonad

end category_theory


import algebra.pi_instances analysis.complex
import .algebra_tensor .monoid_ring .field_extensions

universes u v w

instance subtype.comm_group {α : Type u} [comm_group α] (s : set α) [is_subgroup s] : comm_group s :=
by subtype_instance

noncomputable theory
local attribute [instance] classical.prop_decidable

variables {R : Type u} {A : Type v} {B : Type w}
variables [comm_ring R] [comm_ring A] [comm_ring B]
variables (iA : algebra R A) (iB : algebra R B)

open algebra.tensor_product

class cogroup :=
(comul : iA →ₐ iA.tensor_product iA)
(comul_assoc : (aassoc iA iA iA).comp
    ((amap comul (alg_hom.id iA)).comp comul)
  = (amap (alg_hom.id iA) comul).comp comul)
(coone : iA →ₐ algebra.id R)
(comul_coone : (tensor_id iA).comp
    ((amap (alg_hom.id iA) coone).comp comul)
  = alg_hom.id iA)
(coinv : iA →ₐ iA)
(comul_coinv : (arec (alg_hom.id iA) coinv).comp comul
  = iA.of_id.comp coone)

open monoid_ring

variables R
set_option class.instance_max_depth 50
instance group_ring.cogroup (M : Type v) [add_comm_group M] :
  cogroup (monoid_ring.algebra R M) :=
{ comul := eval _ _ _ (λ n, of_monoid R M n ⊗ₜ of_monoid R M n) $
    ⟨λ _ _, by rw [of_monoid_add, tensor_product.mul_def],
    by rw is_add_monoid_monoid_hom.zero (of_monoid R M); refl⟩,
  coone := eval _ _ _ (λ n, 1) ⟨λ _ _, (mul_one 1).symm, rfl⟩,
  comul_assoc := monoid_ring.ext _ _ _ _ _ (λ m,
    by simp only [alg_hom.comp_apply, eval_of_monoid, amap_tmul, aassoc_tmul, alg_hom.id_apply]),
  comul_coone := monoid_ring.ext _ _ _ _ _ (λ m,
    by simp only [alg_hom.comp_apply, eval_of_monoid, amap_tmul, tensor_id_tmul, alg_hom.id_apply];
    exact @one_smul R _ _ _ _ (of_monoid R M m)),
  coinv := eval _ _ _ (λ n, of_monoid R M (-n))
    ⟨λ _ _, by rw [neg_add, of_monoid_add], by rw neg_zero; refl⟩,
  comul_coinv := monoid_ring.ext _ _ _ _ _ (λ m,
    by simp only [alg_hom.comp_apply, eval_of_monoid, arec_tmul, alg_hom.id_apply, algebra.of_id_apply];
    rw [← of_monoid_add, add_neg_self]; refl) }
set_option class.instance_max_depth 32

instance int.add_comm_group : add_comm_group ℤ :=
ring.to_add_comm_group ℤ

def GL₁ⁿ (n : ℕ) : algebra R (monoid_ring R (fin n → ℤ)) :=
monoid_ring.algebra _ _

instance GL₁ⁿ.cogroup (n : ℕ) : cogroup (GL₁ⁿ R n) :=
group_ring.cogroup _ _

def GL₁ : algebra R (monoid_ring R ℤ) :=
monoid_ring.algebra _ _

instance GL₁.cogroup : cogroup (GL₁ R) :=
group_ring.cogroup _ _

variables {R}
class is_cogroup_hom [cogroup iA] [cogroup iB] (f : iA →ₐ iB) : Prop :=
(comul : (cogroup.comul iB).comp f = (amap f f).comp (cogroup.comul iA))

section is_cogroup_hom

--   f(1)
-- = f(1) * 1
-- = f(1) * (f(1) * f(1)⁻¹)
-- = (f(1) * f(1)) * f(1)⁻¹
-- = f(1 * 1) * f(1)⁻¹
-- = f(1) * f(1)⁻¹
-- = 1
/-theorem is_cogroup_hom.coone [cogroup iA] [cogroup iB]
  (f : @alg_hom R A B _ _ _ _ _) [is_cogroup_hom R A B f] :
  (cogroup.coone R B).comp f = cogroup.coone R A :=
have _ := cogroup.comul_coone R A,
calc  (cogroup.coone R B).comp f
    = ((cogroup.coone R B).comp f).comp ((alg_hom.tensor_ring _ _).comp
    ((tensor_a.map (alg_hom.id A) (cogroup.coone R A)).comp (cogroup.comul R A))) : by rw [cogroup.comul_coone R A]; simp
... = _ : _
... = _ : _-/

end is_cogroup_hom

def cogroup_hom [cogroup iA] [cogroup iB] :=
subtype (is_cogroup_hom iA iB)

def GL₁.alg_hom : units iA.mod ≃ alg_hom (GL₁ R) iA :=
equiv.trans (show units A ≃ add_monoid_monoid_hom ℤ A, from
{ to_fun := λ u, ⟨λ n, ((u^n:units A):A),
    λ _ _, by simp [gpow_add], by simp⟩,
  inv_fun := λ f, ⟨f.1 1, f.1 (-1),
    by rw [← f.2.1, add_neg_self, f.2.2],
    by rw [← f.2.1, neg_add_self, f.2.2]⟩,
  left_inv := λ u, units.ext $ by simp; refl,
  right_inv := λ f, subtype.eq $ funext $ λ n,
    by apply int.induction_on n; intros;
      simp at *; simp [f.2.2, f.2.1, gpow_add, *]; refl})
(monoid_ring.UMP _ _ _)

-- needs more lemmas about tensoring
instance cogroup.base_change_left [cogroup iB] :
  cogroup (base_change_left iA iB) := sorry

structure cogroup_iso [cogroup iA] [cogroup iB] :=
(to_fun : iA →ₐ iB)
(inv_fun : iB →ₐ iA)
(left_inverse : ∀ x, inv_fun (to_fun x) = x)
(right_inverse : ∀ x, to_fun (inv_fun x) = x)
[hom : is_cogroup_hom iA iB to_fun]

def torus.is_split {F : Type u} [discrete_field F]
  {TR : Type v} [comm_ring TR] (T : algebra F TR) [cogroup T]
  (E : finite_Galois_extension F)
  (rank : ℕ) :=
cogroup_iso (GL₁ⁿ E.S rank) (base_change_left E.S.algebra T)

structure torus {F : Type u} [discrete_field F]
  {TR : Type v} [comm_ring TR] (T : algebra F TR) [cogroup T] :=
(top : finite_Galois_extension F)
(rank : ℕ)
(splits : torus.is_split T top rank)

variables {F : Type u} [discrete_field F]
variables {TR : Type v} [comm_ring TR] {T : algebra F TR} [cogroup T]
variables (ht : torus T)
include ht

def torus.base_change : algebra ht.top.S (ht.top.S.algebra.mod ⊗ T.mod) :=
base_change_left ht.top.S.algebra T

instance torus.base_change.cogroup : cogroup ht.base_change :=
cogroup.base_change_left _ _

def torus.char : Type (max u v) :=
cogroup_hom (GL₁ ht.top.S) ht.base_change

def torus.cochar : Type (max u v) :=
cogroup_hom ht.base_change (GL₁ ht.top.S)

instance torus.char.add_comm_group : add_comm_group ht.char := sorry
instance torus.cochar.add_comm_group : add_comm_group ht.cochar := sorry

def torus.rat_pt : Type (max u v) :=
T →ₐ algebra.id F

instance torus.rat_pt.topological_space : topological_space ht.rat_pt := sorry
instance torus.rat_pt.group : group ht.rat_pt := sorry
instance torus.rat_pt.topological_group : topological_group ht.rat_pt := sorry

def torus.hat : Type (max u v) :=
add_monoid_monoid_hom ht.cochar (units ℂ)

def torus.hat_to_fun : ht.hat → (ht.cochar → units ℂ) :=
subtype.val

instance torus.hat.comm_group : comm_group ht.hat :=
@subtype.comm_group (ht.cochar → units ℂ)
(@pi.comm_group _ _ $ λ _, units.comm_group)
is_add_monoid_monoid_hom
{ mul_mem := λ f g hf hg,
    ⟨λ x y, show f (x + y) * g (x + y) = (f x * g x) * (f y * g y),
      by rw [hf.1, hg.1, mul_assoc, mul_assoc, mul_left_comm (f y)],
    show f 0 * g 0 = 1, by rw [hf.2, hg.2, mul_one]⟩,
  one_mem := ⟨λ _ _, (mul_one _).symm, rfl⟩,
  inv_mem := λ f hf,
    ⟨λ x y, show (f (x + y))⁻¹ = (f x)⁻¹ * (f y)⁻¹,
      by rw [hf.1, mul_inv],
    show (f 0)⁻¹ = 1, by rw [hf.2, one_inv]⟩ }

instance torus.hat.topological_space : topological_space ht.hat :=
topological_space.induced subtype.val Pi.topological_space

instance torus.hat.is_group_hom_hat_to_fun : is_group_hom ht.hat_to_fun := ⟨λ _ _, rfl⟩

instance torus.hat.topological_group {F : Type u} [discrete_field F]
  {TR : Type v} [comm_ring TR] {T : algebra F TR} [cogroup T]
  (ht : torus T) : topological_group ht.hat :=
@@topological_group.induced _ _ _ _ _ _ ht.hat_to_fun _

instance torus.hat.topological_add_group_additive {F : Type u} [discrete_field F]
  {TR : Type v} [comm_ring TR] {T : algebra F TR} [cogroup T]
  (ht : torus T) : topological_add_group (additive ht.hat) :=
additive.topological_add_group

instance torus.hat.topological_space_additive {F : Type u} [discrete_field F]
  {TR : Type v} [comm_ring TR] {T : algebra F TR} [cogroup T]
  (ht : torus T) : topological_space (additive ht.hat) :=
additive.topological_space