import analysis.inner_product_space.pi_L2
import topology.paracompact

--OUTPUT 1
theorem ℝn_paracompact (n : ℕ) : paracompact_space (euclidean_space ℝ (fin n)) :=
begin
  assume (A : set (euclidean_space ℝ (fin n))) (hA : is_open_cover A),
  have h1 : ∀ m : ℕ, ∃ Cm : set (euclidean_space ℝ (fin n)), is_open_cover Cm ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → x ∈ A) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ m : ℕ, x ∈ (ball (0 : euclidean_space ℝ (fin n)) m) ∧ x ∉ (ball (0 : euclidean_space ℝ (fin n)) (m - 1))) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ m : ℕ, x ∈ (ball (0 : euclidean_space ℝ (fin n)) m) ∧ x ∉ (ball (0 : euclidean_space ℝ (fin n)) (m - 1))), from sorry,
  have h2 : ∀ m : ℕ, ∃ Cm : set (euclidean_space ℝ (fin n)), is_open_cover Cm ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → x ∈ A) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ m : ℕ, x ∈ (ball (0 : euclidean_space ℝ (fin n)) m) ∧ x ∉ (ball (0 : euclidean_space ℝ (fin n)) (m - 1))) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ m : ℕ, x ∈ (ball (0 : euclidean_space ℝ (fin n)) m) ∧ x ∉ (ball (0 : euclidean_space ℝ (fin n)) (m - 1))), from sorry,
  have h3 : ∀ m : ℕ, ∃ Cm : set (euclidean_space ℝ (fin n)), is_open_cover Cm ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → x ∈ A) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ m : ℕ, x ∈ (ball (0 : euclidean_space ℝ (fin n)) m) ∧ x ∉ (ball (0 : euclidean_space ℝ (fin n)) (m - 1))) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ m : ℕ, x ∈ (ball (0 : euclidean_space ℝ (fin n)) m) ∧ x ∉ (ball (0 : euclidean_space ℝ (fin n)) (m - 1))), from sorry,
  have h4 : ∀ m : ℕ, ∃ Cm : set (euclidean_space ℝ (fin n)), is_open_cover Cm ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → x ∈ A) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ m : ℕ, x ∈ (ball (0 : euclidean_space ℝ (fin n)) m) ∧ x ∉ (ball (0 : euclidean_space ℝ (fin n)) (m - 1))) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ m : ℕ, x ∈ (ball (0 : euclidean_space ℝ (fin n)) m) ∧ x ∉ (ball (0 : euclidean_space ℝ (fin n)) (m - 1))), from sorry,
  have h5 : ∀ m : ℕ, ∃ Cm : set (euclidean_space ℝ (fin n)), is_open_cover Cm ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → x ∈ A) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ m : ℕ, x ∈ (ball (0 : euclidean_space ℝ (fin n)) m) ∧ x ∉ (ball (0 : euclidean_space ℝ (fin n)) (m - 1))) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ m : ℕ, x ∈ (ball (0 : euclidean_space ℝ (fin n)) m) ∧ x ∉ (ball (0 : euclidean_space ℝ (fin n)) (m - 1))), from sorry,
  have h6 : ∀ m : ℕ, ∃ Cm : set (euclidean_space ℝ (fin n)), is_open_cover Cm ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → x ∈ A) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ m : ℕ, x ∈ (ball (0 : euclidean_space ℝ (fin n)) m) ∧ x ∉ (ball (0 : euclidean_space ℝ (fin n)) (m - 1))) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ m : ℕ, x ∈ (ball (0 : euclidean_space ℝ (fin n)) m) ∧ x ∉ (ball (0 : euclidean_space ℝ (fin n)) (m - 1))), from sorry,
  have h7 : ∀ m : ℕ, ∃ Cm : set (euclidean_space ℝ (fin n)), is_open_cover Cm ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → x ∈ A) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ m : ℕ, x ∈ (ball (0 : euclidean_space ℝ (fin n)) m) ∧ x ∉ (ball (0 : euclidean_space ℝ (fin n)) (m - 1))) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ m : ℕ, x ∈ (ball (0 : euclidean_space ℝ (fin n)) m) ∧ x ∉ (ball (0 : euclidean_space ℝ (fin n)) (m - 1))), from sorry,
  have h8 : ∀ m : ℕ, ∃ Cm : set (euclidean_space ℝ (fin n)), is_open_cover Cm ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → x ∈ A) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ m : ℕ, x ∈ (ball (0 : euclidean_space ℝ (fin n)) m) ∧ x ∉ (ball (0 : euclidean_space ℝ (fin n)) (m - 1))) ∧ (∀ x : euclidean_space ℝ (fin n), x ∈ Cm → ∃ m : ℕ, x ∈ (ball (0 : euclidean_space ℝ (fin n)) m) ∧ x ∉ (ball (0 : euclidean_space ℝ (fin n)) (m - 1))), from
end --Needs more than 2000 tokens!

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

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

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

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

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

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

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from 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)-/


-- Copyright 2022-2023 VMware, Inc.
-- SPDX-License-Identifier: BSD-2-Clause

import .incremental
import .relational
import .relational_incremental

open zset

class schema :=
  -- the schemas for the two tables, T and R
  (T R : Type)
  -- t.a > 2
  -- r.s > 5
  (σT : T → Prop) (σR : R → Prop)
  -- the type of t1.x, t2.y, and the common id field
  (T1X T2Y Id : Type)
  (π1 : T → T1X × Id) (π2 : R → Id × T2Y).

def πxy (S: schema) (t : (S.T1X × S.Id) × (S.Id × S.T2Y)) : S.T1X × S.T2Y :=
  (t.1.1, t.2.2).

class schema_ok (S: schema) :=
  (i1 : decidable_eq S.T)
  (i2 : decidable_eq S.R)
  (i3 : decidable_pred S.σT)
  (i4 : decidable_pred S.σR)
  (i5 : decidable_eq S.T1X)
  (i6 : decidable_eq S.T2Y)
  (i7 : decidable_eq S.Id).

section instances.
open schema_ok.
attribute [instance] i1 i2 i3 i4 i5 i6 i7.
end instances.

variables (S: schema) [schema_ok S].

def t1 : Z[S.T] → Z[S.T1X × S.Id] :=
  λ t, zset.distinct (zset.map S.π1 (zset.distinct (filter S.σT (zset.distinct t)))).

def t2 : Z[S.R] → Z[S.Id × S.T2Y] :=
  λ r, zset.distinct (zset.map S.π2 (zset.distinct (filter S.σR (zset.distinct r)))).

def V : Z[S.T] → Z[S.R] → Z[S.T1X × S.T2Y] :=
  λ t r, zset.distinct
    (zset.map (πxy S)
      (equi_join prod.snd prod.fst (t1 S t) (t2 S r))).

-- set up optimizations

/- pos_equiv says f1 and f2 are equivalent on positive inputs -/
def pos_equiv {A B: Type} [decidable_eq A] [decidable_eq B]
  (f1 f2: Z[A] → Z[B]) :=
  ∀ i, is_bag i → f1 i = f2 i.

def pos_equiv2 {A B C: Type} [decidable_eq A] [decidable_eq B] [decidable_eq C]
  (f1 f2: Z[A] → Z[B] → Z[C]) :=
  ∀ i1 i2, is_bag i1 → is_bag i2 → f1 i1 i2 = f2 i1 i2.

infix ` =≤= `:50 := pos_equiv.
infix ` =≤2= `:50 := pos_equiv2.

/-- `same` is a technical device for automation purposes. It is just equality,
  but marked irreducible.

  The way this is used is that we can work on a goal `same x ?y` (where `?y` is
  an existential variable), gradually rewriting x to simplify it. If we tried to
  prove `x = ?y`, then `rw` an `simp` would always try to instantiate ?y with x,
  even if we want to continue rewriting.

  To make intermediate goals readable we provide `x === y` as notation for `same
  x y`.
   -/
def same {A : Type} (x y: A) := x = y.
lemma same_def {A} (x y: A) : same x y = (x = y) := rfl.
local attribute [irreducible] same.

lemma same_intro {A: Type} (x y: A) : same x y → x = y :=
  by { rw same_def, finish, }.

lemma same_elim {A: Type} (x: A) : same x x :=
  by { rw same_def, }.

infix ` === `:50 := same.

structure sig (A: Type) (p: A → Prop) :=
  (witness: A)
  (pf: p witness).

def t1_opt_goal : sig (Z[S.T] → Z[S.T1X × S.Id])
                  (λ opt, t1 S =≤= opt) :=
begin
  econstructor,
  intros t hpos,
  apply same_intro,
  simp [t1],
  rw filter_distinct_dedup,
  rw map_distinct_dedup,
  swap, { apply filter_pos, assumption, },
  apply same_elim,
end

-- TODO: reduce this first
def t1_opt := (t1_opt_goal S).witness.
def t1_opt_ok : t1 S =≤= t1_opt S := (t1_opt_goal S).pf.

def t2_opt_goal : sig (Z[S.R] → Z[S.Id × S.T2Y])
                  (λ opt, t2 S =≤= opt) :=
begin
  econstructor,
  intros t hpos,
  apply same_intro,
  simp [t2],
  rw filter_distinct_dedup,
  rw map_distinct_dedup,
  swap, { apply filter_pos, assumption, },
  apply same_elim,
end

def v_opt_goal : sig (Z[S.T] → Z[S.R] → Z[S.T1X × S.T2Y])
                  (λ opt, V S =≤2= opt) :=
begin
  econstructor, intros i1 i2 hpos1 hpos2,
  apply same_intro,
  simp [V],
  rw (t1_opt_goal S).pf _ (by assumption),
  rw (t2_opt_goal S).pf _ (by assumption),
  simp [t1_opt_goal, t2_opt_goal],
  rw join_distinct_comm, rotate,
  { apply map_pos, apply filter_pos, assumption, },
  { apply map_pos, apply filter_pos, assumption, },
  rw map_distinct_dedup, rotate,
  { apply equi_join_pos; apply map_pos; apply filter_pos; assumption },
  apply same_elim,
end

/- The optimized ℤ-set query from the paper -/
def Vopt (t1: Z[S.T]) (t2: Z[S.R]) :=
  distinct $ zset.map (πxy S)
    (equi_join prod.snd prod.fst
      (zset.map schema.π1 (filter schema.σT t1))
      (zset.map schema.π2 (filter schema.σR t2))).

-- the simplifications above produce exactly what's in the paper
lemma v_opt_ok : V S =≤2= Vopt S :=
  (v_opt_goal S).pf.

lemma v_lifted : ↑²(Vopt S) =
  λ t1 t2, ↑↑distinct (↑↑(zset.map (πxy S)) (↑²(equi_join prod.snd prod.fst)
      (↑↑(zset.map schema.π1) (↑↑(filter schema.σT) t1))
      (↑↑(zset.map schema.π2) (↑↑(filter schema.σR) t2)))) :=
begin
  refl,
end

/- This is the intermediate incremental circuit -/
def VΔ1 (t1: stream Z[S.T]) (t2: stream Z[S.R]) :=
  (↑↑distinct)^Δ $ ↑↑(zset.map (πxy S)) $ ↑²(equi_join prod.snd prod.fst)^Δ2
      (↑↑(zset.map schema.π1) (↑↑(filter schema.σT) t1))
      (↑↑(zset.map schema.π2) (↑↑(filter schema.σR) t2)).

lemma VΔ1_ok :
  ↑²(Vopt S)^Δ2 = VΔ1 S :=
begin
  funext t1 t2,
  -- hide the right-hand side
  transitivity,
  { apply same_intro,
    rw v_lifted, dsimp,
    dsimp only [incremental2],
    repeat { rw D_push2 <|> rw D_push }, simp,
    -- TODO: why does this have to be done explicitly?
    rw (map_incremental (πxy S)),
    rw (map_incremental schema.π1), simp,
    rw (map_incremental schema.π2), simp,
    apply same_elim, },
  { refl },
end

def VΔ (t1: stream Z[S.T]) (t2: stream Z[S.R]) :=
  distinct_incremental $ ↑↑(zset.map $ πxy S) $ times_incremental ↑²(equi_join prod.snd prod.fst)
      (↑↑(zset.map schema.π1) (↑↑(filter schema.σT) t1))
      (↑↑(zset.map schema.π2) (↑↑(filter schema.σR) t2)).

theorem VΔ_ok :
  ↑²(Vopt S)^Δ2 = VΔ S :=
begin
  rw VΔ1_ok, funext t1 t2, unfold VΔ1,
  rw distinct_incremental_ok,
  rw equi_join_incremental,
  refl,
end


import Kenny.sandbox

universes u v w u₁ v₁ w₁

namespace ulift

variables (X : Type u) [topological_space X]

instance : topological_space (ulift.{v} X) :=
topological_space.coinduced ulift.up _inst_1

end ulift

theorem continuous_up {X : Type u} [topological_space X] : continuous (ulift.up : X → ulift.{v} X) :=
λ U, id

theorem continuous_down {X : Type u} [topological_space X] : continuous (ulift.down : ulift.{v} X → X) :=
λ U, id

structure open_subspace (X : Type u) [topological_space X] :=
(U : Type v)
[top : topological_space U]
(inc : U → X)
(inj : function.injective inc)
(cont : continuous inc)
(op : ∀ {V : set U}, is_open V → is_open (inc '' V))
attribute [instance] open_subspace.top

namespace open_subspace

variables (X : Type u) [topological_space X]

instance : has_coe_to_sort (open_subspace X) :=
⟨_, open_subspace.U⟩

instance (U : open_subspace X) : topological_space U :=
U.top

def of_set (U : set X) (HU : is_open U) : open_subspace.{u u} X :=
{ U := U,
  inc := subtype.val,
  inj := subtype.val_injective,
  cont := continuous_induced_dom,
  op := λ V ⟨S, HS, HSV⟩, by rw [← HSV, subtype.image_preimage_val]; exact is_open_inter HS HU }

protected def ulift (U : open_subspace X) : open_subspace X :=
{ U := ulift U,
  inc := λ x, U.inc x.down,
  inj := function.injective_comp U.inj $ function.injective_of_left_inverse $ ulift.up_down,
  cont := U.cont.comp continuous_down,
  op := λ V HV, by rw [set.image_comp, set.image_eq_preimage_of_inverse ulift.up_down ulift.down_up];
    exact U.op (continuous_up _ HV) }

