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

! This file was ported from Lean 3 source module probability.variance
! leanprover-community/mathlib commit 57ac39bd365c2f80589a700f9fbb664d3a1a30c2
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Probability.Notation
import Mathbin.Probability.Integration

/-!
# Variance of random variables

We define the variance of a real-valued random variable as `Var[X] = 𝔼[(X - 𝔼[X])^2]` (in the
`probability_theory` locale).

## Main definitions

* `probability_theory.evariance`: the variance of a real-valued random variable as a extended
  non-negative real.
* `probability_theory.variance`: the variance of a real-valued random variable as a real number.

## Main results

* `probability_theory.variance_le_expectation_sq`: the inequality `Var[X] ≤ 𝔼[X^2]`.
* `probability_theory.meas_ge_le_variance_div_sq`: Chebyshev's inequality, i.e.,
      `ℙ {ω | c ≤ |X ω - 𝔼[X]|} ≤ ennreal.of_real (Var[X] / c ^ 2)`.
* `probability_theory.meas_ge_le_evariance_div_sq`: Chebyshev's inequality formulated with
  `evariance` without requiring the random variables to be L².
* `probability_theory.indep_fun.variance_add`: the variance of the sum of two independent
  random variables is the sum of the variances.
* `probability_theory.indep_fun.variance_sum`: the variance of a finite sum of pairwise
  independent random variables is the sum of the variances.
-/

open MeasureTheory Filter Finset

noncomputable section

open BigOperators MeasureTheory ProbabilityTheory ENNReal NNReal

namespace ProbabilityTheory

/-- The `ℝ≥0∞`-valued variance of a real-valued random variable defined as the Lebesgue integral of
`(X - 𝔼[X])^2`. -/
def evariance {Ω : Type _} {m : MeasurableSpace Ω} (X : Ω → ℝ) (μ : Measure Ω) : ℝ≥0∞ :=
  ∫⁻ ω, ‖X ω - μ[X]‖₊ ^ 2 ∂μ
#align probability_theory.evariance ProbabilityTheory.evariance

/-- The `ℝ`-valued variance of a real-valued random variable defined by applying `ennreal.to_real`
to `evariance`. -/
def variance {Ω : Type _} {m : MeasurableSpace Ω} (X : Ω → ℝ) (μ : Measure Ω) : ℝ :=
  (evariance X μ).toReal
#align probability_theory.variance ProbabilityTheory.variance

variable {Ω : Type _} {m : MeasurableSpace Ω} {X : Ω → ℝ} {μ : Measure Ω}

theorem MeasureTheory.Memℒp.evariance_lt_top [IsFiniteMeasure μ] (hX : Memℒp X 2 μ) :
    evariance X μ < ∞ :=
  by
  have := ENNReal.pow_lt_top (hX.sub <| mem_ℒp_const <| μ[X]).2 2
  rw [snorm_eq_lintegral_rpow_nnnorm two_ne_zero ENNReal.two_ne_top, ← ENNReal.rpow_two] at this
  simp only [Pi.sub_apply, [anonymous], ENNReal.one_toReal, one_div] at this
  rw [← ENNReal.rpow_mul, inv_mul_cancel (two_ne_zero : (2 : ℝ) ≠ 0), ENNReal.rpow_one] at this
  simp_rw [ENNReal.rpow_two] at this
  exact this
#align measure_theory.mem_ℒp.evariance_lt_top MeasureTheory.Memℒp.evariance_lt_top

theorem evariance_eq_top [IsFiniteMeasure μ] (hXm : AeStronglyMeasurable X μ) (hX : ¬Memℒp X 2 μ) :
    evariance X μ = ∞ := by
  by_contra h
  rw [← Ne.def, ← lt_top_iff_ne_top] at h
  have : mem_ℒp (fun ω => X ω - μ[X]) 2 μ :=
    by
    refine' ⟨hXm.sub ae_strongly_measurable_const, _⟩
    rw [snorm_eq_lintegral_rpow_nnnorm two_ne_zero ENNReal.two_ne_top]
    simp only [[anonymous], ENNReal.one_toReal, ENNReal.rpow_two, Ne.def]
    exact ENNReal.rpow_lt_top_of_nonneg (by simp) h.ne
  refine' hX _
  convert this.add (mem_ℒp_const <| μ[X])
  ext ω
  rw [Pi.add_apply, sub_add_cancel]
#align probability_theory.evariance_eq_top ProbabilityTheory.evariance_eq_top

theorem evariance_lt_top_iff_memℒp [IsFiniteMeasure μ] (hX : AeStronglyMeasurable X μ) :
    evariance X μ < ∞ ↔ Memℒp X 2 μ :=
  by
  refine' ⟨_, MeasureTheory.Memℒp.evariance_lt_top⟩
  contrapose
  rw [not_lt, top_le_iff]
  exact evariance_eq_top hX
#align probability_theory.evariance_lt_top_iff_mem_ℒp ProbabilityTheory.evariance_lt_top_iff_memℒp

theorem MeasureTheory.Memℒp.ofReal_variance_eq [IsFiniteMeasure μ] (hX : Memℒp X 2 μ) :
    ENNReal.ofReal (variance X μ) = evariance X μ :=
  by
  rw [variance, ENNReal.ofReal_toReal]
  exact hX.evariance_lt_top.ne
#align measure_theory.mem_ℒp.of_real_variance_eq MeasureTheory.Memℒp.ofReal_variance_eq

include m

theorem evariance_eq_lintegral_ofReal (X : Ω → ℝ) (μ : Measure Ω) :
    evariance X μ = ∫⁻ ω, ENNReal.ofReal ((X ω - μ[X]) ^ 2) ∂μ :=
  by
  rw [evariance]
  congr
  ext1 ω
  rw [pow_two, ← ENNReal.coe_mul, ← nnnorm_mul, ← pow_two]
  congr
  exact (Real.toNNReal_eq_nnnorm_of_nonneg <| sq_nonneg _).symm
#align probability_theory.evariance_eq_lintegral_of_real ProbabilityTheory.evariance_eq_lintegral_ofReal

theorem MeasureTheory.Memℒp.variance_eq_of_integral_eq_zero (hX : Memℒp X 2 μ) (hXint : μ[X] = 0) :
    variance X μ = μ[X ^ 2] :=
  by
  rw [variance, evariance_eq_lintegral_of_real, ← of_real_integral_eq_lintegral_of_real,
      ENNReal.toReal_ofReal] <;>
    simp_rw [hXint, sub_zero]
  · rfl
  · exact integral_nonneg fun ω => pow_two_nonneg _
  · convert hX.integrable_norm_rpow two_ne_zero ENNReal.two_ne_top
    ext ω
    simp only [Pi.sub_apply, Real.norm_eq_abs, [anonymous], ENNReal.one_toReal, Real.rpow_two,
      pow_bit0_abs]
  · exact ae_of_all _ fun ω => pow_two_nonneg _
#align measure_theory.mem_ℒp.variance_eq_of_integral_eq_zero MeasureTheory.Memℒp.variance_eq_of_integral_eq_zero

theorem MeasureTheory.Memℒp.variance_eq [IsFiniteMeasure μ] (hX : Memℒp X 2 μ) :
    variance X μ = μ[(X - fun ω => μ[X]) ^ 2] :=
  by
  rw [variance, evariance_eq_lintegral_of_real, ← of_real_integral_eq_lintegral_of_real,
    ENNReal.toReal_ofReal]
  · rfl
  · exact integral_nonneg fun ω => pow_two_nonneg _
  · convert(hX.sub <| mem_ℒp_const (μ[X])).integrableNormRpow two_ne_zero ENNReal.two_ne_top
    ext ω
    simp only [Pi.sub_apply, Real.norm_eq_abs, [anonymous], ENNReal.one_toReal, Real.rpow_two,
      pow_bit0_abs]
  · exact ae_of_all _ fun ω => pow_two_nonneg _
#align measure_theory.mem_ℒp.variance_eq MeasureTheory.Memℒp.variance_eq

@[simp]
theorem evariance_zero : evariance 0 μ = 0 := by simp [evariance]
#align probability_theory.evariance_zero ProbabilityTheory.evariance_zero

