/-
Copyright (c) 2022 Anatole Dedecker. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel, Anatole Dedecker

! This file was ported from Lean 3 source module topology.algebra.module.finite_dimension
! leanprover-community/mathlib commit f430769b562e0cedef59ee1ed968d67e0e0c86ba
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.LocallyConvex.BalancedCoreHull
import Mathbin.Topology.Algebra.Module.Simple
import Mathbin.Topology.Algebra.Module.Determinant

/-!
# Finite dimensional topological vector spaces over complete fields

Let `𝕜` be a complete nontrivially normed field, and `E` a topological vector space (TVS) over
`𝕜` (i.e we have `[add_comm_group E] [module 𝕜 E] [topological_space E] [topological_add_group E]`
and `[has_continuous_smul 𝕜 E]`).

If `E` is finite dimensional and Hausdorff, then all linear maps from `E` to any other TVS are
continuous.

When `E` is a normed space, this gets us the equivalence of norms in finite dimension.

## Main results :

* `linear_map.continuous_iff_is_closed_ker` : a linear form is continuous if and only if its kernel
  is closed.
* `linear_map.continuous_of_finite_dimensional` : a linear map on a finite-dimensional Hausdorff
  space over a complete field is continuous.

## TODO

Generalize more of `analysis/normed_space/finite_dimension` to general TVSs.

## Implementation detail

The main result from which everything follows is the fact that, if `ξ : ι → E` is a finite basis,
then `ξ.equiv_fun : E →ₗ (ι → 𝕜)` is continuous. However, for technical reasons, it is easier to
prove this when `ι` and `E` live ine the same universe. So we start by doing that as a private
lemma, then we deduce `linear_map.continuous_of_finite_dimensional` from it, and then the general
result follows as `continuous_equiv_fun_basis`.

-/

universe u v w x

noncomputable section

open Set FiniteDimensional TopologicalSpace Filter

open BigOperators

section Field

variable {𝕜 E F : Type _} [Field 𝕜] [TopologicalSpace 𝕜] [AddCommGroup E] [Module 𝕜 E]
  [TopologicalSpace E] [AddCommGroup F] [Module 𝕜 F] [TopologicalSpace F] [TopologicalAddGroup F]
  [ContinuousSMul 𝕜 F]

/-- The space of continuous linear maps between finite-dimensional spaces is finite-dimensional. -/
instance [FiniteDimensional 𝕜 E] [FiniteDimensional 𝕜 F] : FiniteDimensional 𝕜 (E →L[𝕜] F) :=
  FiniteDimensional.of_injective (ContinuousLinearMap.coeLm 𝕜 : (E →L[𝕜] F) →ₗ[𝕜] E →ₗ[𝕜] F)
    ContinuousLinearMap.coe_injective

end Field

section NormedField

