import analysis.inner_product_space.pi_L2
import topology.paracompact

--OUTPUT 1
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  let A : set (euclidean_space ℝ (fin n)), from sorry,
  have H_A_open : open A, from sorry,
  let B_0 : set (euclidean_space ℝ (fin n)), from sorry,
  have H_B_0_empty : B_0 = ∅, from sorry,
  let B_n : set (euclidean_space ℝ (fin n)), from sorry,
  have H_B_n_closed : is_closed B_n, from sorry,
  have H_ℝn_compact : is_compact ℝn, from sorry,
  let C_m : set (euclidean_space ℝ (fin n)), from sorry,
  have H_C_m_open : open C_m, from sorry,
  let C : set (euclidean_space ℝ (fin n)), from sorry,
  have H_C_open : open C, from sorry,
  have H_C_cover : ℝn ⊆ ⋃₀ C, from sorry,
  have H_C_open_refinement : 𝒪 A ⊆ ⋃₀ C, from sorry,
  have H_C_loc_finite : ∀ (x : ℝn), is_locally_finite (λ (U : set (euclidean_space ℝ (fin n))), x ∈ interior U), from sorry,
  exact paracompact_of_locally_finite H_C_open_refinement H_C_cover H_C_loc_finite,
end

--OUTPUT 2
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  intros A hA,
  show ∃ C : ι → set (euclidean_space ℝ (fin n)), ∀ c ∈ C, is_open c ∧ ∀ c ∈ C, ∃ U ∈ A, c ⊆ U ∧ ∀ c' ∈ C, c' ≠ c → c' ∩ c = ∅, from by {
    have h1 : ∀ m : ℕ, ∃ Cₘ : ι → set (euclidean_space ℝ (fin n)), ∀ c ∈ Cₘ, is_open c ∧
      ∀ c ∈ Cₘ, ∃ U ∈ A, c ⊆ U ∧ ∀ c' ∈ Cₘ, c' ≠ c → c' ∩ c = ∅, from sorry,
    let C := λ i : ι, classical.some (h1 (i : ℕ)),
    show ∃ C : ι → set (euclidean_space ℝ (fin n)), ∀ c ∈ C, is_open c ∧ ∀ c ∈ C, ∃ U ∈ A, c ⊆ U ∧ ∀ c' ∈ C, c' ≠ c → c' ∩ c = ∅, from sorry,
  },
end

