import analysis.inner_product_space.pi_L2
import topology.paracompact

--OUTPUT 1
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  -- Let $\mathcal{A}$ be an open covering of $\mathbb{R}^n$.
  assume (A : set (euclidean_space ℝ (fin n))) (hA : is_open_cover A),
  -- We now construct a locally finite open refinement $\mathcal{C}$ of $\mathcal{A}$ that covers $\mathbb{R}^n$.
  have h1 : ∃ (C : set (euclidean_space ℝ (fin n))) (hC : is_open_cover C) (hC1 : is_locally_finite_cover C),
    ∀ (x : euclidean_space ℝ (fin n)), ∃ (U : set (euclidean_space ℝ (fin n))) (hU : is_open U),
    x ∈ U ∧ ∃ (V : set (euclidean_space ℝ (fin n))) (hV : is_open V), x ∈ V ∧ V ⊆ U ∧ ∀ (y : euclidean_space ℝ (fin n)), y ∈ V → ∃ (B : set (euclidean_space ℝ (fin n))) (hB : is_open B) (hB1 : is_ball B), y ∈ B ∧ B ⊆ U ∧ ∀ (z : euclidean_space ℝ (fin n)), z ∈ B → z = y, from by {
      -- 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.
      have h1 : ∀ (m : ℕ), ∃ (Bm : set (euclidean_space ℝ (fin n))) (hBm : is_open Bm) (hBm1 : is_ball Bm),
        (0 : euclidean_space ℝ (fin n)) ∈ Bm ∧ ∀ (x : euclidean_space ℝ (fin n)), x ∈ Bm → ∃ (r : ℝ) (hr : r > 0), ∀ (y : euclidean_space ℝ (fin n)), y ∈ Bm → ∀ (i : fin n), abs (y.val i - x.val i) < r, from by {
        assume (m : ℕ),
        use (ball (0 : euclidean_space ℝ (fin n)) m),
        obviously,
        obviously,
        obviously,
        obviously,
      },
      -- 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}$).
      have h2 : ∀ (m : ℕ), ∃ (Cm : set (euclidean_space ℝ (fin n))) (hCm : is_open_cover Cm) (hCm1 : is_locally_finite_cover Cm),
        ∀ (x : euclidean_space ℝ (fin n)), ∃ (U : set (euclidean_space ℝ (fin n))) (hU : is_open U),
        x ∈ U ∧ ∃ (V : set (euclidean_space ℝ (fin n))) (hV : is_open V), x ∈ V ∧ V ⊆ U ∧ ∀ (y : euclidean_space ℝ (fin n)), y ∈ V → ∃ (B : set (euclidean_space ℝ (fin n))) (hB : is_open B) (hB1 : is_ball B), y ∈ B ∧ B ⊆ U ∧ ∀ (z : euclidean_space ℝ (fin n)), z ∈ B → z = y, from by {
        assume (m : ℕ),
        have h2 : ∃ (Cm : set (euclidean_space ℝ (fin n))) (hCm : is_open_cover Cm),
          ∀ (x : euclidean_space ℝ (fin n)), ∃ (U : set (euclidean_space ℝ (fin n))) (hU : is_open U),
          x ∈ U ∧ ∃ (V : set (euclidean_space ℝ (fin n))) (hV : is_open V), x ∈ V ∧ V ⊆ U ∧ ∀ (y : euclidean_space ℝ (fin n)), y ∈ V → ∃ (B : set (euclidean_space ℝ (fin n))) (hB : is_open B) (hB1 : is_ball B), y ∈ B ∧ B ⊆ U ∧ ∀ (z : euclidean_space ℝ (fin n)), z ∈ B → z = y, from by {
          have h2 : ∃ (Cm : set (euclidean_space ℝ (fin n))) (hCm : is_open_cover Cm),
            ∀ (x : euclidean_space ℝ (fin n)), ∃ (U : set (euclidean_space ℝ (fin n))) (hU : is_open U),
            x ∈ U ∧ ∃ (V : set (euclidean_space ℝ (fin n))) (hV : is_open V), x ∈ V ∧ V ⊆ U ∧ ∀ (y : euclidean_space ℝ (fin n)), y ∈ V → ∃ (B : set (euclidean_space ℝ (fin n))) (hB : is_open B) (hB1 : is_ball B), y ∈ B ∧ B ⊆ U ∧ ∀ (z : euclidean_space ℝ (fin n)), z ∈ B → z = y, from by {
            have h2 : ∃ (Cm : set (euclidean_space ℝ (fin n))) (hCm : is_open_cover Cm),
              ∀ (x : euclidean_space ℝ (fin n)), ∃ (U : set (euclidean_space ℝ (fin n))) (hU : is_open U),
              x ∈ U ∧ ∃ (V : set (euclidean_space ℝ (fin n))) (hV : is_open V), x ∈ V ∧ V ⊆ U ∧ ∀ (y : euclidean_space ℝ (fin n)), y ∈ V → ∃ (B : set (euclidean_space ℝ (fin n))) (hB : is_open B) (hB1 : is_ball B), y ∈ B ∧ B ⊆ U ∧ ∀ (z : euclidean_space ℝ (fin n)), z ∈ B → z = y, from by {
              have h2 : ∃ (Cm : set (euclidean_space ℝ (fin n))) (hCm : is_open_cover Cm),
                ∀ (x : euclidean_space ℝ (fin n)), ∃ (U : set (euclidean_space ℝ (fin n))) (hU : is_open U),
                x ∈ U ∧ ∃ (V : set (euclidean_space ℝ (fin n))) (hV : is_open V), x ∈ V ∧ V ⊆ U ∧ ∀ (y : euclidean_space ℝ (fin n)), y ∈ V → ∃ (B : set (euclidean_space ℝ (fin n))) (hB : is_open B) (hB1 : is_ball B), y ∈ B ∧ B ⊆ U ∧ ∀ (z : euclidean_space
end --Needs more than 2000 tokens!

--OUTPUT 2
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  -- Let $\mathcal{A}$ be an open covering of $\mathbb{R}^n$.
  assume (A : set (euclidean_space ℝ (fin n))),
  assume hA : is_open_cover A,

  -- We now construct a locally finite open refinement $\mathcal{C}$ of $\mathcal{A}$ that covers $\mathbb{R}^n$.
  have h1 : ∃ C : set (euclidean_space ℝ (fin n)), is_open_cover C ∧ locally_finite C ∧ (⋃₀ C = ⋃₀ A), from by {
    -- 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.
    let B0 : set (euclidean_space ℝ (fin n)) := ∅,
    have h2 : ∀ m : ℕ, ∃ Bm : set (euclidean_space ℝ (fin n)), ∀ x : euclidean_space ℝ (fin n), x ∈ Bm ↔ ∀ i : fin n, abs (x i) < m, from by {
      assume m : ℕ,
      have h3 : ∃ Bm : set (euclidean_space ℝ (fin n)), ∀ x : euclidean_space ℝ (fin n), x ∈ Bm ↔ ∀ i : fin n, abs (x i) < m, from by {
        use {x : euclidean_space ℝ (fin n) | ∀ i : fin n, abs (x i) < m},
        obviously,
      },
      show ∃ Bm : set (euclidean_space ℝ (fin n)), ∀ x : euclidean_space ℝ (fin n), x ∈ Bm ↔ ∀ i : fin n, abs (x i) < m, from h3,
    },
    let Bm : ℕ → set (euclidean_space ℝ (fin n)) := λ m, classical.some (h2 m).exists,
    have h4 : ∀ m : ℕ, ∀ x : euclidean_space ℝ (fin n), x ∈ Bm ↔ ∀ i : fin n, abs (x i) < m, from by {
      assume m : ℕ,
      show ∀ x : euclidean_space ℝ (fin n), x ∈ Bm ↔ ∀ i : fin n, abs (x i) < m, from by {
        assume x : euclidean_space ℝ (fin n),
        show x ∈ Bm ↔ ∀ i : fin n, abs (x i) < m, from by {
          apply exists_unique.unique (h2 m),
          show x ∈ classical.some (h2 m).exists ↔ ∀ i : fin n, abs (x i) < m, from
            classical.some_spec (exists_unique.exists (h2 m)),
        },
      },
    },

    -- 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}$).
    have h5 : ∀ m : ℕ, is_compact (closure (Bm m)), from by {
      assume m : ℕ,
      show is_compact (closure (Bm m)), from by {
        apply compact_iff_compact_univ.mp,
        show is_compact (closure (Bm m) ∩ univ), from by {
          apply compact_iff_compact_univ.mpr,
          show is_compact (closure (Bm m)), from by {
            apply compact_iff_compact_univ.mp,
            show is_compact (closure (Bm m) ∩ univ), from by {
              apply compact_iff_compact_univ.mpr,
              show is_compact (closure (Bm m)), from by {
                apply compact_iff_compact_univ.mp,
                show is_compact (closure (Bm m) ∩ univ), from by {
                  apply compact_iff_compact_univ.mpr,
                  show is_compact (closure (Bm m)), from by {
                    apply compact_iff_compact_univ.mp,
                    show is_compact (closure (Bm m) ∩ univ), from by {
                      apply compact_iff_compact_univ.mpr,
                      show is_compact (closure (Bm m)), from by {
                        apply compact_iff_compact_univ.mp,
                        show is_compact (closure (Bm m) ∩ univ), from by {
                          apply compact_iff_compact_univ.mpr,
                          show is_compact (closure (Bm m)), from by {
                            apply compact_iff_compact_univ.mp,
                            show is_compact (closure (Bm m) ∩ univ), from by {
                              apply compact_iff_compact_univ.mpr,
                              show is_compact (closure (Bm m)), from by {
                                apply compact_iff_compact_univ.mp,
                                show is_compact (closure (Bm m) ∩ univ), from by {
                                  apply compact_iff_compact_univ.mpr,
                                  show is_compact (closure (Bm m)), from by {
                                    apply compact_iff_compact_univ.mp,
                                    show is_compact (closure (Bm m) ∩ univ), from by {
                                      apply compact_iff_compact_univ.mpr,
                                      show is_compact (closure (Bm m)), from by {
                                        apply compact_iff_compact_univ.mp,
                                        show is_compact (closure (Bm m) ∩ univ), from by {
                                          apply compact_iff_compact_univ.mpr,
                                          show is_compact (closure (Bm m)), from by {
                                            apply compact_iff_compact_univ.mp,
                                            show is_compact (closure (Bm m) ∩ univ), from by {
                                              apply compact_iff_compact_univ.mpr,
                                              show is_compact (closure (Bm m)), from by {
                                                apply compact_iff_compact_univ.mp,
                                                show is_compact (closure (Bm m) ∩ univ), from by {
                                                  apply compact_iff_compact_univ.mpr,
                                                  show is_compact (closure (Bm m)), from by {
                                                    apply compact_iff_compact_univ.mp,
                                                    show is_compact (closure (Bm m) ∩ univ), from by {
                                                      apply compact_iff_compact_univ.mpr,
                                                      show is_compact (closure (Bm m)), from by {
                                                        apply compact_iff_compact_univ.mp,
                                                        show is_compact (closure (Bm m) ∩ univ), from by {
                                                          apply compact_iff_compact_univ.mpr,
                                                          show is_compact (closure (Bm m)), from by {
                                                            apply compact_iff_compact_univ.mp,
                                                            show is_compact (closure (Bm m) ∩ univ), from by {
                                                              apply compact_iff_compact_univ.mpr,
                                                              show is_compact (closure (Bm m
end --Needs more than 2000 tokens!

--OUTPUT 3
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  -- Let $\mathcal{A}$ be an open covering of $\mathbb{R}^n$.
  assume (A : set (euclidean_space ℝ (fin n))) (hA : is_open_cover A),
  -- We now construct a locally finite open refinement $\mathcal{C}$ of $\mathcal{A}$ that covers $\mathbb{R}^n$.
  have h1 : ∃ (C : set (euclidean_space ℝ (fin n))) (hC : is_open_cover C) (hC1 : is_locally_finite C),
    ∀ (x : euclidean_space ℝ (fin n)), x ∈ C, from by {
    -- 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.
    have hB : ∀ (m : ℕ), (m : ℝ) ∈ {x : ℝ | x > 0} := by {
      assume (m : ℕ),
      have hB1 : (m : ℝ) > 0, from by {
        rw ← nat.cast_zero,
        apply nat.cast_lt.mpr,
        rw ← nat.zero_lt_succ,
        apply nat.succ_pos,
      },
      show (m : ℝ) ∈ {x : ℝ | x > 0}, from by {
        apply set.mem_set_of_eq,
        exact hB1,
      },
    },
    have hB1 : ∀ (m : ℕ), ∃ (Bm : set (euclidean_space ℝ (fin n))), is_open Bm ∧ is_bounded Bm ∧ ball 0 (m : ℝ) ⊆ Bm, from by {
      assume (m : ℕ),
      have hB2 : (m : ℝ) ∈ {x : ℝ | x > 0}, from hB m,
      have hB3 : ∃ (Bm : set (euclidean_space ℝ (fin n))), is_open Bm ∧ is_bounded Bm ∧ ball 0 (m : ℝ) ⊆ Bm, from by {
        apply euclidean_space.is_open_ball_iff.mp,
        rw set.mem_set_of_eq,
        exact hB2,
      },
      show ∃ (Bm : set (euclidean_space ℝ (fin n))), is_open Bm ∧ is_bounded Bm ∧ ball 0 (m : ℝ) ⊆ Bm, from by {
        apply hB3,
      },
    },
    have hB2 : ∀ (m : ℕ), ∃ (Bm : set (euclidean_space ℝ (fin n))), is_open Bm ∧ is_bounded Bm ∧ ball 0 (m : ℝ) ⊆ Bm, from by {
      assume (m : ℕ),
      have hB3 : ∃ (Bm : set (euclidean_space ℝ (fin n))), is_open Bm ∧ is_bounded Bm ∧ ball 0 (m : ℝ) ⊆ Bm, from hB1 m,
      show ∃ (Bm : set (euclidean_space ℝ (fin n))), is_open Bm ∧ is_bounded Bm ∧ ball 0 (m : ℝ) ⊆ Bm, from by {
        apply hB3,
      },
    },
    have hB3 : ∀ (m : ℕ), ∃ (Bm : set (euclidean_space ℝ (fin n))), is_open Bm ∧ is_bounded Bm ∧ ball 0 (m : ℝ) ⊆ Bm, from by {
      assume (m : ℕ),
      have hB4 : ∃ (Bm : set (euclidean_space ℝ (fin n))), is_open Bm ∧ is_bounded Bm ∧ ball 0 (m : ℝ) ⊆ Bm, from hB2 m,
      show ∃ (Bm : set (euclidean_space ℝ (fin n))), is_open Bm ∧ is_bounded Bm ∧ ball 0 (m : ℝ) ⊆ Bm, from by {
        apply hB4,
      },
    },
    have hB4 : ∀ (m : ℕ), ∃ (Bm : set (euclidean_space ℝ (fin n))), is_open Bm ∧ is_bounded Bm ∧ ball 0 (m : ℝ) ⊆ Bm, from by {
      assume (m : ℕ),
      have hB5 : ∃ (Bm : set (euclidean_space ℝ (fin n))), is_open Bm ∧ is_bounded Bm ∧ ball 0 (m : ℝ) ⊆ Bm, from hB3 m,
      show ∃ (Bm : set (euclidean_space ℝ (fin n))), is_open Bm ∧ is_bounded Bm ∧ ball 0 (m : ℝ) ⊆ Bm, from by {
        apply hB5,
      },
    },
    have hB5 : ∀ (m : ℕ), ∃ (Bm : set (euclidean_space ℝ (fin n))), is_open Bm ∧ is_bounded Bm ∧ ball 0 (m : ℝ) ⊆ Bm, from by {
      assume (m : ℕ),
      have hB6 : ∃ (Bm : set (euclidean_space ℝ (fin n))), is_open Bm ∧ is_bounded Bm ∧ ball 0 (m : ℝ) ⊆ Bm, from hB4 m,
      show ∃ (Bm : set (euclidean_space ℝ (fin n))), is_open Bm ∧ is_bounded Bm ∧ ball 0 (m : ℝ) ⊆ Bm, from by {
        apply hB6,
      },
    },
    have hB6 : ∀ (m : ℕ), ∃ (Bm : set (euclidean_space ℝ (fin n))), is_open Bm ∧ is_bounded Bm ∧ ball 0 (m : ℝ) ⊆ Bm, from by {
      assume (m : ℕ),
      have hB7 : ∃ (Bm : set (euclidean_space ℝ (fin n))), is_open Bm ∧ is_bounded Bm ∧ ball 0 (m : ℝ) ⊆ Bm, from hB5 m,
      show ∃ (Bm : set (euclidean_space ℝ (fin n))), is_open Bm ∧ is_bounded Bm ∧ ball 0 (m : ℝ) ⊆ Bm, from by {
        apply hB7,
      },
    },
    have hB7 : ∀ (m : ℕ), ∃ (Bm : set (euclidean_space ℝ (fin n))), is_open Bm ∧ is_bounded Bm ∧ ball 0 (m : ℝ) ⊆ Bm, from by {
      assume (m : ℕ),
      have hB8 : ∃ (Bm : set (euclidean_space ℝ (fin n))), is_open Bm ∧ is_bounded Bm ∧ ball 0 (m : ℝ) ⊆ Bm, from hB6 m,
      show ∃ (Bm : set (euclidean_space ℝ (fin n))), is_open Bm ∧ is_bounded Bm ∧ ball 0 (m : ℝ) ⊆ Bm, from by {
        apply hB8,
      },
    },
    have h
end --Needs more than 2000 tokens!

--OUTPUT 4
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  -- Let $\mathcal{A}$ be an open covering of $\mathbb{R}^n$.
  assume A : set (euclidean_space ℝ (fin n)),
  assume hA : is_open_cover A,
  -- We now construct a locally finite open refinement $\mathcal{C}$ of $\mathcal{A}$ that covers $\mathbb{R}^n$.
  let C : set (euclidean_space ℝ (fin 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.
    m : ℕ | ∃ (U : set (euclidean_space ℝ (fin n))), U ∈ A ∧
    (set.inter U (set.compl (set.closure (ball (0 : euclidean_space ℝ (fin n)) m)))).nonempty
    },
  let C_m : set (euclidean_space ℝ (fin n)) := {
    -- 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.
    U : set (euclidean_space ℝ (fin n)) | ∃ (U' : set (euclidean_space ℝ (fin n))), U' ∈ A ∧
    (set.inter U' (set.compl (set.closure (ball (0 : euclidean_space ℝ (fin n)) m)))).nonempty ∧
    (set.inter U' (set.compl (set.closure (ball (0 : euclidean_space ℝ (fin n)) (m-1))))).nonempty ∧
    U = set.inter U' (set.compl (set.closure (ball (0 : euclidean_space ℝ (fin n)) (m-1)))),
    },
  let C_m_finite : set (euclidean_space ℝ (fin n)) := {
    -- 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.
    U : set (euclidean_space ℝ (fin n)) | ∃ (U' : set (euclidean_space ℝ (fin n))), U' ∈ A ∧
    (set.inter U' (set.compl (set.closure (ball (0 : euclidean_space ℝ (fin n)) m)))).nonempty ∧
    (set.inter U' (set.compl (set.closure (ball (0 : euclidean_space ℝ (fin n)) (m-1))))).nonempty ∧
    U = set.inter U' (set.compl (set.closure (ball (0 : euclidean_space ℝ (fin n)) (m-1)))),
    },
  have h1 : C = (⋃ (m : ℕ), C_m), from by {
    apply set.ext,
    assume x : euclidean_space ℝ (fin
end --Needs more than 2000 tokens!

--OUTPUT 5
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  -- Let $\mathcal{A}$ be an open covering of $\mathbb{R}^n$.
  assume (A : set (euclidean_space ℝ (fin n))) (hA : is_open_cover A),
  -- We now construct a locally finite open refinement $\mathcal{C}$ of $\mathcal{A}$ that covers $\mathbb{R}^n$.
  let C := {c : set (euclidean_space ℝ (fin n)) | ∃ a ∈ A, c = a ∩ (euclidean_space ℝ (fin n))},
  have hC : is_open_refinement C A, from by {
    -- First, we define a collection of pen balls.
    let B : ℕ → set (euclidean_space ℝ (fin n)) := λ (m : ℕ), {x : euclidean_space ℝ (fin n) | ∃ (y : euclidean_space ℝ (fin n)), x ∈ y ∧ y ∈ A ∧ ∥ y ∥ ≤ m},
    have h1 : ∀ (m : ℕ), ∃ (y : euclidean_space ℝ (fin n)), (0 : euclidean_space ℝ (fin n)) ∈ y ∧ y ∈ A ∧ ∥ y ∥ ≤ m, from by {
      assume (m : ℕ),
      have h2 : ∃ (y : euclidean_space ℝ (fin n)), (0 : euclidean_space ℝ (fin n)) ∈ y ∧ y ∈ A, from by {
        have h3 : ∃ (y : euclidean_space ℝ (fin n)), (0 : euclidean_space ℝ (fin n)) ∈ y, from by {
          use (0 : euclidean_space ℝ (fin n)),
          obviously,
        },
        show ∃ (y : euclidean_space ℝ (fin n)), (0 : euclidean_space ℝ (fin n)) ∈ y ∧ y ∈ A, from by {
          rcases h3 with ⟨y, hy⟩,
          have h4 : ∃ (a : euclidean_space ℝ (fin n)), (0 : euclidean_space ℝ (fin n)) ∈ a ∧ a ∈ A, from by {
            use y,
            obviously,
          },
          show ∃ (y : euclidean_space ℝ (fin n)), (0 : euclidean_space ℝ (fin n)) ∈ y ∧ y ∈ A, from by {
            rcases h4 with ⟨y, hy⟩,
            use y,
            obviously,
          },
        },
      },
      rcases h2 with ⟨y, hy⟩,
      have h3 : ∃ (m : ℕ), ∥ y ∥ ≤ m, from by {
        have h4 : ∃ (m : ℕ), ∥ y ∥ < m + 1, from by {
          have h5 : ∃ (m : ℕ), ∥ y ∥ < m + 1, from by {
            have h6 : ∃ (m : ℕ), ∥ y ∥ < m + 1, from by {
              have h7 : ∃ (m : ℕ), ∥ y ∥ < m + 1, from by {
                have h8 : ∃ (m : ℕ), ∥ y ∥ < m + 1, from by {
                  have h9 : ∃ (m : ℕ), ∥ y ∥ < m + 1, from by {
                    have h10 : ∃ (m : ℕ), ∥ y ∥ < m + 1, from by {
                      have h11 : ∃ (m : ℕ), ∥ y ∥ < m + 1, from by {
                        have h12 : ∃ (m : ℕ), ∥ y ∥ < m + 1, from by {
                          have h13 : ∃ (m : ℕ), ∥ y ∥ < m + 1, from by {
                            have h14 : ∃ (m : ℕ), ∥ y ∥ < m + 1, from by {
                              have h15 : ∃ (m : ℕ), ∥ y ∥ < m + 1, from by {
                                have h16 : ∃ (m : ℕ), ∥ y ∥ < m + 1, from by {
                                  have h17 : ∃ (m : ℕ), ∥ y ∥ < m + 1, from by {
                                    have h18 : ∃ (m : ℕ), ∥ y ∥ < m + 1, from by {
                                      have h19 : ∃ (m : ℕ), ∥ y ∥ < m + 1, from by {
                                        have h20 : ∃ (m : ℕ), ∥ y ∥ < m + 1, from by {
                                          have h21 : ∃ (m : ℕ), ∥ y ∥ < m + 1, from by {
                                            have h22 : ∃ (m : ℕ), ∥ y ∥ < m + 1, from by {
                                              have h23 : ∃ (m : ℕ), ∥ y ∥ < m + 1, from by {
                                                have h24 : ∃ (m : ℕ), ∥ y ∥ < m + 1, from by {
                                                  have h25 : ∃ (m : ℕ), ∥ y ∥ < m + 1, from by {
                                                    have h26 : ∃ (m : ℕ), ∥ y ∥ < m + 1, from by {
                                                      have h27 : ∃ (m : ℕ), ∥ y ∥ < m + 1, from by {
                                                        have h28 : ∃ (m : ℕ), ∥ y ∥ < m + 1, from by {
                                                          have h29 : ∃ (m : ℕ), ∥ y ∥ < m + 1, from by {
                                                            have h30 : ∃ (m : ℕ), ∥ y ∥ < m + 1, from by {
                                                              have h31 : ∃ (m : ℕ), ∥ y ∥ < m + 1, from by {
                                                                have h32 : ∃ (m : ℕ), ∥ y ∥ < m + 1, from by {
                                                                  have h33 : ∃ (m : ℕ), ∥ y ∥ < m + 1, from by {
                                                                    have h34 : ∃ (m : ℕ), ∥ y ∥ < m + 1, from by {
                                                                      have h35 : ∃ (m : ℕ), ∥ y ∥ < m + 1, from by {
                                                                        have h36 : ∃ (m : ℕ), ∥ y ∥ < m + 1, from by {
                                                                          have h37 : ∃ (m : ℕ), ∥ y ∥ < m + 1, from by {
                                                                            have h38 : ∃ (m : ℕ), ∥ y ∥ < m + 1, from by {
                                                                              have h39 : ∃ (m : ℕ), ∥ y ∥ < m + 1, from by {
                                                                                have h40 : ∃ (m : ℕ), ∥ y ∥ < m + 1, from by {
                                                                                have h41 : ∃ (m : ℕ), ∥ y ∥ < m + 1, from by {
                                                                                have h42 : ∃ (m : ℕ), ∥ y ∥ < m + 1, from by {
                                                                                have h43 : ∃ (m : ℕ), ∥ y ∥ < m + 1, from by {
                                                                                have h44 : ∃ (m : ℕ), ∥ y ∥ < m + 1, from by {
                                                                                have h45 : ∃ (m : ℕ), ∥ y ∥ < m + 1, from by {

end --Needs more than 2000 tokens!

--OUTPUT 6
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  -- Let $\mathcal{A}$ be an open covering of $\mathbb{R}^n$.
  assume (A : set (set (euclidean_space ℝ (fin n)))) (hA : is_open_cover A),
  -- We now construct a locally finite open refinement $\mathcal{C}$ of $\mathcal{A}$ that covers $\mathbb{R}^n$.
  let C := {C ∈ A | ∀ x : euclidean_space ℝ (fin n), ∃ m : ℕ, x ∈ ⋃ i in finset.range (m+1), C i},
  have h1 : C ⊆ A, from by {
    assume (C : set (euclidean_space ℝ (fin n))) (hC : C ∈ C),
    show C ∈ A, from by {
      have h1 : C ∈ A, from by {
        have h1 : C ∈ A, from by {
          have h1 : C ∈ A, from by {
            have h1 : C ∈ A, from by {
              have h1 : C ∈ A, from by {
                have h1 : C ∈ A, from by {
                  have h1 : C ∈ A, from by {
                    have h1 : C ∈ A, from by {
                      have h1 : C ∈ A, from by {
                        have h1 : C ∈ A, from by {
                          have h1 : C ∈ A, from by {
                            have h1 : C ∈ A, from by {
                              have h1 : C ∈ A, from by {
                                have h1 : C ∈ A, from by {
                                  have h1 : C ∈ A, from by {
                                    have h1 : C ∈ A, from by {
                                      have h1 : C ∈ A, from by {
                                        have h1 : C ∈ A, from by {
                                          have h1 : C ∈ A, from by {
                                            have h1 : C ∈ A, from by {
                                              have h1 : C ∈ A, from by {
                                                have h1 : C ∈ A, from by {
                                                  have h1 : C ∈ A, from by {
                                                    have h1 : C ∈ A, from by {
                                                      have h1 : C ∈ A, from by {
                                                        have h1 : C ∈ A, from by {
                                                          have h1 : C ∈ A, from by {
                                                            have h1 : C ∈ A, from by {
                                                              have h1 : C ∈ A, from by {
                                                                have h1 : C ∈ A, from by {
                                                                  have h1 : C ∈ A, from by {
                                                                    have h1 : C ∈ A, from by {
                                                                      have h1 : C ∈ A, from by {
                                                                        have h1 : C ∈ A, from by {
                                                                          have h1 : C ∈ A, from by {
                                                                            have h1 : C ∈ A, from by {
                                                                              have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {
                                                                                have h1 : C ∈ A, from by {

end --Needs more than 2000 tokens!

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

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

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

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

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

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

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

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

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

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

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

Setting $b = a$, this becomes:

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

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

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

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

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

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (hident : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a).exists, from assume (a : G),
        exists_unique.unique (h3 a) (hident a).right
        (classical.some_spec (exists_unique.exists (h3 a))),
      have h9 : ∀ a : G, e = classical.some (h4 a).exists, from assume (a : G),
        exists_unique.unique (h4 a) (hident a).left
        (classical.some_spec (exists_unique.exists (h4 a))),
      show e = (1 : G), from eq.trans (h9 e) (h6 _),
    },
    exact ⟨by obviously, h7⟩,
  }
end

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

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


import Table.BuiltinExtensions

universe u_η
universe u

def Header {η} := (η × Type u)
def Schema {η} := List (@Header η)

-- Schema column predicates
inductive Schema.HasCol {η : Type u_η} :
  @Header η → @Schema η → Type (max (u + 1) u_η)
| hd {c : η} {τ : Type u} {rs : Schema} : HasCol (c, τ) ((c, τ) :: rs)
| tl {r c τ rs} : HasCol (c, τ) rs → HasCol (c, τ) (r::rs)

inductive Schema.HasName {η : Type u_η} : η → @Schema η → Type (max (u + 1) u_η)
| hd {c : η} {rs : Schema} {τ : Type u} : HasName c ((c, τ) :: rs)
| tl {r c rs} : HasName c rs → HasName c (r::rs)

-- Schema-related convenience types
def Subschema {η : Type u_η} (schm : @Schema η) :=
  List ((h : Header) × schm.HasCol (h.fst, h.snd))

def EqSubschema {η : Type u_η} (schm : @Schema η) :=
  List ((h : Header) × schm.HasCol (h.fst, h.snd) × DecidableEq h.2)

def CertifiedName (schema : @Schema η) := ((c : η) × Schema.HasName c schema)
def CertifiedHeader (schema : @Schema η) :=
  ((h : Header) × Schema.HasCol h schema)

-- Action lists
/-
Action lists represent a collection of items to apply to a schema with a
guarantee that the validity of each proof of containment is preserved after each
action item is applied. It generalizes the following instances:
  inductive SchemaRemoveList {η : Type u_η} [DecidableEq η] :
    @Schema.{u_η, u} η → Type (max u_η (u + 1))
  | nil {schema} : SchemaRemoveList schema
  | cons {schema} : (cn : CertifiedName schema) →
                    SchemaRemoveList (schema.removeName cn.2) →
                    SchemaRemoveList schema

  inductive SchemaFlattenList {η : Type u_η} [DecidableEq η] :
    @Schema η → Type _
  | nil {schema} : SchemaFlattenList schema
  | cons {schema} : (cn : ((c : η) × (τ: Type u) × schema.HasCol (c, List τ))) →
                    SchemaFlattenList (schema.flattenList cn) →
                    SchemaFlattenList schema

  inductive SchemaRenameList {η : Type u_η} [DecidableEq η] :
    @Schema η → Type _
  | nil {schema} : SchemaRenameList schema
  | cons {schema} : (cnc : (CertifiedName schema × η))→
                    SchemaRenameList (schema.renameColumn cnc.1.2 cnc.2) →
                    SchemaRenameList schema
-/
inductive ActionList {η : Type u_η} [DecidableEq η]
                     {κ : @Schema η → Type u}
                     (f : ∀ (s : @Schema η), κ s → @Schema η)
    : @Schema η → Type _
| nil {schema}  : ActionList f schema
| cons {schema} : (entry : κ schema) →
                  ActionList f (f schema entry) →
                  ActionList f schema

inductive BiActionList {η : Type u_η} [DecidableEq η]
                       {κ : @Schema η × @Schema η → Type u}
  (f : ∀ (ss : @Schema η × @Schema η), κ ss → @Schema η × @Schema η)
    : @Schema η × @Schema η → Type _
| nil {s₁ s₂}  : BiActionList f (s₁, s₂)
| cons {s₁ s₂} : (entry : κ (s₁, s₂)) →
                  BiActionList f (f (s₁, s₂) entry) →
                  BiActionList f (s₁, s₂)

variable {η : Type u_η} [dec_η : DecidableEq η] {schema : @Schema η}

-- For ease of refactoring, makes these products act like subtypes
def CertifiedName.val (n : CertifiedName schema) := Sigma.fst n
def CertifiedName.property (n : CertifiedName schema) := Sigma.snd n
def CertifiedHeader.val (h : CertifiedHeader schema) := Sigma.fst h
def CertifiedHeader.property (h : CertifiedHeader schema) := Sigma.snd h

-- This will make proofs difficult
-- def Subschema.toSchema {schm : @Schema η} (s : Subschema schm) : @Schema η :=
--   s.map (λ x => x.fst)

def Subschema.toSchema {schm : @Schema η} : Subschema schm → @Schema η
| [] => []
| ⟨hdr, _⟩ :: ss => hdr :: toSchema ss

def EqSubschema.toSchema {schm : @Schema η} : EqSubschema schm → @Schema η
| [] => []
| ⟨hdr, _⟩ :: ss => hdr :: toSchema ss

def Schema.fromCHeaders {schema : @Schema η}
                        (cs : List (CertifiedHeader schema))
    : @Schema η :=
  cs.map Sigma.fst

def Schema.HasCol.size : {schema : @Schema η} →
                         {hdr : @Header η} →
                         schema.HasCol hdr →
                         Nat
| _, _, Schema.HasCol.hd => 0
| _, _, Schema.HasCol.tl h => 1 + size h

-- Schema proof generation/manipulation functions
def Schema.certify (schema : @Schema η) : List (CertifiedHeader schema) :=
  let rec certify_elts : (subschm : @Schema η) → List (CertifiedHeader subschm)
    | [] => []
    | (c, τ) :: hs =>
      let map_subproof :=
        λ (⟨hdr, h⟩ : CertifiedHeader hs) => ⟨hdr, Schema.HasCol.tl h⟩;
      ⟨(c, τ), Schema.HasCol.hd⟩ :: (certify_elts hs).map map_subproof;
  certify_elts schema

def Schema.colImpliesName :
      {schema : @Schema η} →
      {c : η} →
      {τ : Type u} →
      schema.HasCol (c, τ) → schema.HasName c
| h :: hs, _, _, HasCol.hd => HasName.hd
| h :: hs, c, τ, HasCol.tl p => HasName.tl (colImpliesName p)
-- Can also be done in tactic mode:
-- | h :: hs, c, τ, p => by
--     cases p with
--     | hd => apply HasName.hd
--     | tl a => apply HasName.tl (colImpliesName a)

-- There occasionally seem to be some issues with this function, too -- not sure
-- if it's the same issue as `removeName` and `lookup`, but will leave these
-- here for the time being just in case
def Schema.colImpliesName_eq_1 {sch' : @Schema η} {hdr : @Header η} :
  colImpliesName (schema := hdr :: sch') HasCol.hd = HasName.hd := rfl

def Schema.colImpliesName_eq_2 {sch' : @Schema η} {s hdr : @Header η}
                               {h : sch'.HasCol hdr}:
  colImpliesName (schema := s :: sch') (HasCol.tl h) =
  HasName.tl (colImpliesName h) := rfl

def Schema.certifyNames (schema : @Schema η) : List (CertifiedName schema) :=
  schema.certify.map (λ (⟨(c, _), h⟩ : CertifiedHeader schema) =>
                        ⟨c, colImpliesName h⟩)

def Schema.hasNameOfAppend : {sch : @Schema η} →
                                 {nm : η} →
                                 {hs : List Header} →
                                 sch.HasName nm →
  Schema.HasName nm (sch.append hs)
| _, _, _, Schema.HasName.hd => Schema.HasName.hd
| _, _, _, Schema.HasName.tl h => Schema.HasName.tl $ hasNameOfAppend h

def Schema.hasAppendedSingletonName :
  ∀ (sch : @Schema η) (c : η) (τ : Type _),
  HasName c (List.append sch [(c, τ)])
| [], _, _ => HasName.hd
| s :: ss, c, τ => HasName.tl (hasAppendedSingletonName ss c τ)

-- Schema functions
def Schema.names {η : Type u_η} := List.map (@Prod.fst η (Type u))

-- TODO: when we come back to do uniqueness, this might be helpful
-- def Schema.removeName :
--     (s : @Schema η) → {c : η // s.HasName c} → @Schema η
/-
dite (c = nm)
       (λ _ => xs)
       (λ nh => (nm, τ) :: removeName xs ⟨c, by
        cases h with
        | hd => simp at nh
        | tl tl_h => apply tl_h
        ⟩)
-/

-- Doesn't work b/c we can't definitionally equate conditionals with their
-- evaluation, even when the equality is tautological
-- def Schema.removeName :
--     (s : @Schema η) → η → @Schema η
-- | [], _ => []
-- | (nm, τ)::xs, c => if c = nm then xs else (nm, τ) :: removeName xs c

def Schema.removeName {c : η} :
    (s : @Schema η) → (v_nm : s.HasName c) → @Schema η
| _::s, Schema.HasName.hd => s
| s::ss, Schema.HasName.tl h => s :: removeName ss h

theorem Schema.removeName_eq_1 {η : Type u_η} [DecidableEq η]
  {c : η} (hdr : @Header η) (ss : @Schema η) :
  removeName (hdr :: ss) Schema.HasName.hd = ss := rfl

theorem Schema.removeName_eq_2 {η : Type u_η} [DecidableEq η]
  {c : η} (hdr : @Header η) (ss : @Schema η)
  (h : Schema.HasName c ss) :
  removeName (hdr :: ss) (Schema.HasName.tl h) = hdr :: removeName ss h := rfl

def Schema.removeHeader {c : η} {τ : Type u}
                        (s : @Schema η)
                        (hd : s.HasCol (c, τ))
    : @Schema η :=
  removeName s (Schema.colImpliesName hd)
-- | _::s, .hd => s
-- | s::ss, .tl h => s :: removeHeader ss h

-- theorem Schema.removeHeader_eq_1 {η : Type u_η} [DecidableEq η]
--   {c : η} (hdr : @Header η) (ss : @Schema η) :
--   removeHeader (hdr :: ss) Schema.HasCol.hd = ss := rfl

-- theorem Schema.removeHeader_eq_2 {η : Type u_η} [DecidableEq η]
--   {c : η} {τ : Type u} (hdr : @Header η) (ss : @Schema η)
--   (h : Schema.HasCol (c, τ) ss) :
--   removeHeader (hdr :: ss) (Schema.HasCol.tl h) = hdr :: removeHeader ss h :=
-- rfl

def Schema.removeCertifiedName (s : @Schema η) (cn : CertifiedName s) :=
  removeName s cn.2

def Schema.removeCertifiedHeader (s : @Schema η) (ch : CertifiedHeader s) :=
  removeHeader s ch.2

def Schema.removeTypedName (τ : Type u)
                           (s : @Schema η)
                           (c : ((c : η) × s.HasCol (c, τ)))
    : @Schema η :=
  removeHeader s c.2

def Schema.removeNamePres : {schema : @Schema η} →
                              {nm : η} →
                              {n : schema.HasName nm} →
                              {nm' : η} →
                              Schema.HasName nm' (schema.removeName n) →
                              Schema.HasName nm' schema
| _ :: _, nm, Schema.HasName.hd, nm', pf => Schema.HasName.tl pf
| (nm', τ) :: ss, nm, Schema.HasName.tl h, _, Schema.HasName.hd =>
  Schema.HasName.hd
| s :: ss, nm, Schema.HasName.tl h, nm', Schema.HasName.tl h' =>
  let ih := @removeNamePres _ nm h nm' h'
  Schema.HasName.tl ih

def Schema.removeCNPres {schema : @Schema η} {nm} {n : schema.HasName nm}
                        (cn : CertifiedName $ schema.removeName n)
    : CertifiedName schema
  := ⟨cn.1, removeNamePres cn.2⟩

def Schema.removeHeaderPres :
    {hdr : @Header η} → {schema : @Schema η} →
    {h : schema.HasCol hdr} →
    {hdr' : @Header η} →
    Schema.HasCol hdr' (schema.removeHeader h) →
    Schema.HasCol hdr' schema
| _, _ :: _, HasCol.hd, hdr', pf => HasCol.tl pf
| hdr, .(hdr') :: ss, HasCol.tl h, hdr', HasCol.hd => HasCol.hd
| hdr, s :: ss, HasCol.tl h, _, HasCol.tl h' => HasCol.tl (removeHeaderPres h')

def Schema.removeTNPres
  (s : Schema)
  (k : (c : η) × Schema.HasCol (c, τ) s)
  (c : (c : η) × Schema.HasCol (c, τ) (Schema.removeTypedName τ s k)) :
  (c : η) × Schema.HasCol (c, τ) s
  := ⟨c.1, removeHeaderPres c.2⟩

def Schema.removeNames {η : Type u_η} [DecidableEq η] :
    (s : @Schema η) → ActionList removeCertifiedName s → @Schema η
| ss, ActionList.nil => ss
| ss, ActionList.cons cn rest => removeNames (removeName ss cn.2) rest

def Schema.removeHeaders {η : Type u_η} [DecidableEq η] :
    (s : @Schema η) → ActionList removeCertifiedHeader s → @Schema η
| ss, ActionList.nil => ss
| ss, ActionList.cons cn rest =>
  removeHeaders (removeCertifiedHeader ss cn) rest

def Schema.removeTypedNames {τ : Type u} :
  (s : @Schema η) → ActionList (removeTypedName τ) s → @Schema η
| s, ActionList.nil => s
| s, ActionList.cons ch rest => removeTypedNames (removeTypedName τ s ch) rest

-- TODO: this is a very inelegant way of hijacking `ActionList` (the
-- alternative, though, would be to make `ActionList` even *more* abstract by
-- decoupling `κ` and the type of the argument to `f`, which would be a function
-- of `κ` or something like that...)
def Schema.removeOtherDecCH
  (schema' schema : @Schema η)
  (c : (hdr : @Header η) × DecidableEq hdr.2 ×
    schema.HasCol hdr × schema'.HasCol hdr) :
  @Schema η := schema.removeHeader c.2.2.1

def Schema.removeOtherDecCHs (schema' : @Schema η) :
  (schema : @Schema η) →
  (cs : ActionList (removeOtherDecCH schema') schema) →
  @Schema η
| s, ActionList.nil => s
| s, ActionList.cons c cs =>
  removeOtherDecCHs schema' (removeOtherDecCH schema' s c) cs

def Schema.removeOtherCHPres :
  (s : Schema) →
  (k : (hdr : Header) × DecidableEq hdr.snd ×
    HasCol hdr s × HasCol hdr schema₁) →
  (hdr : Header) × DecidableEq hdr.snd ×
    HasCol hdr (removeOtherDecCH schema₁ s k) × HasCol hdr schema₁ →
  (hdr : Header) × DecidableEq hdr.snd × HasCol hdr s × HasCol hdr schema₁ :=
λ _ _ c => ⟨c.1, c.2.1, removeHeaderPres c.2.2.1, c.2.2.2⟩

-- Returns the schema entry with the specified name
def Schema.lookup {η : Type u_η} [DecidableEq η]
    : (s : @Schema η) → CertifiedName s → @Header η
| hdr :: _, ⟨_, Schema.HasName.hd⟩ => hdr
| _ :: hs, ⟨c, Schema.HasName.tl h'⟩ => lookup hs ⟨c, h'⟩

-- TODO: figure out what's going on here -- these should be auto-generated
-- (also the field syntax isn't working, so using underscores instead)
theorem Schema.lookup_eq_1 {η : Type u_η} [DecidableEq η]
  (hdr : @Header η) (hs : @Schema η) :
  lookup (hdr :: hs) ⟨hdr.1, HasName.hd⟩ = hdr := rfl

theorem Schema.lookup_eq_2 {η : Type u_η} [DecidableEq η]
  (hd : @Header η) (tl : @Schema η) (c : η) {h : Schema.HasName c tl} :
  lookup (hd :: tl) ⟨c, HasName.tl h⟩ = lookup tl ⟨c, h⟩ := rfl

theorem Schema.lookup_of_colImpliesName :
  ∀ (sch : @Schema η) (hpf : sch.HasCol (nm, τ)),
  Schema.lookup sch ⟨nm, Schema.colImpliesName hpf⟩ = (nm, τ)
| _ :: ss, .hd => by
  rw [colImpliesName_eq_1 (sch' := ss) (hdr := (nm, τ)),
      lookup_eq_1]
| _ :: ss, .tl h => by
  rw [colImpliesName_eq_2, lookup_eq_2]
  apply lookup_of_colImpliesName

-- Returns the type associated with the given name.
-- Note: don't use this function to specify the return type of a function.
-- Instead, take the type implicitly and make that variable the return type.
def Schema.lookupType {η : Type u_η} [DecidableEq η]
    : (s : @Schema η) → CertifiedName s → Type u
| (_, τ) :: _, ⟨_, Schema.HasName.hd⟩ => τ
| _ :: hs, ⟨c, Schema.HasName.tl h'⟩ => lookupType hs ⟨c, h'⟩

theorem Schema.lookupType_eq_snd_lookup (s : @Schema η) (cn : CertifiedName s) :
  lookupType s cn = (lookup s cn).snd := by
  cases cn with | mk nm pf =>
  induction pf with
  | hd =>
    simp only [lookupType]
    rw [lookup_eq_1]
  | tl h ih =>
    simp only [lookupType]
    rw [lookup_eq_2]
    apply ih

def Schema.pick {η : Type u_η} [DecidableEq η] (s : @Schema η)
    : List (CertifiedName s) → @Schema η
| [] => []
| c::cs => lookup s c :: pick s cs

def Schema.retypeColumn {η : Type u_η} [DecidableEq η]
    : {nm : η} → (s : @Schema η) → s.HasName nm → Type u → @Schema η
| _, (nm, τ) :: cs, Schema.HasName.hd, τ' => (nm, τ') :: cs
| _, c :: cs, Schema.HasName.tl h, τ' => c :: retypeColumn cs h τ'

theorem Schema.retypeColumn_preserves_names :
  ∀ (s : @Schema η) {nm : η} (h : s.HasName nm) (τ : Type _),
  Schema.names (s.retypeColumn h τ) = Schema.names s
| (.(nm), _) :: ss, nm, HasName.hd, τ => rfl
| s :: ss, nm, HasName.tl h, τ =>
  congrArg (s.1 :: ·) (retypeColumn_preserves_names ss h τ)

-- Could use `{xs : List τ // xs.length = n}` instead of `List τ` if needed
def Schema.flattenList (schema : @Schema η)
  (c : ((c : η) × (τ : Type u) × schema.HasCol (c, List τ)))
    : @Schema η :=
  schema.retypeColumn (Schema.colImpliesName c.2.2) c.2.1

def Schema.flattenLists : (schema : @Schema η) →
                          (ActionList flattenList schema) →
                         @Schema η
| ss, ActionList.nil => ss
| ss, ActionList.cons c cs => flattenLists (flattenList ss c) cs

def Schema.renameColumn {η : Type u_η} [DecidableEq η]
    : {nm : η} → (s : @Schema η) → s.HasName nm → η → @Schema η
| _, (nm, τ) :: cs, Schema.HasName.hd, nm' => (nm', τ) :: cs
| _, c :: cs, Schema.HasName.tl h, nm' => c :: renameColumn cs h nm'

def Schema.renameColumnCN {η : Type u_η} [DecidableEq η]
                          (s : @Schema η) (entry : CertifiedName s × η)
    : @Schema η :=
  renameColumn s entry.1.2 entry.2

def Schema.renameColumns {η : Type u_η} [DecidableEq η]
    : (s : @Schema η) → ActionList renameColumnCN s → @Schema η
| s, ActionList.nil => s
| s, ActionList.cons c ccs => renameColumns (renameColumnCN s c) ccs

theorem Schema.removeName_sublist :
  ∀ (s : @Schema η) (c : η) (hc : HasName c s),
    List.Sublist (s.removeName hc) s
| _, _, HasName.hd => List.Sublist.cons _ _ _ (List.sublist_self _)
| _, _, HasName.tl h => List.Sublist.cons2 _ _ _ (removeName_sublist _ _ h)

theorem Schema.removeNames_sublist :
  ∀ (s : @Schema η) (cs : ActionList Schema.removeCertifiedName s),
    List.Sublist (s.removeNames cs) s
| s, ActionList.nil => List.sublist_self _
| s, ActionList.cons c cs =>
  have ih := removeNames_sublist (s.removeName c.2) cs
  List.Sublist.trans ih (Schema.removeName_sublist s c.1 c.2)

theorem Schema.lookup_fst_eq_nm :
  ∀ (sch : @Schema η) (c : CertifiedName sch),
    (Schema.lookup sch c).fst = c.val
| s :: ss, ⟨_, HasName.hd⟩ => rfl
| s :: ss, ⟨c, HasName.tl h⟩ => lookup_fst_eq_nm ss ⟨c, h⟩

theorem Schema.lookup_eq_lookup_append :
  ∀ (s : @Schema η) (t : @Schema η) (c : η) (h : s.HasName c),
  lookup s ⟨c, h⟩ = lookup (s.append t) ⟨c, Schema.hasNameOfAppend h⟩ :=
by intros s t c h
   induction h with
   | hd =>
     simp only [Schema.hasNameOfAppend, List.append]
     rw [Schema.lookup_eq_1, Schema.lookup_eq_1]
   | tl h' ih =>
     simp only [Schema.hasNameOfAppend, List.append]
     rw [Schema.lookup_eq_2, Schema.lookup_eq_2]
     exact ih

def Schema.schemaHasLookup : (schema : @Schema η) → (c : CertifiedName schema)
    → schema.HasCol (schema.lookup c)
| _, ⟨_, Schema.HasName.hd⟩ => Schema.HasCol.hd
| _ :: s', ⟨c, Schema.HasName.tl h⟩ =>
  Schema.HasCol.tl (schemaHasLookup s' ⟨c, h⟩)

def Schema.schemaHasSubschema : {nm : η} → {τ : Type u} →
                                {schema : @Schema η} →
                                {subschema : Subschema schema} →
                                (h : subschema.toSchema.HasCol (nm, τ)) →
    schema.HasCol (nm, τ)
| _, _, s₁ :: ss₁, ⟨hdr, pf⟩ :: ss₂, Schema.HasCol.hd => pf
| nm, τ, schema₁, schema₂@(⟨hdr, pf⟩ :: ss), Schema.HasCol.tl h =>
  have term_helper : sizeOf h < sizeOf (@Schema.HasCol.tl η hdr _ _ _ h) := by
    simp
    rw [Nat.add_comm]
    apply Nat.lt.base;
  schemaHasSubschema h

-- TODO: figure out why it won't let us name the proof in the first clause
def Schema.hasNameOfFromCHeaders :
  ∀ {sch : @Schema η} {cs : List $ CertifiedHeader sch} {nm : η},
  Schema.HasName nm (Schema.fromCHeaders cs) → Schema.HasName nm sch
| [], ⟨hdr, hpf⟩ :: _, _, _ => nomatch hpf
| _ :: _, ⟨(.(nm), τ), _⟩ :: _, nm, .hd =>
  Schema.colImpliesName (τ := τ) (by assumption)
| _ :: _, ⟨hdr, hpf⟩ :: cs, nm, .tl h => hasNameOfFromCHeaders h

theorem Schema.hasNameOfFromCHeaders_eq_1 :
  @hasNameOfFromCHeaders η sch (⟨(nm, τ), hpf⟩ :: cs) nm HasName.hd =
  colImpliesName hpf := by
  cases sch with
  | nil => contradiction
  | cons s ss => simp [hasNameOfFromCHeaders]

theorem Schema.hasNameOfFromCHeaders_eq_2 :
  @hasNameOfFromCHeaders η sch (⟨hdr, hpf⟩ :: cs) nm (HasName.tl h) =
  hasNameOfFromCHeaders h := by
  cases sch with
  | nil => contradiction
  | cons s ss => simp [hasNameOfFromCHeaders]

/--
Takes an ActionList along with a "preservation" function that maps action list
entries "in reverse" (i.e., enables them to be "lifted" to a schema prior to
the ActionList's associated transformation) and generates a list of action list
entries at the top-level (original, pre-transformation) schema.
-/
def ActionList.toList {sch : @Schema η} {κ : @Schema η → Type u}
    {f : ∀ (s : @Schema η), κ s → @Schema η}
    (pres : ∀ (s : @Schema η) (k : κ s), κ (f s k) → κ s)
    : ActionList f sch → List (κ sch)
| ActionList.nil => []
| ActionList.cons hdr xs =>
  have : sizeOf xs < 1 + sizeOf xs := by rw [Nat.add_comm]; exact Nat.lt.base _
  hdr :: (toList pres xs).map (pres sch hdr)
-- The default tactic needlessly introduces classical reasoning
decreasing_by assumption

def BiActionList.toList {schs : @Schema η × @Schema η}
    {κ : @Schema η × @Schema η → Type u}
    {f : ∀ (ss : @Schema η × @Schema η), κ ss → @Schema η × @Schema η}
    (pres : ∀ (ss : @Schema η × @Schema η) (k : κ ss), κ (f ss k) → κ ss)
    : BiActionList f schs → List (κ schs)
| BiActionList.nil => []
| BiActionList.cons x xs =>
  have hterm : sizeOf xs < sizeOf (cons x xs) :=
    by simp; rw [Nat.add_comm, Nat.add_one]; apply Nat.lt.base
  x :: (toList pres xs).map (pres schs x)


import parlang.defs

namespace parlang
namespace memory

variables {ι : Type} {τ : ι → Type} [decidable_eq ι] {m : memory τ} {i i' : ι} {val val' : τ i}

lemma get_update_success : get (update m i val) i = val := begin
    unfold update get function.update,
    simp,
end

lemma get_update_skip (h : i' ≠ i) : get (update m i val) i' = get m i' := begin
    unfold update get function.update,
    simp [h],
end

lemma update_update_eq : update (update m i val) i val' = update m i val' := begin
    funext i',
    by_cases h : i' = i,
    simp [update, function.update, h],
    simp [update, function.update, h],
end

end memory
end parlang


import for_mathlib.ab4
import for_mathlib.AddCommGroup

open category_theory
open category_theory.limits
namespace AddCommGroup

universe u

lemma injective_of_mono' {X Y : Ab.{u}} (f : X ⟶ Y) [mono f] :
  function.injective f :=
by rwa ← AddCommGroup.mono_iff_injective

open_locale classical

noncomputable
def cofan {α : Type (u)} (X : α → Ab.{u}) :
  cofan X :=
cofan.mk
(AddCommGroup.of $ Π₀ x, X x)
(λ a, dfinsupp.single_add_hom (λ x, X x) a)

noncomputable
def is_colimit_cofan {α : Type (u)} (X : α → Ab.{u}) :
  is_colimit (cofan X) :=
{ desc := λ S, dfinsupp.lift_add_hom
    (λ i, let e : X i ⟶ S.X := S.ι.app ⟨i⟩ in e),
  fac' := λ S j, begin
    cases j,
    dsimp [cofan], ext t,
    simp only [comp_apply, dfinsupp.single_add_hom_apply,
      dfinsupp.sum_add_hom_single],
  end,
  uniq' := begin
    intros S m hm,
    apply_fun dfinsupp.lift_add_hom.symm,
    swap, apply_instance,
    dsimp,
    erw add_equiv.symm_apply_apply, ext1 a,
    simp_rw ← hm,
    ext,
    dsimp [cofan],
    simp only [comp_apply, dfinsupp.single_add_hom_apply],
  end }

instance AB4 : AB4 AddCommGroup.{u} :=
begin
  constructor,
  introsI α X Y f hf,
  let t := _, change mono t,
  let eX : (∐ λ (a : α), X a) ≅ (cofan X).X :=
    (colimit.is_colimit _).cocone_point_unique_up_to_iso (is_colimit_cofan X),
  let eY : (∐ λ (a : α), Y a) ≅ (cofan Y).X :=
    (colimit.is_colimit _).cocone_point_unique_up_to_iso (is_colimit_cofan Y),
  let q : (cofan X).X ⟶ (cofan Y).X :=
    (is_colimit_cofan X).desc ⟨(cofan Y).X,
    λ a, f a.1 ≫ (cofan Y).ι.app a, _⟩,
  swap, { rintros ⟨i⟩ ⟨⟩ ⟨⟨⟨⟩⟩⟩, dsimp, simp, dsimp, simp },
  haveI : mono q,
  { apply concrete_category.mono_of_injective,
    rintros (u v : Π₀ x, X x) h, ext w,
    dsimp [q, is_colimit_cofan, cofan] at h,
    apply_fun (λ e, (e : Π₀ w, Y w) w) at h,
    simp_rw dfinsupp.sum_add_hom_apply at h,
    apply_fun f w,
    swap,
    { rw ← AddCommGroup.mono_iff_injective, apply_instance },
    let q : Π i, Y i → Π₀ i, Y i := dfinsupp.single,
    let qq : Π i, X i → Π₀ i, Y i := λ i, (q i) ∘ (f i),
    change u.sum (λ i, qq i) w = v.sum (λ i, qq i) w at h,
    rw @dfinsupp.sum_apply α (λ i, Y i) α _ (λ i, X i) _ _ _ u qq w at h,
    rw @dfinsupp.sum_apply α (λ i, Y i) α _ (λ i, X i) _ _ _ v qq w at h,
    simp only [dfinsupp.single_apply] at h,
    dsimp [dfinsupp.sum] at h,
    simp_rw [finset.sum_dite_eq'] at h,
    convert h,
    all_goals
    { split_ifs with hh hh, { refl },
      simp only [dfinsupp.mem_support_to_fun, not_not] at hh,
      simp only [hh, (f w).map_zero] } },
  suffices : t = eX.hom ≫ q ≫ eY.inv,
  { rw this, apply_instance },
  dsimp [t, eX, q, eY],
  apply colimit.hom_ext,
  rintro ⟨j⟩,
  simp only [colimit.ι_desc, cofan.mk_ι_app,
    is_colimit.cocone_point_unique_up_to_iso_hom_desc_assoc,
    colimit.is_colimit_desc, colimit.ι_desc_assoc, category.assoc,
    is_colimit.comp_cocone_point_unique_up_to_iso_inv, colimit.cocone_ι,
    eq_self_iff_true, implies_true_iff],
end

end AddCommGroup


import .exact_seq
import .abelian_category

noncomputable theory

open category_theory
open category_theory.limits

universes v u

variables {𝒜 : Type u} [category.{v} 𝒜] [abelian 𝒜]
variables {A B C : 𝒜} {f : A ⟶ B} {g : B ⟶ C}

namespace category_theory

namespace exact_seq

lemma drop : ∀ {L : list (arrow 𝒜)} (h : exact_seq 𝒜 L) (n : ℕ),
  exact_seq 𝒜 (L.drop n)
| _ nil               0     := nil
| _ nil               (n+1) := nil
| _ (single f)        0     := single f
| _ (single f)        (n+1) := drop nil n
| _ (cons f g h L hL) 0     := cons f g h L hL
| _ (cons f g h L hL) (n+1) := hL.drop n

lemma pair : ∀ {L : list (arrow 𝒜)} (h : exact_seq 𝒜 (f :: g :: L)),
  exact f g
| L (cons _ _ h _ _) := h

end exact_seq

namespace exact

lemma mono_of_eq_zero (h : exact f g) (hf : f = 0) : mono g :=
by rwa [(abelian.tfae_mono A g).out 0 2, ← hf]

lemma eq_zero_of_mono (h : exact f g) (hg : mono g) : f = 0 :=
by rw [← cancel_mono g, h.w, zero_comp]

lemma mono_iff_eq_zero (h : exact f g) : mono g ↔ f = 0 :=
⟨h.eq_zero_of_mono, h.mono_of_eq_zero⟩

lemma epi_of_eq_zero (h : exact f g) (hg : g = 0) : category_theory.epi f :=
by rwa [(abelian.tfae_epi C f).out 0 2, ← hg]

lemma eq_zero_of_epi (h : exact f g) (hf : category_theory.epi f) : g = 0 :=
by rw [← cancel_epi f, h.w, comp_zero]

lemma epi_iff_eq_zero (h : exact f g) : category_theory.epi f ↔ g = 0 :=
⟨h.eq_zero_of_epi, h.epi_of_eq_zero⟩

lemma mono_of_is_zero (h : exact f g) (hA : is_zero A) : mono g :=
by { rw h.mono_iff_eq_zero, exact hA.eq_of_src f _ }

lemma epi_of_is_zero (h : exact f g) (hA : is_zero C) : category_theory.epi f :=
by { rw h.epi_iff_eq_zero, exact hA.eq_of_tgt g _ }

lemma is_zero_of_eq_zero_eq_zero (h : exact f g) (hf : f = 0) (hg : g = 0) : is_zero B :=
is_zero_of_exact_zero_zero' _ _ h hf hg

lemma is_zero_of_is_zero_is_zero (h : exact f g) (hA : is_zero A) (hC : is_zero C) : is_zero B :=
is_zero_of_exact_is_zero_is_zero _ _ h hA hC

protected lemma exact_seq (h : exact f g) : exact_seq 𝒜 [f, g] :=
(exact_iff_exact_seq _ _).mp h

lemma cons (h : exact f g) {L : list (arrow 𝒜)} (hL : exact_seq 𝒜 (g :: L)) :
  exact_seq 𝒜 (f :: g :: L) :=
exact_seq.cons f g h L hL

end exact

end category_theory


import .geom3d
import ..time.time

open_locale affine

section foo

universes u

variables {tf : time_frame} (ts : time_space tf )

/-
All proofs are commented out for now
-/

abbreviation non_negative_time := time ts-- // x.coord >= 0}
/-@[ext]
structure geom3d_series {tf : time_frame} (ts : time_space tf ) :=
    (series: list (non_negative_time ts))
-/
@[ext]
structure geom3d_series {tf : time_frame} (ts : time_space tf ) :=
    (series: list (non_negative_time ts × geom3d_frame))
    --(ordered : ∀ i j : fin series.length, i<j → (series.nth_le i sorry).fst.val.coord > (series.nth_le j sorry).fst.val.coord)
    /--/
    Multiple constraints so we don't have to deal with options.
    We just want to guarantee that when instantiating a timestamped vector with a series of frames,
    there definitionally will be a frame available that the vector satisfies. This is a reasonable expectation.
    Maybe double check with Dr. Elbaum
    -/
    --(non_empty: series.length > 0)
   -- (has_zero: ∃ i : fin series.length, (series.nth_le i sorry).fst.val.coord = 0)
/-
def geom3d_series.insert {tf : time_frame} {ts : time_space tf }
    : geom3d_series ts → (non_negative_time ts × geom3d_frame) → geom3d_series ts
| (⟨[],_,_,_⟩) tup := sorry
| (⟨h::[],_,_,_⟩) tup := (⟨tup::h::[],sorry,sorry,sorry⟩)
| (⟨h::t,_,_,_⟩) tup :=
    if h.fst.val.coord > tup.fst.val.coord then
        let tail_call := geom3d_series.insert (⟨t,sorry,sorry,sorry⟩) tup in
        ⟨h::tail_call.series,sorry,sorry,sorry⟩
    else ⟨tup::h::t,sorry,sorry,sorry⟩
-/

def geom3d_series.insert {tf : time_frame} {ts : time_space tf }
    : geom3d_series ts → (non_negative_time ts × geom3d_frame) → geom3d_series ts
| (⟨[]⟩) tup := sorry
| (⟨h::[]⟩) tup := (⟨tup::h::[]⟩)
| (⟨h::t⟩) tup :=
    if h.fst.coord > tup.fst.coord then
        let tail_call := geom3d_series.insert (⟨t⟩) tup in
        ⟨h::tail_call.series⟩
    else ⟨tup::h::t⟩

@[simp,reducible]
def find_helper : non_negative_time ts → list (non_negative_time ts × geom3d_frame) → (non_negative_time ts × geom3d_frame)
| t_ ([]) := (mk_time _ 0, geom3d_std_frame)
| t_ (h::[]) := h
| t_ (h::t) := if t_.coord > h.fst.coord then h else find_helper t_ t

@[simp,reducible]
def geom3d_series.find  {tf : time_frame} {ts : time_space tf }
   (s : geom3d_series ts) (t : non_negative_time ts) := (find_helper ts t s.series).snd

@[simp,reducible]
def geom3d_series.find_space  {tf : time_frame} {ts : time_space tf }
   (s : geom3d_series ts) (t : non_negative_time ts) :=
   spc.single (s.find t)

@[simp,reducible]
def geom3d_series.find_index  {tf : time_frame} {ts : time_space tf }
   (s : geom3d_series ts) (t : non_negative_time ts) :=
   (find_helper ts t s.series).fst

structure series_index (s : geom3d_series ts) :=
    (idx : non_negative_time ts)

instance index_is_setoid {s : geom3d_series ts} : setoid (series_index ts s) --there are infinite geom3d_space "types"
    :=
    ⟨
        λidx1 idx2, (s.find_index idx1.idx) = (s.find_index idx2.idx),
        sorry
    ⟩

#check @index_is_setoid

def lift_si (ser : geom3d_series ts) : series_index ts ser → time ts :=
  λsi, (ser.find_index si.idx)

def lift_ {ser : geom3d_series ts} := quotient.lift (lift_si ts ser ) begin
  dsimp [has_equiv.equiv],
  unfold lift_si,
  unfold setoid.r,
 -- unfold index_rel,
  intros a b c,
  exact c,
end

@[simp,reducible]
def find_helper'' { s : geom3d_series ts} : (quotient (@index_is_setoid tf ts s )) →
    list (non_negative_time ts × geom3d_frame) → (non_negative_time ts × geom3d_frame)
| t_ ([]) := (mk_time _ 0, geom3d_std_frame)
| t_ (h::[]) := h
| t_ (h::t) := if (lift_ ts t_).coord > h.fst.coord then h else find_helper'' t_ t

@[simp,reducible]
def geom3d_series.find''  {tf : time_frame} {ts : time_space tf }
   (s : geom3d_series ts) (t : quotient (@index_is_setoid tf ts s )) := (find_helper'' ts t s.series).snd

@[simp,reducible]
def geom3d_series.find_space''  {tf : time_frame} {ts : time_space tf }
   (s : geom3d_series ts) (t : quotient (@index_is_setoid tf ts s )) :=
   spc.single (s.find'' t)

@[simp,reducible]
def geom3d_series.find_index''  {tf : time_frame} {ts : time_space tf }
   (s : geom3d_series ts) (t : quotient (@index_is_setoid tf ts s )) :=
   (find_helper'' ts t s.series).fst

@[simp,reducible]
def find_helper' { s : geom3d_series ts} : (series_index ts s) → list (non_negative_time ts × geom3d_frame) → (non_negative_time ts × geom3d_frame)
| t_ ([]) := (mk_time _ 0, geom3d_std_frame)
| t_ (h::[]) := h
| t_ (h::t) := if t_.idx.coord > h.fst.coord then h else find_helper' t_ t

@[simp,reducible]
def geom3d_series.find'  {tf : time_frame} {ts : time_space tf }
   (s : geom3d_series ts) (t : series_index ts s) := (find_helper' ts t s.series).snd

@[simp,reducible]
def geom3d_series.find_space'  {tf : time_frame} {ts : time_space tf }
   (s : geom3d_series ts) (t : series_index ts s) :=
   spc.single (s.find' t)

@[simp,reducible]
def geom3d_series.find_index'  {tf : time_frame} {ts : time_space tf }
   (s : geom3d_series ts) (t : series_index ts s) :=
   (find_helper' ts t s.series).fst

/-
inductive geom3d_rel (series : geom3d_series ts) : time ts → time ts → Prop
| ()
-/
@[simp, reducible]
def mk_displacement3d_timefixed_at_time
    {tf : time_frame} {ts : time_space tf }
    (s : geom3d_series ts) (t : non_negative_time ts) (k₁ k₂ k₃ : scalar)
    := displacement3d.mk (mk_vectr (s.find_space t) ⟨[k₁,k₂,k₃],rfl⟩)

@[simp, reducible]
def mk_displacement3d_timefixed_at_time'
    {tf : time_frame} {ts : time_space tf }
    (s : geom3d_series ts) (t : series_index ts s) (k₁ k₂ k₃ : scalar)
    := displacement3d.mk (mk_vectr (s.find_space' t) ⟨[k₁,k₂,k₃],rfl⟩)

@[simp, reducible]
def mk_displacement3d_timefixed_at_time''
    {tf : time_frame} {ts : time_space tf }
    (s : geom3d_series ts) (t : quotient (@index_is_setoid tf ts s )) (k₁ k₂ k₃ : scalar)
    := displacement3d.mk (mk_vectr (s.find_space'' t) ⟨[k₁,k₂,k₃],rfl⟩)

/-
def geom3d_series.insert {tf : time_frame} {ts : time_space tf }
    : geom3d_series ts → (non_negative_time ts × geom3d_frame) → geom3d_series ts
| (⟨[]⟩) tup := sorry
| (⟨h::[]⟩) tup := (⟨tup::h::[]⟩)
| (⟨h::t⟩) tup :=
    if h.fst.coord > tup.fst.coord then
        let tail_call := geom3d_series.insert (⟨t⟩) tup in
        ⟨h::tail_call.series⟩
    else ⟨tup::h::t⟩

@[simp]
def find_helper : non_negative_time ts → list (non_negative_time ts) → (non_negative_time ts)
| t_ ([]) := (mk_time _ 0)
| t_ (h::[]) := h
| t_ (h::t) := if t_.coord > h.coord then h else find_helper t_ t

@[simp]
def geom3d_series.find  {tf : time_frame} {ts : time_space tf }
   (s : geom3d_series ts) (t : non_negative_time ts) := (find_helper ts t s.series).snd

@[simp]
def geom3d_series.find_space  {tf : time_frame} {ts : time_space tf }
   (s : geom3d_series ts) (t : non_negative_time ts) :=
   spc.single (s.find t)

@[simp]
def geom3d_series.find_index  {tf : time_frame} {ts : time_space tf }
   (s : geom3d_series ts) (t : non_negative_time ts) :=
   (find_helper ts t s.series)

-/
/-
inductive geom3d_rel (series : geom3d_series ts) : time ts → time ts → Prop
| ()
-/
@[simp]
def mk_displacement3d_timefixed_at_time
    {tf : time_frame} {ts : time_space tf }
    (s : geom3d_series ts) (t : non_negative_time ts) (k₁ k₂ k₃ : scalar)
    := displacement3d.mk (mk_vectr (s.find_space t) ⟨[k₁,k₂,k₃],rfl⟩)
/-
structure series_index (s : geom3d_series ts) :=
    (idx : non_negative_time ts)

def index_rel {s : geom3d_series ts} :
    series_index ts s → series_index ts s → Prop
    :=
    λidx1 idx2, (s.find_index idx1.idx) = (s.find_index idx2.idx)

instance idx_is_setoid {s : geom3d_series ts} : setoid (series_index ts s) --there are infinite geom3d_space "types"
    :=
    ⟨
        index_rel ts,
        sorry
    ⟩
-/
instance {s : geom3d_series ts} : has_equiv (series_index ts s)
    := by apply_instance
/-
instance {s : geom3d_series ts} : has_equiv (series_index ts s)
    :=
    ⟨
        index_rel ts

    ⟩-/

structure position3d_timefixed {f : geom3d_frame} (s : geom3d_space f ) extends point s
@[ext] lemma position3d_timefixed.ext : ∀  {f : geom3d_frame} {s : geom3d_space f } (x y : position3d_timefixed s),
    x.to_point = y.to_point → x = y :=
    begin
        intros f s x y e,
        cases x,
        cases y,
        simp *,
        have h₁ : ({to_point := x} : position3d_timefixed s).to_point = x := rfl,
        simp [h₁] at e,
        exact e
    end

def position3d_timefixed.coords {f : geom3d_frame} {s : geom3d_space f } (t :position3d_timefixed s) :=
    t.to_point.coords

def position3d_timefixed.x {f : geom3d_frame} {s : geom3d_space f } (t :position3d_timefixed s) : scalar :=
    (t.to_point.coords 0).coord

def position3d_timefixed.y {f : geom3d_frame} {s : geom3d_space f } (t :position3d_timefixed s) : scalar :=
    (t.to_point.coords 1).coord

def position3d_timefixed.z {f : geom3d_frame} {s : geom3d_space f } (t :position3d_timefixed s) : scalar :=
    (t.to_point.coords 2).coord

@[simp]
def mk_position3d_timefixed' {f : geom3d_frame} (s : geom3d_space f ) (p : point s) : position3d_timefixed s := position3d_timefixed.mk p
@[simp]
def mk_position3d_timefixed {f : geom3d_frame} (s : geom3d_space f ) (k₁ k₂ k₃ : scalar) : position3d_timefixed s := position3d_timefixed.mk (mk_point s ⟨[k₁,k₂,k₃],rfl⟩)

@[simp]
def mk_position3d_timefixed'' {f1 f2 f3 : geom1d_frame } { s1 : geom1d_space f1} {s2 : geom1d_space f2} { s3 : geom1d_space f3}
    (p1 : position1d s1) (p2 : position1d s2) (p3 : position1d s3 )
    : position3d_timefixed (mk_prod_spc (mk_prod_spc s1 s2) s3) :=
    ⟨mk_point_prod (mk_point_prod p1.to_point p2.to_point) p3.to_point⟩

structure displacement3d_timefixed {f : geom3d_frame} (s : geom3d_space f ) extends vectr s
@[ext] lemma displacement3d_timefixed.ext : ∀  {f : geom3d_frame} {s : geom3d_space f } (x y : displacement3d_timefixed s),
    x.to_vectr = y.to_vectr → x = y :=
    begin
        intros f s x y e,
        cases x,
        cases y,
        simp *,
        have h₁ : ({to_vectr := x} : displacement3d_timefixed s).to_vectr = x := rfl,
        simp [h₁] at e,
        exact e
    end

def displacement3d_timefixed.coords {f : geom3d_frame} {s : geom3d_space f } (d :displacement3d_timefixed s) :=
    d.to_vectr.coords

@[simp]
def mk_displacement3d_timefixed' {f : geom3d_frame} (s : geom3d_space f ) (v : vectr s) : displacement3d_timefixed s := displacement3d_timefixed.mk v
@[simp]
def mk_displacement3d_timefixed  {f : geom3d_frame} (s : geom3d_space f ) (k₁ k₂ k₃ : scalar) : displacement3d_timefixed s := displacement3d_timefixed.mk (mk_vectr s ⟨[k₁,k₂,k₃],rfl⟩)

@[simp]
def mk_displacement3d_timefixed'' {f1 f2 f3 : geom1d_frame } { s1 : geom1d_space f1} {s2 : geom1d_space f2} { s3 : geom1d_space f3}
    (p1 : displacement1d s1) (p2 : displacement1d s2) (p3 : displacement1d s3 )
    : displacement3d_timefixed (mk_prod_spc (mk_prod_spc s1 s2) s3) :=
    ⟨mk_vectr_prod (mk_vectr_prod p1.to_vectr p2.to_vectr) p3.to_vectr⟩

@[simp]
def mk_geom3d_frame {parent : geom3d_frame} {s : spc scalar parent} (p : position3d_timefixed s)
    (v0 : displacement3d_timefixed s) (v1 : displacement3d_timefixed s) (v2 : displacement3d_timefixed s)
    : geom3d_frame :=
    (mk_frame p.to_point ⟨(λi, if i = 0 then v0.to_vectr else if i = 1 then v1.to_vectr else v2.to_vectr),sorry,sorry⟩)

end foo

section bar

/-
    *************************************
    Instantiate module scalar (vector scalar)
    *************************************
-/

namespace geom3d
variables {f : geom3d_frame} {s : geom3d_space f }
@[simp]
def add_displacement3d_timefixed_displacement3d_timefixed (v3 v2 : displacement3d_timefixed s) : displacement3d_timefixed s :=
    mk_displacement3d_timefixed' s (v3.to_vectr + v2.to_vectr)
@[simp]
def smul_displacement3d_timefixed (k : scalar) (v : displacement3d_timefixed s) : displacement3d_timefixed s :=
    mk_displacement3d_timefixed' s (k • v.to_vectr)
@[simp]
def neg_displacement3d_timefixed (v : displacement3d_timefixed s) : displacement3d_timefixed s :=
    mk_displacement3d_timefixed' s ((-1 : scalar) • v.to_vectr)
@[simp]
def sub_displacement3d_timefixed_displacement3d_timefixed (v3 v2 : displacement3d_timefixed s) : displacement3d_timefixed s :=    -- v3-v2
    add_displacement3d_timefixed_displacement3d_timefixed v3 (neg_displacement3d_timefixed v2)

instance has_add_displacement3d_timefixed : has_add (displacement3d_timefixed s) := ⟨ add_displacement3d_timefixed_displacement3d_timefixed ⟩
lemma add_assoc_displacement3d_timefixed : ∀ a b c : displacement3d_timefixed s, a + b + c = a + (b + c) := begin
    intros,
    ext,
    --cases a,
    repeat {
    have p3 : (a + b + c).to_vec = a.to_vec + b.to_vec + c.to_vec := rfl,
    have p2 : (a + (b + c)).to_vec = a.to_vec + (b.to_vec + c.to_vec) := rfl,
    rw [p3,p2],
    cc
    },
    admit
end
instance add_semigroup_displacement3d_timefixed : add_semigroup (displacement3d_timefixed s) := ⟨ add_displacement3d_timefixed_displacement3d_timefixed, add_assoc_displacement3d_timefixed⟩
@[simp]
def displacement3d_timefixed_zero  := mk_displacement3d_timefixed s 0 0 0
instance has_zero_displacement3d_timefixed : has_zero (displacement3d_timefixed s) := ⟨displacement3d_timefixed_zero⟩

lemma zero_add_displacement3d_timefixed : ∀ a : displacement3d_timefixed s, 0 + a = a :=
begin
    intros,--ext,
    ext,
    admit,
   -- let h0 : (0 + a).to_vec = (0 : vectr s).to_vec + a.to_vec := rfl,
    --simp [h0],
    --exact zero_add _,
    --exact zero_add _,
end

lemma add_zero_displacement3d_timefixed : ∀ a : displacement3d_timefixed s, a + 0 = a :=
begin
    intros,ext,
    admit,
    --exact add_zero _,
    --exact add_zero _,
end

@[simp]
def nsmul_displacement3d_timefixed : ℕ → (displacement3d_timefixed s) → (displacement3d_timefixed s)
| nat.zero v := displacement3d_timefixed_zero
--| 3 v := v
| (nat.succ n) v := (add_displacement3d_timefixed_displacement3d_timefixed) v (nsmul_displacement3d_timefixed n v)

instance add_monoid_displacement3d_timefixed : add_monoid (displacement3d_timefixed s) := ⟨
    -- add_semigroup
    add_displacement3d_timefixed_displacement3d_timefixed,
    add_assoc_displacement3d_timefixed,
    -- has_zero
    displacement3d_timefixed_zero,
    -- new structure
    @zero_add_displacement3d_timefixed f s,
    add_zero_displacement3d_timefixed,
    nsmul_displacement3d_timefixed
⟩

instance has_neg_displacement3d_timefixed : has_neg (displacement3d_timefixed s) := ⟨neg_displacement3d_timefixed⟩
instance has_sub_displacement3d_timefixed : has_sub (displacement3d_timefixed s) := ⟨ sub_displacement3d_timefixed_displacement3d_timefixed⟩
lemma sub_eq_add_neg_displacement3d_timefixed : ∀ a b : displacement3d_timefixed s, a - b = a + -b :=
begin
    intros,ext,
    refl,
end

instance sub_neg_monoid_displacement3d_timefixed : sub_neg_monoid (displacement3d_timefixed s) :=
{
    neg := neg_displacement3d_timefixed ,
    ..(show add_monoid (displacement3d_timefixed s), by apply_instance)
}

lemma add_left_neg_displacement3d_timefixed : ∀ a : displacement3d_timefixed s, -a + a = 0 :=
begin
    intros,
    ext,
   /- repeat {
    have h0 : (-a + a).to_vec = -a.to_vec + a.to_vec := rfl,
    simp [h0],
    have : (0:vec scalar) = (0:displacement3d_timefixed s).to_vectr.to_vec := rfl,
    simp *,
    }-/
    admit,
end

instance : add_group (displacement3d_timefixed s) := {
    add_left_neg := begin
        exact add_left_neg_displacement3d_timefixed,
    end,
..(show sub_neg_monoid (displacement3d_timefixed s), by apply_instance),

}

lemma add_comm_displacement3d_timefixed : ∀ a b : displacement3d_timefixed s, a + b = b + a :=
begin
    intros,
    ext,
    /-repeat {
    have p3 : (a + b).to_vec = a.to_vec + b.to_vec:= rfl,
    have p2 : (b + a).to_vec = b.to_vec + a.to_vec := rfl,
    rw [p3,p2],
    cc
    }
    -/
    admit,
end
instance add_comm_semigroup_displacement3d_timefixed : add_comm_semigroup (displacement3d_timefixed s) := ⟨
    -- add_semigroup
    add_displacement3d_timefixed_displacement3d_timefixed,
    add_assoc_displacement3d_timefixed,
    add_comm_displacement3d_timefixed,
⟩

instance add_comm_monoid_displacement3d_timefixed : add_comm_monoid (displacement3d_timefixed s) := {
    add_comm := begin
        exact add_comm_displacement3d_timefixed
    end,
    ..(show add_monoid (displacement3d_timefixed s), by apply_instance)
}

instance has_scalar_displacement3d_timefixed : has_scalar scalar (displacement3d_timefixed s) := ⟨
smul_displacement3d_timefixed,
⟩

lemma one_smul_displacement3d_timefixed : ∀ b : displacement3d_timefixed s, (1 : scalar) • b = b := begin
    intros,ext,
    /-repeat {
        have h0 : ((3:scalar) • b).to_vec = ((3:scalar)•(b.to_vec)) := rfl,
        rw [h0],
        simp *,
    }-/
    admit,
end
lemma mul_smul_displacement3d_timefixed : ∀ (x y : scalar) (b : displacement3d_timefixed s), (x * y) • b = x • y • b :=
begin
    intros,
    cases b,
    ext,
    exact mul_assoc x y _,
end

instance mul_action_displacement3d_timefixed : mul_action scalar (displacement3d_timefixed s) := ⟨
one_smul_displacement3d_timefixed,
mul_smul_displacement3d_timefixed,
⟩

lemma smul_add_displacement3d_timefixed : ∀(r : scalar) (x y : displacement3d_timefixed s), r • (x + y) = r • x + r • y := begin
    intros, ext,
    repeat {
    have h0 : (r • (x + y)).to_vec = (r • (x.to_vec + y.to_vec)) := rfl,
    have h3 : (r•x + r•y).to_vec = (r•x.to_vec + r•y.to_vec) := rfl,
    rw [h0,h3],
    simp *,
    }
    ,admit,
end
lemma smul_zero_displacement3d_timefixed : ∀(r : scalar), r • (0 : displacement3d_timefixed s) = 0 := begin
    admit--intros, ext, exact mul_zero _, exact mul_zero _
end
instance distrib_mul_action_K_displacement3d_timefixed : distrib_mul_action scalar (displacement3d_timefixed s) := ⟨
smul_add_displacement3d_timefixed,
smul_zero_displacement3d_timefixed,
⟩

-- renaming vs template due to clash with name "s" for prevailing variable
lemma add_smul_displacement3d_timefixed : ∀ (a b : scalar) (x : displacement3d_timefixed s), (a + b) • x = a • x + b • x :=
begin
  intros,
  ext,
  exact right_distrib _ _ _,
end
lemma zero_smul_displacement3d_timefixed : ∀ (x : displacement3d_timefixed s), (0 : scalar) • x = 0 := begin
    intros,
    ext,
    admit,--exact zero_mul _, exact zero_mul _
end
instance module_K_displacement3d_timefixed : module scalar (displacement3d_timefixed s) := ⟨ add_smul_displacement3d_timefixed, zero_smul_displacement3d_timefixed ⟩

instance add_comm_group_displacement3d_timefixed : add_comm_group (displacement3d_timefixed s) := {
    add_comm := begin
        exact add_comm_displacement3d_timefixed
    end,
..(show add_group (displacement3d_timefixed s), by apply_instance)
}
instance : module scalar (displacement3d_timefixed s) := @geom3d.module_K_displacement3d_timefixed f s

/-
    ********************
    *** Affine space ***
    ********************
-/

/-
Affine operations
-/
instance : has_add (displacement3d_timefixed s) := ⟨add_displacement3d_timefixed_displacement3d_timefixed⟩
instance : has_zero (displacement3d_timefixed s) := ⟨displacement3d_timefixed_zero⟩
instance : has_neg (displacement3d_timefixed s) := ⟨neg_displacement3d_timefixed⟩

/-
Lemmas needed to implement affine space API
-/
@[simp]
def sub_position3d_timefixed_position3d_timefixed {f : geom3d_frame} {s : geom3d_space f } (p3 p2 : position3d_timefixed s) : displacement3d_timefixed s :=
    mk_displacement3d_timefixed' s (p3.to_point -ᵥ p2.to_point)
@[simp]
def add_position3d_timefixed_displacement3d_timefixed {f : geom3d_frame} {s : geom3d_space f } (p : position3d_timefixed s) (v : displacement3d_timefixed s) : position3d_timefixed s :=
    mk_position3d_timefixed' s (v.to_vectr +ᵥ p.to_point) -- reorder assumes order is irrelevant
@[simp]
def add_displacement3d_timefixed_position3d_timefixed {f : geom3d_frame} {s : geom3d_space f } (v : displacement3d_timefixed s) (p : position3d_timefixed s) : position3d_timefixed s :=
    mk_position3d_timefixed' s (v.to_vectr +ᵥ p.to_point)
--@[simp]
--def aff_displacement3d_timefixed_group_action : displacement3d_timefixed s → position3d_timefixed s → position3d_timefixed s := add_displacement3d_timefixed_position3d_timefixed scalar
instance : has_vadd (displacement3d_timefixed s) (position3d_timefixed s) := ⟨add_displacement3d_timefixed_position3d_timefixed⟩

lemma zero_displacement3d_timefixed_vadd'_a3 : ∀ p : position3d_timefixed s, (0 : displacement3d_timefixed s) +ᵥ p = p := begin
    intros,
    ext,--exact zero_add _,
    admit--exact add_zero _
end
lemma displacement3d_timefixed_add_assoc'_a3 : ∀ (g3 g2 : displacement3d_timefixed s) (p : position3d_timefixed s), g3 +ᵥ (g2 +ᵥ p) = (g3 + g2) +ᵥ p := begin
    intros, ext,
    repeat {
    have h0 : (g3 +ᵥ (g2 +ᵥ p)).to_pt = (g3.to_vec +ᵥ (g2.to_vec +ᵥ p.to_pt)) := rfl,
    have h3 : (g3 + g2 +ᵥ p).to_pt = (g3.to_vec +ᵥ g2.to_vec +ᵥ p.to_pt) := rfl,
    rw [h0,h3],
    simp *,
    simp [has_vadd.vadd, has_add.add, add_semigroup.add, add_zero_class.add, add_monoid.add, sub_neg_monoid.add,
        add_group.add, distrib.add, ring.add, division_ring.add],
    cc,
    },
    admit,
end

instance displacement3d_timefixed_add_action: add_action (displacement3d_timefixed s) (position3d_timefixed s) :=
⟨ zero_displacement3d_timefixed_vadd'_a3,
begin
    let h0 := displacement3d_timefixed_add_assoc'_a3,
    intros,
    exact (h0 g₁ g₂ p).symm
end⟩
--@[simp]
--def aff_geom3d_group_sub : position3d_timefixed s → position3d_timefixed s → displacement3d_timefixed s := sub_geom3d_position3d_timefixed scalar
instance position3d_timefixed_has_vsub : has_vsub (displacement3d_timefixed s) (position3d_timefixed s) := ⟨ sub_position3d_timefixed_position3d_timefixed⟩

instance : nonempty (position3d_timefixed s) := ⟨mk_position3d_timefixed s 0 0 0⟩

lemma position3d_timefixed_vsub_vadd_a3 : ∀ (p3 p2 : (position3d_timefixed s)), (p3 -ᵥ p2) +ᵥ p2 = p3 := begin
    /-intros, ext,
    --repeat {
    have h0 : (p3 -ᵥ p2 +ᵥ p2).to_pt = (p3.to_pt -ᵥ p2.to_pt +ᵥ p2.to_pt) := rfl,
    rw h0,
    simp [has_vsub.vsub, has_sub.sub, sub_neg_monoid.sub, add_group.sub, add_comm_group.sub, ring.sub, division_ring.sub],
    simp [has_vadd.vadd, has_add.add, distrib.add, ring.add, division_ring.add],
    let h0 : field.add p2.to_pt.to_prod.fst (field.sub p3.to_pt.to_prod.fst p2.to_pt.to_prod.fst) =
            field.add (field.sub p3.to_pt.to_prod.fst p2.to_pt.to_prod.fst) p2.to_pt.to_prod.fst := add_comm _ _,
    rw h0,
    exact sub_add_cancel _ _,
    have h0 : (p3 -ᵥ p2 +ᵥ p2).to_pt = (p3.to_pt -ᵥ p2.to_pt +ᵥ p2.to_pt) := rfl,
    rw h0,
    simp [has_vsub.vsub, has_sub.sub, sub_neg_monoid.sub, add_group.sub, add_comm_group.sub, ring.sub, division_ring.sub],
    simp [has_vadd.vadd, has_add.add, distrib.add, ring.add, division_ring.add],
    let h0 : field.add p2.to_pt.to_prod.snd (field.sub p3.to_pt.to_prod.snd p2.to_pt.to_prod.snd) =
            field.add (field.sub p3.to_pt.to_prod.snd p2.to_pt.to_prod.snd) p2.to_pt.to_prod.snd := add_comm _ _,
    rw h0,
    exact sub_add_cancel _ _,-/
    admit
end
lemma position3d_timefixed_vadd_vsub_a3 : ∀ (g : displacement3d_timefixed s) (p : position3d_timefixed s), g +ᵥ p -ᵥ p = g :=
begin
    intros, ext,
    repeat {
    have h0 : ((g +ᵥ p -ᵥ p) : displacement3d_timefixed s).to_vectr = (g.to_vectr +ᵥ p.to_point -ᵥ p.to_point) := rfl,
    rw h0,
    simp *,
    }

end

instance aff_geom3d_torsor' : add_torsor (displacement3d_timefixed s) (position3d_timefixed s) :=
⟨
    begin
        exact position3d_timefixed_vsub_vadd_a3,
    end,
    begin
        exact position3d_timefixed_vadd_vsub_a3,
    end,
⟩

open_locale affine

instance : affine_space (displacement3d_timefixed s) (position3d_timefixed s) := @geom3d.aff_geom3d_torsor' f s

end geom3d -- ha ha
end bar