variable {𝕜 : Type u} [hnorm : NontriviallyNormedField 𝕜] {E : Type v} [AddCommGroup E] [Module 𝕜 E]
  [TopologicalSpace E] [TopologicalAddGroup E] [ContinuousSMul 𝕜 E] {F : Type w} [AddCommGroup F]
  [Module 𝕜 F] [TopologicalSpace F] [TopologicalAddGroup F] [ContinuousSMul 𝕜 F] {F' : Type x}
  [AddCommGroup F'] [Module 𝕜 F'] [TopologicalSpace F'] [TopologicalAddGroup F']
  [ContinuousSMul 𝕜 F']

include hnorm

/-- If `𝕜` is a nontrivially normed field, any T2 topology on `𝕜` which makes it a topological
vector space over itself (with the norm topology) is *equal* to the norm topology. -/
theorem unique_topology_of_t2 {t : TopologicalSpace 𝕜} (h₁ : @TopologicalAddGroup 𝕜 t _)
    (h₂ : @ContinuousSMul 𝕜 𝕜 _ hnorm.toUniformSpace.toTopologicalSpace t) (h₃ : @T2Space 𝕜 t) :
    t = hnorm.toUniformSpace.toTopologicalSpace :=
  by
  -- Let `𝓣₀` denote the topology on `𝕜` induced by the norm, and `𝓣` be any T2 vector
  -- topology on `𝕜`. To show that `𝓣₀ = 𝓣`, it suffices to show that they have the same
  -- neighborhoods of 0.
  refine' TopologicalAddGroup.ext h₁ inferInstance (le_antisymm _ _)
  · -- To show `𝓣 ≤ 𝓣₀`, we have to show that closed balls are `𝓣`-neighborhoods of 0.
    rw [metric.nhds_basis_closed_ball.ge_iff]
    -- Let `ε > 0`. Since `𝕜` is nontrivially normed, we have `0 < ‖ξ₀‖ < ε` for some `ξ₀ : 𝕜`.
    intro ε hε
    rcases NormedField.exists_norm_lt 𝕜 hε with ⟨ξ₀, hξ₀, hξ₀ε⟩
    -- Since `ξ₀ ≠ 0` and `𝓣` is T2, we know that `{ξ₀}ᶜ` is a `𝓣`-neighborhood of 0.
    have : {ξ₀}ᶜ ∈ @nhds 𝕜 t 0 :=
      IsOpen.mem_nhds isOpen_compl_singleton (Ne.symm <| norm_ne_zero_iff.mp hξ₀.ne.symm)
    -- Thus, its balanced core `𝓑` is too. Let's show that the closed ball of radius `ε` contains
    -- `𝓑`, which will imply that the closed ball is indeed a `𝓣`-neighborhood of 0.
    have : balancedCore 𝕜 ({ξ₀}ᶜ) ∈ @nhds 𝕜 t 0 := balancedCore_mem_nhds_zero this
    refine' mem_of_superset this fun ξ hξ => _
    -- Let `ξ ∈ 𝓑`. We want to show `‖ξ‖ < ε`. If `ξ = 0`, this is trivial.
    by_cases hξ0 : ξ = 0
    · rw [hξ0]
      exact Metric.mem_closedBall_self hε.le
    · rw [mem_closedBall_zero_iff]
      -- Now suppose `ξ ≠ 0`. By contradiction, let's assume `ε < ‖ξ‖`, and show that
      -- `ξ₀ ∈ 𝓑 ⊆ {ξ₀}ᶜ`, which is a contradiction.
      by_contra' h
      suffices (ξ₀ * ξ⁻¹) • ξ ∈ balancedCore 𝕜 ({ξ₀}ᶜ)
        by
        rw [smul_eq_mul 𝕜, mul_assoc, inv_mul_cancel hξ0, mul_one] at this
        exact not_mem_compl_iff.mpr (mem_singleton ξ₀) ((balancedCore_subset _) this)
      -- For that, we use that `𝓑` is balanced : since `‖ξ₀‖ < ε < ‖ξ‖`, we have `‖ξ₀ / ξ‖ ≤ 1`,
      -- hence `ξ₀ = (ξ₀ / ξ) • ξ ∈ 𝓑` because `ξ ∈ 𝓑`.
      refine' (balancedCore_balanced _).smul_mem _ hξ
      rw [norm_mul, norm_inv, mul_inv_le_iff (norm_pos_iff.mpr hξ0), mul_one]
      exact (hξ₀ε.trans h).le
  ·-- Finally, to show `𝓣₀ ≤ 𝓣`, we simply argue that `id = (λ x, x • 1)` is continuous from
    -- `(𝕜, 𝓣₀)` to `(𝕜, 𝓣)` because `(•) : (𝕜, 𝓣₀) × (𝕜, 𝓣) → (𝕜, 𝓣)` is continuous.
    calc
      @nhds 𝕜 hnorm.to_uniform_space.to_topological_space 0 =
          map id (@nhds 𝕜 hnorm.to_uniform_space.to_topological_space 0) :=
        map_id.symm
      _ = map (fun x => id x • 1) (@nhds 𝕜 hnorm.to_uniform_space.to_topological_space 0) := by
        conv_rhs =>
            congr
            ext
            rw [smul_eq_mul, mul_one] <;>
          rfl
      _ ≤ @nhds 𝕜 t ((0 : 𝕜) • 1) :=
        (@tendsto.smul_const _ _ _ hnorm.to_uniform_space.to_topological_space t _ _ _ _ _
          tendsto_id (1 : 𝕜))
      _ = @nhds 𝕜 t 0 := by rw [zero_smul]

#align unique_topology_of_t2 unique_topology_of_t2

/-- Any linear form on a topological vector space over a nontrivially normed field is continuous if
    its kernel is closed. -/
theorem LinearMap.continuous_of_isClosed_ker (l : E →ₗ[𝕜] 𝕜) (hl : IsClosed (l.ker : Set E)) :
    Continuous l :=
  by
  -- `l` is either constant or surjective. If it is constant, the result is trivial.
  by_cases H : finrank 𝕜 l.range = 0
  · rw [finrank_eq_zero, LinearMap.range_eq_bot] at H
    rw [H]
    exact continuous_zero
  · -- In the case where `l` is surjective, we factor it as `φ : (E ⧸ l.ker) ≃ₗ[𝕜] 𝕜`. Note that
    -- `E ⧸ l.ker` is T2 since `l.ker` is closed.
    have : finrank 𝕜 l.range = 1 :=
      le_antisymm (finrank_self 𝕜 ▸ l.range.finrank_le) (zero_lt_iff.mpr H)
    have hi : Function.Injective (l.ker.liftq l (le_refl _)) :=
      by
      rw [← LinearMap.ker_eq_bot]
      exact Submodule.ker_liftQ_eq_bot _ _ _ (le_refl _)
    have hs : Function.Surjective (l.ker.liftq l (le_refl _)) :=
      by
      rw [← LinearMap.range_eq_top, Submodule.range_liftQ]
      exact eq_top_of_finrank_eq ((finrank_self 𝕜).symm ▸ this)
    let φ : (E ⧸ l.ker) ≃ₗ[𝕜] 𝕜 := LinearEquiv.ofBijective (l.ker.liftq l (le_refl _)) ⟨hi, hs⟩
    have hlφ : (l : E → 𝕜) = φ ∘ l.ker.mkq := by ext <;> rfl
    -- Since the quotient map `E →ₗ[𝕜] (E ⧸ l.ker)` is continuous, the continuity of `l` will follow
    -- form the continuity of `φ`.
    suffices Continuous φ.to_equiv by
      rw [hlφ]
      exact this.comp continuous_quot_mk
    -- The pullback by `φ.symm` of the quotient topology is a T2 topology on `𝕜`, because `φ.symm`
    -- is injective. Since `φ.symm` is linear, it is also a vector space topology.
    -- Hence, we know that it is equal to the topology induced by the norm.
    have : induced φ.to_equiv.symm inferInstance = hnorm.to_uniform_space.to_topological_space :=
      by
      refine'
        unique_topology_of_t2 (topologicalAddGroup_induced φ.symm.to_linear_map)
          (continuousSMul_induced φ.symm.to_linear_map) _
      rw [t2Space_iff]
      exact fun x y hxy =>
        @separated_by_continuous _ _ (induced _ _) _ _ _ continuous_induced_dom _ _
          (φ.to_equiv.symm.injective.ne hxy)
    -- Finally, the pullback by `φ.symm` is exactly the pushforward by `φ`, so we have to prove
    -- that `φ` is continuous when `𝕜` is endowed with the pushforward by `φ` of the quotient
    -- topology, which is trivial by definition of the pushforward.
    rw [this.symm, Equiv.induced_symm]
    exact continuous_coinduced_rng
#align linear_map.continuous_of_is_closed_ker LinearMap.continuous_of_isClosed_ker

/-- Any linear form on a topological vector space over a nontrivially normed field is continuous if
    and only if its kernel is closed. -/
theorem LinearMap.continuous_iff_isClosed_ker (l : E →ₗ[𝕜] 𝕜) :
    Continuous l ↔ IsClosed (l.ker : Set E) :=
  ⟨fun h => isClosed_singleton.Preimage h, l.continuous_of_isClosed_ker⟩
#align linear_map.continuous_iff_is_closed_ker LinearMap.continuous_iff_isClosed_ker

/-- Over a nontrivially normed field, any linear form which is nonzero on a nonempty open set is
    automatically continuous. -/
theorem LinearMap.continuous_of_nonzero_on_open (l : E →ₗ[𝕜] 𝕜) (s : Set E) (hs₁ : IsOpen s)
    (hs₂ : s.Nonempty) (hs₃ : ∀ x ∈ s, l x ≠ 0) : Continuous l :=
  by
  refine' l.continuous_of_is_closed_ker (l.is_closed_or_dense_ker.resolve_right fun hl => _)
  rcases hs₂ with ⟨x, hx⟩
  have : x ∈ interior ((l.ker : Set E)ᶜ) :=
    by
    rw [mem_interior_iff_mem_nhds]
    exact mem_of_superset (hs₁.mem_nhds hx) hs₃
  rwa [hl.interior_compl] at this
#align linear_map.continuous_of_nonzero_on_open LinearMap.continuous_of_nonzero_on_open

variable [CompleteSpace 𝕜]

/-- This version imposes `ι` and `E` to live in the same universe, so you should instead use
`continuous_equiv_fun_basis` which gives the same result without universe restrictions. -/
private theorem continuous_equiv_fun_basis_aux [ht2 : T2Space E] {ι : Type v} [Fintype ι]
    (ξ : Basis ι 𝕜 E) : Continuous ξ.equivFun :=
  by
  letI : UniformSpace E := TopologicalAddGroup.toUniformSpace E
  letI : UniformAddGroup E := comm_topologicalAddGroup_is_uniform
  letI : SeparatedSpace E := separated_iff_t2.mpr ht2
  induction' hn : Fintype.card ι with n IH generalizing ι E
  · rw [Fintype.card_eq_zero_iff] at hn
    exact continuous_of_const fun x y => funext hn.elim
  · haveI : FiniteDimensional 𝕜 E := of_fintype_basis ξ
    -- first step: thanks to the induction hypothesis, any n-dimensional subspace is equivalent
    -- to a standard space of dimension n, hence it is complete and therefore closed.
    have H₁ : ∀ s : Submodule 𝕜 E, finrank 𝕜 s = n → IsClosed (s : Set E) :=
      by
      intro s s_dim
      letI : UniformAddGroup s := s.to_add_subgroup.uniform_add_group
      let b := Basis.ofVectorSpace 𝕜 s
      have U : UniformEmbedding b.equiv_fun.symm.to_equiv :=
        by
        have : Fintype.card (Basis.ofVectorSpaceIndex 𝕜 s) = n :=
          by
          rw [← s_dim]
          exact (finrank_eq_card_basis b).symm
        have : Continuous b.equiv_fun := IH b this
        exact
          b.equiv_fun.symm.uniform_embedding b.equiv_fun.symm.to_linear_map.continuous_on_pi this
      have : IsComplete (s : Set E) :=
        completeSpace_coe_iff_isComplete.1 ((completeSpace_congr U).1 (by infer_instance))
      exact this.is_closed
    -- second step: any linear form is continuous, as its kernel is closed by the first step
    have H₂ : ∀ f : E →ₗ[𝕜] 𝕜, Continuous f := by
      intro f
      by_cases H : finrank 𝕜 f.range = 0
      · rw [finrank_eq_zero, LinearMap.range_eq_bot] at H
        rw [H]
        exact continuous_zero
      · have : finrank 𝕜 f.ker = n :=
          by
          have Z := f.finrank_range_add_finrank_ker
          rw [finrank_eq_card_basis ξ, hn] at Z
          have : finrank 𝕜 f.range = 1 :=
            le_antisymm (finrank_self 𝕜 ▸ f.range.finrank_le) (zero_lt_iff.mpr H)
          rw [this, add_comm, Nat.add_one] at Z
          exact Nat.succ.inj Z
        have : IsClosed (f.ker : Set E) := H₁ _ this
        exact LinearMap.continuous_of_isClosed_ker f this
    rw [continuous_pi_iff]
    intro i
    change Continuous (ξ.coord i)
    exact H₂ (ξ.coord i)
#align continuous_equiv_fun_basis_aux continuous_equiv_fun_basis_aux

/-- Any linear map on a finite dimensional space over a complete field is continuous. -/
theorem LinearMap.continuous_of_finiteDimensional [T2Space E] [FiniteDimensional 𝕜 E]
    (f : E →ₗ[𝕜] F') : Continuous f :=
  by
  -- for the proof, go to a model vector space `b → 𝕜` thanks to `continuous_equiv_fun_basis`, and
  -- argue that all linear maps there are continuous.
  let b := Basis.ofVectorSpace 𝕜 E
  have A : Continuous b.equiv_fun := continuous_equiv_fun_basis_aux b
  have B : Continuous (f.comp (b.equiv_fun.symm : (Basis.ofVectorSpaceIndex 𝕜 E → 𝕜) →ₗ[𝕜] E)) :=
    LinearMap.continuous_on_pi _
  have :
    Continuous
      (f.comp (b.equiv_fun.symm : (Basis.ofVectorSpaceIndex 𝕜 E → 𝕜) →ₗ[𝕜] E) ∘ b.equiv_fun) :=
    B.comp A
  convert this
  ext x
  dsimp
  rw [Basis.equivFun_symm_apply, Basis.sum_repr]
#align linear_map.continuous_of_finite_dimensional LinearMap.continuous_of_finiteDimensional

instance LinearMap.continuousLinearMapClassOfFiniteDimensional [T2Space E] [FiniteDimensional 𝕜 E] :
    ContinuousLinearMapClass (E →ₗ[𝕜] F') 𝕜 E F' :=
  { LinearMap.semilinearMapClass with map_continuous := fun f => f.continuous_of_finiteDimensional }
#align linear_map.continuous_linear_map_class_of_finite_dimensional LinearMap.continuousLinearMapClassOfFiniteDimensional

/-- In finite dimensions over a non-discrete complete normed field, the canonical identification
(in terms of a basis) with `𝕜^n` (endowed with the product topology) is continuous.
This is the key fact wich makes all linear maps from a T2 finite dimensional TVS over such a field
continuous (see `linear_map.continuous_of_finite_dimensional`), which in turn implies that all
norms are equivalent in finite dimensions. -/
theorem continuous_equivFun_basis [T2Space E] {ι : Type _} [Fintype ι] (ξ : Basis ι 𝕜 E) :
    Continuous ξ.equivFun :=
  haveI : FiniteDimensional 𝕜 E := of_fintype_basis ξ
  ξ.equiv_fun.to_linear_map.continuous_of_finite_dimensional
#align continuous_equiv_fun_basis continuous_equivFun_basis

namespace LinearMap

variable [T2Space E] [FiniteDimensional 𝕜 E]

/-- The continuous linear map induced by a linear map on a finite dimensional space -/
def toContinuousLinearMap : (E →ₗ[𝕜] F') ≃ₗ[𝕜] E →L[𝕜] F'
    where
  toFun f := ⟨f, f.continuous_of_finiteDimensional⟩
  invFun := coe
  map_add' f g := rfl
  map_smul' c f := rfl
  left_inv f := rfl
  right_inv f := ContinuousLinearMap.coe_injective rfl
#align linear_map.to_continuous_linear_map LinearMap.toContinuousLinearMap

@[simp]
theorem coe_to_continuous_linear_map' (f : E →ₗ[𝕜] F') : ⇑f.toContinuousLinearMap = f :=
  rfl
#align linear_map.coe_to_continuous_linear_map' LinearMap.coe_to_continuous_linear_map'

@[simp]
theorem coe_toContinuousLinearMap (f : E →ₗ[𝕜] F') : (f.toContinuousLinearMap : E →ₗ[𝕜] F') = f :=
  rfl
#align linear_map.coe_to_continuous_linear_map LinearMap.coe_toContinuousLinearMap

@[simp]
theorem coe_toContinuousLinearMap_symm :
    ⇑(toContinuousLinearMap : (E →ₗ[𝕜] F') ≃ₗ[𝕜] E →L[𝕜] F').symm = coe :=
  rfl
#align linear_map.coe_to_continuous_linear_map_symm LinearMap.coe_toContinuousLinearMap_symm

@[simp]
theorem det_toContinuousLinearMap (f : E →ₗ[𝕜] E) : f.toContinuousLinearMap.det = f.det :=
  rfl
#align linear_map.det_to_continuous_linear_map LinearMap.det_toContinuousLinearMap

@[simp]
theorem ker_toContinuousLinearMap (f : E →ₗ[𝕜] F') : ker f.toContinuousLinearMap = ker f :=
  rfl
#align linear_map.ker_to_continuous_linear_map LinearMap.ker_toContinuousLinearMap

@[simp]
theorem range_toContinuousLinearMap (f : E →ₗ[𝕜] F') : range f.toContinuousLinearMap = range f :=
  rfl
#align linear_map.range_to_continuous_linear_map LinearMap.range_toContinuousLinearMap

/-- A surjective linear map `f` with finite dimensional codomain is an open map. -/
theorem isOpenMap_of_finiteDimensional (f : F →ₗ[𝕜] E) (hf : Function.Surjective f) : IsOpenMap f :=
  by
  rcases f.exists_right_inverse_of_surjective (LinearMap.range_eq_top.2 hf) with ⟨g, hg⟩
  refine' IsOpenMap.of_sections fun x => ⟨fun y => g (y - f x) + x, _, _, fun y => _⟩
  ·
    exact
      ((g.continuous_of_finite_dimensional.comp <| continuous_id.sub continuous_const).add
          continuous_const).ContinuousAt
  · rw [sub_self, map_zero, zero_add]
  · simp only [map_sub, map_add, ← comp_apply f g, hg, id_apply, sub_add_cancel]
#align linear_map.is_open_map_of_finite_dimensional LinearMap.isOpenMap_of_finiteDimensional

instance canLiftContinuousLinearMap : CanLift (E →ₗ[𝕜] F) (E →L[𝕜] F) coe fun _ => True :=
  ⟨fun f _ => ⟨f.toContinuousLinearMap, rfl⟩⟩
#align linear_map.can_lift_continuous_linear_map LinearMap.canLiftContinuousLinearMap

end LinearMap

namespace LinearEquiv

variable [T2Space E] [T2Space F] [FiniteDimensional 𝕜 E]

/-- The continuous linear equivalence induced by a linear equivalence on a finite dimensional
space. -/
def toContinuousLinearEquiv (e : E ≃ₗ[𝕜] F) : E ≃L[𝕜] F :=
  { e with
    continuous_toFun := e.toLinearMap.continuous_of_finiteDimensional
    continuous_invFun :=
      haveI : FiniteDimensional 𝕜 F := e.finite_dimensional
      e.symm.to_linear_map.continuous_of_finite_dimensional }
#align linear_equiv.to_continuous_linear_equiv LinearEquiv.toContinuousLinearEquiv

@[simp]
theorem coe_toContinuousLinearEquiv (e : E ≃ₗ[𝕜] F) : (e.toContinuousLinearEquiv : E →ₗ[𝕜] F) = e :=
  rfl
#align linear_equiv.coe_to_continuous_linear_equiv LinearEquiv.coe_toContinuousLinearEquiv

@[simp]
theorem coe_to_continuous_linear_equiv' (e : E ≃ₗ[𝕜] F) : (e.toContinuousLinearEquiv : E → F) = e :=
  rfl
#align linear_equiv.coe_to_continuous_linear_equiv' LinearEquiv.coe_to_continuous_linear_equiv'

@[simp]
theorem coe_toContinuousLinearEquiv_symm (e : E ≃ₗ[𝕜] F) :
    (e.toContinuousLinearEquiv.symm : F →ₗ[𝕜] E) = e.symm :=
  rfl
#align linear_equiv.coe_to_continuous_linear_equiv_symm LinearEquiv.coe_toContinuousLinearEquiv_symm

@[simp]
theorem coe_toContinuousLinearEquiv_symm' (e : E ≃ₗ[𝕜] F) :
    (e.toContinuousLinearEquiv.symm : F → E) = e.symm :=
  rfl
#align linear_equiv.coe_to_continuous_linear_equiv_symm' LinearEquiv.coe_toContinuousLinearEquiv_symm'

@[simp]
theorem toLinearEquiv_toContinuousLinearEquiv (e : E ≃ₗ[𝕜] F) :
    e.toContinuousLinearEquiv.toLinearEquiv = e :=
  by
  ext x
  rfl
#align linear_equiv.to_linear_equiv_to_continuous_linear_equiv LinearEquiv.toLinearEquiv_toContinuousLinearEquiv

@[simp]
theorem toLinearEquiv_toContinuousLinearEquiv_symm (e : E ≃ₗ[𝕜] F) :
    e.toContinuousLinearEquiv.symm.toLinearEquiv = e.symm :=
  by
  ext x
  rfl
#align linear_equiv.to_linear_equiv_to_continuous_linear_equiv_symm LinearEquiv.toLinearEquiv_toContinuousLinearEquiv_symm

instance canLiftContinuousLinearEquiv :
    CanLift (E ≃ₗ[𝕜] F) (E ≃L[𝕜] F) ContinuousLinearEquiv.toLinearEquiv fun _ => True :=
  ⟨fun f _ => ⟨_, f.toLinearEquiv_toContinuousLinearEquiv⟩⟩
#align linear_equiv.can_lift_continuous_linear_equiv LinearEquiv.canLiftContinuousLinearEquiv

end LinearEquiv

namespace ContinuousLinearMap

variable [T2Space E] [FiniteDimensional 𝕜 E]

/-- Builds a continuous linear equivalence from a continuous linear map on a finite-dimensional
vector space whose determinant is nonzero. -/
def toContinuousLinearEquivOfDetNeZero (f : E →L[𝕜] E) (hf : f.det ≠ 0) : E ≃L[𝕜] E :=
  ((f : E →ₗ[𝕜] E).equivOfDetNeZero hf).toContinuousLinearEquiv
#align continuous_linear_map.to_continuous_linear_equiv_of_det_ne_zero ContinuousLinearMap.toContinuousLinearEquivOfDetNeZero

@[simp]
theorem coe_toContinuousLinearEquivOfDetNeZero (f : E →L[𝕜] E) (hf : f.det ≠ 0) :
    (f.toContinuousLinearEquivOfDetNeZero hf : E →L[𝕜] E) = f :=
  by
  ext x
  rfl
#align continuous_linear_map.coe_to_continuous_linear_equiv_of_det_ne_zero ContinuousLinearMap.coe_toContinuousLinearEquivOfDetNeZero

@[simp]
theorem toContinuousLinearEquivOfDetNeZero_apply (f : E →L[𝕜] E) (hf : f.det ≠ 0) (x : E) :
    f.toContinuousLinearEquivOfDetNeZero hf x = f x :=
  rfl
#align continuous_linear_map.to_continuous_linear_equiv_of_det_ne_zero_apply ContinuousLinearMap.toContinuousLinearEquivOfDetNeZero_apply

/- ./././Mathport/Syntax/Translate/Expr.lean:207:4: warning: unsupported notation `«expr!![ » -/
/- ./././Mathport/Syntax/Translate/Expr.lean:387:14: unsupported user notation matrix.notation -/
theorem Matrix.toLin_finTwoProd_toContinuousLinearMap (a b c d : 𝕜) :
    (Matrix.toLin (Basis.finTwoProd 𝕜) (Basis.finTwoProd 𝕜)
          («expr!![ »
            "./././Mathport/Syntax/Translate/Expr.lean:387:14: unsupported user notation matrix.notation")).toContinuousLinearMap =
      (a • ContinuousLinearMap.fst 𝕜 𝕜 𝕜 + b • ContinuousLinearMap.snd 𝕜 𝕜 𝕜).Prod
        (c • ContinuousLinearMap.fst 𝕜 𝕜 𝕜 + d • ContinuousLinearMap.snd 𝕜 𝕜 𝕜) :=
  ContinuousLinearMap.ext <| Matrix.toLin_finTwoProd_apply _ _ _ _
#align matrix.to_lin_fin_two_prod_to_continuous_linear_map Matrix.toLin_finTwoProd_toContinuousLinearMap

end ContinuousLinearMap

end NormedField


import wspace
import rates
import xu
import utils

open metric_space

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

@[simp]
def tikhonov_mann {X : Type*} [whyperbolic_space X] (T : X → X) (o : X) (l β : ℕ → ℝ) (x₀ : X) : ℕ → X
| 0 := x₀
| (n + 1) := wmap (l n) (wmap (β n) o (tikhonov_mann n)) (T (wmap (β n) o (tikhonov_mann n)))

section
  open whyperbolic_space

  -- using parameters for the hypotheses was a bad idea.
  -- do not repeat

  parameters {X : Type*} [whyperbolic_space X]
  parameters (T : X → X) (o : X) (l β : ℕ → ℝ) (x₀ : X) (p : X)
  parameters (Tne : ∀ s t : X, dist (T s) (T t) ≤ dist s t) (p_fp_T : T p = p) (h_p_neq_o : p ≠ o)
  parameters (l_pos : ∀ {n : ℕ}, 0 < l n) (hl1 : ∀ {n : ℕ}, l n ≤ 1)
  parameters (β_pos : ∀ {n : ℕ}, 0 < β n) (hβ1 : ∀ {n : ℕ}, β n ≤ 1)

  include Tne p_fp_T h_p_neq_o l_pos hl1 β_pos hβ1

  def x : ℕ → X := tikhonov_mann T o l β x₀
  def y (n : ℕ) : X := wmap (β n) o (x n)

  noncomputable def M := max (dist p x₀) (dist p o)

  lemma x_y : ∀ n : ℕ, x (n + 1) = wmap (l n) (y n) (T $ y n) := by intros n; induction n; simp [x, y]

  lemma hl0 : ∀ {n : ℕ}, 0 ≤ l n := λ _, le_of_lt l_pos

  lemma hβ0 : ∀ {n : ℕ}, 0 ≤ β n := λ _, le_of_lt β_pos

  lemma dist_p_o_pos : 0 < dist p o :=
  begin
    refine (ne.le_iff_lt _).mp dist_nonneg,
    intros h,
    have : dist p o = 0 := h.symm,
    have := metric_space.eq_of_dist_eq_zero this,
    contradiction,
  end

  lemma M_pos : 0 < M := lt_max_of_lt_right dist_p_o_pos

  lemma M_nonneg : 0 ≤ M := le_of_lt M_pos

  lemma M_double_nonneg : 0 ≤ 2 * M := mul_nonneg zero_le_two M_nonneg

  lemma left_le_M : dist p x₀ ≤ M := by simp [M]

  lemma right_le_M : dist p o ≤ M := by simp [M]

  -- # Corresponding to lemmas 3.1 and 3.2

  lemma l_3_1_i : ∀ n : ℕ, dist p (x $ n + 1)  ≤ (1 - (β n)) * (dist p o) + (β n) * (dist p (x n)) :=
  λ n, calc dist p (x $ n + 1) ≤ (1 - l n) * (dist p (y n)) + (l n) * (dist p (T $ y n)) : dist_conv _ _ _ hl0 hl1
    ... = (1 - l n) * (dist p (y n)) + (l n) * dist (T p) (T $ y n) : by rw p_fp_T
    ... ≤ (1 - l n) * (dist p (y n)) + (l n) * dist p (y n) : by {
      have := @hl0 n,
      have := @hl1 n,
      nlinarith [Tne p (y n)],
    }
    ... = dist p (y n) : by { ring, }
    ... ≤ (1 - (β n)) * (dist p o) + (β n) * (dist p (x n)) : dist_conv _ _ _ hβ0 hβ1

  lemma l_3_1_ii_i : ∀ n : ℕ, dist p (x n) ≤ M :=
  begin
    intros n,
    induction n,
    case zero
    { simp [M, x], },
    case succ: n ih {
      calc dist p (x $ n + 1) ≤ (1 - (β n)) * (dist p o) + (β n) * (dist p (x n)) : l_3_1_i n
      ... ≤ (1 - (β n)) * M + (β n) * (dist p (x n)) : by {
        have : dist p o ≤ M := by simp [M],
        nlinarith [@hβ0 n, @hβ1 n],
      }
      ... ≤ (1 - (β n)) * M + (β n) * M : by { nlinarith [@hβ0 n, @hβ1 n, ih], }
      ... ≤ M : by ring,
    }
  end

  lemma l_3_1_ii_ii : ∀ n : ℕ, dist (x n) o ≤ 2 * M :=
  λ n, calc dist (x n) o ≤ dist (x n) p + dist p o : dist_triangle _ _ _
  ... ≤ M + dist p o : by{
    nth_rewrite 0 dist_comm,
    linarith [l_3_1_ii_i n],
  }
  ... ≤ M + M : by {have : dist p o ≤ M := by simp [M], linarith, }
  ... = 2 * M : by ring

  lemma l_3_1_iii_i : ∀ n : ℕ, dist p (y n) ≤ M :=
  λ n, calc
  dist p (y n) ≤ (1 - β n) * (dist p o) + (β n) * (dist p (x n)) : dist_conv _ _ _ hβ0 hβ1
  ... ≤ (1 - β n) * M + (β n) * (dist p (x n)) : by nlinarith [right_le_M, @hβ0 n, @hβ1 n]
  ... ≤ (1 - β n) * M + (β n) * M : by nlinarith [@hβ0 n, @hβ1 n, @l_3_1_ii_i n]
  ... = M : by ring

  lemma l_3_1_iii_ii : ∀ n : ℕ, dist (y n) (T $ y n) ≤ 2 * M :=
  λ n, calc
  dist (y n) (T $ y n) ≤ dist (y n) p + dist p (T $ y n) : dist_triangle _ _ _
  ... = dist (y n) p + dist (T p) (T $ y n) : by rw p_fp_T
  ... ≤ dist (y n) p + dist p (y n) : by nlinarith [Tne p (y n)]
  ... = dist p (y n) + dist p (y n) : by rw dist_comm
  ... ≤ M + M : by nlinarith [l_3_1_iii_i n]
  ... = 2 * M : by ring

  lemma l_3_2_i : ∀ n : ℕ,
  dist (y $ n + 1) (y n)  ≤ (β $ n + 1) * (dist (x $ n + 1) (x n)) + 2 * M * |(β $ n + 1) - β n| :=
  λ n, calc
  dist (y $ n + 1) (y n)  ≤ (β $ n + 1) * (dist (x $ n + 1) (x n)) + |(β $ n + 1) - β n| * (dist o (x n)) : @dist_wmap_same_first _ _ _ _ o (x $ n + 1)(x n) (@hβ0 $ n + 1) (@hβ1 $ n + 1) (@hβ0 n) (@hβ1 n)
  ... ≤ (β $ n + 1) * (dist (x $ n + 1) (x n)) + |(β $ n + 1) - β n| * (2 * M) : by {
    nth_rewrite 1 dist_comm,
    nlinarith [M_pos, l_3_1_ii_ii n, abs_nonneg (β (n + 1) - β n)],
  }
  ... = (β $ n + 1) * (dist (x $ n + 1) (x n)) + 2 * M * |(β $ n + 1) - β n| : by ring

  lemma l_3_2_ii :
  ∀ n : ℕ, dist (x $ n + 2) (x $ n + 1)
  ≤ (β $ n + 1) * (dist (x $ n + 1) (x n)) + 2 * M * (|(β $ n + 1) - β n| + |(l $ n + 1) - l n|) :=
  λ n, calc
  dist (x $ n + 2) (x $ n + 1) = dist (wmap (l $ n + 1) (y $ n + 1) (T $ y $ n + 1)) (wmap (l n) (y n) (T $ y n)) : by simp [x_y]
  ... ≤ (1 - l (n + 1)) * (dist (y $ n + 1) (y n)) + (l $ n + 1) * (dist (T $ y $ n + 1) (T $ y $ n))
      + |l (n + 1) - l n| * (dist (y n) (T $ y $ n)) : dist_wmap hl0 hl1 hl0 hl1
  ... ≤ (1 - l (n + 1)) * (dist (y $ n + 1) (y n)) + (l $ n + 1) * (dist (y $ n + 1) (y n))
      + |l (n + 1) - l n| * (dist (y n) (T $ y $ n)) : by nlinarith [Tne (y $ n + 1) (y n), @hl0 (n + 1)]
  ... = dist (y $ n + 1) (y n) + |l (n + 1) - l n| * (dist (y n) (T $ y n)) : by ring
  ... ≤ dist (y $ n + 1) (y n) + |l (n + 1) - l n| * (2 * M) : by nlinarith [l_3_1_iii_ii n, abs_nonneg (l (n + 1) - l n)]
  ... ≤ (β $ n + 1) * (dist (x $ n + 1) (x n)) + 2 * M * |(β $ n + 1) - β n| + |l (n + 1) - l n| * (2 * M) : by nlinarith [l_3_2_i n, abs_nonneg (l (n + 1) - l n)]
  ... = (β $ n + 1) * (dist (x $ n + 1) (x n)) + 2 * M * (|(β $ n + 1) - β n| + |(l $ n + 1) - l n|) : by ring

  lemma l_3_2_iii :
  ∀ n : ℕ, dist (x n) (y n) = (1 - β n) * (dist o (x n)) :=
  begin
    intros n,
    have h₁ := @hβ0 n,
    have h₂ := @hβ1 n,
    simp only [y],
    rw [dist_self_wmap_right h₁ h₂],
  end

  lemma l_3_2_iv :
  ∀ n : ℕ, dist (x n) (T $ x n) ≤ dist (x n) (x $ n + 1) + (l n) * (1 - β n) * (dist o (x n)) +
  (1 - l n) * (β n) * (dist (x n) (T $ x n)) +
  (1 - l n) * (1 - β n) * (dist o (T $ x n)) :=
  λ n, calc
  dist (x n) (T $ x n)
      ≤ dist (x n) (x $ n + 1) + dist (x $ n + 1) (T $ x n) : dist_triangle _ _ _
  ... = dist (x n) (x $ n + 1) + dist (wmap (l n) (y n) (T $ y n)) (T $ x n) : by simp [x_y]
  ... = dist (x n) (x $ n + 1) + dist (T $ x n) (wmap (l n) (y n) (T $ y n)) : by nth_rewrite 1 dist_comm
  ... ≤ (dist (x n) (x $ n + 1)) + (1 - l n) * (dist (y n) (T $ x n)) + (l n) * (dist (T $ y n) (T $ x n)) : by{
    rw [dist_comm (y n) (T $ x n), dist_comm (T $ y n) (T $ x n)],
    nlinarith [dist_conv (y n) (T $ y n) (T $ x n) (@hl0 n) (@hl1 n)],
  }
  ... ≤ (dist (x n) (x $ n + 1)) + (1 - l n) * (dist (y n) (T $ x n)) + (l n) * (dist (y n) (x n)) : by nlinarith [Tne (y n) (x n), @hl0 n]
  ... ≤ (dist (x n) (x $ n + 1)) + (l n) * (dist (y n) (x n)) + (1 - l n) * (dist (y n) (T $ x n)) : by ring
  ... ≤ (dist (x n) (x $ n + 1)) + (l n) * (dist (y n) (x n))
        + (1 - l n) * (dist (y n) (wmap (β n) o (T $ x n)) + dist (wmap (β n) o (T $ x n)) (T $ x n)) : by nlinarith [dist_triangle (y n) (wmap (β n) o (T $ x n)) (T $ x n), @hl0 n, sub_nonneg.mpr (@hl1 n)]
  ... = (dist (x n) (x $ n + 1)) + (l n) * (dist (y n) (x n))
        + (1 - l n) * (dist (y n) (wmap (β n) o (T $ x n))) + (1 - l n) * (dist (wmap (β n) o (T $ x n)) (T $ x n)) : by ring
  ... = (dist (x n) (x $ n + 1)) + (l n) * (dist (y n) (x n))
        + (1 - l n) * (dist (y n) (wmap (β n) o (T $ x n)))
        + (1 - l n) * (1 - β n) * (dist o (T $ x n)) : by { rw [dist_comm (wmap (β n) o (T $ x n)) (T $ x n), dist_self_wmap_right hβ0 hβ1], ring, }
  ... = (dist (x n) (x $ n + 1)) + (l n) * (dist (y n) (x n)) + (1 - l n) * (1 - β n) * (dist o (T $ x n))
        +  (1 - l n) * (dist (y n) (wmap (β n) o (T $ x n))) : by ring
  ... = (dist (x n) (x $ n + 1)) + (l n) * (dist (y n) (x n)) + (1 - l n) * (1 - β n) * (dist o (T $ x n))
        + (1 - l n) * (dist (wmap (β n) o (x n)) (wmap (β n) o (T $ x n))) : by simp [y]
  ... = (dist (x n) (x $ n + 1)) + (l n) * (1 - β n) * (dist o (x n)) + (1 - l n) * (1 - β n) * (dist o (T $ x n))
        + (1 - l n) * (dist (wmap (β n) o (x n)) (wmap (β n) o (T $ x n))) : by {
          rw [dist_comm (y n) (x n)],
          have : dist (x n) (y n) = (1 - β n) * dist o (x n) := l_3_2_iii n,
          simp only [*, add_left_inj, add_right_inj],
          ring,
        }
  ... ≤ (dist (x n) (x $ n + 1)) + (l n) * (1 - β n) * (dist o (x n)) + (1 - l n) * (1 - β n) * (dist o (T $ x n))
        + (1 - l n) * (β n) * (dist (x n) (T $ x n)) : by nlinarith [sub_nonneg.mpr (@hl1 n), @wmap_same_coeff_same_firt _ _ _ o (x n) (T $ x n) (@hβ0 n) (@hβ1 n)]
  ... = dist (x n) (x $ n + 1) + (l n) * (1 - β n) * (dist o (x n)) +
  (1 - l n) * (β n) * (dist (x n) (T $ x n)) +
  (1 - l n) * (1 - β n) * (dist o (T $ x n)) : by ring

  lemma l_3_2_v : ∀ n : ℕ,
  (l n) * (dist (x n) (T $ x n)) ≤ dist (x n) (x $ n + 1) + 2 * M * (1 - β n) :=
  λ n, begin
    have h₁ : dist (x n) (T $ x n) ≤ dist (x n) (x $ n + 1) + (1 - β n) * (2 * M) + (1 - l n) * (dist (x n) (T $ x n)),
    calc
    dist (x n) (T $ x n)
        ≤ dist (x n) (x $ n + 1) + (l n) * (1 - β n) * (dist o (x n)) + (1 - l n) * (β n) * (dist (x n) (T $ x n))
          + (1 - l n) * (1 - β n) * (dist o (T $ x n)) : by apply l_3_2_iv
    ... ≤ dist (x n) (x $ n + 1) + (l n) * (1 - β n) * (dist o (x n)) + (1 - l n) * (β n) * (dist (x n) (T $ x n))
          + (1 - l n) * (1 - β n) * ((dist o (x n)) +  (dist (x n) (T $ x n))) : by nlinarith [mul_nonneg (sub_nonneg.mpr $ @hl1 n) (sub_nonneg.mpr $ @hβ1 n), dist_triangle o (x n) (T $ x n)]
    ... = dist (x n) (x $ n + 1) + (l n) * (1 - β n) * (dist o (x n)) + (1 - l n) * (β n) * (dist (x n) (T $ x n))
          + (1 - l n) * (1 - β n) * (dist o (x n)) + (1 - l n) * (1 - β n) * (dist (x n) (T $ x n)) : by ring
    ... ≤ dist (x n) (x $ n + 1) + (1 - β n) * (dist o (x n)) + (1 - l n) * (dist (x n) (T $ x n)) : by ring
    ... ≤ dist (x n) (x $ n + 1) + (1 - β n) * (2 * M) + (1 - l n) * (dist (x n) (T $ x n)) : by { rw [dist_comm o (x n)], nlinarith [sub_nonneg.mpr (@hβ1 n), l_3_1_ii_ii n], },

    have h₂ : dist (x n) (T $ x n) - (1 - l n) * (dist (x n) (T $ x n)) ≤ dist (x n) (x $ n + 1) + (1 - β n) * (2 * M) := sub_le_iff_le_add.mpr h₁,
    have h₃ : dist (x n) (T $ x n) - (1 - l n) * (dist (x n) (T $ x n)) = (l n) * (dist (x n) (T $ x n)) := by ring,
    rw [h₃, mul_comm (1 - β n) (2 * M)] at h₂,
    exact h₂,
  end

  -- # Main results

  parameters {σ₂ σ₃ σ₄ σ₅ : ℕ → ℕ} {Λ NΛ : ℕ} (Λ_pos : 0 < Λ)
  include Λ_pos

  open_locale big_operators

  open finset (range)

  def cond₂ : Prop := is_rate_of_convergence_towards σ₂ (λ n, ∏ i in range (n + 1), (β $ i + 1)) 0

  def cond₃ : Prop := is_cauchy_modulus σ₃ (λ n, ∑ i in range (n + 1), |β (i + 1) - β i|)

  def cond₄ : Prop := is_cauchy_modulus σ₄ (λ n, ∑ i in range (n + 1), |l (i + 1) - l i|)

  def cond₅ : Prop := is_rate_of_convergence_towards σ₅ β 1

  def cond₆ : Prop := ∀ n : ℕ, NΛ ≤ n → 1 / (Λ : ℝ) ≤ l n

  parameters (K : ℕ) (h_M_le_K : (M : ℝ) ≤ (K : ℝ)) (ψ : ℕ → ℕ) (hψ_pos : ∀ k : ℕ, 0 < ψ k)
  include h_M_le_K

  def L := 2 * K
  def s (n : ℕ) : ℝ := dist (x $ n + 1) (x n)
  def a (n : ℕ) : ℝ := 1 - (β $ n + 1)
  def P (n : ℕ) : ℝ := ∏ i in range (n + 1), (1 - a i)
  noncomputable def c (n : ℕ) : ℝ := 2 * M * (|β (n + 1) - (β n)| + |l (n + 1) - l n|)
  noncomputable def c' (n : ℕ) : ℝ := ∑ i in range (n + 1), c i

  lemma a_pos : ∀ {n : ℕ}, 0 ≤ a n :=
  by { intros n, simp only [a, sub_nonneg], exact hβ1, }

  lemma one_sub_a_nonneg : ∀ {n : ℕ}, 0 ≤ (1 - a n) :=
  by { intros n, simp only [a, sub_sub_cancel], exact hβ0, }

  lemma a_lt_one : ∀ {n : ℕ}, a n < 1 :=
  by { intros n, simp only [a, sub_lt_self_iff], exact β_pos, }

  lemma c_pos : ∀ {n : ℕ}, 0 ≤ c n :=
  begin
    intros n,
    simp only [c],
    exact mul_nonneg (mul_nonneg zero_le_two M_nonneg) (add_nonneg (abs_nonneg _) (abs_nonneg _)),
  end

  lemma s_pos : ∀ {n : ℕ}, 0 ≤ s n :=
  begin
    intros n,
    simp only [s],
    exact dist_nonneg,
  end

  lemma P_pos : ∀ {n : ℕ}, 0 ≤ (P n) :=
  begin
    intros n,
    simp only [P],
    exact finset.prod_nonneg (λ i _, one_sub_a_nonneg),
  end

  lemma xu_ineq_s_a_c : ∀ {n : ℕ}, s (n + 1) ≤ (1 - a n) * s n + c n :=
  begin
    intros n,
    simp only [s, a, c, sub_sub_cancel],
    have : n + 1 + 1 = n + 2 := by ring,
    rw this,
    exact l_3_2_ii n,
  end

  lemma s_le_L : ∀ {n : ℕ}, s n ≤ (L : ℝ) :=
  begin
    simp only [L, s, nat.cast_bit0, nat.cast_one, nat.cast_mul],
    intros n,
    calc dist (x $ n + 1) (x n) ≤ dist (x $ n + 1) p + dist p (x n) : dist_triangle _ _ _
    ... = dist p (x $ n + 1) + dist p (x n) : by rw dist_comm
    ... ≤ M + M : add_le_add (l_3_1_ii_i _) (l_3_1_ii_i _)
    ... ≤ K + K : add_le_add h_M_le_K h_M_le_K
    ... = 2 * K : by ring,
  end

  set_option pp.all false
  lemma σ₂_rate_conv_P : cond₂ → is_rate_of_convergence_towards σ₂ P 0 :=
  begin
    intros hc₂,
    intros k n h,
    rw [real.dist_eq, sub_zero, abs_eq_self.mpr P_pos],
    simp only [P, a, one_div, sub_sub_cancel, nat.cast_add, nat.cast_one],
    dunfold cond₂ at hc₂,
    specialize hc₂ k n h,
    dsimp only at hc₂,
    have : 0 ≤ ∏ i in range (n + 1), β (i + 1) := finset.prod_nonneg (λ i _, hβ0),
    rw [real.dist_eq, sub_zero, abs_eq_self.mpr this] at hc₂,
    clear this,
    ring_nf at hc₂,
    simp only [nat.cast_add, nat.cast_one] at hc₂,
    exact hc₂,
  end

  lemma L_def : L = 2 * K := rfl

  lemma K_pos : 0 < K := (@nat.cast_pos ℝ _ _ K).mp (lt_of_lt_of_le M_pos h_M_le_K)

  lemma M_le_L : M ≤ L :=
  begin
    simp only [L, nat.cast_bit0, nat.cast_one, nat.cast_mul],
    nlinarith [M_pos],
  end

  lemma L_pos : 0 < L := nat.succ_mul_pos 1 K_pos

  lemma L_pos_real : (0 : ℝ) < L := nat.cast_pos.mpr L_pos

  def χ (k : ℕ) : ℕ :=
  max
    (σ₃ $ 8 * K * (k + 1) - 1)
    (σ₄ $ 8 * K * (k + 1) - 1)

  def Ω (k : ℕ) : ℕ :=
  max
    (σ₂ $ 6 * K * (k + 1) * (ψ k) - 1)
    (χ (3 * k + 2) + 1)
    + 1

  def Φ (k : ℕ) : ℕ := (max3 NΛ (Ω $ 2 * Λ * (k + 1) - 1) (σ₅ $ 4 * K * Λ * (k + 1) - 1)) + 1

  def Γ (φ : ℕ → ℕ) (k : ℕ) : ℕ := (max3 NΛ (φ $ 2 * Λ * (k + 1) - 1) (σ₅ $ 4 * K * Λ * (k + 1) - 1)) + 1

  parameter (hψ : ∀ k : ℕ, 1 / (ψ k : ℝ) ≤ P (χ $ 3 * k + 2))

  -- set_option pp.all true
  lemma l_5_3 (hc₃ : cond₃) (hc₄ : cond₄) : is_cauchy_modulus χ c' :=
  begin

    intros k n j h,
    have hσ₃_le_n : σ₃ (8 * K * (k + 1) - 1) ≤ n := le_of_max_le_left h,
    have hσ₄_le_n : σ₄ (8 * K * (k + 1) - 1) ≤ n := le_of_max_le_right h,
    have hc₃' := hc₃ _ _ j hσ₃_le_n,
    have hc₄' := hc₄ _ _ j hσ₄_le_n,
    set β' : ℕ → ℝ := λ n, ∑ i in range (n + 1), |β (i + 1) - β i|,
    set l' : ℕ → ℝ := λ n, ∑ i in range (n + 1), |l (i + 1) - l i|,
    rw [real.dist_eq] at hc₃' hc₄',
    have : 8 * K = 4 * L := by { dsimp only [L], ring, },
    rw this at *, clear this,
    have h_4LK_pos : 0 < 4 * L * (k + 1) := mul_pos (mul_pos zero_lt_four L_pos) (nat.succ_pos k),
    have : 4 * L * (k + 1) - 1 + 1 = 4 * L * (k + 1) := nat.succ_pred_eq_of_pos h_4LK_pos,
    rw this at *, clear this,

    have h_c_β_l : ∀ m : ℕ, c' m = 2 * M * (β' m + l' m) :=
    begin
      intros m,
      simp only [c', c, β', l'],
      rw [finset.sum_hom, finset.sum_add_distrib],
    end,

    have h_β'_sub_abs : |β' (n + j) - β' n| = β' (n + j) - β' n := by {
      apply abs_eq_self.mpr,
      dsimp only [β'],
      have : n + j + 1 = (n + 1) + j := by ring,
      rw this,
      apply nonneg_sub_of_nonneg_sum,
      intros,
      apply abs_nonneg,
    },
    have h_l'_sub_abs : |l' (n + j) - l' n| = l' (n + j) - l' n := by {
      apply abs_eq_self.mpr,
      dsimp only [l'],
      have : n + j + 1 = (n + 1) + j := by ring,
      rw this,
      apply nonneg_sub_of_nonneg_sum,
      intros,
      apply abs_nonneg,
    },
    rw h_β'_sub_abs at hc₃',
    rw h_l'_sub_abs at hc₄',

    have h_2M_pos : 0 < 2 * M := mul_pos zero_lt_two M_pos,

    have h_c'_le : c' (n + j) - c' n ≤ 1 / ↑(k + 1) :=
    calc c' (n + j) - c' n
        = 2 * M * (β' (n + j) + l' (n + j)) - 2 * M * (β' n + l' n) : by repeat { rw [h_c_β_l] }
    ... = 2 * M * ((β' (n + j) - β' n) + (l' (n + j) - l' n)) : by ring
    ... ≤ 2 * M * (1 / ↑(4 * L * (k + 1)) + 1 / ↑(4 * L * (k + 1))) : by nlinarith
    ... = 2 * M * (2 / ↑(4 * L * (k + 1))) : by ring
    ... = 2 * M * (2 / (4 * ↑L * (↑k + 1))) : by simp only [nat.cast_bit0, nat.cast_add, nat.cast_one, nat.cast_mul]
    ... = 4 * M / (4 * ↑L * (↑k + 1)) : by ring
    ... = 4 * M / (4 * (↑L * (↑k + 1))) : by rw mul_assoc
    ... = M / (↑L * (↑k + 1)) : mul_div_mul_left _ _ (by norm_num)
    ... = (M / ↑L) * (1 / (↑k + 1)) : by { ring_nf, rw [mul_inv', mul_comm (↑L)⁻¹ _], }
    ... ≤ 1 * (1 / ↑(k + 1)) : by {
      -- have : (0 : ℝ) < ↑L := L_pos_real,
      have h_M_div_L_le_one : (M / (L : ℝ)) ≤ 1 := (@div_le_one ℝ _ M ↑L L_pos_real).mpr M_le_L,
      have h_one_div_k_succ_pos : (0 : ℝ) < 1 / ↑(k + 1) := one_div_pos.mpr (nat.cast_pos.mpr $ nat.succ_pos k),
      exact (mul_le_mul_right h_one_div_k_succ_pos).mpr h_M_div_L_le_one,
    }
    ... = 1 / ↑(k + 1) : one_mul _,

    have h_c'_sub_abs : |c' (n + j) - c' n| = c' (n + j) - c' n := by {
      apply abs_eq_self.mpr,
      dsimp only [c'],
      have : n + j + 1 = (n + 1) + j := by ring,
      rw this, clear this,
      apply nonneg_sub_of_nonneg_sum,
      intros,
      have : 0 ≤ |β (i + 1) - β i| + |l (i + 1) - l i| := add_nonneg (abs_nonneg _) (abs_nonneg _),
      nlinarith,
    },
    rw [real.dist_eq, h_c'_sub_abs],
    exact h_c'_le,
  end

  lemma Λ_pos_real : 0 < (Λ : ℝ) := nat.cast_pos.mpr Λ_pos

  lemma add_div_two_self (a : ℝ)  (h : a ≠ 0) : 1 / (2 * a) + 1 / (2 * a) = 1 / a :=
  calc 1 / (2 * a) + 1 / (2 * a)
      = (2 / (2 * a)) : by ring
  ... = (1 / a) : by rw [div_mul_right a two_ne_zero]

  lemma β_sub_one_neg : ∀ {n : ℕ}, β n - 1 ≤ 0 := λ n, by nlinarith [@hβ1 n]

  lemma l_5_5 (hc₅ : cond₅) (hc₆ : cond₆) (Θ : ℕ → ℕ) (Θar : is_rate_of_asymptotic_regularity Θ x) :
  is_rate_of_asymptotic_regularity_with_respect_to (Γ Θ) x T :=
  begin
    intros k n h,
    dsimp only at ⊢,
    rw [real.dist_eq, sub_zero, abs_eq_self.mpr dist_nonneg],
    have h_le₁ : NΛ ≤ n := le_trans (le_trans max3_le₁ (nat.le_succ _)) h,
    have h_le₂ : Θ (2 * Λ * (k + 1) - 1) ≤ n := le_trans (le_trans max3_le₂ (nat.le_succ _)) h,
    have h_le₃ : σ₅ (4 * K * Λ * (k + 1) - 1) ≤ n := le_trans (le_trans max3_le₃ (nat.le_succ _)) h,

    dunfold cond₅ at hc₅,
    dunfold cond₆ at hc₆,

    have k_succ_pos_real : 0 < (k : ℝ) + 1 := nat.cast_add_one_pos k,

    have hΛ : 1 / (l n) ≤ Λ := by {
      have h'₂ : 0 < l n := l_pos,
      have := hc₆ n h_le₁,
      refine (one_div_le l_pos Λ_pos_real).mpr this,
    },
    have h₁ : dist (T $ x n) (x n) ≤ Λ * (dist (x n) (x $ n + 1) + 2 * M * (1 - β n)) := by {
      have p₁ := l_3_2_v n,
      have p₂ : dist (x n) (T $ x n) ≤ (1 / l n) * (dist (x n) (x (n + 1)) + 2 * M * (1 - β n)) := by {
        apply helper,
        exact p₁,
      },
      rw dist_comm at p₂,
      have p₃ : (1 / l n) * (dist (x n) (x (n + 1)) + 2 * M * (1 - β n)) ≤ ↑Λ * (dist (x n) (x (n + 1)) + 2 * M * (1 - β n)) :=
        mul_mono_nonneg (add_nonneg dist_nonneg (by nlinarith [M_pos, @β_pos n, @hβ1 n])) hΛ,
      refine le_trans p₂ p₃,
    },

    have h₂ : dist (x n) (x $ n + 1) ≤ 1 / (2 * Λ * (k + 1)) := by {
      specialize Θar (2 * Λ * (k + 1) - 1) n h_le₂,
      dsimp only at Θar,
      rw [real.dist_eq, sub_zero, abs_eq_self.mpr dist_nonneg] at Θar,
      rw dist_comm at Θar,
      have h_2ΛK_pos : 0 < 2 * Λ * (k + 1) := by nlinarith,
      have : 2 * Λ * (k + 1) - 1 + 1 = 2 * Λ * (k + 1) := nat.succ_pred_eq_of_pos h_2ΛK_pos,
      rw this at Θar,
      simp only [nat.cast_bit0, nat.cast_add, nat.cast_one, nat.cast_mul] at Θar,
      exact Θar,
    },

    have h₃ : 2 * M * (1 - β n) ≤ 1 / (2 * Λ * (k + 1)) := by {
      specialize hc₅ ((4 * K * Λ * (k + 1) - 1)) n h_le₃,
      rw [real.dist_eq, abs_of_nonpos β_sub_one_neg, neg_sub] at hc₅,
      have h_4KK_pos : 0 < 4 * K * Λ * (k + 1) := by repeat { apply mul_pos }; try { nlinarith [K_pos] },
      have : 4 * K * Λ * (k + 1) - 1 + 1 = 4 * K * Λ * (k + 1) := nat.succ_pred_eq_of_pos h_4KK_pos,
      rw this at hc₅, clear this,
      have := mul_sides_left _ _ (2 * M) _ _ hc₅, -- this is awful
      all_goals { sorry },
    },

    calc dist (T $ x n) (x n)
        ≤ Λ * (dist (x n) (x $ n + 1) + 2 * M * (1 - β n)) : h₁
    ... ≤ Λ * ((1 / (2 * Λ * (k + 1))) + 2 * M * (1 - β n)) : (mul_le_mul_left Λ_pos_real).mpr (add_le_add_right h₂ _)
    ... = Λ * (1 / (2 * Λ * (k + 1))) + Λ * 2 * M * (1 - β n) : by ring
    ... = Λ / (2 * Λ * (k + 1)) + Λ * (2 * M * (1 - β n)) : by ring
    ... = Λ / (Λ * 2 * (k + 1)) + Λ * (2 * M * (1 - β n)) : by rw [mul_comm 2 (Λ : ℝ)]
    ... = 1 / (2 * (k + 1)) + Λ * (2 * M * (1 - β n)) : by {
      have : (Λ : ℝ) / ((Λ : ℝ) * 2 * (↑k + 1)) = 1 / (2 * (k + 1)) := by {
        rw [mul_assoc (Λ : ℝ) 2 (k + 1)],
        exact div_mul_right _ (ne_of_gt Λ_pos_real),
      },
      rw this,
    }
    ... ≤ 1 / (2 * (k + 1)) + Λ * (1 / (2 * Λ * (k + 1))) : add_le_add_left ((mul_le_mul_left Λ_pos_real).mpr h₃) _
    ... = 1 / (2 * (k + 1)) + Λ * (1 / (Λ * (2 * (k + 1)))) : by rw [mul_comm 2 (Λ : ℝ), mul_assoc (Λ : ℝ) 2 (k + 1)]
    ... = 1 / (2 * (k + 1)) + Λ / (Λ * (2 * (k + 1))) : by ring
    ... = 1 / (2 * (k + 1)) + 1 / (2 * (k + 1)) : by  rw [div_mul_right _ (ne_of_gt Λ_pos_real)]
    ... = 1 / (↑k + 1) :  add_div_two_self _ (ne_of_gt k_succ_pos_real),

  end

  include hψ
  theorem main₁
  (hc₂ : cond₂)
  (hc₃ : cond₃)
  (hc₄ : cond₄)
  : is_rate_of_asymptotic_regularity Ω x :=
  begin
    have xu := xu_quantitative a c s L χ σ₂ ψ @a_pos @a_lt_one @c_pos @s_pos L_pos @xu_ineq_s_a_c @s_le_L (l_5_3 hc₃ hc₄) (σ₂_rate_conv_P hc₂) hψ,
    dsimp only [is_rate_of_asymptotic_regularity],
    have : s = λ (i : ℕ), dist (x (i + 1)) (x i) := by refl,
    rw ←this, clear this,
    have : Ω = xu_rate χ σ₂ ψ L := by {
      ext,
      simp [Ω, xu_rate, L],
      ring,
    },
    rw this,
    exact xu,
  end

  theorem main₂
  (hc₂ : cond₂)
  (hc₃ : cond₃)
  (hc₄ : cond₄)
  (hc₅ : cond₅)
  (hc₆ : cond₆)
  : is_rate_of_asymptotic_regularity_with_respect_to Φ x T :=
  begin
    have : Φ = Γ Ω := by {
      ext,

      simp [Φ, Γ, Ω],
    },
    rw this,
    exact l_5_5 hc₅ hc₆ Ω (main₁ hc₂ hc₃ hc₄),
  end
end

#check finset.sum_add_distrib
open_locale big_operators
#check finset.sum_hom
example (a b : ℕ → ℝ) (c : ℝ) (n : ℕ) : ∑ i in finset.range n, c * a i = c * (∑ i in finset.range n, a i) :=
begin
  exact (finset.range n).sum_hom (has_mul.mul c),
end
#check div_le_one

example (a : ℝ) (h : 0 < a) : 0 < (1 / a) := by {
  exact one_div_pos.mpr h,
}

example (k : ℕ) : (0 : ℝ) < (k.succ) := by {
  have : (0 : ℕ) < k.succ := nat.succ_pos k,
  exact nat.cast_pos.mpr (nat.succ_pos k),
}

example (a b : ℝ) (h : a ≤ b) (h₁ : 0 < a) (h₂ : 0 < b) : (a / b ≤ 1) :=
by {
  exact (div_le_one h₂).mpr h,
}
/-
Try this: exact gt_of_ge_of_gt h₂ h₁
-/

example (a b : ℝ) (h : 1 / a ≤ b) (h₁ : 0 < a) (h₂ : 0 < b) : 1 / b ≤ a := by {
  exact (one_div_le h₁ h₂).mp h,
}

example (a b c : ℝ) (h : b ≤ c) (h₁ : 0 < a) : a * b ≤ a * c := by {
  exact (mul_le_mul_left h₁).mpr h,
}

example (a b c : ℝ) (h : a ≤ b) : a + c ≤ b + c := by {
  exact add_le_add_right h c,
}

example (a b : ℝ) (h₁: 0 < a) (h₂ : 0 < b) : (a * b)⁻¹ = b⁻¹ * a⁻¹ := by {
  exact mul_inv_rev' a b,
}
example (a : ℝ) (h : 0 < a) : a * a⁻¹ = 1 := by {
}

example (a b : ℝ) (h₁ : 0 ≠ a) (h₂ : 0 ≠ b) : a / (a * b) = 1 / b := by {
  exact div_mul_right b (ne.symm h₁),
  -- ring_nf,
  -- rw [mul_inv_rev', mul_assoc, inv_mul_cancel (ne_of_gt h₁), mul_one],
}

example (a : ℝ) : a + a = 2 * a := by {
  ring,
}

example (a : ℝ)  (h : a ≠ 0) : 1 / (2 * a) + 1 / (2 * a) = 1 / a :=
calc 1 / (2 * a) + 1 / (2 * a)
    = (2 / (2 * a)) : by ring
... = (1 / a) : by rw [div_mul_right a two_ne_zero]

example (a b c : ℝ) (ha : 0 < a) (hb : 0 < b) (hc : 0 < c)
: a * b ≤ c → b ≤ a⁻¹ * c := by {
  have : a * b ≤ c → a⁻¹ * (a * b) ≤ a⁻¹ * c := (mul_le_mul_left (inv_pos.mpr ha)).mpr,
  rw [←mul_assoc, inv_mul_cancel (ne_of_gt ha), one_mul] at this,
  exact this,
}

example (a b c : ℝ) (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : b ≤ c → a * b ≤ a * c := by {
  exact (mul_le_mul_left ha).mpr,
}

example (a b c : ℝ) (h' : b ≤ c) (h : 0 ≤ a) : b * a ≤ c * a := by {
  exact mul_mono_nonneg h h',
}

#check (mul_le_mul_left _).mpr

example (a b : ℝ) : - (a - b) = b -a := neg_sub a b

example (a : ℝ) (h : a ≤ 0) : abs a = -a := abs_of_nonpos h

example (s : finset ℕ) (x : ℕ) (h : x ∈ s) : x ≤ s.sup id := by {
  have := @finset.le_sup _ _ _ _ id _ h,
  exact this,
}

example (a : ℕ) : a ≤ a + 1 := nat.le_succ a

#check finset.prod_nonneg
#check finset.sum_nonneg

example (a b c d : ℝ) (h₁ : 0 ≠ a) (h₂ : 0 ≠ c) : (a * b) / (a * c) = b / c := by {
  exact mul_div_mul_left b c (ne.symm h₁),
}


/-
Copyright (c) 2022 Christopher Hoskin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Christopher Hoskin
-/
import algebra.ring.idempotents
import tactic.noncomm_ring
import analysis.normed.group.basic

/-!
# M-structure

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

A projection P on a normed space X is said to be an L-projection (`is_Lprojection`) if, for all `x`
in `X`,
$\|x\| = \|P x\| + \|(1 - P) x\|$.

A projection P on a normed space X is said to be an M-projection if, for all `x` in `X`,
$\|x\| = max(\|P x\|,\|(1 - P) x\|)$.

The L-projections on `X` form a Boolean algebra (`is_Lprojection.subtype.boolean_algebra`).

## TODO (Motivational background)

The M-projections on a normed space form a Boolean algebra.

The range of an L-projection on a normed space `X` is said to be an L-summand of `X`. The range of
an M-projection is said to be an M-summand of `X`.

When `X` is a Banach space, the Boolean algebra of L-projections is complete. Let `X` be a normed
space with dual `X^*`. A closed subspace `M` of `X` is said to be an M-ideal if the topological
annihilator `M^∘` is an L-summand of `X^*`.

M-ideal, M-summands and L-summands were introduced by Alfsen and Effros in [alfseneffros1972] to
study the structure of general Banach spaces. When `A` is a JB*-triple, the M-ideals of `A` are
exactly the norm-closed ideals of `A`. When `A` is a JBW*-triple with predual `X`, the M-summands of
`A` are exactly the weak*-closed ideals, and their pre-duals can be identified with the L-summands
of `X`. In the special case when `A` is a C*-algebra, the M-ideals are exactly the norm-closed
two-sided ideals of `A`, when `A` is also a W*-algebra the M-summands are exactly the weak*-closed
two-sided ideals of `A`.

## Implementation notes

The approach to showing that the L-projections form a Boolean algebra is inspired by
`measure_theory.measurable_space`.

Instead of using `P : X →L[𝕜] X` to represent projections, we use an arbitrary ring `M` with a
faithful action on `X`. `continuous_linear_map.apply_module` can be used to recover the `X →L[𝕜] X`
special case.

## References

* [Behrends, M-structure and the Banach-Stone Theorem][behrends1979]
* [Harmand, Werner, Werner, M-ideals in Banach spaces and Banach algebras][harmandwernerwerner1993]

## Tags

M-summand, M-projection, L-summand, L-projection, M-ideal, M-structure

-/

variables (X : Type*) [normed_add_comm_group X]
variables {M : Type*} [ring M] [module M X]
/--
A projection on a normed space `X` is said to be an L-projection if, for all `x` in `X`,
$\|x\| = \|P x\| + \|(1 - P) x\|$.

Note that we write `P • x` instead of `P x` for reasons described in the module docstring.
-/
structure is_Lprojection (P : M) : Prop :=
(proj : is_idempotent_elem P)
(Lnorm : ∀ (x : X), ‖x‖ = ‖P • x‖ + ‖(1 - P) • x‖)

/--
A projection on a normed space `X` is said to be an M-projection if, for all `x` in `X`,
$\|x\| = max(\|P x\|,\|(1 - P) x\|)$.

Note that we write `P • x` instead of `P x` for reasons described in the module docstring.
-/
structure is_Mprojection (P : M) : Prop :=
(proj : is_idempotent_elem P)
(Mnorm : ∀ (x : X), ‖x‖ = (max ‖P • x‖ ‖(1 - P) • x‖))

variables {X}

namespace is_Lprojection

lemma Lcomplement {P : M} (h: is_Lprojection X P) : is_Lprojection X (1 - P) :=
⟨h.proj.one_sub, λ x, by { rw [add_comm, sub_sub_cancel], exact h.Lnorm x }⟩

lemma Lcomplement_iff (P : M) : is_Lprojection X P ↔ is_Lprojection X (1 - P) :=
⟨Lcomplement, λ h, sub_sub_cancel 1 P ▸ h.Lcomplement⟩

lemma commute [has_faithful_smul M X] {P Q : M} (h₁ : is_Lprojection X P)
  (h₂ : is_Lprojection X Q) : commute P Q :=
begin
  have PR_eq_RPR : ∀ R : M, is_Lprojection X R → P * R = R * P * R := λ R h₃,
  begin
    refine @eq_of_smul_eq_smul _ X _ _ _ _ (λ x, _),
    rw ← norm_sub_eq_zero_iff,
    have e1 : ‖R • x‖ ≥ ‖R • x‖ + 2 • ‖ (P * R) • x - (R * P * R) • x‖ :=
    calc ‖R • x‖ = ‖R • (P • (R • x))‖ + ‖(1 - R) • (P • (R • x))‖ +
                   (‖(R * R) • x - R • (P • (R • x))‖ + ‖(1 - R) • ((1 - P) • (R • x))‖) :
      by rw [h₁.Lnorm, h₃.Lnorm, h₃.Lnorm ((1 - P) • (R • x)), sub_smul 1 P,
        one_smul, smul_sub, mul_smul]
    ... = ‖R • (P • (R • x))‖ + ‖(1 - R) • (P • (R • x))‖ + (‖R • x - R • (P • (R • x))‖
      + ‖((1 - R) * R) • x - (1 - R) • (P • (R • x))‖) : by rw [h₃.proj.eq,
        sub_smul 1 P, one_smul, smul_sub, mul_smul]
    ... = ‖R • (P • (R • x))‖ + ‖(1 - R) • (P • (R • x))‖ +
          (‖R • x - R • (P • (R • x))‖ + ‖(1 - R) • (P • (R • x))‖) :
      by rw [sub_mul, h₃.proj.eq, one_mul, sub_self, zero_smul, zero_sub,
        norm_neg]
    ... = ‖R • (P • (R • x))‖ + ‖R • x - R • (P • (R • x))‖ + 2•‖(1 - R) • (P • (R • x))‖ : by abel
    ... ≥ ‖R • x‖ + 2 • ‖ (P * R) • x - (R * P * R) • x‖ : by
      { rw ge,
        have := add_le_add_right
          (norm_le_insert' (R • x) (R • (P • (R • x)))) (2•‖(1 - R) • (P • (R • x))‖),
        simpa only [mul_smul, sub_smul, one_smul] using this },
    rw ge at e1,
    nth_rewrite_rhs 0 ← add_zero (‖R • x‖) at e1,
    rw [add_le_add_iff_left, two_smul, ← two_mul] at e1,
    rw le_antisymm_iff,
    refine ⟨_, norm_nonneg _⟩,
    rwa [←mul_zero (2 : ℝ), mul_le_mul_left (show (0 : ℝ) < 2, by norm_num)] at e1
  end,
  have QP_eq_QPQ : Q * P = Q * P * Q,
  { have e1 : P * (1 - Q) = P * (1 - Q) - (Q * P - Q * P * Q) :=
    calc P * (1 - Q) = (1 - Q) * P * (1 - Q) : by rw PR_eq_RPR (1 - Q) h₂.Lcomplement
    ... = P * (1 - Q) - (Q * P - Q * P * Q) : by noncomm_ring,
    rwa [eq_sub_iff_add_eq, add_right_eq_self, sub_eq_zero] at e1 },
  show P * Q = Q * P, by rw [QP_eq_QPQ, PR_eq_RPR Q h₂]
end

lemma mul [has_faithful_smul M X] {P Q : M} (h₁ : is_Lprojection X P) (h₂ : is_Lprojection X Q) :
  is_Lprojection X (P * Q) :=
begin
  refine ⟨is_idempotent_elem.mul_of_commute (h₁.commute h₂) h₁.proj h₂.proj, _⟩,
  intro x,
  refine le_antisymm _ _,
  { calc ‖ x ‖ = ‖(P * Q) • x + (x - (P * Q) • x)‖ : by rw add_sub_cancel'_right ((P * Q) • x) x
    ... ≤ ‖(P * Q) • x‖ + ‖ x - (P * Q) • x ‖ : by apply norm_add_le
    ... = ‖(P * Q) • x‖ + ‖(1 - P * Q) • x‖ : by rw [sub_smul,
      one_smul] },
  { calc ‖x‖ = ‖P • (Q • x)‖ + (‖Q • x - P • (Q • x)‖ + ‖x - Q • x‖) : by
      rw [h₂.Lnorm x, h₁.Lnorm (Q • x),
          sub_smul, one_smul,
          sub_smul, one_smul, add_assoc]
    ... ≥ ‖P • (Q • x)‖ + ‖(Q • x - P • (Q • x)) + (x - Q • x)‖ :
      (add_le_add_iff_left (‖P • (Q • x)‖)).mpr (norm_add_le (Q • x - P • (Q • x)) (x - Q • x))
    ... = ‖(P * Q) • x‖ + ‖(1 - P * Q) • x‖ : by rw [sub_add_sub_cancel',
      sub_smul, one_smul,
      mul_smul] }
end

lemma join [has_faithful_smul M X] {P Q : M} (h₁ : is_Lprojection X P) (h₂ : is_Lprojection X Q) :
  is_Lprojection X (P + Q - P * Q) :=
begin
  convert (Lcomplement_iff _).mp (h₁.Lcomplement.mul h₂.Lcomplement) using 1,
  noncomm_ring,
end

instance : has_compl { f : M // is_Lprojection X f } :=
⟨λ P, ⟨1 - P, P.prop.Lcomplement⟩⟩

@[simp] lemma coe_compl (P : {P : M // is_Lprojection X P}) :
  ↑(Pᶜ) = (1 : M) - ↑P := rfl

instance [has_faithful_smul M X] : has_inf {P : M // is_Lprojection X P} :=
⟨λ P Q, ⟨P * Q, P.prop.mul Q.prop⟩ ⟩

@[simp] lemma coe_inf [has_faithful_smul M X] (P Q : {P : M // is_Lprojection X P}) :
  ↑(P ⊓ Q) = ((↑P : (M)) * ↑Q) := rfl

instance [has_faithful_smul M X] : has_sup {P : M // is_Lprojection X P} :=
⟨λ P Q, ⟨P + Q - P * Q, P.prop.join Q.prop⟩ ⟩

@[simp] lemma coe_sup [has_faithful_smul M X] (P Q : {P : M // is_Lprojection X P}) :
  ↑(P ⊔ Q) = ((↑P : M) + ↑Q - ↑P * ↑Q) := rfl

instance [has_faithful_smul M X] : has_sdiff {P : M // is_Lprojection X P} :=
⟨λ P Q, ⟨P * (1 - Q), by exact P.prop.mul Q.prop.Lcomplement ⟩⟩

@[simp] lemma coe_sdiff [has_faithful_smul M X] (P Q : {P : M // is_Lprojection X P}) :
  ↑(P \ Q) = (↑P : M) * (1 - ↑Q) := rfl

instance [has_faithful_smul M X] : partial_order {P : M // is_Lprojection X P} :=
{ le := λ P Q, (↑P : M) = ↑(P ⊓ Q),
  le_refl := λ P, by simpa only [coe_inf, ←sq] using (P.prop.proj.eq).symm,
  le_trans := λ P Q R h₁ h₂, by { simp only [coe_inf] at ⊢ h₁ h₂, rw [h₁, mul_assoc, ←h₂] },
  le_antisymm := λ P Q h₁ h₂, subtype.eq (by convert (P.prop.commute Q.prop).eq) }

lemma le_def [has_faithful_smul M X] (P Q : {P : M // is_Lprojection X P}) :
  P ≤ Q ↔ (P : M) = ↑(P ⊓ Q) :=
iff.rfl

instance : has_zero {P : M // is_Lprojection X P} :=
⟨⟨0, ⟨by rw [is_idempotent_elem, zero_mul],
     λ x, by simp only [zero_smul, norm_zero, sub_zero,
                        one_smul, zero_add]⟩⟩⟩

@[simp] lemma coe_zero : ↑(0 : {P : M // is_Lprojection X P}) = (0 : M) :=
rfl

instance : has_one {P : M // is_Lprojection X P} :=
⟨⟨1, sub_zero (1 : M) ▸ (0 : {P : M // is_Lprojection X P}).prop.Lcomplement⟩⟩

@[simp] lemma coe_one : ↑(1 : {P : M // is_Lprojection X P}) = (1 : M) :=
rfl

instance [has_faithful_smul M X] : bounded_order {P : M // is_Lprojection X P} :=
{ top := 1,
  le_top := λ P, (mul_one (P : M)).symm,
  bot := 0,
  bot_le := λ P, (zero_mul (P : M)).symm, }

@[simp] lemma coe_bot [has_faithful_smul M X] :
  ↑(bounded_order.bot : {P : M // is_Lprojection X P}) = (0 : M) := rfl

@[simp]

lemma compl_mul {P : {P : M // is_Lprojection X P}} {Q : M} :
  ↑Pᶜ * Q = Q - ↑P * Q := by rw [coe_compl, sub_mul, one_mul]

lemma mul_compl_self {P : {P : M // is_Lprojection X P}} :
  (↑P : M) * (↑Pᶜ) = 0 :=
by rw [coe_compl, mul_sub, mul_one, P.prop.proj.eq, sub_self]

lemma distrib_lattice_lemma [has_faithful_smul M X] {P Q R : {P : M // is_Lprojection X P}} :
  ((↑P : M) + ↑Pᶜ * R) * (↑P + ↑Q * ↑R * ↑Pᶜ) = (↑P + ↑Q * ↑R * ↑Pᶜ) :=
by rw [add_mul, mul_add, mul_add, mul_assoc ↑Pᶜ ↑R (↑Q * ↑R * ↑Pᶜ), ← mul_assoc ↑R (↑Q * ↑R) ↑Pᶜ,
    ← coe_inf Q, (Pᶜ.prop.commute R.prop).eq, ((Q ⊓ R).prop.commute Pᶜ.prop).eq,
    (R.prop.commute (Q ⊓ R).prop).eq, coe_inf Q, mul_assoc ↑Q, ← mul_assoc, mul_assoc ↑R,
    (Pᶜ.prop.commute P.prop).eq, mul_compl_self, zero_mul, mul_zero, zero_add, add_zero,
    ← mul_assoc,
    P.prop.proj.eq, R.prop.proj.eq, ← coe_inf Q, mul_assoc, ((Q ⊓ R).prop.commute Pᶜ.prop).eq,
    ← mul_assoc, Pᶜ.prop.proj.eq]

instance [has_faithful_smul M X] : distrib_lattice {P : M // is_Lprojection X P} :=
{ le_sup_left := λ P Q, by rw [le_def, coe_inf, coe_sup, ← add_sub, mul_add, mul_sub, ← mul_assoc,
    P.prop.proj.eq, sub_self, add_zero],
  le_sup_right := λ P Q,
  begin
    rw [le_def, coe_inf, coe_sup, ← add_sub, mul_add, mul_sub, commute.eq (commute P.prop Q.prop),
      ← mul_assoc, Q.prop.proj.eq, add_sub_cancel'_right],
  end,
  sup_le := λ P Q R,
  begin
    rw [le_def, le_def, le_def, coe_inf, coe_inf, coe_sup, coe_inf, coe_sup, ← add_sub, add_mul,
      sub_mul, mul_assoc],
    intros h₁ h₂,
    rw [← h₂, ← h₁],
  end,
  inf_le_left := λ P Q, by rw [le_def, coe_inf, coe_inf, coe_inf, mul_assoc,
    (Q.prop.commute P.prop).eq, ← mul_assoc, P.prop.proj.eq],
  inf_le_right := λ P Q, by rw [le_def, coe_inf, coe_inf, coe_inf, mul_assoc, Q.prop.proj.eq],
  le_inf := λ P Q R,
  begin
    rw [le_def, le_def, le_def, coe_inf, coe_inf, coe_inf, coe_inf, ← mul_assoc],
    intros h₁ h₂,
    rw [← h₁, ← h₂],
  end,
  le_sup_inf := λ P Q R,
  begin
    have e₁: ↑((P ⊔ Q) ⊓ (P ⊔ R)) = ↑P + ↑Q * ↑R * ↑Pᶜ :=
    by rw [coe_inf, coe_sup, coe_sup,
      ← add_sub, ← add_sub, ←compl_mul, ←compl_mul, add_mul, mul_add,
      (Pᶜ.prop.commute Q.prop).eq, mul_add, ← mul_assoc, mul_assoc ↑Q, (Pᶜ.prop.commute P.prop).eq,
      mul_compl_self, zero_mul, mul_zero, zero_add, add_zero, ← mul_assoc, mul_assoc ↑Q,
      P.prop.proj.eq, Pᶜ.prop.proj.eq, mul_assoc, (Pᶜ.prop.commute R.prop).eq, ← mul_assoc],
    have e₂ : ↑((P ⊔ Q) ⊓ (P ⊔ R)) * ↑(P ⊔ Q ⊓ R) = ↑P + ↑Q * ↑R * ↑Pᶜ := by rw [coe_inf, coe_sup,
      coe_sup, coe_sup, ← add_sub, ← add_sub, ← add_sub, ←compl_mul, ←compl_mul,
      ←compl_mul, (Pᶜ.prop.commute (Q⊓R).prop).eq, coe_inf, mul_assoc, distrib_lattice_lemma,
      (Q.prop.commute R.prop).eq, distrib_lattice_lemma],
    rw [le_def, e₁, coe_inf, e₂],
  end,
  .. is_Lprojection.subtype.has_inf,
  .. is_Lprojection.subtype.has_sup,
  .. is_Lprojection.subtype.partial_order }

instance [has_faithful_smul M X] : boolean_algebra {P : M // is_Lprojection X P} :=
{ inf_compl_le_bot := λ P,
    (subtype.ext (by rw [coe_inf, coe_compl, coe_bot, ← coe_compl, mul_compl_self])).le,
  top_le_sup_compl := λ P, (subtype.ext(by rw [coe_top, coe_sup, coe_compl,
    add_sub_cancel'_right, ← coe_compl, mul_compl_self, sub_zero])).le,
  sdiff_eq := λ P Q, subtype.ext $ by rw [coe_sdiff, ← coe_compl, coe_inf],
  .. is_Lprojection.subtype.has_compl,
  .. is_Lprojection.subtype.has_sdiff,
  .. is_Lprojection.subtype.bounded_order,
  .. is_Lprojection.subtype.distrib_lattice }

end is_Lprojection


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

universes u v l

namespace Mathlib

/-!
# Star algebras

Introduces the notion of a star algebra over a star ring.
-/

/--
A star algebra `A` over a star ring `R` is an algebra which is a star ring,
and the two star structures are compatible in the sense
`star (r • a) = star r • star a`.
-/
-- Note that we take `star_ring A` as a typeclass argument, rather than extending it,

-- to avoid having multiple definitions of the star operation.

class star_algebra (R : Type u) (A : Type v) [comm_semiring R] [star_ring R] [semiring A] [star_ring A] [algebra R A]
where
  star_smul : ∀ (r : R) (a : A), star (r • a) = has_star.star r • star a

@[simp] theorem star_smul (R : Type u) (A : Type v) [comm_semiring R] [star_ring R] [semiring A] [star_ring A] [algebra R A] [star_algebra R A] (r : R) (a : A) : star (r • a) = star r • star a :=
  star_algebra.star_smul r a


import SciLean
-- import SciLean.Tactic.AutoDiff

open SciLean

variable {α β γ : Type}
variable {X Y Z W : Type} [SemiHilbert X] [SemiHilbert Y] [SemiHilbert Z] [SemiHilbert W]
variable {Y₁ Y₂ : Type} [SemiHilbert Y₁] [SemiHilbert Y₂]
variable {ι κ : Type} [Enumtype ι] [Enumtype κ]

-- set_option maxHeartbeats 4000
-- set_option synthInstance.maxHeartbeats 1000
-- set_option synthInstance.maxSize 80

example {ι} [Enumtype ι] (i : ι)
  : (λ (f : ι → ℝ) => f i)†
    =
    λ f' i' => [[i=i']] * f' :=
by
  symdiff
  done

#check sum

example {n} (i : Fin n) : HasAdjointT fun (x : Fin n → ℝ) => x i := by infer_instance
example {n} : HasAdjointT fun (x : Fin n → ℝ) => sum x := by infer_instance
example {n} : HasAdjointT fun (x : Fin n → ℝ) => ∑ i, x i := by infer_instance
example {n} (y : Fin n → ℝ) : HasAdjointT fun (x : Fin n → ℝ) => ∑ i, y i * x i := by infer_instance

-- set_option trace.Meta.synthInstance true in
example {n} (y : Fin n → ℝ) : HasAdjointT fun (x : Fin n → ℝ) => ∑ i, x i * y i := by infer_instance
example {n m} (A : Fin n → Fin m → ℝ) (i : Fin n) : HasAdjointT fun (x : Fin m → ℝ) => ∑ j, A i j * x j := by infer_instance

example {n} :
  (λ (x : Fin n → ℝ) => ∑ i, (x i))†
  =
  (λ y i => y) := by simp only [comp.arg_x.adj_simp]; symdiff; done

example {n k} (x : Fin n → ℝ)
    : (λ (w : Fin k → ℝ) => λ (i : Fin n) => ∑ j, w j * x (i + j) )†
      =
      λ (y : Fin n → ℝ) => λ (j : Fin k) => ∑ i, x i * y (i - j) := sorry_proof

example (p q : ℝ ⟿ ℝ)
  : (λ (f : ℝ ⟿ ℝ) => λ x ⟿ p x * f x + q x * ⅆ f x)†
     =
    (λ (f : ℝ ⟿ ℝ) => λ x ⟿ p x * f x - ⅆ (x':=x), q x' * f x') := sorry_proof

example (f : X → Y → Z) [IsSmoothNT 2 f]
  : differential (λ ((x,y) : X×Y) => f x y)
    =
    λ (x,y) (dx,dy) =>
      ∂ (λ x' => f x' y) x dx
      +
      ∂ (λ y' => f x y') y dy
    := by symdiff; done

example (f : X → Y → Z) :
  IsSmoothNT 2 f
  ↔
  (∀ x, IsSmoothT (f x)) ∧ IsSmoothT (λ x => λ y ⟿ f x y) := sorry_proof

@[diff]
theorem adjoint_pointwise_fun (f : ι → X → Y) [∀ i, HasAdjointT (f i)]
  : (λ (x : ι → X) i => (f i) (x i))†
    =
    (λ (y : ι → Y) i => (f i)† (y i)) := by symdiff; sorry_proof

set_option trace.Meta.Tactic.simp.rewrite true in
@[diff]
theorem adjoint_pointwise_array [PowType Xι ι X] (f : ι → X → Y) [∀ i, HasAdjointT (f i)]
  : (λ (x : X^ι)  => λ i => (f i) (x[i]))†
    =
    (λ (y : ι→Y) => ⊞ i,   (f i)† (y i)) := by symdiff; sorry_proof

@[diff low-3]
theorem swap.arg_y.adj_simp' {Rn Y Z} [Enumtype ι] [FinVec Rn ι] [Hilbert Y] [Hilbert Z]
  (f : Rn → Y → Z)--  [∀ i, HasAdjointT (f i)] [IsSmoothNT 2 f]
  : have : IsSmoothNT 2 f := sorry_proof
    have : ∀ i, HasAdjointT (f i) := sorry_proof
    (λ y => λ x ⟿ f x y)†
    =
    λ g => limitOverWholeDomain (∫ x, (f x)† (g x)) := sorry_proof

set_option trace.Meta.Tactic.simp.unify true in
set_option trace.Meta.Tactic.simp.discharge true in
@[diff]
theorem adjoint_pointwise_smooth_fun {W X Y} [Hilbert X] [Hilbert Y] [Enumtype ι] [FinVec W ι] (f : W → X → Y) [∀ w, HasAdjointT (f w)] [IsSmoothNT 2 f]
  : (λ (x : W⟿X) => λ w ⟿ (f w) (x w))†
    =
    (λ (y : W⟿Y) => λ w ⟿ (f w)† (y w)) := by simp only [swap.arg_y.adj_simp']; symdiff; sorry_proof

@[diff]
theorem adjoint_pointwise_lin_fun {W X Y} [Hilbert X] [Hilbert Y] [Enumtype ι] [FinVec W ι] (f : X → Y) [hf : HasAdjointT f]
  : have : IsLinT f := ⟨hf.1.2⟩
    (λ (x : W⊸X) => λ w ⊸ f (x w))†
    =
    (λ (y : W⊸Y) => λ w ⊸ f† (y w)) := by symdiff; sorry_proof

example [Enumtype I] [PowType YI I Y] (f : X → Y) [HasAdjointT f]
  : (λ (x : I → X) => ⊞ i, f (x i))†
    =
    (λ y i => f† y[i]) := by symdiff; done

example [Enumtype I] [PowType XI I X] [PowType YI I Y] (f : X → Y) [HasAdjointT f]
  : (λ (x : X^I) => ⊞ i, f (x[i]))†
    =
    (λ y => ⊞ i, f† y[i]) := by symdiff; done

-- set_option trace.Meta.Tactic.simp.rewrite true in
-- set_option trace.Meta.Tactic.simp.unify true in
example {n} :
  (λ (x : Fin n → ℝ) i => 2*(x i))†
  =
  (λ y i => 2 * y i) := by symdiff; done

unif_hint (f? : X → Y)
  (op : X → X → Y)
where
  f? =?= λ x => op x x
  |-
  (λ (x : ι → X) i => f? (x i))†
  =?=
  (λ (x : ι → X) i => op (x i) (x i))†

example : HasAdjointT (λ x : X => x + x) := by infer_instance

example {n} :
  (λ (x : Fin n → ℝ) i => x i + x i)†
  =
  (λ y i => y i + y i) :=
by symdiff_core only []; done

example {n m : Nat} (f : Fin n → Fin m → ℝ → ℝ) [∀ i j, HasAdjointT (f i j)]
  : (λ (x : ℝ^{m}) => ⊞ i, ∑ j, (f i j) x[j])†
    =
    λ y => ⊞ j, ∑ i, (f i j)† y[i] :=
by
  unfold introPowElem
  symdiff; done

--------------------------------------------------------------------------------
-- Linear Algebra
--------------------------------------------------------------------------------

--------------------------------------------------------------------------------
-- Variants on transposing matrix multiplication and other tensor contractions
--------------------------------------------------------------------------------

example {n m} (A : Fin n → Fin m → ℝ) :
  (λ (x : Fin m → ℝ) => λ i => ∑ j, A i j * x j)†
  =
  (λ y => λ i => ∑ j, A j i * y j) := by symdiff; done

example {n m} (A : ℝ^{n,m}) :
  (λ (x : ℝ^{m}) => ⊞ i, ∑ j, A[i,j] * x[j])†
  =
  (λ y => ⊞ i, ∑ j, A[j,i] * y[j]) := by symdiff; done

example {n m} (A : Fin n → Fin m → ℝ) :
  (λ (x : Fin m → ℝ) => λ i => ∑ j, x j * A i j)†
  =
  (λ y => λ i => ∑ j, y j * A j i) := by symdiff; done

example {n m} (A : Fin n → Fin m → ℝ) :
  (λ (x : Fin m → ℝ) => λ i => ∑ j, 2 * x j * A i j)†
  =
  (λ y => λ i => ∑ j, 2 * y j * A j i) := by symdiff; done

example {n m} (A : Fin n → Fin m → ℝ) :
  (λ (x : Fin m → ℝ) => λ i => ∑ j, A i j * x j * A i j)†
  =
  (λ y => λ i => ∑ j, A j i * y j * A j i) := by symdiff; done

-- Make these work!
example {n m} (A B : Fin n → Fin m → ℝ) :
  (λ (x : Fin m → ℝ) => λ i => ∑ j, (A i j * x j + B i j * x j))†
  =
  (λ y => λ i => ∑ j, A j i * y j) := by symdiff; admit

example {n m l} (A : Fin n → Fin m → Fin l → ℝ) :
  (λ (x : Fin m → Fin l → ℝ) => λ i => ∑ j k, A i j k * x j k)†
  =
  (λ y => λ j k => ∑ i, A i j k * y i) :=
by symdiff; admit


import data.real.basic
import data.real.ereal
import order.conditionally_complete_lattice

open set
open_locale classical
noncomputable theory

@[simp]
lemma set.eq_univ_iff_forall' {α : Type} (p : α → Prop) : {x : α | p x} = univ ↔ ∀ x, p x :=
set.eq_univ_iff_forall

@[simp]
lemma set.eq_empty_iff_forall_not_mem' {α : Type} {p : α → Prop} : {x : α | p x} = ∅ ↔ ∀ x, ¬ p x :=
set.eq_empty_iff_forall_not_mem

lemma sUnion_eq_of_pointwise {X : Type} {U : set X} {ℬ : set (set X)} :
  ( ∃ J ⊆ ℬ, U = ⋃₀ J ) ↔  (∀ x ∈ U, ∃ W ∈ ℬ, x ∈ W ∧ W ⊆ U) :=
begin
  split,
  { rintros ⟨J, hJ1, rfl⟩ x ⟨t, ht1, ht2⟩,
    exact ⟨t, hJ1 ht1, ht2, subset_sUnion_of_mem ht1⟩ },
  { intro h,
    refine ⟨{W ∈ ℬ | W ⊆ U}, sep_subset _ _, _⟩,
    apply eq_of_subset_of_subset,
    { intros x hx,
      obtain ⟨W, hWB, hXw, hwu⟩ := h x hx,
      exact ⟨W, ⟨hWB, hwu⟩, hXw⟩ },
    { rintros x ⟨W, ⟨-, hWU⟩, hXw⟩,
      exact hWU hXw, } }
end

lemma ereal.eq_top_iff (x : ereal) : x = ⊤ ↔ ∀ (y : ℝ), (y : ereal) < x :=
begin
  split,
  { intro h,
    subst h,
    exact ereal.coe_lt_top },
  { intro h,
    by_contradiction hc,
    by_cases hb : x = ⊥,
    { subst hb,
      simpa [not_lt_bot] using (h 0) },
    let z := x.to_real,
    have hz : (z : ereal) = x := ereal.coe_to_real hc hb,
    simpa [hz] using (h z) }
end

lemma ereal.eq_bot_iff (x : ereal) : x = ⊥ ↔ ∀ (y : ℝ), x < (y : ereal) :=
begin
  split,
  { intro h,
    subst h,
    exact ereal.bot_lt_coe },
  { intro h,
    by_contradiction hc,
    by_cases ht : x = ⊤,
    { subst ht,
      simpa [not_lt_bot] using (h 0) },
    let z := x.to_real,
    have hz : (z : ereal) = x := (ereal.coe_to_real ht hc),
    simpa [hz] using (h z) }
end

lemma inter_is_not_is_empty_intersection {X : Type} {x : X} {U V : set X}
  (hxU : x ∈ U) (hUV : U ∩ V = ∅ ) : x ∉ V := disjoint_left.1 (disjoint_iff_inter_eq_empty.2 hUV) hxU

lemma image_sUnion {X Y: Type} (A: set(set X)) (f: X → Y) : f '' (⋃₀ A) = ⋃₀ { V: set Y | ∃ U: set X, U ∈ A ∧ V = f '' U}:=
begin
  ext1 y,
  split,{
    rintro ⟨x, ⟨U, hU, hx⟩, _⟩,
    use f '' U,
    simp only [mem_image, mem_set_of_eq],
    tauto,
  },
  {
    rintro ⟨_, ⟨⟨U, hU, _, _⟩, x, _⟩⟩,
    use x,
    simp only [exists_prop, mem_set_of_eq],
    tauto,
  },
end

lemma neq_elements_prod {X Y : Type} {x y : X × Y} (h : x ≠ y) : x.1 ≠ y.1 ∨ x.2 ≠ y.2 :=
begin
  by_contradiction hh,
  push_neg at hh,
  exact h (prod.ext_iff.mpr hh),
end

lemma abs_add_nonneg (x : ℝ) : 0 ≤ abs x + x :=
begin
  by_cases h : 0 ≤ x,
  { linarith [abs_of_nonneg h] },
  { push_neg at h,
    linarith [abs_of_neg h] },
end