/-
Copyright (c) 2021 Rémy Degenne. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Rémy Degenne

! This file was ported from Lean 3 source module measure_theory.function.l2_space
! leanprover-community/mathlib commit 46b633fd842bef9469441c0209906f6dddd2b4f5
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.InnerProductSpace.Basic
import Mathbin.MeasureTheory.Integral.SetIntegral

/-! # `L^2` space

If `E` is an inner product space over `𝕜` (`ℝ` or `ℂ`), then `Lp E 2 μ` (defined in `lp_space.lean`)
is also an inner product space, with inner product defined as `inner f g = ∫ a, ⟪f a, g a⟫ ∂μ`.

### Main results

* `mem_L1_inner` : for `f` and `g` in `Lp E 2 μ`, the pointwise inner product `λ x, ⟪f x, g x⟫`
  belongs to `Lp 𝕜 1 μ`.
* `integrable_inner` : for `f` and `g` in `Lp E 2 μ`, the pointwise inner product `λ x, ⟪f x, g x⟫`
  is integrable.
* `L2.inner_product_space` : `Lp E 2 μ` is an inner product space.

-/

noncomputable section

open TopologicalSpace MeasureTheory MeasureTheory.lp

open NNReal ENNReal MeasureTheory

namespace MeasureTheory

section

variable {α F : Type _} {m : MeasurableSpace α} {μ : Measure α} [NormedAddCommGroup F]

theorem Memℒp.integrableSq {f : α → ℝ} (h : Memℒp f 2 μ) : Integrable (fun x => f x ^ 2) μ := by
  simpa [← mem_ℒp_one_iff_integrable] using h.norm_rpow two_ne_zero ENNReal.two_ne_top
#align measure_theory.mem_ℒp.integrable_sq MeasureTheory.Memℒp.integrableSq

theorem memℒp_two_iff_integrable_sq_norm {f : α → F} (hf : AeStronglyMeasurable f μ) :
    Memℒp f 2 μ ↔ Integrable (fun x => ‖f x‖ ^ 2) μ :=
  by
  rw [← mem_ℒp_one_iff_integrable]
  convert(mem_ℒp_norm_rpow_iff hf two_ne_zero ENNReal.two_ne_top).symm
  · simp
  · rw [div_eq_mul_inv, ENNReal.mul_inv_cancel two_ne_zero ENNReal.two_ne_top]
#align measure_theory.mem_ℒp_two_iff_integrable_sq_norm MeasureTheory.memℒp_two_iff_integrable_sq_norm

theorem memℒp_two_iff_integrable_sq {f : α → ℝ} (hf : AeStronglyMeasurable f μ) :
    Memℒp f 2 μ ↔ Integrable (fun x => f x ^ 2) μ :=
  by
  convert mem_ℒp_two_iff_integrable_sq_norm hf
  ext x
  simp
#align measure_theory.mem_ℒp_two_iff_integrable_sq MeasureTheory.memℒp_two_iff_integrable_sq

end

namespace L2

variable {α E F 𝕜 : Type _} [IsROrC 𝕜] [MeasurableSpace α] {μ : Measure α} [NormedAddCommGroup E]
  [InnerProductSpace 𝕜 E] [NormedAddCommGroup F]

-- mathport name: «expr⟪ , ⟫»
local notation "⟪" x ", " y "⟫" => @inner 𝕜 _ _ x y

theorem snorm_rpow_two_norm_lt_top (f : lp F 2 μ) : snorm (fun x => ‖f x‖ ^ (2 : ℝ)) 1 μ < ∞ :=
  by
  have h_two : ENNReal.ofReal (2 : ℝ) = 2 := by simp [zero_le_one]
  rw [snorm_norm_rpow f zero_lt_two, one_mul, h_two]
  exact ENNReal.rpow_lt_top_of_nonneg zero_le_two (Lp.snorm_ne_top f)
#align measure_theory.L2.snorm_rpow_two_norm_lt_top MeasureTheory.L2.snorm_rpow_two_norm_lt_top

theorem snorm_inner_lt_top (f g : α →₂[μ] E) : snorm (fun x : α => ⟪f x, g x⟫) 1 μ < ∞ :=
  by
  have h : ∀ x, IsROrC.abs ⟪f x, g x⟫ ≤ ‖f x‖ * ‖g x‖ := fun x => abs_inner_le_norm _ _
  have h' : ∀ x, IsROrC.abs ⟪f x, g x⟫ ≤ IsROrC.abs (‖f x‖ ^ 2 + ‖g x‖ ^ 2) :=
    by
    refine' fun x => le_trans (h x) _
    rw [IsROrC.abs_to_real, abs_eq_self.mpr]
    swap
    · exact add_nonneg (by simp) (by simp)
    refine' le_trans _ (half_le_self (add_nonneg (sq_nonneg _) (sq_nonneg _)))
    refine' (le_div_iff (zero_lt_two' ℝ)).mpr ((le_of_eq _).trans (two_mul_le_add_sq _ _))
    ring
  simp_rw [← IsROrC.norm_eq_abs, ← Real.rpow_nat_cast] at h'
  refine' (snorm_mono_ae (ae_of_all _ h')).trans_lt ((snorm_add_le _ _ le_rfl).trans_lt _)
  · exact ((Lp.ae_strongly_measurable f).norm.AeMeasurable.pow_const _).AeStronglyMeasurable
  · exact ((Lp.ae_strongly_measurable g).norm.AeMeasurable.pow_const _).AeStronglyMeasurable
  simp only [Nat.cast_bit0, ENNReal.add_lt_top, Nat.cast_one]
  exact ⟨snorm_rpow_two_norm_lt_top f, snorm_rpow_two_norm_lt_top g⟩
#align measure_theory.L2.snorm_inner_lt_top MeasureTheory.L2.snorm_inner_lt_top

section InnerProductSpace

open ComplexConjugate

include 𝕜

instance : HasInner 𝕜 (α →₂[μ] E) :=
  ⟨fun f g => ∫ a, ⟪f a, g a⟫ ∂μ⟩

theorem inner_def (f g : α →₂[μ] E) : ⟪f, g⟫ = ∫ a : α, ⟪f a, g a⟫ ∂μ :=
  rfl
#align measure_theory.L2.inner_def MeasureTheory.L2.inner_def

theorem integral_inner_eq_sq_snorm (f : α →₂[μ] E) :
    (∫ a, ⟪f a, f a⟫ ∂μ) = ENNReal.toReal (∫⁻ a, (‖f a‖₊ : ℝ≥0∞) ^ (2 : ℝ) ∂μ) :=
  by
  simp_rw [inner_self_eq_norm_sq_to_K]
  norm_cast
  rw [integral_eq_lintegral_of_nonneg_ae]
  rotate_left
  · exact Filter.eventually_of_forall fun x => sq_nonneg _
  · exact ((Lp.ae_strongly_measurable f).norm.AeMeasurable.pow_const _).AeStronglyMeasurable
  congr
  ext1 x
  have h_two : (2 : ℝ) = ((2 : ℕ) : ℝ) := by simp
  rw [← Real.rpow_nat_cast _ 2, ← h_two, ←
    ENNReal.ofReal_rpow_of_nonneg (norm_nonneg _) zero_le_two, ofReal_norm_eq_coe_nnnorm]
  norm_cast
#align measure_theory.L2.integral_inner_eq_sq_snorm MeasureTheory.L2.integral_inner_eq_sq_snorm

private theorem norm_sq_eq_inner' (f : α →₂[μ] E) : ‖f‖ ^ 2 = IsROrC.re ⟪f, f⟫ :=
  by
  have h_two : (2 : ℝ≥0∞).toReal = 2 := by simp
  rw [inner_def, integral_inner_eq_sq_snorm, norm_def, ← ENNReal.toReal_pow, IsROrC.of_real_re,
    ENNReal.toReal_eq_toReal (ENNReal.pow_ne_top (Lp.snorm_ne_top f)) _]
  · rw [← ENNReal.rpow_nat_cast, snorm_eq_snorm' two_ne_zero ENNReal.two_ne_top, snorm', ←
      ENNReal.rpow_mul, one_div, h_two]
    simp
  · refine' (lintegral_rpow_nnnorm_lt_top_of_snorm'_lt_top zero_lt_two _).Ne
    rw [← h_two, ← snorm_eq_snorm' two_ne_zero ENNReal.two_ne_top]
    exact Lp.snorm_lt_top f
#align measure_theory.L2.norm_sq_eq_inner' measure_theory.L2.norm_sq_eq_inner'

theorem mem_L1_inner (f g : α →₂[μ] E) :
    AeEqFun.mk (fun x => ⟪f x, g x⟫)
        ((lp.aeStronglyMeasurable f).inner (lp.aeStronglyMeasurable g)) ∈
      lp 𝕜 1 μ :=
  by
  simp_rw [mem_Lp_iff_snorm_lt_top, snorm_ae_eq_fun]
  exact snorm_inner_lt_top f g
#align measure_theory.L2.mem_L1_inner MeasureTheory.L2.mem_L1_inner

theorem integrableInner (f g : α →₂[μ] E) : Integrable (fun x : α => ⟪f x, g x⟫) μ :=
  (integrable_congr
        (AeEqFun.coeFn_mk (fun x => ⟪f x, g x⟫)
          ((lp.aeStronglyMeasurable f).inner (lp.aeStronglyMeasurable g)))).mp
    (AeEqFun.integrable_iff_mem_L1.mpr (mem_L1_inner f g))
#align measure_theory.L2.integrable_inner MeasureTheory.L2.integrableInner

private theorem add_left' (f f' g : α →₂[μ] E) : ⟪f + f', g⟫ = inner f g + inner f' g :=
  by
  simp_rw [inner_def, ← integral_add (integrable_inner f g) (integrable_inner f' g), ←
    inner_add_left]
  refine' integral_congr_ae ((coe_fn_add f f').mono fun x hx => _)
  congr
  rwa [Pi.add_apply] at hx
#align measure_theory.L2.add_left' measure_theory.L2.add_left'

private theorem smul_left' (f g : α →₂[μ] E) (r : 𝕜) : ⟪r • f, g⟫ = conj r * inner f g :=
  by
  rw [inner_def, inner_def, ← smul_eq_mul, ← integral_smul]
  refine' integral_congr_ae ((coe_fn_smul r f).mono fun x hx => _)
  rw [smul_eq_mul, ← inner_smul_left]
  congr
  rwa [Pi.smul_apply] at hx
#align measure_theory.L2.smul_left' measure_theory.L2.smul_left'

instance innerProductSpace : InnerProductSpace 𝕜 (α →₂[μ] E)
    where
  norm_sq_eq_inner := norm_sq_eq_inner'
  conj_symm _ _ := by simp_rw [inner_def, ← integral_conj, inner_conj_symm]
  add_left := add_left'
  smul_left := smul_left'
#align measure_theory.L2.inner_product_space MeasureTheory.L2.innerProductSpace

end InnerProductSpace

section IndicatorConstLp

variable (𝕜) {s : Set α}

/-- The inner product in `L2` of the indicator of a set `indicator_const_Lp 2 hs hμs c` and `f` is
equal to the integral of the inner product over `s`: `∫ x in s, ⟪c, f x⟫ ∂μ`. -/
theorem inner_indicatorConstLp_eq_set_integral_inner (f : lp E 2 μ) (hs : MeasurableSet s) (c : E)
    (hμs : μ s ≠ ∞) : (⟪indicatorConstLp 2 hs hμs c, f⟫ : 𝕜) = ∫ x in s, ⟪c, f x⟫ ∂μ :=
  by
  rw [inner_def, ← integral_add_compl hs (L2.integrable_inner _ f)]
  have h_left : (∫ x in s, ⟪(indicator_const_Lp 2 hs hμs c) x, f x⟫ ∂μ) = ∫ x in s, ⟪c, f x⟫ ∂μ :=
    by
    suffices h_ae_eq : ∀ᵐ x ∂μ, x ∈ s → ⟪indicator_const_Lp 2 hs hμs c x, f x⟫ = ⟪c, f x⟫
    exact set_integral_congr_ae hs h_ae_eq
    have h_indicator : ∀ᵐ x : α ∂μ, x ∈ s → indicator_const_Lp 2 hs hμs c x = c :=
      indicator_const_Lp_coe_fn_mem
    refine' h_indicator.mono fun x hx hxs => _
    congr
    exact hx hxs
  have h_right : (∫ x in sᶜ, ⟪(indicator_const_Lp 2 hs hμs c) x, f x⟫ ∂μ) = 0 :=
    by
    suffices h_ae_eq : ∀ᵐ x ∂μ, x ∉ s → ⟪indicator_const_Lp 2 hs hμs c x, f x⟫ = 0
    · simp_rw [← Set.mem_compl_iff] at h_ae_eq
      suffices h_int_zero :
        (∫ x in sᶜ, inner (indicator_const_Lp 2 hs hμs c x) (f x) ∂μ) = ∫ x in sᶜ, (0 : 𝕜) ∂μ
      · rw [h_int_zero]
        simp
      exact set_integral_congr_ae hs.compl h_ae_eq
    have h_indicator : ∀ᵐ x : α ∂μ, x ∉ s → indicator_const_Lp 2 hs hμs c x = 0 :=
      indicator_const_Lp_coe_fn_nmem
    refine' h_indicator.mono fun x hx hxs => _
    rw [hx hxs]
    exact inner_zero_left _
  rw [h_left, h_right, add_zero]