-- instance : has_inter (open_subspace X) :=
-- ⟨λ U V,
-- { U := { p : U × V // U.inc p.1 = V.inc p.2 },
--   inc := λ p, U.inc p.1.1,
--   inj := λ p q H, subtype.eq $ prod.ext (U.inj H) $ V.inj $
--     calc  V.inc p.1.2
--         = U.inc p.1.1 : p.2.symm
--     ... = U.inc q.1.1 : H
--     ... = V.inc q.1.2 : q.2,
--   cont := continuous.comp (continuous.comp continuous_induced_dom continuous_fst) U.cont,
--   op := λ W HW, by rw set.image_comp; exact U.op _ }⟩

end open_subspace

namespace gluing_data

protected structure topological_space :=
(left : Type u)
(right : Type v)
[topl : topological_space left]
[topr : topological_space right]
(osl : open_subspace left)
(osr : open_subspace right)
(maplr : osl → osr)
(maprl : osr → osl)
(contlr : continuous maplr)
(contrl : continuous maprl)
(lrl : ∀ x, maprl (maplr x) = x)
(rlr : ∀ x, maplr (maprl x) = x)
attribute [instance] gluing_data.topological_space.topl gluing_data.topological_space.topr

end gluing_data

namespace gluing

inductive topological_space.r (d : gluing_data.topological_space) :
  d.left ⊕ d.right → d.left ⊕ d.right → Prop
| refl : ∀ p, topological_space.r p p
| inlr : ∀ p : d.osl, topological_space.r (sum.inl (d.osl.inc p)) (sum.inr (d.osr.inc (d.maplr p)))
| inrl : ∀ p : d.osr, topological_space.r (sum.inr (d.osr.inc p)) (sum.inl (d.osl.inc (d.maprl p)))
attribute [refl] topological_space.r.refl

instance topological_space.setoid (d : gluing_data.topological_space) :
  setoid (d.left ⊕ d.right) :=
{ r := topological_space.r d,
  iseqv := ⟨topological_space.r.refl,
  begin
    rintros (p|p) (q|q) h,
    { cases h, refl },
    { cases h with _ p, convert topological_space.r.inrl (d.maplr p), rw d.lrl },
    { cases h with _ _ p, convert topological_space.r.inlr (d.maprl p), rw d.rlr },
    { cases h, refl }
  end,
  begin
    rintros (p|p) (q|q) r h1 h2,
    { cases h1, exact h2 },
    { cases h2,
      case gluing.topological_space.r.refl { exact h1 },
      case gluing.topological_space.r.inrl : q {
        generalize_hyp hr : d.osr.inc q = r at h1, cases h1 with _ r,
        replace hr := d.osr.inj hr, subst hr, rw d.lrl } },
    { cases h2,
      case gluing.topological_space.r.refl { exact h1 },
      case gluing.topological_space.r.inlr : q {
        generalize_hyp hr : d.osl.inc q = r at h1, cases h1 with _ r,
        replace hr := d.osl.inj hr, subst hr, rw d.rlr } },
    { cases h1, exact h2 }
  end⟩ }

protected def topological_space (d : gluing_data.topological_space) : Type* :=
quotient $ topological_space.setoid d

end gluing

namespace projective_line

end projective_line


import Radon.main
import Radon.png_reflects_limits

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

variables (X : Profinite.{0}) (p : ℝ≥0)
instance why_do_I_need_this : add_comm_group (weak_dual ℝ C(X,ℝ)) :=
show add_comm_group (C(X,ℝ) →L[ℝ] ℝ), by apply_instance

lemma bdd_neg {c} (a : weak_dual ℝ C(X,ℝ)) (ha : a.bdd p c) : (-a).bdd p c :=
λ e, by simpa only [continuous_linear_map.neg_apply, nnnorm_neg] using ha e

section p_pos
variables [fact (0 < p)]

lemma bdd_zero : (0 : weak_dual ℝ C(X,ℝ)).bdd p 0 :=
λ e, by {
  refine (finset.sum_eq_zero (λ x hx, _)).le,
  rw [continuous_linear_map.zero_apply, nnnorm_zero],
  exact nnreal.rpow_eq_zero_iff.mpr ⟨rfl, (nnreal.coe_pos.mpr (fact.out _)).ne'⟩ }

section p_le_one
variables [fact (p ≤ 1)]

lemma bdd_add {ca cb} (a b : weak_dual ℝ C(X,ℝ)) (ha : a.bdd p ca) (hb : b.bdd p cb) :
  (a + b).bdd p (ca + cb) :=
begin
  intros e,
  --  `dsimp` is unneeded and slowly changes the goal to
  -- `∑ (t : ↥e), ∥⇑a (e.fibre t).indicator + ⇑b (e.fibre t).indicator∥₊ ^ ↑p ≤ ca + cb`,
  refine le_trans _ (add_le_add (ha e) (hb e)),
  rw ← finset.sum_add_distrib,
  apply finset.sum_le_sum, rintros i -,
  refine le_trans _ (nnreal.rpow_add_le_add_rpow _ _ _ $
    (nnreal.coe_le_coe.mpr (fact.out _)).trans nnreal.coe_one.le),
  refine nnreal.rpow_le_rpow _ _,
  { apply nnnorm_add_le },
  repeat { exact (nnreal.coe_pos.mpr (fact.out _)).le },
end

/-- An auxiliary definition to be used in the constructions below. -/
def bdd_weak_dual : add_subgroup (weak_dual ℝ C(X,ℝ)) :=
{ carrier := { μ | ∃ c, μ.bdd p c },
  add_mem' := λ a b ha hb, begin
    obtain ⟨ca, ha⟩ := ha,
    obtain ⟨cb, hb⟩ := hb,
    use ca + cb,
    apply bdd_add _ _ _ _ ha hb,
  end,
  zero_mem' := ⟨0, bdd_zero _ _⟩,
  neg_mem' := λ a ha, begin
    obtain ⟨c,ha⟩ := ha,
    use c,
    apply bdd_neg _ _ _ ha,
  end }

instance : pseudo_normed_group (X.bdd_weak_dual p) :=
{ filtration := λ c, {μ | μ.1.bdd p c},
  filtration_mono := λ c₁ c₂ h μ hμ e, by apply le_trans (hμ e) h,
  zero_mem_filtration := λ c e, le_trans (bdd_zero _ _ _) (zero_le _),
  neg_mem_filtration := λ c μ hμ e, bdd_neg _ _ _ hμ _,
  add_mem_filtration := λ c₁ c₂ a b ha hb, bdd_add _ _ _ _ ha hb }

instance topological_space_bdd_weak_dual_filtration (c : ℝ≥0) :
  topological_space (pseudo_normed_group.filtration (X.bdd_weak_dual p) c) :=
topological_space.induced (λ μ, μ.1.1) infer_instance

/-- An auxiliary definition to be used in the constructions below. -/
def bdd_weak_dual_filtration_homeo (c : ℝ≥0) :
  (pseudo_normed_group.filtration (X.bdd_weak_dual p) c) ≃ₜ
  X.Radon p c :=
{ to_fun := λ μ, ⟨μ.1.1, μ.2⟩,
  inv_fun := λ μ, ⟨⟨μ.1, ⟨c, μ.2⟩⟩, μ.2⟩,
  left_inv := λ μ, by { ext, refl },
  right_inv := λ μ, by { ext, refl },
  continuous_to_fun := begin
    apply continuous.subtype_mk,
    exact continuous_induced_dom,
  end,
  continuous_inv_fun := begin
    rw continuous_induced_rng,
    exact continuous_subtype_coe
  end }

instance : comphaus_filtered_pseudo_normed_group (X.bdd_weak_dual p) :=
{ t2 := λ c, (X.bdd_weak_dual_filtration_homeo p c).symm.t2_space,
  compact := λ c, (X.bdd_weak_dual_filtration_homeo p c).symm.compact_space,
  continuous_add' := begin
    intros c₁ c₂,
    rw continuous_induced_rng,
    let i1 :
      (pseudo_normed_group.filtration ↥(X.bdd_weak_dual p) c₁) ×
      (pseudo_normed_group.filtration ↥(X.bdd_weak_dual p) c₂) →
      weak_dual ℝ C(X,ℝ) × weak_dual ℝ C(X,ℝ) :=
      prod.map (λ μ, μ.1.1) (λ μ, μ.1.1),
    let i2 :
      weak_dual ℝ C(X,ℝ) × weak_dual ℝ C(X,ℝ) → weak_dual ℝ C(X,ℝ) :=
      (λ a, a.1 + a.2),
    change continuous (i2 ∘ i1),
    apply continuous.comp,
    exact continuous_add,
    refine continuous.prod_map _ _,
    exact continuous_induced_dom,
    exact continuous_induced_dom,
  end,
  continuous_neg' := begin
    intros c,
    rw continuous_induced_rng,
    let i1 :
      (pseudo_normed_group.filtration ↥(X.bdd_weak_dual p) c) →
      weak_dual ℝ C(X,ℝ) := λ μ, μ.1.1,
    let i2 : weak_dual ℝ C(X,ℝ) → weak_dual ℝ C(X,ℝ) := λ μ, -μ,
    change continuous (i2 ∘ i1),
    apply continuous.comp,
    apply weak_dual.continuous_of_continuous_eval,
    intros f,
    dsimp [i2],
    have : (λ (a : weak_dual ℝ C(↥X, ℝ)), -a f) =
      (λ (a : weak_dual ℝ C(↥X, ℝ)), a (-f)), by { ext, simp },
    rw this, apply weak_dual.eval_continuous,
    exact continuous_induced_dom,
  end,
  continuous_cast_le := begin
    introsI c₁ c₂ h,
    rw continuous_induced_rng,
    exact continuous_induced_dom,
  end,
  ..(infer_instance : pseudo_normed_group (X.bdd_weak_dual p)) }

/-- The space of `p`-Radon measures on `X`, as a CompHaus-ly filtered pseudo normed group`. -/
def Radon_png : CompHausFiltPseuNormGrp₁ :=
{ M := X.bdd_weak_dual p,
  exhaustive' := λ μ, μ.2 }

/-- A continuous map of profinite spaces induces a morphism between `Radon_png p`. -/
def map_Radon_png {X Y : Profinite.{0}} (f : X ⟶ Y) :
  X.Radon_png p ⟶ Y.Radon_png p :=
{ to_fun := λ μ, ⟨weak_dual.comap f.comap μ.1, begin
    obtain ⟨c,hc⟩ := μ.2,
    use c,
    apply weak_dual.bdd_comap _ hc,
  end⟩,
  map_zero' := by { ext, refl },
  map_add' := λ a b, by { ext, refl },
  strict' := λ c μ hμ,
    weak_dual.bdd_comap _ hμ _,
  continuous' := begin
    intros c,
    rw continuous_induced_rng,
    let i1 : pseudo_normed_group.filtration ↥(X.Radon_png p) c →
      weak_dual _ _ := λ μ, μ.1.1,
    let i2 : weak_dual ℝ C(↥X, ℝ) → weak_dual ℝ C(↥Y, ℝ) :=
      weak_dual.comap (f.comap),
    change continuous (i2 ∘ i1),
    refine continuous.comp _ continuous_induced_dom,
    refine continuous_linear_map.continuous _,
  end }

/-- A functorial version of `Radon_png`. -/
def Radon_png_functor : Profinite.{0} ⥤ CompHausFiltPseuNormGrp₁ :=
{ obj := λ X, X.Radon_png p,
  map := λ X Y, map_Radon_png _,
  map_id' := λ X, by { ext, dsimp [map_Radon_png, weak_dual.comap], congr' 1,
    ext, refl },
  map_comp' := λ X Y Z f g, by { ext, refl } }

/-- The cone exhibiting `X.Radon_png p` as a limit of `T.Radon_png p` as
`T` varies over the discrete quotients of `X`. -/
def Radon_png_cone : cone (X.diagram ⋙ Radon_png_functor p) :=
(Radon_png_functor p).map_cone X.as_limit_cone

/-- An auxiliary definition to be used in the constructions below. -/
def Radon_png_functor_level_iso_component (c : ℝ≥0) (X : Profinite.{0}) :
  (CompHausFiltPseuNormGrp₁.level.obj c).obj (X.Radon_png p) ≅
  (Radon_CompHaus_functor p c).obj X :=
let e := (bdd_weak_dual_filtration_homeo X p c) in
{ hom := e.to_continuous_map,
  inv := e.symm.to_continuous_map,
  hom_inv_id' := by { ext, refl },
  inv_hom_id' := by { ext, refl } }

/-- An auxiliary definition to be used in the constructions below. -/
def Radon_png_functor_level_iso (c : ℝ≥0) :
  Radon_png_functor p ⋙ CompHausFiltPseuNormGrp₁.level.obj c ≅
  Radon_CompHaus_functor p c :=
nat_iso.of_components
(λ X, Radon_png_functor_level_iso_component _ _ _)
(λ X Y f, by { ext, refl })

/-- An auxiliary definition to be used in the constructions below. -/
def is_limit_Radon_png_cone_map_level (c : ℝ≥0) :
  is_limit ((Radon_png_functor p ⋙
    CompHausFiltPseuNormGrp₁.level.obj c).map_cone X.as_limit_cone) :=
{ lift := λ S,
    (X.is_limit_Radon_CompHaus_cone p c).lift
    ⟨_, S.π ≫ whisker_left _ (Radon_png_functor_level_iso p c).hom⟩ ≫
    (Radon_png_functor_level_iso p c).inv.app _,
  fac' := begin
    intros S j,
    erw [category.assoc, ← nat_trans.naturality,
      (X.is_limit_Radon_CompHaus_cone p c).fac_assoc],
    dsimp, simp only [category.assoc, iso.hom_inv_id_app],
    erw category.comp_id,
  end,
  uniq' := begin
    intros S m hm,
    rw [← nat_iso.app_inv, iso.eq_comp_inv],
    apply (X.is_limit_Radon_CompHaus_cone p c).hom_ext, intros j,
    erw (X.is_limit_Radon_CompHaus_cone p c).fac,
    dsimp, rw ← hm, dsimp, simp only [category.assoc],
    erw ← nat_trans.naturality,
  end }

/-- As promised, `X.Radon_png p` is a limit cone. -/
def is_limit_Radon_png_cone : is_limit (X.Radon_png_cone p) :=
CompHausFiltPseuNormGrp₁.level_jointly_reflects_limits _ $
λ c, is_limit_Radon_png_cone_map_level _ _ _

/-- An auxiliary definition to be used in the constructions below. -/
def Radon_png_comparison_component (T : discrete_quotient X) :
  (X.diagram ⋙ Radon_png_functor p).obj T ≅
  (X.fintype_diagram ⋙ real_measures.functor p).obj T :=
CompHausFiltPseuNormGrp₁.create_iso_from_level.{0}
(λ c, Radon_png_functor_level_iso_component _ _ _ ≪≫
  (Radon_CompHaus_comparison _ _ _).app _)
begin
  ext, refl,
end
begin
  intros a b,
  ext, refl,
end begin
  intros c₁ c₂ i,
  ext, refl, -- ;-D
end

/-- An auxiliary definition to be used in the constructions below. -/
def Radon_png_comparison :
  X.diagram ⋙ Radon_png_functor p ≅
  X.fintype_diagram ⋙ real_measures.functor p :=
nat_iso.of_components
(λ T, Radon_png_comparison_component _ _ _)
begin
  intros S T f,
  dsimp only [Radon_png_comparison_component, iso.trans_hom],
  apply CompHausFiltPseuNormGrp₁.level_jointly_faithful,
  intros c,
  simp only [functor.map_comp],
  simp_rw [CompHausFiltPseuNormGrp₁.level_create_iso_from_level.{0},
    iso.trans_hom, nat_iso.app_hom, category.assoc],
  erw ← (X.Radon_CompHaus_comparison p c).hom.naturality f,
  refl,
end

/-- The CompHaus-ly filtered pseudno normed group of signed `p`-Radon measures on `X`
is isomorphic to the limit of `real_measures p T` as `T` varies over
the discrete quotients of `X`.

This is the final key isomorphism needed for the comparison of Raon measures and
`ℳ_p(X)`. -/
def Radon_png_iso : X.Radon_png p ≅
  (Profinite.extend (real_measures.functor p)).obj X :=
(X.is_limit_Radon_png_cone p).cone_point_unique_up_to_iso
  (limit.is_limit _) ≪≫ has_limit.iso_of_nat_iso (X.Radon_png_comparison p)

end p_le_one

end p_pos

end Profinite


/-
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.monoidal.braided
import category_theory.monoidal.Mon_

/-!
# The category of commutative monoids in a braided monoidal category.
-/

universes v₁ v₂ u₁ u₂

open category_theory
open category_theory.monoidal_category

variables (C : Type u₁) [category.{v₁} C] [monoidal_category.{v₁} C] [braided_category.{v₁} C]

/--
A commutative monoid object internal to a monoidal category.
-/
structure CommMon_ extends Mon_ C :=
(mul_comm' : (β_ _ _).hom ≫ mul = mul . obviously)

restate_axiom CommMon_.mul_comm'
attribute [simp, reassoc] CommMon_.mul_comm

namespace CommMon_

/--
The trivial commutative monoid object. We later show this is initial in `CommMon_ C`.
-/
@[simps]
def trivial : CommMon_ C :=
{ mul_comm' := begin dsimp, rw [braiding_left_unitor, unitors_equal], end
  ..Mon_.trivial C }

instance : inhabited (CommMon_ C) := ⟨trivial C⟩

variables {C} {M : CommMon_ C}

instance : category (CommMon_ C) :=
induced_category.category CommMon_.to_Mon_

@[simp] lemma id_hom (A : CommMon_ C) : Mon_.hom.hom (𝟙 A) = 𝟙 A.X := rfl
@[simp] lemma comp_hom {R S T : CommMon_ C} (f : R ⟶ S) (g : S ⟶ T) :
  Mon_.hom.hom (f ≫ g) = f.hom ≫ g.hom := rfl

section
variables (C)

/-- The forgetful functor from commutative monoid objects to monoid objects. -/
@[derive [full, faithful]]
def forget₂_Mon_ : CommMon_ C ⥤ Mon_ C :=
induced_functor CommMon_.to_Mon_

@[simp] lemma forget₂_Mon_obj_one (A : CommMon_ C) : ((forget₂_Mon_ C).obj A).one = A.one := rfl
@[simp] lemma forget₂_Mon_obj_mul (A : CommMon_ C) : ((forget₂_Mon_ C).obj A).mul = A.mul := rfl
@[simp] lemma forget₂_Mon_map_hom {A B : CommMon_ C} (f : A ⟶ B) :
  ((forget₂_Mon_ C).map f).hom = f.hom := rfl

end

instance unique_hom_from_trivial (A : CommMon_ C) : unique (trivial C ⟶ A) :=
Mon_.unique_hom_from_trivial A.to_Mon_

open category_theory.limits

instance : has_initial (CommMon_ C) :=
has_initial_of_unique (trivial C)

end CommMon_

namespace category_theory.lax_braided_functor

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

/--
A lax braided functor takes commutative monoid objects to commutative monoid objects.

That is, a lax braided functor `F : C ⥤ D` induces a functor `CommMon_ C ⥤ CommMon_ D`.
-/
@[simps]
def map_CommMon (F : lax_braided_functor C D) : CommMon_ C ⥤ CommMon_ D :=
{ obj := λ A,
  { mul_comm' :=
    begin
      dsimp,
      have := F.braided,
      slice_lhs 1 2 { rw ←this, },
      slice_lhs 2 3 { rw [←category_theory.functor.map_comp, A.mul_comm], },
    end,
    ..F.to_lax_monoidal_functor.map_Mon.obj A.to_Mon_ },
  map := λ A B f, F.to_lax_monoidal_functor.map_Mon.map f, }

variables (C) (D)

/-- `map_CommMon` is functorial in the lax braided functor. -/
def map_CommMon_functor : (lax_braided_functor C D) ⥤ (CommMon_ C ⥤ CommMon_ D) :=
{ obj := map_CommMon,
  map := λ F G α,
  { app := λ A,
    { hom := α.app A.X, } } }

end category_theory.lax_braided_functor

namespace CommMon_

open category_theory.lax_braided_functor

namespace equiv_lax_braided_functor_punit

/-- Implementation of `CommMon_.equiv_lax_braided_functor_punit`. -/
@[simps]
def lax_braided_to_CommMon : lax_braided_functor (discrete punit) C ⥤ CommMon_ C :=
{ obj := λ F, (F.map_CommMon : CommMon_ _ ⥤ CommMon_ C).obj (trivial (discrete punit)),
  map := λ F G α, ((map_CommMon_functor (discrete punit) C).map α).app _ }

/-- Implementation of `CommMon_.equiv_lax_braided_functor_punit`. -/
@[simps]
def CommMon_to_lax_braided : CommMon_ C ⥤ lax_braided_functor (discrete punit) C :=
{ obj := λ A,
  { obj := λ _, A.X,
    map := λ _ _ _, 𝟙 _,
    ε := A.one,
    μ := λ _ _, A.mul,
    map_id' := λ _, rfl,
    map_comp' := λ _ _ _ _ _, (category.id_comp (𝟙 A.X)).symm, },
  map := λ A B f,
  { app := λ _, f.hom,
    naturality' := λ _ _ _, by { dsimp, rw [category.id_comp, category.comp_id], },
    unit' := f.one_hom,
    tensor' := λ _ _, f.mul_hom, }, }

/-- Implementation of `CommMon_.equiv_lax_braided_functor_punit`. -/
@[simps]
def unit_iso :
  𝟭 (lax_braided_functor (discrete punit) C) ≅
    lax_braided_to_CommMon C ⋙ CommMon_to_lax_braided C :=
nat_iso.of_components (λ F, lax_braided_functor.mk_iso
  (monoidal_nat_iso.of_components
    (λ _, F.to_lax_monoidal_functor.to_functor.map_iso (eq_to_iso (by ext)))
    (by tidy) (by tidy) (by tidy)))
  (by tidy)

/-- Implementation of `CommMon_.equiv_lax_braided_functor_punit`. -/
@[simps]
def counit_iso : CommMon_to_lax_braided C ⋙ lax_braided_to_CommMon C ≅ 𝟭 (CommMon_ C) :=
nat_iso.of_components (λ F, { hom := { hom := 𝟙 _, }, inv := { hom := 𝟙 _, } })
  (by tidy)

end equiv_lax_braided_functor_punit

open equiv_lax_braided_functor_punit

/--
Commutative monoid objects in `C` are "just" braided lax monoidal functors from the trivial
braided monoidal category to `C`.
-/
@[simps]
def equiv_lax_braided_functor_punit : lax_braided_functor (discrete punit) C ≌ CommMon_ C :=
{ functor := lax_braided_to_CommMon C,
  inverse := CommMon_to_lax_braided C,
  unit_iso := unit_iso C,
  counit_iso := counit_iso C, }

end CommMon_


/-
Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.uniform_space.cauchy
import Mathlib.topology.uniform_space.separation
import Mathlib.topology.dense_embedding
import Mathlib.PostPort

universes u_1 u_2 u_3

namespace Mathlib

/-!
# Theory of complete separated uniform spaces.

This file is for elementary lemmas that depend on both Cauchy filters and separation.
-/

/-In a separated space, a complete set is closed -/

theorem is_complete.is_closed {α : Type u_1} [uniform_space α] [separated_space α] {s : set α} (h : is_complete s) : is_closed s := sorry

namespace dense_inducing

theorem continuous_extend_of_cauchy {α : Type u_1} [topological_space α] {β : Type u_2} [topological_space β] {γ : Type u_3} [uniform_space γ] [complete_space γ] [separated_space γ] {e : α → β} {f : α → γ} (de : dense_inducing e) (h : ∀ (b : β), cauchy (filter.map f (filter.comap e (nhds b)))) : continuous (extend de f) :=
  continuous_extend de fun (b : β) => complete_space.complete (h b)


/-
Copyright (c) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Stephen Morgan, Scott Morrison
-/
import category_theory.eq_to_hom

/-!
# Cartesian products of categories

We define the category instance on `C × D` when `C` and `D` are categories.

We define:
* `sectl C Z` : the functor `C ⥤ C × D` given by `X ↦ ⟨X, Z⟩`
* `sectr Z D` : the functor `D ⥤ C × D` given by `Y ↦ ⟨Z, Y⟩`
* `fst`       : the functor `⟨X, Y⟩ ↦ X`
* `snd`       : the functor `⟨X, Y⟩ ↦ Y`
* `swap`      : the functor `C × D ⥤ D × C` given by `⟨X, Y⟩ ↦ ⟨Y, X⟩`
    (and the fact this is an equivalence)

We further define `evaluation : C ⥤ (C ⥤ D) ⥤ D` and `evaluation_uncurried : C × (C ⥤ D) ⥤ D`,
and products of functors and natural transformations, written `F.prod G` and `α.prod β`.
-/

namespace category_theory

-- declare the `v`'s first; see `category_theory.category` for an explanation
universes v₁ v₂ v₃ v₄ u₁ u₂ u₃ u₄

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

/--
`prod C D` gives the cartesian product of two categories.

See <https://stacks.math.columbia.edu/tag/001K>.
-/
@[simps {not_recursive := []}] -- the generates simp lemmas like `id_fst` and `comp_snd`
instance prod : category.{max v₁ v₂} (C × D) :=
{ hom     := λ X Y, ((X.1) ⟶ (Y.1)) × ((X.2) ⟶ (Y.2)),
  id      := λ X, ⟨ 𝟙 (X.1), 𝟙 (X.2) ⟩,
  comp    := λ _ _ _ f g, (f.1 ≫ g.1, f.2 ≫ g.2) }

/-- Two rfl lemmas that cannot be generated by `@[simps]`. -/
@[simp]

lemma is_iso_prod_iff {P Q : C} {S T : D} {f : (P, S) ⟶ (Q, T)} :
  is_iso f ↔ is_iso f.1 ∧ is_iso f.2 :=
begin
  split,
  { rintros ⟨g, hfg, hgf⟩,
    simp at hfg hgf,
    rcases hfg with ⟨hfg₁, hfg₂⟩,
    rcases hgf with ⟨hgf₁, hgf₂⟩,
    exact ⟨⟨⟨g.1, hfg₁, hgf₁⟩⟩, ⟨⟨g.2, hfg₂, hgf₂⟩⟩⟩ },
  { rintros ⟨⟨g₁, hfg₁, hgf₁⟩, ⟨g₂, hfg₂, hgf₂⟩⟩,
    dsimp at hfg₁ hgf₁ hfg₂ hgf₂,
    refine ⟨⟨(g₁, g₂), _, _⟩⟩; { simp; split; assumption } }
end

section
variables {C D}

/-- Construct an isomorphism in `C × D` out of two isomorphisms in `C` and `D`. -/
@[simps]
def iso.prod {P Q : C} {S T : D} (f : P ≅ Q) (g : S ≅ T) : (P, S) ≅ (Q, T) :=
{ hom := (f.hom, g.hom),
  inv := (f.inv, g.inv), }

end

end

section
variables (C : Type u₁) [category.{v₁} C] (D : Type u₁) [category.{v₁} D]
/--
`prod.category.uniform C D` is an additional instance specialised so both factors have the same
universe levels. This helps typeclass resolution.
-/
instance uniform_prod : category (C × D) := category_theory.prod C D
end

-- Next we define the natural functors into and out of product categories. For now this doesn't
-- address the universal properties.
namespace prod

/-- `sectl C Z` is the functor `C ⥤ C × D` given by `X ↦ (X, Z)`. -/
@[simps] def sectl
  (C : Type u₁) [category.{v₁} C] {D : Type u₂} [category.{v₂} D] (Z : D) : C ⥤ C × D :=
{ obj := λ X, (X, Z),
  map := λ X Y f, (f, 𝟙 Z) }

/-- `sectr Z D` is the functor `D ⥤ C × D` given by `Y ↦ (Z, Y)` . -/
@[simps] def sectr
  {C : Type u₁} [category.{v₁} C] (Z : C) (D : Type u₂) [category.{v₂} D] : D ⥤ C × D :=
{ obj := λ X, (Z, X),
  map := λ X Y f, (𝟙 Z, f) }

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

/-- `fst` is the functor `(X, Y) ↦ X`. -/
@[simps] def fst : C × D ⥤ C :=
{ obj := λ X, X.1,
  map := λ X Y f, f.1 }

/-- `snd` is the functor `(X, Y) ↦ Y`. -/
@[simps] def snd : C × D ⥤ D :=
{ obj := λ X, X.2,
  map := λ X Y f, f.2 }

/-- The functor swapping the factors of a cartesian product of categories, `C × D ⥤ D × C`. -/
@[simps] def swap : C × D ⥤ D × C :=
{ obj := λ X, (X.2, X.1),
  map := λ _ _ f, (f.2, f.1) }

/--
Swapping the factors of a cartesion product of categories twice is naturally isomorphic
to the identity functor.
-/
@[simps] def symmetry : swap C D ⋙ swap D C ≅ 𝟭 (C × D) :=
{ hom := { app := λ X, 𝟙 X },
  inv := { app := λ X, 𝟙 X } }

/--
The equivalence, given by swapping factors, between `C × D` and `D × C`.
-/
@[simps]
def braiding : C × D ≌ D × C :=
equivalence.mk (swap C D) (swap D C)
  (nat_iso.of_components (λ X, eq_to_iso (by simp)) (by tidy))
  (nat_iso.of_components (λ X, eq_to_iso (by simp)) (by tidy))

instance swap_is_equivalence : is_equivalence (swap C D) :=
(by apply_instance : is_equivalence (braiding C D).functor)

end prod

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

/--
The "evaluation at `X`" functor, such that
`(evaluation.obj X).obj F = F.obj X`,
which is functorial in both `X` and `F`.
-/
@[simps] def evaluation : C ⥤ (C ⥤ D) ⥤ D :=
{ obj := λ X,
  { obj := λ F, F.obj X,
    map := λ F G α, α.app X, },
  map := λ X Y f,
  { app := λ F, F.map f,
    naturality' := λ F G α, eq.symm (α.naturality f) } }

/--
The "evaluation of `F` at `X`" functor,
as a functor `C × (C ⥤ D) ⥤ D`.
-/
@[simps] def evaluation_uncurried : C × (C ⥤ D) ⥤ D :=
{ obj := λ p, p.2.obj p.1,
  map := λ x y f, (x.2.map f.1) ≫ (f.2.app y.1),
  map_comp' := λ X Y Z f g,
  begin
    cases g, cases f, cases Z, cases Y, cases X,
    simp only [prod_comp, nat_trans.comp_app, functor.map_comp, category.assoc],
    rw [←nat_trans.comp_app, nat_trans.naturality, nat_trans.comp_app,
        category.assoc, nat_trans.naturality],
  end }

end

variables {A : Type u₁} [category.{v₁} A]
          {B : Type u₂} [category.{v₂} B]
          {C : Type u₃} [category.{v₃} C]
          {D : Type u₄} [category.{v₄} D]

namespace functor
/-- The cartesian product of two functors. -/
@[simps] def prod (F : A ⥤ B) (G : C ⥤ D) : A × C ⥤ B × D :=
{ obj := λ X, (F.obj X.1, G.obj X.2),
  map := λ _ _ f, (F.map f.1, G.map f.2) }

/- Because of limitations in Lean 3's handling of notations, we do not setup a notation `F × G`.
   You can use `F.prod G` as a "poor man's infix", or just write `functor.prod F G`. -/

/-- Similar to `prod`, but both functors start from the same category `A` -/
@[simps] def prod' (F : A ⥤ B) (G : A ⥤ C) : A ⥤ (B × C) :=
{ obj := λ a, (F.obj a, G.obj a),
  map := λ x y f, (F.map f, G.map f), }

section
variable (C)

/-- The diagonal functor. -/
def diag : C ⥤ C × C := (𝟭 C).prod' (𝟭 C)

@[simp] lemma diag_obj (X : C) : (diag C).obj X = (X, X) := rfl

@[simp] lemma diag_map {X Y : C} (f : X ⟶ Y) : (diag C).map f = (f, f) := rfl

end

end functor

namespace nat_trans

/-- The cartesian product of two natural transformations. -/
@[simps] def prod {F G : A ⥤ B} {H I : C ⥤ D} (α : F ⟶ G) (β : H ⟶ I) :
  F.prod H ⟶ G.prod I :=
{ app         := λ X, (α.app X.1, β.app X.2),
  naturality' := λ X Y f,
  begin
    cases X, cases Y,
    simp only [functor.prod_map, prod.mk.inj_iff, prod_comp],
    split; rw naturality
  end }

/- Again, it is inadvisable in Lean 3 to setup a notation `α × β`;
   use instead `α.prod β` or `nat_trans.prod α β`. -/

end nat_trans

/-- `F.flip` composed with evaluation is the same as evaluating `F`. -/
@[simps]
def flip_comp_evaluation (F : A ⥤ B ⥤ C) (a) :
  F.flip ⋙ (evaluation _ _).obj a ≅ F.obj a :=
nat_iso.of_components (λ b, eq_to_iso rfl) $ by tidy

end category_theory


import prop program

import data.finmap
import category_theory.category
import tactic.interactive
import tactic.tauto
import tactic.linarith
import tactic.monotonicity

namespace refinement

open category_theory
open separation separation.hProp memory

variables value : Type

-- local notation `heap` := heap value
-- local notation `hProp` := hProp value

def state := Σ t : Type*, t → hProp value

section value

variables {value}

def state.mk {s} (p : s → hProp value) : state value := ⟨s,p⟩

structure inst (x : state value) :=
 (σ : x.fst) (h : heap value)
 (shape : x.snd σ h)

end value

def hom (x y : state value) := inst x → set (inst y)

instance : category (state value) :=
{ hom := hom value,
  id := λ _, pure,
  comp := λ x y z A₀ A₁, A₀ >=> A₁,
  id_comp' := λ x y f, fish_pipe _,
  comp_id' := λ x y f, fish_pure _,
  assoc' := λ x y z w f g h, fish_assoc _ _ _ }

universes u

variables {value} {s s' α : Type u}

def sat (p : s → hProp value) (m : ST value s α) (q : α → s → hProp value) : Prop :=
∀ σ σ' h h' x, (x,σ',h') ∈ m.run (σ,h) → p σ h → q x σ' h'

variables {p : s → hProp value} {m : ST value s punit} {q : s → hProp value}
variables {p' : s' → hProp value} {m' : ST value s' punit} {q' : s' → hProp value}

open function (const)

notation `♯` := by repeat { ext : 1; try {refl} }

def attach (x : set α) : set { a // a ∈ x } :=
{ a | a.1 ∈ x }

def arrow (hm : sat p m (const _ q)) : state.mk p ⟶ state.mk q :=
show inst (state.mk p) → set (inst (state.mk q)), from
λ ⟨σ,h,hp⟩,
do ⟨⟨x₀,x₁,x₂⟩,hx⟩ ← attach (m.run (σ,h)),
   return (inst.mk x₁ x₂ (hm σ _ h _ x₀ hx hp))

def abs {s s' : Type*} (R : s → s' → Prop) {p : s → hProp value} {p' : s' → hProp value} : state.mk p ⟶ state.mk p' :=
show inst (state.mk p) → set (inst (state.mk p')), from
λ ⟨σ,h,hp⟩ ⟨σ',h',hp'⟩,
R σ σ'

def repr {s s' : Type*} (R : s → s' → Prop) {p : s → hProp value} {p' : s' → hProp value} : state.mk p' ⟶ state.mk p :=
show inst (state.mk p') → set (inst (state.mk p)), from
λ ⟨σ,h,hp⟩ ⟨σ',h',hp'⟩,
R σ' σ

def ref {X Y : state value} (a b : X ⟶ Y) : Prop :=
∀ i, a i ⊆ b i

notation `⦃` p `⦄` := inst (state.mk p)

def rel (m : ST value s punit) (x : ⦃p⦄) (y : ⦃q⦄) : Prop :=
(punit.star,y.1,y.2) ∈ m.run (x.1,x.2)

infix ` ⊑ `:50 := ref

-- #exit
-- lemma sound (R : s → s' → Prop) (hc : sat p m (const _ q)) (ha : sat p' m' (const _ q'))
--   (hh : arrow hc ≫ abs R ⊑ abs R ≫ arrow ha) :
--   ∀ (c : ⦃p⦄) (c' : ⦃q⦄) (a : ⦃p'⦄),
--     R c.1 a.1 → rel m c c' →
--     ∃ a' : ⦃q'⦄, rel m' a a' ∧ R c'.1 a'.1 :=
-- begin
--   introv hR hm,
--   let ha' := m'.run (a.1,a.2),
--   let a' : ⦃q'⦄ := ⟨ha'.2.1,ha'.2.2,ha _ _ _ _ _ ♯ a.shape⟩,
--   existsi [a'], split, repeat {ext : 1; try { refl <|> apply punit_eq }},
--   specialize @hh c a', cases c, simp [(≫),(>=>),arrow,return,abs] at hh,
--   specialize @hh a',
-- end

lemma sound' (R : s → s' → Prop) (hc : sat p m (const _ q)) (ha : sat p' m' (const _ q'))
  (hh : repr R ≫ arrow hc ⊑ arrow ha ≫ repr R) :
  ∀ (c : ⦃p⦄) (c' : ⦃q⦄) (a : ⦃p'⦄),
    R c.1 a.1 → rel m c c' →
    ∃ a' : ⦃q'⦄, rel m' a a' ∧ R c'.1 a'.1 :=
begin
  introv hR hm,
  let a' : set ⦃q'⦄ := arrow ha a,
  specialize @hh a c' ⟨_,_,hm⟩,
  casesm* ⦃ _ ⦄, -- squeeze_simp [arrow,(≫),(>=>),(>>=),attach,repr] at hh,
  simp only [category_struct.comp, fish, arrow, return, set.bUnion_singleton, and_imp, attach,
             exists_prop, set.mem_Union, set.bind_def, set.pure_def, exists_imp_distrib] at hh,
  revert hh, apply exists_imp_exists, rintros ⟨a,b,c⟩,
  simp only [repr, true_and, and_imp, subtype.val_prop, bex_imp_distrib, subtype.exists,
             set.mem_set_of_eq, exists_imp_distrib, prod.exists, rel, arrow, return, pure,
             set.mem_singleton_iff ],
  introv h₀ h₁ h₂ h₃, subst x_1, subst x_2, cases x,
  exact ⟨h₀,h₃⟩,
  simp [set.mem_singleton_iff],
  existsi c, cases c,
  apply set.ext, intro,
  simp only [arrow, set.Union, exists_prop, set.mem_Union, set.bind_def, subtype.exists, prod.exists],
  split,
  { rintro ⟨h₀,⟨⟨⟩,b,c,h₁,h₂,h₃⟩⟩, simp only [return, set.mem_singleton_iff, and_self, set.pure_def] at h₃, subst x, exact h₂, },
  { intro h, cases a, existsi [hR,punit.star,_,_,h,h],
    cases x, simp only [return, set.mem_singleton_iff, and_self, set.pure_def, eq_self_iff_true], },
end

open state_t

-- instance {α} : has_coe (option α) (ST value s α) := _

/-
 * framing
 * assignment
 * alloc
 * dealloc
 * sequencing
 * loop
-/

-- def spec_alloc (s) (free : set ptr) (p : hProp value) (m : ST value s α) (q : α → hProp value) : Prop :=
-- ∀ σ σ' h h' frame x, (x,σ',h') ∈ m.run (σ,h) → (∀ p ∈ free, ¬ p ∈ h) → holds h frame p → holds h' frame (q x)

-- lemma And_frame {α} {p : hProp value} {m : ST value s α} {q : α → hProp value}
--   (h : ) :
--   spec s p m q := _

-- lemma p_exists_one_point {α} {p : α → hProp value} (x : α)
--   (h : ∀ y, p y =*> [| x = y |] ⊛ True) :
--   p_exists p = p x :=
-- begin
--   ext; dsimp [p_exists]; split,
--   { rintros ⟨x',HH⟩, specialize h _ _ HH, admit },
--   apply @Exists.intro _ (λ x, p x h_1),
-- end

end refinement


import ..phys.time.time
import ..phys.time_series.geom3d
import ..std.time_std
import ..std.geom3d_std
noncomputable theory

-- TODO: Should come from resp. std libraries and be distributed to them accordingly
namespace std
def time (p : K) : time time_std_space := mk_time time_std_space p
def duration (d : K) : duration time_std_space := mk_duration _ d
def position (x y z : K) : position3d geom3d_std_space := mk_position3d _ x y z
def displacement (x y z : K) : displacement3d geom3d_std_space := mk_displacement3d _ x y z
end std

/-
We need to assume a physical interpretation of the data
representing our coordinate system on time. We derive a new ACS from
"coordinated_universal_time_in_seconds" - see time_std.lean
for a more details on the coordinate system and physical interpretation
(note : this is a conventional UTC ACS expressed with units in seconds)

This example does not require any specialized timespaces beyond a simple
world time space.

(1) ORIGIN: We move the origin up to 1629311979

(2) BASIS VECTORS
    basis0
      - points to the future
      - unit length is 1 second (as in UTC)
(3) ACS is given by [Origin, b0]
-/

namespace utc
def origin := std.time 0   -- origin; first instant of January 1, 1970
def basis := std.duration 1    -- basis; "second;" the smallest non-variable unit in UTC
def frame := mk_time_frame origin basis -- recall why "time" is part of the constructor name? factor out?
def coords := mk_space frame  -- "cosys"?
def time (t : K) := mk_time coords t
def duration (d : K) := mk_duration coords d
end utc

/-
We need to assume a physical interpretation of the data
representing our coordinate system on geom3d. See geom3d_std.lean
for more details on the coordinate system and physical interpretation.
-/
-- Geometric world
namespace world  -- it's generic/parametric: for example, world -> Rice 440, as follows
def origin := std.position 0 0 0      -- looking in from doorway, the back lower left corner
def basis_0 := std.displacement 1 0 0 -- right/east along wall; unit is 1m; right
def basis_1 := std.displacement 0 1 0 -- to door along weset wall; 1m; right
def basis_2 := std.displacement 0 0 1 -- up along NW corner; 1m; right handed
def frame := mk_geom3d_frame origin basis_0 basis_1 basis_2
def coords := mk_geom3d_space frame
def position (x y z : K) := mk_position3d coords x y z
def displacement (x y z : K) := mk_displacement3d coords x y z
end world

/-
We define a base link ACS, which is intended to represent the ACS
centered at the robot, in terms of the world frame, and oriented at the robot,
in terms of the world frame.

We define the robot to be 3 meters to the right of the left wall, 4 meters
in north of the bottom wall, and 1 meter above the ground. It's rotated 1 radian
around it's yaw axis relative to the world's orientation.
-/

namespace base_link
def origin := std.position 3 4 1
def basis_0 := std.displacement 1 0 0
def basis_1 := std.displacement 0 1 0
def basis_2 := std.displacement 0 0 1
def frame := mk_geom3d_frame origin basis_0 basis_1 basis_2
def coords := mk_geom3d_space frame
def position (x y z : scalar) := mk_position3d coords x y z
def displacement (x y z : scalar) := mk_displacement3d coords x y z
end base_link

/-
We define a UTM coordinate space. UTM (Universal Transverse Mercator)
is a 2-D coordinate system on the globe that separates the globe into
slices separated into longitudinal strips.

Andrew - update these coordinates with more accurate representations.
-/

namespace UTM  -- it's generic/parametric: for example, world -> Rice 440, as follows
def origin := world.position 3 2 0      -- looking in from doorway, the back lower left corner
def basis_0 := world.displacement 1 0 0 -- right/east along wall; unit is 1m; right
def basis_1 := world.displacement 0 1 0 -- to door along weset wall; 1m; right
def basis_2 := world.displacement 0 0 0 -- up along NW corner; 1m; right handed
def frame := mk_geom3d_frame origin basis_0 basis_1 basis_2
def coords := mk_geom3d_space frame
def position (x y z : K) := mk_position3d coords x y z
def displacement (x y z : K) := mk_displacement3d coords x y z
end UTM

/-
We define a base_link_yaw_only frame. This is intended to represent
the base link frame, however, projected onto a 2-D coordinate sytem
(where there is only a yaw rotation).

Andrew - update these coordinates with more accurate representations.

This should, perhaps, derive from the UTC coordinates.
-/
namespace base_link_yaw_only
def origin := world.position 2 2 0
def basis_0 := world.displacement 0.54 (-0.84) 0
def basis_1 := world.displacement (0.84) (0.54) 0
def basis_2 := world.displacement 0 0 0
def frame := mk_geom3d_frame origin basis_0 basis_1 basis_2
def coords := mk_geom3d_space frame
def position (x y z : scalar) := mk_position3d coords x y z
def displacement (x y z : scalar) := mk_displacement3d coords x y z
end base_link_yaw_only

/-

    //! @brief Parameter that specifies the magnetic declination for the robot's environment.
    //!
    double magnetic_declination_;

    //! @brief UTM's meridian convergence
    //!
    //! Angle between projected meridian (True North) and UTM's grid Y-axis.
    //! For UTM projection (Ellipsoidal Transverse Mercator) it is zero on the equator and non-zero everywhere else.
    //! It increases as the poles are approached or as we're getting farther from central meridian.
    //!
    double utm_meridian_convergence_;

    //! @brief IMU's yaw offset
    //!
    //! Your IMU should read 0 when facing *magnetic* north. If it doesn't, this (parameterized) value gives the offset
    //! (NOTE: if you have a magenetic declination, use the parameter setting for that).
    //!
    double yaw_offset_;

    //! @brief Latest IMU orientation
    //!
    tf2::Quaternion transform_orientation_;

    //! @brief Latest IMU orientation
    //!
    tf2::Transform transform_world_pose_;

    //! @brief Holds the Cartesian->odom transform
    //!
    tf2::Transform cartesian_world_transform_;

    //! @brief Holds the cartesian (UTM or local ENU) pose that is used to compute the transform
    //!
    tf2::Transform transform_cartesian_pose_;

-/

/-
This is a transpiled version of the class containing the critical code, named "NavSatTransform". It contains (only)
the relevant class properties that are referenced in the methods relevant to where the isolated bug is.

-/

structure NavSatTransform :=
 (magnetic_declination_ : scalar)
 (utm_meridian_convergence_ : scalar)
 (yaw_offset_ : scalar)
 (transform_orientation_ : orientation3d world.coords)
 (transform_world_pose_  : geom3d_transform world.coords base_link.coords)
 (transform_cartesian_pose_ : geom3d_transform world.coords UTM.coords)

/-
    void NavSatTransform::getRobotOriginWorldPose(const tf2::Transform &gps_odom_pose,
                                                tf2::Transform &robot_odom_pose,
                                                const ros::Time &transform_time)
  {
    robot_odom_pose.setIdentity();
    tf2::Transform gps_offset_rotated;
    bool can_transform = RosFilterUtilities::lookupTransformSafe(tf_buffer_,
                                                                 base_link_frame_id_,
                                                                 gps_frame_id_,
                                                                 transform_time,
                                                                 transform_timeout_,
                                                                 gps_offset_rotated);

    if (can_transform)
    {
      tf2::Transform robot_orientation;
      can_transform = RosFilterUtilities::lookupTransformSafe(tf_buffer_,
                                                              world_frame_id_,
                                                              base_link_frame_id_,
                                                              transform_time,
                                                              transform_timeout_,
                                                              robot_orientation);
      if (can_transform)
      {
        gps_offset_rotated.setOrigin(tf2::quatRotate(robot_orientation.getRotation(), gps_offset_rotated.getOrigin()));
        gps_offset_rotated.setRotation(tf2::Quaternion::getIdentity());
        robot_odom_pose = gps_offset_rotated.inverse() * gps_odom_pose;
      }
      else
      {
      }
    }
    else
    {
    }
  }

-/

/-
Transpilation of "tf::Transform::setIdentity"
Notice that this method is "bound" to pose3d in Lean, so there is an interesting subtlety in how these would need to be
printed off (possibly with duplicates).

The other aspect to notice is that the purpose of this method, in C++, is an in-place assignment. We lose a particular aspect of the
original semantics here. We can see a re-assignment of the argument, p, below. However, the original semantics require an in-place assignment.
Thus, the caller expects that the member argument, p, has been re-assigned, but, as it is modeled,
the member argument is assigned *into* p0, and the enclosing scope does not have access to the updated value of p.
This is a broader issue and does not have a simple solution, such as forcibly convering this method and all call sites as assignments.
-/
def pose3d.setIdentity {f : geom3d_frame} {sp : geom3d_space f} (p : pose3d sp) : punit :=
  let p0 : pose3d sp := {
    position := inhabited.default _,
    orientation := inhabited.default _
  } in
  punit.star

/-

Just as above, transpilation of "getRPY" call from matrices or quaternions in ROS.
The intended semantics of this method should perform an in-place assignment of the arguments,
(roll pitch and yaw angles). Unfortunately, we face the same challenge as above.

(also, I haven't implemented the Lean orientation call to retrieve these values...will do so soon)
-/
def orientation3d.getRPY {f : geom3d_frame} {sp : geom3d_space f }
  (o : orientation3d sp)
  : scalar → scalar → scalar → punit :=
  λ s1 s2 s3,
  punit.star

/-

    void NavSatTransform::getRobotOriginWorldPose(const tf2::Transform &gps_odom_pose,
                                                tf2::Transform &robot_odom_pose,
                                                const ros::Time &transform_time)

This is the formalization of a helper function reference in the function "computeTransform",
formalized below, which describes the error of interest to the issue. There are no physical
type errors in this method, although formalizing raised some interesting issues.

It is defined as a "Lean-esque member function" of NavSatTransform.

For example, Poses and Transforms share the same type in C++, whereas they are modeled differently
-/
def NavSatTransform.getRobotOriginCartesianPose (nst : NavSatTransform)
  : geom3d_transform world.coords UTM.coords → pose3d world.coords → time utc.coords → punit
  :=
    λ gps_cartesian_pose, λ robot_cartesian_pose, λ transform_time,
    --robot_cartesian_pose.setIdentity();
    let setIdentityCall := robot_cartesian_pose.setIdentity in
    --tf2::Quaternion cartesian_orientation = transform_orientation_;
    let cartesian_orientation : orientation3d world.coords := nst.transform_orientation_ in
    --tf2::Matrix3x3 mat(cartesian_orientation);
    let mat : orientation3d world.coords := cartesian_orientation in

    /-
    double roll;
    double pitch;
    double yaw;
    -/
    let roll : scalar := inhabited.default _ in
    let pitch : scalar := inhabited.default _ in
    let yaw : scalar := inhabited.default _ in

    --mat.getRPY(roll, pitch, yaw);
    let getRPYCall := mat.getRPY roll pitch yaw in
    let yaw0 := yaw + nst.magnetic_declination_ + nst.yaw_offset_ + nst.utm_meridian_convergence_ in
    --yaw += (magnetic_declination_ + yaw_offset_ + utm_meridian_convergence_);
    /-
    cartesian_orientation.setRPY(roll, pitch, yaw);
    A note here: A more "literal" translation of the above line would involve a call to "setRPY",
    which, again, is an in-place assignment to cartesian_orientation. Fortunately, if we don't
    attempt that route, we can directly assign to the variable (SSA-style) using "mk_orientation3d_from_euler_angles",
    which carries the same semantics as the original C++.
    -/
    let cartesian_orientation0 := mk_orientation3d_from_euler_angles world.coords roll pitch yaw in

    /-
    offset.setOrigin(tf2::quatRotate(cartesian_orientation, offset.getOrigin()));
    offset.setRotation(tf2::Quaternion::getIdentity());

    robot_cartesian_pose = offset.inverse() * gps_cartesian_pose;

    We have no way of formalizing this code. "offset" is intended to be a transform - but we provide
    no way to set the "origin" or "rotation" of a Transform, and, it's not a simple fix, it's a bit beyond the scope of
    our formalization currently.
    -/

    punit.star

/-
void NavSatTransform::computeTransform()

This is the principal function in which the error of interest is modeled.
It is a member function of the C++ class "NavSatTransform", and here, in Lean, it is modeled
as a "member function" of the structure NavSatTransform.

The gist of the function and error, below, is that we will first "construct"
  the Transform from UTM → Base Link Yaw Only, T₁, and then we will "use" the member transform_world_pose_, T₂,
  of NavSatTransform, which is a transform from World → Base Link, in order to construct a transform from
  World → UTM, by taking T₂∘(T₁⁻¹). However, the domain of T₁⁻¹ does not match the codomain of T₂,
  yielding a type error in Lean that was not captured in the original code.
-/
def NavSatTransform.compute_transform
  (nst : NavSatTransform)
  : punit :=
  /-
      tf2::Transform transform_cartesian_pose_corrected;
  -/
  let transform_cartesian_pose_corrected : pose3d world.coords := inhabited.default _ in
  /-
  if (!use_manual_datum_)
      {
        getRobotOriginCartesianPose(transform_cartesian_pose_, transform_cartesian_pose_corrected, ros::Time(0));
      }
      else
      {
        transform_cartesian_pose_corrected = transform_cartesian_pose_;
      }

  Notice here, we simply assume an execution path. We assume that the former branch triggers, and thus, a call
  to the previously formalized member function of NavSatTransform is called
  -/
  let getRobotOriginCartesianPoseCall : punit
    := nst.getRobotOriginCartesianPose nst.transform_cartesian_pose_ transform_cartesian_pose_corrected (mk_time utc.coords 0) in
  /-
      tf2::Matrix3x3 mat(transform_orientation_);
  -/
  let mat : orientation3d world.coords := inhabited.default _ in

  /-
      double imu_roll;
      double imu_pitch;
      double imu_yaw;
      mat.getRPY(imu_roll, imu_pitch, imu_yaw);
  -/
  let imu_roll : scalar := inhabited.default _ in
  let imu_pitch : scalar := inhabited.default _ in
  let imu_yaw : scalar := inhabited.default _ in
  /-
  This does not correctly model the semantics of in-place assignment, as described earlier.
  -/
  let getRPYCall : punit := mat.getRPY imu_roll imu_pitch imu_yaw in

  --imu_yaw += (magnetic_declination_ + yaw_offset_ + utm_meridian_convergence_);
  /-

  -/
  let imu_yaw0 := imu_yaw + nst.magnetic_declination_ + nst.yaw_offset_ + nst.utm_meridian_convergence_ in

  /-
  tf2::Quaternion imu_quat;
  imu_quat.setRPY(0.0, 0.0, imu_yaw);

  -/
  let imu_quat : orientation3d base_link.coords := inhabited.default _ in
  let imu_quat0 : orientation3d base_link.coords := mk_orientation3d_from_euler_angles _ imu_roll imu_pitch imu_yaw in

/-

      cartesian_pose_with_orientation.setOrigin(transform_cartesian_pose_corrected.getOrigin());
      cartesian_pose_with_orientation.setRotation(imu_quat);

      We have no way to formalize these two lines. As described earlier, in our current architecture, a
      Transform is defined simply by providing two coordinate spaces, and we receive the *fixed* transform
      between those two spaces. In ROS, coordinate spaces *vary* over time, and thus, transforms are not necessarily
      fixed, and we can assign to their properties in an ad hoc manner, which often represents a transform at a particular time.
      Time Series, at least as we've currently modeled them, do not provide a solution to this limitation.

      To capture the semantics, I ignore the constructed transform_cartesian_pose_corrected origin and imu_quat, and
      construct the transform from UTM → Base Link Yaw Only as we conventionally construct it.
-/
  let cartesian_pose_with_orientation : geom3d_transform _ _ :=
    (UTM.coords.mk_geom3d_transform_to base_link_yaw_only.coords) in

  /-
  Here is where the error occurs: We attempt to compose a transform from World → Base Link, with the inverse of a transform from
  UTM → Base Link Yaw Only, by taking T₂∘(T₁⁻¹). However, the domain of T₁⁻¹ does not match the codomain of T₂,
  yielding a type error in Lean that was not captured in the original code.
  -/
  let cartestian_world_transform_ := (nst.transform_world_pose_.trans (cartesian_pose_with_orientation.symm)) in

  punit.star


example (p q r : Prop) (hp : p) (hq : q) (hr : r) : p ∧ q ∧ r :=
begin
  split,
  any_goals { split },
  any_goals { assumption }
end


example (p q r : Prop) (hp : p) (hq : q) (hr : r) : p ∧ q ∧ r :=
begin
  repeat { any_goals { split } },
  all_goals { assumption }
end


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

! This file was ported from Lean 3 source module tactic.scc
! leanprover-community/mathlib commit d6814c584384ddf2825ff038e868451a7c956f31
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Tactic.Tauto

/-!
# Strongly Connected Components

This file defines tactics to construct proofs of equivalences between a set of mutually equivalent
propositions. The tactics use implications transitively to find sets of equivalent propositions.

## Implementation notes

The tactics use a strongly connected components algorithm on a graph where propositions are
vertices and edges are proofs that the source implies the target. The strongly connected components
are therefore sets of propositions that are pairwise equivalent to each other.

The resulting strongly connected components are encoded in a disjoint set data structure to
facilitate the construction of equivalence proofs between two arbitrary members of an equivalence
class.

## Possible generalizations

Instead of reasoning about implications and equivalence, we could generalize the machinery to
reason about arbitrary partial orders.

## References

 * Tarjan, R. E. (1972), "Depth-first search and linear graph algorithms",
   SIAM Journal on Computing, 1 (2): 146–160, doi:10.1137/0201010
 * Dijkstra, Edsger (1976), A Discipline of Programming, NJ: Prentice Hall, Ch. 25.
 * <https://en.wikipedia.org/wiki/Disjoint-set_data_structure>

## Tags

graphs, tactic, strongly connected components, disjoint sets
-/

namespace Tactic

/-- `closure` implements a disjoint set data structure using path compression
optimization. For the sake of the scc algorithm, it also stores the preorder
numbering of the equivalence graph of the local assumptions.

The `expr_map` encodes a directed forest by storing for every non-root
node, a reference to its parent and a proof of equivalence between
that node's expression and its parent's expression. Given that data
structure, checking that two nodes belong to the same tree is easy and
fast by repeatedly following the parent references until a root is reached.
If both nodes have the same root, they belong to the same tree, i.e. their
expressions are equivalent. The proof of equivalence can be formed by
composing the proofs along the edges of the paths to the root.

More concretely, if we ignore preorder numbering, the set
`{ {e₀,e₁,e₂,e₃}, {e₄,e₅} }` is represented as:

```
e₀ → ⊥      -- no parent, i.e. e₀ is a root
e₁ → e₀, p₁ -- with p₁ : e₁ ↔ e₀
e₂ → e₁, p₂ -- with p₂ : e₂ ↔ e₁
e₃ → e₀, p₃ -- with p₃ : e₃ ↔ e₀
e₄ → ⊥      -- no parent, i.e. e₄ is a root
e₅ → e₄, p₅ -- with p₅ : e₅ ↔ e₄
```

We can check that `e₂` and `e₃` are equivalent by seeking the root of
the tree of each. The parent of `e₂` is `e₁`, the parent of `e₁` is
`e₀` and `e₀` does not have a parent, and thus, this is the root of its tree.
The parent of `e₃` is `e₀` and it's also the root, the same as for `e₂` and
they are therefore equivalent. We can build a proof of that equivalence by using
transitivity on `p₂`, `p₁` and `p₃.symm` in that order.

Similarly, we can discover that `e₂` and `e₅` aren't equivalent.

A description of the path compression optimization can be found at:
<https://en.wikipedia.org/wiki/Disjoint-set_data_structure#Path_compression>

-/
unsafe def closure :=
  ref (expr_map (Sum ℕ (expr × expr)))
#align tactic.closure tactic.closure

namespace closure

/-- `with_new_closure f` creates an empty `closure` `c`, executes `f` on `c`, and then deletes `c`,
returning the output of `f`. -/
unsafe def with_new_closure {α} : (closure → tactic α) → tactic α :=
  using_new_ref (expr_map.mk _)
#align tactic.closure.with_new_closure tactic.closure.with_new_closure

/-- `to_tactic_format cl` pretty-prints the `closure` `cl` as a list. Assuming `cl` was built by
`dfs_at`, each element corresponds to a node `pᵢ : expr` and is one of the folllowing:
- if `pᵢ` is a root: `"pᵢ ⇐ i"`, where `i` is the preorder number of `pᵢ`,
- otherwise: `"(pᵢ, pⱼ) : P"`, where `P` is `pᵢ ↔ pⱼ`.
Useful for debugging. -/
unsafe def to_tactic_format (cl : closure) : tactic format := do
  let m ← read_ref cl
  let l := m.toList
  let fmt ←
    l.mapM fun ⟨x, y⟩ =>
        match y with
        | Sum.inl y => f!"{(← x)} ⇐ {← y}"
        | Sum.inr ⟨y, p⟩ => f!"({(← x)}, {(← y)}) : {← infer_type p}"
  pure <| to_fmt fmt
#align tactic.closure.to_tactic_format tactic.closure.to_tactic_format

unsafe instance : has_to_tactic_format closure :=
  ⟨to_tactic_format⟩

/-- `(n,r,p) ← root cl e` returns `r` the root of the tree that `e` is a part of (which might be
itself) along with `p` a proof of `e ↔ r` and `n`, the preorder numbering of the root. -/
unsafe def root (cl : closure) : expr → tactic (ℕ × expr × expr)
  | e => do
    let m ← read_ref cl
    match m e with
      | none => do
        let p ← mk_app `` Iff.refl [e]
        pure (0, e, p)
      | some (Sum.inl n) => do
        let p ← mk_app `` Iff.refl [e]
        pure (n, e, p)
      | some (Sum.inr (e₀, p₀)) => do
        let (n, e₁, p₁) ← root e₀
        let p ← mk_app `` Iff.trans [p₀, p₁]
        modify_ref cl fun m => m e (Sum.inr (e₁, p))
        pure (n, e₁, p)
#align tactic.closure.root tactic.closure.root

/-- (Implementation of `merge`.) -/
unsafe def merge_intl (cl : closure) (p e₀ p₀ e₁ p₁ : expr) : tactic Unit := do
  let p₂ ← mk_app `` Iff.symm [p₀]
  let p ← mk_app `` Iff.trans [p₂, p]
  let p ← mk_app `` Iff.trans [p, p₁]
  modify_ref cl fun m => m e₀ <| Sum.inr (e₁, p)
#align tactic.closure.merge_intl tactic.closure.merge_intl

-- failed to format: unknown constant 'term.pseudo.antiquot'
/--
      `merge cl p`, with `p` a proof of `e₀ ↔ e₁` for some `e₀` and `e₁`,
      merges the trees of `e₀` and `e₁` and keeps the root with the smallest preorder
      number as the root. This ensures that, in the depth-first traversal of the graph,
      when encountering an edge going into a vertex whose equivalence class includes
      a vertex that originated the current search, that vertex will be the root of
      the corresponding tree. -/
    unsafe
  def
    merge
    ( cl : closure ) ( p : expr ) : tactic Unit
    :=
      do
        let q( $ ( e₀ ) ↔ $ ( e₁ ) ) ← infer_type p >>= instantiate_mvars
          let ( n₂ , e₂ , p₂ ) ← root cl e₀
          let ( n₃ , e₃ , p₃ ) ← root cl e₁
          if
            e₂ ≠ e₃
            then
            do
              if
                n₂ < n₃
                then
                do let p ← mk_app ` ` Iff.symm [ p ] cl p e₃ p₃ e₂ p₂
                else
                cl p e₂ p₂ e₃ p₃
            else
            pure ( )
#align tactic.closure.merge tactic.closure.merge

/-- Sequentially assign numbers to the nodes of the graph as they are being visited. -/
unsafe def assign_preorder (cl : closure) (e : expr) : tactic Unit :=
  modify_ref cl fun m => m.insert e (Sum.inl m.size)
#align tactic.closure.assign_preorder tactic.closure.assign_preorder

/-- `prove_eqv cl e₀ e₁` constructs a proof of equivalence of `e₀` and `e₁` if
they are equivalent. -/
unsafe def prove_eqv (cl : closure) (e₀ e₁ : expr) : tactic expr := do
  let (_, r, p₀) ← root cl e₀
  let (_, r', p₁) ← root cl e₁
  guard (r = r') <|> throwError "{(← e₀)} and {← e₁} are not equivalent"
  let p₁ ← mk_app `` Iff.symm [p₁]
  mk_app `` Iff.trans [p₀, p₁]
#align tactic.closure.prove_eqv tactic.closure.prove_eqv

/-- `prove_impl cl e₀ e₁` constructs a proof of `e₀ -> e₁` if they are equivalent. -/
unsafe def prove_impl (cl : closure) (e₀ e₁ : expr) : tactic expr :=
  cl.prove_eqv e₀ e₁ >>= iff_mp
#align tactic.closure.prove_impl tactic.closure.prove_impl

/-- `is_eqv cl e₀ e₁` checks whether `e₀` and `e₁` are equivalent without building a proof. -/
unsafe def is_eqv (cl : closure) (e₀ e₁ : expr) : tactic Bool := do
  let (_, r, p₀) ← root cl e₀
  let (_, r', p₁) ← root cl e₁
  return <| r = r'
#align tactic.closure.is_eqv tactic.closure.is_eqv

end closure

/-- mutable graphs between local propositions that imply each other with the proof of implication -/
@[reducible]
unsafe def impl_graph :=
  ref (expr_map (List <| expr × expr))
#align tactic.impl_graph tactic.impl_graph

/-- `with_impl_graph f` creates an empty `impl_graph` `g`, executes `f` on `g`, and then deletes
`g`, returning the output of `f`. -/
unsafe def with_impl_graph {α} : (impl_graph → tactic α) → tactic α :=
  using_new_ref (expr_map.mk (List <| expr × expr))
#align tactic.with_impl_graph tactic.with_impl_graph

namespace ImplGraph

-- failed to format: unknown constant 'term.pseudo.antiquot'
/--
      `add_edge g p`, with `p` a proof of `v₀ → v₁` or `v₀ ↔ v₁`, adds an edge to the implication
      graph `g`. -/
    unsafe
  def
    add_edge
    ( g : impl_graph ) : expr → tactic Unit
    |
      p
      =>
      do
        let t ← infer_type p
          match
            t
            with
            |
                q( $ ( v₀ ) → $ ( v₁ ) )
                =>
                do
                  is_prop v₀ >>= guardb
                    is_prop v₁ >>= guardb
                    let m ← read_ref g
                    let xs := ( m v₀ ) . getD [ ]
                    let xs' := ( m v₁ ) . getD [ ]
                    modify_ref g fun m => ( m v₀ ( ( v₁ , p ) :: xs ) ) . insert v₁ xs'
              |
                q( $ ( v₀ ) ↔ $ ( v₁ ) )
                =>
                do
                  let p₀ ← mk_mapp ` ` Iff.mp [ none , none , p ]
                    let p₁ ← mk_mapp ` ` Iff.mpr [ none , none , p ]
                    add_edge p₀
                    add_edge p₁
              | _ => failed
#align tactic.impl_graph.add_edge tactic.impl_graph.add_edge

section Scc

open List

parameter (g : expr_map (List <| expr × expr))

parameter (visit : ref <| expr_map Bool)

parameter (cl : closure)

/-- `merge_path path e`, where `path` and `e` forms a cycle with proofs of implication between
consecutive vertices. The proofs are compiled into proofs of equivalences and added to the closure
structure. `e` and the first vertex of `path` do not have to be the same but they have to be
in the same equivalence class. -/
unsafe def merge_path (path : List (expr × expr)) (e : expr) : tactic Unit := do
  let p₁ ← cl.prove_impl e Path.headI.fst
  let p₂ ← mk_mapp `` id [e]
  let path := (e, p₁) :: Path
  let (_, ls) ←
    Path.mapAccumLM
        (fun p p' => Prod.mk <$> mk_mapp `` Implies.trans [none, p'.1, none, p, p'.2] <*> pure p) p₂
  let (_, rs) ←
    Path.mapAccumRM
        (fun p p' => Prod.mk <$> mk_mapp `` Implies.trans [none, none, none, p.2, p'] <*> pure p')
        p₂
  let ps ← zipWithM (fun p₀ p₁ => mk_app `` Iff.intro [p₀, p₁]) ls.tail rs.dropLast
  ps cl
#align tactic.impl_graph.merge_path tactic.impl_graph.merge_path

/-- (implementation of `collapse`) -/
unsafe def collapse' : List (expr × expr) → List (expr × expr) → expr → tactic Unit
  | Acc, [], v => merge_path Acc v
  | Acc, (x, pr) :: xs, v => do
    let b ← cl.is_eqv x v
    let acc' := (x, pr) :: Acc
    if b then merge_path acc' v else collapse' acc' xs v
#align tactic.impl_graph.collapse' tactic.impl_graph.collapse'

/-- `collapse path v`, where `v` is a vertex that originated the current search
(or a vertex in the same equivalence class as the one that originated the current search).
It or its equivalent should be found in `path`. Since the vertices following `v` in the path
form a cycle with `v`, they can all be added to an equivalence class. -/
unsafe def collapse : List (expr × expr) → expr → tactic Unit :=
  collapse' []
#align tactic.impl_graph.collapse tactic.impl_graph.collapse

/-- Strongly connected component algorithm inspired by Tarjan's and
Dijkstra's scc algorithm. Whereas they return strongly connected
components by enumerating them, this algorithm returns a disjoint set
data structure using path compression. This is a compact
representation that allows us, after the fact, to construct a proof of
equivalence between any two members of an equivalence class.

 * Tarjan, R. E. (1972), "Depth-first search and linear graph algorithms",
   SIAM Journal on Computing, 1 (2): 146–160, doi:10.1137/0201010
 * Dijkstra, Edsger (1976), A Discipline of Programming, NJ: Prentice Hall, Ch. 25.
-/
unsafe def dfs_at : List (expr × expr) → expr → tactic Unit
  | vs, v => do
    let m ← read_ref visit
    let (_, v', _) ← cl.root v
    match m v' with
      | some tt => pure ()
      | some ff => collapse vs v
      | none => do
        cl v
        modify_ref visit fun m => m v ff
        let ns ← g v
        ns fun ⟨w, e⟩ => dfs_at ((v, e) :: vs) w
        modify_ref visit fun m => m v tt
        pure ()
#align tactic.impl_graph.dfs_at tactic.impl_graph.dfs_at

end Scc

/-- Use the local assumptions to create a set of equivalence classes. -/
unsafe def mk_scc (cl : closure) : tactic (expr_map (List (expr × expr))) :=
  with_impl_graph fun g =>
    using_new_ref (expr_map.mk Bool) fun visit => do
      let ls ← local_context
      ls fun l => try (g l)
      let m ← read_ref g
      m fun ⟨v, _⟩ => impl_graph.dfs_at m visit cl [] v
      pure m
#align tactic.impl_graph.mk_scc tactic.impl_graph.mk_scc

end ImplGraph

-- failed to format: unknown constant 'term.pseudo.antiquot'
unsafe
  def
    prove_eqv_target
    ( cl : closure ) : tactic Unit
    := do let q( $ ( p ) ↔ $ ( q ) ) ← target >>= whnf cl p q >>= exact
#align tactic.prove_eqv_target tactic.prove_eqv_target

-- failed to format: unknown constant 'term.pseudo.antiquot'
/--
      `scc` uses the available equivalences and implications to prove
      a goal of the form `p ↔ q`.

      ```lean
      example (p q r : Prop) (hpq : p → q) (hqr : q ↔ r) (hrp : r → p) : p ↔ r :=
      by scc
      ```
      -/
    unsafe
  def
    interactive.scc
    : tactic Unit
    :=
      closure.with_new_closure
        fun cl => do impl_graph.mk_scc cl let q( $ ( p ) ↔ $ ( q ) ) ← target cl p q >>= exact
#align tactic.interactive.scc tactic.interactive.scc

/-- Collect all the available equivalences and implications and
add assumptions for every equivalence that can be proven using the
strongly connected components technique. Mostly useful for testing. -/
unsafe def interactive.scc' : tactic Unit :=
  closure.with_new_closure fun cl => do
    let m ← impl_graph.mk_scc cl
    let ls := m.toList.map Prod.fst
    let ls' := Prod.mk <$> ls <*> ls
    ls' fun x => do
        let h ← get_unused_name `h
        try <| closure.prove_eqv cl x.1 x.2 >>= note h none
#align tactic.interactive.scc' tactic.interactive.scc'

/-- `scc` uses the available equivalences and implications to prove
a goal of the form `p ↔ q`.

```lean
example (p q r : Prop) (hpq : p → q) (hqr : q ↔ r) (hrp : r → p) : p ↔ r :=
by scc
```

The variant `scc'` populates the local context with all equivalences that `scc` is able to prove.
This is mostly useful for testing purposes.
-/
add_tactic_doc
  { Name := "scc"
    category := DocCategory.tactic
    declNames := [`` interactive.scc, `` interactive.scc']
    tags := ["logic"] }

end Tactic


import data.matrix.notation

import for_mathlib.snake_lemma2
import for_mathlib.short_exact_sequence

noncomputable theory

open category_theory
open category_theory.limits

universes v u

lemma preadditive.exact_of_iso_of_exact' {D : Type*} [category D] [abelian D]
  {A₁ B₁ C₁ A₂ B₂ C₂ : D}
  (f₁ : A₁ ⟶ B₁) (g₁ : B₁ ⟶ C₁) (f₂ : A₂ ⟶ B₂) (g₂ : B₂ ⟶ C₂)
  (α : A₁ ≅ A₂) (β : B₁ ≅ B₂) (γ : C₁ ≅ C₂) (hsq₁ : α.hom ≫ f₂ = f₁ ≫ β.hom)
  (hsq₂ : β.hom ≫ g₂ = g₁ ≫ γ.hom)
  (h : exact f₁ g₁) :
  exact f₂ g₂ :=
preadditive.exact_of_iso_of_exact f₁ g₁ f₂ g₂ (arrow.iso_mk α β hsq₁) (arrow.iso_mk β γ hsq₂) rfl h

namespace homological_complex

variables {C : Type u} [category.{v} C] [abelian C]
variables {ι : Type*} {c : complex_shape ι}

def mod_boundaries (A : homological_complex C c) (j : ι) : C :=
cokernel ((A.boundaries j).arrow)

def mod_boundaries_map {A B : homological_complex C c} (f : A ⟶ B) (j : ι) :
  A.mod_boundaries j ⟶ B.mod_boundaries j :=
cokernel.map _ _ (boundaries_map f j) (f.f j) $ by { rw image_subobject_map_arrow, refl }

@[simps]
def mod_boundaries_functor (j : ι) : homological_complex C c ⥤ C :=
{ obj := λ A, A.mod_boundaries j,
  map := λ A B f, mod_boundaries_map f j,
  map_id' := λ A,
  begin
    delta mod_boundaries mod_boundaries_map cokernel.map, ext,
    show cokernel.π (A.boundaries j).arrow ≫ _ = cokernel.π (A.boundaries j).arrow ≫ _,
    simp only [cokernel.π_desc, category.id_comp, id_f, category.comp_id],
  end,
  map_comp' := λ X Y Z f g,
  begin
    delta mod_boundaries mod_boundaries_map cokernel.map, ext,
    show cokernel.π (X.boundaries j).arrow ≫ _ = cokernel.π (X.boundaries j).arrow ≫ _,
    simp only [cokernel.π_desc, cokernel.π_desc_assoc, comp_f, category.assoc],
  end }
.

-- generalize to chain complexes over other shapes
@[simps]
def homology_to_mod_boundaries (i : ι) :
  homology_functor C c i ⟶ mod_boundaries_functor i :=
{ app := λ A, cokernel.map _ _ (𝟙 _) ((A.cycles i).arrow)
    (by { simp only [category.id_comp, image_to_kernel_arrow], }),
  naturality' := λ A B f,
  begin
    ext,
    simp only [homology_functor_map, mod_boundaries_functor_map, homology.π_map_assoc],
    delta mod_boundaries_map homology.π cokernel.map cycles,
    simp only [cokernel.π_desc, cokernel.π_desc_assoc, comp_f, category.assoc,
      kernel_subobject_map_arrow_assoc, hom.sq_from_left],
  end }
.

variables (A : homological_complex C c) (i j : ι) (hij : c.rel i j)

def delta_to_boundaries : A.X i ⟶ (A.boundaries j) :=
(X_prev_iso A hij).inv ≫ factor_thru_image_subobject _

instance delta_to_boundaries_epi : epi (delta_to_boundaries A i j hij) :=
epi_comp _ _

@[ext] lemma boundaries.ext' {X : C} (f g : (boundaries A j : C) ⟶ X)
  (h : factor_thru_image_subobject _ ≫ f = factor_thru_image_subobject _ ≫ g) : f = g :=
by rwa cancel_epi (factor_thru_image_subobject (A.d_to j)) at h

@[simp, reassoc] lemma delta_to_boundaries_comp_arrow :
  (delta_to_boundaries A i j hij) ≫ (boundaries A j).arrow = A.d i j :=
by rw [delta_to_boundaries, category.assoc, image_subobject_arrow_comp, X_prev_iso_comp_d_to]

@[simp, reassoc] lemma boundaries_arrow_comp_delta_to_boundaries :
  (boundaries _ i).arrow ≫ delta_to_boundaries A i j hij = 0 :=
begin
  ext,
  simp only [image_subobject_arrow_comp_assoc, category.assoc,
    delta_to_boundaries_comp_arrow, comp_zero, zero_comp,
    ← d_from_comp_X_next_iso A hij, reassoc_of (d_to_comp_d_from A)],
end

def delta_to_cycles : A.X i ⟶ (A.cycles j) :=
delta_to_boundaries _ i j hij ≫ boundaries_to_cycles _ _

@[simp, reassoc] lemma delta_to_cycles_comp_arrow :
  (delta_to_cycles A i j hij) ≫ (cycles A j).arrow = A.d i j :=
by rw [delta_to_cycles, category.assoc, image_to_kernel_arrow, delta_to_boundaries_comp_arrow]

@[simp, reassoc] lemma boundaries_arrow_comp_delta_to_cycles :
  (boundaries _ _).arrow ≫ delta_to_cycles A i j hij = 0 :=
by rw [delta_to_cycles, ← category.assoc, boundaries_arrow_comp_delta_to_boundaries, zero_comp]

@[simps]
def mod_boundaries_to_cycles : mod_boundaries_functor i ⟶ cycles_functor C c j :=
{ app := λ A, cokernel.desc _ (delta_to_cycles _ i j hij)
   (boundaries_arrow_comp_delta_to_cycles _ i j hij),
  naturality' := λ A B f,
  begin
    ext, show cokernel.π _ ≫ _ = cokernel.π _ ≫ _,
    simp only [homology_functor_map, mod_boundaries_functor_map, homology.π_map_assoc],
    delta mod_boundaries_map homology.π cokernel.map,
    simp only [category.assoc, cycles_functor_map, cycles_map_arrow, hom.comm,
      cokernel.π_desc_assoc, delta_to_cycles_comp_arrow_assoc, delta_to_cycles_comp_arrow]
  end }
.

@[simps]
def cycles_to_homology : cycles_functor C c i ⟶ homology_functor C c i :=
{ app := λ A, cokernel.π _,
  naturality' := λ A B f,
  begin
    simp only [cycles_functor_map, homology_functor_map],
    delta homology.map,
    rw cokernel.π_desc, refl,
  end }

open_locale zero_object

lemma _root_.option.eq_none_or_eq_some {α : Type*} : ∀ (o : option α), o = none ∨ ∃ a, o = some a
| option.none     := or.inl rfl
| (option.some a) := or.inr ⟨a, rfl⟩

lemma exact_next {A₁ A₂ A₃ : homological_complex C c} (f : A₁ ⟶ A₂) (g : A₂ ⟶ A₃)
  (i j : ι) (hij : c.rel i j) (h : exact (f.f j) (g.f j)) :
  exact (f.next i) (g.next i) :=
begin
  refine preadditive.exact_of_iso_of_exact' (f.f j) (g.f j) _ _
    (X_next_iso A₁ hij).symm (X_next_iso A₂ hij).symm (X_next_iso A₃ hij).symm _ _ h;
  simp only [hom.next_eq _ hij, iso.symm_hom, iso.inv_hom_id_assoc],
end

lemma exact_next' {A₁ A₂ A₃ : homological_complex C c} (f : A₁ ⟶ A₂) (g : A₂ ⟶ A₃) (i : ι)
  (h : ∀ n, exact (f.f n) (g.f n)) : exact (f.next i) (g.next i) :=
h _

lemma exact_prev {A₁ A₂ A₃ : homological_complex C c} (f : A₁ ⟶ A₂) (g : A₂ ⟶ A₃)
  (i j : ι) (hij : c.rel i j) (h : exact (f.f i) (g.f i)) :
  exact (f.prev j) (g.prev j) :=
begin
  refine preadditive.exact_of_iso_of_exact' (f.f i) (g.f i) _ _
    (X_prev_iso A₁ hij).symm (X_prev_iso A₂ hij).symm (X_prev_iso A₃ hij).symm _ _ h;
  simp only [hom.prev_eq _ hij, iso.symm_hom, iso.inv_hom_id_assoc],
end

lemma exact_prev' {A₁ A₂ A₃ : homological_complex C c} (f : A₁ ⟶ A₂) (g : A₂ ⟶ A₃) (j : ι)
  (h : ∀ n, exact (f.f n) (g.f n)) : exact (f.prev j) (g.prev j) :=
h _

lemma mono_next {A₁ A₂ : homological_complex C c} (f : A₁ ⟶ A₂)
  (i j : ι) (hij : c.rel i j) [mono (f.f j)] :
  mono (f.next i) :=
begin
  rw hom.next_eq _ hij,
  apply_with mono_comp { instances := ff },
  { apply_instance },
  { apply mono_comp }
end

instance mono_next' {A₁ A₂ : homological_complex C c} (f : A₁ ⟶ A₂)
  (i : ι) [∀ n, mono (f.f n)] :
  mono (f.next i) :=
by apply_assumption

lemma epi_prev {A₁ A₂ : homological_complex C c} (f : A₁ ⟶ A₂)
  (i j : ι) (hij : c.rel i j) [epi (f.f i)] :
  epi (f.prev j) :=
begin
  rw hom.prev_eq _ hij,
  apply_with epi_comp { instances := ff },
  { apply_instance },
  { apply epi_comp }
end

instance epi_prev' {A₁ A₂ : homological_complex C c} (f : A₁ ⟶ A₂)
  (j : ι) [∀ n, epi (f.f n)] :
  epi (f.prev j) :=
by apply_assumption

instance {A B : homological_complex C c} (f : A ⟶ B) [∀ n, epi (f.f n)] (i : ι) :
  epi (boundaries_map f i) :=
begin
  let sq := hom.sq_to f i,
  haveI : epi sq.left := by { dsimp, apply_instance, },
  apply_with (epi_of_epi (factor_thru_image_subobject _)) { instances := ff },
  suffices : factor_thru_image_subobject (A.d_to i) ≫
      boundaries_map f i =
    sq.left ≫ factor_thru_image_subobject (B.d_to i),
  { rw this, apply epi_comp, },
  ext,
  simp only [category.assoc, image_subobject_map_arrow, hom.sq_to_right,
    image_subobject_arrow_comp_assoc, hom.sq_to_left, image_subobject_arrow_comp, hom.comm_to],
end

lemma exact_kernel_subobject_arrow (A B : C) (f : A ⟶ B) : exact (kernel_subobject f).arrow f :=
by { rw [← kernel_subobject_arrow, exact_iso_comp], exact exact_kernel_ι }

lemma exact_cycles_arrow (A : homological_complex C c) (i : ι) :
  exact (cycles A i).arrow (d_from A i) :=
exact_kernel_subobject_arrow _ _ _

lemma exact_cycles_map {A₁ A₂ A₃ : homological_complex C c} (f : A₁ ⟶ A₂) (g : A₂ ⟶ A₃)
  (hfg : ∀ n, short_exact (f.f n) (g.f n)) (j : ι) :
  exact (cycles_map f j) (cycles_map g j) :=
begin
  have sq₁ :  d_from A₁ j ≫ f.next j = f.f j ≫ d_from A₂ j := (hom.comm_from _ _).symm,
  have sq₂ :  d_from A₂ j ≫ g.next j = g.f j ≫ d_from A₃ j := (hom.comm_from _ _).symm,
  suffices S : snake
    ↑(cycles A₁ j) ↑(cycles A₂ j) ↑(cycles A₃ j)
    (A₁.X j) (A₂.X j) (A₃.X j)
    _ _ _
    _ _ _
    (cycles_map f j) (cycles_map g j)
    (cycles _ j).arrow (cycles _ j).arrow (cycles _ j).arrow
    (f.f j) (g.f j)
    (A₁.d_from j) (A₂.d_from j) (A₃.d_from j)
    (f.next j) (g.next j)
    (cokernel.π $ A₁.d_from j) (cokernel.π $ A₂.d_from j) (cokernel.π $ A₃.d_from j)
    (cokernel.map _ _ _ _ sq₁) (cokernel.map _ _ _ _ sq₂),
  { exact S.six_term_exact_seq.pair },
  have hfg_epi := λ j, (hfg j).epi,
  have hfg_mono := λ j, (hfg j).mono,
  resetI,
  fsplit,
  { exact (hfg j).exact },
  { exact exact_next' _ _ _ (λ i, (hfg i).exact), },
  { refine (exact_cycles_arrow _ _).cons (abelian.exact_cokernel _).exact_seq, },
  { refine (exact_cycles_arrow _ _).cons (abelian.exact_cokernel _).exact_seq, },
  { refine (exact_cycles_arrow _ _).cons (abelian.exact_cokernel _).exact_seq, },
  { rw cycles_map_arrow, },
  { rw cycles_map_arrow, },
  { exact sq₁ },
  { exact sq₂ },
  { apply cokernel.π_desc, },
  { apply cokernel.π_desc, },
end

variables {A₁ A₂ A₃ : homological_complex C c} (f : A₁ ⟶ A₂) (g : A₂ ⟶ A₃)
variables (hfg : ∀ n, short_exact (f.f n) (g.f n))

lemma mono_cycles_map (hfg : ∀ n, short_exact (f.f n) (g.f n)) (i : ι) :
  mono (cycles_map f i) :=
begin
  apply_with (mono_of_mono _ (subobject.arrow _)) { instances := ff },
  rw cycles_map_arrow,
  haveI : mono (f.f i) := (hfg i).mono,
  apply mono_comp,
end

@[simp] lemma image_subobject_arrow {X : C} (S : subobject X) :
  image_subobject (S.arrow) = S :=
begin
  delta image_subobject,
  ext,
  swap,
  { exact limits.image_mono_iso_source _ },
  { simp }
end

@[simp] lemma kernel_subobject_cokernel.π {X : C} (S : subobject X) :
  kernel_subobject (cokernel.π S.arrow) = S :=
begin
  delta kernel_subobject,
  ext,
  swap,
  { exact (abelian.image_iso_image _).trans (limits.image_mono_iso_source _) },
  { simp }
end

lemma exact.congr {X₁ X₂ Y Z₁ Z₂ : C} (f₁ : X₁ ⟶ Y) (g₁ : Y ⟶ Z₁) (f₂ : X₂ ⟶ Y) (g₂ : Y ⟶ Z₂)
  (h : exact f₁ g₁) (him : image_subobject f₁ = image_subobject f₂)
  (hker : kernel_subobject g₁ = kernel_subobject g₂) :
  exact f₂ g₂ :=
by rwa [abelian.exact_iff_image_eq_kernel, ← him, ← hker, ← abelian.exact_iff_image_eq_kernel]

lemma exact_column :
exact_seq C [(kernel.ι (A.d_to j)), (A.d_to j), (cokernel.π (A.boundaries j).arrow)] :=
exact_kernel_ι.cons $
(exact.congr (boundaries A j).arrow _ _ _ (abelian.exact_cokernel _) (image_subobject_arrow _) rfl).exact_seq

lemma exact_mod_boundaries_map (hfg : ∀ n, short_exact (f.f n) (g.f n)) (j : ι) :
  exact (mod_boundaries_map f j) (mod_boundaries_map g j) :=
begin
  have sq1 : A₁.d_to j ≫ f.f j = f.prev j ≫ A₂.d_to j := (f.comm_to _).symm,
  have sq2 : A₂.d_to j ≫ g.f j = g.prev j ≫ A₃.d_to j := (g.comm_to _).symm,
  suffices S : snake
    -- the objects
         (kernel _)           (kernel _)           (kernel _)
        (A₁.X_prev j)         (A₂.X_prev j)         (A₃.X_prev j)
          (A₁.X j)             (A₂.X j)             (A₃.X j)
    (mod_boundaries _ j) (mod_boundaries _ j) (mod_boundaries _ j)
    -- the morphisms
    (kernel.map _ _ _ _ sq1) (kernel.map _ _ _ _ sq2)
    (kernel.ι $ A₁.d_to j) (kernel.ι $ A₂.d_to j) (kernel.ι $ A₃.d_to j)
    (f.prev j) (g.prev j)
    (A₁.d_to j) (A₂.d_to j) (A₃.d_to j)
    (f.f j) (g.f j)
    (cokernel.π _) (cokernel.π _) (cokernel.π _)
    (mod_boundaries_map f j) (mod_boundaries_map g j),
  { exact (S.six_term_exact_seq.drop 3).pair },
  have hfg_epi := λ n, (hfg n).epi,
  have hfg_mono := λ n, (hfg n).mono,
  resetI,
  fsplit,
  { exact exact_prev' _ _ _ (λ n, (hfg n).exact) },
  { exact (hfg j).exact },
  { apply exact_column },
  { apply exact_column },
  { apply exact_column },
  { simp },
  { simp },
  { exact sq1 },
  { exact sq2 },
  { simp [mod_boundaries_map] },
  { simp [mod_boundaries_map] }
end

lemma epi_mod_boundaries_map (hfg : ∀ n, short_exact (f.f n) (g.f n)) (i : ι) :
  epi (mod_boundaries_map g i) :=
begin
  apply_with (epi_of_epi (cokernel.π _)) { instances := ff },
  haveI : epi (g.f i) := (hfg i).epi,
  have : cokernel.π _ ≫ mod_boundaries_map g i = g.f i ≫ cokernel.π _ := cokernel.π_desc _ _ _,
  rw this,
  apply epi_comp,
end

lemma mono_homology_to_mod_boundaries :
  mono ((homology_to_mod_boundaries i).app A) :=
cokernel.map_mono_of_epi_of_mono
  (boundaries A i) (cycles A i)
  (boundaries A i) (A.X i)
  _ _ _ _ _

variables {C}

@[simp] lemma image_subobject_comp_eq_of_epi {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) [epi f] :
  image_subobject (f ≫ g) = image_subobject g :=
begin
  delta image_subobject,
  haveI : is_iso (image.pre_comp f g) := is_iso_of_mono_of_epi _,
  ext, swap,
  { exact as_iso (image.pre_comp f g) },
  { simp only [as_iso_hom, image.pre_comp_ι], },
end

@[simp] lemma kernel_subobject_comp_eq_of_mono {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) [mono g] :
  kernel_subobject (f ≫ g) = kernel_subobject f :=
begin
  delta kernel_subobject,
  ext, swap,
  { exact kernel_comp_mono f g },
  { simp only [kernel_comp_mono_hom, kernel.lift_ι] },
end

lemma exact_cycles_arrow_delta_to_cycles :
  exact (A.cycles i).arrow (delta_to_cycles A i j hij) :=
begin
  rw [category_theory.abelian.exact_iff_image_eq_kernel],
  dsimp [delta_to_cycles, delta_to_boundaries],
  simp only [image_subobject_arrow, kernel_subobject_comp_eq_of_mono],
  delta cycles,
  let g : ↑(A.boundaries j) ⟶ X_next A i := (A.boundaries j).arrow ≫ (X_next_iso _ hij).inv,
  haveI : mono g := mono_comp _ _,
  suffices aux : delta_to_boundaries _ i j hij ≫ g = d_from A i,
  { simp_rw [← aux, kernel_subobject_comp_eq_of_mono], refl, },
  simp only [delta_to_boundaries_comp_arrow_assoc, iso.comp_inv_eq, d_from_comp_X_next_iso],
end

lemma exact_homology_to_mod_boundaries_to_cycles :
  exact ((homology_to_mod_boundaries i).app A) ((mod_boundaries_to_cycles i j hij).app A) :=
begin
  let φ : homology A i ⟶ mod_boundaries A i :=
    limits.cokernel.desc _ ((kernel_subobject _).arrow ≫ (cokernel.π _)) (by simp),
  suffices S : snake
    (0:C) 0 0
    (A.boundaries i) (boundaries A i) 0
    (A.cycles i) (A.X i) (A.cycles j)
    (homology A i) (mod_boundaries A i) (A.cycles j)
    0 0
    0 0 0
    (𝟙 _) 0
    (boundaries_to_cycles _ _) (A.boundaries i).arrow 0
    (A.cycles i).arrow (delta_to_cycles _ i j hij)
    (homology.π _ _ _) (cokernel.π _) (𝟙 _)
    φ ((mod_boundaries_to_cycles i j hij).app A),
  { exact (S.six_term_exact_seq.drop 3).pair },
  letI : exact (cycles A i).arrow (delta_to_cycles A i j hij) :=
    exact_cycles_arrow_delta_to_cycles _ i j hij,
  letI : epi (homology.π (d_to A i) (d_from A i) (A.d_to_comp_d_from i)) := coequalizer.π_epi,
  fsplit,
  { rw ← epi_iff_exact_zero_right, apply_instance },
  { apply exact_cycles_arrow_delta_to_cycles },
  { exact (category_theory.exact_zero_mono _).cons (abelian.exact_cokernel _).exact_seq, },
  { exact (category_theory.exact_zero_mono _).cons (abelian.exact_cokernel _).exact_seq, },
  { exact (category_theory.exact_zero_mono _).cons (exact_zero_left_of_mono _).exact_seq, },
  { simp only [zero_comp] },
  { simp only [zero_comp] },
  { simp only [image_to_kernel_arrow, category.id_comp] },
  { simp only [boundaries_arrow_comp_delta_to_cycles, zero_comp], },
  { dsimp [homology.π], simp only [cokernel.π_desc] },
  { simp only [mod_boundaries_to_cycles_app, cokernel.π_desc, category.comp_id] },
end

lemma exact_mod_boundaries_to_cycles_to_homology :
  exact ((mod_boundaries_to_cycles i j hij).app A) ((cycles_to_homology j).app A)  :=
begin
  refine exact.congr (boundaries_to_cycles _ _) _ _ _ _ _ rfl,
  { exact abelian.exact_cokernel _, },
  { simp only [mod_boundaries_to_cycles_app],
    delta delta_to_cycles,
    rw [← image_subobject_comp_eq_of_epi (cokernel.π _)],
    simp only [cokernel.π_desc, image_subobject_comp_eq_of_epi], }
end

lemma epi_cycles_to_homology : epi ((cycles_to_homology j).app A) :=
coequalizer.π_epi

lemma exact_seq_column :
  exact_seq C
    [((homology_to_mod_boundaries i).app A₁),
     ((mod_boundaries_to_cycles i j hij).app A₁),
     ((cycles_to_homology j).app A₁)] :=
(exact_homology_to_mod_boundaries_to_cycles _ _ _ _).cons
  (exact_mod_boundaries_to_cycles_to_homology _ _ _ _).exact_seq

lemma snake (hfg : ∀ n, short_exact (f.f n) (g.f n)) (i j : ι) (hij : c.rel i j) :
  snake
  -- the objects
     (A₁.homology i)       (A₂.homology i)       (A₃.homology i)
  (A₁.mod_boundaries i) (A₂.mod_boundaries i) (A₃.mod_boundaries i)
      (A₁.cycles j)         (A₂.cycles j)         (A₃.cycles j)
     (A₁.homology j)       (A₂.homology j)       (A₃.homology j)
  -- the morphisms
  ((homology_functor _ _ i).map f) ((homology_functor _ _ i).map g)
  ((homology_to_mod_boundaries i).app A₁)
  ((homology_to_mod_boundaries i).app A₂)
  ((homology_to_mod_boundaries i).app A₃)
  ((mod_boundaries_functor i).map f) ((mod_boundaries_functor i).map g)
  ((mod_boundaries_to_cycles i j hij).app A₁)
  ((mod_boundaries_to_cycles i j hij).app A₂)
  ((mod_boundaries_to_cycles i j hij).app A₃)
  ((cycles_functor _ _ j).map f) ((cycles_functor _ _ j).map g)
  ((cycles_to_homology j).app A₁)
  ((cycles_to_homology j).app A₂)
  ((cycles_to_homology j).app A₃)
  ((homology_functor _ _ j).map f) ((homology_functor _ _ j).map g) :=
{ row_exact₁ := exact_mod_boundaries_map f g hfg _,
  row_exact₂ := exact_cycles_map f g hfg _,
  row_epi := epi_mod_boundaries_map f g hfg _,
  row_mono := mono_cycles_map f g hfg _,
  col_exact_a := exact_seq_column _ _ _,
  col_exact_b := exact_seq_column _ _ _,
  col_exact_c := exact_seq_column _ _ _,
  col_mono_a := mono_homology_to_mod_boundaries _ _,
  col_mono_b := mono_homology_to_mod_boundaries _ _,
  col_mono_c := mono_homology_to_mod_boundaries _ _,
  col_epi_a := epi_cycles_to_homology _ _,
  col_epi_b := epi_cycles_to_homology _ _,
  col_epi_c := epi_cycles_to_homology _ _,
  sq_a₀ := ((homology_to_mod_boundaries _).naturality _).symm,
  sq_b₀ := ((homology_to_mod_boundaries _).naturality _).symm,
  sq_a₁ := ((mod_boundaries_to_cycles _ _ _).naturality _).symm,
  sq_b₁ := ((mod_boundaries_to_cycles _ _ _).naturality _).symm,
  sq_a₂ := ((cycles_to_homology _).naturality _).symm,
  sq_b₂ := ((cycles_to_homology _).naturality _).symm }

def δ (hfg : ∀ n, short_exact (f.f n) (g.f n)) (i j : ι) (hij : c.rel i j) :
  homology A₃ i ⟶ homology A₁ j :=
(snake f g hfg i j hij).δ

lemma six_term_exact_seq (hfg : ∀ n, short_exact (f.f n) (g.f n)) (i j : ι) (hij : c.rel i j) :
  exact_seq C [
    (homology_functor _ _ i).map f, -- Hⁱ(A₁) ⟶ Hⁱ(A₂)
    (homology_functor _ _ i).map g, -- Hⁱ(A₂) ⟶ Hⁱ(A₃)
    δ f g hfg i j hij,              -- Hⁱ(A₃) ⟶ Hʲ(A₁)
    (homology_functor _ _ j).map f, -- Hʲ(A₁) ⟶ Hʲ(A₂)
    (homology_functor _ _ j).map g  -- Hʲ(A₁) ⟶ Hʲ(A₃)
  ] :=
(snake f g hfg i j hij).six_term_exact_seq

end homological_complex