/-
Copyright (c) 2021 Andrew Yang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Andrew Yang
-/
import ring_theory.finite_type
import ring_theory.localization.at_prime
import ring_theory.localization.away
import ring_theory.localization.integer
import ring_theory.localization.submodule
import ring_theory.nilpotent
import ring_theory.ring_hom_properties

/-!
# Local properties of commutative rings

In this file, we provide the proofs of various local properties.

## Naming Conventions

* `localization_P` : `P` holds for `S⁻¹R` if `P` holds for `R`.
* `P_of_localization_maximal` : `P` holds for `R` if `P` holds for `Rₘ` for all maximal `m`.
* `P_of_localization_prime` : `P` holds for `R` if `P` holds for `Rₘ` for all prime `m`.
* `P_of_localization_span` : `P` holds for `R` if given a spanning set `{fᵢ}`, `P` holds for all
  `R_{fᵢ}`.

## Main results

The following properties are covered:

* The triviality of an ideal or an element:
  `ideal_eq_bot_of_localization`, `eq_zero_of_localization`
* `is_reduced` : `localization_is_reduced`, `is_reduced_of_localization_maximal`.
* `finite`: `localization_finite`, `finite_of_localization_span`
* `finite_type`: `localization_finite_type`, `finite_type_of_localization_span`

-/

open_locale pointwise classical big_operators

universe u

variables {R S : Type u} [comm_ring R] [comm_ring S] (M : submonoid R)
variables (N : submonoid S) (R' S' : Type u) [comm_ring R'] [comm_ring S'] (f : R →+* S)
variables [algebra R R'] [algebra S S']

section properties

section comm_ring

variable (P : ∀ (R : Type u) [comm_ring R], Prop)

include P

/-- A property `P` of comm rings is said to be preserved by localization
  if `P` holds for `M⁻¹R` whenever `P` holds for `R`. -/
def localization_preserves : Prop :=
  ∀ {R : Type u} [hR : comm_ring R] (M : by exactI submonoid R) (S : Type u) [hS : comm_ring S]
    [by exactI algebra R S] [by exactI is_localization M S], @P R hR → @P S hS

/-- A property `P` of comm rings satisfies `of_localization_maximal` if
  if `P` holds for `R` whenever `P` holds for `Rₘ` for all maximal ideal `m`. -/
def of_localization_maximal : Prop :=
  ∀ (R : Type u) [comm_ring R],
    by exactI (∀ (J : ideal R) (hJ : J.is_maximal), by exactI P (localization.at_prime J)) → P R

end comm_ring

section ring_hom

variable (P : ∀ {R S : Type u} [comm_ring R] [comm_ring S] (f : by exactI R →+* S), Prop)

include P

/-- A property `P` of ring homs is said to be preserved by localization
 if `P` holds for `M⁻¹R →+* M⁻¹S` whenever `P` holds for `R →+* S`. -/