theorem evariance_eq_zero_iff (hX : AeMeasurable X μ) : evariance X μ = 0 ↔ X =ᵐ[μ] fun ω => μ[X] :=
  by
  rw [evariance, lintegral_eq_zero_iff']
  constructor <;> intro hX <;> filter_upwards [hX]with ω hω
  · simp only [Pi.zero_apply, pow_eq_zero_iff, Nat.succ_pos', ENNReal.coe_eq_zero, nnnorm_eq_zero,
      sub_eq_zero] at hω
    exact hω
  · rw [hω]
    simp
  · measurability
#align probability_theory.evariance_eq_zero_iff ProbabilityTheory.evariance_eq_zero_iff

theorem evariance_mul (c : ℝ) (X : Ω → ℝ) (μ : Measure Ω) :
    evariance (fun ω => c * X ω) μ = ENNReal.ofReal (c ^ 2) * evariance X μ :=
  by
  rw [evariance, evariance, ← lintegral_const_mul' _ _ ennreal.of_real_lt_top.ne]
  congr
  ext1 ω
  rw [ENNReal.ofReal, ← ENNReal.coe_pow, ← ENNReal.coe_pow, ← ENNReal.coe_mul]
  congr
  rw [← sq_abs, ← Real.rpow_two, Real.toNNReal_rpow_of_nonneg (abs_nonneg _), NNReal.rpow_two, ←
    mul_pow, Real.toNNReal_mul_nnnorm _ (abs_nonneg _)]
  conv_rhs => rw [← nnnorm_norm, norm_mul, norm_abs_eq_norm, ← norm_mul, nnnorm_norm, mul_sub]
  congr
  rw [mul_comm]
  simp_rw [← smul_eq_mul, ← integral_smul_const, smul_eq_mul, mul_comm]
#align probability_theory.evariance_mul ProbabilityTheory.evariance_mul

-- mathport name: probability_theory.evariance
scoped notation "eVar[" X "]" => ProbabilityTheory.evariance X MeasureTheory.MeasureSpace.volume

@[simp]
theorem variance_zero (μ : Measure Ω) : variance 0 μ = 0 := by
  simp only [variance, evariance_zero, ENNReal.zero_toReal]
#align probability_theory.variance_zero ProbabilityTheory.variance_zero

theorem variance_nonneg (X : Ω → ℝ) (μ : Measure Ω) : 0 ≤ variance X μ :=
  ENNReal.toReal_nonneg
#align probability_theory.variance_nonneg ProbabilityTheory.variance_nonneg

theorem variance_mul (c : ℝ) (X : Ω → ℝ) (μ : Measure Ω) :
    variance (fun ω => c * X ω) μ = c ^ 2 * variance X μ :=
  by
  rw [variance, evariance_mul, ENNReal.toReal_mul, ENNReal.toReal_ofReal (sq_nonneg _)]
  rfl
#align probability_theory.variance_mul ProbabilityTheory.variance_mul

theorem variance_smul (c : ℝ) (X : Ω → ℝ) (μ : Measure Ω) :
    variance (c • X) μ = c ^ 2 * variance X μ :=
  variance_mul c X μ
#align probability_theory.variance_smul ProbabilityTheory.variance_smul

theorem variance_smul' {A : Type _} [CommSemiring A] [Algebra A ℝ] (c : A) (X : Ω → ℝ)
    (μ : Measure Ω) : variance (c • X) μ = c ^ 2 • variance X μ :=
  by
  convert variance_smul (algebraMap A ℝ c) X μ
  · ext1 x
    simp only [algebraMap_smul]
  · simp only [Algebra.smul_def, map_pow]
#align probability_theory.variance_smul' ProbabilityTheory.variance_smul'

-- mathport name: probability_theory.variance
scoped notation "Var[" X "]" => ProbabilityTheory.variance X MeasureTheory.MeasureSpace.volume

omit m

variable [MeasureSpace Ω]

theorem variance_def' [IsProbabilityMeasure (ℙ : Measure Ω)] {X : Ω → ℝ} (hX : Memℒp X 2) :
    Var[X] = 𝔼[X ^ 2] - 𝔼[X] ^ 2 :=
  by
  rw [hX.variance_eq, sub_sq', integral_sub', integral_add']; rotate_left
  · exact hX.integrable_sq
  · convert integrable_const (𝔼[X] ^ 2)
    infer_instance
  · apply hX.integrable_sq.add
    convert integrable_const (𝔼[X] ^ 2)
    infer_instance
  · exact ((hX.integrable one_le_two).const_mul 2).mul_const' _
  simp only [integral_mul_right, Pi.pow_apply, Pi.mul_apply, Pi.bit0_apply, Pi.one_apply,
    integral_const (integral ℙ X ^ 2), integral_mul_left (2 : ℝ), one_mul, variance, Pi.pow_apply,
    measure_univ, ENNReal.one_toReal, Algebra.id.smul_eq_mul]
  ring
#align probability_theory.variance_def' ProbabilityTheory.variance_def'

theorem variance_le_expectation_sq [IsProbabilityMeasure (ℙ : Measure Ω)] {X : Ω → ℝ}
    (hm : AeStronglyMeasurable X ℙ) : Var[X] ≤ 𝔼[X ^ 2] :=
  by
  by_cases hX : mem_ℒp X 2
  · rw [variance_def' hX]
    simp only [sq_nonneg, sub_le_self_iff]
  rw [variance, evariance_eq_lintegral_of_real, ← integral_eq_lintegral_of_nonneg_ae]
  by_cases hint : integrable X; swap
  · simp only [integral_undef hint, Pi.pow_apply, Pi.sub_apply, sub_zero]
  · rw [integral_undef]
    · exact integral_nonneg fun a => sq_nonneg _
    · intro h
      have A : mem_ℒp (X - fun ω : Ω => 𝔼[X]) 2 ℙ :=
        (mem_ℒp_two_iff_integrable_sq
              (hint.ae_strongly_measurable.sub ae_strongly_measurable_const)).2
          h
      have B : mem_ℒp (fun ω : Ω => 𝔼[X]) 2 ℙ := mem_ℒp_const _
      apply hX
      convert A.add B
      simp
  · exact ae_of_all _ fun x => sq_nonneg _
  · exact (AeMeasurable.powConst (hm.ae_measurable.sub_const _) _).AeStronglyMeasurable
#align probability_theory.variance_le_expectation_sq ProbabilityTheory.variance_le_expectation_sq

theorem evariance_def' [IsProbabilityMeasure (ℙ : Measure Ω)] {X : Ω → ℝ}
    (hX : AeStronglyMeasurable X ℙ) : eVar[X] = (∫⁻ ω, ‖X ω‖₊ ^ 2) - ENNReal.ofReal (𝔼[X] ^ 2) :=
  by
  by_cases hℒ : mem_ℒp X 2
  · rw [← hℒ.of_real_variance_eq, variance_def' hℒ, ENNReal.ofReal_sub _ (sq_nonneg _)]
    congr
    simp_rw [← ENNReal.coe_pow]
    rw [lintegral_coe_eq_integral]
    · congr 2 with ω
      simp only [Pi.pow_apply, NNReal.coe_pow, coe_nnnorm, Real.norm_eq_abs, pow_bit0_abs]
    · exact hℒ.abs.integrable_sq
  · symm
    rw [evariance_eq_top hX hℒ, ENNReal.sub_eq_top_iff]
    refine' ⟨_, ENNReal.ofReal_ne_top⟩
    rw [mem_ℒp, not_and] at hℒ
    specialize hℒ hX
    simp only [snorm_eq_lintegral_rpow_nnnorm two_ne_zero ENNReal.two_ne_top, not_lt, top_le_iff,
      [anonymous], ENNReal.one_toReal, ENNReal.rpow_two, one_div, ENNReal.rpow_eq_top_iff,
      inv_lt_zero, inv_pos, zero_lt_bit0, zero_lt_one, and_true_iff, or_iff_not_imp_left,
      not_and_or] at hℒ
    exact hℒ fun _ => zero_le_two
#align probability_theory.evariance_def' ProbabilityTheory.evariance_def'

/-- *Chebyshev's inequality* for `ℝ≥0∞`-valued variance. -/
theorem meas_ge_le_evariance_div_sq {X : Ω → ℝ} (hX : AeStronglyMeasurable X ℙ) {c : ℝ≥0}
    (hc : c ≠ 0) : ℙ { ω | ↑c ≤ |X ω - 𝔼[X]| } ≤ eVar[X] / c ^ 2 :=
  by
  have A : (c : ℝ≥0∞) ≠ 0 := by rwa [Ne.def, ENNReal.coe_eq_zero]
  have B : ae_strongly_measurable (fun ω : Ω => 𝔼[X]) ℙ := ae_strongly_measurable_const
  convert meas_ge_le_mul_pow_snorm ℙ two_ne_zero ENNReal.two_ne_top (hX.sub B) A
  · ext ω
    simp only [Pi.sub_apply, ENNReal.coe_le_coe, ← Real.norm_eq_abs, ← coe_nnnorm,
      NNReal.coe_le_coe, ENNReal.ofReal_coe_nnreal]
  · rw [snorm_eq_lintegral_rpow_nnnorm two_ne_zero ENNReal.two_ne_top]
    simp only [[anonymous], ENNReal.one_toReal, Pi.sub_apply, one_div]
    rw [div_eq_mul_inv, ENNReal.inv_pow, mul_comm, ENNReal.rpow_two]
    congr
    simp_rw [← ENNReal.rpow_mul, inv_mul_cancel (two_ne_zero : (2 : ℝ) ≠ 0), ENNReal.rpow_two,
      ENNReal.rpow_one, evariance]
#align probability_theory.meas_ge_le_evariance_div_sq ProbabilityTheory.meas_ge_le_evariance_div_sq

/-- *Chebyshev's inequality* : one can control the deviation probability of a real random variable
from its expectation in terms of the variance. -/
theorem meas_ge_le_variance_div_sq [IsFiniteMeasure (ℙ : Measure Ω)] {X : Ω → ℝ} (hX : Memℒp X 2)
    {c : ℝ} (hc : 0 < c) : ℙ { ω | c ≤ |X ω - 𝔼[X]| } ≤ ENNReal.ofReal (Var[X] / c ^ 2) :=
  by
  rw [ENNReal.ofReal_div_of_pos (sq_pos_of_ne_zero _ hc.ne.symm), hX.of_real_variance_eq]
  convert@meas_ge_le_evariance_div_sq _ _ _ hX.1 c.to_nnreal (by simp [hc])
  · simp only [Real.coe_toNNReal', max_le_iff, abs_nonneg, and_true_iff]
  · rw [ENNReal.ofReal_pow hc.le]
    rfl
#align probability_theory.meas_ge_le_variance_div_sq ProbabilityTheory.meas_ge_le_variance_div_sq

/-- The variance of the sum of two independent random variables is the sum of the variances. -/
theorem IndepFunCat.variance_add [IsProbabilityMeasure (ℙ : Measure Ω)] {X Y : Ω → ℝ}
    (hX : Memℒp X 2) (hY : Memℒp Y 2) (h : IndepFunCat X Y) : Var[X + Y] = Var[X] + Var[Y] :=
  calc
    Var[X + Y] = 𝔼[fun a => X a ^ 2 + Y a ^ 2 + 2 * X a * Y a] - 𝔼[X + Y] ^ 2 := by
      simp [variance_def' (hX.add hY), add_sq']
    _ = 𝔼[X ^ 2] + 𝔼[Y ^ 2] + 2 * 𝔼[X * Y] - (𝔼[X] + 𝔼[Y]) ^ 2 :=
      by
      simp only [Pi.add_apply, Pi.pow_apply, Pi.mul_apply, mul_assoc]
      rw [integral_add, integral_add, integral_add, integral_mul_left]
      · exact hX.integrable one_le_two
      · exact hY.integrable one_le_two
      · exact hX.integrable_sq
      · exact hY.integrable_sq
      · exact hX.integrable_sq.add hY.integrable_sq
      · apply integrable.const_mul
        exact h.integrable_mul (hX.integrable one_le_two) (hY.integrable one_le_two)
    _ = 𝔼[X ^ 2] + 𝔼[Y ^ 2] + 2 * (𝔼[X] * 𝔼[Y]) - (𝔼[X] + 𝔼[Y]) ^ 2 :=
      by
      congr
      exact h.integral_mul_of_integrable (hX.integrable one_le_two) (hY.integrable one_le_two)
    _ = Var[X] + Var[Y] := by
      simp only [variance_def', hX, hY, Pi.pow_apply]
      ring

#align probability_theory.indep_fun.variance_add ProbabilityTheory.IndepFunCat.variance_add

/-- The variance of a finite sum of pairwise independent random variables is the sum of the
variances. -/
theorem IndepFunCat.variance_sum [IsProbabilityMeasure (ℙ : Measure Ω)] {ι : Type _} {X : ι → Ω → ℝ}
    {s : Finset ι} (hs : ∀ i ∈ s, Memℒp (X i) 2)
    (h : Set.Pairwise ↑s fun i j => IndepFunCat (X i) (X j)) :
    Var[∑ i in s, X i] = ∑ i in s, Var[X i] := by
  classical
    induction' s using Finset.induction_on with k s ks IH
    · simp only [Finset.sum_empty, variance_zero]
    rw [variance_def' (mem_ℒp_finset_sum' _ hs), sum_insert ks, sum_insert ks]
    simp only [add_sq']
    calc
      𝔼[X k ^ 2 + (∑ i in s, X i) ^ 2 + 2 * X k * ∑ i in s, X i] - 𝔼[X k + ∑ i in s, X i] ^ 2 =
          𝔼[X k ^ 2] + 𝔼[(∑ i in s, X i) ^ 2] + 𝔼[2 * X k * ∑ i in s, X i] -
            (𝔼[X k] + 𝔼[∑ i in s, X i]) ^ 2 :=
        by
        rw [integral_add', integral_add', integral_add']
        · exact mem_ℒp.integrable one_le_two (hs _ (mem_insert_self _ _))
        · apply integrable_finset_sum' _ fun i hi => _
          exact mem_ℒp.integrable one_le_two (hs _ (mem_insert_of_mem hi))
        · exact mem_ℒp.integrable_sq (hs _ (mem_insert_self _ _))
        · apply mem_ℒp.integrable_sq
          exact mem_ℒp_finset_sum' _ fun i hi => hs _ (mem_insert_of_mem hi)
        · apply integrable.add
          · exact mem_ℒp.integrable_sq (hs _ (mem_insert_self _ _))
          · apply mem_ℒp.integrable_sq
            exact mem_ℒp_finset_sum' _ fun i hi => hs _ (mem_insert_of_mem hi)
        · rw [mul_assoc]
          apply integrable.const_mul _ (2 : ℝ)
          simp only [mul_sum, sum_apply, Pi.mul_apply]
          apply integrable_finset_sum _ fun i hi => _
          apply
            indep_fun.integrable_mul _ (mem_ℒp.integrable one_le_two (hs _ (mem_insert_self _ _)))
              (mem_ℒp.integrable one_le_two (hs _ (mem_insert_of_mem hi)))
          apply h (mem_insert_self _ _) (mem_insert_of_mem hi)
          exact fun hki => ks (hki.symm ▸ hi)
      _ =
          Var[X k] + Var[∑ i in s, X i] +
            (𝔼[2 * X k * ∑ i in s, X i] - 2 * 𝔼[X k] * 𝔼[∑ i in s, X i]) :=
        by
        rw [variance_def' (hs _ (mem_insert_self _ _)),
          variance_def' (mem_ℒp_finset_sum' _ fun i hi => hs _ (mem_insert_of_mem hi))]
        ring
      _ = Var[X k] + Var[∑ i in s, X i] :=
        by
        simp only [mul_assoc, integral_mul_left, Pi.mul_apply, Pi.bit0_apply, Pi.one_apply,
          sum_apply, add_right_eq_self, mul_sum]
        rw [integral_finset_sum s fun i hi => _]; swap
        · apply integrable.const_mul _ (2 : ℝ)
          apply
            indep_fun.integrable_mul _ (mem_ℒp.integrable one_le_two (hs _ (mem_insert_self _ _)))
              (mem_ℒp.integrable one_le_two (hs _ (mem_insert_of_mem hi)))
          apply h (mem_insert_self _ _) (mem_insert_of_mem hi)
          exact fun hki => ks (hki.symm ▸ hi)
        rw [integral_finset_sum s fun i hi =>
            mem_ℒp.integrable one_le_two (hs _ (mem_insert_of_mem hi)),
          mul_sum, mul_sum, ← sum_sub_distrib]
        apply Finset.sum_eq_zero fun i hi => _
        rw [integral_mul_left, indep_fun.integral_mul', sub_self]
        · apply h (mem_insert_self _ _) (mem_insert_of_mem hi)
          exact fun hki => ks (hki.symm ▸ hi)
        · exact mem_ℒp.ae_strongly_measurable (hs _ (mem_insert_self _ _))
        · exact mem_ℒp.ae_strongly_measurable (hs _ (mem_insert_of_mem hi))
      _ = Var[X k] + ∑ i in s, Var[X i] := by
        rw [IH (fun i hi => hs i (mem_insert_of_mem hi))
            (h.mono (by simp only [coe_insert, Set.subset_insert]))]

#align probability_theory.indep_fun.variance_sum ProbabilityTheory.IndepFunCat.variance_sum

end ProbabilityTheory


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Scott Morrison
-/
import topology.sheaves.presheaf_of_functions
import topology.sheaves.sheaf_condition.unique_gluing

/-!
# Sheaf conditions for presheaves of (continuous) functions.

We show that
* `Top.presheaf.to_Type_is_sheaf`: not-necessarily-continuous functions into a type form a sheaf
* `Top.presheaf.to_Types_is_sheaf`: in fact, these may be dependent functions into a type family

For
* `Top.sheaf_to_Top`: continuous functions into a topological space form a sheaf
please see `topology/sheaves/local_predicate.lean`, where we set up a general framework
for constructing sub(pre)sheaves of the sheaf of dependent functions.

## Future work
Obviously there's more to do:
* sections of a fiber bundle
* various classes of smooth and structure preserving functions
* functions into spaces with algebraic structure, which the sections inherit
-/

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

universe u

noncomputable theory

variables (X : Top.{u})

open Top

namespace Top.presheaf

/--
We show that the presheaf of functions to a type `T`
(no continuity assumptions, just plain functions)
form a sheaf.

In fact, the proof is identical when we do this for dependent functions to a type family `T`,
so we do the more general case.
-/
lemma to_Types_is_sheaf (T : X → Type u) : (presheaf_to_Types X T).is_sheaf :=
is_sheaf_of_is_sheaf_unique_gluing_types _ $ λ ι U sf hsf,
-- We use the sheaf condition in terms of unique gluing
-- U is a family of open sets, indexed by `ι` and `sf` is a compatible family of sections.
-- In the informal comments below, I'll just write `U` to represent the union.
begin
  -- Our first goal is to define a function "lifted" to all of `U`.
  -- We do this one point at a time. Using the axiom of choice, we can pick for each
  -- `x : supr U` an index `i : ι` such that `x` lies in `U i`
  choose index index_spec using λ x : supr U, opens.mem_supr.mp x.2,
  -- Using this data, we can glue our functions together to a single section
  let s : Π x : supr U, T x := λ x, sf (index x) ⟨x.1, index_spec x⟩,
  refine ⟨s,_,_⟩,
  { intro i,
    ext x,
    -- Now we need to verify that this lifted function restricts correctly to each set `U i`.
    -- Of course, the difficulty is that at any given point `x ∈ U i`,
    -- we may have used the axiom of choice to pick a different `j` with `x ∈ U j`
    -- when defining the function.
    -- Thus we'll need to use the fact that the restrictions are compatible.
    convert congr_fun (hsf (index ⟨x,_⟩) i) ⟨x,⟨index_spec ⟨x.1,_⟩,x.2⟩⟩,
    ext,
    refl },
  { -- Now we just need to check that the lift we picked was the only possible one.
    -- So we suppose we had some other gluing `t` of our sections
    intros t ht,
    -- and observe that we need to check that it agrees with our choice
    -- for each `f : s .X` and each `x ∈ supr U`.
    ext x,
    convert congr_fun (ht (index x)) ⟨x.1,index_spec x⟩,
    ext,
    refl }
end

-- We verify that the non-dependent version is an immediate consequence:
/--
The presheaf of not-necessarily-continuous functions to
a target type `T` satsifies the sheaf condition.
-/
lemma to_Type_is_sheaf (T : Type u) : (presheaf_to_Type X T).is_sheaf :=
to_Types_is_sheaf X (λ _, T)

end Top.presheaf

namespace Top

/--
The sheaf of not-necessarily-continuous functions on `X` with values in type family
`T : X → Type u`.
-/
def sheaf_to_Types (T : X → Type u) : sheaf (Type u) X :=
⟨presheaf_to_Types X T, presheaf.to_Types_is_sheaf _ _⟩

/--
The sheaf of not-necessarily-continuous functions on `X` with values in a type `T`.
-/
def sheaf_to_Type (T : Type u) : sheaf (Type u) X :=
⟨presheaf_to_Type X T, presheaf.to_Type_is_sheaf _ _⟩

end Top


/-
Copyright (c) 2022 María Inés de Frutos-Fernández. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: María Inés de Frutos-Fernández, Yaël Dillies
-/
import analysis.normed.field.basic

/-!
# Seminorms and norms on rings

This file defines seminorms and norms on rings. These definitions are useful when one needs to
consider multiple (semi)norms on a given ring.

## Main declarations

For a ring `R`:
* `ring_seminorm`: A seminorm on a ring `R` is a function `f : R → ℝ` that preserves zero, takes
  nonnegative values, is subadditive and submultiplicative and such that `f (-x) = f x` for all
  `x ∈ R`.
* `ring_norm`: A seminorm `f` is a norm if `f x = 0` if and only if `x = 0`.
* `mul_ring_seminorm`: A multiplicative seminorm on a ring `R` is a ring seminorm that preserves
  multiplication.
* `mul_ring_norm`: A multiplicative norm on a ring `R` is a ring norm that preserves multiplication.

## Notes

The corresponding hom classes are defined in `analysis.order.hom.basic` to be used by absolute
values.

## References

* [S. Bosch, U. Güntzer, R. Remmert, *Non-Archimedean Analysis*][bosch-guntzer-remmert]

## Tags
ring_seminorm, ring_norm
-/

set_option old_structure_cmd true

open_locale nnreal

variables {F R S : Type*} (x y : R) (r : ℝ)

/-- A seminorm on a ring `R` is a function `f : R → ℝ` that preserves zero, takes nonnegative
  values, is subadditive and submultiplicative and such that `f (-x) = f x` for all `x ∈ R`. -/
structure ring_seminorm (R : Type*) [non_unital_non_assoc_ring R]
  extends add_group_seminorm R :=
(mul_le' : ∀ x y : R, to_fun (x * y) ≤ to_fun x * to_fun y)

/-- A function `f : R → ℝ` is a norm on a (nonunital) ring if it is a seminorm and `f x = 0`
  implies `x = 0`. -/
structure ring_norm (R : Type*) [non_unital_non_assoc_ring R]
  extends ring_seminorm R, add_group_norm R

/-- A multiplicative seminorm on a ring `R` is a function `f : R → ℝ` that preserves zero and
multiplication, takes nonnegative values, is subadditive and such that `f (-x) = f x` for all `x`.
-/
structure mul_ring_seminorm (R : Type*) [non_assoc_ring R]
  extends add_group_seminorm R, monoid_with_zero_hom R ℝ

/-- A multiplicative norm on a ring `R` is a multiplicative ring seminorm such that `f x = 0`
implies `x = 0`. -/
structure mul_ring_norm (R : Type*) [non_assoc_ring R] extends mul_ring_seminorm R, add_group_norm R

attribute [nolint doc_blame] ring_seminorm.to_add_group_seminorm ring_norm.to_add_group_norm
  ring_norm.to_ring_seminorm mul_ring_seminorm.to_add_group_seminorm
  mul_ring_seminorm.to_monoid_with_zero_hom mul_ring_norm.to_add_group_norm
  mul_ring_norm.to_mul_ring_seminorm

namespace ring_seminorm

section non_unital_ring

variables [non_unital_ring R]

instance ring_seminorm_class : ring_seminorm_class (ring_seminorm R) R ℝ :=
{ coe := λ f, f.to_fun,
  coe_injective' := λ f g h, by cases f; cases g; congr',
  map_zero := λ f, f.map_zero',
  map_add_le_add := λ f, f.add_le',
  map_mul_le_mul := λ f, f.mul_le',
  map_neg_eq_map := λ f, f.neg' }

/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`. -/
instance : has_coe_to_fun (ring_seminorm R) (λ _, R → ℝ) := fun_like.has_coe_to_fun

@[simp] lemma to_fun_eq_coe (p : ring_seminorm R) : p.to_fun = p := rfl

@[ext] lemma ext {p q : ring_seminorm R} : (∀ x, p x = q x) → p = q := fun_like.ext p q

instance : has_zero (ring_seminorm R) :=
⟨{ mul_le' := λ _ _, (zero_mul _).ge,
  ..add_group_seminorm.has_zero.zero }⟩

lemma eq_zero_iff {p : ring_seminorm R} : p = 0 ↔ ∀ x, p x = 0 := fun_like.ext_iff
lemma ne_zero_iff {p : ring_seminorm R} : p ≠ 0 ↔ ∃ x, p x ≠ 0 := by simp [eq_zero_iff]

instance : inhabited (ring_seminorm R) := ⟨0⟩

/-- The trivial seminorm on a ring `R` is the `ring_seminorm` taking value `0` at `0` and `1` at
every other element. -/
instance [decidable_eq R] : has_one (ring_seminorm R) :=
⟨{ mul_le' := λ x y, begin
    by_cases h : x * y = 0,
    { refine (if_pos h).trans_le (mul_nonneg _ _);
      { change _ ≤ ite _ _ _,
        split_ifs,
        exacts [le_rfl, zero_le_one] } },
    { change ite _ _ _ ≤ ite _ _ _ * ite _ _ _,
      simp only [if_false, h, left_ne_zero_of_mul h, right_ne_zero_of_mul h, mul_one] }
  end,
  ..(1 : add_group_seminorm R) }⟩

@[simp] lemma apply_one [decidable_eq R] (x : R) :
  (1 : ring_seminorm R) x = if x = 0 then 0 else 1 := rfl

end non_unital_ring

section ring

variables [ring R] (p : ring_seminorm R)

lemma seminorm_one_eq_one_iff_ne_zero (hp : p 1 ≤ 1) :
  p 1 = 1 ↔ p ≠ 0 :=
begin
  refine ⟨λ h, ne_zero_iff.mpr ⟨1, by {rw h, exact one_ne_zero}⟩, λ h, _⟩,
  obtain hp0 | hp0 := (map_nonneg p (1 : R)).eq_or_gt,
  { cases h (ext $ λ x, (map_nonneg _ _).antisymm' _),
    simpa only [hp0, mul_one, mul_zero] using map_mul_le_mul p x 1},
  { refine hp.antisymm ((le_mul_iff_one_le_left hp0).1 _),
    simpa only [one_mul] using map_mul_le_mul p (1 : R) _ }
end

end ring

end ring_seminorm

/-- The norm of a `non_unital_semi_normed_ring` as a `ring_seminorm`. -/
def norm_ring_seminorm (R : Type*) [non_unital_semi_normed_ring R] :
  ring_seminorm R :=
{ to_fun    := norm,
  mul_le'   := norm_mul_le,
  ..(norm_add_group_seminorm R) }

namespace ring_norm

variable [non_unital_ring R]

instance ring_norm_class : ring_norm_class (ring_norm R) R ℝ :=
{ coe := λ f, f.to_fun,
  coe_injective' := λ f g h, by cases f; cases g; congr',
  map_zero := λ f, f.map_zero',
  map_add_le_add := λ f, f.add_le',
  map_mul_le_mul := λ f, f.mul_le',
  map_neg_eq_map := λ f, f.neg',
  eq_zero_of_map_eq_zero := λ f, f.eq_zero_of_map_eq_zero' }

/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`. -/
instance : has_coe_to_fun (ring_norm R) (λ _, R → ℝ) := ⟨λ p, p.to_fun⟩

@[simp] lemma to_fun_eq_coe (p : ring_norm R) : p.to_fun = p := rfl

@[ext] lemma ext {p q : ring_norm R} : (∀ x, p x = q x) → p = q := fun_like.ext p q

variable (R)

/-- The trivial norm on a ring `R` is the `ring_norm` taking value `0` at `0` and `1` at every
  other element. -/
instance [decidable_eq R] : has_one (ring_norm R) :=
⟨{ ..(1 : ring_seminorm R), ..(1 : add_group_norm R) }⟩

@[simp] lemma apply_one [decidable_eq R] (x : R) : (1 : ring_norm R) x = if x = 0 then 0 else 1 :=
rfl

instance [decidable_eq R] : inhabited (ring_norm R) := ⟨1⟩

end ring_norm

namespace mul_ring_seminorm
variables [non_assoc_ring R]

instance mul_ring_seminorm_class : mul_ring_seminorm_class (mul_ring_seminorm R) R ℝ :=
{ coe := λ f, f.to_fun,
  coe_injective' := λ f g h, by cases f; cases g; congr',
  map_zero := λ f, f.map_zero',
  map_one := λ f, f.map_one',
  map_add_le_add := λ f, f.add_le',
  map_mul := λ f, f.map_mul',
  map_neg_eq_map := λ f, f.neg' }

/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`. -/
instance : has_coe_to_fun (mul_ring_seminorm R) (λ _, R → ℝ) := fun_like.has_coe_to_fun

@[simp] lemma to_fun_eq_coe (p : mul_ring_seminorm R) : p.to_fun = p := rfl

@[ext] lemma ext {p q : mul_ring_seminorm R} : (∀ x, p x = q x) → p = q := fun_like.ext p q

variables [decidable_eq R] [no_zero_divisors R] [nontrivial R]

/-- The trivial seminorm on a ring `R` is the `mul_ring_seminorm` taking value `0` at `0` and `1` at
every other element. -/
instance : has_one (mul_ring_seminorm R) :=
⟨{ map_one' := if_neg one_ne_zero,
  map_mul' := λ x y, begin
    obtain rfl | hx := eq_or_ne x 0,
    { simp },
    obtain rfl | hy := eq_or_ne y 0,
    { simp },
    { simp [hx, hy] }
  end,
  ..(1 : add_group_seminorm R) }⟩

@[simp] lemma apply_one (x : R) : (1 : mul_ring_seminorm R) x = if x = 0 then 0 else 1 := rfl

instance : inhabited (mul_ring_seminorm R) := ⟨1⟩

end mul_ring_seminorm

namespace mul_ring_norm
variable [non_assoc_ring R]

instance mul_ring_norm_class : mul_ring_norm_class (mul_ring_norm R) R ℝ :=
{ coe := λ f, f.to_fun,
  coe_injective' := λ f g h, by cases f; cases g; congr',
  map_zero := λ f, f.map_zero',
  map_one := λ f, f.map_one',
  map_add_le_add := λ f, f.add_le',
  map_mul := λ f, f.map_mul',
  map_neg_eq_map := λ f, f.neg',
  eq_zero_of_map_eq_zero := λ f, f.eq_zero_of_map_eq_zero' }

/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`. -/
instance : has_coe_to_fun (mul_ring_norm R) (λ _, R → ℝ) := ⟨λ p, p.to_fun⟩

@[simp] lemma to_fun_eq_coe (p : mul_ring_norm R) : p.to_fun = p := rfl

@[ext] lemma ext {p q : mul_ring_norm R} : (∀ x, p x = q x) → p = q := fun_like.ext p q

variables (R) [decidable_eq R] [no_zero_divisors R] [nontrivial R]

/-- The trivial norm on a ring `R` is the `mul_ring_norm` taking value `0` at `0` and `1` at every
other element. -/
instance : has_one (mul_ring_norm R) :=
⟨{ ..(1 : mul_ring_seminorm R), ..(1 : add_group_norm R) }⟩

@[simp] lemma apply_one (x : R) : (1 : mul_ring_norm R) x = if x = 0 then 0 else 1 := rfl

instance : inhabited (mul_ring_norm R) := ⟨1⟩

end mul_ring_norm

/-- A nonzero ring seminorm on a field `K` is a ring norm. -/
def ring_seminorm.to_ring_norm {K : Type*} [field K] (f : ring_seminorm K) (hnt : f ≠ 0) :
  ring_norm K :=
{ eq_zero_of_map_eq_zero' := λ x hx,
  begin
    obtain ⟨c, hc⟩ := ring_seminorm.ne_zero_iff.mp hnt,
    by_contradiction hn0,
    have hc0 : f c = 0,
    { rw [← mul_one c, ← mul_inv_cancel hn0, ← mul_assoc, mul_comm c, mul_assoc],
      exact le_antisymm (le_trans (map_mul_le_mul f _ _)
        (by rw [← ring_seminorm.to_fun_eq_coe, hx, zero_mul])) (map_nonneg f _) },
    exact hc hc0,
  end,
  ..f }

/-- The norm of a normed_ring as a ring_norm. -/
@[simps] def norm_ring_norm (R : Type*) [non_unital_normed_ring R] : ring_norm R :=
{ ..norm_add_group_norm R, ..norm_ring_seminorm R }


/-
Copyright (c) 2022 Yuma Mizuno. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yuma Mizuno

! This file was ported from Lean 3 source module category_theory.bicategory.strict
! leanprover-community/mathlib commit 34ee86e6a59d911a8e4f89b68793ee7577ae79c7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.EqToHom
import Mathbin.CategoryTheory.Bicategory.Basic

/-!
# Strict bicategories

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

A bicategory is called `strict` if the left unitors, the right unitors, and the associators are
isomorphisms given by equalities.

## Implementation notes

In the literature of category theory, a strict bicategory (usually called a strict 2-category) is
often defined as a bicategory whose left unitors, right unitors, and associators are identities.
We cannot use this definition directly here since the types of 2-morphisms depend on 1-morphisms.
For this reason, we use `eq_to_iso`, which gives isomorphisms from equalities, instead of
identities.
-/

namespace CategoryTheory

open Bicategory

universe w v u

variable (B : Type u) [Bicategory.{w, v} B]

#print CategoryTheory.Bicategory.Strict /-
/-- A bicategory is called `strict` if the left unitors, the right unitors, and the associators are
isomorphisms given by equalities.
-/
class Bicategory.Strict : Prop where
  id_comp' : ∀ {a b : B} (f : a ⟶ b), 𝟙 a ≫ f = f := by obviously
  comp_id' : ∀ {a b : B} (f : a ⟶ b), f ≫ 𝟙 b = f := by obviously
  assoc' : ∀ {a b c d : B} (f : a ⟶ b) (g : b ⟶ c) (h : c ⟶ d), (f ≫ g) ≫ h = f ≫ g ≫ h := by
    obviously
  leftUnitor_eq_to_iso' : ∀ {a b : B} (f : a ⟶ b), λ_ f = eqToIso (id_comp' f) := by obviously
  rightUnitor_eq_to_iso' : ∀ {a b : B} (f : a ⟶ b), ρ_ f = eqToIso (comp_id' f) := by obviously
  associator_eq_to_iso' :
    ∀ {a b c d : B} (f : a ⟶ b) (g : b ⟶ c) (h : c ⟶ d), α_ f g h = eqToIso (assoc' f g h) := by
    obviously
#align category_theory.bicategory.strict CategoryTheory.Bicategory.Strict
-/

restate_axiom bicategory.strict.id_comp'

restate_axiom bicategory.strict.comp_id'

restate_axiom bicategory.strict.assoc'

restate_axiom bicategory.strict.left_unitor_eq_to_iso'

restate_axiom bicategory.strict.right_unitor_eq_to_iso'

restate_axiom bicategory.strict.associator_eq_to_iso'

attribute [simp]
  bicategory.strict.id_comp bicategory.strict.left_unitor_eq_to_iso bicategory.strict.comp_id bicategory.strict.right_unitor_eq_to_iso bicategory.strict.assoc bicategory.strict.associator_eq_to_iso

#print CategoryTheory.StrictBicategory.category /-
-- see Note [lower instance priority]
/-- Category structure on a strict bicategory -/
instance (priority := 100) StrictBicategory.category [Bicategory.Strict B] : Category B
    where
  id_comp' a b := Bicategory.Strict.id_comp
  comp_id' a b := Bicategory.Strict.comp_id
  assoc' a b c d := Bicategory.Strict.assoc
#align category_theory.strict_bicategory.category CategoryTheory.StrictBicategory.category
-/

namespace Bicategory

variable {B}

#print CategoryTheory.Bicategory.whiskerLeft_eqToHom /-
@[simp]
theorem whiskerLeft_eqToHom {a b c : B} (f : a ⟶ b) {g h : b ⟶ c} (η : g = h) :
    f ◁ eqToHom η = eqToHom (congr_arg₂ (· ≫ ·) rfl η) :=
  by
  cases η
  simp only [whisker_left_id, eq_to_hom_refl]
#align category_theory.bicategory.whisker_left_eq_to_hom CategoryTheory.Bicategory.whiskerLeft_eqToHom
-/

#print CategoryTheory.Bicategory.eqToHom_whiskerRight /-
@[simp]
theorem eqToHom_whiskerRight {a b c : B} {f g : a ⟶ b} (η : f = g) (h : b ⟶ c) :
    eqToHom η ▷ h = eqToHom (congr_arg₂ (· ≫ ·) η rfl) :=
  by
  cases η
  simp only [id_whisker_right, eq_to_hom_refl]
#align category_theory.bicategory.eq_to_hom_whisker_right CategoryTheory.Bicategory.eqToHom_whiskerRight
-/

end Bicategory

end CategoryTheory


import algebra.homology.homology
import category_theory.abelian.exact
import category_theory.limits.shapes.zero_objects
import for_mathlib.complex_extend
import for_mathlib.homology_exact

open category_theory
open category_theory.limits

universes v u
variables {A : Type u} [category.{v} A] [abelian A]

namespace chain_complex

variables (C : chain_complex A ℤ)

lemma _root_.category_theory.is_zero_homology_iff_exact
  {X Y Z : A} (f : X ⟶ Y) (g : Y ⟶ Z) (w : f ≫ g = 0) :
  is_zero (homology f g w) ↔ exact f g :=
begin
  rw preadditive.exact_iff_homology_zero,
  split,
  { intros h,
    use [w, h.iso_zero] },
  { rintros ⟨w,⟨h⟩⟩,
    apply is_zero.of_iso _ h,
    exact is_zero_zero _ }
end

lemma exact_of_is_zero_homology
  (h : ∀ i : ℤ, is_zero (C.homology i)) :
  ∀ i j k : ℤ, (complex_shape.down ℤ).rel i j → (complex_shape.down ℤ).rel j k →
  exact (C.d i j) (C.d j k) :=
begin
  rintros i j k ⟨rfl⟩ ⟨rfl⟩,
  dsimp,
  specialize h (k+1),
  erw _root_.category_theory.is_zero_homology_iff_exact at h,
  let e : C.X_prev (k+1) ≅ C.X (k+1+1) :=
    C.X_prev_iso rfl,
  let q : C.X_next (k+1) ≅ C.X k :=
    C.X_next_iso rfl,
  suffices : exact (e.hom ≫ C.d (k+1+1) (k+1)) (C.d (k+1) k ≫ q.inv),
  { simpa using this },
  dsimp [e,q], rwa [← C.d_to_eq, ← C.d_from_eq],
end

-- change of variables ideas
lemma is_zero_homology_of_exact
  (h : ∀ i j k : ℤ, (complex_shape.down ℤ).rel i j → (complex_shape.down ℤ).rel j k →
  exact (C.d i j) (C.d j k)) :
  ∀ i : ℤ, is_zero (C.homology i) :=
begin
  intro i,
  specialize h (i+1) i (i-1) rfl (sub_add_cancel i 1),
  rw _root_.category_theory.is_zero_homology_iff_exact,
  rw ← homological_complex.X_prev_iso_comp_d_to at h, swap, simp,
  rw ← homological_complex.d_from_comp_X_next_iso at h, swap, simp,
  simpa only [exact_comp_iso, exact_iso_comp] using h,
end

/-

kmb experiments  -- happy to delete

-- change of variables ideas
lemma is_zero_homology_of_exact
  (h : ∀ i j k : ℤ, (complex_shape.down ℤ).rel i j → (complex_shape.down ℤ).rel j k →
  exact (C.d i j) (C.d j k)) :
  ∀ i : ℤ, is_zero (C.homology i) :=
begin
  -- For stupid defeq reasons coming up later on we want to change
  -- variables

  -- this has a name (it's `f 1` for some `f`) but I can't find it.
  let eij : ℤ ≃ ℤ := ⟨λ i, i - 1, λ j, j + 1,
  λ i, sub_add_cancel i 1, λ j, add_tsub_cancel_right _ _⟩,
  -- Make the abstract change of variables claim
  suffices : ∀ (j : ℤ), is_zero (homological_complex.homology C (eij.symm j)),
  --
  { intro i,
    -- use the equiv the other way
    specialize this (eij i),
    -- the simplifier can take it from here (avoiding motive not type correct errors)
    simpa, },
  -- now unravel the equiv
  dsimp [eij],
  -- and forget it
  clear eij,
  /-
  alternative approach involves changing goal to ∀ i, P((i - 1) + 1)
  and then generalizing (i - 1) to j, but then you're rewriting under binders,
  TODO: try other way
  -/
  /-
  Third approach (working code below) : instead of defining eij just do the
  rewrite more brutally. I didn't like how you couldn't get rid of i afterwards
  until you introduced j.

  -- convenient to have i of the form k+1 for stupid
  -- definitional reasons so let's start by changing variables.
  have k := i - 1,
  have hk : k = i - 1 := by refl,
  have hi : i = k + 1 := by {rw hk, ring },
  -- That's our bijections between the `i` and `k` world.
  rw hi, -- change all the i's to k's
  -- Define a new variable j to be "k, but forget about whole "defined
  -- in terms of i" part".
  generalize : k = j,
  -- We'll do the entire rest of the problem with the abstract
  -- variable j. We tidy up, for no particular reason.
  clear hi hk k i,
  -/
  intro k,
  rw _root_.category_theory.is_zero_homology_iff_exact,
  specialize h (k+1+1) (k+1) k rfl rfl,
  /-
  h: exact (C.d (i + 1) i) (C.d i (i - 1))
  ⊢ exact (homological_complex.d_to C i) (homological_complex.d_from C i)
  -/
  convert h,
  -- gives me `heq`s
  repeat {admit },
end

-/

lemma exact_iff_is_zero_homology :
  (∀ i : ℤ, is_zero (C.homology i)) ↔
  (∀ i j k : ℤ, (complex_shape.down ℤ).rel i j → (complex_shape.down ℤ).rel j k →
  exact (C.d i j) (C.d j k)) :=
⟨exact_of_is_zero_homology _, is_zero_homology_of_exact _⟩

variable (D : chain_complex A ℕ)

lemma epi_and_exact_of_is_zero_homology
  (h : ∀ i : ℤ,
    is_zero (((homological_complex.embed $
    complex_shape.embedding.nat_down_int_down).obj D).homology i)) :
  epi (D.d 1 0) ∧ ∀ i : ℕ, exact (D.d (i+2) (i+1)) (D.d (i+1) (i)) :=
begin
  split,
  { specialize h 0,
  rw [category_theory.is_zero_homology_iff_exact,
    homological_complex.d_from_eq _ (show (complex_shape.down ℤ).rel 0 (-1), by simp),
    exact_comp_iso, homological_complex.d_to_eq _ (show (complex_shape.down ℤ).rel 1 0, by simp),
    exact_iso_comp] at h,
    rw is_zero.eq_zero_of_tgt (is_zero_zero _)
      (((homological_complex.embed complex_shape.embedding.nat_down_int_down).obj D).d 0 (-1)) at h,
    rw epi_iff_exact_zero_right,
    exact h, -- defeq abuse probably
  },
  { intro i,
    specialize h (i + 1 : ℕ),
    rw [category_theory.is_zero_homology_iff_exact,
      homological_complex.d_from_eq _ (show (complex_shape.down ℤ).rel (i + 1 : ℕ) (i : ℕ), by simp),
      exact_comp_iso, homological_complex.d_to_eq _ (show (complex_shape.down ℤ).rel (i + 2 : ℕ) (i + 1 : ℕ), by simp [add_assoc]; refl),
      exact_iso_comp] at h,
    exact h, }, -- more defeq abuse
end

lemma exact_of_epi {𝒞 : Type*} [category 𝒞] [abelian 𝒞] {A B C : 𝒞} {f : A ⟶ B} {g : B ⟶ C}
  (hfg : f ≫ g = 0) [epi f] : exact f g :=
begin
  rw abelian.exact_iff,
  refine ⟨hfg, _⟩,
  rw [(abelian.epi_iff_cokernel_π_eq_zero _).1 (show epi f, from infer_instance), comp_zero],
end

lemma exact_zero_snd_iff_epi {𝒞 : Type*} [category 𝒞] [abelian 𝒞] {A B C : 𝒞}
  {f : A ⟶ B} : exact f (0 : B ⟶ C) ↔ epi f :=
begin
  split,
  { intro h,
    apply preadditive.epi_of_cokernel_zero,
    rcases (abelian.exact_iff _ _).1 h with ⟨-, h2⟩,
    simpa using h2, },
  { introI _,
    exact exact_of_epi comp_zero, },
end

lemma exact_of_mono {𝒞 : Type*} [category 𝒞] [abelian 𝒞] {A B C : 𝒞} {f : A ⟶ B} {g : B ⟶ C}
  (hfg : f ≫ g = 0) [mono g] : exact f g :=
begin
  rw abelian.exact_iff,
  refine ⟨hfg, _⟩,
  rw [(abelian.mono_iff_kernel_ι_eq_zero g).1 infer_instance, zero_comp],
end

lemma exact_zero_fst_iff_mono {𝒞 : Type*} [category 𝒞] [abelian 𝒞] {A B C : 𝒞}
  {g : B ⟶ C} : exact (0 : A ⟶ B) g ↔ mono g :=
begin
  split,
  { intro h,
    apply preadditive.mono_of_kernel_zero,
    rcases (abelian.exact_iff _ _).1 h with ⟨-, h2⟩,
    simpa using h2, },
  { introI _,
    exact exact_of_mono zero_comp, },
end

lemma nat_epi_iff_exact : epi (D.d 1 0) ↔
  exact (homological_complex.d_to D 0) (homological_complex.d_from D 0) :=
begin
  rw [homological_complex.d_to_eq _ (show (complex_shape.down ℕ).rel 1 0, by simp),
    exact_iso_comp],
  split,
  { introI h,
    apply exact_of_epi,
    apply homological_complex.d_comp_d, },
  { intro h,
    refine h.epi_of_eq_zero (D.shape _ _ _),
    simp only [next_nat_zero, complex_shape.down_rel, nat.one_ne_zero, not_false_iff], },
end

lemma nat_exact_iff_to_from_exact (i : ℕ) :
  exact (D.d (i + 2) (i + 1)) (D.d (i + 1) i) ↔
  exact (homological_complex.d_to D (i + 1)) (homological_complex.d_from D (i + 1)) :=
by rw [homological_complex.d_from_eq _ (show (complex_shape.down ℕ).rel i.succ i, by simp),
    exact_comp_iso, homological_complex.d_to_eq _ (show (complex_shape.down ℕ).rel
      i.succ.succ i.succ, by simp), exact_iso_comp ]

lemma is_zero_homology_of_epi_and_exact
  (h1 : epi (D.d 1 0))
  (h2 : ∀ i : ℕ, exact (D.d (i+2) (i+1)) (D.d (i+1) (i))) :
  ∀ i : ℤ, is_zero (((homological_complex.embed $
    complex_shape.embedding.nat_down_int_down).obj D).homology i) :=
begin
  intro i,
  rw category_theory.is_zero_homology_iff_exact,
  rcases lt_trichotomy i 0 with (hi | rfl | hi),
  { have : is_zero (((homological_complex.embed complex_shape.embedding.nat_down_int_down).obj D).X i),
    { delta homological_complex.embed homological_complex.embed.obj
        complex_shape.embedding.nat_down_int_down complex_shape.embedding.pos_int_to_onat,
      obtain ⟨j, rfl⟩ := int.eq_neg_succ_of_lt_zero hi,
      simp only [is_zero_zero A, homological_complex.embed.X_none],
    },
  exact category_theory.limits.is_zero.exact this _ _ },
  { rw [homological_complex.d_from_eq _ (show (complex_shape.down ℤ).rel 0 (-1), by simp),
    exact_comp_iso, homological_complex.d_to_eq _ (show (complex_shape.down ℤ).rel 1 0, by simp),
    exact_iso_comp],
    apply exact_of_epi (homological_complex.d_comp_d _ (1 : ℤ) 0 (-1)),
    exact h1 }, -- maybe defeq abuse?
  { obtain ⟨j, rfl⟩ := int.eq_succ_of_zero_lt hi, clear hi,
    specialize h2 j,
    rw [homological_complex.d_from_eq _ (show (complex_shape.down ℤ).rel (j.succ : ℕ) j, by simp),
    exact_comp_iso, homological_complex.d_to_eq _ (show (complex_shape.down ℤ).rel
      (j.succ.succ : ℕ) (j.succ), by simp),
    exact_iso_comp],
    exact h2 }, -- maybe defeq abuse
end

lemma epi_and_exact_iff_is_zero_homology :
  (epi (D.d 1 0) ∧ ∀ i : ℕ, exact (D.d (i+2) (i+1)) (D.d (i+1) (i))) ↔
  (∀ i : ℤ, is_zero (((homological_complex.embed $
    complex_shape.embedding.nat_down_int_down).obj D).homology i)) :=
⟨λ h, is_zero_homology_of_epi_and_exact D h.1 h.2,
  epi_and_exact_of_is_zero_homology _⟩

lemma homology_zero_iff_homology_zero :
  (∀ i : ℤ, is_zero (((homological_complex.embed $
    complex_shape.embedding.nat_down_int_down).obj D).homology i)) ↔
  (∀ i : ℕ, is_zero (D.homology i)) :=
begin
  rw ← epi_and_exact_iff_is_zero_homology,
  simp_rw [category_theory.is_zero_homology_iff_exact, nat_epi_iff_exact,
    nat_exact_iff_to_from_exact],
  split,
  { rintro ⟨h0, hS⟩ ( _ | i),
    { exact h0 },
    { exact hS i }, },
  { intro h,
    exact ⟨h 0, λ i, h i.succ⟩, },
end

lemma epi_and_exact_iff_zero_homology' :
  (epi (D.d 1 0) ∧ ∀ i : ℕ, exact (D.d (i+2) (i+1)) (D.d (i+1) (i))) ↔
  (∀ i : ℕ, is_zero (D.homology i)) :=
begin
  rw ← homology_zero_iff_homology_zero,
  apply epi_and_exact_iff_is_zero_homology,
end

universes v' u'

-- `kernel_comparison_comp_ι` in mathlib master (as I write) is not
-- maximally universe-polymorphic; the morphisms of both categories live in the
-- same universe. So we write `[category.{v} B]` instead of `[category.{v'} B]` here.

-- TODO : fix kernel_comparison_comp_ι (if this is indeed an oversight)

lemma exact_iff_map_exact {α : Type*} {c : complex_shape α}
  (D : homological_complex A c)
  {B : Type u'} [category.{v} B] [abelian B] (E : A ≌ B)
  [E.functor.additive] (i j k : α) (f : D.X i ⟶ D.X j) (g : D.X j ⟶ D.X k) :
  exact f g ↔ exact (E.functor.map f) (E.functor.map g) :=
begin
  rw abelian.exact_iff,
  rw abelian.exact_iff,
  apply and_congr,
   { rw [← functor.map_comp],
     exact (functor.map_eq_zero_iff _).symm, },
   { rw [← functor.map_eq_zero_iff E.functor, functor.map_comp],
     rw ← kernel_comparison_comp_ι,
     rw ← π_comp_cokernel_comparison,
     rw ← preserves_kernel.iso_hom,
     rw ← preserves_cokernel.iso_inv,
     rw category.assoc,
     rw preadditive.is_iso.comp_left_eq_zero,
     rw ← category.assoc,
     rw preadditive.is_iso.comp_right_eq_zero, }
end

-- morphisms of B in same universe as morphisms of A because of `exact_iff_map_exact`
lemma homology_zero_iff_map_homology_zero
  {α : Type*} {c : complex_shape α}
  (D : homological_complex A c)
  {B : Type u'} [category.{v} B] [abelian B] (E : A ≌ B)
  [E.functor.additive] :
  (∀ i : α, is_zero (D.homology i)) ↔
  (∀ i : α, is_zero (((E.functor.map_homological_complex _).obj D).homology i)) :=
begin
  apply forall_congr,
  intro i,
  rw category_theory.is_zero_homology_iff_exact,
  rw category_theory.is_zero_homology_iff_exact,
  rw functor.map_homological_complex,
  apply exact_iff_map_exact,
end

end chain_complex


/-
Copyright (c) 2022 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import algebra.order.upper_lower
import topology.algebra.group.basic

/-!
# Topological facts about upper/lower/order-connected sets

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

The topological closure and interior of an upper/lower/order-connected set is an
upper/lower/order-connected set (with the notable exception of the closure of an order-connected
set).

## Implementation notes

The same lemmas are true in the additive/multiplicative worlds. To avoid code duplication, we
provide `has_upper_lower_closure`, an ad hoc axiomatisation of the properties we need.
-/

open function set
open_locale pointwise

/-- Ad hoc class stating that the closure of an upper set is an upper set. This is used to state
lemmas that do not mention algebraic operations for both the additive and multiplicative versions
simultaneously. If you find a satisfying replacement for this typeclass, please remove it! -/
class has_upper_lower_closure (α : Type*) [topological_space α] [preorder α] : Prop :=
(is_upper_set_closure : ∀ s : set α, is_upper_set s → is_upper_set (closure s))
(is_lower_set_closure : ∀ s : set α, is_lower_set s → is_lower_set (closure s))
(is_open_upper_closure : ∀ s : set α, is_open s → is_open (upper_closure s : set α))
(is_open_lower_closure : ∀ s : set α, is_open s → is_open (lower_closure s : set α))

variables {α : Type*} [topological_space α]

@[to_additive, priority 100] -- See note [lower instance priority]
instance ordered_comm_group.to_has_upper_lower_closure [ordered_comm_group α]
  [has_continuous_const_smul α α] : has_upper_lower_closure α :=
{ is_upper_set_closure := λ s h x y hxy hx, closure_mono (h.smul_subset $ one_le_div'.2 hxy) $
    by { rw closure_smul, exact ⟨x, hx, div_mul_cancel' _ _⟩ },
  is_lower_set_closure := λ s h x y hxy hx, closure_mono (h.smul_subset $ div_le_one'.2 hxy) $
    by { rw closure_smul, exact ⟨x, hx, div_mul_cancel' _ _⟩ },
  is_open_upper_closure := λ s hs, by { rw [←mul_one s, ←mul_upper_closure], exact hs.mul_right },
  is_open_lower_closure := λ s hs, by { rw [←mul_one s, ←mul_lower_closure], exact hs.mul_right } }

variables [preorder α] [has_upper_lower_closure α] {s : set α}

protected lemma is_upper_set.closure : is_upper_set s → is_upper_set (closure s) :=
has_upper_lower_closure.is_upper_set_closure _

protected lemma is_lower_set.closure : is_lower_set s → is_lower_set (closure s) :=
has_upper_lower_closure.is_lower_set_closure _

protected lemma is_open.upper_closure : is_open s → is_open (upper_closure s : set α) :=
has_upper_lower_closure.is_open_upper_closure _

protected lemma is_open.lower_closure : is_open s → is_open (lower_closure s : set α) :=
has_upper_lower_closure.is_open_lower_closure _

instance : has_upper_lower_closure αᵒᵈ :=
{ is_upper_set_closure := @is_lower_set.closure α _ _ _,
  is_lower_set_closure := @is_upper_set.closure α _ _ _,
  is_open_upper_closure := @is_open.lower_closure α _ _ _,
  is_open_lower_closure := @is_open.upper_closure α _ _ _ }

/-
Note: `s.ord_connected` does not imply `(closure s).ord_connected`, as we can see by taking
`s := Ioo 0 1 × Ioo 1 2 ∪ Ioo 2 3 × Ioo 0 1` because then
`closure s = Icc 0 1 × Icc 1 2 ∪ Icc 2 3 × Icc 0 1` is not order-connected as
`(1, 1) ∈ closure s`, `(2, 1) ∈ closure s` but `Icc (1, 1) (2, 1) ⊈ closure s`.

`s` looks like
```
xxooooo
xxooooo
oooooxx
oooooxx
```
-/

protected lemma is_upper_set.interior (h : is_upper_set s) : is_upper_set (interior s) :=
by { rw [←is_lower_set_compl, ←closure_compl], exact h.compl.closure }

protected lemma is_lower_set.interior (h : is_lower_set s) : is_lower_set (interior s) :=
h.of_dual.interior

protected lemma set.ord_connected.interior (h : s.ord_connected) : (interior s).ord_connected :=
begin
  rw [←h.upper_closure_inter_lower_closure, interior_inter],
  exact (upper_closure s).upper.interior.ord_connected.inter
    (lower_closure s).lower.interior.ord_connected,
end


/-
Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import analysis.normed_space.operator_norm
import analysis.normed_space.add_torsor
import topology.bases
import linear_algebra.finite_dimensional

/-!
# Finite dimensional normed spaces over complete fields

Over a complete nondiscrete field, in finite dimension, all norms are equivalent and all linear maps
are continuous. Moreover, a finite-dimensional subspace is always complete and closed.

## Main results:

* `linear_map.continuous_of_finite_dimensional` : a linear map on a finite-dimensional space over a
  complete field is continuous.
* `finite_dimensional.complete` : a finite-dimensional space over a complete field is complete. This
  is not registered as an instance, as the field would be an unknown metavariable in typeclass
  resolution.
* `submodule.closed_of_finite_dimensional` : a finite-dimensional subspace over a complete field is
  closed
* `finite_dimensional.proper` : a finite-dimensional space over a proper field is proper. This
  is not registered as an instance, as the field would be an unknown metavariable in typeclass
  resolution. It is however registered as an instance for `𝕜 = ℝ` and `𝕜 = ℂ`. As properness
  implies completeness, there is no need to also register `finite_dimensional.complete` on `ℝ` or
  `ℂ`.

## Implementation notes

The fact that all norms are equivalent is not written explicitly, as it would mean having two norms
on a single space, which is not the way type classes work. However, if one has a
finite-dimensional vector space `E` with a norm, and a copy `E'` of this type with another norm,
then the identities from `E` to `E'` and from `E'`to `E` are continuous thanks to
`linear_map.continuous_of_finite_dimensional`. This gives the desired norm equivalence.
-/

universes u v w x

open set finite_dimensional topological_space filter
open_locale classical big_operators filter topological_space

noncomputable theory

/-- A linear map on `ι → 𝕜` (where `ι` is a fintype) is continuous -/
lemma linear_map.continuous_on_pi {ι : Type w} [fintype ι] {𝕜 : Type u} [normed_field 𝕜]
  {E : Type v}  [add_comm_group E] [module 𝕜 E] [topological_space E]
  [topological_add_group E] [has_continuous_smul 𝕜 E] (f : (ι → 𝕜) →ₗ[𝕜] E) : continuous f :=
begin
  -- for the proof, write `f` in the standard basis, and use that each coordinate is a continuous
  -- function.
  have : (f : (ι → 𝕜) → E) =
         (λx, ∑ i : ι, x i • (f (λj, if i = j then 1 else 0))),
    by { ext x, exact f.pi_apply_eq_sum_univ x },
  rw this,
  refine continuous_finset_sum _ (λi hi, _),
  exact (continuous_apply i).smul continuous_const
end

section complete_field

variables {𝕜 : Type u} [nondiscrete_normed_field 𝕜]
{E : Type v} [normed_group E] [normed_space 𝕜 E]
{F : Type w} [normed_group F] [normed_space 𝕜 F]
{F' : Type x} [add_comm_group F'] [module 𝕜 F'] [topological_space F']
[topological_add_group F'] [has_continuous_smul 𝕜 F']
[complete_space 𝕜]

/-- In finite dimension over a complete field, the canonical identification (in terms of a basis)
with `𝕜^n` together with its sup norm is continuous. This is the nontrivial part in the fact that
all norms are equivalent in finite dimension.

This statement is superceded by the fact that every linear map on a finite-dimensional space is
continuous, in `linear_map.continuous_of_finite_dimensional`. -/
lemma continuous_equiv_fun_basis {ι : Type v} [fintype ι] (ξ : ι → E) (hξ : is_basis 𝕜 ξ) :
  continuous hξ.equiv_fun :=
begin
  unfreezingI { induction hn : fintype.card ι with n IH generalizing ι E },
  { apply linear_map.continuous_of_bound _ 0 (λx, _),
    have : hξ.equiv_fun x = 0,
      by { ext i, exact (fintype.card_eq_zero_iff.1 hn i).elim },
    change ∥hξ.equiv_fun x∥ ≤ 0 * ∥x∥,
    rw this,
    simp [norm_nonneg] },
  { haveI : finite_dimensional 𝕜 E := of_fintype_basis hξ,
    -- first step: thanks to the inductive assumption, 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 → is_closed (s : set E),
    { assume s s_dim,
      rcases exists_is_basis_finite 𝕜 s with ⟨b, b_basis, b_finite⟩,
      letI : fintype b := finite.fintype b_finite,
      have U : uniform_embedding b_basis.equiv_fun.symm.to_equiv,
      { have : fintype.card b = n,
          by { rw ← s_dim, exact (finrank_eq_card_basis b_basis).symm },
        have : continuous b_basis.equiv_fun := IH (subtype.val : b → s) b_basis this,
        exact b_basis.equiv_fun.symm.uniform_embedding (linear_map.continuous_on_pi _) this },
      have : is_complete (s : set E),
        from complete_space_coe_iff_is_complete.1 ((complete_space_congr U).1 (by apply_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,
    { assume f,
      have : finrank 𝕜 f.ker = n ∨ finrank 𝕜 f.ker = n.succ,
      { have Z := f.finrank_range_add_finrank_ker,
        rw [finrank_eq_card_basis hξ, hn] at Z,
        by_cases H : finrank 𝕜 f.range = 0,
        { right,
          rw H at Z,
          simpa using Z },
        { left,
          have : finrank 𝕜 f.range = 1,
          { refine le_antisymm _ (zero_lt_iff.mpr H),
            simpa [finrank_of_field] using f.range.finrank_le },
          rw [this, add_comm, nat.add_one] at Z,
          exact nat.succ.inj Z } },
      have : is_closed (f.ker : set E),
      { cases this,
        { exact H₁ _ this },
        { have : f.ker = ⊤,
            by { apply eq_top_of_finrank_eq, rw [finrank_eq_card_basis hξ, hn, this] },
          simp [this] } },
      exact linear_map.continuous_iff_is_closed_ker.2 this },
    -- third step: applying the continuity to the linear form corresponding to a coefficient in the
    -- basis decomposition, deduce that all such coefficients are controlled in terms of the norm
    have : ∀i:ι, ∃C, 0 ≤ C ∧ ∀(x:E), ∥hξ.equiv_fun x i∥ ≤ C * ∥x∥,
    { assume i,
      let f : E →ₗ[𝕜] 𝕜 := (linear_map.proj i).comp hξ.equiv_fun,
      let f' : E →L[𝕜] 𝕜 := { cont := H₂ f, ..f },
      exact ⟨∥f'∥, norm_nonneg _, λx, continuous_linear_map.le_op_norm f' x⟩ },
    -- fourth step: combine the bound on each coefficient to get a global bound and the continuity
    choose C0 hC0 using this,
    let C := ∑ i, C0 i,
    have C_nonneg : 0 ≤ C := finset.sum_nonneg (λi hi, (hC0 i).1),
    have C0_le : ∀i, C0 i ≤ C :=
      λi, finset.single_le_sum (λj hj, (hC0 j).1) (finset.mem_univ _),
    apply linear_map.continuous_of_bound _ C (λx, _),
    rw pi_semi_norm_le_iff,
    { exact λi, le_trans ((hC0 i).2 x) (mul_le_mul_of_nonneg_right (C0_le i) (norm_nonneg _)) },
    { exact mul_nonneg C_nonneg (norm_nonneg _) } }
end

/-- Any linear map on a finite dimensional space over a complete field is continuous. -/
theorem linear_map.continuous_of_finite_dimensional [finite_dimensional 𝕜 E] (f : E →ₗ[𝕜] F') :
  continuous f :=
begin
  -- 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.
  rcases exists_is_basis_finite 𝕜 E with ⟨b, b_basis, b_finite⟩,
  letI : fintype b := finite.fintype b_finite,
  have A : continuous b_basis.equiv_fun :=
    continuous_equiv_fun_basis _ b_basis,
  have B : continuous (f.comp (b_basis.equiv_fun.symm : (b → 𝕜) →ₗ[𝕜] E)) :=
    linear_map.continuous_on_pi _,
  have : continuous ((f.comp (b_basis.equiv_fun.symm : (b → 𝕜) →ₗ[𝕜] E))
                      ∘ b_basis.equiv_fun) := B.comp A,
  convert this,
  ext x,
  dsimp,
  rw linear_equiv.symm_apply_apply
end

theorem affine_map.continuous_of_finite_dimensional {PE PF : Type*}
  [metric_space PE] [normed_add_torsor E PE] [metric_space PF] [normed_add_torsor F PF]
  [finite_dimensional 𝕜 E] (f : PE →ᵃ[𝕜] PF) : continuous f :=
affine_map.continuous_linear_iff.1 f.linear.continuous_of_finite_dimensional

namespace linear_map

variables [finite_dimensional 𝕜 E]

/-- The continuous linear map induced by a linear map on a finite dimensional space -/
def to_continuous_linear_map : (E →ₗ[𝕜] F') ≃ₗ[𝕜] E →L[𝕜] F' :=
{ to_fun := λ f, ⟨f, f.continuous_of_finite_dimensional⟩,
  inv_fun := coe,
  map_add' := λ f g, rfl,
  map_smul' := λ c f, rfl,
  left_inv := λ f, rfl,
  right_inv := λ f, continuous_linear_map.coe_injective rfl }

@[simp] lemma coe_to_continuous_linear_map' (f : E →ₗ[𝕜] F') :
  ⇑f.to_continuous_linear_map = f := rfl

@[simp] lemma coe_to_continuous_linear_map (f : E →ₗ[𝕜] F') :
  (f.to_continuous_linear_map : E →ₗ[𝕜] F') = f := rfl

@[simp] lemma coe_to_continuous_linear_map_symm :
  ⇑(to_continuous_linear_map : (E →ₗ[𝕜] F') ≃ₗ[𝕜] E →L[𝕜] F').symm = coe := rfl

end linear_map

/-- The continuous linear equivalence induced by a linear equivalence on a finite dimensional
space. -/
def linear_equiv.to_continuous_linear_equiv [finite_dimensional 𝕜 E] (e : E ≃ₗ[𝕜] F) : E ≃L[𝕜] F :=
{ continuous_to_fun := e.to_linear_map.continuous_of_finite_dimensional,
  continuous_inv_fun := begin
    haveI : finite_dimensional 𝕜 F := e.finite_dimensional,
    exact e.symm.to_linear_map.continuous_of_finite_dimensional
  end,
  ..e }

lemma linear_map.exists_antilipschitz_with [finite_dimensional 𝕜 E] (f : E →ₗ[𝕜] F)
  (hf : f.ker = ⊥) : ∃ K > 0, antilipschitz_with K f :=
begin
  cases subsingleton_or_nontrivial E; resetI,
  { exact ⟨1, zero_lt_one, antilipschitz_with.of_subsingleton⟩ },
  { let e : E ≃L[𝕜] f.range := (linear_equiv.of_injective f hf).to_continuous_linear_equiv,
    exact ⟨_, e.nnnorm_symm_pos, e.antilipschitz⟩ }
end

protected lemma linear_independent.eventually {ι} [fintype ι] {f : ι → E}
  (hf : linear_independent 𝕜 f) : ∀ᶠ g in 𝓝 f, linear_independent 𝕜 g :=
begin
  simp only [fintype.linear_independent_iff'] at hf ⊢,
  rcases linear_map.exists_antilipschitz_with _ hf with ⟨K, K0, hK⟩,
  have : tendsto (λ g : ι → E, ∑ i, ∥g i - f i∥) (𝓝 f) (𝓝 $ ∑ i, ∥f i - f i∥),
    from tendsto_finset_sum _ (λ i hi, tendsto.norm $
      ((continuous_apply i).tendsto _).sub tendsto_const_nhds),
  simp only [sub_self, norm_zero, finset.sum_const_zero] at this,
  refine (this.eventually (gt_mem_nhds $ inv_pos.2 K0)).mono (λ g hg, _),
  replace hg : ∑ i, nnnorm (g i - f i) < K⁻¹, by { rw ← nnreal.coe_lt_coe, push_cast, exact hg },
  rw linear_map.ker_eq_bot,
  refine (hK.add_sub_lipschitz_with (lipschitz_with.of_dist_le_mul $ λ v u, _) hg).injective,
  simp only [dist_eq_norm, linear_map.lsum_apply, pi.sub_apply, linear_map.sum_apply,
    linear_map.comp_apply, linear_map.proj_apply, linear_map.smul_right_apply, linear_map.id_apply,
    ← finset.sum_sub_distrib, ← smul_sub, ← sub_smul, nnreal.coe_sum, coe_nnnorm, finset.sum_mul],
  refine norm_sum_le_of_le _ (λ i _, _),
  rw [norm_smul, mul_comm],
  exact mul_le_mul_of_nonneg_left (norm_le_pi_norm (v - u) i) (norm_nonneg _)
end

lemma is_open_set_of_linear_independent {ι : Type*} [fintype ι] :
  is_open {f : ι → E | linear_independent 𝕜 f} :=
is_open_iff_mem_nhds.2 $ λ f, linear_independent.eventually

lemma is_open_set_of_nat_le_rank (n : ℕ) : is_open {f : E →L[𝕜] F | ↑n ≤ rank (f : E →ₗ[𝕜] F)} :=
begin
  simp only [le_rank_iff_exists_linear_independent_finset, set_of_exists, ← exists_prop],
  refine is_open_bUnion (λ t ht, _),
  have : continuous (λ f : E →L[𝕜] F, (λ x : (t : set E), f x)),
    from continuous_pi (λ x, (continuous_linear_map.apply 𝕜 F (x : E)).continuous),
  exact is_open_set_of_linear_independent.preimage this
end

/-- Two finite-dimensional normed spaces are continuously linearly equivalent if they have the same
(finite) dimension. -/
theorem finite_dimensional.nonempty_continuous_linear_equiv_of_finrank_eq
  [finite_dimensional 𝕜 E] [finite_dimensional 𝕜 F] (cond : finrank 𝕜 E = finrank 𝕜 F) :
  nonempty (E ≃L[𝕜] F) :=
(nonempty_linear_equiv_of_finrank_eq cond).map linear_equiv.to_continuous_linear_equiv

/-- Two finite-dimensional normed spaces are continuously linearly equivalent if and only if they
have the same (finite) dimension. -/
theorem finite_dimensional.nonempty_continuous_linear_equiv_iff_finrank_eq
  [finite_dimensional 𝕜 E] [finite_dimensional 𝕜 F] :
   nonempty (E ≃L[𝕜] F) ↔ finrank 𝕜 E = finrank 𝕜 F :=
⟨ λ ⟨h⟩, h.to_linear_equiv.finrank_eq,
  λ h, finite_dimensional.nonempty_continuous_linear_equiv_of_finrank_eq h ⟩

/-- A continuous linear equivalence between two finite-dimensional normed spaces of the same
(finite) dimension. -/
def continuous_linear_equiv.of_finrank_eq [finite_dimensional 𝕜 E] [finite_dimensional 𝕜 F]
  (cond : finrank 𝕜 E = finrank 𝕜 F) :
  E ≃L[𝕜] F :=
(linear_equiv.of_finrank_eq E F cond).to_continuous_linear_equiv

variables {ι : Type*} [fintype ι]

/-- Construct a continuous linear map given the value at a finite basis. -/
def is_basis.constrL {v : ι → E} (hv : is_basis 𝕜 v) (f : ι → F) :
  E →L[𝕜] F :=
by haveI : finite_dimensional 𝕜 E := finite_dimensional.of_fintype_basis hv;
  exact (hv.constr f).to_continuous_linear_map

@[simp, norm_cast] lemma is_basis.coe_constrL {v : ι → E} (hv : is_basis 𝕜 v) (f : ι → F) :
  (hv.constrL f : E →ₗ[𝕜] F) = hv.constr f := rfl

/-- The continuous linear equivalence between a vector space over `𝕜` with a finite basis and
functions from its basis indexing type to `𝕜`. -/
def is_basis.equiv_funL {v : ι → E} (hv : is_basis 𝕜 v) : E ≃L[𝕜] (ι → 𝕜) :=
{ continuous_to_fun := begin
    haveI : finite_dimensional 𝕜 E := finite_dimensional.of_fintype_basis hv,
    apply linear_map.continuous_of_finite_dimensional,
  end,
  continuous_inv_fun := begin
    change continuous hv.equiv_fun.symm.to_fun,
    apply linear_map.continuous_of_finite_dimensional,
  end,
  ..hv.equiv_fun }

@[simp] lemma is_basis.constrL_apply {v : ι → E} (hv : is_basis 𝕜 v) (f : ι → F) (e : E) :
  (hv.constrL f) e = ∑ i, (hv.equiv_fun e i) • f i :=
hv.constr_apply_fintype _ _

@[simp] lemma is_basis.constrL_basis {v : ι → E} (hv : is_basis 𝕜 v) (f : ι → F) (i : ι) :
  (hv.constrL f) (v i) = f i :=
constr_basis _

lemma is_basis.sup_norm_le_norm {v : ι → E} (hv : is_basis 𝕜 v) :
  ∃ C > (0 : ℝ), ∀ e : E, ∑ i, ∥hv.equiv_fun e i∥ ≤ C * ∥e∥ :=
begin
  set φ := hv.equiv_funL.to_continuous_linear_map,
  set C := ∥φ∥ * (fintype.card ι),
  use [max C 1, lt_of_lt_of_le (zero_lt_one) (le_max_right C 1)],
  intros e,
  calc ∑ i, ∥φ e i∥ ≤ ∑ i : ι, ∥φ e∥ : by { apply finset.sum_le_sum,
                                           exact λ i hi, norm_le_pi_norm (φ e) i }
  ... = ∥φ e∥*(fintype.card ι) : by simpa only [mul_comm, finset.sum_const, nsmul_eq_mul]
  ... ≤ ∥φ∥ * ∥e∥ * (fintype.card ι) : mul_le_mul_of_nonneg_right (φ.le_op_norm e)
                                                                 (fintype.card ι).cast_nonneg
  ... = ∥φ∥ * (fintype.card ι) * ∥e∥ : by ring
  ... ≤ max C 1 * ∥e∥ :  mul_le_mul_of_nonneg_right (le_max_left _ _) (norm_nonneg _)
end

lemma is_basis.op_norm_le  {ι : Type*} [fintype ι] {v : ι → E} (hv : is_basis 𝕜 v) :
  ∃ C > (0 : ℝ), ∀ {u : E →L[𝕜] F} {M : ℝ}, 0 ≤ M → (∀ i, ∥u (v i)∥ ≤ M) → ∥u∥ ≤ C*M :=
begin
  obtain ⟨C, C_pos, hC⟩ : ∃ C > (0 : ℝ), ∀ (e : E), ∑ i, ∥hv.equiv_fun e i∥ ≤ C * ∥e∥,
    from hv.sup_norm_le_norm,
  use [C, C_pos],
  intros u M hM hu,
  apply u.op_norm_le_bound (mul_nonneg (le_of_lt C_pos) hM),
  intros e,
  calc
  ∥u e∥ = ∥u (∑ i, hv.equiv_fun e i • v i)∥ :  by conv_lhs { rw ← hv.equiv_fun_total e }
  ... = ∥∑ i, (hv.equiv_fun e i) • (u $ v i)∥ :  by simp [u.map_sum, linear_map.map_smul]
  ... ≤ ∑ i, ∥(hv.equiv_fun e i) • (u $ v i)∥ : norm_sum_le _ _
  ... = ∑ i, ∥hv.equiv_fun e i∥ * ∥u (v i)∥ : by simp only [norm_smul]
  ... ≤ ∑ i, ∥hv.equiv_fun e i∥ * M : finset.sum_le_sum (λ i hi,
                                                  mul_le_mul_of_nonneg_left (hu i) (norm_nonneg _))
  ... = (∑ i, ∥hv.equiv_fun e i∥) * M : finset.sum_mul.symm
  ... ≤ C * ∥e∥ * M : mul_le_mul_of_nonneg_right (hC e) hM
  ... = C * M * ∥e∥ : by ring
end

instance [finite_dimensional 𝕜 E] [second_countable_topology F] :
  second_countable_topology (E →L[𝕜] F) :=
begin
  set d := finite_dimensional.finrank 𝕜 E,
  suffices :
    ∀ ε > (0 : ℝ), ∃ n : (E →L[𝕜] F) → fin d → ℕ, ∀ (f g : E →L[𝕜] F), n f = n g → dist f g ≤ ε,
  from metric.second_countable_of_countable_discretization
    (λ ε ε_pos, ⟨fin d → ℕ, by apply_instance, this ε ε_pos⟩),
  intros ε ε_pos,
  obtain ⟨u : ℕ → F, hu : dense_range u⟩ := exists_dense_seq F,
  obtain ⟨v : fin d → E, hv : is_basis 𝕜 v⟩ := finite_dimensional.fin_basis 𝕜 E,
  obtain ⟨C : ℝ, C_pos : 0 < C,
          hC : ∀ {φ : E →L[𝕜] F} {M : ℝ}, 0 ≤ M → (∀ i, ∥φ (v i)∥ ≤ M) → ∥φ∥ ≤ C * M⟩ :=
    hv.op_norm_le,
  have h_2C : 0 < 2*C := mul_pos zero_lt_two C_pos,
  have hε2C : 0 < ε/(2*C) := div_pos ε_pos h_2C,
  have : ∀ φ : E →L[𝕜] F, ∃ n : fin d → ℕ, ∥φ - (hv.constrL $ u ∘ n)∥ ≤ ε/2,
  { intros φ,
    have : ∀ i, ∃ n, ∥φ (v i) - u n∥ ≤ ε/(2*C),
    { simp only [norm_sub_rev],
      intro i,
      have : φ (v i) ∈ closure (range u) := hu _,
      obtain ⟨n, hn⟩ : ∃ n, ∥u n - φ (v i)∥ < ε / (2 * C),
      { rw mem_closure_iff_nhds_basis metric.nhds_basis_ball at this,
        specialize this (ε/(2*C)) hε2C,
        simpa [dist_eq_norm] },
      exact ⟨n, le_of_lt hn⟩ },
    choose n hn using this,
    use n,
    replace hn : ∀ i : fin d, ∥(φ - (hv.constrL $ u ∘ n)) (v i)∥ ≤ ε / (2 * C), by simp [hn],
    have : C * (ε / (2 * C)) = ε/2,
    { rw [eq_div_iff (two_ne_zero : (2 : ℝ) ≠ 0), mul_comm, ← mul_assoc,
          mul_div_cancel' _ (ne_of_gt h_2C)] },
    specialize hC (le_of_lt hε2C) hn,
    rwa this at hC },
  choose n hn using this,
  set Φ := λ φ : E →L[𝕜] F, (hv.constrL $ u ∘ (n φ)),
  change ∀ z, dist z (Φ z) ≤ ε/2 at hn,
  use n,
  intros x y hxy,
  calc dist x y ≤ dist x (Φ x) + dist (Φ x) y : dist_triangle _ _ _
  ... = dist x (Φ x) + dist y (Φ y) : by simp [Φ, hxy, dist_comm]
  ... ≤ ε : by linarith [hn x, hn y]
end

/-- Any finite-dimensional vector space over a complete field is complete.
We do not register this as an instance to avoid an instance loop when trying to prove the
completeness of `𝕜`, and the search for `𝕜` as an unknown metavariable. Declare the instance
explicitly when needed. -/
variables (𝕜 E)
lemma finite_dimensional.complete [finite_dimensional 𝕜 E] : complete_space E :=
begin
  set e := continuous_linear_equiv.of_finrank_eq (@finrank_fin_fun 𝕜 _ (finrank 𝕜 E)).symm,
  have : uniform_embedding e.to_linear_equiv.to_equiv.symm := e.symm.uniform_embedding,
  exact (complete_space_congr this).1 (by apply_instance)
end

variables {𝕜 E}
/-- A finite-dimensional subspace is complete. -/
lemma submodule.complete_of_finite_dimensional (s : submodule 𝕜 E) [finite_dimensional 𝕜 s] :
  is_complete (s : set E) :=
complete_space_coe_iff_is_complete.1 (finite_dimensional.complete 𝕜 s)

/-- A finite-dimensional subspace is closed. -/
lemma submodule.closed_of_finite_dimensional (s : submodule 𝕜 E) [finite_dimensional 𝕜 s] :
  is_closed (s : set E) :=
s.complete_of_finite_dimensional.is_closed

lemma continuous_linear_map.exists_right_inverse_of_surjective [finite_dimensional 𝕜 F]
  (f : E →L[𝕜] F) (hf : f.range = ⊤) :
  ∃ g : F →L[𝕜] E, f.comp g = continuous_linear_map.id 𝕜 F :=
let ⟨g, hg⟩ := (f : E →ₗ[𝕜] F).exists_right_inverse_of_surjective hf in
⟨g.to_continuous_linear_map, continuous_linear_map.ext $ linear_map.ext_iff.1 hg⟩

lemma closed_embedding_smul_left {c : E} (hc : c ≠ 0) : closed_embedding (λ x : 𝕜, x • c) :=
begin
  haveI : finite_dimensional 𝕜 (submodule.span 𝕜 {c}) :=
    finite_dimensional.span_of_finite 𝕜 (finite_singleton c),
  have m1 : closed_embedding (coe : submodule.span 𝕜 {c} → E) :=
  (submodule.span 𝕜 {c}).closed_of_finite_dimensional.closed_embedding_subtype_coe,
  have m2 : closed_embedding
    (linear_equiv.to_span_nonzero_singleton 𝕜 E c hc : 𝕜 → submodule.span 𝕜 {c}) :=
  (continuous_linear_equiv.to_span_nonzero_singleton 𝕜 c hc).to_homeomorph.closed_embedding,
  exact m1.comp m2
end

/- `smul` is a closed map in the first argument. -/
lemma is_closed_map_smul_left (c : E) : is_closed_map (λ x : 𝕜, x • c) :=
begin
  by_cases hc : c = 0,
  { simp_rw [hc, smul_zero], exact is_closed_map_const },
  { exact (closed_embedding_smul_left hc).is_closed_map }
end

end complete_field

section proper_field
variables (𝕜 : Type u) [nondiscrete_normed_field 𝕜]
(E : Type v) [normed_group E] [normed_space 𝕜 E] [proper_space 𝕜]

/-- Any finite-dimensional vector space over a proper field is proper.
We do not register this as an instance to avoid an instance loop when trying to prove the
properness of `𝕜`, and the search for `𝕜` as an unknown metavariable. Declare the instance
explicitly when needed. -/
lemma finite_dimensional.proper [finite_dimensional 𝕜 E] : proper_space E :=
begin
  set e := continuous_linear_equiv.of_finrank_eq (@finrank_fin_fun 𝕜 _ (finrank 𝕜 E)).symm,
  exact e.symm.antilipschitz.proper_space e.symm.continuous e.symm.surjective
end

end proper_field

/- Over the real numbers, we can register the previous statement as an instance as it will not
cause problems in instance resolution since the properness of `ℝ` is already known. -/
instance finite_dimensional.proper_real
  (E : Type u) [normed_group E] [normed_space ℝ E] [finite_dimensional ℝ E] : proper_space E :=
finite_dimensional.proper ℝ E

attribute [instance, priority 900] finite_dimensional.proper_real

/-- In a finite dimensional vector space over `ℝ`, the series `∑ x, ∥f x∥` is unconditionally
summable if and only if the series `∑ x, f x` is unconditionally summable. One implication holds in
any complete normed space, while the other holds only in finite dimensional spaces. -/
lemma summable_norm_iff {α E : Type*} [normed_group E] [normed_space ℝ E] [finite_dimensional ℝ E]
  {f : α → E} : summable (λ x, ∥f x∥) ↔ summable f :=
begin
  refine ⟨summable_of_summable_norm, λ hf, _⟩,
  -- First we use a finite basis to reduce the problem to the case `E = fin N → ℝ`
  suffices : ∀ {N : ℕ} {g : α → fin N → ℝ}, summable g → summable (λ x, ∥g x∥),
  { rcases fin_basis ℝ E with ⟨v, hv⟩,
    set e := hv.equiv_funL,
    have : summable (λ x, ∥e (f x)∥) := this (e.summable.2 hf),
    refine summable_of_norm_bounded _ (this.mul_left
      ↑(nnnorm (e.symm : (fin (finrank ℝ E) → ℝ) →L[ℝ] E))) (λ i, _),
    simpa using (e.symm : (fin (finrank ℝ E) → ℝ) →L[ℝ] E).le_op_norm (e $ f i) },
  unfreezingI { clear_dependent E },
  -- Now we deal with `g : α → fin N → ℝ`
  intros N g hg,
  have : ∀ i, summable (λ x, ∥g x i∥) := λ i, (pi.summable.1 hg i).abs,
  refine summable_of_norm_bounded _ (summable_sum (λ i (hi : i ∈ finset.univ), this i)) (λ x, _),
  rw [norm_norm, pi_norm_le_iff],
  { refine λ i, finset.single_le_sum (λ i hi, _) (finset.mem_univ i),
    exact norm_nonneg (g x i) },
  { exact finset.sum_nonneg (λ _ _, norm_nonneg _) }
end


import
  tactic.find tactic.omega
  data.vector list_lemma

namespace AlgStructures

class monoid {A : Type*} (e : A) (f : A → A → A) [decidable_eq A] :=
 (Hassoc : ∀ a b c : A, f a (f b c) = f (f a b) c)
 (Hidl : ∀ a : A, f e a = a)
 (Hidr : ∀ a : A, f a e = a)

class group {A : Type*} (e : A) (f : A → A → A)
 (inv : A → A) [Hdec : decidable_eq A] :=
 (Hmon : @monoid A e f Hdec)
 (Hinvl : ∀ x, f (inv x) x = e)
 (Hinvr : ∀ x, f x (inv x) = e)

class abelian_group {A : Type*} (e : A) (f : A → A → A)
 (inv : A → A) [Hdec : decidable_eq A] :=
 (Hg : @group A e f inv Hdec)
 (Hcomm : ∀ x y : A, f x y = f y x)

/- assuming a ring with identity -/
class ring {A : Type*} (zero one : A)
 (Radd Rsub Rmult : A → A → A) (Ropp : A → A)
 [Hdec : decidable_eq A] :=
 (Habel : @abelian_group A zero Radd Ropp Hdec)
 (Hmon : @monoid A one Rmult Hdec)
 (Ring_distr_l : forall x y z, Rmult (Radd x y) z =
    Radd (Rmult x z) (Rmult y z))
 (Ring_distr_r : forall x y z, Rmult z (Radd x y) =
    Radd (Rmult z x) (Rmult z y))
 (Ring_sub_def : forall x y, Rsub x y = Radd x (Ropp y))

class commutative_ring {A : Type*} (zero one : A)
 (Radd Rsub Rmult : A → A → A) (Ropp : A → A)
 [Hdec : decidable_eq A] :=
 (Hring : @ring A zero one Radd Rsub Rmult Ropp Hdec)
 (Hinv : forall x y : A, Rmult x y = Rmult y x)

class field {A : Type*} (zero one : A)
 (Fadd Fsub Fmult Fdiv : A → A → A) (Fopp Finv : A → A)
 [Hdec : decidable_eq A] :=
 (Hcring : @commutative_ring A zero one Fadd Fsub Fmult
                Fopp Hdec)
 (Hfinvl : forall x : A, x ≠ zero -> Fmult (Finv x) x = one)
 (Hfinvr : forall x : A, x ≠ zero -> Fmult x (Finv x) = one)
 (Hzinv : Finv zero = zero)

class vector_space {F : Type*} {V : Type*} (Fzero Fone : F)
    (Fadd Fsub Fmult Fdiv : F → F → F) (Fopp Finv : F → F)
    (Vone : V) (Vdot : V → V → V) (Vinv : V → V) (Vop : F → V → V)
    [Hfdec : decidable_eq F] [Hgdec : decidable_eq V] :=
    (Hfield : @field F Fzero Fone Fadd Fsub Fmult Fdiv Fopp Finv Hfdec)
    (Hgroup : @abelian_group V Vone Vdot Vinv Hgdec)
    (Hcomp  : forall (x y : F) (v : V), Vop x (Vop y v) = Vop (Fmult x y) v)
    (Hdistr_fv : forall x v₁ v₂, Vop x (Vdot v₁ v₂) = Vdot (Vop x v₁) (Vop x v₂))
    (Hdistr_vf : forall x y v, Vop (Fadd x y) v = Vdot (Vop x v) (Vop y v))
    (Hfoneid : forall v, Vop Fone v = v)
    (Hfzerid : forall v, Vop Fzero v = Vone)

end AlgStructures

namespace Elgamal
open AlgStructures

 section
 variables
   {F : Type*}
   {G : Type*}
   (Fzero Fone : F)
   (Fadd Fsub Fmult Fdiv : F → F → F)
   (Fopp Finv : F → F)
   (Gone : G)
   (Gdot : G → G → G)
   (Ginv : G → G)
   (Gop : F → G → G)
   [Hfdec : decidable_eq F]
   [Hgdec : decidable_eq G]
   [Hvec : @vector_space F G
           Fzero Fone Fadd
           Fsub Fmult Fdiv
           Fopp Finv Gone
           Gdot Ginv Gop
           Hfdec Hgdec]

variables
   (g : G) /- generator -/
   (x : F) /- private key -/
   (h : G) /- publick key -/
   (Hp : h = Gop x g) /- g = h^x -/

/- When suppling Gdot, map m => g^m -/
def elgamal_enc (r : F) (m : G) :=
  (Gop r g, Gdot m (Gop r h))

def elgamal_dec (c : G × G) : G :=
 Gdot c.2 (Ginv (Gop x c.1))

def elgamal_reenc (r : F) (c : G × G) :=
  (Gdot c.1 (Gop r g), Gdot c.2 (Gop r h))

def ciphertext_mult (c d : G × G) :=
     (Gdot c.1 d.1, Gdot c.2 d.2)

def vector_elegamal_enc {n : ℕ} :
  vector F n -> vector G n ->
  vector (G × G) n
  | ⟨rs, Hr⟩ ⟨ms, Hm⟩ :=
    ⟨list.zip_with (elgamal_enc Gdot Gop g h) rs ms,
    begin
      have Ht : list.length rs = list.length ms :=
      begin rw [Hm, Hr] end, rw <- Hr,
      apply zip_with_len_l, exact Ht
    end⟩

def vector_elegamal_dec {n : ℕ} :
  vector (G × G) n -> vector G n
  | ⟨cs, Hc⟩  :=
    ⟨list.map (elgamal_dec Gdot Ginv Gop x) cs,
      by rw <- Hc; apply map_with_len_l⟩

def vector_elegamal_reenc {n : ℕ} :
  vector F n -> vector (G × G) n ->
  vector (G × G) n
  | ⟨rs, Hr⟩ ⟨cs, Hc⟩ :=
    ⟨list.zip_with (elgamal_reenc Gdot Gop g h) rs cs,
    begin
      have Ht : list.length rs = list.length cs :=
      begin rw [Hc, Hr] end,
      rw <- Hr, apply zip_with_len_l, exact Ht
    end⟩

def vector_ciphertext_mult {n : ℕ} :
  vector (G × G) n -> vector (G × G) n ->
  vector (G × G) n
  | ⟨cs₁ , Hc₁⟩  ⟨cs₂, Hc₂⟩ :=
    ⟨list.zip_with (ciphertext_mult Gdot) cs₁  cs₂,
    begin
      have Ht : list.length cs₁ = list.length cs₂ :=
      begin rw [Hc₁, Hc₂] end,
      rw <- Hc₁, apply zip_with_len_l, exact Ht,
    end⟩

include Hvec Hp
theorem decryption_correct (r : F) (m : G) (c : G × G):
  c = elgamal_enc Gdot Gop g h r m ->
  elgamal_dec Gdot Ginv Gop x c = m :=
begin
  intro Hc, rw [Hc, Hp],
  unfold elgamal_enc elgamal_dec,
  simp,
  destruct Hvec, intros, clear a,
  repeat {rw Hcomp},
  destruct Hgroup, intros, clear a,
  destruct Hfield, intros, clear a,
  destruct Hcring, intros, clear a,
  rw Hinv,
  destruct Hring, intros, clear a,
  destruct Hg, intros, clear a,
  destruct Hmon_1, intros, clear a,
  rw [<- Hassoc, Hinvr, Hidr]
end

theorem reencryption_decrypt_correct
  (r₁ r₂ : F) (m : G) (c₁ c₂ : G × G) :
  c₁ = elgamal_enc Gdot Gop g h r₁ m    ->
  c₂ = elgamal_reenc Gdot Gop g h r₂ c₁ ->
  elgamal_dec Gdot Ginv Gop x c₂ = m :=
  begin
    intros Hc₁ Hc₂,
    rw [Hc₂, Hc₁, Hp],
    unfold elgamal_dec
      elgamal_reenc elgamal_enc,
    simp, sorry
  end

theorem ciphertext_mult_homomorphic
  (r₁ r₂ : F) (m₁ m₂ : G) (c₁ c₂ c₃ : G × G) :
  c₁ = elgamal_enc Gdot Gop g h r₁ m₁ ->
  c₂ = elgamal_enc Gdot Gop g h r₂ m₂ ->
  c₃ = ciphertext_mult Gdot c₁ c₂     ->
  elgamal_dec Gdot Ginv Gop x c₃ = Gdot m₁ m₂ :=
  begin
    intros Hc₁ Hc₂ Hc₃,
    rw [Hc₃, Hc₂, Hc₁, Hp],
    unfold elgamal_enc
      ciphertext_mult elgamal_dec,
    simp, /- feed to sat solver-/
    sorry
  end

end
end Elgamal