#align measure_theory.L2.inner_indicator_const_Lp_eq_set_integral_inner MeasureTheory.L2.inner_indicatorConstLp_eq_set_integral_inner

/-- The inner product in `L2` of the indicator of a set `indicator_const_Lp 2 hs hμs c` and `f` is
equal to the inner product of the constant `c` and the integral of `f` over `s`. -/
theorem inner_indicatorConstLp_eq_inner_set_integral [CompleteSpace E] [NormedSpace ℝ E]
    (hs : MeasurableSet s) (hμs : μ s ≠ ∞) (c : E) (f : lp E 2 μ) :
    (⟪indicatorConstLp 2 hs hμs c, f⟫ : 𝕜) = ⟪c, ∫ x in s, f x ∂μ⟫ := by
  rw [← integral_inner (integrable_on_Lp_of_measure_ne_top f fact_one_le_two_ennreal.elim hμs),
    L2.inner_indicator_const_Lp_eq_set_integral_inner]
#align measure_theory.L2.inner_indicator_const_Lp_eq_inner_set_integral MeasureTheory.L2.inner_indicatorConstLp_eq_inner_set_integral

variable {𝕜}

/-- The inner product in `L2` of the indicator of a set `indicator_const_Lp 2 hs hμs (1 : 𝕜)` and
a real or complex function `f` is equal to the integral of `f` over `s`. -/
theorem inner_indicatorConstLp_one (hs : MeasurableSet s) (hμs : μ s ≠ ∞) (f : lp 𝕜 2 μ) :
    ⟪indicatorConstLp 2 hs hμs (1 : 𝕜), f⟫ = ∫ x in s, f x ∂μ :=
  by
  rw [L2.inner_indicator_const_Lp_eq_inner_set_integral 𝕜 hs hμs (1 : 𝕜) f]
  simp
#align measure_theory.L2.inner_indicator_const_Lp_one MeasureTheory.L2.inner_indicatorConstLp_one

end IndicatorConstLp

end L2

section InnerContinuous

variable {α : Type _} [TopologicalSpace α] [MeasureSpace α] [BorelSpace α] {𝕜 : Type _} [IsROrC 𝕜]

variable (μ : Measure α) [IsFiniteMeasure μ]

open BoundedContinuousFunction ComplexConjugate

-- mathport name: «expr⟪ , ⟫»
local notation "⟪" x ", " y "⟫" => @inner 𝕜 (α →₂[μ] 𝕜) _ x y

/-- For bounded continuous functions `f`, `g` on a finite-measure topological space `α`, the L^2
inner product is the integral of their pointwise inner product. -/
theorem BoundedContinuousFunction.inner_toLp (f g : α →ᵇ 𝕜) :
    ⟪BoundedContinuousFunction.toLp 2 μ 𝕜 f, BoundedContinuousFunction.toLp 2 μ 𝕜 g⟫ =
      ∫ x, conj (f x) * g x ∂μ :=
  by
  apply integral_congr_ae
  have hf_ae := f.coe_fn_to_Lp 2 μ 𝕜
  have hg_ae := g.coe_fn_to_Lp 2 μ 𝕜
  filter_upwards [hf_ae, hg_ae]with _ hf hg
  rw [hf, hg]
  simp
#align measure_theory.bounded_continuous_function.inner_to_Lp MeasureTheory.BoundedContinuousFunction.inner_toLp

variable [CompactSpace α]

/-- For continuous functions `f`, `g` on a compact, finite-measure topological space `α`, the L^2
inner product is the integral of their pointwise inner product. -/
theorem ContinuousMap.inner_toLp (f g : C(α, 𝕜)) :
    ⟪ContinuousMap.toLp 2 μ 𝕜 f, ContinuousMap.toLp 2 μ 𝕜 g⟫ = ∫ x, conj (f x) * g x ∂μ :=
  by
  apply integral_congr_ae
  have hf_ae := f.coe_fn_to_Lp μ
  have hg_ae := g.coe_fn_to_Lp μ
  filter_upwards [hf_ae, hg_ae]with _ hf hg
  rw [hf, hg]
  simp
#align measure_theory.continuous_map.inner_to_Lp MeasureTheory.ContinuousMap.inner_toLp

end InnerContinuous

end MeasureTheory


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

import algebra.algebra.tower
import algebra.invertible
import linear_algebra.basis
import ring_theory.adjoin.basic
import ring_theory.polynomial.tower

/-!
# Towers of algebras

We set up the basic theory of algebra towers.
An algebra tower A/S/R is expressed by having instances of `algebra A S`,
`algebra R S`, `algebra R A` and `is_scalar_tower R S A`, the later asserting the
compatibility condition `(r • s) • a = r • (s • a)`.

In `field_theory/tower.lean` we use this to prove the tower law for finite extensions,
that if `R` and `S` are both fields, then `[A:R] = [A:S] [S:A]`.

In this file we prepare the main lemma:
if `{bi | i ∈ I}` is an `R`-basis of `S` and `{cj | j ∈ J}` is a `S`-basis
of `A`, then `{bi cj | i ∈ I, j ∈ J}` is an `R`-basis of `A`. This statement does not require the
base rings to be a field, so we also generalize the lemma to rings in this file.
-/

universes u v w u₁

variables (R : Type u) (S : Type v) (A : Type w) (B : Type u₁)

namespace is_scalar_tower

section semiring
variables [comm_semiring R] [comm_semiring S] [semiring A] [semiring B]
variables [algebra R S] [algebra S A] [algebra S B] [algebra R A] [algebra R B]
variables [is_scalar_tower R S A] [is_scalar_tower R S B]

variables (R S A B)

/-- Suppose that `R -> S -> A` is a tower of algebras.
If an element `r : R` is invertible in `S`, then it is invertible in `A`. -/
def invertible.algebra_tower (r : R) [invertible (algebra_map R S r)] :
  invertible (algebra_map R A r) :=
invertible.copy (invertible.map (algebra_map S A : S →* A) (algebra_map R S r)) (algebra_map R A r)
  (by rw [ring_hom.coe_monoid_hom, is_scalar_tower.algebra_map_apply R S A])

/-- A natural number that is invertible when coerced to `R` is also invertible
when coerced to any `R`-algebra. -/
def invertible_algebra_coe_nat (n : ℕ) [inv : invertible (n : R)] :
  invertible (n : A) :=
by { haveI : invertible (algebra_map ℕ R n) := inv, exact invertible.algebra_tower ℕ R A n }

end semiring

section comm_semiring
variables [comm_semiring R] [comm_semiring A] [comm_semiring B]
variables [algebra R A] [algebra A B] [algebra R B] [is_scalar_tower R A B]

end comm_semiring

end is_scalar_tower

namespace algebra

theorem adjoin_algebra_map' {R : Type u} {S : Type v} {A : Type w}
  [comm_ring R] [comm_ring S] [comm_ring A] [algebra R S] [algebra S A] (s : set S) :
  adjoin R (algebra_map S (comap R S A) '' s) = subalgebra.map (adjoin R s) (to_comap R S A) :=
le_antisymm (adjoin_le $ set.image_subset_iff.2 $ λ y hy, ⟨y, subset_adjoin hy, rfl⟩)
  (subalgebra.map_le.2 $ adjoin_le $ λ y hy, subset_adjoin ⟨y, hy, rfl⟩)

theorem adjoin_algebra_map (R : Type u) (S : Type v) (A : Type w)
  [comm_ring R] [comm_ring S] [comm_ring A] [algebra R S] [algebra S A] [algebra R A]
  [is_scalar_tower R S A] (s : set S) :
  adjoin R (algebra_map S A '' s) =
    subalgebra.map (adjoin R s) (is_scalar_tower.to_alg_hom R S A) :=
le_antisymm (adjoin_le $ set.image_subset_iff.2 $ λ y hy, ⟨y, subset_adjoin hy, rfl⟩)
  (subalgebra.map_le.2 $ adjoin_le $ λ y hy, subset_adjoin ⟨y, hy, rfl⟩)

lemma adjoin_res (C D E : Type*) [comm_semiring C] [comm_semiring D] [comm_semiring E]
  [algebra C D] [algebra C E] [algebra D E] [is_scalar_tower C D E] (S : set E) :
(algebra.adjoin D S).res C = ((⊤ : subalgebra C D).map (is_scalar_tower.to_alg_hom C D E)).under
  (algebra.adjoin ((⊤ : subalgebra C D).map (is_scalar_tower.to_alg_hom C D E)) S) :=
begin
  suffices : set.range (algebra_map D E) =
    set.range (algebra_map ((⊤ : subalgebra C D).map (is_scalar_tower.to_alg_hom C D E)) E),
  { ext x, change x ∈ subsemiring.closure (_ ∪ S) ↔ x ∈ subsemiring.closure (_ ∪ S), rw this },
  ext x,
  split,
  { rintros ⟨y, hy⟩,
    exact ⟨⟨algebra_map D E y, ⟨y, ⟨algebra.mem_top, rfl⟩⟩⟩, hy⟩ },
  { rintros ⟨⟨y, ⟨z, ⟨h0, h1⟩⟩⟩, h2⟩,
    exact ⟨z, eq.trans h1 h2⟩ },
end

lemma adjoin_res_eq_adjoin_res (C D E F : Type*) [comm_semiring C] [comm_semiring D]
  [comm_semiring E] [comm_semiring F] [algebra C D] [algebra C E] [algebra C F] [algebra D F]
  [algebra E F] [is_scalar_tower C D F] [is_scalar_tower C E F] {S : set D} {T : set E}
  (hS : algebra.adjoin C S = ⊤) (hT : algebra.adjoin C T = ⊤) :
(algebra.adjoin E (algebra_map D F '' S)).res C =
  (algebra.adjoin D (algebra_map E F '' T)).res C :=
by { rw [adjoin_res, adjoin_res, ←hS, ←hT, ←algebra.adjoin_image, ←algebra.adjoin_image,
  ←alg_hom.coe_to_ring_hom, ←alg_hom.coe_to_ring_hom, is_scalar_tower.coe_to_alg_hom,
  is_scalar_tower.coe_to_alg_hom, ←algebra.adjoin_union, ←algebra.adjoin_union, set.union_comm] }

end algebra

section
open_locale classical
lemma algebra.fg_trans' {R S A : Type*} [comm_ring R] [comm_ring S] [comm_ring A]
  [algebra R S] [algebra S A] [algebra R A] [is_scalar_tower R S A]
  (hRS : (⊤ : subalgebra R S).fg) (hSA : (⊤ : subalgebra S A).fg) :
  (⊤ : subalgebra R A).fg :=
let ⟨s, hs⟩ := hRS, ⟨t, ht⟩ := hSA in ⟨s.image (algebra_map S A) ∪ t,
by rw [finset.coe_union, finset.coe_image, algebra.adjoin_union, algebra.adjoin_algebra_map, hs,
    algebra.map_top, is_scalar_tower.range_under_adjoin, ht, subalgebra.res_top]⟩
end

section ring

open finsupp
open_locale big_operators classical
universes v₁ w₁

variables {R S A}
variables [comm_ring R] [ring S] [add_comm_group A]
variables [algebra R S] [module S A] [module R A] [is_scalar_tower R S A]