def ring_hom.localization_preserves :=
  ∀ ⦃R S : Type u⦄ [comm_ring R] [comm_ring S] (f : by exactI R →+* S) (M : by exactI submonoid R)
    (R' S' : Type u) [comm_ring R'] [comm_ring S'] [by exactI algebra R R']
    [by exactI algebra S S'] [by exactI is_localization M R']
    [by exactI is_localization (M.map f) S'],
    by exactI (P f → P (is_localization.map S' f (submonoid.le_comap_map M) : R' →+* S'))

/-- A property `P` of ring homs satisfies `ring_hom.of_localization_finite_span`
if `P` holds for `R →+* S` whenever there exists a finite set `{ r }` that spans `R` such that
`P` holds for `Rᵣ →+* Sᵣ`.

Note that this is equivalent to `ring_hom.of_localization_span` via
`ring_hom.of_localization_span_iff_finite`, but this is easier to prove. -/
def ring_hom.of_localization_finite_span :=
  ∀ ⦃R S : Type u⦄ [comm_ring R] [comm_ring S] (f : by exactI R →+* S)
    (s : finset R) (hs : by exactI ideal.span (s : set R) = ⊤)
    (H : by exactI (∀ (r : s), P (localization.away_map f r))), by exactI P f

/-- A property `P` of ring homs satisfies `ring_hom.of_localization_finite_span`
if `P` holds for `R →+* S` whenever there exists a set `{ r }` that spans `R` such that
`P` holds for `Rᵣ →+* Sᵣ`.

Note that this is equivalent to `ring_hom.of_localization_finite_span` via
`ring_hom.of_localization_span_iff_finite`, but this has less restrictions when applying. -/
def ring_hom.of_localization_span :=
  ∀ ⦃R S : Type u⦄ [comm_ring R] [comm_ring S] (f : by exactI R →+* S)
    (s : set R) (hs : by exactI ideal.span s = ⊤)
    (H : by exactI (∀ (r : s), P (localization.away_map f r))), by exactI P f

/-- A property `P` of ring homs satisfies `ring_hom.holds_for_localization_away`
 if `P` holds for each localization map `R →+* Rᵣ`. -/
def ring_hom.holds_for_localization_away : Prop :=
∀ ⦃R : Type u⦄ (S : Type u) [comm_ring R] [comm_ring S] [by exactI algebra R S] (r : R)
  [by exactI is_localization.away r S], by exactI P (algebra_map R S)

/-- A property `P` of ring homs satisfies `ring_hom.of_localization_finite_span_target`
if `P` holds for `R →+* S` whenever there exists a finite set `{ r }` that spans `S` such that
`P` holds for `R →+* Sᵣ`.

Note that this is equivalent to `ring_hom.of_localization_span_target` via
`ring_hom.of_localization_span_target_iff_finite`, but this is easier to prove. -/
def ring_hom.of_localization_finite_span_target : Prop :=
∀ ⦃R S : Type u⦄ [comm_ring R] [comm_ring S] (f : by exactI R →+* S)
  (s : finset S) (hs : by exactI ideal.span (s : set S) = ⊤)
  (H : by exactI (∀ (r : s), P ((algebra_map S (localization.away (r : S))).comp f))),
  by exactI P f

/-- A property `P` of ring homs satisfies `ring_hom.of_localization_span_target`
if `P` holds for `R →+* S` whenever there exists a set `{ r }` that spans `S` such that
`P` holds for `R →+* Sᵣ`.

Note that this is equivalent to `ring_hom.of_localization_finite_span_target` via
`ring_hom.of_localization_span_target_iff_finite`, but this has less restrictions when applying. -/
def ring_hom.of_localization_span_target : Prop :=
∀ ⦃R S : Type u⦄ [comm_ring R] [comm_ring S] (f : by exactI R →+* S)
  (s : set S) (hs : by exactI ideal.span s = ⊤)
  (H : by exactI (∀ (r : s), P ((algebra_map S (localization.away (r : S))).comp f))),
  by exactI P f

/-- A property `P` of ring homs satisfies `of_localization_prime` if
  if `P` holds for `R` whenever `P` holds for `Rₘ` for all prime ideals `p`. -/
def ring_hom.of_localization_prime : Prop :=
∀ ⦃R S : Type u⦄ [comm_ring R] [comm_ring S] (f : by exactI R →+* S),
  by exactI (∀ (J : ideal S) (hJ : J.is_prime),
    by exactI P (localization.local_ring_hom _ J f rfl)) → P f

/-- A property of ring homs is local if it is preserved by localizations and compositions, and for
each `{ r }` that spans `S`, we have `P (R →+* S) ↔ ∀ r, P (R →+* Sᵣ)`. -/
structure ring_hom.property_is_local : Prop :=
(localization_preserves : ring_hom.localization_preserves @P)
(of_localization_span_target : ring_hom.of_localization_span_target @P)
(stable_under_composition : ring_hom.stable_under_composition @P)
(holds_for_localization_away : ring_hom.holds_for_localization_away @P)

lemma ring_hom.of_localization_span_iff_finite :
  ring_hom.of_localization_span @P ↔ ring_hom.of_localization_finite_span @P :=
begin
  delta ring_hom.of_localization_span ring_hom.of_localization_finite_span,
  apply forall₅_congr, -- TODO: Using `refine` here breaks `resetI`.
  introsI,
  split,
  { intros h s, exact h s },
  { intros h s hs hs',
    obtain ⟨s', h₁, h₂⟩ := (ideal.span_eq_top_iff_finite s).mp hs,
    exact h s' h₂ (λ x, hs' ⟨_, h₁ x.prop⟩) }
end

lemma ring_hom.of_localization_span_target_iff_finite :
  ring_hom.of_localization_span_target @P ↔ ring_hom.of_localization_finite_span_target @P :=
begin
  delta ring_hom.of_localization_span_target ring_hom.of_localization_finite_span_target,
  apply forall₅_congr, -- TODO: Using `refine` here breaks `resetI`.
  introsI,
  split,
  { intros h s, exact h s },
  { intros h s hs hs',
    obtain ⟨s', h₁, h₂⟩ := (ideal.span_eq_top_iff_finite s).mp hs,
    exact h s' h₂ (λ x, hs' ⟨_, h₁ x.prop⟩) }
end

variables {P f R' S'}

lemma _root_.ring_hom.property_is_local.respects_iso (hP : ring_hom.property_is_local @P) :
  ring_hom.respects_iso @P :=
begin
  apply hP.stable_under_composition.respects_iso,
  introv,
  resetI,
  letI := e.to_ring_hom.to_algebra,
  apply_with hP.holds_for_localization_away { instances := ff },
  apply is_localization.away_of_is_unit_of_bijective _ is_unit_one,
  exact e.bijective
end

-- Almost all arguments are implicit since this is not intended to use mid-proof.
lemma ring_hom.localization_preserves.away
  (H : ring_hom.localization_preserves @P) (r : R) [is_localization.away r R']
  [is_localization.away (f r) S'] (hf : P f) :
    P (by exactI is_localization.away.map R' S' f r) :=
begin
  resetI,
  haveI : is_localization ((submonoid.powers r).map f) S',
  { rw submonoid.map_powers, assumption },
  exact H f (submonoid.powers r) R' S' hf,
end

lemma ring_hom.property_is_local.of_localization_span (hP : ring_hom.property_is_local @P) :
  ring_hom.of_localization_span @P :=
begin
  introv R hs hs',
  resetI,
  apply_fun (ideal.map f) at hs,
  rw [ideal.map_span, ideal.map_top] at hs,
  apply hP.of_localization_span_target _ _ hs,
  rintro ⟨_, r, hr, rfl⟩,
  have := hs' ⟨r, hr⟩,
  convert hP.stable_under_composition _ _ (hP.holds_for_localization_away (localization.away r) r)
    (hs' ⟨r, hr⟩) using 1,
  exact (is_localization.map_comp _).symm
end

end ring_hom

end properties

section ideal

open_locale non_zero_divisors

/-- Let `I J : ideal R`. If the localization of `I` at each maximal ideal `P` is included in
the localization of `J` at `P`, then `I ≤ J`. -/
lemma ideal.le_of_localization_maximal {I J : ideal R}
  (h : ∀ (P : ideal R) (hP : P.is_maximal),
    ideal.map (algebra_map R (by exactI localization.at_prime P)) I ≤
      ideal.map (algebra_map R (by exactI localization.at_prime P)) J) :
  I ≤ J :=
begin
  intros x hx,
  suffices : J.colon (ideal.span {x}) = ⊤,
  { simpa using submodule.mem_colon.mp
      (show (1 : R) ∈ J.colon (ideal.span {x}), from this.symm ▸ submodule.mem_top)
      x (ideal.mem_span_singleton_self x) },
  refine not.imp_symm (J.colon (ideal.span {x})).exists_le_maximal _,
  push_neg,
  introsI P hP le,
  obtain ⟨⟨⟨a, ha⟩, ⟨s, hs⟩⟩, eq⟩ := (is_localization.mem_map_algebra_map_iff P.prime_compl _).mp
    (h P hP (ideal.mem_map_of_mem _ hx)),
  rw [← _root_.map_mul, ← sub_eq_zero, ← map_sub] at eq,
  obtain ⟨⟨m, hm⟩, eq⟩ := (is_localization.map_eq_zero_iff P.prime_compl _ _).mp eq,
  refine hs ((hP.is_prime.mem_or_mem (le (ideal.mem_colon_singleton.mpr _))).resolve_right hm),
  simp only [subtype.coe_mk, mul_sub, sub_eq_zero, mul_comm x s, mul_left_comm] at eq,
  simpa only [mul_assoc, eq] using J.mul_mem_left m ha
end

/-- Let `I J : ideal R`. If the localization of `I` at each maximal ideal `P` is equal to
the localization of `J` at `P`, then `I = J`. -/
theorem ideal.eq_of_localization_maximal {I J : ideal R}
  (h : ∀ (P : ideal R) (hP : P.is_maximal),
    ideal.map (algebra_map R (by exactI localization.at_prime P)) I =
      ideal.map (algebra_map R (by exactI localization.at_prime P)) J) :
  I = J :=
le_antisymm
  (ideal.le_of_localization_maximal (λ P hP, (h P hP).le))
  (ideal.le_of_localization_maximal (λ P hP, (h P hP).ge))

/-- An ideal is trivial if its localization at every maximal ideal is trivial. -/
lemma ideal_eq_bot_of_localization' (I : ideal R)
   (h : ∀ (J : ideal R) (hJ : J.is_maximal),
      ideal.map (algebra_map R (by exactI (localization.at_prime J))) I = ⊥) : I = ⊥ :=
ideal.eq_of_localization_maximal (λ P hP, (by simpa using h P hP))

-- TODO: This proof should work for all modules, once we have enough material on submodules of
-- localized modules.
/-- An ideal is trivial if its localization at every maximal ideal is trivial. -/
lemma ideal_eq_bot_of_localization (I : ideal R)
   (h : ∀ (J : ideal R) (hJ : J.is_maximal),
      by exactI is_localization.coe_submodule (localization.at_prime J) I = ⊥) : I = ⊥ :=
ideal_eq_bot_of_localization' _ (λ P hP, (ideal.map_eq_bot_iff_le_ker _).mpr (λ x hx,
  by { rw [ring_hom.mem_ker, ← submodule.mem_bot R, ← h P hP, is_localization.mem_coe_submodule],
       exact ⟨x, hx, rfl⟩ }))

lemma eq_zero_of_localization (r : R)
   (h : ∀ (J : ideal R) (hJ : J.is_maximal),
      by exactI algebra_map R (localization.at_prime J) r = 0) : r = 0 :=
begin
  rw ← ideal.span_singleton_eq_bot,
  apply ideal_eq_bot_of_localization,
  intros J hJ,
  delta is_localization.coe_submodule,
  erw [submodule.map_span, submodule.span_eq_bot],
  rintro _ ⟨_, h', rfl⟩,
  cases set.mem_singleton_iff.mpr h',
  exact h J hJ,
end

end ideal

section reduced

lemma localization_is_reduced : localization_preserves (λ R hR, by exactI is_reduced R) :=
begin
  introv R _ _,
  resetI,
  constructor,
  rintro x ⟨(_|n), e⟩,
  { simpa using congr_arg (*x) e },
  obtain ⟨⟨y, m⟩, hx⟩ := is_localization.surj M x,
  dsimp only at hx,
  let hx' := congr_arg (^ n.succ) hx,
  simp only [mul_pow, e, zero_mul, ← ring_hom.map_pow] at hx',
  rw [← (algebra_map R S).map_zero] at hx',
  obtain ⟨m', hm'⟩ := (is_localization.eq_iff_exists M S).mp hx',
  apply_fun (*m'^n) at hm',
  simp only [mul_assoc, zero_mul, mul_zero] at hm',
  rw [← mul_left_comm, ← pow_succ, ← mul_pow] at hm',
  replace hm' := is_nilpotent.eq_zero ⟨_, hm'.symm⟩,
  rw [← (is_localization.map_units S m).mul_left_inj, hx, zero_mul,
    is_localization.map_eq_zero_iff M],
  exact ⟨m', by rw [← hm', mul_comm]⟩
end

instance [is_reduced R] : is_reduced (localization M) := localization_is_reduced M _ infer_instance

lemma is_reduced_of_localization_maximal :
  of_localization_maximal (λ R hR, by exactI is_reduced R) :=
begin
  introv R h,
  constructor,
  intros x hx,
  apply eq_zero_of_localization,
  intros J hJ,
  specialize h J hJ,
  resetI,
  exact (hx.map $ algebra_map R $ localization.at_prime J).eq_zero,
end

end reduced

section surjective

lemma localization_preserves_surjective :
  ring_hom.localization_preserves (λ R S _ _ f, function.surjective f) :=
begin
  introv R H x,
  resetI,
  obtain ⟨x, ⟨_, s, hs, rfl⟩, rfl⟩ := is_localization.mk'_surjective (M.map f) x,
  obtain ⟨y, rfl⟩ := H x,
  use is_localization.mk' R' y ⟨s, hs⟩,
  rw is_localization.map_mk',
  refl,
end

lemma surjective_of_localization_span :
  ring_hom.of_localization_span (λ R S _ _ f, function.surjective f) :=
begin
  introv R e H,
  rw [← set.range_iff_surjective, set.eq_univ_iff_forall],
  resetI,
  letI := f.to_algebra,
  intro x,
  apply submodule.mem_of_span_eq_top_of_smul_pow_mem (algebra.of_id R S).to_linear_map.range s e,
  intro r,
  obtain ⟨a, e'⟩ := H r (algebra_map _ _ x),
  obtain ⟨b, ⟨_, n, rfl⟩, rfl⟩ := is_localization.mk'_surjective (submonoid.powers (r : R)) a,
  erw is_localization.map_mk' at e',
  rw [eq_comm, is_localization.eq_mk'_iff_mul_eq, subtype.coe_mk, subtype.coe_mk, ← map_mul] at e',
  obtain ⟨⟨_, n', rfl⟩, e''⟩ := (is_localization.eq_iff_exists (submonoid.powers (f r)) _).mp e',
  rw [subtype.coe_mk, mul_comm x, ←mul_assoc, ← map_pow, ← map_mul, ← map_mul, ← pow_add] at e'',
  exact ⟨n' + n, _, e''.symm⟩
end

end surjective

section finite

/-- If `S` is a finite `R`-algebra, then `S' = M⁻¹S` is a finite `R' = M⁻¹R`-algebra. -/
lemma localization_finite : ring_hom.localization_preserves @ring_hom.finite :=
begin
  introv R hf,
  -- Setting up the `algebra` and `is_scalar_tower` instances needed
  resetI,
  letI := f.to_algebra,
  letI := ((algebra_map S S').comp f).to_algebra,
  let f' : R' →+* S' := is_localization.map S' f (submonoid.le_comap_map M),
  letI := f'.to_algebra,
  haveI : is_scalar_tower R R' S' :=
    is_scalar_tower.of_algebra_map_eq' (is_localization.map_comp _).symm,
  let fₐ : S →ₐ[R] S' := alg_hom.mk' (algebra_map S S') (λ c x, ring_hom.map_mul _ _ _),

  -- We claim that if `S` is generated by `T` as an `R`-module,
  -- then `S'` is generated by `T` as an `R'`-module.
  unfreezingI { obtain ⟨T, hT⟩ := hf },
  use T.image (algebra_map S S'),
  rw eq_top_iff,
  rintro x -,

  -- By the hypotheses, for each `x : S'`, we have `x = y / (f r)` for some `y : S` and `r : M`.
  -- Since `S` is generated by `T`, the image of `y` should fall in the span of the image of `T`.
  obtain ⟨y, ⟨_, ⟨r, hr, rfl⟩⟩, rfl⟩ := is_localization.mk'_surjective (M.map f) x,
  rw [is_localization.mk'_eq_mul_mk'_one, mul_comm, finset.coe_image],
  have hy : y ∈ submodule.span R ↑T, by { rw hT, trivial },
  replace hy : algebra_map S S' y ∈ submodule.map fₐ.to_linear_map (submodule.span R T) :=
    submodule.mem_map_of_mem hy,
  rw submodule.map_span fₐ.to_linear_map T at hy,
  have H : submodule.span R ((algebra_map S S') '' T) ≤
    (submodule.span R' ((algebra_map S S') '' T)).restrict_scalars R,
  { rw submodule.span_le, exact submodule.subset_span },

  -- Now, since `y ∈ span T`, and `(f r)⁻¹ ∈ R'`, `x / (f r)` is in `span T` as well.
  convert (submodule.span R' ((algebra_map S S') '' T)).smul_mem
    (is_localization.mk' R' (1 : R) ⟨r, hr⟩) (H hy) using 1,
  rw algebra.smul_def,
  erw is_localization.map_mk',
  rw map_one,
  refl,
end

lemma localization_away_map_finite (r : R) [is_localization.away r R']
  [is_localization.away (f r) S'] (hf : f.finite) :
    (is_localization.away.map R' S' f r).finite :=
localization_finite.away r hf

/--
Let `S` be an `R`-algebra, `M` an submonoid of `R`, and `S' = M⁻¹S`.
If the image of some `x : S` falls in the span of some finite `s ⊆ S'` over `R`,
then there exists some `m : M` such that `m • x` falls in the
span of `finset_integer_multiple _ s` over `R`.
-/
lemma is_localization.smul_mem_finset_integer_multiple_span [algebra R S]
  [algebra R S'] [is_scalar_tower R S S']
  [is_localization (M.map (algebra_map R S)) S'] (x : S)
  (s : finset S') (hx : algebra_map S S' x ∈ submodule.span R (s : set S')) :
    ∃ m : M, m • x ∈ submodule.span R
      (is_localization.finset_integer_multiple (M.map (algebra_map R S)) s : set S) :=
begin
  let g : S →ₐ[R] S' := alg_hom.mk' (algebra_map S S')
    (λ c x, by simp [algebra.algebra_map_eq_smul_one]),

  -- We first obtain the `y' ∈ M` such that `s' = y' • s` is falls in the image of `S` in `S'`.
  let y := is_localization.common_denom_of_finset (M.map (algebra_map R S)) s,
  have hx₁ : (y : S) • ↑s = g '' _ := (is_localization.finset_integer_multiple_image _ s).symm,
  obtain ⟨y', hy', e : algebra_map R S y' = y⟩ := y.prop,
  have : algebra_map R S y' • (s : set S') = y' • s :=
    by simp_rw [algebra.algebra_map_eq_smul_one, smul_assoc, one_smul],
  rw [← e, this] at hx₁,
  replace hx₁ := congr_arg (submodule.span R) hx₁,
  rw submodule.span_smul at hx₁,
  replace hx : _ ∈ y' • submodule.span R (s : set S') := set.smul_mem_smul_set hx,
  rw hx₁ at hx,
  erw [← g.map_smul, ← submodule.map_span (g : S →ₗ[R] S')] at hx,
  -- Since `x` falls in the span of `s` in `S'`, `y' • x : S` falls in the span of `s'` in `S'`.
  -- That is, there exists some `x' : S` in the span of `s'` in `S` and `x' = y' • x` in `S'`.
  -- Thus `a • (y' • x) = a • x' ∈ span s'` in `S` for some `a ∈ M`.
  obtain ⟨x', hx', hx'' : algebra_map _ _ _ = _⟩ := hx,
  obtain ⟨⟨_, a, ha₁, rfl⟩, ha₂⟩ := (is_localization.eq_iff_exists
    (M.map (algebra_map R S)) S').mp hx'',
  use (⟨a, ha₁⟩ : M) * (⟨y', hy'⟩ : M),
  convert (submodule.span R (is_localization.finset_integer_multiple
    (submonoid.map (algebra_map R S) M) s : set S)).smul_mem a hx' using 1,
  convert ha₂.symm,
  { rw [subtype.coe_mk, submonoid.smul_def, submonoid.coe_mul, ← smul_smul],
    exact algebra.smul_def _ _ },
  { exact algebra.smul_def _ _ }
end

/-- If `S` is an `R' = M⁻¹R` algebra, and `x ∈ span R' s`,
then `t • x ∈ span R s` for some `t : M`.-/
lemma multiple_mem_span_of_mem_localization_span [algebra R' S] [algebra R S]
  [is_scalar_tower R R' S] [is_localization M R']
  (s : set S) (x : S) (hx : x ∈ submodule.span R' s) :
    ∃ t : M, t • x ∈ submodule.span R s :=
begin
  classical,
  obtain ⟨s', hss', hs'⟩ := submodule.mem_span_finite_of_mem_span hx,
  rsuffices ⟨t, ht⟩ : ∃ t : M, t • x ∈ submodule.span R (s' : set S),
  { exact ⟨t, submodule.span_mono hss' ht⟩ },
  clear hx hss' s,
  revert x,
  apply s'.induction_on,
  { intros x hx, use 1, simpa using hx },
  rintros a s ha hs x hx,
  simp only [finset.coe_insert, finset.image_insert, finset.coe_image, subtype.coe_mk,
    submodule.mem_span_insert] at hx ⊢,
  rcases hx with ⟨y, z, hz, rfl⟩,
  rcases is_localization.surj M y with ⟨⟨y', s'⟩, e⟩,
  replace e : _ * a = _ * a := (congr_arg (λ x, algebra_map R' S x * a) e : _),
  simp_rw [ring_hom.map_mul, ← is_scalar_tower.algebra_map_apply, mul_comm (algebra_map R' S y),
    mul_assoc, ← algebra.smul_def] at e,
  rcases hs _ hz with ⟨t, ht⟩,
  refine ⟨t*s', t*y', _, (submodule.span R (s : set S)).smul_mem s' ht, _⟩,
  rw [smul_add, ← smul_smul, mul_comm, ← smul_smul, ← smul_smul, ← e],
  refl,
end

/-- If `S` is an `R' = M⁻¹R` algebra, and `x ∈ adjoin R' s`,
then `t • x ∈ adjoin R s` for some `t : M`.-/
lemma multiple_mem_adjoin_of_mem_localization_adjoin [algebra R' S] [algebra R S]
  [is_scalar_tower R R' S] [is_localization M R']
  (s : set S) (x : S) (hx : x ∈ algebra.adjoin R' s) :
    ∃ t : M, t • x ∈ algebra.adjoin R s :=
begin
  change ∃ (t : M), t • x ∈ (algebra.adjoin R s).to_submodule,
  change x ∈ (algebra.adjoin R' s).to_submodule at hx,
  simp_rw [algebra.adjoin_eq_span] at hx ⊢,
  exact multiple_mem_span_of_mem_localization_span M R' _ _ hx
end

lemma finite_of_localization_span : ring_hom.of_localization_span @ring_hom.finite :=
begin
  rw ring_hom.of_localization_span_iff_finite,
  introv R hs H,
  -- We first setup the instances
  resetI,
  letI := f.to_algebra,
  letI := λ (r : s), (localization.away_map f r).to_algebra,
  haveI : ∀ r : s, is_localization ((submonoid.powers (r : R)).map (algebra_map R S))
    (localization.away (f r)),
  { intro r, rw submonoid.map_powers, exact localization.is_localization },
  haveI : ∀ r : s, is_scalar_tower R (localization.away (r : R)) (localization.away (f r)) :=
    λ r, is_scalar_tower.of_algebra_map_eq' (is_localization.map_comp _).symm,

  -- By the hypothesis, we may find a finite generating set for each `Sᵣ`. This set can then be
  -- lifted into `R` by multiplying a sufficiently large power of `r`. I claim that the union of
  -- these generates `S`.
  constructor,
  replace H := λ r, (H r).1,
  choose s₁ s₂ using H,
  let sf := λ (x : s), is_localization.finset_integer_multiple (submonoid.powers (f x)) (s₁ x),
  use s.attach.bUnion sf,
  rw [submodule.span_attach_bUnion, eq_top_iff],

  -- It suffices to show that `r ^ n • x ∈ span T` for each `r : s`, since `{ r ^ n }` spans `R`.
  -- This then follows from the fact that each `x : R` is a linear combination of the generating set
  -- of `Sᵣ`. By multiplying a sufficiently large power of `r`, we can cancel out the `r`s in the
  -- denominators of both the generating set and the coefficients.
  rintro x -,
  apply submodule.mem_of_span_eq_top_of_smul_pow_mem _ (s : set R) hs _ _,
  intro r,
  obtain ⟨⟨_, n₁, rfl⟩, hn₁⟩ := multiple_mem_span_of_mem_localization_span
    (submonoid.powers (r : R)) (localization.away (r : R)) (s₁ r : set (localization.away (f r)))
      (algebra_map S _ x) (by { rw s₂ r, trivial }),
  rw [submonoid.smul_def, algebra.smul_def, is_scalar_tower.algebra_map_apply R S,
    subtype.coe_mk, ← map_mul] at hn₁,
  obtain ⟨⟨_, n₂, rfl⟩, hn₂⟩ := is_localization.smul_mem_finset_integer_multiple_span
    (submonoid.powers (r : R)) (localization.away (f r)) _ (s₁ r) hn₁,
  rw [submonoid.smul_def, ← algebra.smul_def, smul_smul, subtype.coe_mk, ← pow_add] at hn₂,
  simp_rw submonoid.map_powers at hn₂,
  use n₂ + n₁,
  exact le_supr (λ (x : s), submodule.span R (sf x : set S)) r hn₂,
end

end finite

section finite_type

lemma localization_finite_type : ring_hom.localization_preserves @ring_hom.finite_type :=
begin
  introv R hf,
  -- mirrors the proof of `localization_map_finite`
  resetI,
  letI := f.to_algebra,
  letI := ((algebra_map S S').comp f).to_algebra,
  let f' : R' →+* S' := is_localization.map S' f (submonoid.le_comap_map M),
  letI := f'.to_algebra,
  haveI : is_scalar_tower R R' S' :=
    is_scalar_tower.of_algebra_map_eq' (is_localization.map_comp _).symm,
  let fₐ : S →ₐ[R] S' := alg_hom.mk' (algebra_map S S') (λ c x, ring_hom.map_mul _ _ _),

  obtain ⟨T, hT⟩ := id hf,
  use T.image (algebra_map S S'),
  rw eq_top_iff,
  rintro x -,
  obtain ⟨y, ⟨_, ⟨r, hr, rfl⟩⟩, rfl⟩ := is_localization.mk'_surjective (M.map f) x,
  rw [is_localization.mk'_eq_mul_mk'_one, mul_comm, finset.coe_image],
  have hy : y ∈ algebra.adjoin R (T : set S), by { rw hT, trivial },
  replace hy : algebra_map S S' y ∈ (algebra.adjoin R (T : set S)).map fₐ :=
    subalgebra.mem_map.mpr ⟨_, hy, rfl⟩,
  rw fₐ.map_adjoin T at hy,
  have H : algebra.adjoin R ((algebra_map S S') '' T) ≤
    (algebra.adjoin R' ((algebra_map S S') '' T)).restrict_scalars R,
  { rw algebra.adjoin_le_iff, exact algebra.subset_adjoin },
  convert (algebra.adjoin R' ((algebra_map S S') '' T)).smul_mem (H hy)
    (is_localization.mk' R' (1 : R) ⟨r, hr⟩) using 1,
  rw algebra.smul_def,
  erw is_localization.map_mk',
  rw map_one,
  refl,
end

lemma localization_away_map_finite_type (r : R) [is_localization.away r R']
  [is_localization.away (f r) S'] (hf : f.finite_type) :
    (is_localization.away.map R' S' f r).finite_type :=
localization_finite_type.away r hf

variable {S'}

/--
Let `S` be an `R`-algebra, `M` a submonoid of `S`, `S' = M⁻¹S`.
Suppose the image of some `x : S` falls in the adjoin of some finite `s ⊆ S'` over `R`,
and `A` is an `R`-subalgebra of `S` containing both `M` and the numerators of `s`.
Then, there exists some `m : M` such that `m • x` falls in `A`.
-/
lemma is_localization.exists_smul_mem_of_mem_adjoin [algebra R S]
  [algebra R S'] [is_scalar_tower R S S'] (M : submonoid S)
  [is_localization M S'] (x : S) (s : finset S') (A : subalgebra R S)
  (hA₁ : (is_localization.finset_integer_multiple M s : set S) ⊆ A)
  (hA₂ : M ≤ A.to_submonoid)
  (hx : algebra_map S S' x ∈ algebra.adjoin R (s : set S')) :
    ∃ m : M, m • x ∈ A :=
begin
  let g : S →ₐ[R] S' := is_scalar_tower.to_alg_hom R S S',
  let y := is_localization.common_denom_of_finset M s,
  have hx₁ : (y : S) • ↑s = g '' _ := (is_localization.finset_integer_multiple_image _ s).symm,
  obtain ⟨n, hn⟩ := algebra.pow_smul_mem_of_smul_subset_of_mem_adjoin (y : S) (s : set S')
    (A.map g) (by { rw hx₁, exact set.image_subset _ hA₁ }) hx (set.mem_image_of_mem _ (hA₂ y.2)),
  obtain ⟨x', hx', hx''⟩ := hn n (le_of_eq rfl),
  rw [algebra.smul_def, ← _root_.map_mul] at hx'',
  obtain ⟨a, ha₂⟩ := (is_localization.eq_iff_exists M S').mp hx'',
  use a * y ^ n,
  convert A.mul_mem hx' (hA₂ a.prop),
  rw [submonoid.smul_def, smul_eq_mul, submonoid.coe_mul, submonoid.coe_pow, mul_assoc, ←ha₂,
    mul_comm],
end

/--
Let `S` be an `R`-algebra, `M` an submonoid of `R`, and `S' = M⁻¹S`.
If the image of some `x : S` falls in the adjoin of some finite `s ⊆ S'` over `R`,
then there exists some `m : M` such that `m • x` falls in the
adjoin of `finset_integer_multiple _ s` over `R`.
-/
lemma is_localization.lift_mem_adjoin_finset_integer_multiple [algebra R S]
  [algebra R S'] [is_scalar_tower R S S']
  [is_localization (M.map (algebra_map R S)) S'] (x : S)
  (s : finset S') (hx : algebra_map S S' x ∈ algebra.adjoin R (s : set S')) :
    ∃ m : M, m • x ∈ algebra.adjoin R
      (is_localization.finset_integer_multiple (M.map (algebra_map R S)) s : set S) :=
begin
  obtain ⟨⟨_, a, ha, rfl⟩, e⟩ := is_localization.exists_smul_mem_of_mem_adjoin
    (M.map (algebra_map R S)) x s (algebra.adjoin R _) algebra.subset_adjoin _ hx,
  { exact ⟨⟨a, ha⟩, by simpa [submonoid.smul_def] using e⟩ },
{ rintros _ ⟨a, ha, rfl⟩, exact subalgebra.algebra_map_mem _ a }
end

lemma finite_type_of_localization_span : ring_hom.of_localization_span @ring_hom.finite_type :=
begin
  rw ring_hom.of_localization_span_iff_finite,
  introv R hs H,
  -- mirrors the proof of `finite_of_localization_span`
  resetI,
  letI := f.to_algebra,
  letI := λ (r : s), (localization.away_map f r).to_algebra,
  haveI : ∀ r : s, is_localization ((submonoid.powers (r : R)).map (algebra_map R S))
    (localization.away (f r)),
  { intro r, rw submonoid.map_powers, exact localization.is_localization },
  haveI : ∀ r : s, is_scalar_tower R (localization.away (r : R)) (localization.away (f r)) :=
    λ r, is_scalar_tower.of_algebra_map_eq' (is_localization.map_comp _).symm,

  constructor,
  replace H := λ r, (H r).1,
  choose s₁ s₂ using H,
  let sf := λ (x : s), is_localization.finset_integer_multiple (submonoid.powers (f x)) (s₁ x),
  use s.attach.bUnion sf,
  convert (algebra.adjoin_attach_bUnion sf).trans _,
  rw eq_top_iff,
  rintro x -,
  apply (⨆ (x : s), algebra.adjoin R (sf x : set S)).to_submodule
    .mem_of_span_eq_top_of_smul_pow_mem _ hs _ _,
  intro r,
  obtain ⟨⟨_, n₁, rfl⟩, hn₁⟩ := multiple_mem_adjoin_of_mem_localization_adjoin
    (submonoid.powers (r : R)) (localization.away (r : R)) (s₁ r : set (localization.away (f r)))
      (algebra_map S (localization.away (f r)) x) (by { rw s₂ r, trivial }),
  rw [submonoid.smul_def, algebra.smul_def, is_scalar_tower.algebra_map_apply R S,
    subtype.coe_mk, ← map_mul] at hn₁,
  obtain ⟨⟨_, n₂, rfl⟩, hn₂⟩ := is_localization.lift_mem_adjoin_finset_integer_multiple
    (submonoid.powers (r : R)) _ (s₁ r) hn₁,
  rw [submonoid.smul_def, ← algebra.smul_def, smul_smul, subtype.coe_mk, ← pow_add] at hn₂,
  simp_rw submonoid.map_powers at hn₂,
  use n₂ + n₁,
  exact le_supr (λ (x : s), algebra.adjoin R (sf x : set S)) r hn₂
end

end finite_type


-- https://github.com/dwrensha/lean4-maze/blob/main/Maze.lean

import Lean

-- Turn off pp.analyze. When pp.analyze is set to true (the default), some of our
-- larger mazes take a long time to display.
set_option pp.analyze false

-- Coordinates in a two dimensional grid. ⟨0,0⟩ is the upper left.
structure Coords where
  x : Nat -- column number
  y : Nat -- row number
deriving BEq

instance : ToString Coords where
  toString := (λ ⟨x,y⟩ => String.join ["Coords.mk ", toString x, ", ", toString y])

structure GameState where
  size     : Coords      -- coordinates of bottom-right cell
  position : Coords      -- row and column of the player
  walls    : List Coords -- maze cells that are not traversible

-- We define custom syntax for GameState.

declare_syntax_cat game_cell
declare_syntax_cat game_cell_sequence
declare_syntax_cat game_row
declare_syntax_cat horizontal_border
declare_syntax_cat game_top_row
declare_syntax_cat game_bottom_row

syntax "─" : horizontal_border

syntax "\n┌" horizontal_border* "┐\n" : game_top_row

syntax "└" horizontal_border* "┘\n" : game_bottom_row

syntax "░" : game_cell -- empty
syntax "▓" : game_cell -- wall
syntax "@" : game_cell -- player

syntax "│" game_cell* "│\n" : game_row

syntax:max game_top_row game_row* game_bottom_row : term

inductive CellContents where
  | empty  : CellContents
  | wall   : CellContents
  | player : CellContents

def update_state_with_row_aux : Nat → Nat → List CellContents → GameState → GameState
| currentRowNum, currentColNum, [], oldState => oldState
| currentRowNum, currentColNum, cell::contents, oldState =>
    let oldState' := update_state_with_row_aux currentRowNum (currentColNum+1) contents oldState
    match cell with
    | CellContents.empty => oldState'
    | CellContents.wall => {oldState' .. with
                            walls := ⟨currentColNum,currentRowNum⟩::oldState'.walls}
    | CellContents.player => {oldState' .. with
                              position := ⟨currentColNum,currentRowNum⟩}

def update_state_with_row : Nat → List CellContents → GameState → GameState
| currentRowNum, rowContents, oldState => update_state_with_row_aux currentRowNum 0 rowContents oldState

-- size, current row, remaining cells -> gamestate
def game_state_from_cells_aux : Coords → Nat → List (List CellContents) → GameState
| size, _, [] => ⟨size, ⟨0,0⟩, []⟩
| size, currentRow, row::rows =>
        let prevState := game_state_from_cells_aux size (currentRow + 1) rows
        update_state_with_row currentRow row prevState

-- size, remaining cells -> gamestate
def game_state_from_cells : Coords → List (List CellContents) → GameState
| size, cells => game_state_from_cells_aux size 0 cells

def termOfCell : Lean.Macro
| `(game_cell| ░) => `(CellContents.empty)
| `(game_cell| ▓) => `(CellContents.wall)
| `(game_cell| @) => `(CellContents.player)
| _ => Lean.Macro.throwError "unknown game cell"

def termOfGameRow : Nat → Lean.Macro
| expectedRowSize, `(game_row| │$cells:game_cell*│) =>
      do if cells.size != expectedRowSize
         then Lean.Macro.throwError "row has wrong size"
         let cells' ← Array.mapM termOfCell cells
         `([$cells',*])
| _, _ => Lean.Macro.throwError "unknown game row"

macro_rules
| `(┌ $tb:horizontal_border* ┐
    $rows:game_row*
    └ $bb:horizontal_border* ┘) =>
      do let rsize := Lean.Syntax.mkNumLit (toString rows.size)
         let csize := Lean.Syntax.mkNumLit (toString tb.size)
         if tb.size != bb.size then Lean.Macro.throwError "top/bottom border mismatch"
         let rows' ← Array.mapM (termOfGameRow tb.size) rows
         `(game_state_from_cells ⟨$csize,$rsize⟩ [$rows',*])

---------------------------
-- Now we define a delaborator that will cause GameState to be rendered as a maze.

def extractXY : Lean.Expr → Lean.MetaM Coords
| e => do
  let e':Lean.Expr ← (Lean.Meta.whnf e)
  let sizeArgs := Lean.Expr.getAppArgs e'
  let f := Lean.Expr.getAppFn e'
  let x ← Lean.Meta.whnf sizeArgs[0]
  let y ← Lean.Meta.whnf sizeArgs[1]
  let numCols := (Lean.Expr.natLit? x).get!
  let numRows := (Lean.Expr.natLit? y).get!
  Coords.mk numCols numRows

partial def extractWallList : Lean.Expr → Lean.MetaM (List Coords)
| exp => do
  let exp':Lean.Expr ← (Lean.Meta.whnf exp)
  let f := Lean.Expr.getAppFn exp'
  if f.constName!.toString == "List.cons"
  then let consArgs := Lean.Expr.getAppArgs exp'
       let rest ← extractWallList consArgs[2]
       let ⟨wallCol, wallRow⟩ ← extractXY consArgs[1]
       (Coords.mk wallCol wallRow) :: rest
  else [] -- "List.nil"

partial def extractGameState : Lean.Expr → Lean.MetaM GameState
| exp => do
    let exp': Lean.Expr ← (Lean.Meta.whnf exp)
    let gameStateArgs := Lean.Expr.getAppArgs exp'
    let size ← extractXY gameStateArgs[0]
    let playerCoords ← extractXY gameStateArgs[1]
    let walls ← extractWallList gameStateArgs[2]
    pure ⟨size, playerCoords, walls⟩

def update2dArray {α : Type} : Array (Array α) → Coords → α → Array (Array α)
| a, ⟨x,y⟩, v =>
   Array.set! a y $ Array.set! (Array.get! a y) x v

def update2dArrayMulti {α : Type} : Array (Array α) → List Coords → α → Array (Array α)
| a, [], v => a
| a, c::cs, v =>
     let a' := update2dArrayMulti a cs v
     update2dArray a' c v

def delabGameRow : (Array Lean.Syntax) → Lean.PrettyPrinter.Delaborator.Delab
| a => `(game_row| │ $a:game_cell* │)

def delabGameState : Lean.Expr → Lean.PrettyPrinter.Delaborator.Delab
| e =>
  do guard $ e.getAppNumArgs == 3
     let ⟨⟨numCols, numRows⟩, playerCoords, walls⟩ ←
       try extractGameState e
       catch err => failure -- can happen if game state has variables in it

     let topBar := Array.mkArray numCols $ ← `(horizontal_border| ─)
     let emptyCell ← `(game_cell| ░)
     let emptyRow := Array.mkArray numCols emptyCell
     let emptyRowStx ← `(game_row| │$emptyRow:game_cell*│)
     let allRows := Array.mkArray numRows emptyRowStx

     let a0 := Array.mkArray numRows $ Array.mkArray numCols emptyCell
     let a1 := update2dArray a0 playerCoords $ ← `(game_cell| @)
     let a2 := update2dArrayMulti a1 walls $ ← `(game_cell| ▓)
     let aa ← Array.mapM delabGameRow a2

     `(┌$topBar:horizontal_border*┐ $aa:game_row*
       └$topBar:horizontal_border*┘)

-- The attribute [delab] registers this function as a delaborator for the GameState.mk constructor.
@[delab app.GameState.mk] def delabGameStateMk : Lean.PrettyPrinter.Delaborator.Delab := do
  let e ← Lean.PrettyPrinter.Delaborator.SubExpr.getExpr
  delabGameState e

-- We register the same elaborator for applications of the game_state_from_cells function.
@[delab app.game_state_from_cells] def delabGameState' : Lean.PrettyPrinter.Delaborator.Delab :=
  do let e ← Lean.PrettyPrinter.Delaborator.SubExpr.getExpr
     let e' ← (Lean.Meta.whnf e)
     delabGameState e'

--------------------------

inductive Move where
  | east  : Move
  | west  : Move
  | north : Move
  | south : Move

@[simp]
def make_move : GameState → Move → GameState
| ⟨s, ⟨x,y⟩, w⟩, Move.east =>
             if w.notElem ⟨x+1, y⟩ ∧ x + 1 ≤ s.x
             then ⟨s, ⟨x+1, y⟩, w⟩
             else ⟨s, ⟨x,y⟩, w⟩
| ⟨s, ⟨x,y⟩, w⟩, Move.west =>
             if w.notElem ⟨x-1, y⟩
             then ⟨s, ⟨x-1, y⟩, w⟩
             else ⟨s, ⟨x,y⟩, w⟩
| ⟨s, ⟨x,y⟩, w⟩, Move.north =>
             if w.notElem ⟨x, y-1⟩
             then ⟨s, ⟨x, y-1⟩, w⟩
             else ⟨s, ⟨x,y⟩, w⟩
| ⟨s, ⟨x,y⟩, w⟩, Move.south =>
             if w.notElem ⟨x, y + 1⟩ ∧ y + 1 ≤ s.y
             then ⟨s, ⟨x, y+1⟩, w⟩
             else ⟨s, ⟨x,y⟩, w⟩

def is_win : GameState → Prop
| ⟨⟨sx, sy⟩, ⟨x,y⟩, w⟩ => x = 0 ∨ y = 0 ∨ x + 1 = sx ∨ y + 1 = sy

def can_escape (state : GameState) : Prop :=
  ∃ (gs : List Move), is_win (List.foldl make_move state gs)

theorem can_still_escape
  (g : GameState) (m : Move) (hg : can_escape (make_move g m)) : can_escape g :=
 have ⟨pms, hpms⟩ := hg
 Exists.intro (m::pms) hpms

theorem step_west
  {s: Coords}
  {x y : Nat}
  {w: List Coords}
  (hclear' : w.notElem ⟨x,y⟩)
  (W : can_escape ⟨s,⟨x,y⟩,w⟩) :
  can_escape ⟨s,⟨x+1,y⟩,w⟩ :=
   by have hmm : GameState.mk s ⟨x,y⟩ w = make_move ⟨s,⟨x+1, y⟩,w⟩ Move.west :=
               by have h' : x + 1 - 1 = x := rfl
                  simp [h', hclear']
      rw [hmm] at W
      exact can_still_escape ⟨s,⟨x+1,y⟩,w⟩ Move.west W

theorem step_east
  {s: Coords}
  {x y : Nat}
  {w: List Coords}
  (hclear' : w.notElem ⟨x+1,y⟩)
  (hinbounds : x + 1 ≤ s.x)
  (E : can_escape ⟨s,⟨x+1,y⟩,w⟩) :
  can_escape ⟨s,⟨x, y⟩,w⟩ :=
    by have hmm : GameState.mk s ⟨x+1,y⟩ w = make_move ⟨s, ⟨x,y⟩,w⟩ Move.east :=
         by simp [hclear', hinbounds]
       rw [hmm] at E
       exact can_still_escape ⟨s, ⟨x,y⟩, w⟩ Move.east E

theorem step_north
  {s: Coords}
  {x y : Nat}
  {w: List Coords}
  (hclear' : w.notElem ⟨x,y⟩)
  (N : can_escape ⟨s,⟨x,y⟩,w⟩) :
  can_escape ⟨s,⟨x, y+1⟩,w⟩ :=
    by have hmm : GameState.mk s ⟨x,y⟩ w = make_move ⟨s,⟨x, y+1⟩,w⟩ Move.north :=
         by have h' : y + 1 - 1 = y := rfl
            simp [h', hclear']
       rw [hmm] at N
       exact can_still_escape ⟨s,⟨x,y+1⟩,w⟩ Move.north N

theorem step_south
  {s: Coords}
  {x y : Nat}
  {w: List Coords}
  (hclear' : w.notElem ⟨x,y+1⟩)
  (hinbounds : y + 1 ≤ s.y)
  (S : can_escape ⟨s,⟨x,y+1⟩,w⟩) :
  can_escape ⟨s,⟨x, y⟩,w⟩ :=
    by have hmm : GameState.mk s ⟨x,y+1⟩ w = make_move ⟨s,⟨x, y⟩,w⟩ Move.south :=
            by simp [hclear', hinbounds]
       rw [hmm] at S
       exact can_still_escape ⟨s,⟨x,y⟩,w⟩ Move.south S

def escape_west {sx sy : Nat} {y : Nat} {w : List Coords} : can_escape ⟨⟨sx, sy⟩,⟨0, y⟩,w⟩ :=
    ⟨[], Or.inl rfl⟩

def escape_east {sy x y : Nat} {w : List Coords} : can_escape ⟨⟨x+1, sy⟩,⟨x, y⟩,w⟩ :=
  ⟨[], Or.inr $ Or.inr $ Or.inl rfl⟩

def escape_north {sx sy : Nat} {x : Nat} {w : List Coords} : can_escape ⟨⟨sx, sy⟩,⟨x, 0⟩,w⟩ :=
  ⟨[], Or.inr $ Or.inl rfl⟩

def escape_south {sx x y : Nat} {w: List Coords} : can_escape ⟨⟨sx, y+1⟩,⟨x, y⟩,w⟩ :=
  ⟨[], Or.inr $ Or.inr $ Or.inr rfl⟩

-- Define an "or" tactic combinator, like <|> in Lean 3.
elab t1:tactic " ⟨|⟩ " t2:tactic : tactic =>
   try Lean.Elab.Tactic.evalTactic t1
   catch err => Lean.Elab.Tactic.evalTactic t2

elab "fail" m:term  : tactic => throwError m

-- the `simp`s are to discharge the `hclear` and `hinbounds` side-goals
macro "west" : tactic => `((apply step_west; simp)    ⟨|⟩ fail "cannot step west")
macro "east" : tactic => `((apply step_east; simp; simp)    ⟨|⟩ fail "cannot step east")
macro "xxx" : tactic => `((apply step_east; simp; simp)    ⟨|⟩ fail "cannot step xxx")
macro "north" : tactic => `((apply step_north; simp)  ⟨|⟩ fail "cannot step north")
macro "south" : tactic => `((apply step_south; simp; simp)  ⟨|⟩ fail "cannot step south")

macro "out" : tactic => `(apply escape_north ⟨|⟩ apply escape_south ⟨|⟩
                           apply escape_east ⟨|⟩ apply escape_west ⟨|⟩
                           fail "not currently at maze boundary")

-- Can escape the trivial maze in any direction.
example : can_escape ┌─┐
                     │@│
                     └─┘ := by out

-- some other mazes with immediate escapes
example : can_escape ┌──┐
                     │░░│
                     │@░│
                     │░░│
                     └──┘ := by out
example : can_escape ┌──┐
                     │░░│
                     │░@│
                     │░░│
                     └──┘ := by out
example : can_escape ┌───┐
                     │░@░│
                     │░░░│
                     │░░░│
                     └───┘ := by out
example : can_escape ┌───┐
                     │░░░│
                     │░░░│
                     │░@░│
                     └───┘ := by out

-- Now for some more interesting mazes.

abbrev maze1 := ┌──────┐
                │▓▓▓▓▓▓│
                │▓░░@░▓│
                │▓░░░░▓│
                │▓░░░░▓│
                │▓▓▓▓░▓│
                └──────┘

def ex1 : can_escape maze1 := by
  west
  west
  east
  south
  south
  east
  east
  south
  out

def maze2 := ┌────────┐
             │▓▓▓▓▓▓▓▓│
             │▓░▓@▓░▓▓│
             │▓░▓░░░▓▓│
             │▓░░▓░▓▓▓│
             │▓▓░▓░▓░░│
             │▓░░░░▓░▓│
             │▓░▓▓▓▓░▓│
             │▓░░░░░░▓│
             │▓▓▓▓▓▓▓▓│
             └────────┘

example : can_escape maze2 :=
 by south
    east
    south
    south
    south
    west
    west
    west
    south
    south
    east
    east
    east
    east
    east
    north
    north
    north
    east
    out

def maze3 := ┌────────────────────────────┐
             │▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓│
             │▓░░░░░░░░░░░░░░░░░░░░▓░░░@░▓│
             │▓░▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓░▓░▓▓▓▓▓│
             │▓░▓░░░▓░░░░▓░░░░░░░░░▓░▓░░░▓│
             │▓░▓░▓░▓░▓▓▓▓░▓▓▓▓▓▓▓▓▓░▓░▓░▓│
             │▓░▓░▓░▓░▓░░░░▓░░░░░░░░░░░▓░▓│
             │▓░▓░▓░▓░▓░▓▓▓▓▓▓▓▓▓▓▓▓░▓▓▓░▓│
             │▓░▓░▓░▓░░░▓░░░░░░░░░░▓░░░▓░▓│
             │▓░▓░▓░▓▓▓░▓░▓▓▓▓▓▓▓▓▓▓░▓░▓░▓│
             │▓░▓░▓░░░░░▓░░░░░░░░░░░░▓░▓░▓│
             │▓░▓░▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓░▓│
             │░░▓░░░░░░░░░░░░░░░░░░░░░░░░▓│
             │▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓│
             └────────────────────────────┘

example : can_escape maze3 :=
 by west
    west
    west
    south
    admit -- can you finish the proof?


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

Standard identity and composition functors
-/
import tactic.ext tactic.cache category.basic

universe variables u v w

section functor

variables {F : Type u → Type v}
variables {α β γ : Type u}
variables [functor F] [is_lawful_functor F]

lemma functor.map_id : (<$>) id = (id : F α → F α) :=
by apply funext; apply id_map

lemma functor.map_comp_map (f : α → β) (g : β → γ) :
  ((<$>) g ∘ (<$>) f : F α → F γ) = (<$>) (g ∘ f) :=
by apply funext; intro; rw comp_map

theorem functor.ext {F} : ∀ {F1 : functor F} {F2 : functor F}
  [@is_lawful_functor F F1] [@is_lawful_functor F F2]
  (H : ∀ α β (f : α → β) (x : F α),
    @functor.map _ F1 _ _ f x = @functor.map _ F2 _ _ f x),
  F1 = F2
| ⟨m, mc⟩ ⟨m', mc'⟩ H1 H2 H :=
begin
  cases show @m = @m', by funext α β f x; apply H,
  congr, funext α β,
  have E1 := @map_const_eq _ ⟨@m, @mc⟩ H1,
  have E2 := @map_const_eq _ ⟨@m, @mc'⟩ H2,
  exact E1.trans E2.symm
end

end functor

def id.mk {α : Sort u} : α → id α := id

namespace functor

/-- `functor.comp` is a wrapper around `function.comp` for types.
    It prevents Lean's type class resolution mechanism from trying
    a `functor (comp F id)` when `functor F` would do. -/
def comp (F : Type u → Type w) (G : Type v → Type u) (α : Type v) : Type w :=
F $ G α

@[pattern] def comp.mk {F : Type u → Type w} {G : Type v → Type u} {α : Type v}
  (x : F (G α)) : comp F G α := x

def comp.run {F : Type u → Type w} {G : Type v → Type u} {α : Type v}
  (x : comp F G α) : F (G α) := x

namespace comp

variables {F : Type u → Type w} {G : Type v → Type u}

protected lemma ext
  {α} {x y : comp F G α} : x.run = y.run → x = y := id

variables [functor F] [functor G]

protected def map {α β : Type v} (h : α → β) : comp F G α → comp F G β
| (comp.mk x) := comp.mk ((<$>) h <$> x)

instance : functor (comp F G) := { map := @comp.map F G _ _ }

@[functor_norm] lemma map_mk {α β} (h : α → β) (x : F (G α)) :
  h <$> comp.mk x = comp.mk ((<$>) h <$> x) := rfl

variables [is_lawful_functor F] [is_lawful_functor G]
variables {α β γ : Type v}

protected lemma id_map : ∀ (x : comp F G α), comp.map id x = x
| (comp.mk x) := by simp [comp.map, functor.map_id]

protected lemma comp_map (g' : α → β) (h : β → γ) : ∀ (x : comp F G α),
           comp.map (h ∘ g') x = comp.map h (comp.map g' x)
| (comp.mk x) := by simp [comp.map, functor.map_comp_map g' h] with functor_norm

@[simp] protected lemma run_map (h : α → β) (x : comp F G α) :
  (h <$> x).run = (<$>) h <$> x.run := rfl

instance : is_lawful_functor (comp F G) :=
{ id_map := @comp.id_map F G _ _ _ _,
  comp_map := @comp.comp_map F G _ _ _ _ }

theorem functor_comp_id {F} [AF : functor F] [is_lawful_functor F] :
  @comp.functor F id _ _ = AF :=
@functor.ext F _ AF (@comp.is_lawful_functor F id _ _ _ _) _ (λ α β f x, rfl)

theorem functor_id_comp {F} [AF : functor F] [is_lawful_functor F] :
  @comp.functor id F _ _ = AF :=
@functor.ext F _ AF (@comp.is_lawful_functor id F _ _ _ _) _ (λ α β f x, rfl)

end comp

end functor

namespace ulift

instance : functor ulift :=
{ map := λ α β f, up ∘ f ∘ down }

end ulift

namespace sum

variables {γ : Type u} {α β : Type v}

protected def mapr (f : α → β) : γ ⊕ α → γ ⊕ β
| (inl x) := inl x
| (inr x) := inr (f x)

instance : functor (sum.{u v} γ) :=
{ map := @sum.mapr γ }

instance : is_lawful_functor (sum γ) :=
{ id_map := by intros; casesm _ ⊕ _; refl,
  comp_map := by intros; casesm _ ⊕ _; refl }

end sum


def myid (a : α) := a -- works

#check myid 10
#check myid true

theorem ex1 (a : α) : myid a = a := rfl

def cnst (b : β) : α → β := fun _ => b -- works

theorem ex2 (b : β) (a : α) : cnst b a = b := rfl

def Vec (α : Type) (n : Nat) := { a : Array α // a.size = n }

def mkVec : Vec α 0 := ⟨ #[], rfl ⟩

def Vec.map (xs : Vec α n) (f : α → β) : Vec β n :=
  ⟨ xs.val.map f, sorry ⟩

/- unbound implicit locals must be greek or lower case letters followed by numerical digits -/
def Vec.map2 (xs : Vec α size /- error: unknown identifier size -/) (f : α → β) : Vec β n :=
  ⟨ xs.val.map f, sorry ⟩

set_option autoBoundImplicitLocal false in
def Vec.map3 (xs : Vec α n) (f : α → β) : Vec β n := -- Errors, unknown identifiers 'α', 'n', 'β'
  ⟨ xs.val.map f, sorry ⟩

def double [Add α] (a : α) := a + a

variable (xs : Vec α n) -- works

def f := xs

#check @f

#check f mkVec

#check f (α := Nat) mkVec

def g (a : α) := xs.val.push a

theorem ex3 : g ⟨#[0], rfl⟩ 1 = #[0, 1] :=
  rfl

inductive Tree (α β : Type) :=
  | leaf1 : α → Tree α β
  | leaf2 : β → Tree α β
  | node : Tree α β → Tree α β → Tree α β

inductive TreeElem1 : α → Tree α β → Prop
  | leaf1     : (a : α) → TreeElem1 a (Tree.leaf1 (β := β) a)
  | nodeLeft  : (a : α) → (left : Tree α β) → (right : Tree α β) → TreeElem1 a left  → TreeElem1 a (Tree.node left right)
  | nodeRight : (a : α) → (left : Tree α β) → (right : Tree α β) → TreeElem1 a right → TreeElem1 a (Tree.node left right)

inductive TreeElem2 : β → Tree α β → Prop
  | leaf2     : (b : β) → TreeElem2 b (Tree.leaf2 (α := α) b)
  | nodeLeft  : (b : β) → (left : Tree α β) → (right : Tree α β) → TreeElem2 b left  → TreeElem2 b (Tree.node left right)
  | nodeRight : (b : β) → (left : Tree α β) → (right : Tree α β) → TreeElem2 b right → TreeElem2 b (Tree.node left right)

namespace Ex1

def findSomeRevM? [Monad m] (as : Array α) (f : α → m (Option β)) : m (Option β) :=
  pure none

def findSomeRev? (as : Array α) (f : α → Option β) : Option β :=
  Id.run <| findSomeRevM? as f

end Ex1

def apply {α : Type u₁} {β : α → Type u₂} (f : (a : α) → β a) (a : α) : β a :=
  f a

def pair (a : α₁) := (a, a)


/-
Copyright © 2020 Nicolò Cavalleri. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Nicolò Cavalleri.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.geometry.manifold.times_cont_mdiff_map
import Mathlib.PostPort

universes u_1 u_2 u_3 u_5 u_6 u_8 u_9 l u_10 u_4 u_7

namespace Mathlib

/-!
# Diffeomorphisms
This file implements diffeomorphisms.

## Definitions

* `times_diffeomorph I I' M M' n`:  `n`-times continuously differentiable diffeomorphism between
                                    `M` and `M'` with respect to I and I'
* `diffeomorph  I I' M M'` : smooth diffeomorphism between `M` and `M'` with respect to I and I'

## Notations

* `M ≃ₘ^n⟮I, I'⟯ M'` := `times_diffeomorph I J M N n`
* `M ≃ₘ⟮I, I'⟯ M'`   := `times_diffeomorph I J M N ⊤`

## Implementation notes

This notion of diffeomorphism is needed although there is already a notion of structomorphism
because structomorphisms do not allow the model spaces `H` and `H'` of the two manifolds to be
different, i.e. for a structomorphism one has to impose `H = H'` which is often not the case in
practice.

-/

/--
`n`-times continuously differentiable diffeomorphism between `M` and `M'` with respect to I and I'
-/
structure times_diffeomorph {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {E' : Type u_3} [normed_group E'] [normed_space 𝕜 E'] {H : Type u_5} [topological_space H] {H' : Type u_6} [topological_space H'] (I : model_with_corners 𝕜 E H) (I' : model_with_corners 𝕜 E' H') (M : Type u_8) [topological_space M] [charted_space H M] [smooth_manifold_with_corners I M] (M' : Type u_9) [topological_space M'] [charted_space H' M'] [smooth_manifold_with_corners I' M'] (n : with_top ℕ)
extends M ≃ M'
where
  times_cont_mdiff_to_fun : times_cont_mdiff I I' n (equiv.to_fun _to_equiv)
  times_cont_mdiff_inv_fun : times_cont_mdiff I' I n (equiv.inv_fun _to_equiv)

/-- A `diffeomorph` is just a smooth `times_diffeomorph`. -/
def diffeomorph {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {E' : Type u_3} [normed_group E'] [normed_space 𝕜 E'] {H : Type u_5} [topological_space H] {H' : Type u_6} [topological_space H'] (I : model_with_corners 𝕜 E H) (I' : model_with_corners 𝕜 E' H') (M : Type u_8) [topological_space M] [charted_space H M] [smooth_manifold_with_corners I M] (M' : Type u_9) [topological_space M'] [charted_space H' M'] [smooth_manifold_with_corners I' M'] :=
  times_diffeomorph I I' M M' ⊤

namespace times_diffeomorph

protected instance has_coe_to_fun {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {E' : Type u_3} [normed_group E'] [normed_space 𝕜 E'] {H : Type u_5} [topological_space H] {H' : Type u_6} [topological_space H'] (I : model_with_corners 𝕜 E H) (I' : model_with_corners 𝕜 E' H') (M : Type u_8) [topological_space M] [charted_space H M] [smooth_manifold_with_corners I M] (M' : Type u_9) [topological_space M'] [charted_space H' M'] [smooth_manifold_with_corners I' M'] (n : with_top ℕ) : has_coe_to_fun (times_diffeomorph I I' M M' n) :=
  has_coe_to_fun.mk (fun (_x : times_diffeomorph I I' M M' n) => M → M')
    fun (e : times_diffeomorph I I' M M' n) => ⇑(times_diffeomorph.to_equiv e)

protected instance times_cont_mdiff_map.has_coe {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {E' : Type u_3} [normed_group E'] [normed_space 𝕜 E'] {H : Type u_5} [topological_space H] {H' : Type u_6} [topological_space H'] (I : model_with_corners 𝕜 E H) (I' : model_with_corners 𝕜 E' H') (M : Type u_8) [topological_space M] [charted_space H M] [smooth_manifold_with_corners I M] (M' : Type u_9) [topological_space M'] [charted_space H' M'] [smooth_manifold_with_corners I' M'] (n : with_top ℕ) : has_coe (times_diffeomorph I I' M M' n) (times_cont_mdiff_map I I' M M' n) :=
  has_coe.mk
    fun (Φ : times_diffeomorph I I' M M' n) => times_cont_mdiff_map.mk (⇑Φ) (times_diffeomorph.times_cont_mdiff_to_fun Φ)

protected theorem continuous {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {E' : Type u_3} [normed_group E'] [normed_space 𝕜 E'] {H : Type u_5} [topological_space H] {H' : Type u_6} [topological_space H'] (I : model_with_corners 𝕜 E H) (I' : model_with_corners 𝕜 E' H') (M : Type u_8) [topological_space M] [charted_space H M] [smooth_manifold_with_corners I M] (M' : Type u_9) [topological_space M'] [charted_space H' M'] [smooth_manifold_with_corners I' M'] (n : with_top ℕ) (h : times_diffeomorph I I' M M' n) : continuous ⇑h :=
  times_cont_mdiff.continuous (times_diffeomorph.times_cont_mdiff_to_fun h)

protected theorem times_cont_mdiff {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {E' : Type u_3} [normed_group E'] [normed_space 𝕜 E'] {H : Type u_5} [topological_space H] {H' : Type u_6} [topological_space H'] (I : model_with_corners 𝕜 E H) (I' : model_with_corners 𝕜 E' H') (M : Type u_8) [topological_space M] [charted_space H M] [smooth_manifold_with_corners I M] (M' : Type u_9) [topological_space M'] [charted_space H' M'] [smooth_manifold_with_corners I' M'] (n : with_top ℕ) (h : times_diffeomorph I I' M M' n) : times_cont_mdiff I I' n ⇑h :=
  times_diffeomorph.times_cont_mdiff_to_fun h

protected theorem smooth {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {E' : Type u_3} [normed_group E'] [normed_space 𝕜 E'] {H : Type u_5} [topological_space H] {H' : Type u_6} [topological_space H'] (I : model_with_corners 𝕜 E H) (I' : model_with_corners 𝕜 E' H') (M : Type u_8) [topological_space M] [charted_space H M] [smooth_manifold_with_corners I M] (M' : Type u_9) [topological_space M'] [charted_space H' M'] [smooth_manifold_with_corners I' M'] (h : times_diffeomorph I I' M M' ⊤) : smooth I I' ⇑h :=
  times_diffeomorph.times_cont_mdiff_to_fun h

theorem coe_eq_to_equiv {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {E' : Type u_3} [normed_group E'] [normed_space 𝕜 E'] {H : Type u_5} [topological_space H] {H' : Type u_6} [topological_space H'] (I : model_with_corners 𝕜 E H) (I' : model_with_corners 𝕜 E' H') (M : Type u_8) [topological_space M] [charted_space H M] [smooth_manifold_with_corners I M] (M' : Type u_9) [topological_space M'] [charted_space H' M'] [smooth_manifold_with_corners I' M'] (n : with_top ℕ) (h : times_diffeomorph I I' M M' n) (x : M) : coe_fn h x = coe_fn (times_diffeomorph.to_equiv h) x :=
  rfl

/-- Identity map as a diffeomorphism. -/
protected def refl {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {H : Type u_5} [topological_space H] (I : model_with_corners 𝕜 E H) (M : Type u_8) [topological_space M] [charted_space H M] [smooth_manifold_with_corners I M] (n : with_top ℕ) : times_diffeomorph I I M M n :=
  mk (equiv.mk (equiv.to_fun (equiv.refl M)) (equiv.inv_fun (equiv.refl M)) sorry sorry) times_cont_mdiff_id
    times_cont_mdiff_id

/-- Composition of two diffeomorphisms. -/
protected def trans {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {E' : Type u_3} [normed_group E'] [normed_space 𝕜 E'] {F : Type u_4} [normed_group F] [normed_space 𝕜 F] {H : Type u_5} [topological_space H] {H' : Type u_6} [topological_space H'] {G : Type u_7} [topological_space G] (I : model_with_corners 𝕜 E H) (I' : model_with_corners 𝕜 E' H') (J : model_with_corners 𝕜 F G) (M : Type u_8) [topological_space M] [charted_space H M] [smooth_manifold_with_corners I M] (M' : Type u_9) [topological_space M'] [charted_space H' M'] [smooth_manifold_with_corners I' M'] (N : Type u_10) [topological_space N] [charted_space G N] [smooth_manifold_with_corners J N] (n : with_top ℕ) (h₁ : times_diffeomorph I I' M M' n) (h₂ : times_diffeomorph I' J M' N n) : times_diffeomorph I J M N n :=
  mk
    (equiv.mk (equiv.to_fun (equiv.trans (times_diffeomorph.to_equiv h₁) (times_diffeomorph.to_equiv h₂)))
      (equiv.inv_fun (equiv.trans (times_diffeomorph.to_equiv h₁) (times_diffeomorph.to_equiv h₂))) sorry sorry)
    sorry sorry

/-- Inverse of a diffeomorphism. -/
protected def symm {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_4} [normed_group F] [normed_space 𝕜 F] {H : Type u_5} [topological_space H] {G : Type u_7} [topological_space G] (I : model_with_corners 𝕜 E H) (J : model_with_corners 𝕜 F G) (M : Type u_8) [topological_space M] [charted_space H M] [smooth_manifold_with_corners I M] (N : Type u_10) [topological_space N] [charted_space G N] [smooth_manifold_with_corners J N] (n : with_top ℕ) (h : times_diffeomorph I J M N n) : times_diffeomorph J I N M n :=
  mk
    (equiv.mk (equiv.to_fun (equiv.symm (times_diffeomorph.to_equiv h)))
      (equiv.inv_fun (equiv.symm (times_diffeomorph.to_equiv h))) sorry sorry)
    (times_diffeomorph.times_cont_mdiff_inv_fun h) (times_diffeomorph.times_cont_mdiff_to_fun h)


import for_mathlib.homological_complex_op
import for_mathlib.split_exact
import for_mathlib.AddCommGroup.exact
import for_mathlib.unop

import pseudo_normed_group.FP2
import pseudo_normed_group.system_of_complexes

import system_of_complexes.rescale

import prop_92.prop_92

noncomputable theory

open_locale nnreal

universes u v

open category_theory breen_deligne

variables (r r' : ℝ≥0)
variables (BD : breen_deligne.data)
variables (M : ProFiltPseuNormGrpWithTinv.{u} r')
variables (V : SemiNormedGroup.{v})

set_option pp.universes true

def aux_system (κ : ℝ≥0 → ℕ → ℝ≥0) [∀ c, BD.suitable (κ c)] [∀ (n : ℕ), fact (monotone (function.swap κ n))] :
  system_of_complexes :=
(FPsystem r' BD M κ).op ⋙
  (((CLC.{v u} V).right_op.map_FreeAb ⋙ FreeAb.eval _).map_homological_complex _).op ⋙
  homological_complex.unop_functor

namespace aux_system

variables [fact (0 < r)] [fact (0 < r')] [fact (r' ≤ 1)]

open system_of_complexes opposite

variables (κ₁ κ₂ : ℝ≥0 → ℕ → ℝ≥0) [∀ c, BD.suitable (κ₁ c)] [∀ c, BD.suitable (κ₂ c)]

def Tinv [hκ₁ : ∀ n, fact (monotone (function.swap κ₁ n))] [hκ₂ : ∀ n, fact (monotone (function.swap κ₂ n))]
  [∀ c n, fact (κ₁ c n ≤ r' * κ₂ c n)] :
  aux_system r' BD M V κ₂ ⟶ aux_system r' BD M V κ₁ :=
whisker_right (nat_trans.op $ FPsystem.Tinv r' BD M κ₁ κ₂)
  ((((CLC.{v u} V).right_op.map_FreeAb ⋙ FreeAb.eval _).map_homological_complex _).op ⋙
    homological_complex.unop_functor)

lemma Tinv_eq [hκ₁ : ∀ n, fact (monotone (function.swap κ₁ n))] [hκ₂ : ∀ n, fact (monotone (function.swap κ₂ n))]
  [∀ c n, fact (κ₁ c n ≤ r' * κ₂ c n)] (c : ℝ≥0ᵒᵖ) (n : ℕ) :
  ((Tinv r' BD M V κ₁ κ₂).app c).f n =
  ((CLCFP.Tinv V r' _ _ (BD.X n)).app (op M) : _) :=
begin
  dsimp only [Tinv, CLCFP.Tinv, FPsystem.Tinv, FP2.Tinv,
    homological_complex.comp_f, aux_system, functor.comp_map, homological_complex.unop_functor,
    homological_complex.unop_d, functor.op_obj, functor.map_homological_complex_obj_d,
    unop_op, CLC, functor.op_map, quiver.hom.unop_op, functor.map_homological_complex_map_f,
    functor.map_FreeAb, FreeAb.eval, free_abelian_group.map_of_apply,
    FPsystem, FP2.res_app, FreeAb.of_functor, functor.right_op_map,
    whisker_right_app, nat_trans.op_app],
  erw [free_abelian_group.lift.of],
  refl,
end

def T_inv [normed_with_aut r V]
  (κ : ℝ≥0 → ℕ → ℝ≥0) [∀ c, BD.suitable (κ c)] [∀ (n : ℕ), fact (monotone (function.swap κ n))] :
  aux_system r' BD M V κ ⟶ aux_system r' BD M V κ :=
{ app := λ c,
  { f := λ i, normed_group_hom.completion $ (SemiNormedGroup.LocallyConstant.map $ normed_with_aut.T.inv).app _,
    comm' := begin
      rintro i j (rfl : i + 1 = j),
      dsimp only [aux_system, functor.comp_obj, homological_complex.unop_functor,
        homological_complex.unop_d, functor.op_obj, functor.map_homological_complex_obj_d,
        unop_op],
      erw [← SemiNormedGroup.Completion_map, ← SemiNormedGroup.Completion_map, chain_complex.of_d],
      dsimp only [FPsystem.d, universal_map.eval_FP2, universal_map.eval_CLCFP,
        universal_map.eval_LCFP, CLC],
      simp only [nat_trans.app_sum, functor.map_sum, preadditive.comp_sum, preadditive.sum_comp,
        category_theory.unop_sum, nat_trans.app_zsmul, functor.map_zsmul,
        preadditive.comp_zsmul, preadditive.zsmul_comp, category_theory.unop_zsmul],
      refine finset.sum_congr rfl _,
      rintro ⟨g, hg⟩ -,
      dsimp only [basic_universal_map.eval_FP2, basic_universal_map.eval_LCFP,
        whisker_right_app, nat_trans.op_app, unop_op, FreeAb.of_functor,
        free_abelian_group.map_of_apply, functor.right_op_map, LC,
        functor.comp_map, functor.map_FreeAb, FreeAb.eval],
      rw [free_abelian_group.lift.of, _root_.id, quiver.hom.unop_op,
        ← SemiNormedGroup.Completion.map_comp, ← SemiNormedGroup.Completion.map_comp,
        nat_trans.naturality],
    end },
  naturality' := λ c₁ c₂ h, begin
    ext n : 2,
    dsimp only [homological_complex.comp_f, aux_system, functor.comp_map, homological_complex.unop_functor,
      homological_complex.unop_d, functor.op_obj, functor.map_homological_complex_obj_d,
      unop_op, CLC, functor.op_map, quiver.hom.unop_op, functor.map_homological_complex_map_f,
      functor.map_FreeAb, FreeAb.eval, free_abelian_group.map_of_apply,
      FPsystem, FP2.res_app, FreeAb.of_functor, functor.right_op_map],
    rw [← SemiNormedGroup.Completion_map, ← SemiNormedGroup.Completion_map,
      free_abelian_group.lift.of, _root_.id, quiver.hom.unop_op,
      ← SemiNormedGroup.Completion.map_comp, ← SemiNormedGroup.Completion.map_comp,
        nat_trans.naturality],
    refl,
  end }
.

variables [normed_with_aut r V]

lemma T_inv_eq
  (κ : ℝ≥0 → ℕ → ℝ≥0) [∀ c, BD.suitable (κ c)] [∀ (n : ℕ), fact (monotone (function.swap κ n))]
  (c : ℝ≥0ᵒᵖ) (n : ℕ) : ((T_inv r r' BD M V κ).app c).f n =
  ((CLCFP.T_inv r V r' _ (BD.X n)).app (op M) : _) :=
begin
  dsimp only [T_inv, CLCFP.T_inv, FPsystem, chain_complex.of_X, FPsystem.X,
    homological_complex.comp_f, aux_system, functor.comp_map, homological_complex.unop_functor,
    homological_complex.unop_d, functor.op_obj, functor.map_homological_complex_obj_d,
    functor.map_homological_complex_map_f, functor.map_FreeAb,
    unop_op, CLC, functor.op_map, functor.op_obj, quiver.hom.unop_op,
    FreeAb.eval, free_abelian_group.map_of_apply, FPsystem, FP2.res_app, FreeAb.of_functor,
    functor.right_op_map, whisker_right_app, nat_trans.op_app, whisker_left_app],
  refl,
end

def res [hκ₁ : ∀ n, fact (monotone (function.swap κ₁ n))] [hκ₂ : ∀ n, fact (monotone (function.swap κ₂ n))]
  [∀ c n, fact (κ₁ c n ≤ κ₂ c n)] :
  aux_system r' BD M V κ₂ ⟶ aux_system r' BD M V κ₁ :=
whisker_right (nat_trans.op $ FPsystem.res r' BD M κ₁ κ₂)
  ((((CLC.{v u} V).right_op.map_FreeAb ⋙ FreeAb.eval _).map_homological_complex _).op ⋙
    homological_complex.unop_functor)

lemma res_eq [hκ₁ : ∀ n, fact (monotone (function.swap κ₁ n))] [hκ₂ : ∀ n, fact (monotone (function.swap κ₂ n))]
  [∀ c n, fact (κ₁ c n ≤ r' * κ₂ c n)] [∀ c n, fact (κ₁ c n ≤ κ₂ c n)] (c : ℝ≥0ᵒᵖ) (n : ℕ) :
  ((res r' BD M V κ₁ κ₂).app c).f n =
  ((CLCFP.res V r' _ _ (BD.X n)).app (op M) : _) :=
begin
  dsimp only [res, CLCFP.res, FPsystem.res, FP2.res,
    homological_complex.comp_f, aux_system, functor.comp_map, homological_complex.unop_functor,
    homological_complex.unop_d, functor.op_obj, functor.map_homological_complex_obj_d,
    unop_op, CLC, functor.op_map, quiver.hom.unop_op, functor.map_homological_complex_map_f,
    functor.map_FreeAb, FreeAb.eval, free_abelian_group.map_of_apply,
    FPsystem, FP2.res_app, FreeAb.of_functor, functor.right_op_map,
    whisker_right_app, nat_trans.op_app],
  rw [free_abelian_group.lift.of],
  refl,
end

def Tinv2 [hκ₁ : ∀ n, fact (monotone (function.swap κ₁ n))] [hκ₂ : ∀ n, fact (monotone (function.swap κ₂ n))]
  [∀ c n, fact (κ₁ c n ≤ r' * κ₂ c n)] [∀ c n, fact (κ₁ c n ≤ κ₂ c n)] :
  aux_system r' BD M V κ₂ ⟶ aux_system r' BD M V κ₁ :=
Tinv r' BD M V κ₁ κ₂ - T_inv r r' BD M V κ₂ ≫ res r' BD M V κ₁ κ₂
.

lemma Tinv2_eq [hκ₁ : ∀ n, fact (monotone (function.swap κ₁ n))] [hκ₂ : ∀ n, fact (monotone (function.swap κ₂ n))]
  [∀ c n, fact (κ₁ c n ≤ r' * κ₂ c n)] [∀ c n, fact (κ₁ c n ≤ κ₂ c n)] (c : ℝ≥0ᵒᵖ) (n : ℕ) :
  ((Tinv2 r r' BD M V κ₁ κ₂).app c).f n =
  ((CLCFP.Tinv V r' _ _ (BD.X n)).app (op M) : _) -
  ((CLCFP.T_inv r V r' _ (BD.X n)).app (op M) : _) ≫ ((CLCFP.res V r' _ _ (BD.X n)).app (op M) : _) :=
by rw [Tinv2, nat_trans.app_sub, homological_complex.sub_f_apply, Tinv_eq,
    nat_trans.comp_app, homological_complex.comp_f, T_inv_eq, res_eq]

lemma aux_system_d_eq
  (κ : ℝ≥0 → ℕ → ℝ≥0) [∀ c, BD.suitable (κ c)] [∀ (n : ℕ), fact (monotone (function.swap κ n))]
  (c : ℝ≥0ᵒᵖ) (i : ℕ) :
  arrow.mk (((aux_system r' BD M V κ).obj c).d i (i + 1)) =
  arrow.mk ((universal_map.eval_CLCFP V r' (κ (unop c) i) (κ (unop c) (i + 1)) (BD.d (i + 1) i) : _).app (op M)) :=
begin
  dsimp [aux_system, FPsystem],
  rw [chain_complex.of_d],
  dsimp [FreeAb.eval, functor.map_FreeAb, functor.right_op_map, FPsystem.d,
    universal_map.eval_FP2, universal_map.eval_CLCFP, universal_map.eval_LCFP],
  simp only [nat_trans.app_sum, map_sum, ← normed_group_hom_completion_hom_apply,
    category_theory.unop_sum],
  congr' 1,
  refine finset.sum_congr rfl _,
  rintro ⟨g, hg⟩ -,
  simp only [nat_trans.app_zsmul, map_zsmul, category_theory.unop_zsmul],
  dsimp only [basic_universal_map.eval_FP2, basic_universal_map.eval_LCFP,
    whisker_right_app, nat_trans.op_app, unop_op, FreeAb.of_functor,
    free_abelian_group.map_of_apply],
  rw [free_abelian_group.lift.of],
  refl,
end

section

variables (κ : ℕ → ℝ≥0) [BD.suitable κ]

instance mul_left_mono (n : ℕ) :
  fact (monotone (function.swap (λ (c : ℝ≥0) (n : ℕ), c * κ n) n)) :=
⟨λ c₁ c₂ h, mul_le_mul' h le_rfl⟩

def incl_f (c : ℝ≥0ᵒᵖ) (n : ℕ) :
  ((BD.complex κ r V r' (unop c)).obj (op M)).X n ⟶ ((aux_system r' BD M V (λ c n, c * κ n)).obj c).X n :=
begin
  dsimp [breen_deligne.data.complex, breen_deligne.data.complex₂, breen_deligne.data.complex₂_X,
    CLCTinv, aux_system, FPsystem, FPsystem.X, functor.map_FreeAb, FreeAb.eval],
  exact (SemiNormedGroup.equalizer.ι _ _ : _),
end

lemma incl_comm (c : ℝ≥0ᵒᵖ) (i : ℕ) :
  incl_f.{u v} r r' BD M V κ c i ≫ ((aux_system.{u v} r' BD M V (λ c n, c * κ n)).obj c).d i (i + 1) =
  ((BD.complex κ r V r' (unop c)).obj (op.{u+2} M)).d i (i + 1) ≫ incl_f.{u v} r r' BD M V κ c (i + 1) :=
begin
  dsimp [aux_system],
  erw [chain_complex.of_d, breen_deligne.data.complex_obj_d],
  dsimp [breen_deligne.data.complex, breen_deligne.data.complex₂, breen_deligne.data.complex₂_X,
    CLCTinv, FPsystem, FPsystem.X, functor.map_FreeAb, FreeAb.eval,
    universal_map.eval_CLCFPTinv, universal_map.eval_CLCFPTinv₂,
    SemiNormedGroup.equalizer.map_nat, incl_f],
  delta id, dsimp only [], symmetry,
  convert SemiNormedGroup.equalizer.map_comp_ι _ _ _ _ using 2,
  apply arrow.mk_injective,
  rw ← aux_system_d_eq r' BD M V (λ c n, c * κ n),
  dsimp [aux_system],
  erw [chain_complex.of_d],
  refl,
end

def incl : (BD.system κ r V r').obj (op M) ⟶ aux_system r' BD M V (λ c n, c * κ n) :=
{ app := λ c,
  { f := incl_f r r' BD M V κ c,
    comm' := by { rintro i j (rfl : i + 1 = j), apply incl_comm } },
  naturality' := λ c₁ c₂ h, begin
    ext n : 2,
    dsimp [aux_system],
    dsimp [breen_deligne.data.complex, breen_deligne.data.complex₂, breen_deligne.data.complex₂_X,
      CLCTinv, FPsystem, FPsystem.X, functor.map_FreeAb, FreeAb.eval, FreeAb.of_functor,
      universal_map.eval_CLCFPTinv, universal_map.eval_CLCFPTinv₂,
      SemiNormedGroup.equalizer.map_nat, incl_f, CLCFPTinv₂.res, CLCTinv.map_nat, CLCTinv.map],
    delta id,
    erw [free_abelian_group.lift.of],
    convert SemiNormedGroup.equalizer.map_comp_ι _ _ _ _ using 1,
  end }

def incl' := whisker_right (incl r r' BD M V κ) (functor.map_homological_complex (forget₂ _ Ab.{max u v}) _)

end

def Tinv2' [hκ₁ : ∀ n, fact (monotone (function.swap κ₁ n))] [hκ₂ : ∀ n, fact (monotone (function.swap κ₂ n))]
  [∀ c n, fact (κ₁ c n ≤ r' * κ₂ c n)] [∀ c n, fact (κ₁ c n ≤ κ₂ c n)] :=
whisker_right (Tinv2 r r' BD M V κ₁ κ₂)
(functor.map_homological_complex (forget₂ _ Ab.{max u v}) _)

lemma _root_.SemiNormedGroup.equalizer.ι_injective {V W : SemiNormedGroup} (f g : V ⟶ W) :
  function.injective (SemiNormedGroup.equalizer.ι f g) :=
subtype.val_injective

lemma _root_.SemiNormedGroup.equalizer.forget₂_ι {V W : SemiNormedGroup} (f g : V ⟶ W) :
  (forget₂ _ Ab).map (SemiNormedGroup.equalizer.ι f g) =
  add_subgroup.subtype (add_monoid_hom.ker ((forget₂ _ Ab).map (f - g))) :=
rfl

instance mul_left_mono' (κ : ℕ → ℝ≥0) (n : ℕ) :
  fact (monotone (function.swap (λ (c : ℝ≥0) (n : ℕ), r' * (c * κ n)) n)) :=
⟨λ c₁ c₂ h, mul_le_mul' le_rfl $ mul_le_mul' h le_rfl⟩

lemma neg_surjective {A B : Ab} (f : A ⟶ B) (hf : function.surjective f) :
  function.surjective (-f) :=
begin
  intro y, obtain ⟨x, rfl⟩ := hf y, use -x, simp only [pi.neg_apply, map_neg, neg_neg],
end

lemma short_exact [fact (r < 1)] (κ : ℕ → ℝ≥0) [BD.suitable κ]
  [∀ c n, fact (κ₁ c n ≤ r' * (c * κ n))] (c : ℝ≥0ᵒᵖ) (n : ℕ) :
  short_exact (((incl' r r' BD M V κ).app c).f n)
    (((Tinv2' r r' BD M V (λ c n, r' * (c * κ n)) (λ c n, c * κ n)).app c).f n) :=
begin
  apply_with @short_exact.mk {instances := ff},
  { rw AddCommGroup.mono_iff_injective,
    dsimp [incl', incl, incl_f,
      breen_deligne.data.complex, breen_deligne.data.complex₂, breen_deligne.data.complex₂_X],
    exact SemiNormedGroup.equalizer.ι_injective _ _, },
  { rw [Tinv2', whisker_right_app, functor.map_homological_complex_map_f, Tinv2_eq,
      ← nat_trans.comp_app, ← CLCFP.res_comp_T_inv, nat_trans.comp_app,
      ← neg_sub, functor.map_neg, functor.map_sub, category_theory.functor.map_comp,
      AddCommGroup.epi_iff_surjective],
    apply neg_surjective,
    have := CLCFP.T_inv_sub_Tinv_surjective r r' V (unop c * κ n) (BD.X n) (op M),
    rw [CLCFP.T_inv_sub_Tinv, nat_trans.app_sub, nat_trans.comp_app] at this,
    exact this, },
  { rw AddCommGroup.exact_iff,
    dsimp [incl', incl, incl_f, Tinv2',
      breen_deligne.data.complex, breen_deligne.data.complex₂, breen_deligne.data.complex₂_X],
    rw [SemiNormedGroup.equalizer.forget₂_ι, add_subgroup.subtype_range, Tinv2_eq,
      ← nat_trans.comp_app, ← CLCFP.res_comp_T_inv],
    refl, }
end

end aux_system


/-
Copyright (c) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot, Scott Morrison, Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.concrete_category.unbundled_hom
import Mathlib.topology.continuous_map
import Mathlib.topology.opens
import Mathlib.PostPort

universes u u_1

namespace Mathlib

/-- The category of topological spaces and continuous maps. -/
def Top :=
  category_theory.bundled topological_space

namespace Top

protected instance bundled_hom : category_theory.bundled_hom continuous_map :=
  category_theory.bundled_hom.mk continuous_map.to_fun continuous_map.id continuous_map.comp

protected instance has_coe_to_sort : has_coe_to_sort Top :=
  category_theory.bundled.has_coe_to_sort

protected instance topological_space_unbundled (x : Top) : topological_space ↥x :=
  category_theory.bundled.str x

@[simp] theorem id_app (X : Top) (x : ↥X) : coe_fn 𝟙 x = x :=
  rfl

@[simp] theorem comp_app {X : Top} {Y : Top} {Z : Top} (f : X ⟶ Y) (g : Y ⟶ Z) (x : ↥X) : coe_fn (f ≫ g) x = coe_fn g (coe_fn f x) :=
  rfl

/-- Construct a bundled `Top` from the underlying type and the typeclass. -/
def of (X : Type u) [topological_space X] : Top :=
  category_theory.bundled.mk X

protected instance topological_space (X : Top) : topological_space ↥X :=
  category_theory.bundled.str X

@[simp] theorem coe_of (X : Type u) [topological_space X] : ↥(of X) = X :=
  rfl

protected instance inhabited : Inhabited Top :=
  { default := of empty }

/-- The discrete topology on any type. -/
def discrete : Type u ⥤ Top :=
  category_theory.functor.mk (fun (X : Type u) => category_theory.bundled.mk X)
    fun (X Y : Type u) (f : X ⟶ Y) => continuous_map.mk f

/-- The trivial topology on any type. -/
def trivial : Type u ⥤ Top :=
  category_theory.functor.mk (fun (X : Type u) => category_theory.bundled.mk X)
    fun (X Y : Type u) (f : X ⟶ Y) => continuous_map.mk f