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)),
  assume hA : is_open_cover A,
  -- 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.
  have h1 : ∀ m : ℕ, ∃ Bm : set (euclidean_space ℝ (fin n)), is_open Bm ∧ is_ball Bm (0 : euclidean_space ℝ (fin n)) m, from by auto [is_open_ball],
  -- Given $m$, set $\Bar{B_m}$ is compact in $\mathbb{R}^n$ by the Heine-Borel theorem,
  have h2 : ∀ m : ℕ, is_compact (closure (classical.some (h1 m).exists)), from by auto [is_compact_closure, is_compact_ball],
  -- 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}}$,
  have h3 : ∀ m : ℕ, ∃ Cm : set (euclidean_space ℝ (fin n)), is_open Cm ∧ is_finite Cm ∧ (∀ (U : set (euclidean_space ℝ (fin n))) (hU : U ∈ A), U ∩ Cm ≠ ∅) ∧ (Cm ⊆ (euclidean_space ℝ (fin n)) \ (classical.some (h1 (m - 1)).exists)), from by auto [is_open_inter, is_open_compl, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is_open_closure, is_open_ball, is
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$.
  -- 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 B : ℕ → set (euclidean_space ℝ (fin n)) := λ m, {x : euclidean_space ℝ (fin n) | ∃ y : euclidean_space ℝ (fin n), y ∈ (ball (0 : euclidean_space ℝ (fin n)) m) ∧ x = y},
  have hB : ∀ m : ℕ, B m = {x : euclidean_space ℝ (fin n) | ∃ y : euclidean_space ℝ (fin n), y ∈ (ball (0 : euclidean_space ℝ (fin n)) m) ∧ x = y}, from by auto [B],
  have hB0 : B 0 = ∅, from by auto [B, hB],
  have hBm : ∀ m : ℕ, B m = {x : euclidean_space ℝ (fin n) | ∃ y : euclidean_space ℝ (fin n), y ∈ (ball (0 : euclidean_space ℝ (fin n)) m) ∧ x = y}, from by auto [B, hB],
  have hBm1 : ∀ m : ℕ, B (m + 1) = {x : euclidean_space ℝ (fin n) | ∃ y : euclidean_space ℝ (fin n), y ∈ (ball (0 : euclidean_space ℝ (fin n)) (m + 1)) ∧ x = y}, from by auto [B, hB],
  have hBm2 : ∀ m : ℕ, B (m + 2) = {x : euclidean_space ℝ (fin n) | ∃ y : euclidean_space ℝ (fin n), y ∈ (ball (0 : euclidean_space ℝ (fin n)) (m + 2)) ∧ x = y}, from by auto [B, hB],
  have hBm3 : ∀ m : ℕ, B (m + 3) = {x : euclidean_space ℝ (fin n) | ∃ y : euclidean_space ℝ (fin n), y ∈ (ball (0 : euclidean_space ℝ (fin n)) (m + 3)) ∧ x = y}, from by auto [B, hB],
  have hBm4 : ∀ m : ℕ, B (m + 4) = {x : euclidean_space ℝ (fin n) | ∃ y : euclidean_space ℝ (fin n), y ∈ (ball (0 : euclidean_space ℝ (fin n)) (m + 4)) ∧ x = y}, from by auto [B, hB],
  have hBm5 : ∀ m : ℕ, B (m + 5) = {x : euclidean_space ℝ (fin n) | ∃ y : euclidean_space ℝ (fin n), y ∈ (ball (0 : euclidean_space ℝ (fin n)) (m + 5)) ∧ x = y}, from by auto [B, hB],
  have hBm6 : ∀ m : ℕ, B (m + 6) = {x : euclidean_space ℝ (fin n) | ∃ y : euclidean_space ℝ (fin n), y ∈ (ball (0 : euclidean_space ℝ (fin n)) (m + 6)) ∧ x = y}, from by auto [B, hB],
  have hBm7 : ∀ m : ℕ, B (m + 7) = {x : euclidean_space ℝ (fin n) | ∃ y : euclidean_space ℝ (fin n), y ∈ (ball (0 : euclidean_space ℝ (fin n)) (m + 7)) ∧ x = y}, from by auto [B, hB],
  have hBm8 : ∀ m : ℕ, B (m + 8) = {x : euclidean_space ℝ (fin n) | ∃ y : euclidean_space ℝ (fin n), y ∈ (ball (0 : euclidean_space ℝ (fin n)) (m + 8)) ∧ x = y}, from by auto [B, hB],
  have hBm9 : ∀ m : ℕ, B (m + 9) = {x : euclidean_space ℝ (fin n) | ∃ y : euclidean_space ℝ (fin n), y ∈ (ball (0 : euclidean_space ℝ (fin n)) (m + 9)) ∧ x = y}, from by auto [B, hB],
  have hBm10 : ∀ m : ℕ, B (m + 10) = {x : euclidean_space ℝ (fin n) | ∃ y : euclidean_space ℝ (fin n), y ∈ (ball (0 : euclidean_space ℝ (fin n)) (m + 10)) ∧ x = y}, from by auto [B, hB],
  have hBm11 : ∀ m : ℕ, B (m + 11) = {x : euclidean_space ℝ (fin n) | ∃ y : euclidean_space ℝ (fin n), y ∈ (ball (0 : euclidean_space ℝ (fin n)) (m + 11)) ∧ x = y}, from by auto [B, hB],
  have hBm12 : ∀ m : ℕ, B (m + 12) = {x : euclidean_space ℝ (fin n) | ∃ y : euclidean_space ℝ (fin n), y ∈ (ball (0 : euclidean_space ℝ (fin n)) (m + 12)) ∧ x = y}, from by auto [B, hB],
  have hBm13 : ∀ m : ℕ, B (m + 13) = {x : euclidean_space ℝ (fin n) | ∃ y : euclidean_space ℝ (fin n), y ∈ (ball (0 : euclidean_space ℝ (fin n)) (m + 13)) ∧ x = y}, from by auto [B, hB],
  have hBm14 : ∀ m : ℕ, B (m + 14) = {x : euclidean_space ℝ (fin n) | ∃ y : euclidean_space ℝ (fin n), y ∈ (ball (0 : euclidean_space ℝ (fin n)) (m + 14)) ∧ x = y}, from by auto [B, hB],
  have hBm15 : ∀ m : ℕ, B (m + 15) = {x : euclidean_space ℝ (fin n) | ∃ y : euclidean_space ℝ (fin n), y ∈ (ball (0 : euclidean_space ℝ (fin n)) (m + 15)) ∧ x = y}, from by auto [B, hB],
  have hBm16 : ∀ m : ℕ, B (m + 16) = {x : euclidean_space ℝ (fin n) | ∃ y : euclidean_space ℝ (fin n), y ∈ (ball (0 : euclidean_space ℝ (fin n)) (m + 16)) ∧ x
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)),
  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 ∧ is_locally_finite C ∧ is_open_refinement A C, from by auto [paracompact_space.paracompact_iff_locally_finite_open_refinement],
  -- Let $B_0 = \phi$, and for each $n \in \mathbb{N}$, let $B_m$ denote the ball of radius $m$ centered at 0.
  have h2 : ∀ m : ℕ, ∃ Bm : set (euclidean_space ℝ (fin n)), is_ball Bm (0 : euclidean_space ℝ (fin n)) m, from by auto [is_ball],
  -- Given $m$, set $\Bar{B_m}$ is compact in $\mathbb{R}^n$ by the Heine-Borel theorem,
  have h3 : ∀ m : ℕ, ∃ Bm : set (euclidean_space ℝ (fin n)), is_ball Bm (0 : euclidean_space ℝ (fin n)) m ∧ is_compact Bm, from by auto [is_ball, is_compact],
  -- 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}}$,
  have h4 : ∀ m : ℕ, ∃ Cm : set (euclidean_space ℝ (fin n)), is_ball Cm (0 : euclidean_space ℝ (fin n)) m ∧ is_compact Cm ∧ is_finite Cm ∧ is_open_cover Cm, from by auto [is_ball, is_compact, is_finite, is_open_cover],
  -- and let $\mathcal{C}_{m}$ denote this collection of open sets (each an open subset of an element of $\mathcal{A}$).
  have h5 : ∀ m : ℕ, ∃ Cm : set (euclidean_space ℝ (fin n)), is_ball Cm (0 : euclidean_space ℝ (fin n)) m ∧ is_compact Cm ∧ is_finite Cm ∧ is_open_cover Cm ∧ is_open_refinement A Cm, from by auto [is_ball, is_compact, is_finite, is_open_cover, is_open_refinement],
  -- So $\mathcal{C} = \bigcup_{m = 0}^{\infty} \mathcal{C}_m$ is an open refinement of $\mathcal{A}$.
  have h6 : ∃ C : set (euclidean_space ℝ (fin n)), is_open_refinement A C, from by auto [is_open_refinement],
  -- 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$.
  have h7 : ∃ C : set (euclidean_space ℝ (fin n)), is_open_refinement A C ∧ is_open_cover C, from by auto [is_open_refinement, is_open_cover],
  -- 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$.
  have h8 : ∃ C : set (euclidean_space ℝ (fin n)), is_open_refinement A C ∧ is_open_cover C ∧ is_locally_finite C, from by auto [is_open_refinement, is_open_cover, is_locally_finite],
  -- So $\mathcal{C}$ is a locally finite open refinement of $\mathcal{A}$ that covers $\mathbb{R}^n$, hence $\mathbb{R}^n$ is paracompact.
  show paracompact_space (euclidean_space ℝ (fin n)), from by auto [paracompact_space.paracompact_iff_locally_finite_open_refinement],
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
  -- $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 auto [set.subset_of_mem_powerset, set.subset_of_mem_powerset],
  -- Then $(A ∩ B) ⊆ A$, by intersection of set is a subset
  have h2 : (A ∩ B) ⊆ A, from by auto [set.inter_subset_left],
  -- Then $(A ∩ B) ⊆ S$, by subset relation is transitive
  have h3 : (A ∩ B) ⊆ S, from by auto [set.subset.trans],
  -- Hence $(A ∩ B) ∈  𝒫 S$, by power set definition
  show (A ∩ B) ∈  𝒫 S, from by auto [set.mem_powerset],
