import ml

universes u v

namespace goedelgod
open ml kripke_frame
variables {F : kripke_frame.{u}} [S5 F]

constants {α : Type v} (positive : (α → F.prop) → F.prop)
variables (φ ψ : α → F.prop)

axiom axiom1 : ⊧ positive (λ x, ¬ₘφ x) ⟷ ¬ₘpositive φ
-- 任意の性質は肯定的(positive)か肯定的でないかのいずれかである

axiom axiom2 (φ ψ : α → F.prop) : ⊧ positive φ ⟶ (□ ∀ₘ x, φ x ⟶ ψ x) ⟶ positive ψ
-- φが肯定的なとき、必然的にφから導かれる性質は肯定的性質である

lemma false_negative : ⊧ ¬ₘpositive (λ x : α, (⊥ₘ : F.prop)) := λ w,
begin
  have : positive (λ x : α, ⊥ₘ) w ∨ (¬ₘpositive (λ x : α, ⊥ₘ)) w, from em w,
  rcases this,
  { exfalso,
    have h₁ : ¬positive (λ x : α, ⊤ₘ) w,
    from ((axiom1 (λ x : α, (⊤ₘ : F.prop))) w).1 (by simpa[mnot, mverum] using this ),
    have h₂ : positive (λ x : α, ⊤ₘ) w,
    from axiom2 (λ x : α, (⊥ₘ : F.prop)) (λ x, ⊤ₘ) w this (λ v hv x, by simp[mverum, (⟶)]),
    exact h₁ h₂ },
  { exact this }
end

theorem theorem1 : ⊧ positive φ ⟶ ◇∃ₘ x, φ x := λ w h,
begin
  have : (¬ₘpositive (λ x : α, ⊥ₘ) ⟶ ¬ₘ(□∀ₘ x, φ x ⟶ ⊥ₘ)) w,
    from mt (axiom2 φ (λ x : α, (⊥ₘ : F.prop)) w h),
  have : (◇∃ₘ x, ¬ₘ(φ x ⟶ ⊥ₘ)) w,
    by simpa[mnot_mbox_eq, mnot_mforall_eq] using (this $ false_negative w),
  simpa[mnot, mimplies, mfalsum] using this,
end
-- 肯定的な性質は満たされうる

def godlike : α → F.prop := λ x, ∀ₘ φ, positive φ ⟶ φ x
-- 神的(God-Like)であるとはあらゆる肯定的な性質を持つことである

axiom axiom3 : ⊧ positive (godlike : α → F.prop)
-- 神的な性質は肯定的である

theorem theorem2 : ⊧ (◇∃ₘ x : α, godlike x : F.prop) :=
λ w, theorem1 godlike w (axiom3 w)
-- 神的なものは存在しうる

def essence (φ : α → F.prop) (x : α) : F.prop := φ x ∧ₘ ∀ₘ (ψ : α → F.prop), ψ x ⟶ □∀ₘ y, φ y ⟶ ψ y
infix ` ess `:80 := essence
-- xがφを満たし、xについて成り立つあらゆる性質がφから必然的に導かれるものに限るとき、xはφの本質(essence)であるという

axiom axiom4 : ⊧ positive φ ⟶ □positive φ
-- 肯定的な性質は必然的に肯定的である

theorem theorem3 : ⊧ ∀ₘ x : α, (godlike x : F.prop) ⟶ godlike ess x :=
λ w x hg,
begin
  refine ⟨hg, λ ψ hψ v hv y hy, _⟩,
  have : positive ψ w,
  { by_contradiction A,
    have : (positive (λ x, ¬ₘψ x)) w, from (axiom1 ψ w).mpr A,
    have : ¬ψ x w, from hg (λ x, ¬ₘψ x) this,
    contradiction },
  have : positive /watch/so40834219ψ v, from axiom4 ψ w this v hv,
  exact hy ψ this
end
-- 神的なものは神性の本質である

def necessary_existence (x : α) : F.prop := ∀ₘ φ, φ ess x ⟶ □∃ₘ y, φ y
-- xが本質であるあらゆる性質が、それを満たすものが必然的に存在する時、xは必然的存在(Necessary existence)である

axiom axiom5 : ⊧ positive (necessary_existence : α → F.prop)
-- 本質的存在性は肯定的である

theorem theorem4 : ⊧ □∃ₘ x : α, (godlike x : F.prop) :=
begin
  have : ⊧ ◇□∃ₘ x : α, (godlike x : F.prop),
  { intros w,
    have : (◇∃ₘ x, godlike x) w, from (theorem2 : ⊧ ◇∃ₘ x : α, (godlike x : F.prop)) w,
    rcases this with ⟨v, hv, x, gv⟩,
    have nv : necessary_existence x v, from gv (necessary_existence : α → F.prop) (axiom5 v),
    have : (□∃ₘ y, godlike y) v, from nv godlike (theorem3 v x gv),
    refine ⟨v, hv, this⟩ },
  exact λ w, dia_box_implies_box w (this w)
end
-- 神的なものは必然的に存在する

theorem modal_collapse {φ : F.prop} : ⊧ φ ⟷ □φ := λ w,
⟨λ hw v rv,
  begin
    have : (□∀ₘ y : α, godlike y ⟶ φ) w,
    { have : ∃ x : α, godlike x w, from theorem4 w w (T.reflexivity w),
      rcases this with ⟨x, gw⟩,
      have : (φ ⟶ □∀ₘ (y : α), godlike y ⟶ φ) w,
        from (theorem3 w x gw).2 (λ _, φ),
      exact this hw },
    have : ∃ x : α, godlike x v, from theorem4 w v rv,
    rcases this with ⟨x, gx⟩,
    refine this v rv x gx
  end, box_implies w⟩
-- そんな...

end goedelgod


import elliptic_curve_rationals
import group_theory.subgroup
import group_theory.finiteness
import group_theory.quotient_group
import data.fintype.card
import data.set.finite
import init.data.nat.lemmas
import data.nat.prime
import data.zmod.basic
import data.complex.basic
import analysis.special_functions.pow
import order.filter.at_top_bot
import analysis.analytic.basic
import analysis.calculus.iterated_deriv
import tprod
import algebra.module.basic
import ring_theory.noetherian

namespace elliptic_curve
variable (E : elliptic_curve)

instance module : module ℤ (points E) := begin
  apply add_comm_group.int_module,
end

theorem points_is_noetherian : is_noetherian ℤ (points E) := begin
  apply is_noetherian_of_fg_of_noetherian',

  sorry,
end

def torsion_submodule (E : elliptic_curve) : submodule ℤ (points E) :=
{ carrier := (torsion_points E),
  zero_mem' := begin
    sorry
  end,
  add_mem' := begin
    sorry
  end,
  smul_mem' := begin
    sorry,
  end
}

def torsion_free_module (E : elliptic_curve) :=
  (submodule.quotient (torsion_submodule E))

instance: module ℤ (torsion_free E) := begin
  apply_instance,
end

theorem is_noetherian_torsion_free : is_noetherian ℤ (torsion_submodule E).quotient := begin
  apply is_noetherian_of_quotient_of_noetherian ℤ (points E) (torsion_submodule E),
  apply points_is_noetherian,
end

theorem is_fg_torsion_free : submodule.fg (⊤ :submodule  ℤ (torsion_free E)) := begin
sorry,
end
end elliptic_curve


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin

! This file was ported from Lean 3 source module ring_theory.witt_vector.frobenius
! leanprover-community/mathlib commit 2196ab363eb097c008d4497125e0dde23fb36db2
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Nat.Multiplicity
import Mathbin.Data.Zmod.Algebra
import Mathbin.RingTheory.WittVector.Basic
import Mathbin.RingTheory.WittVector.IsPoly
import Mathbin.FieldTheory.PerfectClosure

/-!
## The Frobenius operator

If `R` has characteristic `p`, then there is a ring endomorphism `frobenius R p`
that raises `r : R` to the power `p`.
By applying `witt_vector.map` to `frobenius R p`, we obtain a ring endomorphism `𝕎 R →+* 𝕎 R`.
It turns out that this endomorphism can be described by polynomials over `ℤ`
that do not depend on `R` or the fact that it has characteristic `p`.
In this way, we obtain a Frobenius endomorphism `witt_vector.frobenius_fun : 𝕎 R → 𝕎 R`
for every commutative ring `R`.

Unfortunately, the aforementioned polynomials can not be obtained using the machinery
of `witt_structure_int` that was developed in `structure_polynomial.lean`.
We therefore have to define the polynomials by hand, and check that they have the required property.

In case `R` has characteristic `p`, we show in `frobenius_fun_eq_map_frobenius`
that `witt_vector.frobenius_fun` is equal to `witt_vector.map (frobenius R p)`.

### Main definitions and results

* `frobenius_poly`: the polynomials that describe the coefficients of `frobenius_fun`;
* `frobenius_fun`: the Frobenius endomorphism on Witt vectors;
* `frobenius_fun_is_poly`: the tautological assertion that Frobenius is a polynomial function;
* `frobenius_fun_eq_map_frobenius`: the fact that in characteristic `p`, Frobenius is equal to
  `witt_vector.map (frobenius R p)`.

TODO: Show that `witt_vector.frobenius_fun` is a ring homomorphism,
and bundle it into `witt_vector.frobenius`.

## References

* [Hazewinkel, *Witt Vectors*][Haze09]

* [Commelin and Lewis, *Formalizing the Ring of Witt Vectors*][CL21]
-/

namespace WittVector

variable {p : ℕ} {R S : Type _} [hp : Fact p.Prime] [CommRing R] [CommRing S]

-- mathport name: expr𝕎
local notation "𝕎" => WittVector p

-- type as `\bbW`
noncomputable section

open MvPolynomial Finset

open BigOperators

variable (p)

include hp

/-- The rational polynomials that give the coefficients of `frobenius x`,
in terms of the coefficients of `x`.
These polynomials actually have integral coefficients,
see `frobenius_poly` and `map_frobenius_poly`. -/
def frobeniusPolyRat (n : ℕ) : MvPolynomial ℕ ℚ :=
  bind₁ (wittPolynomial p ℚ ∘ fun n => n + 1) (xInTermsOfW p ℚ n)
#align witt_vector.frobenius_poly_rat WittVector.frobeniusPolyRat

theorem bind₁_frobeniusPolyRat_wittPolynomial (n : ℕ) :
    bind₁ (frobeniusPolyRat p) (wittPolynomial p ℚ n) = wittPolynomial p ℚ (n + 1) :=
  by
  delta frobenius_poly_rat
  rw [← bind₁_bind₁, bind₁_xInTermsOfW_wittPolynomial, bind₁_X_right]
#align witt_vector.bind₁_frobenius_poly_rat_witt_polynomial WittVector.bind₁_frobeniusPolyRat_wittPolynomial

/-- An auxiliary definition, to avoid an excessive amount of finiteness proofs
for `multiplicity p n`. -/
private def pnat_multiplicity (n : ℕ+) : ℕ :=
  (multiplicity p n).get <| multiplicity.finite_nat_iff.mpr <| ⟨ne_of_gt hp.1.one_lt, n.2⟩
#align witt_vector.pnat_multiplicity witt_vector.pnat_multiplicity

-- mathport name: exprv
local notation "v" => pnatMultiplicity

/-- An auxiliary polynomial over the integers, that satisfies
`p * (frobenius_poly_aux p n) + X n ^ p = frobenius_poly p n`.
This makes it easy to show that `frobenius_poly p n` is congruent to `X n ^ p`
modulo `p`. -/
noncomputable def frobeniusPolyAux : ℕ → MvPolynomial ℕ ℤ
  | n =>
    X (n + 1) -
      ∑ i : Fin n,
        have := i.is_lt
        ∑ j in range (p ^ (n - i)),
          (X i ^ p) ^ (p ^ (n - i) - (j + 1)) * frobenius_poly_aux i ^ (j + 1) *
            C
              ↑((p ^ (n - i)).choose (j + 1) / p ^ (n - i - v p ⟨j + 1, Nat.succ_pos j⟩) *
                    ↑p ^ (j - v p ⟨j + 1, Nat.succ_pos j⟩) :
                  ℕ)
#align witt_vector.frobenius_poly_aux WittVector.frobeniusPolyAux

theorem frobeniusPolyAux_eq (n : ℕ) :
    frobeniusPolyAux p n =
      X (n + 1) -
        ∑ i in range n,
          ∑ j in range (p ^ (n - i)),
            (X i ^ p) ^ (p ^ (n - i) - (j + 1)) * frobeniusPolyAux p i ^ (j + 1) *
              C
                ↑((p ^ (n - i)).choose (j + 1) / p ^ (n - i - v p ⟨j + 1, Nat.succ_pos j⟩) *
                      ↑p ^ (j - v p ⟨j + 1, Nat.succ_pos j⟩) :
                    ℕ) :=
  by rw [frobenius_poly_aux, ← Fin.sum_univ_eq_sum_range]
#align witt_vector.frobenius_poly_aux_eq WittVector.frobeniusPolyAux_eq

/-- The polynomials that give the coefficients of `frobenius x`,
in terms of the coefficients of `x`. -/
def frobeniusPoly (n : ℕ) : MvPolynomial ℕ ℤ :=
  X n ^ p + C ↑p * frobeniusPolyAux p n
#align witt_vector.frobenius_poly WittVector.frobeniusPoly

/-
Our next goal is to prove
```
lemma map_frobenius_poly (n : ℕ) :
  mv_polynomial.map (int.cast_ring_hom ℚ) (frobenius_poly p n) = frobenius_poly_rat p n
```
This lemma has a rather long proof, but it mostly boils down to applying induction,
and then using the following two key facts at the right point.
-/
/-- A key divisibility fact for the proof of `witt_vector.map_frobenius_poly`. -/
theorem MapFrobeniusPoly.key₁ (n j : ℕ) (hj : j < p ^ n) :
    p ^ (n - v p ⟨j + 1, j.succ_pos⟩) ∣ (p ^ n).choose (j + 1) :=
  by
  apply multiplicity.pow_dvd_of_le_multiplicity
  rw [hp.out.multiplicity_choose_prime_pow hj j.succ_ne_zero]
  rfl
#align witt_vector.map_frobenius_poly.key₁ WittVector.MapFrobeniusPoly.key₁

/-- A key numerical identity needed for the proof of `witt_vector.map_frobenius_poly`. -/
theorem MapFrobeniusPoly.key₂ {n i j : ℕ} (hi : i ≤ n) (hj : j < p ^ (n - i)) :
    j - v p ⟨j + 1, j.succ_pos⟩ + n = i + j + (n - i - v p ⟨j + 1, j.succ_pos⟩) :=
  by
  generalize h : v p ⟨j + 1, j.succ_pos⟩ = m
  rsuffices ⟨h₁, h₂⟩ : m ≤ n - i ∧ m ≤ j
  ·
    rw [tsub_add_eq_add_tsub h₂, add_comm i j, add_tsub_assoc_of_le (h₁.trans (Nat.sub_le n i)),
      add_assoc, tsub_right_comm, add_comm i,
      tsub_add_cancel_of_le (le_tsub_of_add_le_right ((le_tsub_iff_left hi).mp h₁))]
  have hle : p ^ m ≤ j + 1 := h ▸ Nat.le_of_dvd j.succ_pos (multiplicity.pow_multiplicity_dvd _)
  exact
    ⟨(pow_le_pow_iff hp.1.one_lt).1 (hle.trans hj),
      Nat.le_of_lt_succ ((Nat.lt_pow_self hp.1.one_lt m).trans_le hle)⟩
#align witt_vector.map_frobenius_poly.key₂ WittVector.MapFrobeniusPoly.key₂