theorem linear_independent_smul {ι : Type v₁} {b : ι → S} {ι' : Type w₁} {c : ι' → A}
  (hb : linear_independent R b) (hc : linear_independent S c) :
  linear_independent R (λ p : ι × ι', b p.1 • c p.2) :=
begin
  rw linear_independent_iff' at hb hc, rw linear_independent_iff'', rintros s g hg hsg ⟨i, k⟩,
  by_cases hik : (i, k) ∈ s,
  { have h1 : ∑ i in (s.image prod.fst).product (s.image prod.snd), g i • b i.1 • c i.2 = 0,
    { rw ← hsg, exact (finset.sum_subset finset.subset_product $ λ p _ hp,
        show g p • b p.1 • c p.2 = 0, by rw [hg p hp, zero_smul]).symm },
    rw [finset.sum_product, finset.sum_comm] at h1,
    simp_rw [← smul_assoc, ← finset.sum_smul] at h1,
    exact hb _ _ (hc _ _ h1 k (finset.mem_image_of_mem _ hik)) i (finset.mem_image_of_mem _ hik) },
  exact hg _ hik
end

theorem is_basis.smul {ι : Type v₁} {b : ι → S} {ι' : Type w₁} {c : ι' → A}
  (hb : is_basis R b) (hc : is_basis S c) : is_basis R (λ p : ι × ι', b p.1 • c p.2) :=
⟨linear_independent_smul hb.1 hc.1,
by rw [← set.range_smul_range, submodule.span_smul hb.2, ← submodule.restrict_scalars_top R S A,
    submodule.restrict_scalars_inj, hc.2]⟩

theorem is_basis.smul_repr
  {ι ι' : Type*} {b : ι → S} {c : ι' → A}
  (hb : is_basis R b) (hc : is_basis S c) (x : A) (ij : ι × ι') :
  (hb.smul hc).repr x ij = hb.repr (hc.repr x ij.2) ij.1 :=
begin
  apply (hb.smul hc).repr_apply_eq,
  { intros x y, ext, simp only [linear_map.map_add, add_apply, pi.add_apply] },
  { intros c x, ext,
    simp only [← is_scalar_tower.algebra_map_smul S c x, linear_map.map_smul, smul_eq_mul,
               ← algebra.smul_def, smul_apply, pi.smul_apply] },
  rintros ij,
  ext ij',
  rw single_apply,
  split_ifs with hij,
  { simp [hij] },
  rw [linear_map.map_smul, smul_apply, hc.repr_self_apply],
  split_ifs with hj,
  { simp [hj, show ¬ (ij.1 = ij'.1), from λ hi, hij (prod.ext hi hj)] },
  simp
end

theorem is_basis.smul_repr_mk
  {ι ι' : Type*} {b : ι → S} {c : ι' → A}
  (hb : is_basis R b) (hc : is_basis S c) (x : A) (i : ι) (j : ι') :
  (hb.smul hc).repr x (i, j) = hb.repr (hc.repr x j) i :=
by simp [is_basis.smul_repr]

end ring

section artin_tate

variables (C : Type*)
variables [comm_ring A] [comm_ring B] [comm_ring C]
variables [algebra A B] [algebra B C] [algebra A C] [is_scalar_tower A B C]

open finset submodule
open_locale classical

lemma exists_subalgebra_of_fg (hAC : (⊤ : subalgebra A C).fg) (hBC : (⊤ : submodule B C).fg) :
  ∃ B₀ : subalgebra A B, B₀.fg ∧ (⊤ : submodule B₀ C).fg :=
begin
  cases hAC with x hx,
  cases hBC with y hy, have := hy,
  simp_rw [eq_top_iff', mem_span_finset] at this, choose f hf,
  let s : finset B := (finset.product (x ∪ (y * y)) y).image (function.uncurry f),
  have hsx : ∀ (xi ∈ x) (yj ∈ y), f xi yj ∈ s := λ xi hxi yj hyj,
    show function.uncurry f (xi, yj) ∈ s,
    from mem_image_of_mem _ $ mem_product.2 ⟨mem_union_left _ hxi, hyj⟩,
  have hsy : ∀ (yi yj yk ∈ y), f (yi * yj) yk ∈ s := λ yi yj yk hyi hyj hyk,
    show function.uncurry f (yi * yj, yk) ∈ s,
    from mem_image_of_mem _ $ mem_product.2 ⟨mem_union_right _ $ finset.mul_mem_mul hyi hyj, hyk⟩,
  have hxy : ∀ xi ∈ x, xi ∈ span (algebra.adjoin A (↑s : set B))
               (↑(insert 1 y : finset C) : set C) :=
    λ xi hxi, hf xi ▸ sum_mem _ (λ yj hyj, smul_mem
      (span (algebra.adjoin A (↑s : set B)) (↑(insert 1 y : finset C) : set C))
      ⟨f xi yj, algebra.subset_adjoin $ hsx xi hxi yj hyj⟩
      (subset_span $ mem_insert_of_mem hyj)),
  have hyy : span (algebra.adjoin A (↑s : set B)) (↑(insert 1 y : finset C) : set C) *
      span (algebra.adjoin A (↑s : set B)) (↑(insert 1 y : finset C) : set C) ≤
    span (algebra.adjoin A (↑s : set B)) (↑(insert 1 y : finset C) : set C),
  { rw [span_mul_span, span_le, coe_insert], rintros _ ⟨yi, yj, rfl | hyi, rfl | hyj, rfl⟩,
    { rw mul_one, exact subset_span (set.mem_insert _ _) },
    { rw one_mul, exact subset_span (set.mem_insert_of_mem _ hyj) },
    { rw mul_one, exact subset_span (set.mem_insert_of_mem _ hyi) },
    { rw ← hf (yi * yj), exact set_like.mem_coe.2 (sum_mem _ $ λ yk hyk, smul_mem
        (span (algebra.adjoin A (↑s : set B)) (insert 1 ↑y : set C))
        ⟨f (yi * yj) yk, algebra.subset_adjoin $ hsy yi yj yk hyi hyj hyk⟩
        (subset_span $ set.mem_insert_of_mem _ hyk : yk ∈ _)) } },
  refine ⟨algebra.adjoin A (↑s : set B), subalgebra.fg_adjoin_finset _, insert 1 y, _⟩,
  refine restrict_scalars_injective A _ _ _,
  rw [restrict_scalars_top, eq_top_iff, ← algebra.top_to_submodule, ← hx,
    algebra.adjoin_eq_span, span_le],
  refine λ r hr, submonoid.closure_induction hr (λ c hc, hxy c hc)
    (subset_span $ mem_insert_self _ _) (λ p q hp hq, hyy $ submodule.mul_mem_mul hp hq)
end

/-- Artin--Tate lemma: if A ⊆ B ⊆ C is a chain of subrings of commutative rings, and
A is noetherian, and C is algebra-finite over A, and C is module-finite over B,
then B is algebra-finite over A.

References: Atiyah--Macdonald Proposition 7.8; Stacks 00IS; Altman--Kleiman 16.17. -/
theorem fg_of_fg_of_fg [is_noetherian_ring A]
  (hAC : (⊤ : subalgebra A C).fg) (hBC : (⊤ : submodule B C).fg)
  (hBCi : function.injective (algebra_map B C)) :
  (⊤ : subalgebra A B).fg :=
let ⟨B₀, hAB₀, hB₀C⟩ := exists_subalgebra_of_fg A B C hAC hBC in
algebra.fg_trans' (B₀.fg_top.2 hAB₀) $ subalgebra.fg_of_submodule_fg $
have is_noetherian_ring B₀, from is_noetherian_ring_of_fg hAB₀,
have is_noetherian B₀ C, by exactI is_noetherian_of_fg_of_noetherian' hB₀C,
by exactI fg_of_injective (is_scalar_tower.to_alg_hom B₀ B C).to_linear_map
  (linear_map.ker_eq_bot.2 hBCi)

end artin_tate

section alg_hom_tower

variables {A} {C D : Type*} [comm_semiring A] [comm_semiring C] [comm_semiring D]
  [algebra A C] [algebra A D]

variables (f : C →ₐ[A] D) (B) [comm_semiring B] [algebra A B] [algebra B C] [is_scalar_tower A B C]

/-- Restrict the domain of an `alg_hom`. -/
def alg_hom.restrict_domain : B →ₐ[A] D := f.comp (is_scalar_tower.to_alg_hom A B C)

/-- Extend the scalars of an `alg_hom`. -/
def alg_hom.extend_scalars : @alg_hom B C D _ _ _ _ (f.restrict_domain B).to_ring_hom.to_algebra :=
{ commutes' := λ _, rfl .. f }

variables {B}

/-- `alg_hom`s from the top of a tower are equivalent to a pair of `alg_hom`s. -/
def alg_hom_equiv_sigma :
  (C →ₐ[A] D) ≃ Σ (f : B →ₐ[A] D), @alg_hom B C D _ _ _ _ f.to_ring_hom.to_algebra :=
{ to_fun := λ f, ⟨f.restrict_domain B, f.extend_scalars B⟩,
  inv_fun := λ fg,
    let alg := fg.1.to_ring_hom.to_algebra in by exactI fg.2.restrict_scalars A,
  left_inv := λ f, by { dsimp only, ext, refl },
  right_inv :=
  begin
    rintros ⟨⟨f, _, _, _, _, _⟩, g, _, _, _, _, hg⟩,
    have : f = λ x, g (algebra_map B C x) := by { ext, exact (hg x).symm },
    subst this,
    refl,
  end }

end alg_hom_tower


/-
Copyright (c) 2020 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import ring_theory.prime
import ring_theory.polynomial.content
/-!
# Eisenstein's criterion

A proof of a slight generalisation of Eisenstein's criterion for the irreducibility of
a polynomial over an integral domain.
-/

open polynomial ideal.quotient
variables {R : Type*} [comm_ring R]

namespace polynomial
namespace eisenstein_criterion_aux
/- Section for auxiliary lemmas used in the proof of `irreducible_of_eisenstein_criterion`-/

lemma map_eq_C_mul_X_pow_of_forall_coeff_mem {f : polynomial R} {P : ideal R}
  (hfP : ∀ (n : ℕ), ↑n < f.degree → f.coeff n ∈ P) (hf0 : f ≠ 0) :
  map (mk P) f = C ((mk P) f.leading_coeff) * X ^ f.nat_degree :=
polynomial.ext (λ n, begin
  rcases lt_trichotomy ↑n (degree f) with h | h | h,
  { erw [coeff_map, eq_zero_iff_mem.2 (hfP n h), coeff_C_mul, coeff_X_pow, if_neg, mul_zero],
    rintro rfl, exact not_lt_of_ge degree_le_nat_degree h },
  { have : nat_degree f = n, from nat_degree_eq_of_degree_eq_some h.symm,
    rw [coeff_C_mul, coeff_X_pow, if_pos this.symm, mul_one, leading_coeff, this, coeff_map] },
  { rw [coeff_eq_zero_of_degree_lt, coeff_eq_zero_of_degree_lt],
    { refine lt_of_le_of_lt (degree_C_mul_X_pow_le _ _) _,
      rwa ← degree_eq_nat_degree hf0 },
    { exact lt_of_le_of_lt (degree_map_le _ _) h } }
end)

lemma le_nat_degree_of_map_eq_mul_X_pow {n : ℕ}
  {P : ideal R} (hP : P.is_prime) {q : polynomial R} {c : polynomial (R ⧸ P)}
  (hq : map (mk P) q = c * X ^ n) (hc0 : c.degree = 0) : n ≤ q.nat_degree :=
with_bot.coe_le_coe.1
  (calc ↑n = degree (q.map (mk P)) :
      by rw [hq, degree_mul, hc0, zero_add, degree_pow, degree_X, nsmul_one, nat.cast_with_bot]
      ... ≤ degree q : degree_map_le _ _
      ... ≤ nat_degree q : degree_le_nat_degree)

lemma eval_zero_mem_ideal_of_eq_mul_X_pow {n : ℕ} {P : ideal R}
  {q : polynomial R} {c : polynomial (R ⧸ P)}
  (hq : map (mk P) q = c * X ^ n) (hn0 : 0 < n) : eval 0 q ∈ P :=
by rw [← coeff_zero_eq_eval_zero, ← eq_zero_iff_mem, ← coeff_map,
    coeff_zero_eq_eval_zero, hq, eval_mul, eval_pow, eval_X, zero_pow hn0, mul_zero]

lemma is_unit_of_nat_degree_eq_zero_of_forall_dvd_is_unit {p q : polynomial R}
  (hu : ∀ (x : R), C x ∣ p * q → is_unit x) (hpm : p.nat_degree = 0) :
  is_unit p :=
begin
  rw [eq_C_of_degree_le_zero (nat_degree_eq_zero_iff_degree_le_zero.1 hpm), is_unit_C],
  refine hu _ _,
  rw [← eq_C_of_degree_le_zero (nat_degree_eq_zero_iff_degree_le_zero.1 hpm)],
  exact dvd_mul_right _ _
end

end eisenstein_criterion_aux

open eisenstein_criterion_aux

variables [is_domain R]

/-- If `f` is a non constant polynomial with coefficients in `R`, and `P` is a prime ideal in `R`,
then if every coefficient in `R` except the leading coefficient is in `P`, and
the trailing coefficient is not in `P^2` and no non units in `R` divide `f`, then `f` is
irreducible. -/
theorem irreducible_of_eisenstein_criterion {f : polynomial R} {P : ideal R} (hP : P.is_prime)
  (hfl : f.leading_coeff ∉ P)
  (hfP : ∀ n : ℕ, ↑n < degree f → f.coeff n ∈ P)
  (hfd0 : 0 < degree f) (h0 : f.coeff 0 ∉ P^2)
  (hu : f.is_primitive) : irreducible f :=
have hf0 : f ≠ 0, from λ _, by simp only [*, not_true, submodule.zero_mem, coeff_zero] at *,
have hf : f.map (mk P) = C (mk P (leading_coeff f)) * X ^ nat_degree f,
  from map_eq_C_mul_X_pow_of_forall_coeff_mem hfP hf0,
have hfd0 : 0 < f.nat_degree, from with_bot.coe_lt_coe.1
  (lt_of_lt_of_le hfd0 degree_le_nat_degree),
⟨mt degree_eq_zero_of_is_unit (λ h, by simp only [*, lt_irrefl] at *),
begin
  rintros p q rfl,
  rw [map_mul] at hf,
  rcases mul_eq_mul_prime_pow (show prime (X : polynomial (R ⧸ P)),
    from monic_X.prime_of_degree_eq_one degree_X) hf with
      ⟨m, n, b, c, hmnd, hbc, hp, hq⟩,
  have hmn : 0 < m → 0 < n → false,
  { assume hm0 hn0,
    refine h0 _,
    rw [coeff_zero_eq_eval_zero, eval_mul, sq],
    exact ideal.mul_mem_mul
      (eval_zero_mem_ideal_of_eq_mul_X_pow hp hm0)
      (eval_zero_mem_ideal_of_eq_mul_X_pow hq hn0) },
  have hpql0 : (mk P) (p * q).leading_coeff ≠ 0,
  { rwa [ne.def, eq_zero_iff_mem] },
  have hp0 : p ≠ 0, from λ h, by simp only [*, zero_mul, eq_self_iff_true, not_true, ne.def] at *,
  have hq0 : q ≠ 0, from λ h, by simp only [*, eq_self_iff_true, not_true, ne.def, mul_zero] at *,
  have hbc0 : degree b = 0 ∧ degree c = 0,
  { apply_fun degree at hbc,
    rwa [degree_C hpql0, degree_mul, eq_comm, nat.with_bot.add_eq_zero_iff] at hbc },
  have hmp : m ≤ nat_degree p,
    from le_nat_degree_of_map_eq_mul_X_pow hP hp hbc0.1,
  have hnq : n ≤ nat_degree q,
    from le_nat_degree_of_map_eq_mul_X_pow hP hq hbc0.2,
  have hpmqn : p.nat_degree = m ∧ q.nat_degree = n,
  { rw [nat_degree_mul hp0 hq0] at hmnd,
    clear_except hmnd hmp hnq,
    contrapose hmnd,
    apply ne_of_lt,
    rw not_and_distrib at hmnd,
    cases hmnd,
    { exact add_lt_add_of_lt_of_le (lt_of_le_of_ne hmp (ne.symm hmnd)) hnq },
    { exact add_lt_add_of_le_of_lt hmp (lt_of_le_of_ne hnq (ne.symm hmnd)) } },
  obtain rfl | rfl : m = 0 ∨ n = 0,
  { rwa [pos_iff_ne_zero, pos_iff_ne_zero, imp_false, not_not,
      ← or_iff_not_imp_left] at hmn },
  { exact or.inl (is_unit_of_nat_degree_eq_zero_of_forall_dvd_is_unit hu hpmqn.1) },
  { exact or.inr (is_unit_of_nat_degree_eq_zero_of_forall_dvd_is_unit
      (by simpa only [mul_comm] using hu) hpmqn.2) }
end⟩

end polynomial


import .constructions .projection ftype.minmaxsum

noncomputable theory
namespace ftype

variables {U : ftype}

section intersection

/--independence in both M₁ and M₂ -/
def is_common_ind (M₁ M₂ : rankfun U) (X : set U) :=
  is_indep M₁ X ∧ is_indep M₂ X

lemma empty_is_common_ind (M₁ M₂ : rankfun U) :
  is_common_ind M₁ M₂ (∅ : set U) :=
  ⟨empty_indep M₁, empty_indep M₂⟩

lemma exists_common_ind {M₁ M₂ : rankfun U} :
  set.nonempty (is_common_ind M₁ M₂) :=
  ⟨∅, empty_is_common_ind M₁ M₂⟩

/-- size of max common independent set of M₁ M₂ -/
def ν (M₁ M₂ : rankfun U) : ℤ :=
  max_size_over (is_common_ind M₁ M₂) exists_common_ind

/-- A largest common independent set of M₁ M₂ -/
def max_common_ind (M₁ M₂ : rankfun U) : set U :=
  arg_max_size_over (is_common_ind M₁ M₂) exists_common_ind

lemma size_max_common_ind_eq_nu (M₁ M₂ : rankfun U) :
  size (max_common_ind M₁ M₂) = ν M₁ M₂ :=
  (arg_max_over_attains _ _ _).2

lemma max_common_ind_is_common_ind (M₁ M₂ : rankfun U) :
  is_common_ind M₁ M₂ (max_common_ind M₁ M₂) :=
  (arg_max_over_attains _ _ _).1

lemma size_common_ind_le_nu {M₁ M₂ : rankfun U} {X : set U} :
  is_common_ind M₁ M₂ X → size X ≤ ν M₁ M₂ :=
  λ h, (max_over_is_ub _ _ _ X h)

lemma exists_max_common_ind (M₁ M₂ : rankfun U) :
  ∃ I, is_common_ind M₁ M₂ I ∧ size I = ν M₁ M₂ ∧ ∀ J, is_common_ind M₁ M₂ J → size J ≤ size I :=
max_size_over_spec (is_common_ind M₁ M₂) exists_common_ind

lemma nu_nonneg (M₁ M₂ : rankfun U) :
  0 ≤ ν M₁ M₂ :=
  by {rw ←(size_empty U), from size_common_ind_le_nu (empty_is_common_ind _ _)}

/-- The function that provides an upper bound on ν for each X -/
def matroid_intersection_ub_fn (M₁ M₂ : rankfun U) : set U → ℤ :=
  (λ X, M₁.r X + M₂.r Xᶜ)

theorem matroid_intersection_pair_le {M₁ M₂ : rankfun U} {I : set U} (A : set U) :
  is_common_ind M₁ M₂ I → size I ≤ M₁.r A + M₂.r Aᶜ :=
begin
  rintros ⟨h₁,h₂⟩,
  rw ←(compl_inter_size A I),
  have h₁i := indep_of_subset_indep (inter_subset_right A I) h₁,
  have h₂i := indep_of_subset_indep (inter_subset_right Aᶜ I) h₂,
  rw [←indep_iff_r.mp h₁i, ←indep_iff_r.mp h₂i],
  linarith [R2 M₁ (inter_subset_left A I), R2 M₂ (inter_subset_left Aᶜ I)],
end

lemma matroid_intersection_ub (M₁ M₂ : rankfun U) :
  ν M₁ M₂ ≤ min_val (λ X, M₁.r X + M₂.r Xᶜ) :=
begin
  set ub_fn := λ X, M₁.r X + M₂.r Xᶜ with h_ub_fn,
  set A := arg_min ub_fn with hA ,
  set I := max_common_ind M₁ M₂ with hI,
  rw [←size_max_common_ind_eq_nu, ←arg_min_attains ub_fn, ←hA],
  from matroid_intersection_pair_le A (max_common_ind_is_common_ind M₁ M₂)
end

/-- Edmonds' matroid intersection theorem: the size of a largest common independent set
    is equal to the minimum value of a natural upper bound on the size of any such set.
    Implies many other minmax theorems in combinatorics.                             -/
theorem matroid_intersection (M₁ M₂ : rankfun U) :
  ν M₁ M₂ = min_val (λ X, M₁.r X + M₂.r Xᶜ) :=
begin
set ub_fn := λ (N₁ N₂ : rankfun U) X, N₁.r X + N₂.r Xᶜ with h_ub_fn,
--induction boilerplate (and ≥ suffices)

set Q : ℤ → Prop :=
  λ s, ∀ (M₁ M₂ : rankfun U), size (loops M₁ ∪ loops M₂)ᶜ = s →
    min_val (ub_fn M₁ M₂) ≤ ν M₁ M₂,
suffices : ∀ n₀, 0 ≤ n₀ → Q n₀,
  from antisymm (matroid_intersection_ub M₁ M₂) (this _ (size_nonneg _) M₁ M₂ rfl) ,
refine nonneg_int_strong_induction _ (λ N₁ N₂ hloops, _) (λ n hn IH N₁ N₂ hsize, _),

-- base case
rw [size_zero_iff_empty, compl_empty_iff] at hloops,
have h' : (ub_fn N₁ N₂) (loops N₁) = 0 :=  by
{
  simp_rw h_ub_fn,
  linarith [R0 N₂ (loops N₁)ᶜ, rank_loops N₁, rank_loops N₂,
                            R2 N₂ (cover_compl_subset hloops)],
},
linarith [nu_nonneg N₁ N₂, min_is_lb (ub_fn N₁ N₂) (loops N₁)],

--inductive step
set k := ν N₁ N₂ with hk,
rw ←hsize at hn,
cases exists_mem_of_size_pos hn with e he,

have h_e_nl : (is_nonloop N₁ e) ∧ (is_nonloop N₂ e) := by split;
{
  rw [nonloop_iff_not_mem_loops, ←mem_compl_iff],
  refine mem_of_mem_of_subset he _,
  simp only [compl_union, inter_subset_left, inter_subset_right],
},

set N₁d := loopify N₁ e with hN₁d,
set N₂d := loopify N₂ e with hN₂d,
set N₁c := project N₁ e with hN₁c,
set N₂c := project N₂ e with hN₂c,

set Id := max_common_ind N₁d N₂d with hId,
set Ic := max_common_ind N₁c N₂c with hIc,
let hId' : is_common_ind N₁d N₂d Id := by apply max_common_ind_is_common_ind,
let hIc' : is_common_ind N₁c N₂c Ic := by apply max_common_ind_is_common_ind,

have heIc : e ∉ Ic := λ heIc, by
{
  have := projected_set_rank_zero N₁ e,
  rw [←hN₁c, mem_indep_r heIc hIc'.1] at this,
  from one_ne_zero this,
},

have h_nu_d : ν N₁d N₂d ≤ k := by
{
  rw [←size_max_common_ind_eq_nu, ←hId, hk],
  from size_common_ind_le_nu
        ⟨indep_of_loopify_indep hId'.1,
          indep_of_loopify_indep hId'.2⟩,
},

have h_nu_c : ν N₁c N₂c ≤ k-1 := by
{
  rw [←size_max_common_ind_eq_nu, ←hIc, hk],
  linarith
  [
    size_union_nonmem_singleton heIc,
    size_common_ind_le_nu
    ⟨
      indep_of_project_indep hIc'.1 (nonloop_iff_indep.mp h_e_nl.1),
      indep_of_project_indep hIc'.2 (nonloop_iff_indep.mp h_e_nl.2)
    ⟩
  ],
},

-- these next two claims let us apply IH to deletion/contraction
have h_more_loops_d : size (loops N₁d ∪ loops N₂d)ᶜ < n := by
{
  have h_add_e := union_subset_union
    (loopify_makes_loops N₁ e)
    (loopify_makes_loops N₂ e),
  rw ←union_distrib_union_left at h_add_e,
  have := size_monotone h_add_e,
  rw [size_union_singleton_compl he, ←hN₁d, ←hN₂d] at this,
  rw [compl_size] at ⊢ hsize, linarith,
},

have h_more_loops_c : size (loops N₁c ∪ loops N₂c)ᶜ < n := by
{
  have h_add_e := union_subset_union
    (project_makes_loops N₁ e)
    (project_makes_loops N₂ e),
  rw ←union_distrib_union_left at h_add_e,
  have := size_monotone h_add_e,
  rw [size_union_singleton_compl he, ←hN₁c, ←hN₂c] at this,
  rw [compl_size] at ⊢ hsize, linarith,
},

-- apply IH to deletion, get minimizer Ad
rcases IH _ (size_nonneg _) h_more_loops_d N₁d N₂d rfl with hd,
set Ad := arg_min (ub_fn N₁d N₂d) with hAd,
rw [←arg_min_attains (ub_fn N₁d N₂d), ←hAd] at hd,
have hAd_ub : N₁.r (Ad \ {e}) + N₂.r (Adᶜ \ {e}) ≤ k := le_trans hd h_nu_d,

--apply IH to contraction, get minimizer Ac
rcases IH _ (size_nonneg _) h_more_loops_c N₁c N₂c rfl with hc,
set Ac := arg_min (ub_fn N₁c N₂c) with hAc,
rw [←arg_min_attains (ub_fn N₁c N₂c), ←hAc] at hc,
have hAc_ub : N₁.r (Ac ∪ {e}) + N₂.r (Acᶜ ∪ {e}) ≤ k+1 := by
{
  suffices : (N₁.r (Ac ∪ {e}) - N₁.r e) + (N₂.r (Acᶜ ∪ {e}) - N₂.r e) ≤ k-1,
    by linarith [rank_nonloop h_e_nl.1, rank_nonloop h_e_nl.2],
  from le_trans hc h_nu_c,
},

by_contra h_contr, push_neg at h_contr,
replace h_contr : ∀ X, k + 1 ≤ ub_fn N₁ N₂ X :=
  λ X, by linarith [min_is_lb (ub_fn N₁ N₂) X],

have hi := h_contr (Ac ∩ Ad \ {e}),
have hu := h_contr (Ac ∪ Ad ∪ {e}),
simp_rw h_ub_fn at hi hu,
rw [compl_union, compl_union, ←diff_eq] at hu,
rw [compl_diff, compl_inter] at hi,
have sm1 := R3 N₁ (Ac ∪ {e}) (Ad \ {e}),
have sm2 := R3 N₂ (Acᶜ ∪ {e}) (Adᶜ \ {e}),
rw [union_union_diff, union_inter_diff] at sm1 sm2,
linarith only [sm1, sm2, hi, hu, hAd_ub, hAc_ub],
end

theorem matroid_intersection_exists_pair_eq (M₁ M₂ : rankfun U) :
  ∃ I A, is_common_ind M₁ M₂ I ∧ size I =  M₁.r A + M₂.r Aᶜ  :=
begin
  set I := max_common_ind M₁ M₂ with hI,
  let h_ind := max_common_ind_is_common_ind M₁ M₂,
  rw ←hI at h_ind,
  set A := arg_min (λ X, M₁.r X + M₂.r Xᶜ) with hX,
  refine ⟨I, ⟨A, ⟨h_ind,_⟩⟩⟩,
  rw [hI, size_max_common_ind_eq_nu, matroid_intersection M₁ M₂],
  from (arg_min_attains _).symm,
end

end intersection

section intersections_of_bases

/-- is the intersection of a basis of M₁ and a basis of M₂ -/
def is_inter_bases (M₁ M₂ : rankfun U) :=
  λ X, ∃ B₁ B₂, is_basis M₁ B₁ ∧ is_basis M₂ B₂ ∧ B₁ ∩ B₂ = X

/-- is contained in the intersection of a basis of M₁ and a basis of M₂-/
def subset_inter_bases (M₁ M₂ : rankfun U) :=
  λ X, ∃ Y, is_inter_bases M₁ M₂ Y ∧ X ⊆ Y

lemma subset_inter_bases_is_common_ind {M₁ M₂ : rankfun U} {I : set U} :
  subset_inter_bases M₁ M₂ I → is_common_ind M₁ M₂ I :=
begin
  rintros ⟨Y, ⟨B₁,B₂,hB₁,hB₂, hIB₁B₂⟩,hY'⟩,
  rw ←hIB₁B₂ at hY', split,
  refine indep_of_subset_indep (subset.trans hY' _) (basis_is_indep hB₁),
  apply inter_subset_left,
  refine indep_of_subset_indep (subset.trans hY' _) (basis_is_indep hB₂),
  apply inter_subset_right,
end

lemma common_ind_iff_subset_inter_bases {M₁ M₂ : rankfun U} {I : set U} :
  is_common_ind M₁ M₂ I ↔ subset_inter_bases M₁ M₂ I :=
begin
  refine ⟨λ h, _, subset_inter_bases_is_common_ind⟩,
  rcases extends_to_basis h.1 with ⟨B₁,hIB₁,hB₁⟩,
  rcases extends_to_basis h.2 with ⟨B₂,hIB₂,hB₂⟩,
  from ⟨B₁ ∩ B₂, ⟨B₁, B₂, hB₁, hB₂, rfl⟩, subset_inter hIB₁ hIB₂⟩,
end

lemma exists_inter_bases {M₁ M₂ : rankfun U} :
  set.nonempty (is_inter_bases M₁ M₂) :=
begin
  cases exists_basis M₁ with B₁ hB₁,
  cases exists_basis M₂ with B₂ hB₂,
  from ⟨B₁ ∩ B₂, ⟨B₁,B₂,hB₁,hB₂,rfl⟩⟩,
end

lemma max_common_indep_inter_bases (M₁ M₂ : rankfun U) :
  ν M₁ M₂ = max_val_over (is_inter_bases M₁ M₂) exists_inter_bases size :=
begin
  rcases exists_max_common_ind M₁ M₂
    with ⟨I, hI_ind, hIsize, hI'I⟩,
  rcases max_over_spec (is_inter_bases M₁ M₂) exists_inter_bases size
    with ⟨J,hJ_inter,hJsize, hYJ⟩,
  rw [←hIsize, ←hJsize],
  apply le_antisymm,
  rw common_ind_iff_subset_inter_bases at hI_ind,
  rcases hI_ind with ⟨Y,⟨h,h'⟩⟩,
  linarith [hYJ _ h, size_monotone h'],
  from hI'I J (common_ind_iff_subset_inter_bases.mpr ⟨J,⟨hJ_inter,subset_refl _⟩⟩),
end

end intersections_of_bases
section union

/-- is the union of an independent set of M₁ and an independent set of M₂-/
def is_union_two_indep (M₁ M₂ : rankfun U) : set U → Prop :=
  λ X, ∃ I₁ I₂, is_indep M₁ I₁ ∧ is_indep M₂ I₂ ∧ X = I₁ ∪ I₂

/-- has partition into an independent set of M₁ and an independent set of M₂-/
def is_two_partitionable (M₁ M₂ : rankfun U) : set U → Prop :=
  λ X, ∃ I₁ I₂, is_indep M₁ I₁ ∧ is_indep M₂ I₂ ∧ X = I₁ ∪ I₂ ∧ I₁ ∩ I₂ = ∅

/-- has partition into a basis of M₁ and a basis set of M₂-/
def is_two_basis_partitionable (M₁ M₂ : rankfun U) : set U → Prop :=
  λ X, ∃ B₁ B₂ , is_basis M₁ B₁ ∧ is_basis M₂ B₂ ∧ B₁ ∪ B₂ = X ∧ B₁ ∩ B₂ = ∅

/-- is the union of a basis of M₁ and a basis of M₂ -/
def is_union_two_bases (M₁ M₂ : rankfun U) : set U → Prop :=
  λ X, ∃ B₁ B₂, is_basis M₁ B₁ ∧ is_basis M₂ B₂ ∧ B₁ ∪ B₂ = X

/-- is the union of independent -/
--def is_partitionable (Mset : list (rankfun U)) : set U → Prop :=
  --λ X, ∃ f: Mset → set U, ∀ M : Mset, is_indep M.val (f M) ∧ set.sUnion (set.range f) = X

lemma two_partitionable_iff_union_two_indep {M₁ M₂ : rankfun U} :
  is_two_partitionable M₁ M₂ = is_union_two_indep M₁ M₂ :=
begin
  ext X, rw [is_two_partitionable, is_union_two_indep],
  refine ⟨λ ⟨I₁,I₂, h₁, h₂, hu, hi⟩, ⟨I₁, I₂, h₁, h₂, hu⟩, λ h, _⟩,
  rcases h with ⟨I₁,I₂, h₁, h₂, hu⟩,
  from ⟨I₁, I₂ \ I₁, h₁, indep_of_subset_indep (diff_subset I₂ I₁) h₂ , by simp [hu], by simp⟩,
end

/-- is a subset of the union of a basis of X and a basis of Y-/
def is_subset_union_two_bases (M₁ M₂ : rankfun U) :=
  λ X, ∃ Y, is_union_two_bases M₁ M₂ Y ∧ X ⊆ Y

lemma two_partitionable_iff_subset_union_two_bases {M₁ M₂ : rankfun U} :
  is_two_partitionable M₁ M₂ = is_subset_union_two_bases M₁ M₂ :=
begin
  rw [two_partitionable_iff_union_two_indep], ext X,
  refine ⟨λ h,_,λ h,_⟩,

  rcases h with ⟨I₁, I₂, hI₁, hI₂, hIX⟩,
  cases extends_to_basis hI₁ with B₁ hB₁,
  cases extends_to_basis hI₂ with B₂ hB₂,
  refine ⟨B₁ ∪ B₂, ⟨B₁, B₂, hB₁.2, hB₂.2, rfl ⟩, _⟩,
  rw hIX, apply union_subset_union hB₁.1 hB₂.1,

  rcases h with ⟨Y, ⟨B₁, B₂, hB₁, hB₂, hBY⟩, hXY⟩,
  refine ⟨X ∩ B₁, X ∩ B₂, inter_indep_of_indep_right (basis_is_indep hB₁), inter_indep_of_indep_right (basis_is_indep hB₂), _ ⟩,
  rw [←inter_distrib_left, hBY, eq_comm, ←subset_iff_inter_eq_left],
  from hXY,
end

lemma union_two_bases_is_subset_union_two_bases (M₁ M₂ : rankfun U) :
  ∀ X, is_union_two_bases M₁ M₂ X → ∃ Y, is_union_two_bases M₁ M₂ Y ∧ X ⊆ Y :=
λ X hX, ⟨X, ⟨hX, subset_refl _⟩⟩

lemma exists_two_partitionable (M₁ M₂ : rankfun U) :
  ∃ X, is_two_partitionable M₁ M₂ X :=
⟨∅, ∅, ∅, empty_indep M₁, empty_indep M₂, by rw union_self, by rw inter_idem⟩

lemma exists_union_two_indep (M₁ M₂ : rankfun U) :
  ∃ X, is_union_two_indep M₁ M₂ X :=
⟨∅, ∅, ∅, empty_indep M₁, empty_indep M₂, by rw union_self⟩

lemma exists_union_two_bases (M₁ M₂ : rankfun U) :
  ∃ X, is_union_two_bases M₁ M₂ X :=
by {cases exists_basis M₁ with B₁ h₁, cases exists_basis M₂ with B₂ h₂, from ⟨_, B₁, B₂, h₁, h₂, rfl⟩}

lemma exists_subset_union_two_bases (M₁ M₂ : rankfun U) :
  ∃ X, is_subset_union_two_bases M₁ M₂ X :=
by {cases exists_union_two_bases M₁ M₂ with Y hY, from ⟨Y,Y,hY, subset_refl Y⟩,  }

/-- prop that there exists a set that is a basis of both M₁ and M₂-/
def exists_common_basis (M₁ M₂ : rankfun U) :=
  ∃ B, is_basis M₁ B ∧ is_basis M₂ B

lemma univ_partitionable_iff_dual_common_basis {M₁ M₂ : rankfun U} :
  is_two_basis_partitionable M₁ M₂ (univ : set U) ↔ exists_common_basis M₁ (dual M₂) :=
begin
  refine ⟨λ h, _, λ h,_⟩,
  rcases h with ⟨B₁, B₂, h₁, h₂, hu, hi⟩,
  refine ⟨B₁,h₁,_⟩,
  rw [←cobasis_iff, cobasis_iff_compl_basis, (compl_unique hu hi).symm],
  from h₂,
  rcases h with ⟨B, hB₁, hB₂⟩,
  rw [←cobasis_iff, cobasis_iff_compl_basis] at hB₂,
  refine ⟨B, Bᶜ, hB₁, hB₂, by simp⟩,
end

/-- size of largest set that partitions into independent sets of M₁, M₂ -/
def π (M₁ M₂ : rankfun U) : ℤ :=
  max_size_over (is_two_partitionable M₁ M₂) (exists_two_partitionable _ _)

lemma π_attained_by_bases (M₁ M₂ : rankfun U) :
  π M₁ M₂ = max_size_over (is_union_two_bases M₁ M₂) (exists_union_two_bases M₁ M₂) :=
begin
  --rcases max_size_over_spec (is_union_two_bases M₁ M₂) (exists_union_two_bases M₁ M₂)
  --  with ⟨X, hXu, hsX, hYX⟩,
  unfold π, simp_rw [two_partitionable_iff_subset_union_two_bases],
  refine le_antisymm _ _,
  rcases max_size_over_spec (is_union_two_bases M₁ M₂) (exists_union_two_bases M₁ M₂)
    with ⟨X, hXu, hsX, hYX⟩,
  rcases max_size_over_spec (is_subset_union_two_bases M₁ M₂) (exists_subset_union_two_bases M₁ M₂)
    with ⟨X', hX'u, hsX', hYX'⟩,

  erw [←hsX, ←hsX'],
  cases hX'u with Y hY,
  linarith [hYX Y hY.1, size_monotone hY.2],

  have hPQ := union_two_bases_is_subset_union_two_bases M₁ M₂,
  refine max_over_subset_le_max
    (is_union_two_bases M₁ M₂)
    (λ X, ∃ Y, is_union_two_bases M₁ M₂ Y ∧ X ⊆ Y)
    (exists_union_two_bases M₁ M₂)
    size
    (union_two_bases_is_subset_union_two_bases M₁ M₂),
end

----------------------------- Trying to make summation manipulations more versatile ----------------

def prop_pairs {α : Type u} (P₁ P₂ : α → Prop) := {x : α // P₁ x} × {x : α // P₂ x}

instance pp_fin {α : Type u} [fintype α] {P₁ P₂ : α → Prop} : fintype (prop_pairs P₁ P₂) :=
begin
  --letI empty_indep: fintype {x : α // P₁ x} := infer_instance,
  --letI indep_of_subset_indep: fintype {x : α // P₂ x} := infer_instance,
  unfold prop_pairs, apply_instance,
  --from @prod.fintype _ _ (fintype.subtype_of_fintype (is_basis M₁)) (fintype.subtype_of_fintype (is_basis M₂)),
end

def basis_pairs (M₁ M₂ : rankfun U) := {B : set U // is_basis M₁ B} × {B : set U // is_basis M₂ B}

def  bp_fin {M₁ M₂ : rankfun U} : fintype (basis_pairs M₁ M₂) :=
begin
  letI := U.fin,
  unfold basis_pairs, apply_instance,
  --haveI : fintype (set U) := infer_instance,
  --haveI empty_indep : fintype {B : set U // is_basis M₁ B} := by library_search,
  --haveI indep_of_subset_indep : fintype {B : set U // is_basis M₂ B} := infer_instance,
  --exact @prod.fintype _ _ (fintype.subtype_of_fintype (is_basis M₁)) (fintype.subtype_of_fintype (is_basis M₂)),

  --unfold basis_pairs,

  -- assumption,
end

----------------------------------------------------------------------------------------------------
/-
lemma ν_eq_π_minus_rank (M₁ M₂ : rankfun U) :
  ν M₁ (dual M₂) = π M₁ M₂ - M₂.r univ :=
begin
  set sub_r : ℤ → ℤ := λ n, n - M₂.r univ with h_sub_r,

  set cond2 := λ X, ∃ B₁ B₂, is_basis M₁ B₁ ∧ is_basis M₂ B₂ ∧ X = B₁ \ B₂ with hcond2,

  have h_mono : monotone sub_r := λ n n' hnn', by {simp only [sub_r], linarith,},
  --have := calc ν M₁ (dual M₂) = _ : by rw max_common_indep_inter_bases,
  rw max_common_indep_inter_bases,

  have h2: is_inter_bases M₁ (dual M₂) = cond2 := by
  {
      ext, refine ⟨λ h,_,λ h,_⟩,
      rcases h with ⟨B₁, B₂, hB₁, hB₂, hX⟩,
      refine ⟨B₁, B₂ᶜ, hB₁,_,by simp [hX]⟩,
      rw [←cobasis_iff_compl_basis], from hB₂,
      rcases h with ⟨B₁, B₂, hB₁, hB₂, hX⟩,
      refine ⟨B₁, B₂ᶜ,hB₁,_,by simp [hX]⟩,
      simp_rw [←cobasis_iff_compl_basis, ←is_cobasis, dual_dual, hB₂],
  },
  have h3 : max_val_over (is_inter_bases M₁ (dual M₂)) exists_inter_bases size
          = max_val_over cond2 (by {rw ←h2, apply exists_inter_bases}) size := by congr',

  rw h3,
  sorry

end
-/

--lemma max_two_partitionable_is_union_two_bases (M₁ M₂ : rankfun U) :
--  ∃ X : set U, size X = π M₁ M₂ ∧ is_union_two_indep M₁ M₂ X

/-
lemma pi_nu (M₁ M₂ : rankfun U) :
  π M₁ M₂ = ν M₁ (dual M₂) - M₂.r univ :=
begin
  sorry,
end
-/

/-
lemma intersection_max_inter_bases (M₁ M₂ : rankfun U) :
  ν M₁ M₂ =
    max_val_over
      (is_basis M₁)
      (exists_basis M₁)
      (
        λ B₁, max_val_over (is_basis M₂)
                           (exists_basis M₂)
                           (λ B₂, size (B₁ ∩ B₂))
      ) :=
begin
  set I := max_common_ind M₁ M₂ with hI,

  sorry,
end

-/

end union

end ftype


/-
Copyright (c) 2021 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser

! This file was ported from Lean 3 source module group_theory.subgroup.pointwise
! leanprover-community/mathlib commit c10e724be91096453ee3db13862b9fb9a992fef2
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.GroupTheory.Subgroup.MulOpposite
import Mathlib.GroupTheory.Submonoid.Pointwise
import Mathlib.GroupTheory.GroupAction.ConjAct

/-! # Pointwise instances on `Subgroup` and `AddSubgroup`s

This file provides the actions

* `Subgroup.pointwiseMulAction`
* `AddSubgroup.pointwiseMulAction`

which matches the action of `Set.mulActionSet`.

These actions are available in the `Pointwise` locale.

## Implementation notes

The pointwise section of this file is almost identical to `GroupTheory/Submonoid/Pointwise.lean`.
Where possible, try to keep them in sync.
-/

open Set

open Pointwise

variable {α G A S : Type _}

@[to_additive (attr := simp)]
theorem inv_coe_set [InvolutiveInv G] [SetLike S G] [InvMemClass S G] {H : S} : (H : Set G)⁻¹ = H :=
  Set.ext fun _ => inv_mem_iff
#align inv_coe_set inv_coe_set
#align neg_coe_set neg_coe_set

variable [Group G] [AddGroup A] {s : Set G}

namespace Subgroup

@[to_additive (attr := simp)]
theorem inv_subset_closure (S : Set G) : S⁻¹ ⊆ closure S := fun s hs => by
  rw [SetLike.mem_coe, ← Subgroup.inv_mem_iff]
  exact subset_closure (mem_inv.mp hs)
#align subgroup.inv_subset_closure Subgroup.inv_subset_closure
#align add_subgroup.neg_subset_closure AddSubgroup.neg_subset_closure

@[to_additive]
theorem closure_toSubmonoid (S : Set G) :
    (closure S).toSubmonoid = Submonoid.closure (S ∪ S⁻¹) := by
  refine le_antisymm (fun x hx => ?_) (Submonoid.closure_le.2 ?_)
  · refine'
      closure_induction hx
        (fun x hx => Submonoid.closure_mono (subset_union_left S S⁻¹) (Submonoid.subset_closure hx))
        (Submonoid.one_mem _) (fun x y hx hy => Submonoid.mul_mem _ hx hy) fun x hx => _
    rwa [← Submonoid.mem_closure_inv, Set.union_inv, inv_inv, Set.union_comm]
  · simp only [true_and_iff, coe_toSubmonoid, union_subset_iff, subset_closure, inv_subset_closure]
#align subgroup.closure_to_submonoid Subgroup.closure_toSubmonoid
#align add_subgroup.closure_to_add_submonoid AddSubgroup.closure_toAddSubmonoid

@[to_additive]
theorem closure_induction_left {p : G → Prop} {x : G} (h : x ∈ closure s) (H1 : p 1)
    (Hmul : ∀ x ∈ s, ∀ (y), p y → p (x * y)) (Hinv : ∀ x ∈ s, ∀ (y), p y → p (x⁻¹ * y)) : p x :=
  let key := (closure_toSubmonoid s).le
  Submonoid.closure_induction_left (key h) H1 fun x hx => hx.elim (Hmul x) fun hx y hy =>
    inv_inv x ▸ Hinv x⁻¹ hx y hy
#align subgroup.closure_induction_left Subgroup.closure_induction_left
#align add_subgroup.closure_induction_left AddSubgroup.closure_induction_left

@[to_additive]
theorem closure_induction_right {p : G → Prop} {x : G} (h : x ∈ closure s) (H1 : p 1)
    (Hmul : ∀ (x), ∀ y ∈ s, p x → p (x * y)) (Hinv : ∀ (x), ∀ y ∈ s, p x → p (x * y⁻¹)) : p x :=
  let key := (closure_toSubmonoid s).le
  Submonoid.closure_induction_right (key h) H1 fun x y hy => hy.elim (Hmul x y) fun hy hx =>
    inv_inv y ▸ Hinv x y⁻¹ hy hx
#align subgroup.closure_induction_right Subgroup.closure_induction_right
#align add_subgroup.closure_induction_right AddSubgroup.closure_induction_right

@[to_additive (attr := simp)]
theorem closure_inv (s : Set G) : closure s⁻¹ = closure s := by
  simp only [← toSubmonoid_eq, closure_toSubmonoid, inv_inv, union_comm]
#align subgroup.closure_inv Subgroup.closure_inv
#align add_subgroup.closure_neg AddSubgroup.closure_neg

/-- An induction principle for closure membership. If `p` holds for `1` and all elements of
`k` and their inverse, and is preserved under multiplication, then `p` holds for all elements of
the closure of `k`. -/
@[to_additive "An induction principle for additive closure membership. If `p` holds for `0` and all
elements of `k` and their negation, and is preserved under addition, then `p` holds for all
elements of the additive closure of `k`."]
theorem closure_induction'' {p : G → Prop} {x} (h : x ∈ closure s) (Hk : ∀ x ∈ s, p x)
    (Hk_inv : ∀ x ∈ s, p x⁻¹) (H1 : p 1) (Hmul : ∀ x y, p x → p y → p (x * y)) : p x :=
  closure_induction_left h H1 (fun x hx y hy => Hmul x y (Hk x hx) hy) fun x hx y =>
    Hmul x⁻¹ y <| Hk_inv x hx
#align subgroup.closure_induction'' Subgroup.closure_induction''
#align add_subgroup.closure_induction'' AddSubgroup.closure_induction''

/-- An induction principle for elements of `⨆ i, S i`.
If `C` holds for `1` and all elements of `S i` for all `i`, and is preserved under multiplication,
then it holds for all elements of the supremum of `S`. -/
@[to_additive (attr := elab_as_elim) " An induction principle for elements of `⨆ i, S i`.
If `C` holds for `0` and all elements of `S i` for all `i`, and is preserved under addition,
then it holds for all elements of the supremum of `S`. "]
theorem supᵢ_induction {ι : Sort _} (S : ι → Subgroup G) {C : G → Prop} {x : G} (hx : x ∈ ⨆ i, S i)
    (hp : ∀ (i), ∀ x ∈ S i, C x) (h1 : C 1) (hmul : ∀ x y, C x → C y → C (x * y)) : C x := by
  rw [supᵢ_eq_closure] at hx
  refine' closure_induction'' hx (fun x hx => _) (fun x hx => _) h1 hmul
  · obtain ⟨i, hi⟩ := Set.mem_unionᵢ.mp hx
    exact hp _ _ hi
  · obtain ⟨i, hi⟩ := Set.mem_unionᵢ.mp hx
    exact hp _ _ (inv_mem hi)
#align subgroup.supr_induction Subgroup.supᵢ_induction
#align add_subgroup.supr_induction AddSubgroup.supᵢ_induction

/-- A dependent version of `Subgroup.supᵢ_induction`. -/
@[to_additive (attr := elab_as_elim) "A dependent version of `AddSubgroup.supᵢ_induction`. "]
theorem supᵢ_induction' {ι : Sort _} (S : ι → Subgroup G) {C : ∀ x, (x ∈ ⨆ i, S i) → Prop}
    (hp : ∀ (i), ∀ x (hx : x ∈ S i), C x (mem_supᵢ_of_mem i hx)) (h1 : C 1 (one_mem _))
    (hmul : ∀ x y hx hy, C x hx → C y hy → C (x * y) (mul_mem ‹_› ‹_›)) {x : G}
    (hx : x ∈ ⨆ i, S i) : C x hx := by
  suffices : ∃ h, C x h; exact this.snd
  refine' supᵢ_induction S (C := fun x => ∃ h, C x h) hx (fun i x hx => _) _ fun x y => _
  · exact ⟨_, hp i _ hx⟩
  · exact ⟨_, h1⟩
  · rintro ⟨_, Cx⟩ ⟨_, Cy⟩
    refine' ⟨_, hmul _ _ _ _ Cx Cy⟩
#align subgroup.supr_induction' Subgroup.supᵢ_induction'
#align add_subgroup.supr_induction' AddSubgroup.supᵢ_induction'

@[to_additive]
theorem closure_mul_le (S T : Set G) : closure (S * T) ≤ closure S ⊔ closure T :=
  infₛ_le fun _x ⟨_s, _t, hs, ht, hx⟩ => hx ▸
    (closure S ⊔ closure T).mul_mem (SetLike.le_def.mp le_sup_left <| subset_closure hs)
      (SetLike.le_def.mp le_sup_right <| subset_closure ht)
#align subgroup.closure_mul_le Subgroup.closure_mul_le
#align add_subgroup.closure_add_le AddSubgroup.closure_add_le

@[to_additive]
theorem sup_eq_closure (H K : Subgroup G) : H ⊔ K = closure ((H : Set G) * (K : Set G)) :=
  le_antisymm
    (sup_le (fun h hh => subset_closure ⟨h, 1, hh, K.one_mem, mul_one h⟩) fun k hk =>
      subset_closure ⟨1, k, H.one_mem, hk, one_mul k⟩)
    ((closure_mul_le _ _).trans <| by rw [closure_eq, closure_eq])
#align subgroup.sup_eq_closure Subgroup.sup_eq_closure
#align add_subgroup.sup_eq_closure AddSubgroup.sup_eq_closure

@[to_additive]
theorem set_mul_normal_comm (s : Set G) (N : Subgroup G) [hN : N.Normal] :
    s * (N : Set G) = (N : Set G) * s := by
  ext x
  refine (exists_congr fun y => ?_).trans exists_swap
  simp only [exists_and_left, @and_left_comm _ (y ∈ s), ← eq_inv_mul_iff_mul_eq (b := y),
    ← eq_mul_inv_iff_mul_eq  (c := y), exists_eq_right, SetLike.mem_coe, hN.mem_comm_iff]

/-- The carrier of `H ⊔ N` is just `↑H * ↑N` (pointwise set product) when `N` is normal. -/
@[to_additive "The carrier of `H ⊔ N` is just `↑H + ↑N` (pointwise set addition)
when `N` is normal."]
theorem mul_normal (H N : Subgroup G) [hN : N.Normal] : (↑(H ⊔ N) : Set G) = H * N := by
  rw [sup_eq_closure]
  refine Set.Subset.antisymm (fun x hx => ?_) subset_closure
  refine closure_induction'' (p := fun x => x ∈ (H : Set G) * (N : Set G)) hx ?_ ?_ ?_ ?_
  · rintro _ ⟨x, y, hx, hy, rfl⟩
    exact mul_mem_mul hx hy
  · rintro _ ⟨x, y, hx, hy, rfl⟩
    simpa only [mul_inv_rev, mul_assoc, inv_inv, inv_mul_cancel_left]
      using mul_mem_mul (inv_mem hx) (hN.conj_mem _ (inv_mem hy) x)
  · exact ⟨1, 1, one_mem _, one_mem _, mul_one 1⟩
  · rintro _ _ ⟨x, y, hx, hy, rfl⟩ ⟨x', y', hx', hy', rfl⟩
    refine ⟨x * x', x'⁻¹ * y * x' * y', mul_mem hx hx', mul_mem ?_ hy', ?_⟩
    · simpa using hN.conj_mem _ hy x'⁻¹
    · simp only [mul_assoc, mul_inv_cancel_left]
#align subgroup.mul_normal Subgroup.mul_normal
#align add_subgroup.add_normal AddSubgroup.add_normal

/-- The carrier of `N ⊔ H` is just `↑N * ↑H` (pointwise set product) when `N` is normal. -/
@[to_additive "The carrier of `N ⊔ H` is just `↑N + ↑H` (pointwise set addition)
when `N` is normal."]
theorem normal_mul (N H : Subgroup G) [N.Normal] : (↑(N ⊔ H) : Set G) = N * H := by
  rw [← set_mul_normal_comm, sup_comm, mul_normal]
#align subgroup.normal_mul Subgroup.normal_mul
#align add_subgroup.normal_add AddSubgroup.normal_add

-- porting note: todo: use `∩` in the RHS
@[to_additive]
theorem mul_inf_assoc (A B C : Subgroup G) (h : A ≤ C) :
    (A : Set G) * ↑(B ⊓ C) = (A : Set G) * (B : Set G) ⊓ C := by
  ext
  simp only [coe_inf, Set.inf_eq_inter, Set.mem_mul, Set.mem_inter_iff]
  constructor
  · rintro ⟨y, z, hy, ⟨hzB, hzC⟩, rfl⟩
    refine' ⟨_, mul_mem (h hy) hzC⟩
    exact ⟨y, z, hy, hzB, rfl⟩
  rintro ⟨⟨y, z, hy, hz, rfl⟩, hyz⟩
  refine' ⟨y, z, hy, ⟨hz, _⟩, rfl⟩
  suffices y⁻¹ * (y * z) ∈ C by simpa
  exact mul_mem (inv_mem (h hy)) hyz
#align subgroup.mul_inf_assoc Subgroup.mul_inf_assoc
#align add_subgroup.add_inf_assoc AddSubgroup.add_inf_assoc

-- porting note: todo: use `∩` in the RHS
@[to_additive]
theorem inf_mul_assoc (A B C : Subgroup G) (h : C ≤ A) :
    ((A ⊓ B : Subgroup G) : Set G) * C = (A : Set G) ⊓ ↑B * ↑C := by
  ext
  simp only [coe_inf, Set.inf_eq_inter, Set.mem_mul, Set.mem_inter_iff]
  constructor
  · rintro ⟨y, z, ⟨hyA, hyB⟩, hz, rfl⟩
    refine' ⟨A.mul_mem hyA (h hz), _⟩
    exact ⟨y, z, hyB, hz, rfl⟩
  rintro ⟨hyz, y, z, hy, hz, rfl⟩
  refine' ⟨y, z, ⟨_, hy⟩, hz, rfl⟩
  suffices y * z * z⁻¹ ∈ A by simpa
  exact mul_mem hyz (inv_mem (h hz))
#align subgroup.inf_mul_assoc Subgroup.inf_mul_assoc
#align add_subgroup.inf_add_assoc AddSubgroup.inf_add_assoc

@[to_additive]
instance sup_normal (H K : Subgroup G) [hH : H.Normal] [hK : K.Normal] : (H ⊔ K).Normal where
  conj_mem n hmem g := by
    rw [← SetLike.mem_coe, normal_mul] at hmem ⊢
    rcases hmem with ⟨h, k, hh, hk, rfl⟩
    refine ⟨g * h * g⁻¹, g * k * g⁻¹, hH.conj_mem h hh g, hK.conj_mem k hk g, ?_⟩
    simp only [mul_assoc, inv_mul_cancel_left]
#align subgroup.sup_normal Subgroup.sup_normal

-- porting note: new lemma
@[to_additive]
theorem smul_opposite_image_mul_preimage' (g : G) (h : Gᵐᵒᵖ) (s : Set G) :
    (fun y => h • y) '' ((g * ·) ⁻¹' s) = (g * ·) ⁻¹' ((fun y => h • y) '' s) := by
  simp [preimage_preimage, mul_assoc]

-- porting note: deprecate?
@[to_additive]
theorem smul_opposite_image_mul_preimage {H : Subgroup G} (g : G) (h : opposite H) (s : Set G) :
    (fun y => h • y) '' ((g * ·) ⁻¹' s) = (g * ·) ⁻¹' ((fun y => h • y) '' s) :=
  smul_opposite_image_mul_preimage' g h s
#align subgroup.smul_opposite_image_mul_preimage Subgroup.smul_opposite_image_mul_preimage
#align add_subgroup.vadd_opposite_image_add_preimage AddSubgroup.vadd_opposite_image_add_preimage

/-! ### Pointwise action -/

section Monoid

variable [Monoid α] [MulDistribMulAction α G]

/-- The action on a subgroup corresponding to applying the action to every element.

This is available as an instance in the `Pointwise` locale. -/
protected def pointwiseMulAction : MulAction α (Subgroup G) where
  smul a S := S.map (MulDistribMulAction.toMonoidEnd _ _ a)
  one_smul S := by
    change S.map _ = S
    simpa only [map_one] using S.map_id
  mul_smul a₁ a₂ S :=
    (congr_arg (fun f : Monoid.End G => S.map f) (MonoidHom.map_mul _ _ _)).trans
      (S.map_map _ _).symm
#align subgroup.pointwise_mul_action Subgroup.pointwiseMulAction

scoped[Pointwise] attribute [instance] Subgroup.pointwiseMulAction

theorem pointwise_smul_def {a : α} (S : Subgroup G) :
    a • S = S.map (MulDistribMulAction.toMonoidEnd _ _ a) :=
  rfl
#align subgroup.pointwise_smul_def Subgroup.pointwise_smul_def

@[simp]
theorem coe_pointwise_smul (a : α) (S : Subgroup G) : ↑(a • S) = a • (S : Set G) :=
  rfl
#align subgroup.coe_pointwise_smul Subgroup.coe_pointwise_smul

@[simp]
theorem pointwise_smul_toSubmonoid (a : α) (S : Subgroup G) :
    (a • S).toSubmonoid = a • S.toSubmonoid :=
  rfl
#align subgroup.pointwise_smul_to_submonoid Subgroup.pointwise_smul_toSubmonoid

theorem smul_mem_pointwise_smul (m : G) (a : α) (S : Subgroup G) : m ∈ S → a • m ∈ a • S :=
  (Set.smul_mem_smul_set : _ → _ ∈ a • (S : Set G))
#align subgroup.smul_mem_pointwise_smul Subgroup.smul_mem_pointwise_smul

theorem mem_smul_pointwise_iff_exists (m : G) (a : α) (S : Subgroup G) :
    m ∈ a • S ↔ ∃ s : G, s ∈ S ∧ a • s = m :=
  (Set.mem_smul_set : m ∈ a • (S : Set G) ↔ _)
#align subgroup.mem_smul_pointwise_iff_exists Subgroup.mem_smul_pointwise_iff_exists

@[simp]
theorem smul_bot (a : α) : a • (⊥ : Subgroup G) = ⊥ :=
  map_bot _
#align subgroup.smul_bot Subgroup.smul_bot

theorem smul_sup (a : α) (S T : Subgroup G) : a • (S ⊔ T) = a • S ⊔ a • T :=
  map_sup _ _ _
#align subgroup.smul_sup Subgroup.smul_sup

theorem smul_closure (a : α) (s : Set G) : a • closure s = closure (a • s) :=
  MonoidHom.map_closure _ _
#align subgroup.smul_closure Subgroup.smul_closure

instance pointwise_isCentralScalar [MulDistribMulAction αᵐᵒᵖ G] [IsCentralScalar α G] :
    IsCentralScalar α (Subgroup G) :=
  ⟨fun _ S => (congr_arg fun f => S.map f) <| MonoidHom.ext <| op_smul_eq_smul _⟩
#align subgroup.pointwise_central_scalar Subgroup.pointwise_isCentralScalar

theorem conj_smul_le_of_le {P H : Subgroup G} (hP : P ≤ H) (h : H) :
    MulAut.conj (h : G) • P ≤ H := by
  rintro - ⟨g, hg, rfl⟩
  exact H.mul_mem (H.mul_mem h.2 (hP hg)) (H.inv_mem h.2)
#align subgroup.conj_smul_le_of_le Subgroup.conj_smul_le_of_le

theorem conj_smul_subgroupOf {P H : Subgroup G} (hP : P ≤ H) (h : H) :
    MulAut.conj h • P.subgroupOf H = (MulAut.conj (h : G) • P).subgroupOf H := by
  refine' le_antisymm _ _
  · rintro - ⟨g, hg, rfl⟩
    exact ⟨g, hg, rfl⟩
  · rintro p ⟨g, hg, hp⟩
    exact ⟨⟨g, hP hg⟩, hg, Subtype.ext hp⟩
#align subgroup.conj_smul_subgroup_of Subgroup.conj_smul_subgroupOf

end Monoid

section Group

variable [Group α] [MulDistribMulAction α G]

@[simp]
theorem smul_mem_pointwise_smul_iff {a : α} {S : Subgroup G} {x : G} : a • x ∈ a • S ↔ x ∈ S :=
  smul_mem_smul_set_iff
#align subgroup.smul_mem_pointwise_smul_iff Subgroup.smul_mem_pointwise_smul_iff

theorem mem_pointwise_smul_iff_inv_smul_mem {a : α} {S : Subgroup G} {x : G} :
    x ∈ a • S ↔ a⁻¹ • x ∈ S :=
  mem_smul_set_iff_inv_smul_mem
#align subgroup.mem_pointwise_smul_iff_inv_smul_mem Subgroup.mem_pointwise_smul_iff_inv_smul_mem

theorem mem_inv_pointwise_smul_iff {a : α} {S : Subgroup G} {x : G} : x ∈ a⁻¹ • S ↔ a • x ∈ S :=
  mem_inv_smul_set_iff
#align subgroup.mem_inv_pointwise_smul_iff Subgroup.mem_inv_pointwise_smul_iff

@[simp]
theorem pointwise_smul_le_pointwise_smul_iff {a : α} {S T : Subgroup G} : a • S ≤ a • T ↔ S ≤ T :=
  set_smul_subset_set_smul_iff
#align subgroup.pointwise_smul_le_pointwise_smul_iff Subgroup.pointwise_smul_le_pointwise_smul_iff

theorem pointwise_smul_subset_iff {a : α} {S T : Subgroup G} : a • S ≤ T ↔ S ≤ a⁻¹ • T :=
  set_smul_subset_iff
#align subgroup.pointwise_smul_subset_iff Subgroup.pointwise_smul_subset_iff

theorem subset_pointwise_smul_iff {a : α} {S T : Subgroup G} : S ≤ a • T ↔ a⁻¹ • S ≤ T :=
  subset_set_smul_iff
#align subgroup.subset_pointwise_smul_iff Subgroup.subset_pointwise_smul_iff

@[simp]
theorem smul_inf (a : α) (S T : Subgroup G) : a • (S ⊓ T) = a • S ⊓ a • T := by
  simp [SetLike.ext_iff, mem_pointwise_smul_iff_inv_smul_mem]
#align subgroup.smul_inf Subgroup.smul_inf

/-- Applying a `MulDistribMulAction` results in an isomorphic subgroup -/
@[simps!]
def equivSMul (a : α) (H : Subgroup G) : H ≃* (a • H : Subgroup G) :=
  (MulDistribMulAction.toMulEquiv G a).subgroupMap H
#align subgroup.equiv_smul Subgroup.equivSMul

theorem subgroup_mul_singleton {H : Subgroup G} {h : G} (hh : h ∈ H) : (H : Set G) * {h} = H :=
  suffices { x : G | x ∈ H } = ↑H by simpa [preimage, mul_mem_cancel_right (inv_mem hh)]
  rfl
#align subgroup.subgroup_mul_singleton Subgroup.subgroup_mul_singleton

theorem singleton_mul_subgroup {H : Subgroup G} {h : G} (hh : h ∈ H) : {h} * (H : Set G) = H :=
  suffices { x : G | x ∈ H } = ↑H by simpa [preimage, mul_mem_cancel_left (inv_mem hh)]
  rfl
#align subgroup.singleton_mul_subgroup Subgroup.singleton_mul_subgroup

theorem Normal.conjAct {G : Type _} [Group G] {H : Subgroup G} (hH : H.Normal) (g : ConjAct G) :
    g • H = H :=
  have : ∀ g : ConjAct G, g • H ≤ H :=
    fun _ => map_le_iff_le_comap.2 fun _ h => hH.conj_mem _ h _
  (this g).antisymm <| (smul_inv_smul g H).symm.trans_le (map_mono <| this _)
#align subgroup.normal.conj_act Subgroup.Normal.conjAct

@[simp]
theorem smul_normal (g : G) (H : Subgroup G) [h : Normal H] : MulAut.conj g • H = H :=
  h.conjAct g
#align subgroup.smul_normal Subgroup.smul_normal

end Group

section GroupWithZero

variable [GroupWithZero α] [MulDistribMulAction α G]

@[simp]
theorem smul_mem_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) (S : Subgroup G) (x : G) :
    a • x ∈ a • S ↔ x ∈ S :=
  smul_mem_smul_set_iff₀ ha (S : Set G) x
#align subgroup.smul_mem_pointwise_smul_iff₀ Subgroup.smul_mem_pointwise_smul_iff₀

theorem mem_pointwise_smul_iff_inv_smul_mem₀ {a : α} (ha : a ≠ 0) (S : Subgroup G) (x : G) :
    x ∈ a • S ↔ a⁻¹ • x ∈ S :=
  mem_smul_set_iff_inv_smul_mem₀ ha (S : Set G) x
#align subgroup.mem_pointwise_smul_iff_inv_smul_mem₀ Subgroup.mem_pointwise_smul_iff_inv_smul_mem₀

theorem mem_inv_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) (S : Subgroup G) (x : G) :
    x ∈ a⁻¹ • S ↔ a • x ∈ S :=
  mem_inv_smul_set_iff₀ ha (S : Set G) x
#align subgroup.mem_inv_pointwise_smul_iff₀ Subgroup.mem_inv_pointwise_smul_iff₀

@[simp]
theorem pointwise_smul_le_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) {S T : Subgroup G} :
    a • S ≤ a • T ↔ S ≤ T :=
  set_smul_subset_set_smul_iff₀ ha
#align subgroup.pointwise_smul_le_pointwise_smul_iff₀ Subgroup.pointwise_smul_le_pointwise_smul_iff₀

theorem pointwise_smul_le_iff₀ {a : α} (ha : a ≠ 0) {S T : Subgroup G} : a • S ≤ T ↔ S ≤ a⁻¹ • T :=
  set_smul_subset_iff₀ ha
#align subgroup.pointwise_smul_le_iff₀ Subgroup.pointwise_smul_le_iff₀

theorem le_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) {S T : Subgroup G} : S ≤ a • T ↔ a⁻¹ • S ≤ T :=
  subset_set_smul_iff₀ ha
#align subgroup.le_pointwise_smul_iff₀ Subgroup.le_pointwise_smul_iff₀

end GroupWithZero

end Subgroup

namespace AddSubgroup

section Monoid

variable [Monoid α] [DistribMulAction α A]

/-- The action on an additive subgroup corresponding to applying the action to every element.

This is available as an instance in the `Pointwise` locale. -/
protected def pointwiseMulAction : MulAction α (AddSubgroup A) where
  smul a S := S.map (DistribMulAction.toAddMonoidEnd _ _ a)
  one_smul S := by
    change S.map _ = S
    simpa only [map_one] using S.map_id
  mul_smul _ _ S :=
    (congr_arg (fun f : AddMonoid.End A => S.map f) (MonoidHom.map_mul _ _ _)).trans
      (S.map_map _ _).symm
#align add_subgroup.pointwise_mul_action AddSubgroup.pointwiseMulAction

scoped[Pointwise] attribute [instance] AddSubgroup.pointwiseMulAction

@[simp]
theorem coe_pointwise_smul (a : α) (S : AddSubgroup A) : ↑(a • S) = a • (S : Set A) :=
  rfl
#align add_subgroup.coe_pointwise_smul AddSubgroup.coe_pointwise_smul

@[simp]
theorem pointwise_smul_toAddSubmonoid (a : α) (S : AddSubgroup A) :
    (a • S).toAddSubmonoid = a • S.toAddSubmonoid :=
  rfl
#align add_subgroup.pointwise_smul_to_add_submonoid AddSubgroup.pointwise_smul_toAddSubmonoid

theorem smul_mem_pointwise_smul (m : A) (a : α) (S : AddSubgroup A) : m ∈ S → a • m ∈ a • S :=
  (Set.smul_mem_smul_set : _ → _ ∈ a • (S : Set A))
#align add_subgroup.smul_mem_pointwise_smul AddSubgroup.smul_mem_pointwise_smul

theorem mem_smul_pointwise_iff_exists (m : A) (a : α) (S : AddSubgroup A) :
    m ∈ a • S ↔ ∃ s : A, s ∈ S ∧ a • s = m :=
  (Set.mem_smul_set : m ∈ a • (S : Set A) ↔ _)
#align add_subgroup.mem_smul_pointwise_iff_exists AddSubgroup.mem_smul_pointwise_iff_exists

instance pointwise_isCentralScalar [DistribMulAction αᵐᵒᵖ A] [IsCentralScalar α A] :
    IsCentralScalar α (AddSubgroup A) :=
  ⟨fun _ S => (congr_arg fun f => S.map f) <| AddMonoidHom.ext <| op_smul_eq_smul _⟩
#align add_subgroup.pointwise_central_scalar AddSubgroup.pointwise_isCentralScalar

end Monoid

section Group

variable [Group α] [DistribMulAction α A]

open Pointwise

@[simp]
theorem smul_mem_pointwise_smul_iff {a : α} {S : AddSubgroup A} {x : A} : a • x ∈ a • S ↔ x ∈ S :=
  smul_mem_smul_set_iff
#align add_subgroup.smul_mem_pointwise_smul_iff AddSubgroup.smul_mem_pointwise_smul_iff

theorem mem_pointwise_smul_iff_inv_smul_mem {a : α} {S : AddSubgroup A} {x : A} :
    x ∈ a • S ↔ a⁻¹ • x ∈ S :=
  mem_smul_set_iff_inv_smul_mem
#align add_subgroup.mem_pointwise_smul_iff_inv_smul_mem AddSubgroup.mem_pointwise_smul_iff_inv_smul_mem

theorem mem_inv_pointwise_smul_iff {a : α} {S : AddSubgroup A} {x : A} : x ∈ a⁻¹ • S ↔ a • x ∈ S :=
  mem_inv_smul_set_iff
#align add_subgroup.mem_inv_pointwise_smul_iff AddSubgroup.mem_inv_pointwise_smul_iff

@[simp]
theorem pointwise_smul_le_pointwise_smul_iff {a : α} {S T : AddSubgroup A} :
    a • S ≤ a • T ↔ S ≤ T :=
  set_smul_subset_set_smul_iff
#align add_subgroup.pointwise_smul_le_pointwise_smul_iff AddSubgroup.pointwise_smul_le_pointwise_smul_iff

theorem le_pointwise_smul_iff {a : α} {S T : AddSubgroup A} : S ≤ a • T ↔ a⁻¹ • S ≤ T :=
  subset_set_smul_iff
#align add_subgroup.le_pointwise_smul_iff AddSubgroup.le_pointwise_smul_iff

end Group

section GroupWithZero

variable [GroupWithZero α] [DistribMulAction α A]

open Pointwise

@[simp]
theorem smul_mem_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) (S : AddSubgroup A) (x : A) :
    a • x ∈ a • S ↔ x ∈ S :=
  smul_mem_smul_set_iff₀ ha (S : Set A) x
#align add_subgroup.smul_mem_pointwise_smul_iff₀ AddSubgroup.smul_mem_pointwise_smul_iff₀

theorem mem_pointwise_smul_iff_inv_smul_mem₀ {a : α} (ha : a ≠ 0) (S : AddSubgroup A) (x : A) :
    x ∈ a • S ↔ a⁻¹ • x ∈ S :=
  mem_smul_set_iff_inv_smul_mem₀ ha (S : Set A) x
#align add_subgroup.mem_pointwise_smul_iff_inv_smul_mem₀ AddSubgroup.mem_pointwise_smul_iff_inv_smul_mem₀

theorem mem_inv_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) (S : AddSubgroup A) (x : A) :
    x ∈ a⁻¹ • S ↔ a • x ∈ S :=
  mem_inv_smul_set_iff₀ ha (S : Set A) x
#align add_subgroup.mem_inv_pointwise_smul_iff₀ AddSubgroup.mem_inv_pointwise_smul_iff₀

@[simp]
theorem pointwise_smul_le_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) {S T : AddSubgroup A} :
    a • S ≤ a • T ↔ S ≤ T :=
  set_smul_subset_set_smul_iff₀ ha
#align add_subgroup.pointwise_smul_le_pointwise_smul_iff₀ AddSubgroup.pointwise_smul_le_pointwise_smul_iff₀

theorem pointwise_smul_le_iff₀ {a : α} (ha : a ≠ 0) {S T : AddSubgroup A} :
    a • S ≤ T ↔ S ≤ a⁻¹ • T :=
  set_smul_subset_iff₀ ha
#align add_subgroup.pointwise_smul_le_iff₀ AddSubgroup.pointwise_smul_le_iff₀

theorem le_pointwise_smul_iff₀ {a : α} (ha : a ≠ 0) {S T : AddSubgroup A} :
    S ≤ a • T ↔ a⁻¹ • S ≤ T :=
  subset_set_smul_iff₀ ha
#align add_subgroup.le_pointwise_smul_iff₀ AddSubgroup.le_pointwise_smul_iff₀

end GroupWithZero

end AddSubgroup


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

import measure_theory.function.simple_func_dense_lp
import measure_theory.function.strongly_measurable

/-!
# Finitely strongly measurable functions in `Lp`

Functions in `Lp` for `0 < p < ∞` are finitely strongly measurable.

## Main statements

* `mem_ℒp.ae_fin_strongly_measurable`: if `mem_ℒp f p μ` with `0 < p < ∞`, then
  `ae_fin_strongly_measurable f μ`.
* `Lp.fin_strongly_measurable`: for `0 < p < ∞`, `Lp` functions are finitely strongly measurable.

## References

* Hytönen, Tuomas, Jan Van Neerven, Mark Veraar, and Lutz Weis. Analysis in Banach spaces.
Springer, 2016.
-/

open measure_theory filter topological_space function
open_locale ennreal topological_space measure_theory

namespace measure_theory

local infixr ` →ₛ `:25 := simple_func

variables {α G : Type*} {p : ℝ≥0∞} {m m0 : measurable_space α} {μ : measure α}
  [normed_group G]
  {f : α → G}

lemma mem_ℒp.fin_strongly_measurable_of_strongly_measurable
  (hf : mem_ℒp f p μ) (hf_meas : strongly_measurable f) (hp_ne_zero : p ≠ 0) (hp_ne_top : p ≠ ∞) :
  fin_strongly_measurable f μ :=
begin
  borelize G,
  haveI : separable_space (set.range f ∪ {0} : set G) :=
    hf_meas.separable_space_range_union_singleton,
  let fs := simple_func.approx_on f hf_meas.measurable (set.range f ∪ {0}) 0 (by simp),
  refine ⟨fs, _, _⟩,
  { have h_fs_Lp : ∀ n, mem_ℒp (fs n) p μ,
      from simple_func.mem_ℒp_approx_on_range hf_meas.measurable hf,
    exact λ n, (fs n).measure_support_lt_top_of_mem_ℒp (h_fs_Lp n) hp_ne_zero hp_ne_top },
  { assume x,
    apply simple_func.tendsto_approx_on,
    apply subset_closure,
    simp },
end

lemma mem_ℒp.ae_fin_strongly_measurable (hf : mem_ℒp f p μ) (hp_ne_zero : p ≠ 0)
  (hp_ne_top : p ≠ ∞) :
  ae_fin_strongly_measurable f μ :=
⟨hf.ae_strongly_measurable.mk f, ((mem_ℒp_congr_ae hf.ae_strongly_measurable.ae_eq_mk).mp hf)
  .fin_strongly_measurable_of_strongly_measurable
    hf.ae_strongly_measurable.strongly_measurable_mk hp_ne_zero hp_ne_top,
  hf.ae_strongly_measurable.ae_eq_mk⟩

lemma integrable.ae_fin_strongly_measurable (hf : integrable f μ) :
  ae_fin_strongly_measurable f μ :=
(mem_ℒp_one_iff_integrable.mpr hf).ae_fin_strongly_measurable one_ne_zero ennreal.coe_ne_top

lemma Lp.fin_strongly_measurable (f : Lp G p μ) (hp_ne_zero : p ≠ 0) (hp_ne_top : p ≠ ∞) :
  fin_strongly_measurable f μ :=
(Lp.mem_ℒp f).fin_strongly_measurable_of_strongly_measurable
  (Lp.strongly_measurable f) hp_ne_zero hp_ne_top

end measure_theory