--OUTPUT 3
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
    assume A : set (euclidean_space.sheaf.cover_data (euclidean_space ℝ (fin n))),
    assume H : is_open_cover A,
    let A1 := (λ (a : euclidean_space.sheaf.cover_data (euclidean_space ℝ (fin n))),
        if h : a.U ∈ A then ⟨{ x | a.U.1 x ∧ euclidean_space ℝ (fin n) ≤ a.U.2 + (1 : ℝ) ∧ euclidean_space ℝ (fin n) ≥ a.U.2 - (1 : ℝ)}, h⟩ else ⟨{ x // false }, _⟩),
    have h1 : ∀ a : euclidean_space.sheaf.cover_data (euclidean_space ℝ (fin n)), (euclidean_space ℝ (fin n)) ∈ A ∧ (euclidean_space ℝ (fin n)) ∈ a.U.1 → ∃ c : euclidean_space.sheaf.cover_data (euclidean_space ℝ (fin n)), c ∈ A1 ∧ c.U.1 < a.U.1, from sorry,
    have h2 : ∀ a : euclidean_space.sheaf.cover_data (euclidean_space ℝ (fin n)), (euclidean_space ℝ (fin n)) ∈ A ∧ (euclidean_space ℝ (fin n)) ∈ a.U.1 → ∃ c : euclidean_space.sheaf.cover_data (euclidean_space ℝ (fin n)), c ∈ A1 ∧ a.U.1 < c.U.1, from sorry,
    have h3 : ∀ a : euclidean_space.sheaf.cover_data (euclidean_space ℝ (fin n)), (euclidean_space ℝ (fin n)) ∈ A → ∃ c : euclidean_space.sheaf.cover_data (euclidean_space ℝ (fin n)), c ∈ A1, from sorry,
    have h4 : ∀ a : euclidean_space.sheaf.cover_data (euclidean_space ℝ (fin n)), (euclidean_space ℝ (fin n)) ∈ A → ∃ c : euclidean_space.sheaf.cover_data (euclidean_space ℝ (fin n)), c ∈ A1, from sorry,
    have h5 : ∀ a : euclidean_space.sheaf.cover_data (euclidean_space ℝ (fin n)), (euclidean_space ℝ (fin n)) ∈ A ∧ (euclidean_space ℝ (fin n)) ∈ a.U.1 → ∃ c : euclidean_space.sheaf.cover_data (euclidean_space ℝ (fin n)), c ∈ A1 ∧ c.U.1 < a.U.1 → ∃ c : euclidean_space.sheaf.cover_data (euclidean_space ℝ (fin n)), c ∈ A1 ∧ c.U.1 < a.U.1 ∧ c.U.1 ∈ a.U.1, from sorry,
    have h6 : ∀ a : euclidean_space.sheaf.cover_data (euclidean_space ℝ (fin n)), (euclidean_space ℝ (fin n)) ∈ A ∧ (euclidean_space ℝ (fin n)) ∈ a.U.1 → ∃ c : euclidean_space.sheaf.cover_data (euclidean_space ℝ (fin n)), c ∈ A1 ∧ c.U.1 < a.U.1 ∧ c.U.1 ∈ a.U.1 → ∃ c : euclidean_space.sheaf.cover_data (euclidean_space ℝ (fin n)), c ∈ A1 ∧ c.U.1 < a.U.1 ∧ c.U.1 ∈ a.U.1 ∧ c.U.2 > a.U.2, from sorry,
    have h7 : ∀ a : euclidean_space.sheaf.cover_data (euclidean_space ℝ (fin n)), (euclidean_space ℝ (fin n)) ∈ A ∧ (euclidean_space ℝ (fin n)) ∈ a.U.1 → ∃ c : euclidean_space.sheaf.cover_data (euclidean_space ℝ (fin n)), c ∈ A1 ∧ c.U.1 < a.U.1 ∧ c.U.1 ∈ a.U.1 ∧ c.U.2 > a.U.2, from sorry,
    have h8 : ∀ a : euclidean_space.sheaf.cover_data (euclidean_space ℝ (fin n))
end

--OUTPUT 4
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  intro U,
  by_cases h : nonempty (euclidean_space ℝ (fin n)),
  have h2 : U ⊆ ⋃₀ U, from Union_of_Union_of_Elements_of_Union h,
  have h3 : ∀ x ∈ U, ∃ T : set (euclidean_space ℝ (fin n)), x ∈ T ∧ is_open T ∧ T ∈ U, from @elements_of_Union_of_set_is_Union_of_Elements_of_Union (euclidean_space ℝ (fin n)) _ _ U h2 (nonempty.choose h) h2,
  let V := {T : set (euclidean_space ℝ (fin n)) | (∃x∈U, x∈T) ∧ is_open T},
  have h4 : V ⊆ ⋃₀U, from Union_of_Union_of_Elements_of_Union h,
  have h5 : ∃ T : set (euclidean_space ℝ (fin n)), x ∈ T ∧ is_open T ∧ T ∈ V, from @elements_of_Union_of_set_is_Union_of_Elements_of_Union (euclidean_space ℝ (fin n)) _ _ V h4 (nonempty.choose h) h4,
  show ∃ V : set (euclidean_space ℝ (fin n)), is_open V ∧ x ∈ V ∧ ∀ (T : set (euclidean_space ℝ (fin n))), T ∈ V → T ∈ U, from @elements_of_Union_of_set_is_Union_of_Elements_of_Union (euclidean_space ℝ (fin n)) _ _ V h4 (nonempty.choose h) h4,
end

--OUTPUT 5
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  assume (U : opens (euclidean_space ℝ (fin n))),
  assume hU : is_open_cover U,
  have h_U₀ : (∀ (V : opens (euclidean_space ℝ (fin n))), V ∈ U → (V ≠ ∅)), from sorry,

  have h_B₀ : (∀ V : opens (euclidean_space ℝ (fin n)), V ∈ U → (ℝn.ball 0 0 = ∅)), from sorry,

  have h_B₁ : (∀ m : ℕ, (ℝn.ball 0 m ≠ ∅)), from sorry,

  have h_B₂ : (∀ m : ℕ, (ℝn.ball 0 m ∈ U → ℝn.ball 0 m ⊆ ℝn.ball 0 (m + 1))), from sorry, -- ⊆ ⒂ ⊆₁

  have h_B₃ : (∀ m : ℕ, (ℝn.ball 0 m ∈ U → ℝn.ball 0 m ≠ ℝn.ball 0 (m + 1))), from sorry, -- ≠ ⒂ ≠₁

  have h_R₁ : (∀ (m : ℕ) (x : ℝ ^ (fin n)), (x ∈ ℝn.ball 0 m → ∃ (N : ℕ), (m ≤ N) ∧ (x ∈ ℝn.ball 0 N))), from sorry,

  have h_R₂ : (∀ (m : ℕ) (x : ℝ ^ (fin n)), (x ∈ ℝn.ball 0 m → ∃ (N : ℕ), (m ≤ N) ∧ (x ∈ ℝn.ball 0 N) ∧ (∀ (n : ℕ), (m ≤ n) → (n ≤ N) → (x ∈ ℝn.ball 0 n)))), from sorry,

  have h_R₃ : (∀ (m : ℕ) (x : ℝ ^ (fin n)), (x ∈ ℝn.ball 0 m → (∀ (n : ℕ), (m ≤ n) → (n ≤ m + 1) → (x ∈ ℝn.ball 0 n)))), from sorry,

  have h_R₄ : (∀ (m : ℕ) (x : ℝ ^ (fin n)), (x ∈ ℝn.ball 0 m → (∃ (y : ℝ ^ (fin n)), (x ∈ ℝn.ball 0 (m+1) ∧ x ∈ ℝn.ball y 1) ∧ (∀ (n : ℕ), (m ≤ n) → (n ≤ m + 1) → (x ∈ ℝn.ball 0 n))))), from sorry,

  have h_R₅ : (∀ (m : ℕ) (x : ℝ ^ (fin n)), (x ∈ ℝn.ball 0 m → (∃ (y : ℝ ^ (fin n)), (x ∈ ℝn.ball 0 (m+1) ∧ x ∈ ℝn.ball y 1) ∧ (∀ (n : ℕ) (z : ℝ ^ (fin n)), (m ≤ n) → (n ≤ m + 1) → (z ∈ ℝn.ball 0 n) → (z ∈ ℝn.ball y 1))))), from sorry,

  have h_R₆ : (∀ m : ℕ, (∃ (y : ℝ ^ (fin n)), (m ∈ ℕ) ∧ (∃ (x : ℝ ^ (fin n)), x ∈ ℝn.ball 0 (m+1) ∧ x ∈ ℝn.ball y 1) ∧ (∀ (n : ℕ) (z : ℝ ^ (fin n)), (m ≤ n) → (n ≤ m + 1) → (z ∈ ℝn.ball 0 n) → (z ∈ ℝn.ball y 1)))), from sorry,

  have h_R₇ : (∀ (m : ℕ) (x y : ℝ ^ (fin n)), (x ∈ ℝn.ball 0 m → x ∈ ℝn.ball y 1 → ∃ (n : ℕ), (m ≤ n) ∧ (n ≤ m + 1) ∧ (x ∈ ℝn.ball 0 n))), from sorry,

  have h_R₈ : (∀ (m : ℕ) (x y : ℝ ^ (fin n)), (x ∈ ℝn.ball 0 m → x ∈ ℝn.ball y 1 → ∃ (n : ℕ), (m ≤ n) ∧ (n ≤ m + 1) ∧ (x ∈ ℝn.ball 0 n) ∧ (∀ (k : ℕ), (m ≤ k) → (k ≤ n) → (x ∈ ℝk.ball 0 k)))), from sorry,

  have h_R₉ : (∀ (m : ℕ) (x y : ℝ ^ (fin n)), (x ∈ ℝn.ball 0 m → x ∈ ℝn.ball y 1 → (∀ (k : ℕ), (m ≤ k) → (k ≤ m + 1) → (x ∈ ℝk.ball 0 k)))), from sorry,

  have h_R₁₀ : (∀ m : ℕ, ∃ (y : ℝ ^ (fin n)), (∃ (x : ℝ ^ (fin n)), x ∈ ℝn.ball 0 (m+1) ∧ x ∈ ℝn.ball y 1) ∧ (∀ (k : ℕ) (z : ℝ ^ (fin n)), (m ≤ k) → (k ≤ m + 1) → (z ∈ ℝk.ball 0 k) → (z ∈ ℝn.ball y 1))), from sorry,

  have h_R₁₁ : (∀ (m : ℕ) (y z : ℝ ^ (fin n)), (∃ (x : ℝ ^ (fin n)), x ∈ ℝn.ball 0 (m+1) ∧ x ∈ ℝn.ball y 1) → (∀ (k : ℕ) (w : ℝ ^ (fin n)), (m ≤ k) → (k ≤ m + 1) → (w ∈ ℝk.ball 0 k) → (w ∈ ℝn.ball y 1)) → (∃ (n : ℕ), (m ≤ n) ∧ (n ≤ m + 1) ∧ (z ∈ ℝn.ball 0 n)))), from sorry,

  have h_R₁₂ : (∀ (m : ℕ) (y z : ℝ ^ (fin n)), (∃ (x : ℝ ^ (fin n)), (x ∈ ℝn.ball 0 (m+1) ∧ x ∈ ℝn.ball y 1)) → (∀ (k : ℕ) (w : ℝ ^ (fin n)), (m ≤ k) → (k ≤ m + 1) → (w ∈ ℝk.ball 0 k) → (w ∈ ℝn.ball y 1)) → (∃ (n : ℕ), (m ≤ n) ∧ (n ≤ m + 1) ∧ (z ∈ ℝn.ball 0 n) ∧ (∀ (p : ℕ), (m ≤ p) → (p ≤ n) → (z ∈ ℝp.ball 0 p)))), from sorry,

  have h_R₁₃ : (∀ (m : ℕ) (y z : ℝ ^ (fin n)), (∃ (x : ℝ ^ (fin n)), (x ∈ ℝn.ball 0 (m+1) ∧ x ∈ ℝn.ball y 1)) → (∀ (
end --Needs more than 2000 tokens!

--OUTPUT 6
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) := sorry

/--`theorem`
Empty set is Normal
$\emptyset$ is normal.
`proof`
$\emptyset$ is discrete, so let $V$ be any set. Then $V \cap \emptyset = \emptyset$, which is a neighborhood of $\emptyset$, and $V - \emptyset = V$, which is open in $\emptyset$. So $\emptyset$ is normal.

QED
-/
theorem empty_set_normal : normal_space (⊥) := sorry

/--`theorem`
Consequent is Contradictory
Let $\Gamma$ be a set of formulas, and let $\phi, \psi$ be formulas. Then $\Gamma, \frakgmod \phi \to \phi \models \frakgmod \psi \to \psi$ is true if and only if $\Gamma, \frakgmod \phi \models \psi$.
`proof`
($\implies$)

Suppose $\Gamma, \frakgmod \phi \to \phi \models \frakgmod \psi \to \psi$. Then for any valuation $v$, if $\Gamma \cup \{ \frakgmod \phi \to \phi \} \models \frakgmod \psi \to \psi$ under $v$, then $\Gamma \cup \{ \frakgmod \phi \} \models \psi$ under $v$.

($\impliedby$)

Suppose $\Gamma, \frakgmod \phi \models \psi$. Then for any valuation $v$, if $\Gamma \cup \{ \frakgmod \phi \} \models \psi$ under $v$, then $\Gamma \cup \{ \frakgmod \phi \to \phi \} \models \frakgmod \psi \to \psi$ under $v$.

QED
-/
theorem consequent_is_contradictory {Γ : list form} {φ ψ : form} : Γ ⊢ (φ ⊃ φ) → (ψ ⊃ ψ) ↔ Γ ⊢ φ → ψ := sorry

/--`theorem`
Subset of Compact is Compact
Let $A$ be compact, and let $B \subseteq A$. Then $B$ is compact.
`proof`
Let $B \subseteq A$ be compact. Then $A$ has a finite subcover $A_1, \ldots, A_k$. So for any collection $\{ V_i \}_{i \in I}$ of open sets in $B$ where $B \subseteq \bigcup_{i \in I} V_i$, we can still find a finite subcover of $B$ whose union is $B$, namely, $V_1 \cap B, \ldots, V_k \cap B$ cover $B$ and are open in $B$. So $B$ is compact.

QED
-/
theorem compact_subset_is_compact {A B : set (euclidean_space ℝ 1)} {hA : is_compact A} : B ⊆ A → is_compact B := sorry

/--`theorem`
(Upper) limit of a bounded sequence is bounded
Let ${\left({x_n}\right)}_{n \in \mathbb{N}}$ be a sequence in $\R$, and let $L$ be an upper bound for the sequence, i.e. $\forall n \in \mathbb{N}: x_n \leq L$. Then the limit $L'$ of the sequence is also an upper bound, i.e. $\forall n \in \mathbb{N}: x_n \leq L'$.
`proof`
By the definition of a limit $L'$ of a sequence, for any $\epsilon > 0$, there exists an $N_\epsilon \in \mathbb{N}$ such that for all $n \in \mathbb{N}$ with $n > N_\epsilon$, $\abs{x_n - L'} < \epsilon$. Since $L'$ is the limit, we know this holds for $\epsilon = \frac{L' - L}{2} > 0$ and some $N_\frac{L' - L}{2} \in \mathbb{N}$. So for all $n \in \mathbb{N}$ with $n > N_\frac{L' - L}{2}$, $\abs{x_n - L'} < \frac{L' - L}{2}$, so $\frac{L' - L}{2} + L' > x_n > L' - \frac{L' - L}{2} > L$, and so $L'$ is an upper bound.

QED
-/
theorem limit_is_bounded_upper {X : Type*} [linear_ordered_field X] [linear_order X] [topological_space X] {x : ℕ → X} {M : X} (hM : ∀ n, x n ≤ M) : is_limit x M → ∀ n, x n ≤ M := sorry

/--`theorem`
If an ideal I is contained in the Jacobson radical J, then I is contained in the nilradical of the ring.
Let $R$ be a ring, and let $J$ be the Jacobson radical of $R$. Further, let $I$ be an ideal of $R$ contained in $J$. Then $I$ is contained in the nilradical of $R$.
`proof`
Let $x \in I \subseteq J$. Then $1 - x$ is invertible by definition of the Jacobson radical, so $x$ is nilpotent. Hence, $I$ is contained in the nilradical of $R$.

QED
-/
lemma mem_nilradical_of_mem_jradical_of_ring (R) (J : ideal R) (I : ideal R) : I ⊆ J → I ⊆ ⊥ := sorry

/--`theorem`
Jacobson radical is the intersection of all prime ideals.
Let $R$ be a ring. Then the Jacobson radical of $R$ equals the intersection of all prime ideals of $R$.
`proof`
By the definition of a prime ideal of $R$, it is an ideal $P$ such that for any $a, b \in R$, if $a b \in P$, then either $a$ or $b$ is in $P$. Clearly, the intersection of all prime ideals is contained in the Jacobson radical, since the Jacobson radical is the intersection of all maximal ideals of $R$ which are prime by definition. Conversely, suppose $x \in J$ where $J$ is the Jacobson radical of $R$. Then $1 - x$ is invertible by definition of the Jacobson radical, so suppose $1 - x = ab = ba$ for some $a, b \in R$. Then if $x = 1$, which is in any prime ideal $P$, then either $a = x = 1$ in $R$, which is not in any prime ideal $P$, or $b = x = 1$ in $R$, which is not in any prime ideal $P$. Contradiction. Hence, $x$ is not in any prime ideal of $R$. It follows that the intersection of all prime ideals is the Jacobson radical.

QED
-/
lemma jradical_eq_intersection_of_all_prime_ideals_of_ring (R) : jradical R = ⋂₀ {P // prime P} := sorry

/--`theorem`
Jacobson radical is not null.
Let $R$ be a ring. Then the Jacobson radical of $R$ is not null.
`proof`
Suppose $J$ is the Jacobson radical of $R$, and suppose $J = \emptyset$. Then the intersection of all maximal ideals of $R$ is $\emptyset$. But the maximal ideals of $R$ include the prime ideals of $R$ by definition, so the intersection of all prime ideals of $R$ is $\emptyset$. Hence, the Jacobson radical of $R$ is not null.

QED
-/
lemma jradical_of_ring_non_empty (R) : jradical R ≠ ⊥ := sorry

/--`theorem`
If $a$ is a nonzero and nonunit in a ring $R$, then $a$ is not a unit in the quotient ring $R/\gamma$ for any proper ideal $\gam
end --Needs more than 2000 tokens!

--OUTPUT 7
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  assume (A : set (euclidean_space ℝ (fin n))) (hA : A ≃ᵉ ℝn),
  have h1 : ∀ m : ℕ, ∃ C : set (euclidean_space ℝ (fin n)),
    (∀ x ∈ ℝn, exists i : fin n, x i ≤ m ∧ ∃ i : fin n, m ≤ x i) →
    (∀ j ≤ m, 𝓝 x j ⊆ (⋃ i ∈ C, ⋃ j ∈ A, 𝓝 x i ∩ 𝓝 x j)) →
    C ∈ finset.powerset A ∧ C.finite,
  { assume m,
    have h2 : ∃ C : set (euclidean_space ℝ (fin n)), C ∈ finset.powerset A ∧ C.finite,
    from sorry,
    have h3 : ∀ j ≤ m, 𝓝 x j ⊆ (⋃ i ∈ C, ⋃ j ∈ A, 𝓝 x i ∩ 𝓝 x j), from sorry,
    have h4 : ∀ x ∈ ℝn, exists i : fin n, x i ≤ m ∧ ∃ i : fin n, m ≤ x i, from sorry,
    show ∃ C : set (euclidean_space ℝ (fin n)),
      (∀ x ∈ ℝn, exists i : fin n, x i ≤ m ∧ ∃ i : fin n, m ≤ x i) →
      (∀ j ≤ m, 𝓝 x j ⊆ (⋃ i ∈ C, ⋃ j ∈ A, 𝓝 x i ∩ 𝓝 x j)) →
      C ∈ finset.powerset A ∧ C.finite, from sorry,
  },
  have h5 : ∀ j : ℕ, ∀ x : ℝn, x ∈ ℝn → 𝓝 x j ⊆ (⋃ s ∈ ((⋃ m ∈ ℕ, classical.some (h1 m)) : set (euclidean_space ℝ (fin n))), ⋃ t ∈ A, 𝓝 x s ∩ 𝓝 x t), from sorry,
  have h6 : (⋃ m ∈ ℕ, classical.some (h1 m)) ∈ finset.powerset A ∧ ((⋃ m ∈ ℕ, classical.some (h1 m)) : set (euclidean_space ℝ (fin n))).finite, from sorry,
  show ∃ C : set (euclidean_space ℝ (fin n)),
    (C ≃ᵈ₁ ℝn) ∧
    (⋃ t ∈ C, 𝓝 x t) ≃ᵈ₂ ℝn ∧
    C ∈ finset.powerset A ∧ C.finite, from sorry,
end

--OUTPUT 8
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  let B0 : ℝᵏ := (0 : ℝᵏ),
  let B1 : ℝᵏ := (1 : ℝᵏ),
  let A : set (set (euclidean_space ℝ (fin n))) := {s | ∃ x : ℝᵏ, s = (euclidean_space.ball x ℝ B1 : set (euclidean_space ℝ (fin n)))},
  have h1 : is_open (⋃₀ A), sorry,
  let C := (λ (x : ℝᵏ), { s | ∃ y : ℝᵏ, x ∈ (euclidean_space.ball y ℝ B1 : set (euclidean_space ℝ (fin n))) ∧ s = (euclidean_space.ball y ℝ B1 : set (euclidean_space ℝ (fin n)))} : set (euclidean_space ℝ (fin n)) → set (set (euclidean_space ℝ (fin n)))),
  have h2 : ∀ x : ℝᵏ, is_open (C x), sorry,
  have h3 : is_open (⋃₀ A), from sorry,
  have h4 : is_open (⋃₀ (C (0 : ℝᵏ))), from sorry,

  have h5 : (0 : ℝᵏ) ∈ euclidean_space.ball B0 ℝ B1, by { sorry },
  have h6 : (0 : ℝᵏ) ∈ euclidean_space.ball (0 : ℝᵏ) ℝ B1, by { sorry },
  have h7 : (0 : ℝᵏ) ∈ (⋃₀ A), from sorry,

  let Cm := (λ (m : ℕ), { s | ∃ y : ℝᴾᵐ, finset.prod y B1 < m ∧ s = (euclidean_space.ball y ℝ B1 : set (euclidean_space ℝ (fin n)))} : set (euclidean_space ℝ (fin n)) → set (set (euclidean_space ℝ (fin n)))),
  have h8 : ∀ m : ℕ, is_open (Cm m), sorry,
  have h9 : is_open (⋃₀ (Cm 1)), from sorry,

  let Cm := (λ (m : ℕ), { s | ∃ y : ℕ, finset.prod y B1 < m ∧ s = (euclidean_space.ball y ℝ B1 : set (euclidean_space ℝ (fin n)))} : set (euclidean_space ℝ (fin n)) → set (set (euclidean_space ℝ (fin n)))),
  have h10 : ∀ m : ℕ, is_open (Cm m), sorry,
  have h11 : is_open (⋃₀ (Cm 1)), from sorry,

  have h12 : is_open (⋃ (m : ℕ) (h : m < (1 : ℕ)), Cm m), from sorry,

  show paracompact_space (euclidean_space ℝ (fin n)), from sorry,
end

--OUTPUT 9
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
    sorry
end

--OUTPUT 10
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  show (paracompact_space (euclidean_space ℝ (fin n))), from sorry
end

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

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

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

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

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

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

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from sorry,
  have h2 : (A ∩ B) ⊆ A, from sorry,
  have h3 : (A ∩ B) ⊆ S, from sorry,
  show (A ∩ B) ∈  𝒫 S, from sorry,
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 sorry
  ... = x*(x+y) + y*(x+y) : by sorry
  ... = x*x + x*y + y*x + y*y : by sorry
  ... = x^2 + 2*x*y + y^2 : by sorry,
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 sorry,
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from sorry,

  have h3 : ∀ a : G, ∃! x : G, a * x = a, from sorry,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from sorry,

  have h5 : ∀ a : G, classical.some (h3 a) = (1 : G), from sorry,
  have h6 : ∀ a : G, classical.some (h4 a) = (1 : G), from sorry,

  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) (h7 : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a), from sorry,
      have h9 : ∀ a : G, e = classical.some (h4 a), from sorry,
      show e = (1 : G), from sorry,
    },
    sorry,
  }
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 for_mathlib.derived.bounded_homotopy_category
import for_mathlib.is_quasi_iso_sigma
import for_mathlib.coprod_op
import for_mathlib.derived.example