end

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

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

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

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

Setting $b = a$, this becomes:

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

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

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

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

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

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

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

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


import FOL.deduction FOL.semantics FOL.lindenbaum order.filter.ultrafilter data.finset.basic
open encodable

universes u v

namespace fol
open_locale logic_symbol
open logic.semantics

variables {L : language.{u}} {I : Type u} [inhabited I] (F : ultrafilter I) {𝔄 : I → Structure L}

local notation (name := dom) `|`M`|` := Structure.dom M

def uequiv : (Π i, |𝔄 i|) → (Π i, |𝔄 i|) → Prop :=
λ u₁ u₂, {i | u₁ i = u₂ i} ∈ F

notation u` ~[`:80 F`] `v:80 := uequiv F u v

@[simp] lemma uequiv_refl (u : Π i, |𝔄 i|) : u ~[F] u :=
by { simp[uequiv], exact F.univ_sets }

lemma uequiv_symm {u₁ u₂ : Π i, |𝔄 i|} : u₁ ~[F] u₂ → u₂ ~[F] u₁ :=
by { simp[uequiv], have : {i | u₁ i = u₂ i} = {i | u₂ i = u₁ i}, { ext, simp, exact eq_comm }, simp[this] }

lemma uequiv_trans {u₁ u₂ u₃ : Π i, |𝔄 i|} : u₁ ~[F] u₂ → u₂ ~[F] u₃ → u₁ ~[F] u₃ :=
by { simp[uequiv], intros h₁ h₂,
     have : {i | u₁ i = u₂ i} ∩ {i | u₂ i = u₃ i} ⊆ {i | u₁ i = u₃ i},
     { intros i hi, simp* at* },
     exact F.sets_of_superset (F.inter_sets h₁ h₂) this }

theorem uequiv_equivalence : equivalence (@uequiv L I _ F 𝔄) :=
⟨uequiv_refl F, λ _ _ , uequiv_symm F, λ _ _ _, uequiv_trans F⟩

@[reducible, simp, instance]
def ult (𝔄 : I → Structure L) (F : ultrafilter I) : setoid (Π i, |𝔄 i|) := ⟨@uequiv L I _ F 𝔄, uequiv_equivalence F⟩

def Ult (𝔄 : I → Structure L) (F : ultrafilter I) : Type* :=
quotient (ult 𝔄 F: setoid (Π i, |𝔄 i|))

def to_quotient {𝔄 : I → Structure L} {F : ultrafilter I} (u : Π i, |𝔄 i|) : Ult 𝔄 F := quotient.mk' u

notation `⟦`u`⟧*` :max := to_quotient u

instance : inhabited (Ult 𝔄 F) := ⟨⟦λ i, default⟧*⟩

namespace Ult
open logic.semantics

@[elab_as_eliminator]
protected lemma ind_on {C : Ult 𝔄 F → Prop} (u : Ult 𝔄 F)
  (h : ∀ u : Π i, |𝔄 i|, C ⟦u⟧*) : C u :=
quotient.induction_on' u h

@[elab_as_eliminator, reducible]
protected def lift_on {φ} (d : Ult 𝔄 F) (f : (Π i, |𝔄 i|) → φ)
  (h : ∀ (v u : Π i, |𝔄 i|), v ~[F] u → f v = f u) : φ :=
quotient.lift_on' d f h

@[simp]
protected lemma lift_on_eq {φ} (u₀ : Π i, |𝔄 i|) (f : (Π i, |𝔄 i|) → φ)
  (h : ∀ v u, v ~[F] u → f v = f u) : fol.Ult.lift_on F ⟦u₀⟧* f h = f u₀ := rfl

@[elab_as_eliminator, reducible, simp]
protected def lift_on₂ {φ} (u₁ u₂ : Ult 𝔄 F) (f : (Π i, |𝔄 i|) → (Π i, |𝔄 i|) → φ)
  (h : ∀ u₁ u₂ v₁ v₂, u₁ ~[F] v₁ → u₂ ~[F] v₂ → f u₁ u₂ = f v₁ v₂) : φ :=
quotient.lift_on₂' u₁ u₂ f h

@[simp]
protected lemma lift_on₂_eq {φ} (u₁ u₂ : Π i, |𝔄 i|) (f : (Π i, |𝔄 i|) → (Π i, |𝔄 i|) → φ)
  (h : ∀ t₁ t₂ u₁ u₂, (t₁ ~[F] u₁) → (t₂ ~[F] u₂) → f t₁ t₂ = f u₁ u₂) :
  fol.Ult.lift_on₂ F ⟦u₁⟧* ⟦u₂⟧* f h = f u₁ u₂ := rfl

@[elab_as_eliminator, reducible]
protected def lift_on_finitary {φ} {n : ℕ} (v : finitary (Ult 𝔄 F) n) (f : finitary (Π i, |𝔄 i|) n → φ)
  (h : ∀ v₁ v₂ : finitary (Π i, |𝔄 i|) n, (∀ n, (v₁ n) ~[F] (v₂ n)) → f v₁ = f v₂) : φ :=
quotient.lift_on_finitary v f h

@[simp]
protected lemma lift_on_finitary_eq {φ} {n} (v : finitary (Π i, |𝔄 i|) n) (f : finitary (Π i, |𝔄 i|) n → φ)
  (h : ∀ v₁ v₂ : finitary (Π i, |𝔄 i|) n, (∀ n, (v₁ n) ~[F] (v₂ n)) → f v₁ = f v₂) :
  fol.Ult.lift_on_finitary F (λ x, ⟦v x⟧*) f h = f v :=
quotient.lift_on_finitary_eq v f h