theorem map_frobeniusPoly (n : ℕ) :
    MvPolynomial.map (Int.castRingHom ℚ) (frobeniusPoly p n) = frobeniusPolyRat p n :=
  by
  rw [frobenius_poly, RingHom.map_add, RingHom.map_mul, RingHom.map_pow, map_C, map_X, eq_intCast,
    Int.cast_ofNat, frobenius_poly_rat]
  apply Nat.strong_induction_on n
  clear n
  intro n IH
  rw [xInTermsOfW_eq]
  simp only [AlgHom.map_sum, AlgHom.map_sub, AlgHom.map_mul, AlgHom.map_pow, bind₁_C_right]
  have h1 : ↑p ^ n * ⅟ (↑p : ℚ) ^ n = 1 := by rw [← mul_pow, mul_invOf_self, one_pow]
  rw [bind₁_X_right, Function.comp_apply, wittPolynomial_eq_sum_c_mul_x_pow, sum_range_succ,
    sum_range_succ, tsub_self, add_tsub_cancel_left, pow_zero, pow_one, pow_one, sub_mul, add_mul,
    add_mul, mul_right_comm, mul_right_comm (C (↑p ^ (n + 1))), ← C_mul, ← C_mul, pow_succ,
    mul_assoc (↑p) (↑p ^ n), h1, mul_one, C_1, one_mul, add_comm _ (X n ^ p), add_assoc, ← add_sub,
    add_right_inj, frobenius_poly_aux_eq, RingHom.map_sub, map_X, mul_sub, sub_eq_add_neg,
    add_comm _ (C ↑p * X (n + 1)), ← add_sub, add_right_inj, neg_eq_iff_eq_neg, neg_sub, eq_comm]
  simp only [RingHom.map_sum, mul_sum, sum_mul, ← sum_sub_distrib]
  apply sum_congr rfl
  intro i hi
  rw [mem_range] at hi
  rw [← IH i hi]
  clear IH
  rw [add_comm (X i ^ p), add_pow, sum_range_succ', pow_zero, tsub_zero, Nat.choose_zero_right,
    one_mul, Nat.cast_one, mul_one, mul_add, add_mul, Nat.succ_sub (le_of_lt hi),
    Nat.succ_eq_add_one (n - i), pow_succ, pow_mul, add_sub_cancel, mul_sum, sum_mul]
  apply sum_congr rfl
  intro j hj
  rw [mem_range] at hj
  rw [RingHom.map_mul, RingHom.map_mul, RingHom.map_pow, RingHom.map_pow, RingHom.map_pow,
    RingHom.map_pow, RingHom.map_pow, map_C, map_X, mul_pow]
  rw [mul_comm (C ↑p ^ i), mul_comm _ ((X i ^ p) ^ _), mul_comm (C ↑p ^ (j + 1)), mul_comm (C ↑p)]
  simp only [mul_assoc]
  apply congr_arg
  apply congr_arg
  rw [← C_eq_coe_nat]
  simp only [← RingHom.map_pow, ← C_mul]
  rw [C_inj]
  simp only [invOf_eq_inv, eq_intCast, inv_pow, Int.cast_ofNat, Nat.cast_mul, Int.cast_mul]
  rw [Rat.coe_nat_div _ _ (map_frobenius_poly.key₁ p (n - i) j hj)]
  simp only [Nat.cast_pow, pow_add, pow_one]
  suffices
    ((p ^ (n - i)).choose (j + 1) * p ^ (j - v p ⟨j + 1, j.succ_pos⟩) * p * p ^ n : ℚ) =
      p ^ j * p * ((p ^ (n - i)).choose (j + 1) * p ^ i) * p ^ (n - i - v p ⟨j + 1, j.succ_pos⟩)
    by
    have aux : ∀ k : ℕ, (p ^ k : ℚ) ≠ 0 := by
      intro
      apply pow_ne_zero
      exact_mod_cast hp.1.NeZero
    simpa [aux, -one_div, field_simps] using this.symm
  rw [mul_comm _ (p : ℚ), mul_assoc, mul_assoc, ← pow_add, map_frobenius_poly.key₂ p hi.le hj]
  ring
#align witt_vector.map_frobenius_poly WittVector.map_frobeniusPoly

theorem frobeniusPoly_zMod (n : ℕ) :
    MvPolynomial.map (Int.castRingHom (ZMod p)) (frobeniusPoly p n) = X n ^ p :=
  by
  rw [frobenius_poly, RingHom.map_add, RingHom.map_pow, RingHom.map_mul, map_X, map_C]
  simp only [Int.cast_ofNat, add_zero, eq_intCast, ZMod.nat_cast_self, MulZeroClass.zero_mul, C_0]
#align witt_vector.frobenius_poly_zmod WittVector.frobeniusPoly_zMod

@[simp]
theorem bind₁_frobeniusPoly_wittPolynomial (n : ℕ) :
    bind₁ (frobeniusPoly p) (wittPolynomial p ℤ n) = wittPolynomial p ℤ (n + 1) :=
  by
  apply MvPolynomial.map_injective (Int.castRingHom ℚ) Int.cast_injective
  simp only [map_bind₁, map_frobenius_poly, bind₁_frobenius_poly_rat_witt_polynomial,
    map_wittPolynomial]
#align witt_vector.bind₁_frobenius_poly_witt_polynomial WittVector.bind₁_frobeniusPoly_wittPolynomial

variable {p}

/-- `frobenius_fun` is the function underlying the ring endomorphism
`frobenius : 𝕎 R →+* frobenius 𝕎 R`. -/
def frobeniusFun (x : 𝕎 R) : 𝕎 R :=
  mk p fun n => MvPolynomial.aeval x.coeff (frobeniusPoly p n)
#align witt_vector.frobenius_fun WittVector.frobeniusFun

theorem coeff_frobeniusFun (x : 𝕎 R) (n : ℕ) :
    coeff (frobeniusFun x) n = MvPolynomial.aeval x.coeff (frobeniusPoly p n) := by
  rw [frobenius_fun, coeff_mk]
#align witt_vector.coeff_frobenius_fun WittVector.coeff_frobeniusFun

variable (p)

/-- `frobenius_fun` is tautologically a polynomial function.

See also `frobenius_is_poly`. -/
@[is_poly]
theorem frobeniusFunIsPoly : IsPoly p fun R _Rcr => @frobeniusFun p R _ _Rcr :=
  ⟨⟨frobeniusPoly p, by
      intros
      funext n
      apply coeff_frobenius_fun⟩⟩
#align witt_vector.frobenius_fun_is_poly WittVector.frobeniusFunIsPoly

variable {p}

@[ghost_simps]
theorem ghostComponent_frobeniusFun (n : ℕ) (x : 𝕎 R) :
    ghostComponent n (frobeniusFun x) = ghostComponent (n + 1) x := by
  simp only [ghost_component_apply, frobenius_fun, coeff_mk, ← bind₁_frobenius_poly_witt_polynomial,
    aeval_bind₁]
#align witt_vector.ghost_component_frobenius_fun WittVector.ghostComponent_frobeniusFun

/-- If `R` has characteristic `p`, then there is a ring endomorphism
that raises `r : R` to the power `p`.
By applying `witt_vector.map` to this endomorphism,
we obtain a ring endomorphism `frobenius R p : 𝕎 R →+* 𝕎 R`.

The underlying function of this morphism is `witt_vector.frobenius_fun`.
-/
def frobenius : 𝕎 R →+* 𝕎 R where
  toFun := frobeniusFun
  map_zero' :=
    by
    refine'
      is_poly.ext ((frobenius_fun_is_poly p).comp WittVector.zeroIsPoly)
        (WittVector.zeroIsPoly.comp (frobenius_fun_is_poly p)) _ _ 0
    ghost_simp
  map_one' :=
    by
    refine'
      is_poly.ext ((frobenius_fun_is_poly p).comp WittVector.oneIsPoly)
        (WittVector.oneIsPoly.comp (frobenius_fun_is_poly p)) _ _ 0
    ghost_simp
  map_add' := by ghost_calc _ _ <;> ghost_simp
  map_mul' := by ghost_calc _ _ <;> ghost_simp
#align witt_vector.frobenius WittVector.frobenius

theorem coeff_frobenius (x : 𝕎 R) (n : ℕ) :
    coeff (frobenius x) n = MvPolynomial.aeval x.coeff (frobeniusPoly p n) :=
  coeff_frobeniusFun _ _
#align witt_vector.coeff_frobenius WittVector.coeff_frobenius

@[ghost_simps]
theorem ghostComponent_frobenius (n : ℕ) (x : 𝕎 R) :
    ghostComponent n (frobenius x) = ghostComponent (n + 1) x :=
  ghostComponent_frobeniusFun _ _
#align witt_vector.ghost_component_frobenius WittVector.ghostComponent_frobenius

variable (p)

/-- `frobenius` is tautologically a polynomial function. -/
@[is_poly]
theorem frobeniusIsPoly : IsPoly p fun R _Rcr => @frobenius p R _ _Rcr :=
  frobeniusFunIsPoly _
#align witt_vector.frobenius_is_poly WittVector.frobeniusIsPoly

section CharP

variable [CharP R p]

@[simp]
theorem coeff_frobenius_charP (x : 𝕎 R) (n : ℕ) : coeff (frobenius x) n = x.coeff n ^ p :=
  by
  rw [coeff_frobenius]
  -- outline of the calculation, proofs follow below
  calc
    aeval (fun k => x.coeff k) (frobenius_poly p n) =
        aeval (fun k => x.coeff k)
          (MvPolynomial.map (Int.castRingHom (ZMod p)) (frobenius_poly p n)) :=
      _
    _ = aeval (fun k => x.coeff k) (X n ^ p : MvPolynomial ℕ (ZMod p)) := _
    _ = x.coeff n ^ p := _

  · conv_rhs => rw [aeval_eq_eval₂_hom, eval₂_hom_map_hom]
    apply eval₂_hom_congr (RingHom.ext_int _ _) rfl rfl
  · rw [frobenius_poly_zmod]
  · rw [AlgHom.map_pow, aeval_X]
#align witt_vector.coeff_frobenius_char_p WittVector.coeff_frobenius_charP

theorem frobenius_eq_map_frobenius : @frobenius p R _ _ = map (frobenius R p) :=
  by
  ext (x n)
  simp only [coeff_frobenius_char_p, map_coeff, frobenius_def]
#align witt_vector.frobenius_eq_map_frobenius WittVector.frobenius_eq_map_frobenius

@[simp]
theorem frobenius_zmodp (x : 𝕎 (ZMod p)) : frobenius x = x := by
  simp only [ext_iff, coeff_frobenius_char_p, ZMod.pow_card, eq_self_iff_true, forall_const]
#align witt_vector.frobenius_zmodp WittVector.frobenius_zmodp

variable (p R)

/-- `witt_vector.frobenius` as an equiv. -/
@[simps (config := { fullyApplied := false })]
def frobeniusEquiv [PerfectRing R p] : WittVector p R ≃+* WittVector p R :=
  {
    (WittVector.frobenius :
      WittVector p R →+* WittVector p
          R) with
    toFun := WittVector.frobenius
    invFun := map (pthRoot R p)
    left_inv := fun f =>
      ext fun n => by
        rw [frobenius_eq_map_frobenius]
        exact pthRoot_frobenius _
    right_inv := fun f =>
      ext fun n => by
        rw [frobenius_eq_map_frobenius]
        exact frobenius_pthRoot _ }
#align witt_vector.frobenius_equiv WittVector.frobeniusEquiv

theorem frobenius_bijective [PerfectRing R p] :
    Function.Bijective (@WittVector.frobenius p R _ _) :=
  (frobeniusEquiv p R).Bijective
#align witt_vector.frobenius_bijective WittVector.frobenius_bijective

end CharP

end WittVector


--- Will clean up these imports
import tactic
import analysis.calculus.iterated_deriv
import topology.continuous_function.polynomial
import topology.separation
import topology.path_connected
import analysis.complex.basic
import analysis.calculus.tangent_cone
import analysis.normed_space.units
import analysis.asymptotics.asymptotic_equivalent
import analysis.analytic.basic
import geometry.manifold.algebra.smooth_functions
import geometry.manifold.local_invariant_properties
import linear_algebra.finite_dimensional
import analysis.normed_space.inner_product
import topology.metric_space.basic
import analysis.calculus.formal_multilinear_series
import group_theory.coset
import complex_analysis_prep

open set complex classical filter asymptotics continuous_linear_map set metric is_open differentiable
open_locale topological_space classical nnreal asymptotics filter ennreal unit_interval

noncomputable theory

def holomorph_pregroupoid : pregroupoid ℂ :=
{ property := λ f s, differentiable_on ℂ f s,
  comp := λ f g u v hf hg hu hv huv z hz,
  begin
    rw _root_.differentiable_on at hf hg,
    apply differentiable_within_at.comp',
    { have : f z ∈ v := mem_preimage.mp (mem_of_mem_inter_right hz), exact hg (f z) this, },
    { exact hf z (set.mem_of_mem_inter_left hz), },
  end,
  id_mem := differentiable_on_id,
  locality := λ f u hu hx, differentiable_on_of_locally_differentiable_on hx,
  congr := λ f g u hu hx hf, (differentiable_on_congr hx).mpr hf, }

def biholomorph_groupoid : structure_groupoid ℂ :=
holomorph_pregroupoid.groupoid

lemma of_set_mem_biholomorph_groupoid {s : set ℂ} (h : is_open s) :
  local_homeomorph.of_set s h ∈ biholomorph_groupoid :=
begin
  rw [biholomorph_groupoid, mem_groupoid_of_pregroupoid],
  simp,
  exact differentiable_on_id,
end

instance : closed_under_restriction biholomorph_groupoid :=
(closed_under_restriction_iff_id_le _).mpr
begin
  apply structure_groupoid.le_iff.mpr,
  rintros e ⟨s, hs, h⟩,
  apply biholomorph_groupoid.eq_on_source' _ _ _ h,
  exact of_set_mem_biholomorph_groupoid hs,
end

class riemann_surface
  (X : Type*) [topological_space X] [t2_space X]
  [connected_space X] [charted_space ℂ X]
extends has_groupoid X biholomorph_groupoid : Prop

lemma riemann_surface.mk'
  (X : Type*) [topological_space X] [t2_space X]
  [connected_space X] [charted_space ℂ X]
  [cstructure : has_groupoid X biholomorph_groupoid] : riemann_surface X :=
{ .. cstructure }