open category_theory
open category_theory.limits

universes v u
variables {A : Type u} [category.{v} A] [abelian A] [has_coproducts A]

open_locale zero_object

namespace bounded_homotopy_category

noncomputable
def cofan {α : Type v} (X : α → bounded_homotopy_category A)
  [uniformly_bounded X] : cofan X := cofan.mk
{ val := (homotopy_category.colimit_cofan $ λ a : α, (X a).val).X,
  bdd := begin
    obtain ⟨n,hn⟩ := homotopy_category.is_uniformly_bounded_above.cond (val ∘ X),
      use n, intros i hi,
    dsimp [homotopy_category.colimit_cofan],
    let e : (∐ λ (a : α), (X a).val.as).X i ≅
      (∐ λ (a : α), (X a).val.as.X i) := homotopy_category.coproduct_iso _ _,
    refine is_zero_of_iso_of_zero _ e.symm,
    apply category_theory.is_zero_colimit,
    intros j,
    apply hn j _ hi,
  end }
(λ a, (homotopy_category.colimit_cofan _).ι.app a)

noncomputable
def is_colimit_cofan {α : Type v} (X : α → bounded_homotopy_category A)
  [uniformly_bounded X] : is_colimit (cofan X) :=
{ desc := λ S, (homotopy_category.is_colimit_cofan
    (λ a : α, (X a).val)).desc ((forget A).map_cocone S),
  fac' := begin
    intros S j,
    erw (homotopy_category.is_colimit_cofan (λ a : α, (X a).val)).fac
      ((forget A).map_cocone S) j, refl,
  end,
  uniq' := begin
    intros S m hm,
    apply (homotopy_category.is_colimit_cofan (λ a : α, (X a).val)).hom_ext,
    intros j,
    specialize hm j,
    erw hm,
    erw (homotopy_category.is_colimit_cofan (λ a : α, (X a).val)).fac,
    refl,
  end }

instance has_coproduct_of_uniform_bound {α : Type v}
  (X : α → bounded_homotopy_category A)
  [uniformly_bounded X] :
  has_coproduct X :=
begin
  constructor, apply nonempty.intro,
  refine ⟨cofan X, is_colimit_cofan X⟩,
end

instance is_K_projective_sigma {α : Type v}
  (X : α → bounded_homotopy_category A)
  [uniformly_bounded X]
  [∀ a, homotopy_category.is_K_projective (X a).val] :
  homotopy_category.is_K_projective (sigma_obj X).val :=
begin
  let e : (sigma_obj X) ≅ (cofan X).X :=
    (colimit.is_colimit _).cocone_point_unique_up_to_iso (is_colimit_cofan X),
  let ee := (forget A).map_iso e,
  suffices : homotopy_category.is_K_projective ((forget A).obj (cofan X).X),
  { resetI, apply homotopy_category.is_K_projective_of_iso _ _ ee.symm },
  dsimp [forget, cofan],
  apply_instance,
end

noncomputable
instance forget_preserves_coproduct {α : Type v}
  (X : α → bounded_homotopy_category A)
  [uniformly_bounded X] :
  preserves_colimit (discrete.functor X) (forget A) :=
begin
  apply preserves_colimit_of_preserves_colimit_cocone (is_colimit_cofan X),
  let E : (forget A).map_cocone (cofan X) ≅
    homotopy_category.colimit_cofan (val ∘ X) :=
    cocones.ext (iso.refl _) _,
  rotate,
  { intros a, dsimp [forget, cofan], simpa only [category.comp_id] },
  apply is_colimit.of_iso_colimit _ E.symm,
  apply homotopy_category.is_colimit_cofan,
end

lemma is_quasi_iso_sigma
  [AB4 A]
  {α : Type v}
  (X P : α → bounded_homotopy_category A)
  [uniformly_bounded X]
  [uniformly_bounded P]
  (π : Π a, P a ⟶ X a)
  [∀ a, homotopy_category.is_quasi_iso (π a)] :
  homotopy_category.is_quasi_iso
    (sigma.desc $ λ a : α, π a ≫ sigma.ι X a : sigma_obj P ⟶ sigma_obj X) :=
begin
  let t := sigma.desc (λ (a : α), π a ≫ sigma.ι X a),
  change homotopy_category.is_quasi_iso ((forget A).map t),
  let eP : (forget A).obj (∐ P) ≅ ∐ (λ a, (forget A).obj (P a)) :=
    preserves_colimit_iso (forget A) _,
  let eX : (forget A).obj (∐ X) ≅ ∐ (λ a, (forget A).obj (X a)) :=
    preserves_colimit_iso (forget A) _,
  let s : ∐ (λ a, (forget A).obj (P a)) ⟶ ∐ (λ a, (forget A).obj (X a)) :=
    sigma.desc (λ (a : α), π a ≫ sigma.ι (val ∘ X) a),
  suffices : (forget A).map t = eP.hom ≫ s ≫ eX.inv,
  { rw this,
    apply homotopy_category.is_quasi_iso_comp },
  apply (is_colimit_of_preserves (forget A) (colimit.is_colimit _)).hom_ext,
  swap, apply_instance,
  intros a,
  dsimp [t, s, eP, eX, preserves_colimit_iso, is_colimit.cocone_point_unique_up_to_iso],
  rw [← (forget A).map_comp, colimit.ι_desc],
  slice_rhs 0 1
  { erw (is_colimit_of_preserves (forget A) (colimit.is_colimit (discrete.functor P))).fac },
  erw colimit.ι_desc,
  dsimp, simp only [category.assoc], erw colimit.ι_desc,
  dsimp, simp only [functor.map_comp], refl,
end

variables [enough_projectives A]

noncomputable
def uniform_π {α : Type v}
  (X : α → bounded_homotopy_category A)
  [uniformly_bounded X] : sigma_obj (replace_uniformly X) ⟶ sigma_obj X :=
sigma.desc $ λ a, π_uniformly _ _ ≫ sigma.ι _ a

instance is_quasi_iso_sigma_map_π_uniformly
  [AB4 A]
  {α : Type v}
  (X : α → bounded_homotopy_category A)
  [uniformly_bounded X] :
  homotopy_category.is_quasi_iso (uniform_π X) :=
is_quasi_iso_sigma _ _ _

open opposite

noncomputable
def Ext_coproduct_iso
  [AB4 A]
  {α : Type v}
  (X : α → bounded_homotopy_category A)
  [uniformly_bounded X]
  (i : ℤ) (Y) :
  ((Ext i).obj (op (sigma_obj X))).obj Y ≅
  pi_obj (λ a : α, ((Ext i).obj (op (X a))).obj Y) :=
Ext_iso i _ _ _ (uniform_π X) ≪≫
category_theory.preadditive_yoneda_coproduct_iso (replace_uniformly X) (Y⟦i⟧) ≪≫
category_theory.pi_iso _ _ (λ a, (Ext_iso i _ _ _ (π_uniformly X a)).symm)

lemma ι_Ext_coprodut_iso
  [AB4 A]
  {α : Type v}
  (X : α → bounded_homotopy_category A)
  [uniformly_bounded X]
  (i : ℤ) (Y) (j) :
  (Ext_coproduct_iso X i Y).inv ≫
  ((Ext i).map (sigma.ι X j : X j ⟶ ∐ X).op).app Y =
  pi.π _ _ :=
begin
  rw iso.inv_comp_eq,
  dsimp [Ext_coproduct_iso, pi_iso],
  simp only [category.assoc, limit.lift_π, fan.mk_π_app],
  simp only [← category.assoc], rw iso.eq_comp_inv,
  dsimp [Ext, Ext_iso], --ext t, simp only [comp_apply],
  dsimp [preadditive_yoneda_coproduct_iso, preadditive_yoneda_coproduct_to_product],
  simp only [category.assoc, limit.lift_π],
  ext t, simp only [comp_apply], dsimp,
  simp only [← category.assoc], congr' 1,
  apply lift_ext (∐ X).π, swap, apply_instance,
  dsimp [uniform_π],
  simp,
end

lemma ι_Ext_coproduct_iso'
  [AB4 A]
  {α : Type v}
  (X : α → bounded_homotopy_category A)
  [uniformly_bounded X]
  (i : ℤ) (Y) (j) :
  (Ext_coproduct_iso X i Y).hom ≫  pi.π _ _ =
  ((Ext i).map (sigma.ι X j : X j ⟶ ∐ X).op).app Y :=
begin
  rw [← iso.eq_inv_comp, ι_Ext_coprodut_iso],
end

lemma Ext_coproduct_iso_naturality
  [AB4 A]
  {α : Type v}
  (X₁ X₂ : α → bounded_homotopy_category A)
  [uniformly_bounded X₁]
  [uniformly_bounded X₂]
  (g : X₁ ⟶ X₂)
  (i : ℤ) (Y) :
  ((Ext i).map (sigma.desc (λ b, g b ≫ sigma.ι X₂ b) : ∐ X₁ ⟶ ∐ X₂).op).app Y ≫
  (Ext_coproduct_iso _ _ _).hom =
  (Ext_coproduct_iso _ _ _).hom ≫
  pi.lift (λ b, pi.π _ b ≫ ((Ext i).map (g b).op).app Y) :=
begin
  dsimp only [Ext_coproduct_iso, Ext, Ext0, Ext_iso, functor.comp_map, whiskering_left,
    whisker_left, iso.trans_hom, functor.map_iso, preadditive_yoneda_coproduct_iso,
    functor.flip, pi_iso, as_iso, preadditive_yoneda_coproduct_to_product],
  simp only [category.assoc],
  simp only [quiver.hom.unop_op, iso.op_hom, replacement_iso_hom, iso.op_inv,
    replacement_iso_inv, iso.symm_mk],
  apply limit.hom_ext,
  intros j,
  simp only [category.assoc, limit.lift_π, fan.mk_π_app, limit.lift_π_assoc],
  simp only [← functor.map_comp, ← op_comp],
  congr' 2,
  simp only [category.assoc],
  apply lift_ext (∐ X₂).π, swap, apply_instance,
  dsimp [quiver.hom.unop_op],
  simp only [category.assoc, lift_lifts, lift_lifts_assoc],
  dsimp [uniform_π],
  simp only [colimit.ι_desc_assoc, cofan.mk_ι_app, category.assoc, colimit.ι_desc,
    lift_lifts_assoc],