@[simp] lemma of_eq_of {u₁ u₂ : Π i, |𝔄 i|} : (⟦u₁⟧* : Ult 𝔄 F) = ⟦u₂⟧* ↔ u₁ ~[F] u₂ :=
by simp[to_quotient, quotient.eq']

lemma equivs_mem {n} {v₁ v₂ : finitary (Π i, |𝔄 i|) n} (h : ∀ (x : fin n), {i : I | v₁ x i = v₂ x i} ∈ F) :
  {i | (λ x, v₁ x i) = (λ x, v₂ x i)} ∈ F :=
begin
  induction n with n IH,
  { have : {i : I | (λ x, v₁ x i) = (λ x, v₂ x i)} = set.univ,
    { ext i, simp }, rw this, exact F.univ_sets },
  { have ss : {i | v₁ 0 i = v₂ 0 i} ∩ {i | (λ x, v₁.tail x i) = (λ x, v₂.tail x i)} ⊆ {i : I | (λ x, v₁ x i) = (λ x, v₂ x i)},
    { intros i hi, simp[finitary.tail] at*,
      funext x, refine fin.cases _ _ x,
      { exact hi.1 },
      { intros j, have := congr_fun hi.2 j, simp at this, exact this } },
    have : {i | v₁ 0 i = v₂ 0 i} ∩ {i | (λ x, v₁.tail x i) = (λ x, v₂.tail x i)} ∈ F,
      from (F.inter_sets (h _) (@IH v₁.tail v₂.tail (λ x, h _))),
    refine F.sets_of_superset this ss }
end

lemma fn_equiv {n} {v₁ v₂ : finitary (Π i, |𝔄 i|) n} (h : ∀ x, v₁ x ~[F] v₂ x) (f : L.fn n) :
  (λ i, (𝔄 i).fn f (λ x, v₁ x i)) ~[F] (λ i, (𝔄 i).fn f (λ x, v₂ x i)) :=
begin
  simp[uequiv] at*,
  have : {i | (λ x, v₁ x i) = (λ x, v₂ x i)} ⊆ {i | (𝔄 i).fn f (λ x, v₁ x i) = (𝔄 i).fn f (λ x, v₂ x i)},
  { intros i hi, simp* at* },
  exact F.sets_of_superset (equivs_mem F h) this
end

lemma pr_equiv : ∀ {n} {v₁ v₂ : finitary (Π i, |𝔄 i|) n} (h : ∀ x, v₁ x ~[F] v₂ x) (p : L.pr n),
  {i | (𝔄 i).pr p (λ x, v₁ x i)} ∈ F ↔ {i | (𝔄 i).pr p (λ x, v₂ x i)} ∈ F :=
begin
  suffices : ∀ {n} {v₁ v₂ : finitary (Π i, |𝔄 i|) n} (h : ∀ x, v₁ x ~[F] v₂ x) (p : L.pr n),
  {i | (𝔄 i).pr p (λ x, v₁ x i)} ∈ F → {i | (𝔄 i).pr p (λ x, v₂ x i)} ∈ F,
  { intros n v₁ v₂ eqn p, refine ⟨this eqn p, this (λ x, uequiv_symm _ (eqn x)) p⟩ },
  intros n v₁ v₂ eqn p h,
  have : {i | (𝔄 i).pr p (λ x, v₁ x i)} ∩ {i | (λ x, v₁ x i) = (λ x, v₂ x i)} ⊆ {i | (𝔄 i).pr p (λ x, v₂ x i)},
  { intros i hi, simp* at*, simp[←hi.2], exact hi.1 },
  refine F.sets_of_superset (F.inter_sets h (equivs_mem _ eqn)) this
end

def product_fn (n) (f : L.fn n) : finitary (Ult 𝔄 F) n → Ult 𝔄 F :=
λ v, fol.Ult.lift_on_finitary F v (λ v, (⟦λ i, (𝔄 i).fn f (λ x, v x i)⟧* : Ult 𝔄 F)) $ λ u₁ u₂ eqn,
by { simp, exact fn_equiv F eqn f }

def product_pr (n) (p : L.pr n) : finitary (Ult 𝔄 F) n → Prop :=
λ v, fol.Ult.lift_on_finitary F v (λ v, {i | (𝔄 i).pr p (λ x, v x i)} ∈ F) $ λ u₁ u₂ eqn,
by { simp, exact pr_equiv F eqn p }

def product (𝔄 : I → Structure L) (F : ultrafilter I) : Structure L := ⟨Ult 𝔄 F, ⟨default⟩, product_fn F, product_pr F⟩
notation `ℿ `𝔄` ⫽ `F:90 := product 𝔄 F

variables {F}

@[simp] lemma ult_eq : Ult 𝔄 F = |ℿ 𝔄 ⫽ F| := rfl

private lemma Structure_exists (p : formula L) {e : ∀ i, ℕ → |𝔄 i|} (h : {i | ∃ u, 𝔄 i ⊧[u ⌢ e i] p } ∈ F) :
  ∃ (u : Π i, |𝔄 i|), {i | 𝔄 i ⊧[(u i) ⌢ e i] p} ∈ F :=
begin
  have : ∀ i, ∃ u, i ∈ {i | ∃ u, 𝔄 i ⊧[u ⌢ e i] p} → 𝔄 i ⊧[u ⌢ e i] p,
  { intros i, simp, by_cases C : i ∈ {i | ∃ u, 𝔄 i ⊧[u ⌢ e i] p}; simp at C,
    { rcases C with ⟨u, hu⟩, refine ⟨u, λ v _, hu⟩ },
    { refine ⟨default, λ _ h, _⟩, exfalso, refine C _ h } },
  rcases classical.skolem.mp this with ⟨u, hu⟩,
  refine ⟨u, _⟩, exact F.sets_of_superset h hu
end

lemma Structure_fn_eq {n} (f : L.fn n) : (ℿ 𝔄 ⫽ F).fn f = product_fn F _ f := rfl

lemma Structure_pr_eq {n} (r : L.pr n) : (ℿ 𝔄 ⫽ F).pr r = product_pr F _ r := rfl

lemma models_pr_iff_lmm : ∀ (t : term L) (e : ∀ i, ℕ → |𝔄 i|),
  (@term.val _ (ℿ 𝔄 ⫽ F) (λ n, ⟦λ i, e i n⟧*) t) = ⟦λ i, @term.val _ (𝔄 i) (λ n, e i n) t⟧*
| (#n)                _ := by simp
| (@term.app _ n f v) e :=
  by { simp[Structure_fn_eq, product_fn],
       let v' : finitary (Π i, |𝔄 i|) n := λ x i, (v x).val (𝔄 i) (e i),
       have : (λ x, @term.val _ (ℿ 𝔄 ⫽ F) (λ n, ⟦(λ i, e i n)⟧*) (v x)) = λ x, ⟦v' x⟧*,
       { funext x, simp[v', models_pr_iff_lmm (v x)] },
       simp[this] }

lemma models_pr_iff {n} (r : L.pr n) (v : finitary (term L) n) (e : ∀ i, ℕ → |𝔄 i|) :
  (ℿ 𝔄 ⫽ F).pr r (λ x, (v x).val (ℿ 𝔄 ⫽ F) (λ n, ⟦λ i, e i n⟧*)) ↔ {i | (𝔄 i).pr r (λ x, (v x).val (𝔄 i) (e i))} ∈ F :=
by simp[models_pr_iff_lmm, Structure_pr_eq, product_pr]

-- Łoś's theorem
theorem fundamental_param : ∀ (p : formula L) (e : ∀ i, ℕ → |𝔄 i|),
  ℿ 𝔄 ⫽ F ⊧[λ n, ⟦λ i, e i n⟧*] p ↔ {i | 𝔄 i ⊧[e i] p} ∈ F
| ⊤                 _ := by { simp, exact F.univ_sets }
| (formula.app p v) e := models_pr_iff p _ _
| (t₁ =' t₂)      e := by simp[models_pr_iff_lmm]; refl
| (p ⟶ q)       e := by { simp[fundamental_param p, fundamental_param q],
    show {i | 𝔄 i ⊧[e i] p} ∈ F → {i | 𝔄 i ⊧[e i] q} ∈ F ↔ {i | 𝔄 i ⊧[e i] p → 𝔄 i ⊧[e i] q} ∈ F,
    split,
    { intros h, by_cases C : {i | 𝔄 i ⊧[e i] p} ∈ F,
      { have : {i | 𝔄 i ⊧[e i] q} ⊆ {i | 𝔄 i ⊧[e i] p → 𝔄 i ⊧[e i] q}, { intros i hi, simp* at* },
        exact F.sets_of_superset (h C) this },
      { have : {i | 𝔄 i ⊧[e i] p}ᶜ ∈ F, from ultrafilter.compl_mem_iff_not_mem.mpr C,
        have ss : {i | 𝔄 i ⊧[e i] p}ᶜ ⊆ {i | 𝔄 i ⊧[e i] p → 𝔄 i ⊧[e i] q},
        { intros i hi, simp* at* },
        exact F.sets_of_superset this ss } },
    { intros h₁ h₂,
      have : {i | 𝔄 i ⊧[e i] p} ∩ {i | 𝔄 i ⊧[e i] p → 𝔄 i ⊧[e i] q} ⊆ {i | 𝔄 i ⊧[e i] q},
      { intros i hi, simp at*, refine hi.2 hi.1 },
      exact filter.mp_mem h₂ h₁ } }
| (∼p)          e := by { simp[fundamental_param p], exact ultrafilter.eventually_not.symm }
| (∀.p)          e := by { simp,
    calc
      (∀ u, ℿ 𝔄 ⫽ F ⊧[u ⌢ λ n, ⟦λ i, e i n⟧*] p)
          ↔ (∀ (u : Π i, |𝔄 i|), ℿ 𝔄 ⫽ F ⊧[λ n, ⟦λ i, (λ i, (u i) ⌢ (e i)) i n⟧*] p) :
        by { have eqn: ∀ u, (⟦u⟧* ⌢ λ n, ⟦(λ i, e i n)⟧*) = (λ n, ⟦(λ i, (u i) ⌢ e i $ n)⟧* : ℕ → |ℿ 𝔄 ⫽ F|),
             { intros i, funext x, cases x; simp[concat] }, simp, split,
             { intros h u, have := h ⟦u⟧*, simp[eqn] at this, exact this },
             { intros h u, induction u using fol.Ult.ind_on, simp[eqn, h] } }
      ... ↔ (∀ (u : Π i, |𝔄 i|), {i | 𝔄 i ⊧[u i ⌢ e i] p} ∈ F) :
        by { split, { intros h u, simp[←fundamental_param  p _, h] }, { intros h u, simp[fundamental_param  p _, h] } }
      ... ↔ {i | ∀ (u : |𝔄 i|), 𝔄 i ⊧[u ⌢ e i] p} ∈ F :
        by { split,
             { contrapose,
               simp[←ultrafilter.compl_mem_iff_not_mem, set.compl_def], intros h,
               show ∃ (u : Π i, |𝔄 i|), {i | ¬𝔄 i ⊧[u i ⌢ e i] p} ∈ F, from Structure_exists (∼p) h },
             { refine λ h u, F.sets_of_superset h (λ _ _ , by simp* at*) } } }

theorem fundamental {p : formula L} :
  ℿ 𝔄 ⫽ F ⊧ p ↔ {i | 𝔄 i ⊧ p} ∈ F :=
begin
  calc
    ℿ 𝔄 ⫽ F ⊧ p ↔ ℿ 𝔄 ⫽ F ⊧ nfal p p.arity : nfal_models_iff.symm
    ...         ↔ {i | 𝔄 i ⊧ nfal p p.arity} ∈ F :
      by simpa[eval_is_sentence_iff _ (formula.nfal_is_sentence p)] using fundamental_param (nfal p p.arity) (λ i n, default)
    ...         ↔ {i | 𝔄 i ⊧ p} ∈ F :
      by { have : {i | 𝔄 i ⊧ nfal p p.arity} = {i | 𝔄 i ⊧ p},
           { ext i, simp, refine nfal_models_iff },
           simp[this] }
end

end Ult
end fol

namespace fol
variables {L : language.{u}}

def finTheory (T : Theory L) := {S : finset (formula L) // ∀ {x}, x ∈ S → x ∈ T}

variables {T : Theory L}

def finTheory.empty {T : Theory L} : finTheory T := ⟨∅, by simp⟩
instance : inhabited (finTheory T) := ⟨⟨∅, by simp⟩⟩

noncomputable def finTheory.insert (P : finTheory T) (p : formula L) (h : p ∈ T) : finTheory T :=
⟨insert p P.val, λ x hx,  by { simp at hx, cases hx, simp[hx, h], refine P.property hx }⟩

@[simp] lemma finTheory.insert_val (P : finTheory T) (p : formula L) (h : T p) :
  (P.insert p h).val = insert p P.val := rfl

instance : has_coe (finTheory T) (set (formula L)) := ⟨λ S, {p | p ∈ S.val}⟩

namespace compactness

variables (𝔄 : finTheory T → Structure L)

def formdomain (p : formula L) : set (finTheory T) := {i | 𝔄 i ⊧ p}

def F : set (set (finTheory T)) := {x | ∃ p, T p ∧ x = formdomain 𝔄 p}

private lemma finite_intersection_lmm (h : ∃ p, T p) (H : ∀ (i : finTheory T) p, p ∈ i.val → 𝔄 i ⊧ p) :
  ∀ S : finset (set (finTheory T)), (↑S : set (set (finTheory T))) ⊆ F 𝔄 →
  ∃ P : finTheory T,
  (∀ p, p ∈ P.val → formdomain 𝔄 p ∈ S) ∧ (∀ S', S' ∈ S → ∃ p, p ∈ P.val ∧ S' = formdomain 𝔄 p) :=
begin
  intros S, induction S using finset.induction with i S i_fresh IH,
  { intros _, simp[set.nonempty], rcases h with ⟨p₀, hyp_p₀⟩,
    refine ⟨⟨∅, by simp⟩, _⟩, unfold_coes, simp },
  { intros h, simp at*,
    have lmm₁ : ↑S ⊆ F 𝔄, from set.subset.trans (set.subset_insert _ _) h,
    have : ∃ (P : finTheory T),
      (∀ p, p ∈ ↑P → formdomain 𝔄 p ∈ S) ∧ (∀ S', S' ∈ S → ∃ p, p ∈ ↑P ∧ S' = formdomain 𝔄 p),
    from IH lmm₁, rcases this with ⟨P, IH₁, IH₂⟩,
    have : ∃ p, T p ∧ i = formdomain 𝔄 p, from h (set.mem_insert i ↑S),
    rcases this with ⟨p, hyp_p, rfl⟩,
    refine ⟨P.insert p hyp_p, _, _, _⟩; unfold_coes; simp,
    { refine λ q hyp_q, or.inr (IH₁ _ hyp_q) },
    { refine ⟨p, or.inl rfl, rfl⟩ },
    { intros S' hyp_S',
      have : ∃ p, p ∈ ↑P ∧ S' = formdomain 𝔄 p, from IH₂ _ hyp_S', rcases this with ⟨p, hyp, rfl⟩,
      refine ⟨p, or.inr hyp, rfl⟩ } }
end

theorem finite_intersection (h : ∃ p, T p) (H : ∀ (i : finTheory T) p, p ∈ i.val → 𝔄 i ⊧ p) :
  ∀ S : finset (set (finTheory T)),
  (↑S : set (set (finTheory T))) ⊆ F 𝔄 → (⋂₀ (↑S : set (set (finTheory T)))).nonempty :=
begin
  intros S hS, have := finite_intersection_lmm _ h H S hS, rcases this with ⟨P, hyp⟩,
  refine ⟨P, λ S' hS', _⟩,
  have := hyp.2 S' hS', rcases this with ⟨p, hyp_p, rfl⟩, simp[formdomain] at*,
  refine H _ _ hyp_p
end

theorem ultrafilter_exists (h : ∃ p, p ∈ T) (H : ∀ (i : finTheory T) p, p ∈ i.val → 𝔄 i ⊧ p) :
  ∃ U : ultrafilter (finTheory T), F 𝔄 ⊆ U.to_filter.sets :=
ultrafilter.exists_ultrafilter_of_finite_inter_nonempty _ (finite_intersection _ h H)

theorem compact (T : Theory L) :
  Satisfiable T ↔ ∀ S : finset (formula L), ↑S ⊆ T → Satisfiable (S : Theory L) :=
  ⟨by { intros H S hyp_S, rcases H with ⟨𝔄, hyp⟩,
        refine ⟨𝔄, λ p h, hyp (hyp_S h)⟩ },
   by { suffices : (∀ S : finTheory T, Satisfiable (S : Theory L)) → Satisfiable T,
        { intros h, refine this (λ S, _),
          rcases h S.val (λ p, S.property) with ⟨𝔄, hyp_𝔄⟩, refine ⟨𝔄, hyp_𝔄⟩ },
    intros H, by_cases C : T = ∅,
        { rcases C with rfl, refine empty_has_Structure },
        { have ex : ∃ p, p ∈ T, { by_contra, simp at*, refine C _, { ext x, simp, refine h _ } },
          have : ∃ (𝔄 : finTheory T → Structure L), ∀ (i : finTheory T) p, p ∈ i.val → 𝔄 i ⊧ p,
          from classical.skolem.mp H, rcases this with ⟨𝔄, hyp_𝔄⟩,
          have := ultrafilter_exists _ ex hyp_𝔄, rcases this with ⟨U, hyp_U⟩,
          use ℿ 𝔄 ⫽ U, intros p hyp_p, rw Ult.fundamental,
          have : {i | 𝔄 i ⊧ p} ∈ F 𝔄, { refine ⟨p, hyp_p, rfl⟩ },
          exact hyp_U this } }⟩

end compactness

end fol


example : (m n : Nat) → m = n := by
  intro y y
  rename_i x
  trace_state
  admit

example : (m n : Nat) → m = n := by
  intro a.b a.b
  rename_i x
  trace_state
  admit

example : (m o p n: Nat) → m + p = n + o := by
  intro a.b _ _ a.b
  rename_i x _ y
  trace_state
  admit


import Runtime.Network.Graph.Path.Child

namespace Network.Graph.Path

inductive Sibling : Path graph start → Path graph start → Prop
  | nil : Sibling nil nil
  | cons : (path₁ ≻ parent) → (path₂ ≻ parent) → Sibling path₁ path₂

infix:40 " ≂ " => Sibling

theorem Sibling.refl : ∀ path : Path graph start, (path ≂ path)
  | .nil => nil
  | .cons _ subpath => by have ⟨_, h⟩ := Succ.cons subpath; exact cons h h

theorem Sibling.symm : (path₁ ≂ path₂) → (path₂ ≂ path₁)
  | nil => nil
  | cons h₁ h₂ => cons h₂ h₁

theorem Sibling.iff_eq_prefix : (path₁ ≂ path₂) ↔ (path₁.prefix? = path₂.prefix?) := by
  constructor
  case mp =>
    cases path₁ <;> cases path₂
    case nil.nil => simp
    case cons.cons => intro h; cases h; simp_all [Succ]
    case nil.cons => intro h; cases h; case _ h _ => have := h.isCons; contradiction
    case cons.nil => intro h; cases h; case _ h   => have := h.isCons; contradiction
  case mpr =>
    intro h
    by_cases path₁.prefix?.isSome
    case inr hp =>
      have hc₁ := isNil_iff_not_isCons.mpr <| mt prefix?_isSome_iff_isCons.mpr hp; simp at hc₁
      rw [h] at hp
      have hc₂ := isNil_iff_not_isCons.mpr <| mt prefix?_isSome_iff_isCons.mpr hp; simp at hc₂
      simp [hc₁, hc₂, Sibling.nil]
    case inl hp =>
      have ⟨_, hp₁⟩ := Option.isSome_iff_exists.mp hp
      rw [h] at hp
      have ⟨_, hp₂⟩ := Option.isSome_iff_exists.mp hp
      simp_all
      exact Sibling.cons hp₁ hp₂

instance : Decidable (path₁ ≂ path₂) :=
  if h : path₁.prefix? = path₂.prefix?
  then isTrue <| Sibling.iff_eq_prefix.mpr h
  else isFalse <| mt Sibling.iff_eq_prefix.mp h

end Network.Graph.Path


import util.predicate
import util.classical
import util.meta.tactic
import tactic.linarith

@[user_attribute]
meta def strengthening_attr : user_attribute :=
{ name := `strengthening
, descr := "
Strenghtening lemmas to facilitate the stripping of small details in application.
Expected shape `∀ p : pred' α, ⊩ f p ⟶ g p`
" }

run_cmd mk_simp_attr `tl_simp [`simp]
run_cmd
do ns ← attribute.get_instances `simp,
   let ns : list name := ns.filter (λ n, name.is_prefix_of `predicate n),
   n ← tactic.mk_const (mk_simp_attr_decl_name `tl_simp),
   ns.mmap' (λ n, user_attribute.set simp_attr.tl_simp n () tt),
   return ()

namespace tactic.interactive
open lean interactive.types
open interactive lean.parser tactic
open list (hiding map) functor predicate
local postfix *:9001 := many

meta def TL_unfold (cs : parse ident*) (loc : parse location) : tactic unit :=
do unfold_coes loc, unfold (cs ++ [`var.apply,`pred'.mk]) loc

end tactic.interactive

namespace temporal

open predicate nat

universes u u₀ u₁ u₂ u₃

variables {α : Sort u₀} {β : Sort u₁} {γ : Sort u₂} {φ : Sort u₃}

@[reducible]
def tvar := var ℕ

@[reducible]
def cpred := tvar Prop

abbreviation act (β : Sort u) := β → β → Prop

def eventually (p : cpred) : cpred :=
⟨ λ i, ∃ j, p.apply (i+j) ⟩
def henceforth (p : cpred) : cpred :=
⟨ λ i, ∀ j, p.apply (i+j) ⟩
def next (p : tvar α) : tvar α :=
⟨ λ i, p.apply (i.succ) ⟩

def until (p q : cpred) : cpred :=
⟨ λ i, ∃ j, i+j ⊨ q ∧ ∀ k < j, i+k ⊨ p ⟩

def wait (p q : cpred) : cpred :=
until p q ⋁ henceforth p

def action (a : act α) (v : tvar α) : cpred :=
lifted₂ a v (next v)

@[lifted_fn, reducible]
def pair {α β} (x : tvar α) (y : tvar β) : tvar (α × β) :=
lifted₂ prod.mk x y

notation `⦃` x₀ `,` x₁ `⦄` := pair x₀ x₁
notation `⦃` x₀ `,` x₁ `,` x₂ `⦄` := pair x₀ (pair x₁ x₂)
notation `⦃` x₀ `,` x₁ `,` x₂ `,` x₃ `⦄` := pair x₀ (pair x₁ (pair x₂ x₃))
notation `⦃` x₀ `,` x₁ `,` x₂ `,` x₃ `,` x₄ `⦄` := pair x₀ (pair x₁ (pair x₂ (pair x₃ x₄)))
-- notation `⦃` x `,` l:(foldl `,` (h t, pair h t) x `⦄`)  := l

prefix `⊙`:90 := next
prefix `◇`:95 := eventually -- \di
prefix `◻`:95 := henceforth -- \sqw
infixl `  𝒰  `:95 := until -- \McU
infixl `  𝒲  `:95 := wait -- \McU
notation `⟦ `:max v ` | `:50 R ` ⟧`:0 := action R v
notation `⟦ `:max v `,` v' ` | `:50 R ` ⟧`:0 := action R (pair v v')
notation `⟦ `:max v₀ `,` v₁ `,` v₂ ` | `:50 R ` ⟧`:0 := action R (pair v₀ (pair v₁ v₂))
notation `⟦ `:max v₀ `,` v₁ `,` v₂ `,` v₃ ` | `:50 R ` ⟧`:0 := action R (pair v₀ (pair v₁ (pair v₂ v₃)))

def tl_leads_to (p q : cpred) : cpred :=
◻(p ⟶ ◇q)

infix ` ~> `:55 := tl_leads_to

def to_fun_var (f : var γ α → var γ β) : var γ (α → β) :=
⟨ λ i x, (f ↑x).apply i ⟩

def to_fun_var' (f : tvar α → tvar α → tvar β) : tvar (α → α → β) :=
⟨ λ i x y, (f x y).apply i ⟩

class persistent (p : cpred) : Prop :=
  (is_persistent : ◻p = p)
export persistent (is_persistent)

lemma tl_imp_intro (h : cpred) [persistent h] {p q : cpred}
  (h' : h ⟹ (p ⟶ q))
: ctx_impl h p q :=
begin
  constructor, intro,
  exact (h' True).apply σ trivial,
end

lemma tl_imp_elim (h : cpred) [persistent h] {p q : cpred}
  (h' : ctx_impl h p q)
: h ⟹ (p ⟶ q) :=
begin
  intro, revert Γ,
  apply intro_p_imp h',
end

lemma tl_imp_intro' (h : cpred) [persistent h] {p q : cpred}
  (h' : p ⟹ q)
: ctx_impl h p q :=
h' _

@[tl_simp, simp]
lemma hence_true : ◻(True : cpred) = True :=
begin
  ext1,
  split ; intro h,
  { trivial },
  { intro, trivial }
end

@[tl_simp, simp]
lemma next_true : ⊙True = True :=
by lifted_pred

@[tl_simp, simp]
lemma next_false : ⊙False = False :=
by lifted_pred [next]

instance true_persistent
: persistent (True : cpred) :=
by { constructor, simp with tl_simp, }

lemma tl_imp_elim' {p q : cpred}
  (h : ctx_impl True p q)
: p ⟹ q :=
begin
  simp [ctx_impl] at h,
  apply h,
end

@[strengthening]
lemma eventually_weaken (p : cpred)
: (p ⟹ ◇ p) :=
begin
  pointwise with τ h,
  unfold eventually,
  existsi 0,
  apply h
end
open stream

@[strengthening]
lemma next_entails_eventually (p : cpred)
: ⊙p ⟹ ◇p :=
by { lifted_pred [eventually], intro, existsi 1, assumption }

@[strengthening]
lemma henceforth_entails_next (p : cpred)
: ◻p ⟹ ⊙p :=
by { lifted_pred [eventually], intro h, apply h 1 }

@[strengthening]
lemma henceforth_str (p : cpred) :
  (◻p ⟹ p) :=
begin
  pointwise with τ h, apply h 0
end

local infix ` <$> ` := fun_app_to_var
local infix ` <*> ` := combine_var

lemma init_eq_action {p : α → Prop} (v : tvar α)
: ⟨p⟩ ! v = ⟦ v | λ s s', p s ⟧ :=
by { cases v, refl }

lemma coe_eq (v : tvar α) (x : α)
: ⟨λ y, y = x⟩ ! v = v ≃ x :=
by { cases v, refl }

lemma init_eq_action' {p : pred' α} (v : tvar α)
: (p ! v) = ⟦ v | λ s s', p.apply s ⟧ :=
by { cases v, cases p, refl }

lemma next_eq_action {p : α → Prop} (v : tvar α)
: ⊙(p <$> v) = ⟦ v | λ s s' : α, p s' ⟧ :=
by { cases v, refl }

lemma action_eq {A : act α} (v : tvar α)
: ⟦ v | A ⟧ = (A : tvar (act α)) v (⊙v) :=
by { cases v, refl }

lemma next_eq_action' {p : pred' α} (v : tvar α)
: ⊙(p ! v) = ⟦ v | λ s s' : α, p.apply s' ⟧ :=
by { cases v, cases p, refl }

lemma not_action {A : act α} (v : tvar α)
: -⟦ v | A ⟧ = ⟦ v | λ s s', ¬ A s s' ⟧ :=
rfl

lemma action_imp (p q : act α) (v : tvar α)
: (⟦ v | λ s s' : α, p s s' → q s s' ⟧ : cpred) = ⟦ v | p ⟧ ⟶ ⟦ v | q ⟧ :=
rfl

lemma action_and_action (p q : act α) (v : tvar α)
: ⟦ v | p ⟧ ⋀ ⟦ v | q ⟧ = ⟦ v | λ s s' : α, p s s' ∧ q s s' ⟧ :=
rfl

lemma action_or_action (p q : act α) (v : tvar α)
: ⟦ v | p ⟧ ⋁ ⟦ v | q ⟧ = ⟦ v | λ s s' : α, p s s' ∨ q s s' ⟧ :=
rfl

lemma action_false (v : tvar α)
: (⟦ v | λ _ _, false ⟧ : cpred) = False :=
by { funext x, refl }

variables {Γ : cpred}

lemma unlift_action (A : act α) (v : tvar α)
  (h : ∀ σ σ', A σ σ')
: Γ ⊢ ⟦ v | A ⟧ :=
begin
  constructor, simp_intros [action],
  apply h
end

@[tl_simp, simp]
lemma eventually_eventually (p : cpred) : ◇◇ p = ◇ p :=
begin
  ext k,
  split
  ; unfold eventually
  ; intro h
  ; cases h with i h,
  { cases h with j h,
    existsi (i+j),
    simp at h, apply h, },
  { existsi (0 : ℕ),
    existsi i,
    apply h }
end

@[tl_simp, simp]
lemma henceforth_henceforth (p : cpred) : ◻◻ p = ◻ p :=
begin
  ext _,
  split
  ; intro h,
  { intro i,
    have h' := h i 0,
    simp [drop_drop] at h',
    apply h' },
  { intros i j,
    simp [drop_drop],
    apply h }
end

lemma henceforth_next_intro (p : cpred)
: ◻p = ◻(p ⋀ ⊙p) :=
by { lifted_pred, split ; intros h i,
     { split, apply h i, specialize h (succ i),
       simp [add_succ] at h, simp [next,h], },
     { apply (h i).left }}

/- True / False -/

@[tl_simp, simp]
lemma hence_false : ◻(False : cpred) = False :=
begin
  ext _,
  split ; intro h,
  { cases h 0 },
  { cases h }
end

@[tl_simp, simp]
lemma event_false : ◇(False : cpred) = False :=
begin
  ext _,
  split ; intro h,
  { cases h with _ h, cases h },
  { cases h }
end

@[tl_simp, simp]
lemma eventually_true : ◇(True : cpred) = True :=
begin
  ext1,
  split ; intro h,
  { trivial },
  { apply exists.intro 0, trivial }
end

/- monotonicity -/

@[monotonic]
lemma eventually_tl_imp_eventually {h p q : cpred}
  [persistent h]
  (f : ctx_impl h p q)
: ctx_impl h (◇p) (◇q) :=
begin
  unfold ctx_impl at ⊢ f,
  rw ← is_persistent h at *,
  pointwise f with τ h',
  apply exists_imp_exists,
  intro i,
  apply f,
  rw ← henceforth_henceforth at h',
  apply h',
end

@[monotonic]
lemma eventually_entails_eventually {p q : cpred}
  (f : p ⟹ q)
: (◇p) ⟹ (◇q) :=
begin
  apply tl_imp_elim',
  mono,
end

lemma eventually_imp_eventually {p q : cpred} {Γ}
 (f : Γ ⊢ ◻ (p ⟶ q))
: Γ ⊢ (◇p) ⟶ (◇q) :=
begin
  constructor, introv hΓ,
  apply exists_imp_exists,
  intro i,
  apply f.apply _ hΓ,
end

@[monotonic]
lemma henceforth_tl_imp_henceforth {h p q : cpred}
  [persistent h]
  (f : ctx_impl h p q)
: ctx_impl h (◻p) (◻q) :=
begin
  unfold ctx_impl at *,
  rw ← is_persistent h,
  pointwise f with i h',
  simp [henceforth], intro_mono i,
  apply f ,
  apply  h',
end

@[monotonic]
lemma henceforth_entails_henceforth {p q : cpred}
  (f : p ⟹ q)
: (◻p) ⟹ (◻q) :=
begin
  refine tl_imp_elim' _,
  mono
end

lemma henceforth_imp_henceforth {p q : cpred} {Γ}
  (h : Γ ⊢ ◻ (p ⟶ q))
: Γ ⊢ (◻p) ⟶ (◻q) :=
begin
  pointwise h with τ,
  specialize h τ, simp [henceforth] at ⊢ h,
  introv h₀ h₁,
  solve_by_elim,
end

lemma inf_often_entails_inf_often {p q : cpred} (f : p ⟹ q)
: ◻◇p ⟹ ◻◇q :=
by mono*

lemma stable_entails_stable {p q : cpred} (f : p ⟹ q)
: ◇◻p ⟹ ◇◻q :=
by mono*

lemma henceforth_and (p q : cpred)
: ◻(p ⋀ q) = ◻p ⋀ ◻q :=
begin
  ext1,
  repeat { split ; intros }
  ; intros i ; try { simp, split },
  { apply (a i).left },
  { apply (a i).right },
  { apply a.left },
  { apply a.right },
end

lemma eventually_or (p q : cpred)
: ◇(p ⋁ q) = ◇p ⋁ ◇q :=
begin
  ext1,
  simp [eventually,exists_or],
end

lemma henceforth_forall (P : α → cpred)
: ◻(∀∀ x, P x) = ∀∀ x, ◻P x :=
begin
  ext1,
  simp [henceforth,p_forall],
  rw forall_swap,
end

@[tl_simp, simp]
lemma not_henceforth (p : cpred) : (- ◻p) = (◇-p) :=
begin
  ext1,
  simp [henceforth,not_forall_iff_exists_not,eventually],
end

@[tl_simp, simp]
lemma not_eventually (p : cpred)
: (-◇p) = (◻-p) :=
begin
  ext1,
  simp [henceforth,not_forall_iff_exists_not,eventually],
end

@[tl_simp, simp, predicate]
lemma models_to_fun_var (σ : γ) (x : var γ α → var γ β)
: σ ⊨ to_fun_var x = λ i, σ ⊨ x i :=
by { refl }

@[tl_simp, simp, predicate]
lemma models_to_fun_var' (σ : ℕ) (f : tvar (α → α → β))
: σ ⊨ to_fun_var' (λ x, var_seq $ var_seq f x) = σ ⊨ f :=
by { casesm* tvar _, dunfold to_fun_var', simp_coes [var_seq], }

@[tl_simp, simp, predicate]
lemma models_to_fun_var''' (σ : ℕ) (f : tvar α → tvar α → tvar β) (x y : tvar α)
: (σ ⊨ to_fun_var' f x y) = (σ ⊨ f x y) :=
sorry

@[tl_simp, simp, predicate, lifted_fn]
lemma to_fun_var_fn_coe_proj (f : var γ α) (g : var β φ → var β γ) (w : var β φ)
: to_fun_var (λ w, f ! g w) w = f ! to_fun_var g w :=
by { funext, lifted_pred, simp!, }

@[tl_simp, simp, predicate, lifted_fn]
lemma to_fun_var_fn_coe (g : var β (φ → γ)) (w : var β φ)
: to_fun_var (λ w, g w) w = g w :=
by { funext, lifted_pred, simp!, }

@[tl_simp, simp, predicate, lifted_fn]
lemma to_fun_var_fn_coe' (f : tvar (α → α → β)) (w w' : tvar α)
: ⇑(to_fun_var' $ λ w w', f w w') w w' = f w w' :=
by { lifted_pred, }

@[tl_simp, simp, predicate, lifted_fn]
lemma to_fun_var_p_exists' (f : γ → tvar α → tvar α → tvar Prop) (w w' : tvar α)
: ⇑(to_fun_var' $ λ w w', ∃∃ x : γ, f x w w') w w' = ∃∃ x : γ, to_fun_var' (f x) w w' :=
by { lifted_pred, }

@[lifted_fn]
lemma to_fun_var_lift₁ (f : φ → β) (g : var γ α → var γ φ) (w : var γ α)
: (to_fun_var (λ (w : var γ α), lifted₁ f (g w))) w = lifted₁ f (to_fun_var g w) :=
by { lifted_pred, simp! }

@[lifted_fn]
lemma to_fun_var_lift₂ {σ} (f : φ → σ → β)
  (g₀ : var γ α → var γ φ)
  (g₁ : var γ α → var γ σ) (w : var γ α)
: (to_fun_var (λ (w : var γ α), lifted₂ f (g₀ w) (g₁ w))) w =
  lifted₂ f (to_fun_var g₀ w) (to_fun_var g₁ w) :=
by { lifted_pred, simp }

@[lifted_fn]
lemma to_fun_var_coe (w : var γ α) (v : var γ β)
: to_fun_var (λ (w : var γ α), v) w = v :=
by { lifted_pred, simp }

@[lifted_fn]
lemma to_fun_var_id (w : var γ α)
: to_fun_var (λ w : var γ α, w) w = w :=
by { lifted_pred, simp }

@[lifted_fn]
lemma to_fun_var'_fn_coe (f : var φ β) (g : tvar α → tvar α → tvar φ) (w w' : tvar α)
: (to_fun_var' (λ (w w' : tvar α), f ! g w w')) w w' = f ! to_fun_var' g w w'  :=
by { lifted_pred, }

@[lifted_fn]
lemma to_fun_var'_coe (w w' : tvar α) (v : tvar β)
: (to_fun_var' (λ (w w' : tvar α), v)) w w' = v :=
by { lifted_pred, }

@[lifted_fn]
lemma to_fun_var'_id (w w' : tvar α)
: to_fun_var' (λ w w' : tvar α, w) w w' = w :=
by { lifted_pred, }

@[lifted_fn]
lemma to_fun_var'_id' (w w' : tvar α)
: to_fun_var' (λ w w' : tvar α, w') w w' = w' :=
by { lifted_pred, }

@[lifted_fn]
lemma to_fun_var'_lift₂ {σ} (f : φ → σ → β)
  (g₀ : tvar α → tvar α → tvar φ)
  (g₁ : tvar α → tvar α → tvar σ) (w w' : tvar α)
: to_fun_var' (λ (w w' : tvar α), lifted₂ f (g₀ w w') (g₁ w w')) w w' =
  lifted₂ f (to_fun_var' g₀ w w') (to_fun_var' g₁ w w') :=
by { lifted_pred, }

@[lifted_fn]
lemma to_fun_var'_action {σ} (f : tvar α → tvar β)
  (A : act β)
  (g₁ : tvar α → tvar α → tvar σ) (w w' : tvar α)
: to_fun_var' (λ (w w' : tvar α), ⟦ f w | A ⟧ ) w w' =
  ⟦ f w | A ⟧ :=
by { lifted_pred, }

@[tl_simp, simp, predicate]
lemma models_coe (σ : α) (x : β)
: σ ⊨ ↑x = x :=
by { refl }

@[tl_simp, simp, predicate]
lemma models_action (A : act α) (v : tvar α) (i : ℕ)
: i ⊨ ⟦ v | A ⟧ ↔ A (i ⊨ v) (succ i ⊨ v) :=
by { refl }

@[tl_simp, simp, predicate]
lemma models_next (p : tvar α) (t : ℕ)
: t ⊨ ⊙p = succ t ⊨ p :=
by refl

lemma induct' (p : cpred) {Γ}
  (h : Γ ⊢ ◻ (p ⟶ ⊙p))
: Γ ⊢ ◻ (p ⟶ ◻p) :=
begin
  constructor,
  intros τ hΓ k hp i,
  induction i with i,
  assumption,
  have := h.apply τ hΓ (k+i) (cast (by simp) i_ih),
  simp [next] at this,
  simp [add_succ,this],
end

lemma induct (p : cpred) {Γ}
  (h : Γ ⊢ ◻ (p ⟶ ⊙p))
: Γ ⊢ p ⟶ ◻p :=
henceforth_str (p ⟶ ◻p) Γ (induct' _ h)

lemma induct_evt' (p q : cpred) {Γ}
  (h : Γ ⊢ ◻ (p ⟶ -q ⟶ ⊙p ⋁ ⊙q))
: Γ ⊢ ◻ (p ⟶ ◇q ⋁ ◻p) :=
begin
  lifted_pred using h,
  simp only [henceforth] with tl_simp at *,
  intros,
  simp [or_iff_not_imp,eventually],
  intros hnq k,
  induction k with k,
  { simp [a] },
  { simp [add_succ],
    specialize h _ k_ih (hnq _),
    rw [or_comm,or_iff_not_imp] at h,
    apply h, rw [← add_succ,← add_succ],
    apply hnq }
end

lemma eventually_exists (P : α → cpred)
: ◇(∃∃ x, P x) = ∃∃ x, ◇P x :=
begin
  ext1,
  unfold eventually p_exists,
  split
  ; intro H
  ; cases H with i H
  ; cases H with j H
  ; exact ⟨_,_,H⟩ ,
end

lemma one_point_elim {t} (Γ p : cpred) (v : tvar t)
  (h : ∀ x : t, Γ ⊢ (↑x ≃ v) ⟶ p)
: Γ ⊢ p :=
begin
  rw [← p_forall_to_fun] at h,
  constructor,
  intros i h',
  apply h.apply  i h' (v.apply $ i),
  simp,
end

local attribute [instance] classical.prop_decidable

lemma until_not_of_eventually {Γ p : cpred} :
  Γ ⊢ ◇p ⟶ -p 𝒰 p :=
begin
  lifted_pred, intro h,
  cases h with i h,
  induction i using nat.strong_induction_on with i ih,
  by_cases h' : ∃ j < i, σ + j ⊨ p,
  { rcases h' with ⟨j,h₀,h₁⟩,
    apply ih _ h₀ h₁ },
  { simp only [not_exists] at h',
    existsi [i,h], apply h' }
end

lemma until_backward_induction {Γ p q : cpred}
  (h' : Γ ⊢ ◻(p ⟶ q))
  (h : Γ ⊢ ◻(⊙q ⟶ -p ⟶ q)) :
  Γ ⊢ ◇p ⟶ q 𝒰 p :=
begin
  suffices : Γ ⊢ -p 𝒰 p ⟶ q 𝒰 p,
  { have h' := @until_not_of_eventually Γ p,
    lifted_pred using this h', tauto },
  lifted_pred using h h',
  dsimp [until],
  apply exists_imp_exists,
  rintros i ⟨h₀,h₁⟩,
  existsi h₀,
  introv h₂,
  generalize h₃ : (i - (k + 1)) = n,
  induction n generalizing k,
  { apply h, dsimp [next], rw ← add_succ, apply h', convert h₀,
    apply le_antisymm, apply succ_le_of_lt h₂,
    apply nat.le_of_sub_eq_zero h₃, apply h₁ _ h₂, },
  { apply h,
    { have h₄ : k + 1 ≤ i := succ_le_of_lt h₂,
      dsimp [next], rw ← add_succ,
      apply n_ih, rw nat.sub_eq_iff_eq_add at h₃; try { assumption },
      { rw [h₃,succ_add], apply succ_lt_succ,
        apply lt_of_lt_of_le (lt_succ_self _),
        apply nat.le_add_left },
      { apply succ.inj,
        rw [← h₃,succ_add,← succ_sub,succ_sub_succ_eq_sub],
        apply succ_le_of_lt, rw nat.sub_eq_iff_eq_add at h₃; try { assumption },
        rw h₃, apply lt_add_of_pos_left, apply zero_lt_succ }, },
    apply h₁ _ h₂, },
end

lemma henceforth_until {Γ p q : cpred}
  (h : Γ ⊢ ◻(p 𝒰 q)) :
  Γ ⊢ ◻(p ⋁ q) :=
begin
  lifted_pred using h,
  intro i, specialize h i,
  rcases h with ⟨⟨j⟩,h₀,h₁⟩,
  { right, apply h₀ },
  { left, apply h₁ 0, apply zero_lt_succ }
end

lemma henceforth_until' {Γ p : cpred} (q : cpred)
  (h : Γ ⊢ ◻(p 𝒰 (p ⋀ q))) :
  Γ ⊢ ◻p :=
begin
  replace h := henceforth_until h,
  suffices : p ⋁ p ⋀ q = p, { simp [this] at h, exact h },
  lifted_pred, tauto,
end

def nelist (α : Type*) := { xs : list α // xs.empty = ff }

def nelist.head {α : Type*} : nelist α → α
 | ⟨ x::xs, _ ⟩ := x

def nelist.tail {α : Type*} : nelist α → option (nelist α)
 | ⟨ x::x'::xs, _ ⟩ := some ⟨ x'::xs, rfl ⟩
 | ⟨ _ :: [], _ ⟩ := none

def nelist.uncons {α : Type*} : nelist α → α ⊕ (α × nelist α)
 | ⟨ x::x'::xs, _ ⟩ := sum.inr (x,⟨x'::xs,rfl⟩)
 | ⟨ x :: [], _ ⟩ := sum.inl x

def nelist.single {α : Type*} : α → nelist α
 | x := ⟨ x :: [] ,rfl ⟩

def nelist.cons {α : Type*} : α → nelist α → nelist α
 | x ⟨ xs, _⟩ := ⟨ x::xs,rfl ⟩

noncomputable def epsilon [nonempty α] (p : tvar (α → Prop)) : tvar α :=
⟨ λ i, classical.epsilon $ i ⊨ p ⟩

section witness
variables x₀ : tvar α
variables f : tvar (α → α)
variables (i : ℕ)

open classical nat

private def w : ℕ → α
 | 0 := i ⊨ x₀
 | (succ j) := (i + j ⊨ f) (w j)

lemma fwd_witness
: ⊩ ∃∃ w, w ≃ x₀ ⋀ ◻( ⊙w ≃ f w ) :=
begin
  lifted_pred,
  existsi (⟨ λ i, w x₀ f x (i - x) ⟩ : tvar α),
  simp [nat.sub_self,w],
  intro i,
  have h : x + i ≥ x := nat.le_add_right _ _,
  simp [next,nat.add_sub_cancel_left,succ_sub h,w],
end

variables {P : cpred}
variables (j : ℕ)

local attribute [instance] classical.prop_decidable

lemma first_P {p : ℕ → Prop} (h : ∃ i, p i) :
  (∃ i, (∀ j < i, ¬ p j) ∧ p i) :=
begin
  cases h with i h,
  induction i using nat.strong_induction_on with i ih,
  by_cases h' : (∀ (j : ℕ), j < i → ¬p j),
  { exact ⟨_,h',h⟩, },
  { simp [not_forall] at h',
    rcases h' with ⟨j,h₀,h₁⟩,
    apply ih _ h₀ h₁, }
end

noncomputable def next_P {x} (h : x ⊨ ◻◇P) (y : ℕ) : ℕ :=
classical.some (first_P (h y))

lemma next_P_eq_self {x} (h : x ⊨ ◻◇P) (y : ℕ)
  (h' : x+y ⊨ P) :
  next_P h y = 0 :=
begin
  simp [next_P],
  apply_some_spec,
  intros h, by_contradiction h₂,
  replace h₂ := nat.lt_of_le_and_ne (nat.zero_le _) (ne.symm h₂),
  apply h.1 _ h₂,
  simp [h']
end

lemma next_P_eq_succ {x} (h : x ⊨ ◻◇P) (y : ℕ)
  (h' : ¬ x+y ⊨ P) :
  next_P h y = succ (next_P h (succ y)) :=
begin
  simp [next_P],
  apply_some_spec, apply_some_spec,
  simp, intros h₀ h₁ h₂ h₃,
  by_contradiction h₄,
  replace h₄ := lt_or_gt_of_ne (h₄),
  cases h₄,
  cases x_1,
  { apply h', convert h₃ using 2, },
  { replace h₄ := lt_of_succ_lt_succ h₄,
    apply h₀ _ h₄, convert h₃ using 2, simp [add_succ] },
  { apply h₂ _ h₄, convert h₁ using 2, simp [add_succ] },
end

lemma back_witness {Γ}
  (h : Γ ⊢ ◻◇P)
: Γ ⊢ ∃∃ w, ◻( (P ⋀ w ≃ x₀) ⋁ (- P ⋀ w ≃ ⊙(f w)) ) :=
begin
  lifted_pred using h,
  existsi (⟨ λ i, w x₀ f (i) (next_P h (i - x)) ⟩ : tvar α),
  intro j, simp [nat.add_sub_cancel_left,w],
  by_cases h' : x + j ⊨ P; simp [next_P_eq_self,*,w],
  rw [next_P_eq_succ,w],
  congr' 1,
  { admit },
  have : (succ (x + j) - x) = succ j, admit,
  rw this, clear this,
end

end witness

end temporal


example : ¬ true = false := by
  simp [(¬ ·)]

example (h : y = 0) : x + y = x := by
  simp [(.+.)] -- Expands `HAdd.hAdd
  trace_state
  simp [Add.add]
  simp [h, Nat.add]
  done

example (h : y = 0) : x + y = x := by
  simp [.+.]
  trace_state
  simp [Add.add]
  simp [h, Nat.add]
  done


variable {α} (op : α → α → α)
local infixr:60 " ∙ " => op
example (x y : α) : x ∙ y = y ∙ x := sorry

infixr:60 " *** " => op -- Error, only local notation can reference section variables


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.doc_commands
import Mathlib.PostPort

namespace Mathlib

namespace tactic

namespace interactive

/--
This is a "finishing" tactic modification of `simp`. It has two forms.

* `simpa [rules, ...] using e` will simplify the goal and the type of
  `e` using `rules`, then try to close the goal using `e`.

  Simplifying the type of `e` makes it more likely to match the goal
  (which has also been simplified). This construction also tends to be
  more robust under changes to the simp lemma set.

* `simpa [rules, ...]` will simplify the goal and the type of a
  hypothesis `this` if present in the context, then try to close the goal using
  the `assumption` tactic. -/


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import category_theory.full_subcategory
import category_theory.limits.shapes.equalizers
import category_theory.limits.shapes.products
import tactic.elementwise
import topology.sheaves.presheaf

/-!
# The sheaf condition in terms of an equalizer of products

Here we set up the machinery for the "usual" definition of the sheaf condition,
e.g. as in https://stacks.math.columbia.edu/tag/0072
in terms of an equalizer diagram where the two objects are
`∏ F.obj (U i)` and `∏ F.obj (U i) ⊓ (U j)`.

-/

universes v u

noncomputable theory

open category_theory
open category_theory.limits
open topological_space
open opposite
open topological_space.opens

namespace Top

variables {C : Type u} [category.{v} C] [has_products C]
variables {X : Top.{v}} (F : presheaf C X) {ι : Type v} (U : ι → opens X)

namespace presheaf

namespace sheaf_condition_equalizer_products

/-- The product of the sections of a presheaf over a family of open sets. -/
def pi_opens : C := ∏ (λ i : ι, F.obj (op (U i)))
/--
The product of the sections of a presheaf over the pairwise intersections of
a family of open sets.
-/
def pi_inters : C := ∏ (λ p : ι × ι, F.obj (op (U p.1 ⊓ U p.2)))

/--
The morphism `Π F.obj (U i) ⟶ Π F.obj (U i) ⊓ (U j)` whose components
are given by the restriction maps from `U i` to `U i ⊓ U j`.
-/
def left_res : pi_opens F U ⟶ pi_inters F U :=
pi.lift (λ p : ι × ι, pi.π _ p.1 ≫ F.map (inf_le_left (U p.1) (U p.2)).op)

/--
The morphism `Π F.obj (U i) ⟶ Π F.obj (U i) ⊓ (U j)` whose components
are given by the restriction maps from `U j` to `U i ⊓ U j`.
-/
def right_res : pi_opens F U ⟶ pi_inters F U :=
pi.lift (λ p : ι × ι, pi.π _ p.2 ≫ F.map (inf_le_right (U p.1) (U p.2)).op)

/--
The morphism `F.obj U ⟶ Π F.obj (U i)` whose components
are given by the restriction maps from `U j` to `U i ⊓ U j`.
-/
def res : F.obj (op (supr U)) ⟶ pi_opens F U :=
pi.lift (λ i : ι, F.map (topological_space.opens.le_supr U i).op)

@[simp, elementwise]
lemma res_π (i : ι) : res F U ≫ limit.π _ i = F.map (opens.le_supr U i).op :=
by rw [res, limit.lift_π, fan.mk_π_app]

@[elementwise]
lemma w : res F U ≫ left_res F U = res F U ≫ right_res F U :=
begin
  dsimp [res, left_res, right_res],
  ext,
  simp only [limit.lift_π, limit.lift_π_assoc, fan.mk_π_app, category.assoc],
  rw [←F.map_comp],
  rw [←F.map_comp],
  congr,
end

/--
The equalizer diagram for the sheaf condition.
-/
@[reducible]
def diagram : walking_parallel_pair.{v} ⥤ C :=
parallel_pair (left_res F U) (right_res F U)

/--
The restriction map `F.obj U ⟶ Π F.obj (U i)` gives a cone over the equalizer diagram
for the sheaf condition. The sheaf condition asserts this cone is a limit cone.
-/
def fork : fork.{v} (left_res F U) (right_res F U) := fork.of_ι _ (w F U)

@[simp]
lemma fork_X : (fork F U).X = F.obj (op (supr U)) := rfl

@[simp]
lemma fork_ι : (fork F U).ι = res F U := rfl
@[simp]
lemma fork_π_app_walking_parallel_pair_zero :
  (fork F U).π.app walking_parallel_pair.zero = res F U := rfl
@[simp]
lemma fork_π_app_walking_parallel_pair_one :
  (fork F U).π.app walking_parallel_pair.one = res F U ≫ left_res F U := rfl

variables {F} {G : presheaf C X}

/-- Isomorphic presheaves have isomorphic `pi_opens` for any cover `U`. -/
@[simp]
def pi_opens.iso_of_iso (α : F ≅ G) : pi_opens F U ≅ pi_opens G U :=
pi.map_iso (λ X, α.app _)

/-- Isomorphic presheaves have isomorphic `pi_inters` for any cover `U`. -/
@[simp]
def pi_inters.iso_of_iso (α : F ≅ G) : pi_inters F U ≅ pi_inters G U :=
pi.map_iso (λ X, α.app _)

/-- Isomorphic presheaves have isomorphic sheaf condition diagrams. -/
def diagram.iso_of_iso (α : F ≅ G) : diagram F U ≅ diagram G U :=
nat_iso.of_components
  begin rintro ⟨⟩, exact pi_opens.iso_of_iso U α, exact pi_inters.iso_of_iso U α end
  begin
    rintro ⟨⟩ ⟨⟩ ⟨⟩,
    { simp, },
    { ext, simp [left_res], },
    { ext, simp [right_res], },
    { simp, },
  end.

/--
If `F G : presheaf C X` are isomorphic presheaves,
then the `fork F U`, the canonical cone of the sheaf condition diagram for `F`,
is isomorphic to `fork F G` postcomposed with the corresponding isomorphism between
sheaf condition diagrams.
-/
def fork.iso_of_iso (α : F ≅ G) :
  fork F U ≅ (cones.postcompose (diagram.iso_of_iso U α).inv).obj (fork G U) :=
begin
  fapply fork.ext,
  { apply α.app, },
  { ext,
    dunfold fork.ι, -- Ugh, `simp` can't unfold abbreviations.
    simp [res, diagram.iso_of_iso], }
end

section open_embedding

variables {V : Top.{v}} {j : V ⟶ X} (oe : open_embedding j)
variables (𝒰 : ι → opens V)

/--
Push forward a cover along an open embedding.
-/
@[simp]
def cover.of_open_embedding : ι → opens X := (λ i, oe.is_open_map.functor.obj (𝒰 i))

/--
The isomorphism between `pi_opens` corresponding to an open embedding.
-/
@[simp]
def pi_opens.iso_of_open_embedding :
  pi_opens (oe.is_open_map.functor.op ⋙ F) 𝒰 ≅ pi_opens F (cover.of_open_embedding oe 𝒰) :=
pi.map_iso (λ X, F.map_iso (iso.refl _))

/--
The isomorphism between `pi_inters` corresponding to an open embedding.
-/
@[simp]
def pi_inters.iso_of_open_embedding :
  pi_inters (oe.is_open_map.functor.op ⋙ F) 𝒰 ≅ pi_inters F (cover.of_open_embedding oe 𝒰) :=
pi.map_iso (λ X, F.map_iso
  begin
    dsimp [is_open_map.functor],
    exact iso.op
    { hom := hom_of_le (by
      { simp only [oe.to_embedding.inj, set.image_inter],
        apply le_refl _, }),
      inv := hom_of_le (by
      { simp only [oe.to_embedding.inj, set.image_inter],
        apply le_refl _, }), },
  end)

/-- The isomorphism of sheaf condition diagrams corresponding to an open embedding. -/
def diagram.iso_of_open_embedding :
  diagram (oe.is_open_map.functor.op ⋙ F) 𝒰 ≅ diagram F (cover.of_open_embedding oe 𝒰) :=
nat_iso.of_components
  begin
    rintro ⟨⟩,
    exact pi_opens.iso_of_open_embedding oe 𝒰,
    exact pi_inters.iso_of_open_embedding oe 𝒰
  end
  begin
    rintro ⟨⟩ ⟨⟩ ⟨⟩,
    { simp, },
    { ext,
      dsimp [left_res, is_open_map.functor],
      simp only [limit.lift_π, cones.postcompose_obj_π, iso.op_hom, discrete.nat_iso_hom_app,
        functor.map_iso_refl, functor.map_iso_hom, lim_map_π_assoc, limit.lift_map, fan.mk_π_app,
        nat_trans.comp_app, category.assoc],
      dsimp,
      rw [category.id_comp, ←F.map_comp],
      refl, },
    { ext,
      dsimp [right_res, is_open_map.functor],
      simp only [limit.lift_π, cones.postcompose_obj_π, iso.op_hom, discrete.nat_iso_hom_app,
        functor.map_iso_refl, functor.map_iso_hom, lim_map_π_assoc, limit.lift_map, fan.mk_π_app,
        nat_trans.comp_app, category.assoc],
      dsimp,
      rw [category.id_comp, ←F.map_comp],
      refl, },
    { simp, },
  end.

/--
If `F : presheaf C X` is a presheaf, and `oe : U ⟶ X` is an open embedding,
then the sheaf condition fork for a cover `𝒰` in `U` for the composition of `oe` and `F` is
isomorphic to sheaf condition fork for `oe '' 𝒰`, precomposed with the isomorphism
of indexing diagrams `diagram.iso_of_open_embedding`.

We use this to show that the restriction of sheaf along an open embedding is still a sheaf.
-/
def fork.iso_of_open_embedding :
  fork (oe.is_open_map.functor.op ⋙ F) 𝒰 ≅
    (cones.postcompose (diagram.iso_of_open_embedding oe 𝒰).inv).obj
      (fork F (cover.of_open_embedding oe 𝒰)) :=
begin
  fapply fork.ext,
  { dsimp [is_open_map.functor],
    exact
    F.map_iso (iso.op
    { hom := hom_of_le
      (by simp only [supr_s, supr_mk, le_def, subtype.coe_mk, set.le_eq_subset, set.image_Union]),
      inv := hom_of_le
      (by simp only [supr_s, supr_mk, le_def, subtype.coe_mk, set.le_eq_subset,
                     set.image_Union]) }), },
  { ext,
    dunfold fork.ι, -- Ugh, it is unpleasant that we need this.
    simp only [res, diagram.iso_of_open_embedding, discrete.nat_iso_inv_app, functor.map_iso_inv,
      limit.lift_π, cones.postcompose_obj_π, functor.comp_map,
      fork_π_app_walking_parallel_pair_zero, pi_opens.iso_of_open_embedding,
      nat_iso.of_components.inv_app, functor.map_iso_refl, functor.op_map, limit.lift_map,
      fan.mk_π_app, nat_trans.comp_app, quiver.hom.unop_op, category.assoc, lim_map_eq_lim_map],
    dsimp,
    rw [category.comp_id, ←F.map_comp],
    refl, },
end

end open_embedding

end sheaf_condition_equalizer_products

end presheaf

end Top