lemma riemann_surface_of_cstructure
  (X : Type*) [topological_space X] [t2_space X]
  [connected_space X] [charted_space ℂ X]
  (h : ∀ (e e' : local_homeomorph X ℂ), e ∈ atlas ℂ X → e' ∈ atlas ℂ X →
  (differentiable_on ℂ ⇑(e.symm.trans e') (e.symm.trans e').to_local_equiv.source)) :
  riemann_surface X :=
{ compatible :=
  begin
    haveI : has_groupoid X biholomorph_groupoid := has_groupoid_of_pregroupoid _ h,
    apply structure_groupoid.compatible,
  end }

instance biholomorph_groupoid_of_ℂ : has_groupoid ℂ biholomorph_groupoid :=
{ compatible := λ e e' he he', begin
    rw charted_space_self_atlas at he he',
    simp [he, he', biholomorph_groupoid.id_mem],
  end }

instance : riemann_surface ℂ :=
{ .. biholomorph_groupoid_of_ℂ }

def complex_plane : model_with_corners ℂ ℂ ℂ := by apply model_with_corners_self

example (f : ℂ → ℂ) (s : set ℂ) (h : is_open s) :
  holomorph_pregroupoid.property f s → differentiable_on ℂ f s :=
begin
  intros h,
  exact h,
end

lemma biholomorph_groupoid_eq :
  biholomorph_groupoid = times_cont_diff_groupoid ⊤ complex_plane :=
begin
  apply le_antisymm,
  { rw structure_groupoid.le_iff,
    intros e he,
    rw [biholomorph_groupoid, mem_groupoid_of_pregroupoid] at he,
    rw [times_cont_diff_groupoid, mem_groupoid_of_pregroupoid, complex_plane] at ⊢,
    simp,
    split,
    { apply (smooth_on_iff_holomorph_on e e.open_source).mp, exact he.1, },
    { apply (smooth_on_iff_holomorph_on e.symm e.open_target).mp, exact he.2, }, },
  { rw structure_groupoid.le_iff,
    intros e he,
    rw [biholomorph_groupoid, mem_groupoid_of_pregroupoid] at ⊢,
    rw [times_cont_diff_groupoid, mem_groupoid_of_pregroupoid, complex_plane] at he,
    simp at he,
    split,
    { apply (smooth_on_iff_holomorph_on e e.open_source).mpr, exact he.1, },
    { apply (smooth_on_iff_holomorph_on e.symm e.open_target).mpr, exact he.2, }, },
end

lemma riemann_surface.smooth_manifold
  (X : Type*) [topological_space X] [t2_space X]
  [connected_space X] [charted_space ℂ X] [riemann_surface X] :
  smooth_manifold_with_corners complex_plane X :=
{   compatible := λ e e' he he',
    begin
      apply structure_groupoid.le_iff.mp (le_antisymm_iff.mp biholomorph_groupoid_eq).1,
      exact biholomorph_groupoid.compatible he he',
    end }

lemma topological_space.opens.riemann_surface
  {X : Type*} [topological_space X] [t2_space X]
  [connected_space X] [charted_space ℂ X] [riemann_surface X]
  (Y : topological_space.opens X) [connected_space Y] :
  @riemann_surface Y _ _ _ (topological_space.opens.charted_space Y) :=
{ .. Y.has_groupoid biholomorph_groupoid }

lemma two_points_open : ∀ (x : ℂ) (s : set ℂ) (H: is_open s), x ∈ s → (∃ y, y ∈ s ∧ ¬ y = x) :=
begin
  intros x s hs hx,
  have minor₁ : ¬ s = {x} := by_contra (λ h, (crowded_space.def ℂ) x $ (not_not.mp h) ▸ hs),
  have minor₂ : ¬ s ⊆ {x} :=
    by_contra (λ h, minor₁ $ subset.antisymm (not_not.mp h) $ λ x' hx',
      (set.eq_of_mem_singleton hx').symm ▸ hx),
  rw ← nonempty_diff at minor₂,
  rcases minor₂ with ⟨a, ha⟩,
  rw [mem_diff_singleton, ne.def] at ha,
  exact ⟨a, ha⟩,
end

instance riemann_surface_crowded_space (X : Type*) [topological_space X] [t2_space X]
[connected_space X] [charted_space ℂ X] [riemann_surface X] :
crowded_space X :=
{ is_crowded := begin
    have : ∀ (x : X), ∃ y, ¬ y = x := λ x,
    begin
      have : ∃ (y' : ℂ), y' ∈ (chart_at ℂ x).to_local_equiv.target ∧ ¬ y' =
        (chart_at ℂ x).to_local_equiv x :=
      begin
        rcases two_points_open (chart_at ℂ x x) (chart_at ℂ x).to_local_equiv.target
          (chart_at ℂ x).open_target (mem_chart_target ℂ x),
        exact ⟨w, h⟩,
      end,
      rcases this with ⟨y', hy'₁, hy'₂⟩,
      refine ⟨(chart_at ℂ x).to_local_equiv.symm y', _⟩,
      by_contra w,
      rw [← local_equiv.left_inv (chart_at ℂ x).to_local_equiv (mem_chart_source ℂ x),
          local_equiv.left_inv (chart_at ℂ x).to_local_equiv (mem_chart_source ℂ x)] at w,
      have : (chart_at ℂ x).to_local_equiv x = y' := begin
        nth_rewrite 1 ← w,
        rw local_equiv.right_inv (chart_at ℂ x).to_local_equiv hy'₁,
      end,
      exact hy'₂ this.symm,
    end,
    exact t1_space_connected_with_two_points_is_crowded X this,
  end, }

variables {X Y Z : Type*}
  [topological_space X] [t2_space X] [connected_space X] [charted_space ℂ X] [riemann_surface X]
  [topological_space Y] [t2_space Y] [connected_space Y] [charted_space ℂ Y] [riemann_surface Y]
  [topological_space Z] [t2_space Z] [connected_space Z] [charted_space ℂ Z] [riemann_surface Z]

--- Correct definition? `chart_at` or `atlas`? Seems equivalent to the analogy of the definitions of
--- `times_cont_mdiff` given the compatibility of charts defined.
--- Skipped `lift_prop_on`, `image_eq_target_inter_inv_preimage` and `lift_prop_on_indep_chart`
--- Can be derived from a `chart_at` + `lift_prop_on` definition given the lemma
--- `biholomorph_groupoid_eq : biholomorph_groupoid = times_cont_diff_groupoid ⊤ complex_plane`
def fholomorph_on (f : X → ℂ) {s : set X} (h : is_open s) :=
continuous_on f s ∧
∀ (ϕ : local_homeomorph X ℂ),
ϕ ∈ atlas ℂ X → differentiable_on ℂ (f ∘ ϕ.symm) (ϕ '' (ϕ.to_local_equiv.source ∩ s))

@[simp] lemma fholomorph_on.mono {f : X → ℂ} {s s': set X} {hs: is_open s} {hs' : is_open s'}
(h : fholomorph_on f hs) (H : s' ⊆ s) : fholomorph_on f hs' :=
begin
  split,
  exact continuous_on.mono h.1 H,
  { intros ϕ hϕ,
    have : ϕ '' (ϕ.to_local_equiv.source ∩ s') ⊆ ϕ '' (ϕ.to_local_equiv.source ∩ s) :=
      λ x hx, let ⟨v, ⟨hv₁, hv₂⟩, hv₃⟩ := hx in ⟨v, ⟨hv₁, H hv₂⟩, hv₃⟩,
    exact differentiable_on.mono (h.2 ϕ hϕ) this, },
end

--- Correct definition? `chart_at` or `atlas`? Seems equivalent to the analogy of the definitions of
--- `times_cont_mdiff` given the compatibility of charts defined.
--- Skipped `lift_prop_on`, `image_eq_target_inter_inv_preimage` and `lift_prop_on_indep_chart`
--- Can be derived from a `chart_at` + `lift_prop_on` definition given the lemma
--- `biholomorph_groupoid_eq : biholomorph_groupoid = times_cont_diff_groupoid ⊤ complex_plane`
def mholomorph (f : X → Y) :=
continuous f ∧
∀ (ϕ : local_homeomorph X ℂ) (ψ : local_homeomorph Y ℂ),
ϕ ∈ atlas ℂ X → ψ ∈ atlas ℂ Y →
differentiable_on ℂ (ψ ∘ f ∘ ϕ.symm) (ϕ '' (ϕ.to_local_equiv.source ∩ f⁻¹' ψ.to_local_equiv.source))

lemma mholomorph_of_fholomorph_on_univ {f : X → ℂ} (hf : fholomorph_on f is_open_univ) :
  mholomorph f :=
and.intro
  (continuous_iff_continuous_on_univ.mpr hf.1)
  (begin
    intros e e' he he',
    rw charted_space_self_atlas at he',
    rw he',
    simp,
    rw ← set.inter_univ e.to_local_equiv.source,
    exact hf.2 e he,
  end)
--
lemma fholomorph_on.continuous {f : X → ℂ} {s : set X} {h : is_open s}
  (H : fholomorph_on f h) : continuous_on f s := H.1
lemma mholomorph.continuous {f : X → Y} (h : mholomorph f) : continuous f := h.1

@[simp] lemma fholomorph_on_const {s : set X} (h : is_open s) (c : ℂ) :
  fholomorph_on (λ (x : X), c) h :=
⟨continuous_on_const, λ ϕ hϕ, by {rw function.const_comp, exact differentiable_on_const c}⟩

@[simp] lemma mholomorph_const (c : Y) :
  mholomorph (λ (x : X), c) :=
begin
  split,
  exact continuous_const,
  intros e e' he he',
  rw [function.const_comp, function.comp_const],
  exact differentiable_on_const (e' c),
end

@[simp] lemma fholomorph_on.mul {f g : X → ℂ} {s : set X} {h : is_open s}
  (hf : fholomorph_on f h) (hg : fholomorph_on g h) : fholomorph_on (λ (x : X), (f x) * g x) h :=
⟨continuous_on.mul hf.1 hg.1, λ ϕ hϕ, differentiable_on.mul (hf.2 ϕ hϕ) $ hg.2 ϕ hϕ⟩

@[simp] lemma fholomorph_on.add {f g : X → ℂ} {s : set X} {h : is_open s}
  (hf : fholomorph_on f h) (hg : fholomorph_on g h) : fholomorph_on (λ (x : X), (f x) + g x) h :=
⟨continuous_on.add hf.1 hg.1, λ ϕ hϕ, differentiable_on.add (hf.2 ϕ hϕ) $ hg.2 ϕ hϕ⟩

@[simp] lemma fholomorph_on.neg {f: X → ℂ} {s : set X} {h : is_open s}
  (hf : fholomorph_on f h) : fholomorph_on (λ (x : X), - f x) h :=
begin
  let g : X → ℂ := λ x, -1,
  have minor₁ : fholomorph_on g h := fholomorph_on_const h (-1 : ℂ),
  have minor₂ : (λ (x : X), - f x) = (λ (x : X),  (g x) * f x) := by simp,
  exact minor₂.symm ▸ fholomorph_on.mul minor₁ hf,
end

variables (U : set X) [is_open U] [is_connected U]

--- Contains some redundant lemmas. Bad obj names. Will clean it up.
lemma eq_on_local_disk_around_accumulation_pt
  {f g : X → Y} (hf : mholomorph f) (hg : mholomorph g)
  {G : set X} (hG : set.eq_on f g G)
  {z : X} (key₁ : z ∈ G) (hz : accumulation_pt X G z) :
  ∃ (U : set X), z ∈ U ∧ is_open U ∧ set.eq_on f g U :=
begin
  have minor₁ : set.eq_on f g G := hG,
  have minor₂ : f z = g z := hG key₁,
  let ϕ : local_homeomorph X ℂ := chart_at ℂ z,
  let ψ : local_homeomorph Y ℂ := chart_at ℂ (f z),
  let πf : ℂ → ℂ := ψ ∘ f ∘ ϕ.symm,
  let πg : ℂ → ℂ := ψ ∘ g ∘ ϕ.symm,
  let W : set X := f⁻¹' ψ.to_local_equiv.source ∩ g⁻¹' ψ.to_local_equiv.source,
  let W' : set X := ϕ.to_local_equiv.source ∩ W,
  let V : set ℂ := ϕ '' W',
  have z_mem_W' : z ∈ W' :=
    ⟨mem_chart_source ℂ z,
      ⟨mem_chart_source ℂ (f z),
      (minor₂ ▸ mem_chart_source ℂ (f z) : g z ∈ (chart_at ℂ (f z)).to_local_equiv.source)⟩⟩,
  have openW' : is_open W' :=
    is_open.inter ϕ.open_source (is_open.inter (is_open.preimage hf.1 ψ.open_source) $ is_open.preimage hg.1 ψ.open_source),
  have openV : is_open V :=
    local_homeomorph.image_open_of_open ϕ openW' (set.inter_subset_left _ W),
  have nonemptyW' : W'.nonempty := ⟨z, z_mem_W'⟩,
  have nonemptyV : V.nonempty := set.nonempty.image ϕ nonemptyW',
  rw metric.is_open_iff at openV,
  rcases openV (ϕ z) (set.mem_image_of_mem ϕ z_mem_W') with ⟨ε, hε, hball⟩,
  let ϕball := ball (ϕ z) ε,
  have Vsubset : V ⊆ ϕ.to_local_equiv.target :=
  begin
    intros v hv,
    have : V = ϕ '' W' := rfl,
    rw this at hv,
    rw local_homeomorph.image_eq_target_inter_inv_preimage ϕ (set.inter_subset_left _ W) at hv,
    exact hv.1,
  end,
  have W'subsetf : W' ⊆ f⁻¹' ψ.to_local_equiv.source :=
    set.subset.trans (set.inter_subset_right _ W) (set.inter_subset_left _ _),
  have W'subsetg : W' ⊆ g⁻¹' ψ.to_local_equiv.source :=
    set.subset.trans (set.inter_subset_right _ W) (set.inter_subset_right _ _),
  have fW'subsetsource : f '' W' ⊆ ψ.to_local_equiv.source,
  { rw ← set.image_subset_iff at W'subsetf, exact W'subsetf, },
  have gW'subsetsource : g '' W' ⊆ ψ.to_local_equiv.source,
  { rw ← set.image_subset_iff at W'subsetg, exact W'subsetg, },
  have πfdiffon :
    differentiable_on ℂ πf (ϕ '' (ϕ.to_local_equiv.source ∩ f⁻¹' ψ.to_local_equiv.source)) :=
    hf.2 ϕ ψ (chart_mem_atlas ℂ z) (chart_mem_atlas ℂ (f z)),
  have πgdiffon :
    differentiable_on ℂ πg (ϕ '' (ϕ.to_local_equiv.source ∩ g⁻¹' ψ.to_local_equiv.source)) :=
    hg.2 ϕ ψ (chart_mem_atlas ℂ z) (chart_mem_atlas ℂ (f z)),
  have πfϕballsubset : ϕball ⊆ ϕ '' (ϕ.to_local_equiv.source ∩ f⁻¹' ψ.to_local_equiv.source) :=
    λ v hv, let ⟨v', hv'⟩ := hball hv in ⟨v', ⟨⟨hv'.1.1, hv'.1.2.1⟩, hv'.2⟩⟩,
  have πgϕballsubset : ϕball ⊆ ϕ '' (ϕ.to_local_equiv.source ∩ g⁻¹' ψ.to_local_equiv.source) :=
    λ v hv, let ⟨v', hv'⟩ := hball hv in ⟨v', ⟨⟨hv'.1.1, hv'.1.2.2⟩, hv'.2⟩⟩,
  have ϕballsubset : ϕball ⊆ ϕ.to_local_equiv.target :=
  λ v hv, begin
    rw local_homeomorph.image_eq_target_inter_inv_preimage ϕ (set.inter_subset_left _ _)
      at πfϕballsubset,
    exact (πfϕballsubset hv).1,
  end,
  have subkeyπf : differentiable_on ℂ πf ϕball := differentiable_on.mono πfdiffon πfϕballsubset,
  have subkeyπg : differentiable_on ℂ πg ϕball := differentiable_on.mono πgdiffon πgϕballsubset,
  let superkeyset := ϕball,
  have superkeyopen : is_open superkeyset := metric.is_open_ball,
  have superkeyconnected : is_connected ϕball :=
    (is_open.is_connected_iff_is_path_connected metric.is_open_ball).mp
    (convex.is_path_connected (convex_ball (ϕ z) ε) $ metric.nonempty_ball hε),
  have superkeymem : ϕ z ∈ superkeyset := metric.mem_ball_self hε,
  have superkeymem' : ϕ z ∈  ϕ '' (G ∩ ϕ.to_local_equiv.source) ∩ superkeyset :=
    ⟨⟨z, ⟨⟨key₁, mem_chart_source ℂ z⟩, rfl⟩⟩, superkeymem⟩,
  have subkeyaccum : accumulation_pt ℂ (ϕ '' (G ∩ ϕ.to_local_equiv.source)) (ϕ z) :=
    accumulation_pt_local_homeomorph
      (accumulation_pt_open_inter ϕ.open_source (mem_chart_source ℂ z) hz) (mem_chart_source ℂ z),
  have superkeyaccum : accumulation_pt ℂ
    (ϕ '' (G ∩ ϕ.to_local_equiv.source) ∩ superkeyset) (ϕ z) :=
    accumulation_pt_open_inter superkeyopen superkeymem subkeyaccum,
  have superkeyeq₁ : set.eq_on πf πg (ϕ '' (G ∩ ϕ.to_local_equiv.source) ∩ superkeyset) :=
  begin
    intros m hm,
    rcases hm with ⟨hm₁, hm₂⟩,
    have trivial₀ : ϕ (ϕ.symm m) = m := local_homeomorph.right_inv ϕ (ϕballsubset hm₂),
    have trivial₁ : ϕ.symm m ∈ ϕ.to_local_equiv.source := local_homeomorph.map_target ϕ (ϕballsubset hm₂),
    rw ← trivial₀ at hm₁,
    have trivial₂ : ϕ.symm m ∈ G :=
      ((set.inj_on.mem_image_iff ϕ.to_local_equiv.inj_on
      (set.inter_subset_right G ϕ.to_local_equiv.source) trivial₁).mp hm₁).1,
    exact calc πf m = (ψ ∘ f ∘ ϕ.symm) m : rfl
        ... = ((ψ ∘ f) ∘ ϕ.symm) m : by rw (function.comp.assoc ψ f ϕ.symm).symm
        ... = (ψ ∘ f) (ϕ.symm m) : function.comp_app (ψ ∘ f) ϕ.symm m
        ... = ψ (f (ϕ.symm m)) : function.comp_app ψ f (ϕ.symm m)
        ... = ψ (g (ϕ.symm m)) : by rw hG trivial₂
        ... = (ψ ∘ g) (ϕ.symm m) : (function.comp_app ψ g (ϕ.symm m)).symm
        ... = ((ψ ∘ g) ∘ ϕ.symm) m : (function.comp_app (ψ ∘ g) ϕ.symm m).symm
        ... = (ψ ∘ g ∘ ϕ.symm) m : by rw (function.comp.assoc ψ g ϕ.symm)
        ... = πg m : rfl,
  end,
  have superkeyeq₂ : set.eq_on πf πg superkeyset :=
    identity_theorem superkeyopen superkeyconnected subkeyπf subkeyπg
      (set.inter_subset_right (ϕ '' (G ∩ ϕ.to_local_equiv.source)) superkeyset)
      superkeyeq₁ superkeymem' superkeyaccum,
  let U := ϕ.symm '' ϕball,
  have minor₃ : U = ϕ.to_local_equiv.source ∩ ϕ⁻¹' ϕball :=
  begin
    have : U = ϕ.symm '' ϕball := rfl,
    rw local_homeomorph.symm_image_eq_source_inter_preimage _ ϕballsubset at this,
    exact this,
  end,
  have superkeymemU : z ∈ U :=
    ⟨ϕ z, ⟨mem_ball_self hε, local_homeomorph.left_inv ϕ (mem_chart_source ℂ z)⟩⟩,
  have superkeyopenU : is_open U :=
  begin
    let q := local_homeomorph.preimage_open_of_open ϕ superkeyopen,
    rw (local_homeomorph.symm_image_eq_source_inter_preimage _ ϕballsubset).symm at q,
    exact q,
  end,
  have superkeyeqU : set.eq_on f g U :=
  begin
    intros m hm,
    rcases (set.mem_image _ ϕball _).mp hm with ⟨m', h₁, h₂⟩,
    rw minor₃ at hm,
    have trivial₀ : m ∈ ϕ.to_local_equiv.source := hm.1,
    have trivial₁ : m ∈ W' :=
    begin
      rcases hball hm.2 with ⟨m₁, hm₁, hm₁'⟩,
      let q := ϕ.to_local_equiv.inj_on ((set.inter_subset_left _ W) hm₁) trivial₀ hm₁',
      rw q at hm₁,
      exact hm₁,
    end,
    have trivial₂ : ϕ m ∈ ϕball := hm.2,
    exact calc f m = (ψ.symm) (ψ $ f m) :
        (local_homeomorph.left_inv ψ $ fW'subsetsource $ mem_image_of_mem f trivial₁).symm
      ... = (ψ.symm) (ψ $ f $ ϕ.symm $ ϕ m) : by nth_rewrite 0 ← local_homeomorph.left_inv ϕ trivial₀
      ... = (ψ.symm) (πf $ ϕ m) : by simp
      ... = (ψ.symm) (πg $ ϕ m) : by rw superkeyeq₂ trivial₂
      ... = (ψ.symm) (ψ $ g $ ϕ.symm $ ϕ m) : by simp
      ... = (ψ.symm) (ψ $ g m) : by rw local_homeomorph.left_inv ϕ trivial₀
      ... = g m : (local_homeomorph.left_inv ψ $ gW'subsetsource $ mem_image_of_mem g trivial₁)
  end,
  use U,
  exact ⟨superkeymemU, superkeyopenU, superkeyeqU⟩,
end

--- Contains some redundant lemmas. Bad obj names. Will clean it up.
lemma nondiscrete_closure_of_eq_mholomorph
  {f g : X → Y} (hf : mholomorph f) (hg : mholomorph g)
  {G : set X} (key₁ : is_open G) (hG₂ : set.eq_on f g G)
  {z : X} (hz : z ∈ closure G) :
  ∃ (U : set X), z ∈ U ∧ is_open U ∧ set.eq_on f g U :=
begin
    have : closure G = frontier G ∪ G := by rw [is_open.frontier_eq key₁, diff_union_of_subset subset_closure],
    by_cases p : z ∈ frontier G,
    { have minor₁ : set.eq_on f g G := hG₂,
      have minor₂ : f z = g z := (set.eq_on.mono frontier_subset_closure $ set.eq_on.closure minor₁ hf.continuous hg.continuous) p,
      let ϕ : local_homeomorph X ℂ := chart_at ℂ z,
      let ψ : local_homeomorph Y ℂ := chart_at ℂ (f z),
      let πf : ℂ → ℂ := ψ ∘ f ∘ ϕ.symm,
      let πg : ℂ → ℂ := ψ ∘ g ∘ ϕ.symm,
      let W : set X := f⁻¹' ψ.to_local_equiv.source ∩ g⁻¹' ψ.to_local_equiv.source,
      let W' : set X := ϕ.to_local_equiv.source ∩ W,
      let V : set ℂ := ϕ '' (G ∩ W'),
      have zmemW' : z ∈ W' :=
        ⟨mem_chart_source ℂ z,
          ⟨mem_chart_source ℂ (f z),
          (minor₂ ▸ mem_chart_source ℂ (f z) : g z ∈ (chart_at ℂ (f z)).to_local_equiv.source)⟩⟩,
      have openW' : is_open W' :=
        is_open.inter ϕ.open_source (is_open.inter (is_open.preimage hf.1 ψ.open_source) $ is_open.preimage hg.1 ψ.open_source),
      have openpreV : is_open (G ∩ W') := is_open.inter key₁ openW',
      have openV : is_open V :=
        local_homeomorph.image_open_of_open ϕ openpreV (set.subset.trans (set.inter_subset_right G W') $ set.inter_subset_left _ W),
      have openϕW' : is_open (ϕ '' W') := local_homeomorph.image_open_of_open ϕ openW' (set.inter_subset_left _ W),
      have nonemptypreV : (G ∩ W').nonempty :=
      begin
        let p' := frontier_subset_closure p,
        rw _root_.mem_closure_iff at p',
        specialize p' W' openW' zmemW',
        rw set.inter_comm at p',
        exact p',
      end,
      have nonemptyV : V.nonempty := set.nonempty.image ϕ nonemptypreV,
      have memclosurepreV : z ∈ closure (G ∩ W') := mem_closure_inter (frontier_subset_closure p) openW' zmemW',
      have memclosureV : ϕ z ∈ closure V := mem_image_closure_mem_closure memclosurepreV (mem_chart_source ℂ z),
      rw metric.is_open_iff at openϕW',
      rcases openϕW' (ϕ z) (set.mem_image_of_mem ϕ zmemW') with ⟨ε, hε, hball⟩,
      let ϕball := ball (ϕ z) ε,
      have Vsubset : V ⊆ ϕ.to_local_equiv.target :=
      begin
        intros v hv,
        have : V = ϕ '' (G ∩ W') := rfl,
        rw this at hv,
        rw local_homeomorph.image_eq_target_inter_inv_preimage ϕ (set.subset.trans (set.inter_subset_right G W') (set.inter_subset_left _ W)) at hv,
        exact hv.1,
      end,
      have W'subsetf : W' ⊆ f⁻¹' ψ.to_local_equiv.source := set.subset.trans (set.inter_subset_right _ W) (set.inter_subset_left _ _),
      have W'subsetg : W' ⊆ g⁻¹' ψ.to_local_equiv.source := set.subset.trans (set.inter_subset_right _ W) (set.inter_subset_right _ _),
      have fW'subsetsource : f '' W' ⊆ ψ.to_local_equiv.source := by rw ← set.image_subset_iff at W'subsetf; exact W'subsetf,
      have gW'subsetsource : g '' W' ⊆ ψ.to_local_equiv.source := by rw ← set.image_subset_iff at W'subsetg; exact W'subsetg,
      have openϕball : is_open ϕball := metric.is_open_ball,
      have connectedϕball : is_connected ϕball :=
        (is_open.is_connected_iff_is_path_connected metric.is_open_ball).mp
          (convex.is_path_connected (convex_ball (ϕ z) ε) $ metric.nonempty_ball hε),
      have πfdiffon : differentiable_on ℂ πf (ϕ '' (ϕ.to_local_equiv.source ∩ f⁻¹' ψ.to_local_equiv.source)) :=
        hf.2 ϕ ψ (chart_mem_atlas ℂ z) (chart_mem_atlas ℂ (f z)),
      have πgdiffon : differentiable_on ℂ πg (ϕ '' (ϕ.to_local_equiv.source ∩ g⁻¹' ψ.to_local_equiv.source)) :=
        hg.2 ϕ ψ (chart_mem_atlas ℂ z) (chart_mem_atlas ℂ (f z)),
      have πfϕballsubset : ϕball ⊆ ϕ '' (ϕ.to_local_equiv.source ∩ f⁻¹' ψ.to_local_equiv.source) :=
        λ v hv, let ⟨v', hv'⟩ := hball hv in ⟨v', ⟨⟨hv'.1.1, hv'.1.2.1⟩, hv'.2⟩⟩,
      have πgϕballsubset : ϕball ⊆ ϕ '' (ϕ.to_local_equiv.source ∩ g⁻¹' ψ.to_local_equiv.source) :=
        λ v hv, let ⟨v', hv'⟩ := hball hv in ⟨v', ⟨⟨hv'.1.1, hv'.1.2.2⟩, hv'.2⟩⟩,
      have ϕballsubset : ϕball ⊆ ϕ.to_local_equiv.target := λ v hv,
      begin
        rw local_homeomorph.image_eq_target_inter_inv_preimage ϕ (set.inter_subset_left _ _) at πfϕballsubset,
        exact (πfϕballsubset hv).1,
      end,
      have subkeyπf : differentiable_on ℂ πf ϕball := differentiable_on.mono πfdiffon πfϕballsubset,
      have subkeyπg : differentiable_on ℂ πg ϕball := differentiable_on.mono πgdiffon πgϕballsubset,
      let superkeyset := ϕball ∩ V,
      have superkeyopen : is_open superkeyset := is_open.inter metric.is_open_ball openV,
      have superkeynonempty : superkeyset.nonempty :=
      begin
        rw _root_.mem_closure_iff at memclosureV,
        exact memclosureV ϕball metric.is_open_ball (metric.mem_ball_self hε),
      end,
      have superkeyeq₁ : set.eq_on πf πg superkeyset :=
      begin
        intros m hm,
        rcases hm with ⟨hm₁, hm₂⟩,
        have trivial₀ : ϕ (ϕ.symm m) = m := local_homeomorph.right_inv ϕ (Vsubset hm₂),
        have trivial₁ : ϕ.symm m ∈ ϕ.source := local_homeomorph.map_target ϕ (Vsubset hm₂),
        rw ←trivial₀ at hm₂,
        have trivial₂ : ϕ.symm m ∈ G :=
          ((set.inj_on.mem_image_iff ϕ.to_local_equiv.inj_on (set.subset.trans (set.inter_subset_right G W') (set.inter_subset_left _ W)) trivial₁).mp hm₂).1,
        exact calc πf m = (ψ ∘ f ∘ ϕ.symm) m : rfl
        --- no simp to make the code faster
         ... = ((ψ ∘ f) ∘ ϕ.symm) m : by rw (function.comp.assoc ψ f ϕ.symm).symm
         ... = (ψ ∘ f) (ϕ.symm m) : function.comp_app (ψ ∘ f) ϕ.symm m
         ... = ψ (f (ϕ.symm m)) : function.comp_app ψ f (ϕ.symm m)
         ... = ψ (g (ϕ.symm m)) : by rw minor₁ trivial₂
         ... = (ψ ∘ g) (ϕ.symm m) : (function.comp_app ψ g (ϕ.symm m)).symm
         ... = ((ψ ∘ g) ∘ ϕ.symm) m : (function.comp_app (ψ ∘ g) ϕ.symm m).symm
         ... = (ψ ∘ g ∘ ϕ.symm) m : by rw (function.comp.assoc ψ g ϕ.symm)
         ... = πg m : rfl,
      end,
      have superkeyeq₂ : set.eq_on πf πg ϕball :=
        eq_of_eq_on_open openϕball connectedϕball subkeyπf subkeyπg superkeyopen superkeynonempty superkeyeq₁ (set.inter_subset_left _ V),
      let U := ϕ.symm '' ϕball,
      have minor₃ : U = ϕ.to_local_equiv.source ∩ ϕ⁻¹' ϕball :=
      begin
        have : U = ϕ.symm '' ϕball := rfl,
        rw local_homeomorph.symm_image_eq_source_inter_preimage _ ϕballsubset at this,
        exact this,
      end,
      have superkeymemU : z ∈ U := ⟨ϕ z, ⟨mem_ball_self hε, local_homeomorph.left_inv ϕ (mem_chart_source ℂ z)⟩⟩,
      have superkeyopenU : is_open U :=
      begin
        let q := local_homeomorph.preimage_open_of_open ϕ openϕball,
        rw (local_homeomorph.symm_image_eq_source_inter_preimage _ ϕballsubset).symm at q,
        exact q,
      end,
      have superkeyeqU : set.eq_on f g U :=
      begin
        intros m hm,
        rcases (set.mem_image _ ϕball _).mp hm with ⟨m', h₁, h₂⟩,
        rw minor₃ at hm,
        have trivial₀ : m ∈ ϕ.to_local_equiv.source := hm.1,
        have trivial₁ : m ∈ W' :=
        begin
          rcases hball hm.2 with ⟨m₁, hm₁, hm₁'⟩,
          let q := ϕ.to_local_equiv.inj_on ((set.inter_subset_left _ W) hm₁) trivial₀ hm₁',
          rw q at hm₁,
          exact hm₁,
        end,
        have trivial₂ : ϕ m ∈ ϕball := hm.2,
        exact calc f m = (ψ.symm) (ψ $ f m) : (local_homeomorph.left_inv ψ $ fW'subsetsource $ mem_image_of_mem f trivial₁).symm
          ... = (ψ.symm) (ψ $ f $ ϕ.symm $ ϕ m) : by nth_rewrite 0 ← local_homeomorph.left_inv ϕ trivial₀
          ... = (ψ.symm) (πf $ ϕ m) : by simp
          ... = (ψ.symm) (πg $ ϕ m) : by rw superkeyeq₂ trivial₂
          ... = (ψ.symm) (ψ $ g $ ϕ.symm $ ϕ m) : by simp
          ... = (ψ.symm) (ψ $ g m) : by rw local_homeomorph.left_inv ϕ trivial₀
          ... = g m : (local_homeomorph.left_inv ψ $ gW'subsetsource $ mem_image_of_mem g trivial₁)
      end,
      use U,
      exact ⟨superkeymemU, superkeyopenU, superkeyeqU⟩, },
    { rw [this, set.mem_union] at hz,
      have key : z ∈ G := or.resolve_left hz p,
      rcases (is_open_iff_forall_mem_open.mp key₁ z key) with ⟨U, hU₁, hU₂, hU₃⟩,
      exact ⟨U, hU₃, hU₂, set.eq_on.mono hU₁ hG₂⟩, },
end

lemma identity_lemma_of_mholomorph
  {f g : X → Y} (hf : mholomorph f) (hg : mholomorph g)
  {S : set X} (hS : set.eq_on f g S)
  {s₀ : X} (hs₀ : s₀ ∈ S) (hs₀' : accumulation_pt X S s₀):
  set.eq_on f g univ :=
begin
  let G : set X := {z : X | ∃ (U : set X), z ∈ U ∧ is_open U ∧ set.eq_on f g U},
  have key₁ : is_open G :=
  begin
    rw is_open_iff_forall_mem_open,
    intros x hx,
    rcases hx with ⟨U, hU₁, hU₂, hU₃⟩,
    have : U ⊆ G := λ u hu,
    begin
      rw is_open_iff_forall_mem_open at hU₂,
      rcases hU₂ u hu with ⟨t, ht₁, ht₂⟩,
      exact ⟨t, ht₂.2, ⟨ht₂.1, λ x hx, hU₃ (ht₁ hx)⟩⟩,
    end,
    exact ⟨U, this, ⟨hU₂, hU₁⟩⟩,
  end,
  have : set.eq_on f g G := λ x hx, let ⟨U, h₁, h₂, h₃⟩ := hx in h₃ h₁,
  have key₂ : is_closed G:=
    is_closed_of_closure_subset (λ z hz, let ⟨U, h₁, h₂, h₃⟩ :=
    nondiscrete_closure_of_eq_mholomorph hf hg key₁ this hz in ⟨U, h₁, h₂, h₃⟩),
  have key₃ : G = ∅ ∨ G = univ := is_clopen_iff.mp ⟨key₁, key₂⟩,
  have key₄ : G.nonempty := let ⟨U, h₁, h₂, h₃⟩ :=
    eq_on_local_disk_around_accumulation_pt hf hg hS hs₀ hs₀' in ⟨s₀, ⟨U, h₁, h₂, h₃⟩⟩,
  have superkey : G = univ := or.resolve_left key₃ (ne_empty_iff_nonempty.mpr key₄),
  rw ← superkey,
  exact this,
end

def shifted_chart_to_local_equiv (e : local_equiv X ℂ) (a : ℂ) : local_equiv X ℂ :=
{
  to_fun := λ x, e x + a,
  inv_fun := λ z, e.symm (z - a),
  source := e.source,
  target := {z | z - a ∈ e.target},
  map_source' := λ x hx, by simp; exact e.map_source' hx,
  map_target' := λ x hx, local_equiv.map_target e hx,
  left_inv' := λ x hx,
  begin
    rw [add_sub_assoc _ a a, sub_self a, add_zero (e x)],
    exact e.left_inv' hx,
  end,
  right_inv' := λ x hx,
  begin
    rw [← local_equiv.inv_fun_as_coe, ← local_equiv.to_fun_as_coe, e.right_inv' hx],
    ring,
  end,
}

lemma shifted_source (e : local_equiv X ℂ) (a : ℂ) : (shifted_chart_to_local_equiv e a).source = e.source := rfl
lemma shifted_target (e : local_equiv X ℂ) (a : ℂ) : (shifted_chart_to_local_equiv e a).target = {z | z - a ∈ e.target} := rfl
lemma shifted_to_fun (e : local_equiv X ℂ) (a : ℂ) : (shifted_chart_to_local_equiv e a).to_fun = λ x, e x + a := rfl
lemma shifted_inv_fun (e : local_equiv X ℂ) (a : ℂ) : (shifted_chart_to_local_equiv e a).inv_fun = λ x, e.symm (x - a) := rfl

def shifted_chart_to_local_homeomorph (e : local_homeomorph X ℂ) (a : ℂ) : local_homeomorph X ℂ :=
{
  to_local_equiv := shifted_chart_to_local_equiv e.to_local_equiv a,
  open_source := (shifted_source e.to_local_equiv a).symm ▸ e.open_source,
  open_target :=
  begin
    rw shifted_target e.to_local_equiv a,
    have : {z | z - a ∈ e.to_local_equiv.target} = (λ z, z + a) '' e.to_local_equiv.target :=
    begin
      ext,
      split,
      { intros hx, exact ⟨x - a, ⟨hx, by simp⟩⟩, },
      {
        intros hx, rcases hx with ⟨x', hx'⟩,
        simp at hx',
        rw ← hx'.2,
        simp,
        exact hx'.1,
      },
    end,
    rw this,
    exact is_open_map_add_right a e.to_local_equiv.target e.open_target,
  end,
  continuous_to_fun :=
  begin
    rw [shifted_to_fun e.to_local_equiv a, shifted_source e.to_local_equiv a, local_homeomorph.coe_coe e],
    exact continuous_on.add (e.continuous_to_fun) (continuous_on_const),
  end,
  continuous_inv_fun :=
  begin
    rw [shifted_inv_fun e.to_local_equiv a, shifted_target e.to_local_equiv a, local_homeomorph.coe_coe_symm e],
    have : {z | z - a ∈ e.to_local_equiv.target} = (λ z, z + a) '' e.to_local_equiv.target :=
    begin
      ext,
      split,
      { intros hx, exact ⟨x - a, ⟨hx, by simp⟩⟩, },
      {
        intros hx, rcases hx with ⟨x', hx'⟩,
        simp at hx',
        rw ← hx'.2,
        simp,
        exact hx'.1,
      },
    end,
    rw this,
    have minor : (λ x, e.symm (x - a)) = (e.symm ∘ (λ x, x - a)) := by simp,
    rw minor,
    have key : (λ (z : ℂ), z + a) '' e.to_local_equiv.target ⊆ (λ x, x - a)⁻¹' e.to_local_equiv.target :=
    begin
      intros x hx,
      rcases hx with ⟨x', hx'₁, hx'₂⟩,
      have : (λ x, x - a) x = x' :=
      calc (λ x, x - a) x = x - a : by simp
        ... = ((λ x, x + a) x') - a : by rw hx'₂
        ... = (x' + a) - a : by simp
        ... = x' : by ring,
      rw ← this at hx'₁,
      exact hx'₁,
    end,
    exact continuous_on.comp
      (local_homeomorph.continuous_on_symm e)
      (continuous_on.sub continuous_on_id continuous_on_const)
      key,
  end,
}

lemma shifted_h_to_e (e : local_homeomorph X ℂ) (a : ℂ) : (shifted_chart_to_local_homeomorph e a).to_local_equiv = shifted_chart_to_local_equiv e.to_local_equiv a := rfl
lemma shifted_source' (e : local_homeomorph X ℂ) (a : ℂ) : (shifted_chart_to_local_homeomorph e a).to_local_equiv.source = e.to_local_equiv.source := rfl
lemma shifted_target' (e : local_homeomorph X ℂ) (a : ℂ) : (shifted_chart_to_local_homeomorph e a).to_local_equiv.target = {z | z - a ∈ e.to_local_equiv.target} := by rw shifted_h_to_e; refl
lemma shifted_to_fun' (e : local_homeomorph X ℂ) (a : ℂ) : (shifted_chart_to_local_homeomorph e a).to_local_equiv.to_fun = λ x, e x + a := rfl
lemma shifted_inv_fun' (e : local_homeomorph X ℂ) (a : ℂ) : (shifted_chart_to_local_homeomorph e a).to_local_equiv.inv_fun = λ x, e.symm (x - a) := rfl

lemma chart_at_origin_of_fun_at
{f : X → Y} (hf : continuous f) (a : X) :
∃ (ϕ : local_homeomorph X ℂ) (ψ : local_homeomorph Y ℂ),
a ∈ ϕ.to_local_equiv.source ∧ ϕ a = 0 ∧
f a ∈ ψ.to_local_equiv.source ∧ ψ (f a) = 0 ∧
f '' ϕ.to_local_equiv.source ⊆ ψ.to_local_equiv.source :=
begin
  let ϕ₁ := chart_at ℂ a,
  let ψ₁ := chart_at ℂ (f a),
  let ϕ₂ := shifted_chart_to_local_homeomorph ϕ₁ (-ϕ₁ a),
  have ϕ_obv : ϕ₂ = shifted_chart_to_local_homeomorph ϕ₁ (-ϕ₁ a) := rfl,
  let ψ₂ := shifted_chart_to_local_homeomorph ψ₁ (-ψ₁ (f a)),
  have ψ_obv : ψ₂ = shifted_chart_to_local_homeomorph ψ₁ (-ψ₁ (f a)) := rfl,
  let ϕ₃ := ϕ₂.restr (f⁻¹' ψ₂.to_local_equiv.source),
  have ϕ_obv' : ϕ₃ = ϕ₂.restr (f⁻¹' ψ₂.to_local_equiv.source) := rfl,
  use [ϕ₃, ψ₂],
  split,
  {
    rw local_homeomorph.restr_source' ϕ₂ _,
    have trivial₀ : a ∈ f⁻¹' ψ₂.to_local_equiv.source := mem_chart_source ℂ (f a),
    rw [ϕ_obv, shifted_source' ϕ₁ (-ϕ₁ a)],
    exact ⟨mem_chart_source ℂ a, trivial₀⟩,
    exact is_open.preimage hf ψ₂.open_source,
  },
  {
    split,
    {
      exact calc ϕ₃ a = (ϕ₂.restr (f⁻¹' ψ₂.to_local_equiv.source)) a : by rw ϕ_obv'
        ... = ϕ₂ a : by rw ϕ₂.restr_apply _
        ... = shifted_chart_to_local_homeomorph ϕ₁ (-ϕ₁ a) a : by rw ϕ_obv
        ... = (shifted_chart_to_local_homeomorph ϕ₁ (-ϕ₁ a)).to_local_equiv.to_fun a : by rw ← local_homeomorph.to_fun_eq_coe
        ... = ϕ₁ a + (-ϕ₁ a) : by rw shifted_to_fun'
        ... = 0 : by ring,
    },
    {
      split,
      {
        rw [ψ_obv, shifted_source'],
        exact mem_chart_source ℂ (f a),
      },
      {
        split,
        {
          exact calc ψ₂ (f a) = (shifted_chart_to_local_homeomorph ψ₁ $ -ψ₁ (f a)) (f a) : by rw ψ_obv
            ... = (shifted_chart_to_local_homeomorph ψ₁ $ -ψ₁ (f a)).to_local_equiv.to_fun (f a) : by rw ← local_homeomorph.to_fun_eq_coe
            ... = ψ₁ (f a) + (-ψ₁ (f a)) : by rw shifted_to_fun'
            ... = 0 : by ring,
        },
        {
          intros v hv,
          rw local_homeomorph.restr_source' _ _ (is_open.preimage hf ψ₂.open_source) at hv,
          rcases hv with ⟨v', hv'⟩,
          rw ← hv'.2,
          exact hv'.1.2,
        },
      },
    },
  },
end

--- Unfinished
lemma local_behavior_of_mholomorph
{f : X → Y} (hf : mholomorph f) (a : X)
(h_non_const : ∀ x, ∃ y, ¬ f x = f y):
∃ (ϕ : local_homeomorph X ℂ) (ψ : local_homeomorph Y ℂ),
a ∈ ϕ.to_local_equiv.source ∧ ϕ a = 0 ∧
f a ∈ ψ.to_local_equiv.source ∧ ψ (f a) = 0 ∧
f '' ϕ.to_local_equiv.source ⊆ ψ.to_local_equiv.source ∧
∃ (k : ℕ) (hk : k ≥ 1), ∀ (v : ℂ), v ∈ ϕ.to_local_equiv.target →
(ψ ∘ f ∘ ϕ.symm) v = v ^ k :=
begin
  rcases chart_at_origin_of_fun_at hf.1 a with ⟨ϕ₁, ψ, h₁, h₂, h₃, h₄, h₅⟩,
  /-
  TODO
  -/
  sorry,
end


import .S4_defs .data
open nnf prod list

namespace prod

universe u

def measure_lex {α : Sort u} : (α → ℕ × ℕ) → α → α → Prop :=
inv_image $ lex (<) (<)

def measure_lex' {α : Sort u} : (α → ℕ × ℕ × ℕ) → α → α → Prop :=
inv_image $ lex (<) (measure_lex (λ x, x))

def measure_lex_wf {α : Sort u} (f : α → ℕ × ℕ) : well_founded (measure_lex f) :=
inv_image.wf f (lex_wf nat.lt_wf nat.lt_wf)

def measure_lex_wf' {α : Sort u} (f : α → ℕ × ℕ × ℕ) : well_founded (measure_lex' f) :=
inv_image.wf f (lex_wf nat.lt_wf (measure_lex_wf (λ x, x)))

end prod

def sseqt_size (s : sseqt) : ℕ × ℕ × ℕ :=
((closure s.goal).length - s.b.length,
 (closure s.goal).length - s.h.length,
 node_size s.m)

instance : has_well_founded sseqt :=
⟨prod.measure_lex' sseqt_size, prod.measure_lex_wf' sseqt_size⟩

lemma size_erase_add_eq_size_sum {φ} : Π (Γ : list nnf) (h : φ ∈ Γ), node_size (Γ.erase φ) + sizeof φ = node_size Γ
| [] h := absurd h $ not_mem_nil _
| (hd :: tl) h :=
begin
  by_cases eq : φ = hd,
  {dsimp [list.erase], rw if_pos, rw eq, apply add_comm, rw eq},
  {dsimp [list.erase], rw if_neg, dsimp, rw [add_assoc],   have : node_size (list.erase tl φ) + sizeof φ = node_size tl,
    {apply size_erase_add_eq_size_sum, cases h, contradiction, assumption},
    rw this, intro h', rw h' at eq, contradiction}
end

theorem split_lt_and_size {φ ψ} (Γ : list nnf) (h : nnf.and φ ψ ∈ Γ) :
node_size (φ :: ψ :: Γ.erase (nnf.and φ ψ)) < node_size Γ :=
begin
  dsimp [node_size],
  rw ←size_erase_add_eq_size_sum Γ,
  swap, exact h,
  rw [←add_assoc, add_comm],
  apply add_lt_add_left, dsimp [sizeof, has_sizeof.sizeof, nnf.sizeof],
  rw [add_assoc],
  rw [nat.one_add],
  apply nat.lt_succ_self
end

theorem split_lt_and_seqt {φ ψ} (Γ : sseqt) (h : nnf.and φ ψ ∈ Γ.m) :
prod.measure_lex' sseqt_size
(and_child Γ h) Γ :=
begin
  right, right,
  simp only [and_child],
  apply split_lt_and_size _ h
end

theorem split_lt_or_size_left {φ ψ} (Γ : list nnf) (h : nnf.or φ ψ ∈ Γ) :
node_size (φ :: Γ.erase (nnf.or φ ψ)) < node_size Γ :=
begin
  dsimp,
  rw ←size_erase_add_eq_size_sum Γ,
  swap, exact h,
  rw [add_comm],
  apply add_lt_add_left, dsimp [sizeof, has_sizeof.sizeof, nnf.sizeof],
  rw [add_comm, ←add_assoc],
  apply nat.lt_add_of_pos_left,
  apply nat.succ_pos
end

theorem split_lt_or_size_right {φ ψ} (Γ : list nnf) (h : nnf.or φ ψ ∈ Γ) :
node_size (ψ :: Γ.erase (nnf.or φ ψ)) < node_size Γ :=
begin
  dsimp,
  rw ←size_erase_add_eq_size_sum Γ,
  swap, exact h,
  rw [add_comm],
  apply add_lt_add_left, dsimp [sizeof, has_sizeof.sizeof, nnf.sizeof],
  apply nat.lt_add_of_pos_left,
  rw nat.one_add,
  apply nat.succ_pos
end

theorem split_lt_or_seqt_left {φ ψ} (Γ : sseqt) (h : nnf.or φ ψ ∈ Γ.m) :
prod.measure_lex' sseqt_size (or_child_left Γ h) Γ :=
begin
  right, right,
  simp only [or_child_left],
  apply split_lt_or_size_left _ h
end

theorem split_lt_or_seqt_right {φ ψ} (Γ : sseqt) (h : nnf.or φ ψ ∈ Γ.m) :
prod.measure_lex' sseqt_size (or_child_right Γ h) Γ :=
begin
  right, right,
  simp only [or_child_right],
  apply split_lt_or_size_right _ h
end

theorem copy_lt_size {φ} (Γ : list nnf) (h : nnf.box φ ∈ Γ) :
node_size (φ :: Γ.erase (nnf.box φ)) < node_size Γ :=
begin
  dsimp [node_size],
  rw ←size_erase_add_eq_size_sum Γ,
  swap, exact h,
  rw [add_comm], simp [sizeof,has_sizeof.sizeof, nnf.sizeof]
end

theorem copy_lt_seqt {φ} (Γ : sseqt) (h : nnf.box φ ∈ Γ.m) :
prod.measure_lex' sseqt_size (box_child Γ h) Γ :=
begin
  right, right,
  simp only [box_child],
  apply copy_lt_size _ h
end

theorem box_new_lt_seqt {φ} (Γ : sseqt)
(h₁ : nnf.box φ ∈ Γ.m) (h₂ : nnf.box φ ∉ Γ.b) :
prod.measure_lex' sseqt_size (box_child_new Γ h₁ h₂) Γ :=
begin
  left,
  apply length_sub_lt_of_nodup_subperm,
  {dsimp [box_child_new], exact Γ.spb},
  {dsimp [box_child_new], apply Γ.sbm, exact h₁},
  {exact h₂},
  {exact Γ.ndb}
end


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Markus Himmel
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.homology.chain_complex
import Mathlib.algebra.homology.image_to_kernel_map
import Mathlib.PostPort

universes u v

namespace Mathlib

/-!
# (Co)homology groups for complexes

We setup that part of the theory of homology groups which works in
any category with kernels and images.

We define the homology groups themselves, and show that they induce maps on kernels.

Under the additional assumption that our category has equalizers and functorial images, we construct
induced morphisms on images and functorial induced morphisms in homology.

## Chains and cochains

Throughout we work with complexes graded by an arbitrary `[add_comm_group β]`,
with a differential with grading `b : β`.
Thus we're simultaneously doing homology and cohomology groups
(and in future, e.g., enabling computing homologies for successive pages of spectral sequences).

At the end of the file we set up abbreviations `cohomology` and `graded_cohomology`,
so that when you're working with a `C : cochain_complex V`, you can write `C.cohomology i`
rather than the confusing `C.homology i`.
-/

namespace homological_complex

/-- The map induced by a chain map between the kernels of the differentials. -/
def kernel_map {V : Type u} [category_theory.category V]
    [category_theory.limits.has_zero_morphisms V] {β : Type} [add_comm_group β] {b : β}
    [category_theory.limits.has_kernels V] {C : homological_complex V b}
    {C' : homological_complex V b} (f : C ⟶ C') (i : β) :
    category_theory.limits.kernel (category_theory.differential_object.d C i) ⟶
        category_theory.limits.kernel (category_theory.differential_object.d C' i) :=
  category_theory.limits.kernel.lift (category_theory.differential_object.d C' i)
    (category_theory.limits.kernel.ι (category_theory.differential_object.d C i) ≫
      category_theory.differential_object.hom.f f i)
    sorry

@[simp] theorem kernel_map_condition {V : Type u} [category_theory.category V]
    [category_theory.limits.has_zero_morphisms V] {β : Type} [add_comm_group β] {b : β}
    [category_theory.limits.has_kernels V] {C : homological_complex V b}
    {C' : homological_complex V b} (f : C ⟶ C') (i : β) :
    kernel_map f i ≫ category_theory.limits.kernel.ι (category_theory.differential_object.d C' i) =
        category_theory.limits.kernel.ι (category_theory.differential_object.d C i) ≫
          category_theory.differential_object.hom.f f i :=
  sorry

@[simp] theorem kernel_map_id {V : Type u} [category_theory.category V]
    [category_theory.limits.has_zero_morphisms V] {β : Type} [add_comm_group β] {b : β}
    [category_theory.limits.has_kernels V] (C : homological_complex V b) (i : β) :
    kernel_map 𝟙 i = 𝟙 :=
  sorry

@[simp] theorem kernel_map_comp {V : Type u} [category_theory.category V]
    [category_theory.limits.has_zero_morphisms V] {β : Type} [add_comm_group β] {b : β}
    [category_theory.limits.has_kernels V] {C : homological_complex V b}
    {C' : homological_complex V b} {C'' : homological_complex V b} (f : C ⟶ C') (g : C' ⟶ C'')
    (i : β) : kernel_map (f ≫ g) i = kernel_map f i ≫ kernel_map g i :=
  sorry

/-- The kernels of the differentials of a complex form a `β`-graded object. -/
def kernel_functor {V : Type u} [category_theory.category V]
    [category_theory.limits.has_zero_morphisms V] {β : Type} [add_comm_group β] {b : β}
    [category_theory.limits.has_kernels V] :
    homological_complex V b ⥤ category_theory.graded_object β V :=
  category_theory.functor.mk
    (fun (C : homological_complex V b) (i : β) =>
      category_theory.limits.kernel (category_theory.differential_object.d C i))
    fun (X Y : homological_complex V b) (f : X ⟶ Y) (i : β) => kernel_map f i

/-- A morphism of complexes induces a morphism on the images of the differentials in every
    degree. -/
def image_map {V : Type u} [category_theory.category V]
    [category_theory.limits.has_zero_morphisms V] {β : Type} [add_comm_group β] {b : β}
    [category_theory.limits.has_images V] [category_theory.limits.has_image_maps V]
    {C : homological_complex V b} {C' : homological_complex V b} (f : C ⟶ C') (i : β) :
    category_theory.limits.image (category_theory.differential_object.d C i) ⟶
        category_theory.limits.image (category_theory.differential_object.d C' i) :=
  category_theory.limits.image.map (category_theory.arrow.hom_mk' sorry)

@[simp] theorem image_map_ι {V : Type u} [category_theory.category V]
    [category_theory.limits.has_zero_morphisms V] {β : Type} [add_comm_group β] {b : β}
    [category_theory.limits.has_images V] [category_theory.limits.has_image_maps V]
    {C : homological_complex V b} {C' : homological_complex V b} (f : C ⟶ C') (i : β) :
    image_map V _inst_1 _inst_2 β _inst_3 b _inst_4 _inst_5 C C' f i ≫
          category_theory.limits.image.ι (category_theory.differential_object.d C' i) =
        category_theory.limits.image.ι (category_theory.differential_object.d C i) ≫
          category_theory.differential_object.hom.f f (i + b) :=
  category_theory.limits.image.map_hom_mk'_ι
    (Eq.symm (comm_at V _inst_1 _inst_2 β _inst_3 b C C' f i))

/--
The connecting morphism from the image of `d i` to the kernel of `d (i ± 1)`.
-/
def image_to_kernel_map {V : Type u} [category_theory.category V]
    [category_theory.limits.has_zero_morphisms V] {β : Type} [add_comm_group β] {b : β}
    [category_theory.limits.has_images V] [category_theory.limits.has_equalizers V]
    (C : homological_complex V b) (i : β) :
    category_theory.limits.image (category_theory.differential_object.d C i) ⟶
        category_theory.limits.kernel (category_theory.differential_object.d C (i + b)) :=
  category_theory.image_to_kernel_map (category_theory.differential_object.d C i)
    (category_theory.differential_object.d C (i + b)) sorry

@[simp] theorem image_to_kernel_map_condition {V : Type u} [category_theory.category V]
    [category_theory.limits.has_zero_morphisms V] {β : Type} [add_comm_group β] {b : β}
    [category_theory.limits.has_images V] [category_theory.limits.has_equalizers V]
    (C : homological_complex V b) (i : β) :
    image_to_kernel_map V _inst_1 _inst_2 β _inst_3 b _inst_4 _inst_5 C i ≫
          category_theory.limits.kernel.ι (category_theory.differential_object.d C (i + b)) =
        category_theory.limits.image.ι (category_theory.differential_object.d C i) :=
  sorry

theorem image_to_kernel_map_comp_kernel_map {V : Type u} [category_theory.category V]
    [category_theory.limits.has_zero_morphisms V] {β : Type} [add_comm_group β] {b : β}
    [category_theory.limits.has_images V] [category_theory.limits.has_equalizers V]
    [category_theory.limits.has_image_maps V] {C : homological_complex V b}
    {C' : homological_complex V b} (f : C ⟶ C') (i : β) :
    image_to_kernel_map V _inst_1 _inst_2 β _inst_3 b _inst_4 _inst_5 C i ≫ kernel_map f (i + b) =
        image_map V _inst_1 _inst_2 β _inst_3 b _inst_4 _inst_6 C C' f i ≫
          image_to_kernel_map V _inst_1 _inst_2 β _inst_3 b _inst_4 _inst_5 C' i :=
  sorry

/-- The `i`-th homology group of the complex `C`. -/
def homology_group {V : Type u} [category_theory.category V]
    [category_theory.limits.has_zero_morphisms V] {β : Type} [add_comm_group β] {b : β}
    [category_theory.limits.has_images V] [category_theory.limits.has_equalizers V]
    [category_theory.limits.has_cokernels V] (i : β) (C : homological_complex V b) : V :=
  category_theory.limits.cokernel
    (image_to_kernel_map V _inst_1 _inst_2 β _inst_3 b _inst_4 _inst_5 C (i - b))

/-- A chain map induces a morphism in homology at every degree. -/
def homology_map {V : Type u} [category_theory.category V]
    [category_theory.limits.has_zero_morphisms V] {β : Type} [add_comm_group β] {b : β}
    [category_theory.limits.has_images V] [category_theory.limits.has_equalizers V]
    [category_theory.limits.has_cokernels V] [category_theory.limits.has_image_maps V]
    {C : homological_complex V b} {C' : homological_complex V b} (f : C ⟶ C') (i : β) :
    homology_group V _inst_1 _inst_2 β _inst_3 b _inst_4 _inst_5 _inst_6 i C ⟶
        homology_group V _inst_1 _inst_2 β _inst_3 b _inst_4 _inst_5 _inst_6 i C' :=
  category_theory.limits.cokernel.desc
    (image_to_kernel_map V _inst_1 _inst_2 β _inst_3 b _inst_4 _inst_5 C (i - b))
    (kernel_map f (i - b + b) ≫
      category_theory.limits.cokernel.π
        (image_to_kernel_map V _inst_1 _inst_2 β _inst_3 b _inst_4 _inst_5 C' (i - b)))
    sorry

@[simp] theorem homology_map_condition {V : Type u} [category_theory.category V]
    [category_theory.limits.has_zero_morphisms V] {β : Type} [add_comm_group β] {b : β}
    [category_theory.limits.has_images V] [category_theory.limits.has_equalizers V]
    [category_theory.limits.has_cokernels V] [category_theory.limits.has_image_maps V]
    {C : homological_complex V b} {C' : homological_complex V b} (f : C ⟶ C') (i : β) :
    category_theory.limits.cokernel.π
            (image_to_kernel_map V _inst_1 _inst_2 β _inst_3 b _inst_4 _inst_5 C (i - b)) ≫
          homology_map ((fun (_x : β) => V) (i - b)) _inst_1 _inst_2 β _inst_3 b _inst_4 _inst_5
            _inst_6 _inst_7 C C' f i =
        kernel_map f (i - b + b) ≫
          category_theory.limits.cokernel.π
            (image_to_kernel_map ((fun (_x : β) => V) (i - b)) _inst_1 _inst_2 β _inst_3 b _inst_4
              _inst_5 C' (i - b)) :=
  sorry

@[simp] theorem homology_map_id {V : Type u} [category_theory.category V]
    [category_theory.limits.has_zero_morphisms V] {β : Type} [add_comm_group β] {b : β}
    [category_theory.limits.has_images V] [category_theory.limits.has_equalizers V]
    [category_theory.limits.has_cokernels V] [category_theory.limits.has_image_maps V]
    (C : homological_complex V b) (i : β) :
    homology_map V _inst_1 _inst_2 β _inst_3 b _inst_4 _inst_5 _inst_6 _inst_7 C C 𝟙 i = 𝟙 :=
  sorry

@[simp] theorem homology_map_comp {V : Type u} [category_theory.category V]
    [category_theory.limits.has_zero_morphisms V] {β : Type} [add_comm_group β] {b : β}
    [category_theory.limits.has_images V] [category_theory.limits.has_equalizers V]
    [category_theory.limits.has_cokernels V] [category_theory.limits.has_image_maps V]
    {C : homological_complex V b} {C' : homological_complex V b} {C'' : homological_complex V b}
    (f : C ⟶ C') (g : C' ⟶ C'') (i : β) :
    homology_map V _inst_1 _inst_2 β _inst_3 b _inst_4 _inst_5 _inst_6 _inst_7 C C'' (f ≫ g) i =
        homology_map V _inst_1 _inst_2 β _inst_3 b _inst_4 _inst_5 _inst_6 _inst_7 C C' f i ≫
          homology_map V _inst_1 _inst_2 β _inst_3 b _inst_4 _inst_5 _inst_6 _inst_7 C' C'' g i :=
  sorry

/-- The `i`-th homology functor from `β` graded complexes to `V`. -/
def homology (V : Type u) [category_theory.category V] [category_theory.limits.has_zero_morphisms V]
    {β : Type} [add_comm_group β] {b : β} [category_theory.limits.has_images V]
    [category_theory.limits.has_equalizers V] [category_theory.limits.has_cokernels V]
    [category_theory.limits.has_image_maps V] (i : β) : homological_complex V b ⥤ V :=
  category_theory.functor.mk
    (fun (C : homological_complex V b) =>
      homology_group V _inst_1 _inst_2 β _inst_3 b _inst_4 _inst_5 _inst_6 i C)
    fun (C C' : homological_complex V b) (f : C ⟶ C') =>
      homology_map V _inst_1 _inst_2 β _inst_3 b _inst_4 _inst_5 _inst_6 _inst_7 C C' f i

/-- The homology functor from `β` graded complexes to `β` graded objects in `V`. -/
def graded_homology (V : Type u) [category_theory.category V]
    [category_theory.limits.has_zero_morphisms V] {β : Type} [add_comm_group β] {b : β}
    [category_theory.limits.has_images V] [category_theory.limits.has_equalizers V]
    [category_theory.limits.has_cokernels V] [category_theory.limits.has_image_maps V] :
    homological_complex V b ⥤ category_theory.graded_object β V :=
  category_theory.functor.mk
    (fun (C : homological_complex V b) (i : β) =>
      homology_group V _inst_1 _inst_2 β _inst_3 b _inst_4 _inst_5 _inst_6 i C)
    fun (C C' : homological_complex V b) (f : C ⟶ C') (i : β) =>
      homology_map ((fun (_x : β) => V) i) _inst_1 _inst_2 β _inst_3 b _inst_4 _inst_5 _inst_6
        _inst_7 C C' f i

end homological_complex

/-!
We now set up abbreviations so that you can write `C.cohomology i` or `(graded_cohomology V).map f`,
etc., when `C` is a cochain complex.
-/

namespace cochain_complex

/-- The `i`-th cohomology group of the cochain complex `C`. -/
def cohomology_group {V : Type u} [category_theory.category V]
    [category_theory.limits.has_zero_morphisms V] [category_theory.limits.has_images V]
    [category_theory.limits.has_equalizers V] [category_theory.limits.has_cokernels V]
    (C : cochain_complex V) (i : ℤ) : V :=
  homological_complex.homology_group V _inst_1 _inst_2 ℤ
    (linear_ordered_add_comm_group.to_add_comm_group ℤ) 1 _inst_4 _inst_5 _inst_6 i C

/-- A chain map induces a morphism in cohomology at every degree. -/
def cohomology_map {V : Type u} [category_theory.category V]
    [category_theory.limits.has_zero_morphisms V] [category_theory.limits.has_images V]
    [category_theory.limits.has_equalizers V] [category_theory.limits.has_cokernels V]
    [category_theory.limits.has_image_maps V] {C : cochain_complex V} {C' : cochain_complex V}
    (f : C ⟶ C') (i : ℤ) :
    cohomology_group V _inst_1 _inst_2 _inst_4 _inst_5 _inst_6 C i ⟶
        cohomology_group V _inst_1 _inst_2 _inst_4 _inst_5 _inst_6 C' i :=
  homological_complex.homology_map V _inst_1 _inst_2 ℤ
    (linear_ordered_add_comm_group.to_add_comm_group ℤ) 1 _inst_4 _inst_5 _inst_6 _inst_7 C C' f i

/-- The `i`-th homology functor from cohain complexes to `V`. -/
def cohomology (V : Type u) [category_theory.category V]
    [category_theory.limits.has_zero_morphisms V] [category_theory.limits.has_images V]
    [category_theory.limits.has_equalizers V] [category_theory.limits.has_cokernels V]
    [category_theory.limits.has_image_maps V] (i : ℤ) : cochain_complex V ⥤ V :=
  homological_complex.homology V _inst_1 _inst_2 ℤ
    (linear_ordered_add_comm_group.to_add_comm_group ℤ) 1 _inst_4 _inst_5 _inst_6 _inst_7 i

/-- The cohomology functor from cochain complexes to `ℤ`-graded objects in `V`. -/
def graded_cohomology (V : Type u) [category_theory.category V]
    [category_theory.limits.has_zero_morphisms V] [category_theory.limits.has_images V]
    [category_theory.limits.has_equalizers V] [category_theory.limits.has_cokernels V]
    [category_theory.limits.has_image_maps V] :
    cochain_complex V ⥤ category_theory.graded_object ℤ V :=
  homological_complex.graded_homology V _inst_1 _inst_2 ℤ
    (linear_ordered_add_comm_group.to_add_comm_group ℤ) 1 _inst_4 _inst_5 _inst_6 _inst_7

end Mathlib


/-
Copyright (c) 2022. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Yuma Mizuno, Oleksandr Manzyuk
-/
import category_theory.monoidal.free.coherence
import category_theory.bicategory.coherence_tactic

/-!
# A `coherence` tactic for monoidal categories, and `⊗≫` (composition up to associators)

We provide a `coherence` tactic,
which proves equations where the two sides differ by replacing
strings of monoidal structural morphisms with other such strings.
(The replacements are always equalities by the monoidal coherence theorem.)

A simpler version of this tactic is `pure_coherence`,
which proves that any two morphisms (with the same source and target)
in a monoidal category which are built out of associators and unitors
are equal.

We also provide `f ⊗≫ g`, the `monoidal_comp` operation,
which automatically inserts associators and unitors as needed
to make the target of `f` match the source of `g`.
-/

noncomputable theory

universes v u

open category_theory
open category_theory.free_monoidal_category

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

namespace category_theory.monoidal_category

/-- A typeclass carrying a choice of lift of an object from `C` to `free_monoidal_category C`. -/
class lift_obj (X : C) :=
(lift : free_monoidal_category C)

instance lift_obj_unit : lift_obj (𝟙_ C) := { lift := unit, }
instance lift_obj_tensor (X Y : C) [lift_obj X] [lift_obj Y] : lift_obj (X ⊗ Y) :=
{ lift := lift_obj.lift X ⊗ lift_obj.lift Y, }
@[priority 100]
instance lift_obj_of (X : C) : lift_obj X := { lift := of X, }

/-- A typeclass carrying a choice of lift of a morphism from `C` to `free_monoidal_category C`. -/
class lift_hom {X Y : C} [lift_obj X] [lift_obj Y] (f : X ⟶ Y) :=
(lift : lift_obj.lift X ⟶ lift_obj.lift Y)

instance lift_hom_id (X : C) [lift_obj X] : lift_hom (𝟙 X) :=
{ lift := 𝟙 _, }
instance lift_hom_left_unitor_hom (X : C) [lift_obj X] : lift_hom (λ_ X).hom :=
{ lift := (λ_ (lift_obj.lift X)).hom, }
instance lift_hom_left_unitor_inv (X : C) [lift_obj X] : lift_hom (λ_ X).inv :=
{ lift := (λ_ (lift_obj.lift X)).inv, }
instance lift_hom_right_unitor_hom (X : C) [lift_obj X] : lift_hom (ρ_ X).hom :=
{ lift := (ρ_ (lift_obj.lift X)).hom, }
instance lift_hom_right_unitor_inv (X : C) [lift_obj X] : lift_hom (ρ_ X).inv :=
{ lift := (ρ_ (lift_obj.lift X)).inv, }
instance lift_hom_associator_hom (X Y Z : C) [lift_obj X] [lift_obj Y] [lift_obj Z] :
  lift_hom (α_ X Y Z).hom :=
{ lift := (α_ (lift_obj.lift X) (lift_obj.lift Y) (lift_obj.lift Z)).hom, }
instance lift_hom_associator_inv (X Y Z : C) [lift_obj X] [lift_obj Y] [lift_obj Z] :
  lift_hom (α_ X Y Z).inv :=
{ lift := (α_ (lift_obj.lift X) (lift_obj.lift Y) (lift_obj.lift Z)).inv, }
instance lift_hom_comp {X Y Z : C} [lift_obj X] [lift_obj Y] [lift_obj Z] (f : X ⟶ Y) (g : Y ⟶ Z)
  [lift_hom f] [lift_hom g] : lift_hom (f ≫ g) :=
{ lift := lift_hom.lift f ≫ lift_hom.lift g }
instance lift_hom_tensor {W X Y Z : C} [lift_obj W] [lift_obj X] [lift_obj Y] [lift_obj Z]
  (f : W ⟶ X) (g : Y ⟶ Z) [lift_hom f] [lift_hom g] : lift_hom (f ⊗ g) :=
{ lift := lift_hom.lift f ⊗ lift_hom.lift g }

/--
A typeclass carrying a choice of monoidal structural isomorphism between two objects.
Used by the `⊗≫` monoidal composition operator, and the `coherence` tactic.
-/
-- We could likely turn this into a `Prop` valued existential if that proves useful.
class monoidal_coherence (X Y : C) [lift_obj X] [lift_obj Y] :=
(hom [] : X ⟶ Y)
[is_iso : is_iso hom . tactic.apply_instance]

attribute [instance] monoidal_coherence.is_iso

namespace monoidal_coherence

@[simps]
instance refl (X : C) [lift_obj X] : monoidal_coherence X X := ⟨𝟙 _⟩

@[simps]
instance tensor (X Y Z : C) [lift_obj X] [lift_obj Y] [lift_obj Z] [monoidal_coherence Y Z] :
  monoidal_coherence (X ⊗ Y) (X ⊗ Z) :=
⟨𝟙 X ⊗ monoidal_coherence.hom Y Z⟩

@[simps]
instance tensor_right (X Y : C) [lift_obj X] [lift_obj Y] [monoidal_coherence (𝟙_ C) Y] :
  monoidal_coherence X (X ⊗ Y) :=
⟨(ρ_ X).inv ≫ (𝟙 X ⊗ monoidal_coherence.hom (𝟙_ C) Y)⟩

@[simps]
instance tensor_right' (X Y : C) [lift_obj X] [lift_obj Y] [monoidal_coherence Y (𝟙_ C)] :
  monoidal_coherence (X ⊗ Y) X :=
⟨(𝟙 X ⊗ monoidal_coherence.hom Y (𝟙_ C)) ≫ (ρ_ X).hom⟩

@[simps]
instance left (X Y : C) [lift_obj X] [lift_obj Y] [monoidal_coherence X Y] :
  monoidal_coherence (𝟙_ C ⊗ X) Y :=
⟨(λ_ X).hom ≫ monoidal_coherence.hom X Y⟩

@[simps]
instance left' (X Y : C) [lift_obj X] [lift_obj Y] [monoidal_coherence X Y] :
  monoidal_coherence X (𝟙_ C ⊗ Y) :=
⟨monoidal_coherence.hom X Y ≫ (λ_ Y).inv⟩

@[simps]
instance right (X Y : C) [lift_obj X] [lift_obj Y] [monoidal_coherence X Y] :
  monoidal_coherence (X ⊗ 𝟙_ C) Y :=
⟨(ρ_ X).hom ≫ monoidal_coherence.hom X Y⟩

@[simps]
instance right' (X Y : C) [lift_obj X] [lift_obj Y] [monoidal_coherence X Y] :
  monoidal_coherence X (Y ⊗ 𝟙_ C) :=
⟨monoidal_coherence.hom X Y ≫ (ρ_ Y).inv⟩

@[simps]
instance assoc (X Y Z W : C) [lift_obj W] [lift_obj X] [lift_obj Y] [lift_obj Z]
  [monoidal_coherence (X ⊗ (Y ⊗ Z)) W] : monoidal_coherence ((X ⊗ Y) ⊗ Z) W :=
⟨(α_ X Y Z).hom ≫ monoidal_coherence.hom (X ⊗ (Y ⊗ Z)) W⟩

@[simps]
instance assoc' (W X Y Z : C) [lift_obj W] [lift_obj X] [lift_obj Y] [lift_obj Z]
  [monoidal_coherence W (X ⊗ (Y ⊗ Z))] : monoidal_coherence W ((X ⊗ Y) ⊗ Z) :=
⟨monoidal_coherence.hom W (X ⊗ (Y ⊗ Z)) ≫ (α_ X Y Z).inv⟩

end monoidal_coherence

/-- Construct an isomorphism between two objects in a monoidal category
out of unitors and associators. -/
def monoidal_iso (X Y : C) [lift_obj X] [lift_obj Y] [monoidal_coherence X Y] : X ≅ Y :=
as_iso (monoidal_coherence.hom X Y)

example (X : C) : X ≅ (X ⊗ (𝟙_ C ⊗ 𝟙_ C)) := monoidal_iso _ _

example (X1 X2 X3 X4 X5 X6 X7 X8 X9 : C) :
  (𝟙_ C ⊗ (X1 ⊗ X2 ⊗ ((X3 ⊗ X4) ⊗ X5)) ⊗ X6 ⊗ (X7 ⊗ X8 ⊗ X9)) ≅
  (X1 ⊗ (X2 ⊗ X3) ⊗ X4 ⊗ (X5 ⊗ (𝟙_ C ⊗ X6) ⊗ X7) ⊗ X8 ⊗ X9) :=
monoidal_iso _ _

/-- Compose two morphisms in a monoidal category,
inserting unitors and associators between as necessary. -/
def monoidal_comp {W X Y Z : C} [lift_obj X] [lift_obj Y]
  [monoidal_coherence X Y] (f : W ⟶ X) (g : Y ⟶ Z) : W ⟶ Z :=
f ≫ monoidal_coherence.hom X Y ≫ g

infixr ` ⊗≫ `:80 := monoidal_comp -- type as \ot \gg

/-- Compose two isomorphisms in a monoidal category,
inserting unitors and associators between as necessary. -/
def monoidal_iso_comp {W X Y Z : C} [lift_obj X] [lift_obj Y]
  [monoidal_coherence X Y] (f : W ≅ X) (g : Y ≅ Z) : W ≅ Z :=
f ≪≫ as_iso (monoidal_coherence.hom X Y) ≪≫ g

infixr ` ≪⊗≫ `:80 := monoidal_iso_comp -- type as \ot \gg

example {U V W X Y : C} (f : U ⟶ V ⊗ (W ⊗ X)) (g : (V ⊗ W) ⊗ X ⟶ Y) : U ⟶ Y := f ⊗≫ g

-- To automatically insert unitors/associators at the beginning or end,
-- you can use `f ⊗≫ 𝟙 _`
example {W X Y Z : C} (f : W ⟶ (X ⊗ Y) ⊗ Z) : W ⟶ X ⊗ (Y ⊗ Z) := f ⊗≫ 𝟙 _

@[simp] lemma monoidal_comp_refl {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) :
  f ⊗≫ g = f ≫ g :=
by { dsimp [monoidal_comp], simp, }

example {U V W X Y : C} (f : U ⟶ V ⊗ (W ⊗ X)) (g : (V ⊗ W) ⊗ X ⟶ Y) :
  f ⊗≫ g = f ≫ (α_ _ _ _).inv ≫ g :=
by simp [monoidal_comp]

end category_theory.monoidal_category

open category_theory.monoidal_category

namespace tactic

open tactic
setup_tactic_parser

/--
Auxilliary definition of `monoidal_coherence`,
being careful with namespaces to avoid shadowing.
-/
meta def mk_project_map_expr (e : expr) : tactic expr :=
  to_expr ``(category_theory.free_monoidal_category.project_map _root_.id _ _
    (category_theory.monoidal_category.lift_hom.lift %%e))

/-- Coherence tactic for monoidal categories. -/
meta def monoidal_coherence : tactic unit :=
do
  o ← get_options, set_options $ o.set_nat `class.instance_max_depth 128,
  try `[dsimp],
  `(%%lhs = %%rhs) ← target,
  project_map_lhs ← mk_project_map_expr lhs,
  project_map_rhs ← mk_project_map_expr rhs,
  to_expr  ``(%%project_map_lhs = %%project_map_rhs) >>= tactic.change,
  congr

/--
`pure_coherence` uses the coherence theorem for monoidal categories to prove the goal.
It can prove any equality made up only of associators, unitors, and identities.
```lean
example {C : Type} [category C] [monoidal_category C] :
  (λ_ (𝟙_ C)).hom = (ρ_ (𝟙_ C)).hom :=
by pure_coherence
```

Users will typicall just use the `coherence` tactic, which can also cope with identities of the form
`a ≫ f ≫ b ≫ g ≫ c = a' ≫ f ≫ b' ≫ g ≫ c'`
where `a = a'`, `b = b'`, and `c = c'` can be proved using `pure_coherence`
-/
meta def pure_coherence : tactic unit := monoidal_coherence <|> bicategorical_coherence

example (X₁ X₂ : C) :
  ((λ_ (𝟙_ C)).inv ⊗ 𝟙 (X₁ ⊗ X₂)) ≫ (α_ (𝟙_ C) (𝟙_ C) (X₁ ⊗ X₂)).hom ≫
    (𝟙 (𝟙_ C) ⊗ (α_ (𝟙_ C) X₁ X₂).inv) =
  𝟙 (𝟙_ C) ⊗ ((λ_ X₁).inv ⊗ 𝟙 X₂) :=
by pure_coherence

namespace coherence

/--
Auxiliary simp lemma for the `coherence` tactic:
this moves brackets to the left in order to expose a maximal prefix
built out of unitors and associators.
-/
-- We have unused typeclass arguments here.
-- They are intentional, to ensure that `simp only [assoc_lift_hom]` only left associates
-- monoidal structural morphisms.
@[nolint unused_arguments]
lemma assoc_lift_hom {W X Y Z : C} [lift_obj W] [lift_obj X] [lift_obj Y]
  (f : W ⟶ X) (g : X ⟶ Y) (h : Y ⟶ Z) [lift_hom f] [lift_hom g] :
  f ≫ (g ≫ h) = (f ≫ g) ≫ h :=
(category.assoc _ _ _).symm

/--
Internal tactic used in `coherence`.

Rewrites an equation `f = g` as `f₀ ≫ f₁ = g₀ ≫ g₁`,
where `f₀` and `g₀` are maximal prefixes of `f` and `g` (possibly after reassociating)
which are "liftable" (i.e. expressible as compositions of unitors and associators).
-/
meta def liftable_prefixes : tactic unit :=
do
  o ← get_options, set_options $ o.set_nat `class.instance_max_depth 128,
  try `[simp only [monoidal_comp, category_theory.category.assoc]] >>
    `[apply (cancel_epi (𝟙 _)).1; try { apply_instance }] >>
    try `[simp only [tactic.coherence.assoc_lift_hom, tactic.bicategory.coherence.assoc_lift_hom₂]]

example {W X Y Z : C} (f : Y ⟶ Z) (g) (w : false) : (λ_ _).hom ≫ f = g :=
begin
  liftable_prefixes,
  guard_target (𝟙 _ ≫ (λ_ _).hom) ≫ f = (𝟙 _) ≫ g,
  cases w,
end

lemma insert_id_lhs {C : Type*} [category C] {X Y : C} (f g : X ⟶ Y) (w : f ≫ 𝟙 _ = g) : f = g :=
by simpa using w
lemma insert_id_rhs {C : Type*} [category C] {X Y : C} (f g : X ⟶ Y) (w : f = g ≫ 𝟙 _) : f = g :=
by simpa using w

end coherence

open coherence

/-- The main part of `coherence` tactic. -/
meta def coherence_loop : tactic unit :=
do
  -- To prove an equality `f = g` in a monoidal category,
  -- first try the `pure_coherence` tactic on the entire equation:
  pure_coherence <|> do
  -- Otherwise, rearrange so we have a maximal prefix of each side
  -- that is built out of unitors and associators:
  liftable_prefixes <|>
    fail ("Something went wrong in the `coherence` tactic: " ++
      "is the target an equation in a monoidal category?"),
  -- The goal should now look like `f₀ ≫ f₁ = g₀ ≫ g₁`,
  tactic.congr_core',
  -- and now we have two goals `f₀ = g₀` and `f₁ = g₁`.
  -- Discharge the first using `coherence`,
  focus1 pure_coherence <|>
    fail "`coherence` tactic failed, subgoal not true in the free monoidal_category",
  -- Then check that either `g₀` is identically `g₁`,
  reflexivity <|> (do
    -- or that both are compositions,
    (do `(_ ≫ _ = _) ← target, skip) <|> `[apply tactic.coherence.insert_id_lhs],
    (do `(_ = _ ≫ _) ← target, skip) <|> `[apply tactic.coherence.insert_id_rhs],
    `(_ ≫ _ = _ ≫ _) ← target |
      fail "`coherence` tactic failed, non-structural morphisms don't match",
    tactic.congr_core',
    -- with identical first terms,
    reflexivity <|> fail "`coherence` tactic failed, non-structural morphisms don't match",
    -- and whose second terms can be identified by recursively called `coherence`.
    coherence_loop)

/--
Use the coherence theorem for monoidal categories to solve equations in a monoidal equation,
where the two sides only differ by replacing strings of monoidal structural morphisms
(that is, associators, unitors, and identities)
with different strings of structural morphisms with the same source and target.

That is, `coherence` can handle goals of the form
`a ≫ f ≫ b ≫ g ≫ c = a' ≫ f ≫ b' ≫ g ≫ c'`
where `a = a'`, `b = b'`, and `c = c'` can be proved using `pure_coherence`.

(If you have very large equations on which `coherence` is unexpectedly failing,
you may need to increase the typeclass search depth,
using e.g. `set_option class.instance_max_depth 500`.)
-/
meta def coherence : tactic unit :=
do
  try `[simp only [bicategorical_comp]],
  try `[simp only [monoidal_comp]],
  -- TODO: put similar normalization simp lemmas for monoidal categories
  try bicategory.whisker_simps,
  coherence_loop

run_cmd add_interactive [`pure_coherence, `coherence]

add_tactic_doc
{ name        := "coherence",
  category    := doc_category.tactic,
  decl_names  := [`tactic.interactive.coherence],
  tags        := ["category theory"] }

example (f) : (λ_ (𝟙_ C)).hom ≫ f ≫ (λ_ (𝟙_ C)).hom = (ρ_ (𝟙_ C)).hom ≫ f ≫ (ρ_ (𝟙_ C)).hom :=
by coherence

example {U V W X Y : C} (f : U ⟶ V ⊗ (W ⊗ X)) (g : (V ⊗ W) ⊗ X ⟶ Y) :
  f ⊗≫ g = f ≫ (α_ _ _ _).inv ≫ g :=
by coherence

example {U : C} (f : U ⟶ 𝟙_ C) : f ≫ (ρ_ (𝟙_ C)).inv ≫ (λ_ (𝟙_ C)).hom = f :=
by coherence

example (W X Y Z : C) (f) :
  ((α_ W X Y).hom ⊗ 𝟙 Z) ≫ (α_ W (X ⊗ Y) Z).hom ≫ (𝟙 W ⊗ (α_ X Y Z).hom) ≫ f ≫
    (α_ (W ⊗ X) Y Z).hom ≫ (α_ W X (Y ⊗ Z)).hom =
  (α_ (W ⊗ X) Y Z).hom ≫ (α_ W X (Y ⊗ Z)).hom ≫ f ≫
    ((α_ W X Y).hom ⊗ 𝟙 Z) ≫ (α_ W (X ⊗ Y) Z).hom ≫ (𝟙 W ⊗ (α_ X Y Z).hom) :=
by coherence

end tactic


import data.real.basic
import analysis.normed_space.operator_norm
import analysis.normed_space.dual
import data.fin
import algebra.big_operators.basic
import data.finset.intervals

open  continuous_linear_map
open finset opposite

open_locale big_operators

--noncomputable theory
--open_locale classical

notation `|`x`|` := abs x

def seq_limit (u : ℕ → ℝ) (l : ℝ) : Prop :=
∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - l| ≤ ε

variables {X : Type*} [normed_group X] [normed_space ℝ  X] [complete_space X]

def J (x: X) := {j : normed_space.dual ℝ X | j x = ∥x∥^2 ∧ j x = ∥j∥^2}

lemma geom_ineq (x y : X) (j ∈ J(x+y)) : ∥x + y∥^2 ≤ ∥x∥^2 + 2*(j y):=
begin
  unfold J at H,
  rw set.mem_set_of_eq at H,
  have h1 : j x ≤ ∥j∥* ∥x∥,
    begin
      calc (j x: ℝ)  ≤ ∥j x∥ : by exact le_abs_self (j x)
      ... ≤ ∥j∥* ∥x∥ : by {exact le_op_norm j x}
    end,
  have h3: ∥x+y∥^2 = ∥j∥^2,
  cases H,
  calc  ∥x+y∥^2 = j (x+y) : by exact eq.symm H_left
  ...   = ∥j∥^2 : by {exact H_right},
  have h4: ∥x+y∥ = ∥j∥,
  exact (pow_left_inj  (norm_nonneg (x+y)) (norm_nonneg j) (by simp)).1 h3,
 have h5 : ∥x + y∥^2  ≤ ∥x+y∥* ∥x∥ + j y ,
      begin
        calc ∥x + y∥^2 = j(x + y) : by {rw H.1}
        ... = j x + j y : by simp
        ...≤ ∥j∥* ∥x∥ + j y : by exact add_le_add_right h1 (j y)
        ... =   ∥x+y∥* ∥x∥ + j y : by exact congr_arg2 has_add.add (congr_fun (congr_arg has_mul.mul (eq.symm h4)) ∥x∥) rfl
      end,
  have h6 : 0 ≤ (∥x∥ - ∥x+y∥)^2,
  exact sq_nonneg (∥x∥ - ∥x + y∥),
  have h7 : 0 ≤ (∥x∥^2 + ∥x+y∥^2) - ∥x∥*∥x+y∥*(1/2)⁻¹,
  calc 0 ≤ (∥x∥ - ∥x+y∥)^2 : by exact h6
  ... = (∥x∥^2 + ∥x+y∥^2) - ∥x∥*∥x+y∥*(1/2)⁻¹: by ring,
  have h8 : 0 ≤ (∥x∥^2)*(1/2) + (∥x+y∥^2)*(1/2) - ∥x+y∥*∥x∥,
  calc 0 ≤ ((∥x∥^2 + ∥x+y∥^2) - ∥x∥*∥x+y∥*(1/2)⁻¹)*(1/2) : by exact mul_nonneg h7 (by simp)
  ... = (∥x∥^2)*(1/2) + (∥x+y∥^2)*(1/2) - ∥x+y∥*∥x∥: by ring,
  have h9 : ∥x+y∥*∥x∥ ≤ (∥x∥^2)*(1/2) + (∥x+y∥^2)*(1/2),
  exact sub_nonneg.mp h8,
  have h10 : ∥x + y∥^2 ≤ (∥x∥^2)*(1/2) + (∥x+y∥^2)*(1/2) + j y,
  exact le_add_of_le_add_right h5 h9,
  have h11: 0 ≤ (∥x∥^2)*(1/2) + (∥x+y∥^2)*(1/2) + j y - ∥x + y∥^2,
  exact sub_nonneg.mpr h10,
  have h12 : 0 ≤ (∥x∥^2)*(1/2) + j y - (∥x+y∥^2)*(1/2),
  calc  0 ≤ (∥x∥^2)*(1/2) + (∥x+y∥^2)*(1/2) + j y - ∥x + y∥^2 : by exact h11
  ... = (∥x∥^2)*(1/2) + j y - (∥x+y∥^2)*(1/2) : by ring,
  have h13 : 0 ≤ (∥x∥^2) + 2*j y - ∥x+y∥^2,
  calc  0 ≤ ((∥x∥^2)*(1/2) + j y - (∥x+y∥^2)*(1/2))*2 : by exact mul_nonneg h12 (by simp)
  ... = (∥x∥^2) + 2*j y - ∥x+y∥^2 : by ring,
  exact sub_nonneg.mp h13,

end

def Dom (A: X → set X ) := {x : X | A x ≠ ∅ }

def Range (A: X → set X) := {y : X | ∃ x : X, y ∈ A x}

def accretive (A: X → set X) :=∀ x y (u :A x) (v : A y), (∃ j : J(x-y), j(u-v) ≥ 0)

def strong_accretive (ψ: nnreal  → nnreal ) (A: X → set X):= (continuous ψ) ∧ ∀ x y (u :A x) (v : A y),(∃ j : J(x-y), j(u-v) ≥ ψ(real.to_nnreal ∥x-y∥)*∥x - y∥)

def nnseq:= {u : ℕ → ℝ // ∀ (n : ℕ), u n ≥ 0}

def zero_limit := {α : nnseq | seq_limit α.1  0}

def div_sum := {α : nnseq | ¬ summable α.1 }

def RoC (φ: {x: ℝ // x > 0} → ℕ ) (α : nnseq) := ∀ ε : {x: ℝ // x > 0}, ∀ n ≥ φ ε , α.1 n ≤ ε

def RoD (r: ℕ → {x: ℝ // x > 0} → ℕ )(α : nnseq) :=  (∀N:ℕ, ∀x:{x: ℝ // x > 0} ,N ≤ r N x) ∧ ∀(N : ℕ),∀ (x : {x: ℝ // x > 0}),(∑ i in (finset.Ico N ((r N x) + 1)), α.1 i) > x.1

lemma abstract_lemma1 (θ : nnseq )(α : nnseq)(K: {x: ℝ // x > 0}) (r: ℕ → {x: ℝ // x > 0} → ℕ )
(N : {x:ℝ // x > 0 }  → ℕ ) (φ : {x:ℝ // x > 0 }  → {x:ℝ // x > 0 })
(h1 : ∀(n:ℕ), (θ.1 n) < K) (h2: RoD r α)
(h3: ∀ ε : {x:ℝ // x > 0 } , ∀ n ≥ N(ε), (ε:ℝ) < θ.1 (n + 1)  → θ.1 (n + 1) ≤ θ.1 n - (α.1 n)*φ(ε)):
RoC (λ ε : {x: ℝ // x > 0},  (r (N ε) ⟨K/(φ ε), div_pos K.2 (φ ε).2 ⟩+1)) θ  :=
begin
have
H1 : ∀ ε : {x:ℝ // x > 0 },∀ n ≥ N(ε), θ.1 n ≤ ε  → θ.1 (n + 1) ≤ ε,
by_contradiction p1,
push_neg at p1,
cases p1 with ε p2,
cases p2 with n p3,
have p5 : ε < ε,
calc ε.1 < θ.1 (n+1): (p3.2).2
... ≤ θ.1 n - (α.1 n)*φ(ε): h3 ε n p3.1 (p3.2).2
... ≤ θ.1 n : sub_le_self (θ.1 n) (mul_nonneg (α.2 n) (le_of_lt (φ ε).2 ))
... ≤ ε :(p3.2).1,
exact (lt_self_iff_false ε).mp p5,
have H2 : ∀ ε : {x :ℝ // x > 0}, ∃ n ∈ finset.Ico (N ε) ((r (N ε) ⟨↑K / ↑(φ ε), _⟩)+1), θ.1 (n + 1) ≤ ε,
by_contradiction,
push_neg at h,
cases h with ε h,
have H3: ∀ (n : ℕ), n ∈ finset.Ico (N ε) ((r (N ε) ⟨↑K / ↑(φ ε), _⟩) +1) → θ.1 (n + 1) ≤ θ.1 n - (α.1 n)*φ(ε),
intros n h_n,
have h_n1 : N ε ≤ n ,rw mem_Ico at h_n, exact h_n.1, exact div_pos K.2 (φ ε).2,
rw ← ge_iff_le at h_n1, exact h3 ε n h_n1(h n h_n),
have H3':  ∀ (n : ℕ), n ∈ finset.Ico (N ε) ((r (N ε) ⟨↑K / ↑(φ ε), _⟩)+1) → (α.1 n)*φ(ε) ≤ θ.1 n - θ.1 (n + 1),
intros n hn, specialize H3 n hn, rw le_sub, exact H3,
have sum: (∑ i in Ico (N ε) (r (N ε) ⟨↑K / ↑(φ ε), _⟩ +1),(λ i, α.val i * ↑(φ ε))i) ≤
(∑ i in Ico (N ε) ((r (N ε) ⟨↑K / ↑(φ ε), _⟩ +1)),(λ i,θ.val i - θ.val (i + 1))i),
apply sum_le_sum, exact H3',
have split: (∑ i in Ico (N ε) (r (N ε) ⟨↑K / ↑(φ ε), _⟩ +1),(λ i,θ.val i - θ.val (i + 1))i) =
(∑ i in range (r (N ε) ⟨↑K / ↑(φ ε), _⟩ +1),(λ i,θ.val i - θ.val (i + 1))i) -
(∑ i in range (N ε),(λ i,θ.val i - θ.val (i + 1))i),
rw sum_Ico_eq_sub,
have l: N ε ≤ r (N ε) ⟨↑K / ↑(φ ε), _⟩,
exact (h2.1 (N ε)  (⟨↑K / ↑(φ ε), div_pos K.2 (φ ε).2⟩ )),exact le_add_right l,
rw split at sum,
rw sum_range_sub' at sum, rw sum_range_sub' at sum, simp at sum,
have p: ∑ (x : ℕ) in Ico (N ε) (r (N ε) ⟨↑K / ↑(φ ε), _⟩ + 1), α.1 x * ↑(φ ε)< K,
have w: θ.1 (r (N ε) ⟨↑K / ↑(φ ε), _⟩ +1) ≥ 0, exact θ.2 (r (N ε) ⟨↑K / ↑(φ ε) , div_pos K.2 (φ ε).2⟩+1 ),
calc ∑ (x : ℕ) in Ico (N ε) (r (N ε) ⟨↑K / ↑(φ ε), _⟩ +1), α.1 x * ↑(φ ε) ≤ θ.1 (N ε) - θ.1 (r (N ε) ⟨↑K / ↑(φ ε), _⟩ +1): sum
... ≤ θ.1 (N ε): by linarith
... < K : h1 (N ε),
have q : (∑ (x : ℕ) in Ico (N ε) (r (N ε) ⟨↑K / ↑(φ ε), _⟩+1), α.val x) * ((φ ε).1)* ((φ ε).1)⁻¹ ≤  ↑K* ((φ ε).1)⁻¹,
simp[ le_of_lt] at p, rw ← sum_mul at p,
exact mul_le_mul_of_nonneg_right (le_of_lt p)(le_of_lt ((@inv_pos ℝ _ (φ ε).1).2((φ ε).2))) ,
have inv : (φ ε).val * ((φ ε).val)⁻¹ =1,
exact mul_inv_cancel (norm_num.ne_zero_of_pos (φ ε).1 (φ ε).2),
rw mul_assoc at q, rw inv at q,simp at q,
have cont: (Ico (N ε) (r (N ε) ⟨↑K / ↑(φ ε), _⟩ +1)).sum α.1 > ↑K * (↑(φ ε))⁻¹,
calc  (Ico (N ε) (r (N ε) ⟨↑K / ↑(φ ε), _⟩ +1)).sum α.1 >  K.1 / (φ ε).1 : (h2.2 (N ε) ⟨↑K / ↑(φ ε), _⟩)
... =  ↑K * (↑(φ ε))⁻¹ : rfl, exact div_pos K.2 (φ ε).2,
have cont': ¬  ((Ico (N ε) (r (N ε) ⟨↑K / ↑(φ ε), _⟩ +1)).sum α.1 ≤ ↑K * (↑(φ ε))⁻¹),
push_neg, rw ← gt_iff_lt, exact cont, contradiction,
unfold RoC, intros,
specialize H2 ε,cases H2 with R, cases H2_h with H2_N,
have induct:  ∀k :ℕ, k> R → θ.1 k ≤ ε,
intros, induction k,
have Nnonneg: ¬ (0> R),push_neg,simp, contradiction,
have S1: k_n ≥ R, exact nat.lt_succ_iff.mp ᾰ,
rw ge_iff_le at S1, rw le_iff_lt_or_eq at S1, cases S1, rw ← gt_iff_lt at S1,
rw mem_Ico at H2_N,
have S2: k_n ≥ N ε, linarith,
exact H1 ε k_n S2 (k_ih S1),
rw S1 at H2_h_h, exact H2_h_h,
rw mem_Ico at H2_N,
have S3 : n > R, linarith, exact induct n S3,
end