end

lemma Ext_coproduct_iso_naturality'
  [AB4 A]
  {α : Type v}
  (X : α → bounded_homotopy_category A)
  [uniformly_bounded X]
  (i : ℤ) (Y₁ Y₂) (f : Y₁ ⟶ Y₂) :
  ((Ext i).obj (op (sigma_obj X))).map f ≫
  (Ext_coproduct_iso _ _ _).hom =
  (Ext_coproduct_iso _ _ _).hom ≫
  pi.lift (λ a, pi.π _ a ≫ ((Ext i).obj _).map f) :=
begin
  dsimp only [Ext_coproduct_iso, Ext, Ext0, Ext_iso, functor.comp_map, whiskering_left,
    whisker_left, iso.trans_hom, functor.map_iso, preadditive_yoneda_coproduct_iso,
    functor.flip, pi_iso, as_iso, preadditive_yoneda_coproduct_to_product,
    functor.comp_map, functor.comp_obj],
  simp only [category.assoc],
  simp only [quiver.hom.unop_op, iso.op_hom, replacement_iso_hom, iso.op_inv,
    replacement_iso_inv, iso.symm_mk],
  apply limit.hom_ext,
  intros j,
  simp only [category.assoc, limit.lift_π, fan.mk_π_app, limit.lift_π_assoc],
  erw nat_trans.naturality,
  erw nat_trans.naturality_assoc,
  erw nat_trans.naturality_assoc,
  refl,
end

end bounded_homotopy_category

-- TODO: find better names... And move this stuff!

instance chain_complex_embed_cofan_uniformly_bounded
  {α : Type v}
  (X : α → chain_complex A ℕ) :
  bounded_homotopy_category.uniformly_bounded
  (λ a, chain_complex.to_bounded_homotopy_category.obj (X a)) :=
begin
  constructor, use 1, intros a i hi,
  rcases i with (_|i)|_,
  { exfalso, revert hi, dec_trivial },
  { exact is_zero_zero _, },
  { exfalso, revert hi, dec_trivial }
end

universe u'

def whisker_discrete_functor {α : Type v}
  {C : Type u} {D : Type u'} [category.{v} C] [category.{v} D] (F : C ⥤ D)
  (X : α → C) : discrete.functor X ⋙ F ≅ discrete.functor (F.obj ∘ X) :=
  discrete.nat_iso (λ i, iso.refl _)

noncomputable
lemma preserves_coproducts_aux
  {α : Type v} {C : Type u} {D : Type u'}
  [category.{v} C] [category.{v} D]
  (F : C ⥤ D)
  [has_coproducts_of_shape α C]
  [∀ (X : α → C), has_coproduct (λ a, F.obj (X a))]
  (e : Π (X : α → C), F.obj (∐ X) ≅ ∐ (λ a, F.obj (X a)))
  (he : ∀ (X : α → C) (a : α), F.map (sigma.ι X a) ≫ (e X).hom = sigma.ι _ a) :
  preserves_colimits_of_shape (discrete α) F :=
begin
  constructor, intros K,
  let E : K ≅ discrete.functor K.obj := discrete.nat_iso (λ _, iso.refl _),
  apply preserves_colimit_of_iso_diagram _ E.symm,
  apply preserves_colimit_of_preserves_colimit_cocone (colimit.is_colimit _),
  swap, apply_instance,
  let P := _, change is_colimit P,
  let P' := (cocones.precompose (whisker_discrete_functor F K.obj).inv).obj P,
  suffices : is_colimit P',
  { exact is_colimit.precompose_inv_equiv _ _ this },
  apply is_colimit.of_iso_colimit (colimit.is_colimit _), swap,
  change has_colimit (discrete.functor (λ a : α, F.obj (K.obj a))),
  apply_instance,
  symmetry,
  fapply cocones.ext,
  apply e,
  intros a,
  convert (he (λ b, (K.obj b))) a,
  dsimp [P', whisker_discrete_functor],
  rw category.id_comp,
end

noncomputable
instance homological_complex_embed_preserves_coproducts {α : Type v}
  {M N : Type} (c₁ : complex_shape M) (c₂ : complex_shape N) (e : c₁.embedding c₂) :
  preserves_colimits_of_shape (discrete α)
  (homological_complex.embed e : homological_complex A _ ⥤ _) :=
preserves_coproducts_aux
(homological_complex.embed e : homological_complex A _ ⥤ _)
(λ (X : α → homological_complex A c₁), homological_complex.hom.iso_of_components
(λ i,
begin
  rcases h : e.r i with _ | j,
  { refine homological_complex.embed.X_iso_of_none _ h ≪≫ _,
    refine _ ≪≫ (preserves_colimit_iso (homological_complex.eval A c₂ i) _).symm,
    refine (is_zero.iso_zero _).symm,
    apply is_zero_colimit,
    intros a,
    dsimp,
    exact homological_complex.embed.X_is_zero_of_none _ h },
  { refine homological_complex.embed.X_iso_of_some _ h ≪≫ _,
    refine (preserves_colimit_iso (homological_complex.eval _ _ _) _) ≪≫ _,
    refine _ ≪≫ (preserves_colimit_iso (homological_complex.eval _ _ _) _).symm,
    refine has_colimit.iso_of_nat_iso _,
    refine discrete.nat_iso _,
    intros b,
    dsimp,
    refine (homological_complex.embed.X_iso_of_some _ h).symm }
end) begin
  intros i j h,
  rcases h₁ : e.r i with _ | i';
  rcases h₂ : e.r j with _ | j',
  { apply is_zero.eq_of_src,
    apply homological_complex.embed.X_is_zero_of_none,
    assumption },
  { apply is_zero.eq_of_src,
    apply homological_complex.embed.X_is_zero_of_none,
    assumption },
  { apply is_zero.eq_of_tgt,
    refine is_zero.of_iso _
      (preserves_colimit_iso (homological_complex.eval _ _ _) _),
    apply is_zero_colimit, intros b,
    apply homological_complex.embed.X_is_zero_of_none,
    assumption },
  { simp_rw [h₁, h₂], dsimp,
    simp only [category.assoc],
    rw ← iso.eq_inv_comp,
    dsimp [homological_complex.embed, homological_complex.embed.obj],
    rw homological_complex.embed.d_of_some_of_some (∐ X) h₁ h₂,
    simp only [category.assoc, iso.inv_hom_id_assoc],
    apply (is_colimit_of_preserves (homological_complex.eval A c₁ i') _).hom_ext,
    intros a,
    simp only [functor.map_cocone_ι_app, colimit.cocone_ι, homological_complex.eval_map],
    slice_lhs 1 2 {
      erw (is_colimit_of_preserves (homological_complex.eval A c₁ i') _).fac },
    dsimp,
    simp only [has_colimit.iso_of_nat_iso_ι_hom, discrete.nat_iso_hom_app, iso.symm_hom,
      category.assoc, ι_preserves_colimits_iso_inv, homological_complex.eval_map,
      homological_complex.hom.comm, homological_complex.hom.comm_assoc],
    dsimp,
    rw iso.inv_comp_eq,
    slice_rhs 3 4
    { erw (is_colimit_of_preserves (homological_complex.eval A c₁ j') _).fac },
    dsimp,
    simp only [has_colimit.iso_of_nat_iso_ι_hom, discrete.nat_iso_hom_app, iso.symm_hom,
      category.assoc, ι_preserves_colimits_iso_inv, homological_complex.eval_map],
    slice_rhs 1 3
    { rw ← homological_complex.embed.d_of_some_of_some (X a) h₁ h₂ },
    apply colimit.is_colimit,
    apply_instance, }
    -- still annoying
  end)
begin
  intros X a, ext i,
  rcases h : e.r i with _ | i',
  { apply is_zero.eq_of_tgt,
    refine is_zero.of_iso _
      (preserves_colimit_iso (homological_complex.eval _ _ _) _),
    apply is_zero_colimit, intros b,
    apply homological_complex.embed.X_is_zero_of_none,
    exact h },
  dsimp [homological_complex.hom.iso_of_components],
  simp_rw [h], dsimp,
  simp only [← category.assoc, iso.comp_inv_eq],
  simp_rw [← iso.eq_comp_inv, category.assoc],
  slice_rhs 1 2
  { erw (is_colimit_of_preserves (homological_complex.eval A c₂ i) _).fac },
  dsimp,
  simp only [has_colimit.iso_of_nat_iso_ι_inv, discrete.nat_iso_inv_app, iso.symm_inv,
    category.assoc, ι_preserves_colimits_iso_inv, homological_complex.eval_map],
  apply homological_complex.embed.f_of_some,
end

noncomputable
def embed_coproduct_iso
  {α : Type v}
  (X : α → chain_complex A ℕ) :
  (homological_complex.embed complex_shape.embedding.nat_down_int_up).obj (∐ X) ≅
  (∐ λ (a : α), (homological_complex.embed complex_shape.embedding.nat_down_int_up).obj (X a)) :=
preserves_colimit_iso (homological_complex.embed complex_shape.embedding.nat_down_int_up) _ ≪≫
has_colimit.iso_of_nat_iso (whisker_discrete_functor _ _)

noncomputable
def chain_complex_embed_cofan_iso
  {α : Type v}
  (X : α → chain_complex A ℕ) :
  (bounded_homotopy_category.cofan
    (λ a, chain_complex.to_bounded_homotopy_category.obj (X a))) ≅
    ((cocones.precompose (whisker_discrete_functor _ X).inv).obj
    (chain_complex.to_bounded_homotopy_category.map_cocone
      (colimit.cocone (discrete.functor X)))) :=
cocones.ext
(bounded_homotopy_category.mk_iso $
  (homotopy_category.quotient _ _).map_iso $ (embed_coproduct_iso X).symm)
begin
  intros a,
  dsimp [bounded_homotopy_category.cofan,
    homotopy_category.colimit_cofan, whisker_discrete_functor],
  erw [category.id_comp, ← functor.map_comp],
  congr' 1,
  dsimp [embed_coproduct_iso],
  simp only [category.assoc],
  erw colimit.ι_desc_assoc,
  rw iso.comp_inv_eq,
  erw (is_colimit_of_preserves
    (homological_complex.embed complex_shape.embedding.nat_down_int_up) _).fac,
  dsimp [whisker_discrete_functor],
  rw category.id_comp,
end

noncomputable
instance chain_complex_to_bounded_homotopy_category_preserves_coproducts
  {α : Type v} :
  preserves_colimits_of_shape (discrete α)
  (chain_complex.to_bounded_homotopy_category : chain_complex A _ ⥤ _) :=
begin
  constructor, intros K,
  let E : K ≅ discrete.functor K.obj := discrete.nat_iso (λ _, iso.refl _),
  apply preserves_colimit_of_iso_diagram _ E.symm,
  apply preserves_colimit_of_preserves_colimit_cocone (colimit.is_colimit _),
  let Q : α → bounded_homotopy_category A := λ a,
    chain_complex.to_bounded_homotopy_category.obj (K.obj a),
  let P := _, change is_colimit P,
  let T : discrete.functor K.obj ⋙ chain_complex.to_bounded_homotopy_category ≅
    discrete.functor Q := discrete.nat_iso (λ _, iso.refl _),
  let P' := (cocones.precompose T.inv).obj P,
  suffices : is_colimit P',
  { exact is_colimit.precompose_inv_equiv _ _ this },
  apply is_colimit.of_iso_colimit (bounded_homotopy_category.is_colimit_cofan Q),
  swap, apply_instance,
  apply chain_complex_embed_cofan_iso,
end


import data.fintype.basic
import tactic.derive_fintype
import tactic.linarith
import .finmap

namespace col

inductive ind_vec (σ : Type) : nat → Type
| nil : ind_vec 0
| cons : Π{n : nat}, σ → ind_vec n → ind_vec (n.succ)

def ind_vec.as_list {σ : Type} : ∀{n : nat}, ind_vec σ n → list σ
| _ ind_vec.nil := []
| _ (ind_vec.cons x xs) := x :: xs.as_list

lemma ind_vec.as_list_length {σ : Type} {n : nat} (v : ind_vec σ n) : v.as_list.length = n := begin
  induction v,
  case nil { refl, },
  case cons { simp [ind_vec.as_list, v_ih], },
end

def ind_vec.as_vector {σ : Type} {n : nat} (v : ind_vec σ n) : vector σ n :=
  ⟨v.as_list, v.as_list_length⟩

def list.as_ind_vec {σ : Type} : Π(xs : list σ), ind_vec σ xs.length
| list.nil := ind_vec.nil
| (x :: xs) := ind_vec.cons x xs.as_ind_vec

def vector.as_ind_vec {σ : Type} {n : nat} : vector σ n → ind_vec σ n
| ⟨xs, h⟩ := eq.rec xs.as_ind_vec h

def ind_vec.map {σ τ : Type} : ∀{n : nat}, ind_vec σ n → (σ → τ) → ind_vec τ n
| _ ind_vec.nil _ := ind_vec.nil
| _ (ind_vec.cons x xs) f := ind_vec.cons (f x) (xs.map f)

structure domain :=
  (t_args : nat)

variable {domain_k : Type}
variable {domain_k_finite : fintype domain_k}
variable domains : finmap domain_k domain

inductive atyp (type_bindings : nat)
| binding : fin type_bindings → atyp
| bool : atyp
| int : atyp
| perm : atyp
| ref : atyp
| domain : Π(k : domain_k), ind_vec atyp (domains k).t_args → atyp

def typ := atyp domains 0

mutual def atyp.monomorphize, atyp.monomorphize_all {n : nat} (subs : vector (typ domains) n)

with atyp.monomorphize : atyp domains n → typ domains
| (atyp.binding i) := subs.nth i
| atyp.bool := atyp.bool
| atyp.int := atyp.int
| atyp.perm := atyp.perm
| atyp.ref := atyp.ref
| (atyp.domain k args) := atyp.domain k (atyp.monomorphize_all args)

with atyp.monomorphize_all : ∀{m : nat}, ind_vec (atyp domains n) m → ind_vec (typ domains) m
| 0 ind_vec.nil := ind_vec.nil
| (nat.succ i) (ind_vec.cons t ts) := ind_vec.cons (atyp.monomorphize t) (atyp.monomorphize_all ts)

structure domain_func :=
  (result : (typ domains))
  (args : list (typ domains))

structure function :=
  (result : typ domains)
  (args : list (typ domains))

structure field :=
  (t : typ domains)

structure predicate :=
  (args : list (typ domains))

structure method :=
  (args : list (typ domains))
  (locals : list (typ domains))
  (out_args : list (typ domains))

structure ctx_t
  (domain_k : Type)
  (domain_func_k : Type)
  (func_k : Type)
  (field_k : Type)
  (predicate_k : Type)
  (method_k : Type)
  :=
  [domain_k_finite : fintype domain_k]
  (domains : finmap domain_k domain)
  [domain_func_k_finite : fintype domain_func_k]
  (domain_funcs : finmap domain_func_k (domain_func domains))
  [func_k_finite : fintype func_k]
  (funcs : finmap func_k (function domains))
  [field_k_finite : fintype field_k]
  (fields : finmap field_k (field domains))
  [predicate_k_finite : fintype predicate_k]
  (predicates : finmap predicate_k (predicate domains))
  [method_finite : fintype method_k]
  (methods : finmap method_k (method domains))

variable {domain_func_k : Type}
variable {func_k : Type}
variable {field_k : Type}
variable {predicate_k : Type}
variable {method_k : Type}

variable (ctx : ctx_t domain_k domain_func_k func_k field_k predicate_k method_k)

inductive want
| yes
| no

def want.typ : want → Type
| want.yes := unit
| want.no := empty

structure exp_cfg :=
  (have_heap : want)
  (have_method : want)
  (have_assn : want)
  (have_result : want)
  (type_bindings : nat)

mutual inductive a_exp, domain_inv, func_inv, pred_inv
(ctx : ctx_t domain_k domain_func_k func_k field_k predicate_k method_k)
(cfg : exp_cfg)
(here : cfg.have_method.typ → method_k)

with a_exp : Type
-- pure, heap-independent
| const_bool : bool → a_exp
| const_int : ℤ → a_exp
| domain_apply_indirect : domain_inv → a_exp
| func_apply_indirect : func_inv → a_exp
| and : a_exp → a_exp → a_exp
| implies : a_exp → a_exp → a_exp
| binding : nat → a_exp
| all : (atyp ctx.domains cfg.type_bindings) → a_exp → a_exp
| ex : (atyp ctx.domains cfg.type_bindings) → a_exp → a_exp

-- normal, heap-dependent
| deref : cfg.have_heap.typ → a_exp → field_k → a_exp

-- local
| arg (m : cfg.have_method.typ) : fin (ctx.methods (here m)).args.length → a_exp
| out (m : cfg.have_method.typ) : fin (ctx.methods (here m)).out_args.length → a_exp
| loc (m : cfg.have_method.typ) : fin (ctx.methods (here m)).locals.length → a_exp

-- postcondition result
| result : cfg.have_result.typ → a_exp

-- assertions
| acc_field : cfg.have_assn.typ → a_exp → field_k → a_exp → a_exp
| acc_pred : cfg.have_assn.typ → pred_inv → a_exp → a_exp

with domain_inv : Type
| apply (k : domain_func_k) : ind_vec a_exp (ctx.domain_funcs k).args.length → domain_inv

with func_inv : Type
| apply (k : func_k) : ind_vec a_exp (ctx.funcs k).args.length → func_inv

with pred_inv : Type
| apply (k : predicate_k) : ind_vec a_exp (ctx.predicates k).args.length → pred_inv

def pure_exp (type_bindings : nat) : Type :=
  a_exp ctx { have_heap := want.no, have_method := want.no, have_assn := want.no, have_result := want.no, type_bindings := type_bindings }
    empty.elim

def exp : Type :=
  a_exp ctx { have_heap := want.yes, have_method := want.no, have_assn := want.no, have_result := want.no, type_bindings := 0 }
    empty.elim

def assn (have_result : want) : Type :=
  a_exp ctx { have_heap := want.yes, have_method := want.no, have_assn := want.yes, have_result := have_result, type_bindings := 0 }
    empty.elim

def local_exp (here : method_k) : Type :=
  a_exp ctx { have_heap := want.yes, have_method := want.yes, have_assn := want.no, have_result := want.no, type_bindings := 0 }
    (λ_, here)

def local_assn (here : method_k) : Type :=
  a_exp ctx { have_heap := want.yes, have_method := want.yes, have_assn := want.yes, have_result := want.no, type_bindings := 0 }
    (λ_, here)

structure domain_axiom :=
  (t_args : nat)
  (ax : pure_exp ctx t_args)

structure func_impl :=
  (requires : assn ctx want.no)
  (body : option $ exp ctx)
  (ensures : assn ctx want.yes)

structure predicate_impl :=
  (body : assn ctx want.no)

inductive stat (here : method_k)
| nop : stat
| seqn : list stat → stat
| cond : (local_exp ctx here) → stat → stat → stat
| assign : fin (ctx.methods here).locals.length → (local_exp ctx here) → stat

structure method_impl (here : method_k) :=
  (requires : local_assn ctx here)
  (body : option $ exp ctx)
  (ensures : local_assn ctx here)

structure verification :=
  {domain_k : Type}
  {domain_func_k : Type}
  {func_k : Type}
  {field_k : Type}
  {predicate_k : Type}
  {method_k : Type}

  [domain_k_finite : fintype domain_k]
  [domain_func_k_finite : fintype domain_func_k]
  [func_k_finite : fintype func_k]
  [field_k_finite : fintype field_k]
  [predicate_k_finite : fintype predicate_k]
  [method_finite : fintype method_k]

  (ctx : ctx_t domain_k domain_func_k func_k field_k predicate_k method_k)

  (domain_axioms : list (domain_axiom ctx))
  (func_impls : finmap func_k (func_impl ctx))
  (predicate_impls : finmap predicate_k (predicate_impl ctx))
  (method_impls : Π(k : method_k), method_impl ctx k)

-- typing rules
inductive a_exp.t
(ctx : ctx_t domain_k domain_func_k func_k field_k predicate_k method_k)
(cfg : exp_cfg)
(here : cfg.have_method.typ → method_k)
: (list $ atyp ctx.domains cfg.type_bindings) → (a_exp ctx cfg here) → (atyp ctx.domains cfg.type_bindings) → Prop

| const_bool (vs : (list $ atyp ctx.domains cfg.type_bindings)) (b : bool) : a_exp.t vs (a_exp.const_bool b) atyp.bool
| const_int (vs : (list $ atyp ctx.domains cfg.type_bindings)) (i : ℤ) : a_exp.t vs (a_exp.const_int i) atyp.int
| domain_apply
    (vs : (list $ atyp ctx.domains cfg.type_bindings))
    (k : domain_func_k)
    (args : ind_vec (a_exp ctx cfg here) (ctx.domain_funcs k).args.length)
    (args_ok :
      ∀(i : fin (ctx.domain_funcs k).args.length),
        a_exp.t vs (args.as_vector.nth i)
          ((ctx.domain_funcs k).args.nth_le i i.property))
    : a_exp.t vs (a_exp.domain_apply_indirect (domain_inv.apply k args)) (ctx.domain_funcs k).result
| func_apply
    (vs : (list $ atyp ctx.domains cfg.type_bindings))
    (k : func_k)
    (args : ind_vec (a_exp ctx cfg here) (ctx.funcs k).args.length)
    (args_ok :
      ∀(i : fin (ctx.funcs k).args.length),
        a_exp.t vs (args.as_vector.nth i)
          ((ctx.funcs k).args.nth_le i i.property))
    : a_exp.t vs (a_exp.func_apply_indirect (func_inv.apply k args)) (ctx.funcs k).result
| and (vs : (list $ atyp ctx.domains cfg.type_bindings)) : ∀l r, a_exp.t vs l atyp.bool → a_exp.t vs r atyp.bool → a_exp.t vs (a_exp.and l r) atyp.bool
| implies (vs : (list $ atyp ctx.domains cfg.type_bindings)) : ∀l r, a_exp.t vs l atyp.bool → a_exp.t vs r atyp.bool → a_exp.t vs (a_exp.implies l r) atyp.bool
| binding (vs : (list $ atyp ctx.domains cfg.type_bindings)) (i : nat) (h : i < vs.length) : a_exp.t vs (a_exp.binding i) $ vs.nth_le i h
| all
    (vs : (list $ atyp ctx.domains cfg.type_bindings))
    (v : atyp ctx.domains cfg.type_bindings)
    (e : a_exp ctx cfg here)
  : a_exp.t (v :: vs) e atyp.bool → a_exp.t vs (a_exp.all v e) atyp.bool
| ex
    (vs : (list $ atyp ctx.domains cfg.type_bindings))
    (v : atyp ctx.domains cfg.type_bindings)
    (e : a_exp ctx cfg here)
  : a_exp.t (v :: vs) e atyp.bool → a_exp.t vs (a_exp.ex v e) atyp.bool
| deref
    (vs : (list $ atyp ctx.domains cfg.type_bindings))
    (have_heap : cfg.have_heap.typ)
    (obj : a_exp ctx cfg here)
    (k : field_k)
  : a_exp.t vs obj atyp.ref → a_exp.t vs (a_exp.deref have_heap obj k) (ctx.fields k).t

/-
-- semantics definitions
def objects := nat

structure location :=
  (obj : objects)
  (field : field)

inductive value
| int : ℤ → value
| rat : ℚ → value
| obj : objects → value

structure heap :=
  (mask : location → ℚ)
  (value : location → value)

structure state :=
  (heap : heap)
  (locals : nat → value)

-- semantics
def state.sat : state → exp → Prop := λ s e, match e with
| _ := sorry
end
-/

end col

namespace ex

@[derive fintype]
inductive domain_name
| option

open domain_name

def domains : finmap domain_name col.domain
| option := { t_args := 1 }

@[derive fintype]
inductive method_name
| test

open method_name

def methods : finmap method_name (col.method domains)
| test := { args := [col.atyp.domain option $ col.list.as_ind_vec [col.atyp.int]], locals := [], out_args := [] }

#check methods test

end ex


/-
Copyright 2020 Google LLC

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

      http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
 -/

import order.bounded_lattice

lemma with_top.not_none_lt {α:Type*} [preorder α] (a:with_top α):
  ¬(@has_lt.lt (with_top α) _  (none:with_top α) a):=
begin
  intro A1,
  rw lt_iff_le_not_le at A1,
  cases A1 with A1 A2,
  apply A2,
  apply with_top.le_none,
end

lemma with_top.not_none_le_some {α:Type*} [partial_order α] (a:α):
  ¬(@has_le.le (with_top α) _ (none) (some a)):=
begin
  intro A1,
  have B1:(some a) ≠ (none:with_top α),
  {
    simp,
  },
  have B3:(@has_le.le (with_top α) _ (some a) (none)) := with_top.le_none,
  have B4 := @le_antisymm (with_top α) _ (some a) (none) B3 A1,
  apply B1,
  apply B4
end


import data.vector
import data.equiv.denumerable
import data.list.sort
import ring_theory.tensor_product
import algebra.category.Module.basic

inductive type (cT : Type) : Type
| const : cT → type
| arrow : type → type → type

variables (cT : Type)

@[reducible] def context (cT : Type) : Type := list (string × type cT)

-- instance : has_append (context cT) :=
-- ⟨λ a b : list (string × type cT), list.append b a⟩

variables {cT}

inductive term (ct : type cT → Type) : Π (Γ : context cT) (A : type cT), Type
| const {T : type cT} (t : ct T) : term [] T
| var (a : string) (T : type cT) : term [(a, T)] T
| app (Γ₁ Γ₂ : context cT) {T₁ T₂ : type cT} (f : term Γ₁ (T₁.arrow T₂)) (x : term Γ₂ T₁) :
    term (Γ₁ ++ Γ₂) T₂
| lambda {Γ : context cT} (a : string) (T₁ : type cT) {T₂ : type cT}
    (t : term (Γ ++ [(a, T₁)]) T₂) : term Γ (T₁.arrow T₂)

inductive term2 (ct : type cT → Type) : Π (A : type cT), Type
| const {T : type cT} (t : ct T) : term2 T
| app {T₁ T₂ : type cT} (f : term2 (T₁.arrow T₂)) (x : term2 T₁) : term2 T₂
| id {T₁ : type cT} : term2 (T₁.arrow T₁)
| comp {T₁ T₂ T₃ : type cT} : term2 ((T₁.arrow T₂).arrow ((T₂.arrow T₃).arrow (T₁.arrow T₃)))
| swap {T₁ T₂ T₃ : type cT} : term2 ((T₁.arrow (T₂.arrow T₃)).arrow (T₂.arrow (T₁.arrow T₃)))

def presheaf (ct : type cT → Type) : Type 1 :=
Σ (F : type cT → Type), Π {A B : type cT}, term2 ct (A.arrow B) → F A → F B

namespace presheaf

variable {ct : type cT → Type}

def hom (F G : presheaf ct) : Type :=
Π (A : type cT), F.1 A → G.1 A

def hom.comp {F G H : presheaf ct} (f : hom F G) (g : hom G H) : hom F H :=
λ A, g A ∘ f A

def hom.id (F : presheaf ct) : hom F F := λ _, id

variable (ct)

def yoneda (A : type cT) : presheaf ct :=
⟨λ B, term2 ct (A.arrow B), λ B C f g, term2.app (term2.app term2.comp g) f⟩

variable {ct}

def yoneda_map {A B : type cT} (f : term2 ct (A.arrow B)) : hom (yoneda ct B) (yoneda ct A) :=
λ C, term2.app (term2.app term2.comp f)

def yoneda_full {A B : type cT} (f : hom (yoneda ct B) (yoneda ct A)) :
  term2 ct (A.arrow B) :=
f B term2.id

def sumthing (F : presheaf ct) : presheaf ct :=
⟨λ c, Σ c' : type cT, term2 ct (c'.arrow c) × F.1 c',
  λ A B f a, ⟨a.1, (term2.app term2.comp a.2.1).app f, a.2.2⟩⟩

def to_sumthing (F : presheaf ct) : hom F (sumthing F) :=
λ A a, ⟨A, term2.id, a⟩

def of_sumthing (F : presheaf ct) : hom (sumthing F) F :=
λ A b, F.2 b.2.1 b.2.2

def tensor (F G : presheaf ct) : presheaf ct :=
⟨λ c, Σ c₁ c₂ : type cT, term2 ct (c₁.arrow (c₂.arrow c)) × F.1 c × G.1 c,
  λ A B f x, ⟨x.1, x.2.1, term2.app (term2.app term2.comp x.2.2.1)
      (term2.app (term2.app term2.swap term2.comp) f),
    F.2 f x.2.2.2.1, G.2 f x.2.2.2.2⟩⟩

def tensor_assoc₁ (F G H : presheaf ct) :
  hom (tensor (tensor F G) H) (tensor F (tensor G H)) :=
λ A a, begin
  rcases a with ⟨c₁, c₂, h₁, ⟨c₃, c₄, h₂, f, g⟩, h⟩,
  exact ⟨c₁, c₂, h₁, f, c₃, c₄, h₂, g, h⟩
end

def tensor_assoc (F G H : presheaf ct) :
  hom (tensor F (tensor G H)) (tensor (tensor F G) H) :=
λ A a, begin
  rcases a with ⟨c₁, c₂, h₁, f, c₃, c₄, h₂, g, h⟩,
  exact ⟨c₁, c₂, h₁, ⟨c₃, c₄, h₂, f, g⟩, h⟩
end

def tensor_map {F₁ G₁ F₂ G₂ : presheaf ct} (f : hom F₁ F₂) (g : hom G₁ G₂) :
  hom (tensor F₁ G₁) (tensor F₂ G₂) :=
λ A a, ⟨a.1, a.2.1, a.2.2.1, f _ a.2.2.2.1, g _ a.2.2.2.2⟩

def homp (F G : presheaf ct) : presheaf ct :=
⟨λ c, Σ c₁ c₂ : type cT, term2 ct (c₁.arrow (c₂.arrow c)) → F.1 c → G.1 c,
  sorry⟩

section curry

variables {F G H : presheaf ct}

-- def curryFa (F G H : presheaf ct) : presheaf ct :=
-- ⟨λ A, hom () H, _⟩

-- def currya₁ : hom (homp (tensor F G) H) (homp F (homp G H)) :=

def curry {F G H : presheaf ct} : (hom (tensor F G) H) →
  (hom F (homp G H)) :=
begin
  dsimp [tensor, yoneda, hom, homp] at *,
  exact f _ ⟨x.1, x.2.1, x.2.2, fA, gA⟩
end

end curry

def yoneda_hom (F G : type cT) : yoneda

def id : presheaf ct := ⟨λ _, unit, λ _ _ _, id⟩

def tensor_id₁ (F : presheaf ct) : hom (tensor F id) F :=
λ A a, a.1

def tensor_id₂ (F : presheaf ct) : hom F (tensor F id) :=
λ A a, (a, ())

def id_tensor₂ (F : presheaf ct) : hom F (tensor id F) :=
λ A a, ((), a)

end presheaf

open category_theory

section

inductive type3 (cT : Type) : Type
| const : cT → type3
| arrow : type3 → type3 → type3
| id {} : type3
| tensor : type3 → type3 → type3

def type3.of_type : type cT → type3 cT
| (type.const T) := type3.const T
| (type.arrow T₁ T₂) := type3.arrow (type3.of_type T₁) (type3.of_type T₂)

def contexti : context cT → type3 cT
| []       := type3.id
| (T :: l) := type3.tensor (type3.of_type T.2) (contexti l)

inductive term3 (const_term : type cT → Type) : Π (A : type3 cT), Type
| const {T : type cT} (t : const_term T) : term3 (type3.of_type T)
| id (T : type3 cT) : term3 (T.arrow T)
| curry {T₁ T₂ T₃ : type3 cT} :
  term3 ((((T₁.tensor T₂).arrow T₃)).arrow (T₁.arrow (T₂.arrow T₃)))
| uncurry {T₁ T₂ T₃ : type3 cT} :
  term3 ((T₁.arrow (T₂.arrow T₃)).arrow ((T₁.tensor T₂).arrow T₃))
| tensor_map {T₁ T₂ T₃ T₄ : type3 cT} (f₁ : term3 (T₁.arrow T₃))
  (f₂ : term3 (T₂.arrow T₄)) : term3 ((T₁.tensor T₂).arrow (T₃.tensor T₄))
| tensor_symm {T₁ T₂ : type3 cT} : term3 ((T₁.tensor T₂).arrow (T₂.tensor T₁))
| lid₁ {T : type3 cT} : term3 ((type3.id.tensor T).arrow T)
| lid₂ {T : type3 cT} : term3 (T.arrow (type3.id.tensor T))
| app {T₁ T₂ : type3 cT} (f : term3 (T₁.arrow T₂)) (x : term3 T₁) : term3 T₂
| comp {T₁ T₂ T₃ : type3 cT} (f : term3 (T₁.arrow T₂)) :
  term3 ((T₂.arrow T₃).arrow (T₁.arrow T₃))

namespace term3

variables {const_term : type cT → Type}

def tensor_mk {T₁ T₂ : type3 cT} : term3 const_term (T₁.arrow (T₂.arrow (T₁.tensor T₂))) :=
term3.app term3.curry (term3.id _)

def rid₁ {T : type3 cT} : term3 const_term ((T.tensor type3.id).arrow T) :=
term3.app (term3.comp term3.tensor_symm) term3.lid₁

def rid₂ (T : type3 cT) : term3 const_term (T.arrow (T.tensor type3.id)) :=
term3.app (term3.comp term3.lid₂) term3.tensor_symm

def lift {T : type3 cT} : term3 const_term (T.arrow (type3.id.arrow T)) :=
term3.app term3.curry term3.rid₁

def drop {T : type3 cT} : term3 const_term ((type3.id.arrow T).arrow T) :=
term3.app (term3.comp (term3.rid₂ _))
  (term3.app (term3.uncurry) (term3.id _))

def assoc₁ {T₁ T₂ T₃ : type3 cT} :
  term3 const_term (((T₁.tensor T₂).tensor T₃).arrow (T₁.tensor (T₂.tensor T₃))) :=
term3.app term3.uncurry $ term3.app term3.uncurry $
  term3.app (term3.comp term3.tensor_mk) term3.curry

def assoc₂ {T₁ T₂ T₃ : type3 cT} :
  term3 const_term ((T₁.tensor (T₂.tensor T₃)).arrow ((T₁.tensor T₂).tensor T₃)) :=
term3.app term3.uncurry $ term3.app (term3.comp
  (term3.app term3.curry tensor_mk)) term3.uncurry

def contexti_append₁ : Π (Γ₁ Γ₂ : context cT), term3 const_term
  ((contexti (Γ₁ ++ Γ₂)).arrow ((contexti Γ₁).tensor (contexti Γ₂)))
| []      Γ₂ := lid₂
| (T::Γ₁) Γ₂ := term3.app (term3.comp (term3.tensor_map (term3.id _)
  (contexti_append₁ _ _))) term3.assoc₂

def contexti_append₂ : Π (Γ₁ Γ₂ : context cT), term3 const_term
  (((contexti Γ₁).tensor (contexti Γ₂)).arrow (contexti (Γ₁ ++ Γ₂)))
| []      Γ₂ := lid₁
| (T::Γ₁) Γ₂ := term3.app (term3.comp term3.assoc₁)
  (term3.tensor_map (term3.id _) (contexti_append₂ _ _))

end term3

variables {const_term : type cT → Type}
variables (const_termi : Π {T : type cT}, const_term T → type3 cT)

def termi : Π {Γ : context cT} {A : type cT} (t : term const_term Γ A),
  term3 const_term ((contexti Γ).arrow (type3.of_type A))
| _ A (term.const t) := term3.app term3.lift (term3.const t)
| _ _ (term.var _ A) :=  term3.rid₁
| _ T₂ (@term.app  _ _ Γ₁ Γ₂ T₁ _ f x) :=
term3.app (term3.comp (term3.contexti_append₁ _ _))
  (term3.app term3.uncurry
    (term3.app (term3.comp (termi f))
      (term3.comp (termi x))))
| Γ (type.arrow _ T₂) (term.lambda a T₁ t) :=
term3.app term3.curry
  (term3.app (term3.comp
    (term3.app (term3.comp (term3.tensor_map (term3.id _)
        (term3.rid₂ _))) (term3.contexti_append₂ Γ [(a, T₁)]))) (termi t))

inductive term₃ (const_term : type cT → Type) : Π (A : type cT), Type
| const {T : type cT} (t : const_term T) : term₃ T
| id (T : type cT) : term₃ (T.arrow T)
| app {T₁ T₂ : type cT} (f : term₃ (T₁.arrow T₂)) (x : term₃ T₁) : term₃ T₂
| comp {T₁ T₂ T₃ : type cT} (f : term₃ (T₁.arrow T₂)) :
  term₃ ((T₂.arrow T₃).arrow (T₁.arrow T₃))

end

open term

def const_term : type unit → Type
| (type.arrow (type.const ()) (type.arrow (type.const ()) (type.const ()))) := unit
| _ := empty

def cTi : unit → Module R := λ _, M

include op

def const_termi {T : type unit} (t : const_term T) : typei (@cTi R _ M) T :=
begin
  cases T with _ T₁ T₂; try { apply empty.elim t },
  cases T₁ with _ T₂ T₃; try { apply empty.elim t },
  cases T₁,
  cases T₂ with _ T₁ T₂; try { apply empty.elim t },
  cases T₁ with _ T₁ T₂; try { apply empty.elim t },
  cases T₁,
  cases T₂ with _ T₁ T₂; try { apply empty.elim t },
  exact op
end

omit op

def mult : const_term (type.arrow (type.const ()) (type.arrow (type.const ()) (type.const ()))) := ()

notation `T` := type.const ()

def exmpl₁ : @term unit const_term []
  ((type.const ()).arrow ((type.const ()).arrow ((type.const ()).arrow (type.const ())))) :=
lambda "a" T $
lambda "b" T $
lambda "c" T $
  app [("a", T), ("b", T)] [("c", T)]
  (app [] [("a", T), ("b", T)] (const mult)
    (app [("a", T)] [("b", T)]
      (app [] [("a", T)] (const mult) (var "a" (type.const ())))
        (var "b" (type.const ()))) : _)
    (var "c" (type.const ()))

example (p q r : M) :
  termi (@cTi R _ M) (@const_termi _ _ _ op) exmpl₁ = 0 :=
begin
  dunfold exmpl₁,
  simp[termi],
  dsimp [typei, contexti, contexti_append, cTi, const_termi],
  ext,
  simp,

end


/-
Copyright (c) 2018 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Simon Hudon
-/
import data.pfun

namespace roption
variables {α : Type*} {β : Type*} {γ : Type*}

open function
lemma assert_if_neg {p : Prop}
  (x : p → roption α)
  (h : ¬ p)
: assert p x = roption.none :=
by { dsimp [assert,roption.none],
     have : (∃ (h : p), (x h).dom) ↔ false,
     { split ; intros h' ; repeat { cases h' with h' },
       exact h h' },
     congr,
     repeat { rw this <|> apply hfunext },
     intros h h', cases h', }

lemma assert_if_pos {p : Prop}
  (x : p → roption α)
  (h : p)
: assert p x = x h :=
by { dsimp [assert],
     have : (∃ (h : p), (x h).dom) ↔ (x h).dom,
     { split ; intros h'
       ; cases h' <|> split
       ; assumption, },
     cases hx : x h, congr, rw [this,hx],
     apply hfunext, rw [this,hx],
     intros, simp [hx] }

@[simp]
lemma roption.none_bind {α β : Type*} (f : α → roption β)
: roption.none >>= f = roption.none :=
by simp [roption.none,has_bind.bind,roption.bind,assert_if_neg]

end roption


import Radon.LC_comparison

open_locale nnreal big_operators classical

noncomputable theory

open category_theory
open category_theory.limits
open topological_space

local attribute [instance]
  locally_constant.seminormed_add_comm_group
  locally_constant.pseudo_metric_space

namespace Profinite

/--
This is the cone which will exhibit `X.Radon_LC p c` as the limit of `T.Radon_LC p c`
where `T` varies over the discrete quotients of `X`.
-/
def Radon_LC_cone (X : Profinite.{0}) (p c : ℝ≥0) [fact (0 < p)] :
  cone (X.diagram ⋙ Radon_LC_functor p c) :=
(Radon_LC_functor p c).map_cone X.as_limit_cone

namespace is_limit_Radon_LC_cone

variables (X : Profinite.{0}) (p c : ℝ≥0) [fact (0 < p)]

/-- An auxiliary definition to be used in the constructions below. -/
def linear_map (S : cone (X.diagram ⋙ Radon_LC_functor p c)) (t : S.X) :
  locally_constant X ℝ →ₗ[ℝ] ℝ :=
{ to_fun := λ e, (S.π.app e.discrete_quotient t).1 e.locally_constant_lift,
  map_add' := begin
    intros e₁ e₂,
    let W₁ := e₁.discrete_quotient,
    let W₂ := e₂.discrete_quotient,
    let W₁₂ := (e₁ + e₂).discrete_quotient,
    let W := W₁ ⊓ W₂ ⊓ W₁₂,
    let π₁ : W ⟶ W₁ := hom_of_le (le_trans inf_le_left inf_le_left),
    let π₂ : W ⟶ W₂ := hom_of_le (le_trans inf_le_left inf_le_right),
    let π₁₂ : W ⟶ W₁₂ := hom_of_le inf_le_right,
    rw [← S.w π₁, ← S.w π₂, ← S.w π₁₂],
    dsimp [Radon_LC_functor, map_Radon_LC, weak_dual.comap, continuous_map.comap_LC],
    erw ← ((S.π.app W) t).1.map_add, congr' 1,
    ext ⟨⟩, refl
  end,
  map_smul' := begin
    intros r e,
    let W₁ := e.discrete_quotient,
    let W₂ := (r • e).discrete_quotient,
    let W := W₁ ⊓ W₂,
    let π₁ : W ⟶ W₁ := hom_of_le inf_le_left,
    let π₂ : W ⟶ W₂ := hom_of_le inf_le_right,
    rw [← S.w π₁, ← S.w π₂],
    dsimp [Radon_LC_functor, map_Radon_LC, weak_dual.comap, continuous_map.comap_LC],
    rw ← smul_eq_mul,
    erw ← ((S.π.app W) t).1.map_smul, congr' 1,
    ext ⟨⟩, refl
  end }

variables [fact (p ≤ 1)]

/-- An auxiliary definition to be used in the constructions below. -/
def weak_dual (S : cone (X.diagram ⋙ Radon_LC_functor p c)) (t : S.X) :
  weak_dual ℝ (locally_constant X ℝ) :=
linear_map.mk_continuous_of_exists_bound (linear_map X p c S t)
begin
  use c^(1/(p : ℝ)),
  intros e,
  suffices : ∥ linear_map X p c S t e ∥₊ ≤ c^(1/(p : ℝ)) * ∥ e ∥₊,
    by exact_mod_cast this,
  have hp : 0 < (p : ℝ) := by exact_mod_cast (fact.out (0 < p)),
  have hp' : (p : ℝ) ≠ 0,
  { exact ne_of_gt hp },
  rw [← nnreal.rpow_le_rpow_iff hp, nnreal.mul_rpow, ← nnreal.rpow_mul],
  rw [(show 1 / (p : ℝ) * p = 1, by field_simp), nnreal.rpow_one],
  have H := ((S.π.app e.discrete_quotient) t).2 ⊥,
  replace H := mul_le_mul H (le_refl (∥e∥₊^(p : ℝ))) (zero_le _) (zero_le _),
  refine le_trans _ H,
  rw [mul_comm, finset.mul_sum],
  nth_rewrite 0 e.eq_sum,
  simp_rw [linear_map.map_sum, linear_map.map_smul],
  refine le_trans (real.pow_nnnorm_sum_le _ _ _) _,
  have : ∑ (x : (⊥ : discrete_quotient e.discrete_quotient)),
    ∥e∥₊ ^ (p : ℝ) * ∥(((S.π.app e.discrete_quotient) t).val)
    ((⊥ : discrete_quotient e.discrete_quotient).fibre x).indicator_LC∥₊ ^ (p : ℝ) =
    ∑ (x : e.discrete_quotient), ∥e∥₊^(p : ℝ) *
      ∥ (linear_map X p c S t) (e.discrete_quotient.fibre x).indicator_LC ∥₊^(p : ℝ),
  { fapply finset.sum_bij',
    { intros a _, exact discrete_quotient.equiv_bot.symm a },
    { intros, exact finset.mem_univ _ },
    { intros, congr' 3, dsimp [linear_map],
      let T₁ := e.discrete_quotient,
      let T₂ := (e.discrete_quotient.fibre
        ((discrete_quotient.equiv_bot.symm) a)).indicator_LC.discrete_quotient,
      let T := T₁ ⊓ T₂,
      let π₁ : T ⟶ T₁ := hom_of_le inf_le_left,
      let π₂ : T ⟶ T₂ := hom_of_le inf_le_right,
      rw [← S.w π₁, ← S.w π₂],
      dsimp [Radon_LC_functor, map_Radon_LC, weak_dual.comap],
      congr' 1,
      ext b, obtain ⟨b,rfl⟩ := discrete_quotient.proj_surjective _ b,
      dsimp [continuous_map.comap_LC],
      change _ =
        (e.discrete_quotient.fibre ((discrete_quotient.equiv_bot.symm) a)).indicator_LC b,
      dsimp only [topological_space.clopens.indicator_LC_apply],
      rw (show X.fintype_diagram.map π₁ (T.proj b) = T₁.proj b, by refl),
      erw discrete_quotient.mem_fibre_iff' },
    { intros a _, exact discrete_quotient.equiv_bot a },
    { intros, exact finset.mem_univ _ },
    { intros, apply equiv.apply_symm_apply },
    { intros, apply equiv.symm_apply_apply } },
  rw this, clear this,
  apply finset.sum_le_sum, rintros x -,
  rw [smul_eq_mul, nnnorm_mul, nnreal.mul_rpow],
  refine mul_le_mul _ (le_refl _) (zero_le _) (zero_le _),
  apply nnreal.rpow_le_rpow _ (le_of_lt hp),
  obtain ⟨x,rfl⟩ := discrete_quotient.proj_surjective _ x,
  change ∥ e x ∥₊ ≤ _,
  apply locally_constant.nnnorm_apply_le_nnnorm,
end

/-- An auxiliary definition to be used in the constructions below. -/
def Radon_LC (S : cone (X.diagram ⋙ Radon_LC_functor p c)) (t : S.X) :
  X.Radon_LC p c :=
{ val := weak_dual X p c S t,
  property := begin
    intros T,
    dsimp [weak_dual, linear_map],
    convert (S.π.app T t).2 ⊥ using 1,
    fapply finset.sum_bij',
    { intros a _, exact discrete_quotient.equiv_bot a },
    { intros, apply finset.mem_univ },
    { intros a ha, congr' 2,
      let W := (T.fibre a).indicator_LC.discrete_quotient,
      let E := T ⊓ W,
      let π₁ : E ⟶ T := hom_of_le inf_le_left,
      let π₂ : E ⟶ W := hom_of_le inf_le_right,
      rw [← S.w π₁, ← S.w π₂],
      dsimp [Radon_LC_functor, map_Radon_LC, weak_dual.comap,
        continuous_map.comap_LC],
      congr' 1, ext b, obtain ⟨b,rfl⟩ := discrete_quotient.proj_surjective _ b,
      change (T.fibre a).indicator_LC b = _,
      dsimp [topological_space.clopens.indicator_LC_apply],
      erw discrete_quotient.mem_fibre_iff },
    { intros a _, exact discrete_quotient.equiv_bot.symm a },
    { intros, apply finset.mem_univ },
    { intros, apply equiv.symm_apply_apply },
    { intros, apply equiv.apply_symm_apply }
  end }

lemma continuous_Radon_LC (S : cone (X.diagram ⋙ Radon_LC_functor p c)) :
  continuous (Radon_LC X p c S) :=
begin
  apply continuous.subtype_mk,
  apply weak_dual.continuous_of_continuous_eval,
  intros e, dsimp [weak_dual, linear_map],
  refine continuous.comp (weak_dual.eval_continuous _) _,
  refine continuous.comp continuous_subtype_coe (continuous_map.continuous _),
end

end is_limit_Radon_LC_cone

/-- `X.Radon_LC_cone p c` is a limit cone, as promised. -/
def is_limit_Radon_LC_cone (X : Profinite.{0}) (p c : ℝ≥0) [fact (0 < p)] [fact (p ≤ 1)] :
  is_limit (X.Radon_LC_cone p c) :=
{ lift := λ S, ⟨is_limit_Radon_LC_cone.Radon_LC X p c S,
    is_limit_Radon_LC_cone.continuous_Radon_LC X p c S⟩,
  fac' := begin
    intros S T, ext t e,
    dsimp [Radon_LC_cone, Radon_LC_functor, map_Radon_LC,
      is_limit_Radon_LC_cone.weak_dual, is_limit_Radon_LC_cone.Radon_LC,
      weak_dual.comap, is_limit_Radon_LC_cone.linear_map],
    let W₁ := ((continuous_map.comap_LC (X.as_limit_cone.π.app T)) e).discrete_quotient,
    let W := W₁ ⊓ T,
    let π₁ : W ⟶ W₁ := hom_of_le inf_le_left,
    let π₂ : W ⟶ T := hom_of_le inf_le_right,
    rw [← S.w π₁, ← S.w π₂],
    dsimp [Radon_LC_functor, map_Radon_LC, weak_dual.comap],
    congr' 1, ext ⟨⟩, refl,
  end,
  uniq' := begin
    intros S m hm,
    ext t T,
    specialize hm T.discrete_quotient,
    apply_fun (λ e, (e t).1 T.locally_constant_lift) at hm,
    convert hm using 1,
    dsimp [is_limit_Radon_LC_cone.Radon_LC, is_limit_Radon_LC_cone.weak_dual,
      Radon_LC_cone, Radon_LC_functor, map_Radon_LC, weak_dual.comap],
    congr' 1, ext, refl,
  end }

.

instance compact_space_Radon_LC_of_discrete_quotient (X : Profinite.{0}) (p c : ℝ≥0)
  [fact (0 < p)] [fact (p ≤ 1)] (T : discrete_quotient X) :
  compact_space (Radon_LC (X.diagram.obj T) p c) :=
begin
  change compact_space ((X.diagram ⋙ Radon_LC_functor p c).obj T),
  let e := Top.homeo_of_iso ((Radon_LC_comparison X p c).app T),
  haveI : compact_space
    ((X.fintype_diagram ⋙ real_measures.functor p ⋙ CompHausFiltPseuNormGrp₁.level.obj c
    ⋙ CompHaus_to_Top).obj T),
  { change compact_space ((X.fintype_diagram ⋙ real_measures.functor p
      ⋙ CompHausFiltPseuNormGrp₁.level.obj c).obj T), apply_instance },
  exact e.symm.compact_space,
end

/-- An auxiliary definition to be used in the constructions below. -/
def Radon_LC_CompHaus_diagram (X : Profinite.{0}) (p c : ℝ≥0)
  [fact (0 < p)] [fact (p ≤ 1)] :
  discrete_quotient X ⥤ CompHaus.{0} :=
{ obj := λ T, CompHaus.of $ (X.diagram.obj T).Radon_LC p c,
  map := λ S T e, (Radon_LC_functor p c).map $ X.diagram.map e,
  map_id' := begin
    intros T,
    rw X.diagram.map_id,
    rw (Radon_LC_functor p c).map_id,
    refl,
  end,
  map_comp' := begin
    intros S T W f g,
    rw X.diagram.map_comp,
    rw (Radon_LC_functor p c).map_comp,
    refl,
  end }

instance compact_space_Radon_LC (X : Profinite.{0}) (p c : ℝ≥0)
  [fact (0 < p)] [fact (p ≤ 1)] :
  compact_space (X.Radon_LC p c) :=
begin
  let e₁ : X.Radon_LC p c ≅ limit (X.diagram ⋙ Radon_LC_functor p c) :=
    (X.is_limit_Radon_LC_cone p c).cone_point_unique_up_to_iso (limit.is_limit _),
  let e₂ :
    CompHaus_to_Top.obj (limit $ X.Radon_LC_CompHaus_diagram p c) ≅
    limit (X.diagram ⋙ Radon_LC_functor p c)  :=
    (is_limit_of_preserves CompHaus_to_Top (limit.is_limit _)).cone_point_unique_up_to_iso
    (limit.is_limit _),
  let e := Top.homeo_of_iso (e₂ ≪≫ e₁.symm),
  haveI : compact_space
    (CompHaus_to_Top.obj (limit $ X.Radon_LC_CompHaus_diagram p c)),
  { show compact_space ↥((limit $ X.Radon_LC_CompHaus_diagram p c)), apply_instance },
  exact e.compact_space,
end

/-- An auxiliary definition to be used in the constructions below. -/
def Radon_LC_CompHaus_functor (p c : ℝ≥0)
  [fact (0 < p)] [fact (p ≤ 1)] :
  Profinite.{0} ⥤ CompHaus.{0} :=
{ obj := λ X, CompHaus.of $ X.Radon_LC p c,
  map := λ X Y f, (Radon_LC_functor p c).map f,
  map_id' := (Radon_LC_functor p c).map_id,
  map_comp' := λ X Y Z f g, (Radon_LC_functor p c).map_comp f g }

/--
This is the cone which will exhibit `X.Radon_LC p c` as the limit of `T.Radon_LC p c`
where `T` varies over the discrete quotients of `X`.
This is a variant of `X.Radon_LC_cone` taking values in `CompHaus` as opposed to `Top`.
-/
def Radon_LC_CompHaus_cone (X : Profinite.{0}) (p c : ℝ≥0) [fact (0 < p)] [fact (p ≤ 1)] :
  cone (X.diagram ⋙ Radon_LC_CompHaus_functor p c) :=
(Radon_LC_CompHaus_functor p c).map_cone X.as_limit_cone

/--
`X.Radon_LC_CompHaus_cone p c` is a limit cone, as promised.
This is another key construction which will be used in the main comparison between
Radon measures and `ℳ_p`.
-/
def is_limit_Radon_LC_CompHaus_cone (X : Profinite.{0}) (p c : ℝ≥0) [fact (0 < p)] [fact (p ≤ 1)] :
  is_limit (X.Radon_LC_CompHaus_cone p c) :=
begin
  apply is_limit_of_reflects CompHaus_to_Top,
  apply is_limit_Radon_LC_cone,
end

end Profinite


import tactic
import tactic.induction

import .base .bounded .determinacy .induct

noncomputable theory
open_locale classical

def A_trapped_in_for {pw : ℕ} (a : A pw) (d : D) (B : set Point) :=
all_b a d (λ b, b.A ∈ B)

lemma exi_ma_inf_n_of_exi_A {pw : ℕ} {d : D} {s s' : State} {hs}
  (h₁ : ∀ (n : ℕ), ∃ (a : A pw), ((init_game a d s).play n).act)
  (h₂ : s' = apply_D_move s (d.f s hs).m) :
  ∃ (ma : Valid_A_move pw s'.board),
  {n : ℕ | ∃ (a : A pw) hs' hvm, a.f s' hs' hvm = ma ∧
  ((init_game a d s).play n).act}.infinite :=
begin
  fapply exi_set_infinite_of_forall_exi_P_nat, rintro n,
  obtain ⟨a, h₃⟩ := h₁ n, obtain ⟨a₁, h₄⟩ := h₁ 1, have hs' : s'.act,
  { subst h₂, assumption },
  have hvm : A_has_valid_move pw s'.board,
  { rw [play_1, play_move_at_act] at h₄, swap, { assumption },
    have h₅ : play_D_move_at (init_game a₁ d s) hs = init_game a₁ d s',
    { subst h₂, refl },
    rw [h₅, play_A_move_at] at h₄, clear h₅, split_ifs at h₄ with h₅,
    { exact h₅.2 },
    { cases h₄ }},
  exact ⟨a.f s' hs' hvm, a, hs', hvm, rfl, h₃⟩,
end

lemma exi_A_forall_n_play_act_of_swap {pw : ℕ} {d : D} {s : State}
  (h : ∀ (n : ℕ), ∃ (a : A pw), ((init_game a d s).play n).act) :
  ∃ (a : A pw), ∀ (n : ℕ), ((init_game a d s).play n).act :=
begin
  apply @exi_A_wins_of_invariant (λ s, ∀ (n : ℕ), ∃ (a : A pw),
    ((init_game a d s).play n).act); assumption <|> clear h; dsimp,
  { rintro s h₁, specialize h₁ 0, exact h₁.some_spec },
  { rintro s s' hs h₁ h₂, obtain ⟨ma, hma⟩ := exi_ma_inf_n_of_exi_A h₁ h₂,
    use ma, rintro n, obtain ⟨k, h₃, a, hs', hvm, hh, h₄⟩ := exi_ge_of_set_inf hma,
    use a, convert_to ((init_game a d s).play (n + 1)).act,
    { rw [play_add', play_1], congr, symmetry, ext,
      { exact play_move_at_players_eq.1 },
      { exact play_move_at_players_eq.2 },
      { have h₅ := act_of_act_play h₄, rw play_move_at_act h₅,
        have h₆ : play_D_move_at (init_game a d s) h₅ = init_game a d s',
        { ext; try { refl }, exact h₂.symm },
        rw [h₆, play_A_move_at, dif_pos], clear h₆, swap, { exact ⟨hs', hvm⟩ },
        change apply_A_move s' (a.f s' _ _).m = apply_A_move s' ma.m, congr' }},
    exact act_play_le h₃ h₄ },
end

lemma D_wins_n_of_D_hws {pw : ℕ}
  (h : D_hws pw) :
  ∃ (n : ℕ) (d : D), ∀ (a : A pw),
  D_wins_in a d n :=
begin
  contrapose! h, rw forall_swap at h, change ∀ (d : D) (n : ℕ), _ at h,
  simp_rw [D_wins_in, simulate] at h, push_neg at h, rw [D_hws, D_hws_at],
  push_neg, intro d, specialize h d,
  replace h : ∀ (n : ℕ), ∃ (a : A pw), ((init_game a d state₀).play n).act,
  { intro n, specialize h n, cases h with a h, use a, rcases h with ⟨k, h₁, h₂⟩,
    obtain ⟨k, rfl⟩ := nat.exists_eq_add_of_le h₁, apply act_play_le h₁ h₂ },
  simp_rw Game.D_wins, push_neg, exact exi_A_forall_n_play_act_of_swap h,
end

lemma A_bounded_n_pw {pw n k : ℕ} {a : A pw} {d : D}
  (h : k ≤ n) :
  (simulate a d k).s.board.A ∈ bounded (n * pw) :=
begin
  induction k with k ih generalizing n,
  { apply nat.zero_le },
  { rw simulate at ih ⊢, rw play_at_succ',
    let g₁ : Game pw := _, change (init_game a d state₀).play k with g₁ at ih ⊢,
    rw Game.play_move, split_ifs with h₁, swap, { exact ih (nat.le_of_succ_le h) },
    rw play_A_move_at, split_ifs with h₂,
    { let s' := (play_D_move_at g₁ h₁).s,
      change (apply_A_move_b s'.board (g₁.a.f _ _ _).m).A ∈ _,
      rw apply_A_move_b, dsimp, generalize_proofs h₃,
      let ma := g₁.a.f s' h₁ h₃, change ma.m ∈ _, have h₄ := ma.h.2.1,
      have h₅ : s'.board.A = g₁.s.board.A := apply_D_move_A_eq,
      rw h₅ at h₄, clear h₅, cases n, { cases h }, rw nat.succ_le_succ_iff at h,
      specialize ih h, change _ ≤ _ at ih, change _ ≤ _, rw nat.succ_mul,
      transitivity dist ma.m g₁.s.board.A + dist g₁.s.board.A center,
      { exact dist_triangle },
      { rw add_comm, exact add_le_add ih h₄ }},
    { have h₃ : (play_D_move_at g₁ h₁).finish.s.board.A = g₁.s.board.A,
      { exact apply_D_move_A_eq },
      rw h₃, exact ih (nat.le_of_succ_le h) }},
end

lemma lem_2_1 {pw : ℕ}
  (h : D_hws pw) :
  ∃ (N : ℕ) (d : D), ∀ (a : A pw),
  A_trapped_in_for a d (bounded N) :=
begin
  obtain ⟨n, d, h₁⟩ := D_wins_n_of_D_hws h,
  use [n * pw, d], intro a, specialize h₁ a, intro k,
  have h₂ := h₁ _ (le_refl _), by_cases h₃ : n ≤ k,
  { have h₄ := h₁ _ h₃, have h₅ := simulate_eq_of_not_act h₄ h₂,
    rw h₅, clear' k h₁ h₂ h₃ h₄ h₅, exact A_bounded_n_pw (le_refl _) },
  { push_neg at h₃, exact A_bounded_n_pw (le_of_lt h₃) },
end