/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import data.fintype.card
import group_theory.group_action.defs
import group_theory.group_action.group
import data.setoid.basic
import data.set.pointwise.smul
import group_theory.subgroup.basic

/-!
# Basic properties of group actions

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

This file primarily concerns itself with orbits, stabilizers, and other objects defined in terms of
actions. Despite this file being called `basic`, low-level helper lemmas for algebraic manipulation
of `•` belong elsewhere.

## Main definitions

* `mul_action.orbit`
* `mul_action.fixed_points`
* `mul_action.fixed_by`
* `mul_action.stabilizer`

-/

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

open_locale pointwise
open function

namespace mul_action

variables (α) [monoid α] [mul_action α β]

/-- The orbit of an element under an action. -/
@[to_additive "The orbit of an element under an action."]
def orbit (b : β) := set.range (λ x : α, x • b)

variable {α}

@[to_additive] lemma mem_orbit_iff {b₁ b₂ : β} : b₂ ∈ orbit α b₁ ↔ ∃ x : α, x • b₁ = b₂ :=
iff.rfl

@[simp, to_additive] lemma mem_orbit (b : β) (x : α) : x • b ∈ orbit α b :=
⟨x, rfl⟩

@[simp, to_additive] lemma mem_orbit_self (b : β) : b ∈ orbit α b :=
⟨1, by simp [mul_action.one_smul]⟩

@[to_additive] lemma orbit_nonempty (b : β) : set.nonempty (orbit α b) := set.range_nonempty _

@[to_additive] lemma maps_to_smul_orbit (a : α) (b : β) :
  set.maps_to ((•) a) (orbit α b) (orbit α b) :=
set.range_subset_iff.2 $ λ a', ⟨a * a', mul_smul _ _ _⟩

@[to_additive] lemma smul_orbit_subset (a : α) (b : β) : a • orbit α b ⊆ orbit α b :=
(maps_to_smul_orbit a b).image_subset

@[to_additive] lemma orbit_smul_subset (a : α) (b : β) : orbit α (a • b) ⊆ orbit α b :=
set.range_subset_iff.2 $ λ a', mul_smul a' a b ▸ mem_orbit _ _

@[to_additive] instance {b : β} : mul_action α (orbit α b) :=
{ smul := λ a, (maps_to_smul_orbit a b).restrict _ _ _,
  one_smul := λ a, subtype.ext (one_smul α a),
  mul_smul := λ a a' b', subtype.ext (mul_smul a a' b') }

@[simp, to_additive] lemma orbit.coe_smul {b : β} {a : α} {b' : orbit α b} :
  ↑(a • b') = a • (b' : β) :=
rfl

variables (α) (β)

/-- The set of elements fixed under the whole action. -/
@[to_additive "The set of elements fixed under the whole action."]
def fixed_points : set β := {b : β | ∀ x : α, x • b = b}

/-- `fixed_by g` is the subfield of elements fixed by `g`. -/
@[to_additive "`fixed_by g` is the subfield of elements fixed by `g`."]
def fixed_by (g : α) : set β :=
{ x | g • x = x }

@[to_additive] theorem fixed_eq_Inter_fixed_by : fixed_points α β = ⋂ g : α, fixed_by α β g :=
set.ext $ λ x, ⟨λ hx, set.mem_Inter.2 $ λ g, hx g, λ hx g, by exact (set.mem_Inter.1 hx g : _)⟩

variables {α} (β)

@[simp, to_additive] lemma mem_fixed_points {b : β} :
  b ∈ fixed_points α β ↔ ∀ x : α, x • b = b := iff.rfl

@[simp, to_additive] lemma mem_fixed_by {g : α} {b : β} :
  b ∈ fixed_by α β g ↔ g • b = b := iff.rfl

@[to_additive] lemma mem_fixed_points' {b : β} : b ∈ fixed_points α β ↔
  (∀ b', b' ∈ orbit α b → b' = b) :=
⟨λ h b h₁, let ⟨x, hx⟩ := mem_orbit_iff.1 h₁ in hx ▸ h x,
λ h b, h _ (mem_orbit _ _)⟩

variables (α) {β}

/-- The stabilizer of a point `b` as a submonoid of `α`. -/
@[to_additive "The stabilizer of a point `b` as an additive submonoid of `α`."]
def stabilizer.submonoid (b : β) : submonoid α :=
{ carrier := { a | a • b = b },
  one_mem' := one_smul _ b,
  mul_mem' := λ a a' (ha : a • b = b) (hb : a' • b = b),
    show (a * a') • b = b, by rw [←smul_smul, hb, ha] }

@[simp, to_additive] lemma mem_stabilizer_submonoid_iff {b : β} {a : α} :
  a ∈ stabilizer.submonoid α b ↔ a • b = b := iff.rfl

@[to_additive] lemma orbit_eq_univ [is_pretransitive α β] (x : β) :
  orbit α x = set.univ :=
(surjective_smul α x).range_eq

variables {α} {β}

@[to_additive] lemma mem_fixed_points_iff_card_orbit_eq_one {a : β}
  [fintype (orbit α a)] : a ∈ fixed_points α β ↔ fintype.card (orbit α a) = 1 :=
begin
  rw [fintype.card_eq_one_iff, mem_fixed_points],
  split,
  { exact λ h, ⟨⟨a, mem_orbit_self _⟩, λ ⟨b, ⟨x, hx⟩⟩, subtype.eq $ by simp [h x, hx.symm]⟩ },
  { assume h x,
    rcases h with ⟨⟨z, hz⟩, hz₁⟩,
    calc x • a = z : subtype.mk.inj (hz₁ ⟨x • a, mem_orbit _ _⟩)
      ... = a : (subtype.mk.inj (hz₁ ⟨a, mem_orbit_self _⟩)).symm }
end

end mul_action

namespace mul_action
variable (α)
variables [group α] [mul_action α β]

/-- The stabilizer of an element under an action, i.e. what sends the element to itself.
A subgroup. -/
@[to_additive "The stabilizer of an element under an action, i.e. what sends the element to itself.
An additive subgroup."]
def stabilizer (b : β) : subgroup α :=
{ inv_mem' := λ a (ha : a • b = b), show a⁻¹ • b = b, by rw [inv_smul_eq_iff, ha]
  ..stabilizer.submonoid α b }

variables {α} {β}

@[simp, to_additive] lemma mem_stabilizer_iff {b : β} {a : α} :
  a ∈ stabilizer α b ↔ a • b = b := iff.rfl

@[simp, to_additive] lemma smul_orbit (a : α) (b : β) :
  a • orbit α b = orbit α b :=
(smul_orbit_subset a b).antisymm $
  calc orbit α b = a • a⁻¹ • orbit α b : (smul_inv_smul _ _).symm
             ... ⊆ a • orbit α b       : set.image_subset _ (smul_orbit_subset _ _)

@[simp, to_additive] lemma orbit_smul (a : α) (b : β) : orbit α (a • b) = orbit α b :=
(orbit_smul_subset a b).antisymm $
  calc orbit α b = orbit α (a⁻¹ • a • b) : by rw inv_smul_smul
             ... ⊆ orbit α (a • b)       : orbit_smul_subset _ _

/-- The action of a group on an orbit is transitive. -/
@[to_additive "The action of an additive group on an orbit is transitive."]
instance (x : β) : is_pretransitive α (orbit α x) :=
⟨by { rintro ⟨_, a, rfl⟩ ⟨_, b, rfl⟩, use b * a⁻¹, ext1, simp [mul_smul] }⟩

@[to_additive] lemma orbit_eq_iff {a b : β} :
   orbit α a = orbit α b ↔ a ∈ orbit α b:=
⟨λ h, h ▸ mem_orbit_self _, λ ⟨c, hc⟩, hc ▸ orbit_smul _ _⟩

variables (α) {β}

@[to_additive] lemma mem_orbit_smul (g : α) (a : β) : a ∈ orbit α (g • a) :=
by simp only [orbit_smul, mem_orbit_self]

@[to_additive] lemma smul_mem_orbit_smul (g h : α) (a : β) : g • a ∈ orbit α (h • a) :=
by simp only [orbit_smul, mem_orbit]

variables (α) (β)
/-- The relation 'in the same orbit'. -/
@[to_additive "The relation 'in the same orbit'."]
def orbit_rel : setoid β :=
{ r := λ a b, a ∈ orbit α b,
  iseqv := ⟨mem_orbit_self, λ a b, by simp [orbit_eq_iff.symm, eq_comm],
    λ a b, by simp [orbit_eq_iff.symm, eq_comm] {contextual := tt}⟩ }

local attribute [instance] orbit_rel

variables {α} {β}

/-- When you take a set `U` in `β`, push it down to the quotient, and pull back, you get the union
of the orbit of `U` under `α`. -/
@[to_additive "When you take a set `U` in `β`, push it down to the quotient, and pull back, you get
the union of the orbit of `U` under `α`."] lemma quotient_preimage_image_eq_union_mul (U : set β) :
  quotient.mk ⁻¹' (quotient.mk '' U) = ⋃ a : α, ((•) a) '' U :=
begin
  set f : β → quotient (mul_action.orbit_rel α β) := quotient.mk,
  ext,
  split,
  { rintros ⟨y , hy, hxy⟩,
    obtain ⟨a, rfl⟩ := quotient.exact hxy,
    rw set.mem_Union,
    exact ⟨a⁻¹, a • x, hy, inv_smul_smul a x⟩ },
  { intros hx,
    rw set.mem_Union at hx,
    obtain ⟨a, u, hu₁, hu₂⟩ := hx,
    rw [set.mem_preimage, set.mem_image_iff_bex],
    refine ⟨a⁻¹ • x, _, by simp only [quotient.eq]; use a⁻¹⟩,
    rw ← hu₂,
    convert hu₁,
    simp only [inv_smul_smul], },
end

@[to_additive] lemma disjoint_image_image_iff {U V : set β} :
  disjoint (quotient.mk '' U) (quotient.mk '' V) ↔ ∀ x ∈ U, ∀ a : α, a • x ∉ V :=
begin
  set f : β → quotient (mul_action.orbit_rel α β) := quotient.mk,
  refine ⟨λ h x x_in_U a a_in_V,
    h.le_bot ⟨⟨x, x_in_U, quotient.sound ⟨a⁻¹, _⟩⟩, ⟨a • x, a_in_V, rfl⟩⟩, _⟩,
  { simp },
  { intro h,
    rw set.disjoint_left,
    rintro x ⟨y, hy₁, hy₂⟩ ⟨z, hz₁, hz₂⟩,
    obtain ⟨a, rfl⟩ := quotient.exact (hz₂.trans hy₂.symm),
    exact h y hy₁ a hz₁ }
end

@[to_additive]
lemma image_inter_image_iff (U V : set β) :
  (quotient.mk '' U) ∩ (quotient.mk '' V) = ∅ ↔ ∀ x ∈ U, ∀ a : α, a • x ∉ V :=
set.disjoint_iff_inter_eq_empty.symm.trans disjoint_image_image_iff

variables (α β)

/-- The quotient by `mul_action.orbit_rel`, given a name to enable dot notation. -/
@[reducible, to_additive "The quotient by `add_action.orbit_rel`, given a name to enable dot
notation."]
def orbit_rel.quotient : Type* := quotient $ orbit_rel α β

variables {α β}

/-- The orbit corresponding to an element of the quotient by `mul_action.orbit_rel` -/
@[to_additive "The orbit corresponding to an element of the quotient by `add_action.orbit_rel`"]
def orbit_rel.quotient.orbit (x : orbit_rel.quotient α β) : set β :=
quotient.lift_on' x (orbit α) $ λ _ _, mul_action.orbit_eq_iff.2

@[simp, to_additive]
lemma orbit_rel.quotient.orbit_mk (b : β) :
  orbit_rel.quotient.orbit (quotient.mk' b : orbit_rel.quotient α β) = orbit α b := rfl

@[to_additive]
lemma orbit_rel.quotient.mem_orbit {b : β} {x : orbit_rel.quotient α β} :
  b ∈ x.orbit ↔ quotient.mk' b = x :=
by { induction x using quotient.induction_on', rw quotient.eq', refl }

/-- Note that `hφ = quotient.out_eq'` is a useful choice here. -/
@[to_additive "Note that `hφ = quotient.out_eq'` is a useful choice here."]
lemma orbit_rel.quotient.orbit_eq_orbit_out (x : orbit_rel.quotient α β)
  {φ : orbit_rel.quotient α β → β} (hφ : right_inverse φ quotient.mk') :
  orbit_rel.quotient.orbit x = orbit α (φ x) :=
begin
  conv_lhs { rw ←hφ x },
  induction x using quotient.induction_on',
  refl,
end

variables (α) (β)

local notation `Ω` := orbit_rel.quotient α β

/-- Decomposition of a type `X` as a disjoint union of its orbits under a group action.

This version is expressed in terms of `mul_action.orbit_rel.quotient.orbit` instead of
`mul_action.orbit`, to avoid mentioning `quotient.out'`. -/
@[to_additive "Decomposition of a type `X` as a disjoint union of its orbits under an additive group
action.

This version is expressed in terms of `add_action.orbit_rel.quotient.orbit` instead of
`add_action.orbit`, to avoid mentioning `quotient.out'`. "]
def self_equiv_sigma_orbits' : β ≃ Σ ω : Ω, ω.orbit :=
calc  β
    ≃ Σ (ω : Ω), {b // quotient.mk' b = ω} : (equiv.sigma_fiber_equiv quotient.mk').symm
... ≃ Σ (ω : Ω), ω.orbit :
        equiv.sigma_congr_right $ λ ω, equiv.subtype_equiv_right $ λ x,
          orbit_rel.quotient.mem_orbit.symm

/-- Decomposition of a type `X` as a disjoint union of its orbits under a group action. -/
@[to_additive "Decomposition of a type `X` as a disjoint union of its orbits under an additive group
action."]
def self_equiv_sigma_orbits : β ≃ Σ (ω : Ω), orbit α ω.out' :=
(self_equiv_sigma_orbits' α β).trans $ equiv.sigma_congr_right $ λ i,
  equiv.set.of_eq $ orbit_rel.quotient.orbit_eq_orbit_out _ quotient.out_eq'

variables {α β}

/-- If the stabilizer of `x` is `S`, then the stabilizer of `g • x` is `gSg⁻¹`. -/
lemma stabilizer_smul_eq_stabilizer_map_conj (g : α) (x : β) :
  (stabilizer α (g • x) = (stabilizer α x).map (mul_aut.conj g).to_monoid_hom) :=
begin
  ext h,
  rw [mem_stabilizer_iff, ← smul_left_cancel_iff g⁻¹, smul_smul, smul_smul, smul_smul, mul_left_inv,
      one_smul, ← mem_stabilizer_iff, subgroup.mem_map_equiv, mul_aut.conj_symm_apply]
end

/-- A bijection between the stabilizers of two elements in the same orbit. -/
noncomputable def stabilizer_equiv_stabilizer_of_orbit_rel {x y : β} (h : (orbit_rel α β).rel x y) :
  stabilizer α x ≃* stabilizer α y :=
let g : α := classical.some h in
have hg : g • y = x := classical.some_spec h,
have this : stabilizer α x = (stabilizer α y).map (mul_aut.conj g).to_monoid_hom,
  by rw [← hg, stabilizer_smul_eq_stabilizer_map_conj],
(mul_equiv.subgroup_congr this).trans ((mul_aut.conj g).subgroup_map $ stabilizer α y).symm

end mul_action

namespace add_action

variables [add_group α] [add_action α β]

/-- If the stabilizer of `x` is `S`, then the stabilizer of `g +ᵥ x` is `g + S + (-g)`. -/
lemma stabilizer_vadd_eq_stabilizer_map_conj (g : α) (x : β) :
  (stabilizer α (g +ᵥ x) = (stabilizer α x).map (add_aut.conj g).to_add_monoid_hom) :=
begin
  ext h,
  rw [mem_stabilizer_iff, ← vadd_left_cancel_iff (-g) , vadd_vadd, vadd_vadd, vadd_vadd,
      add_left_neg, zero_vadd, ← mem_stabilizer_iff, add_subgroup.mem_map_equiv,
      add_aut.conj_symm_apply]
end

/-- A bijection between the stabilizers of two elements in the same orbit. -/
noncomputable def stabilizer_equiv_stabilizer_of_orbit_rel {x y : β}
  (h : (orbit_rel α β).rel x y) :
  stabilizer α x ≃+ stabilizer α y :=
let g : α := classical.some h in
have hg : g +ᵥ y = x := classical.some_spec h,
have this : stabilizer α x = (stabilizer α y).map (add_aut.conj g).to_add_monoid_hom,
  by rw [← hg, stabilizer_vadd_eq_stabilizer_map_conj],
(add_equiv.add_subgroup_congr this).trans
  ((add_aut.conj g).add_subgroup_map $ stabilizer α y).symm

end add_action

/-- `smul` by a `k : M` over a ring is injective, if `k` is not a zero divisor.
The general theory of such `k` is elaborated by `is_smul_regular`.
The typeclass that restricts all terms of `M` to have this property is `no_zero_smul_divisors`. -/
lemma smul_cancel_of_non_zero_divisor {M R : Type*}
  [monoid M] [non_unital_non_assoc_ring R] [distrib_mul_action M R]
  (k : M) (h : ∀ (x : R), k • x = 0 → x = 0) {a b : R} (h' : k • a = k • b) :
  a = b :=
begin
  rw ←sub_eq_zero,
  refine h _ _,
  rw [smul_sub, h', sub_self]
end


/-
Copyright (c) 2020 Kenji Nakagawa. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenji Nakagawa, Anne Baanen, Filippo A. E. Nuccio
-/
import linear_algebra.free_module.pid
import ring_theory.dedekind_domain.basic
import ring_theory.localization.module
import ring_theory.trace

/-!
# Integral closure of Dedekind domains

This file shows the integral closure of a Dedekind domain (in particular, the ring of integers
of a number field) is a Dedekind domain.

## Implementation notes

The definitions that involve a field of fractions choose a canonical field of fractions,
but are independent of that choice. The `..._iff` lemmas express this independence.

Often, definitions assume that Dedekind domains are not fields. We found it more practical
to add a `(h : ¬ is_field A)` assumption whenever this is explicitly needed.

## References

* [D. Marcus, *Number Fields*][marcus1977number]
* [J.W.S. Cassels, A. Frölich, *Algebraic Number Theory*][cassels1967algebraic]
* [J. Neukirch, *Algebraic Number Theory*][Neukirch1992]

## Tags

dedekind domain, dedekind ring
-/

variables (R A K : Type*) [comm_ring R] [comm_ring A] [field K]

open_locale non_zero_divisors polynomial

variables [is_domain A]

section is_integral_closure

/-! ### `is_integral_closure` section

We show that an integral closure of a Dedekind domain in a finite separable
field extension is again a Dedekind domain. This implies the ring of integers
of a number field is a Dedekind domain. -/

open algebra
open_locale big_operators

variables (A K) [algebra A K] [is_fraction_ring A K]
variables (L : Type*) [field L] (C : Type*) [comm_ring C]
variables [algebra K L]  [algebra A L] [is_scalar_tower A K L]
variables [algebra C L] [is_integral_closure C A L] [algebra A C] [is_scalar_tower A C L]

/- If `L` is a separable extension of `K = Frac(A)` and `L` has no zero smul divisors by `A`,
then `L` is the localization of the integral closure `C` of `A` in `L` at `A⁰`. -/
lemma is_integral_closure.is_localization [is_separable K L] [no_zero_smul_divisors A L] :
  is_localization (algebra.algebra_map_submonoid C A⁰) L :=
begin
  haveI : is_domain C :=
    (is_integral_closure.equiv A C L (integral_closure A L)).to_ring_equiv.is_domain
      (integral_closure A L),
  haveI : no_zero_smul_divisors A C := is_integral_closure.no_zero_smul_divisors A L,
  refine ⟨_, λ z, _, λ x y, ⟨λ h, ⟨1, _⟩, _⟩⟩,
  { rintros ⟨_, x, hx, rfl⟩,
    rw [is_unit_iff_ne_zero, map_ne_zero_iff _ (is_integral_closure.algebra_map_injective C A L),
      subtype.coe_mk, map_ne_zero_iff _ (no_zero_smul_divisors.algebra_map_injective A C)],
    exact mem_non_zero_divisors_iff_ne_zero.mp hx, },
  { obtain ⟨m, hm⟩ := is_integral.exists_multiple_integral_of_is_localization A⁰ z
      (is_separable.is_integral K z),
    obtain ⟨x, hx⟩ : ∃ x, algebra_map C L x = m • z := is_integral_closure.is_integral_iff.mp hm,
    refine ⟨⟨x, algebra_map A C m, m, set_like.coe_mem m, rfl⟩, _⟩,
    rw [subtype.coe_mk, ← is_scalar_tower.algebra_map_apply, hx, mul_comm, submonoid.smul_def,
      smul_def], },
  { simp only [is_integral_closure.algebra_map_injective C A L h], },
  { rintros ⟨⟨_, m, hm, rfl⟩, h⟩,
    refine congr_arg (algebra_map C L) ((mul_right_inj' _).mp h),
    rw [subtype.coe_mk, map_ne_zero_iff _ (no_zero_smul_divisors.algebra_map_injective A C)],
    exact mem_non_zero_divisors_iff_ne_zero.mp hm, },
end

variable [finite_dimensional K L]
variables {A K L}

lemma is_integral_closure.range_le_span_dual_basis [is_separable K L]
  {ι : Type*} [fintype ι] [decidable_eq ι] (b : basis ι K L)
  (hb_int : ∀ i, is_integral A (b i)) [is_integrally_closed A] :
  ((algebra.linear_map C L).restrict_scalars A).range ≤
    submodule.span A (set.range $ (trace_form K L).dual_basis (trace_form_nondegenerate K L) b) :=
begin
  let db := (trace_form K L).dual_basis (trace_form_nondegenerate K L) b,
  rintros _ ⟨x, rfl⟩,
  simp only [linear_map.coe_restrict_scalars_eq_coe, algebra.linear_map_apply],
  have hx : is_integral A (algebra_map C L x) :=
    (is_integral_closure.is_integral A L x).algebra_map,
  rsuffices ⟨c, x_eq⟩ : ∃ (c : ι → A), algebra_map C L x = ∑ i, c i • db i,
  { rw x_eq,
    refine submodule.sum_mem _ (λ i _, submodule.smul_mem _ _ (submodule.subset_span _)),
    rw set.mem_range,
    exact ⟨i, rfl⟩ },
  suffices : ∃ (c : ι → K), ((∀ i, is_integral A (c i)) ∧ algebra_map C L x = ∑ i, c i • db i),
  { obtain ⟨c, hc, hx⟩ := this,
    have hc' : ∀ i, is_localization.is_integer A (c i) :=
      λ i, is_integrally_closed.is_integral_iff.mp (hc i),
    use λ i, classical.some (hc' i),
    refine hx.trans (finset.sum_congr rfl (λ i _, _)),
    conv_lhs { rw [← classical.some_spec (hc' i)] },
    rw [← is_scalar_tower.algebra_map_smul K (classical.some (hc' i)) (db i)] },
  refine ⟨λ i, db.repr (algebra_map C L x) i, (λ i, _), (db.sum_repr _).symm⟩,
  rw bilin_form.dual_basis_repr_apply,
  exact is_integral_trace (is_integral_mul hx (hb_int i))
end

lemma integral_closure_le_span_dual_basis [is_separable K L]
  {ι : Type*} [fintype ι] [decidable_eq ι] (b : basis ι K L)
  (hb_int : ∀ i, is_integral A (b i)) [is_integrally_closed A] :
  (integral_closure A L).to_submodule ≤ submodule.span A (set.range $
    (trace_form K L).dual_basis (trace_form_nondegenerate K L) b) :=
begin
  refine le_trans _ (is_integral_closure.range_le_span_dual_basis (integral_closure A L) b hb_int),
  intros x hx,
  exact ⟨⟨x, hx⟩, rfl⟩
end

variables (A) (K)

include K

/-- Send a set of `x`'es in a finite extension `L` of the fraction field of `R`
to `(y : R) • x ∈ integral_closure R L`. -/
lemma exists_integral_multiples (s : finset L) :
  ∃ (y ≠ (0 : A)), ∀ x ∈ s, is_integral A (y • x) :=
begin
  haveI := classical.dec_eq L,
  refine s.induction _ _,
  { use [1, one_ne_zero],
    rintros x ⟨⟩ },
  { rintros x s hx ⟨y, hy, hs⟩,
    obtain ⟨x', y', hy', hx'⟩ := exists_integral_multiple
      ((is_fraction_ring.is_algebraic_iff A K L).mpr (is_algebraic_of_finite _ _ x))
      ((injective_iff_map_eq_zero (algebra_map A L)).mp _),
    refine ⟨y * y', mul_ne_zero hy hy', λ x'' hx'', _⟩,
    rcases finset.mem_insert.mp hx'' with (rfl | hx''),
    { rw [mul_smul, algebra.smul_def, algebra.smul_def, mul_comm _ x'', hx'],
      exact is_integral_mul is_integral_algebra_map x'.2 },
    { rw [mul_comm, mul_smul, algebra.smul_def],
      exact is_integral_mul is_integral_algebra_map (hs _ hx'') },
    { rw is_scalar_tower.algebra_map_eq A K L,
      apply (algebra_map K L).injective.comp,
      exact is_fraction_ring.injective _ _ } }
end

variables (L)

/-- If `L` is a finite extension of `K = Frac(A)`,
then `L` has a basis over `A` consisting of integral elements. -/
lemma finite_dimensional.exists_is_basis_integral :
  ∃ (s : finset L) (b : basis s K L), (∀ x, is_integral A (b x)) :=
begin
  letI := classical.dec_eq L,
  letI : is_noetherian K L := is_noetherian.iff_fg.2 infer_instance,
  let s' := is_noetherian.finset_basis_index K L,
  let bs' := is_noetherian.finset_basis K L,
  obtain ⟨y, hy, his'⟩ := exists_integral_multiples A K (finset.univ.image bs'),
  have hy' : algebra_map A L y ≠ 0,
  { refine mt ((injective_iff_map_eq_zero (algebra_map A L)).mp _ _) hy,
    rw is_scalar_tower.algebra_map_eq A K L,
    exact (algebra_map K L).injective.comp (is_fraction_ring.injective A K) },
  refine ⟨s', bs'.map { to_fun := λ x, algebra_map A L y * x,
                        inv_fun := λ x, (algebra_map A L y)⁻¹ * x,
                        left_inv := _,
                        right_inv := _,
                        .. algebra.lmul _ _ (algebra_map A L y) },
          _⟩,
  { intros x, simp only [inv_mul_cancel_left₀ hy'] },
  { intros x, simp only [mul_inv_cancel_left₀ hy'] },
  { rintros ⟨x', hx'⟩,
    simp only [algebra.smul_def, finset.mem_image, exists_prop, finset.mem_univ, true_and] at his',
    simp only [basis.map_apply, linear_equiv.coe_mk],
    exact his' _ ⟨_, rfl⟩ }
end

variables (A K L) [is_separable K L]
include L

/- If `L` is a finite separable extension of `K = Frac(A)`, where `A` is
integrally closed and Noetherian, the integral closure `C` of `A` in `L` is
Noetherian over `A`. -/
lemma is_integral_closure.is_noetherian [is_integrally_closed A] [is_noetherian_ring A] :
  is_noetherian A C :=
begin
  haveI := classical.dec_eq L,
  obtain ⟨s, b, hb_int⟩ := finite_dimensional.exists_is_basis_integral A K L,
  let b' := (trace_form K L).dual_basis (trace_form_nondegenerate K L) b,
  letI := is_noetherian_span_of_finite A (set.finite_range b'),
  let f : C →ₗ[A] submodule.span A (set.range b') :=
    (submodule.of_le (is_integral_closure.range_le_span_dual_basis C b hb_int)).comp
    ((algebra.linear_map C L).restrict_scalars A).range_restrict,
  refine is_noetherian_of_ker_bot f _,
  rw [linear_map.ker_comp, submodule.ker_of_le, submodule.comap_bot, linear_map.ker_cod_restrict],
  exact linear_map.ker_eq_bot_of_injective (is_integral_closure.algebra_map_injective C A L)
end

/- If `L` is a finite separable extension of `K = Frac(A)`, where `A` is
integrally closed and Noetherian, the integral closure `C` of `A` in `L` is
Noetherian. -/
lemma is_integral_closure.is_noetherian_ring [is_integrally_closed A] [is_noetherian_ring A] :
  is_noetherian_ring C :=
is_noetherian_ring_iff.mpr $ is_noetherian_of_tower A (is_integral_closure.is_noetherian A K L C)

/- If `L` is a finite separable extension of `K = Frac(A)`, where `A` is a principal ring
and `L` has no zero smul divisors by `A`, the integral closure `C` of `A` in `L` is
a free `A`-module. -/
lemma is_integral_closure.module_free [no_zero_smul_divisors A L] [is_principal_ideal_ring A] :
  module.free A C :=
begin
  haveI : no_zero_smul_divisors A C := is_integral_closure.no_zero_smul_divisors A L,
  haveI : is_noetherian A C := is_integral_closure.is_noetherian A K L _,
  exact module.free_of_finite_type_torsion_free',
end

/- If `L` is a finite separable extension of `K = Frac(A)`, where `A` is a principal ring
and `L` has no zero smul divisors by `A`, the `A`-rank of the integral closure `C` of `A` in `L`
is equal to the `K`-rank of `L`. -/
lemma is_integral_closure.rank [is_principal_ideal_ring A] [no_zero_smul_divisors A L] :
  finite_dimensional.finrank A C = finite_dimensional.finrank K L :=
begin
  haveI : module.free A C := is_integral_closure.module_free A K L C,
  haveI : is_noetherian A C := is_integral_closure.is_noetherian A K L C,
  haveI : is_localization (algebra.algebra_map_submonoid C A⁰) L :=
    is_integral_closure.is_localization A K L C,
  let b := basis.localization_localization K A⁰ L (module.free.choose_basis A C),
  rw [module.free.finrank_eq_card_choose_basis_index, finite_dimensional.finrank_eq_card_basis b],
end

variables {A K}

/- If `L` is a finite separable extension of `K = Frac(A)`, where `A` is
integrally closed and Noetherian, the integral closure of `A` in `L` is
Noetherian. -/
lemma integral_closure.is_noetherian_ring [is_integrally_closed A] [is_noetherian_ring A] :
  is_noetherian_ring (integral_closure A L) :=
is_integral_closure.is_noetherian_ring A K L (integral_closure A L)

variables (A K) [is_domain C]
/- If `L` is a finite separable extension of `K = Frac(A)`, where `A` is a Dedekind domain,
the integral closure `C` of `A` in `L` is a Dedekind domain.

Can't be an instance since `A`, `K` or `L` can't be inferred. See also the instance
`integral_closure.is_dedekind_domain_fraction_ring` where `K := fraction_ring A`
and `C := integral_closure A L`.
-/
lemma is_integral_closure.is_dedekind_domain [h : is_dedekind_domain A] :
  is_dedekind_domain C :=
begin
  haveI : is_fraction_ring C L := is_integral_closure.is_fraction_ring_of_finite_extension A K L C,
  exact
  ⟨is_integral_closure.is_noetherian_ring A K L C,
   h.dimension_le_one.is_integral_closure _ L _,
   (is_integrally_closed_iff L).mpr (λ x hx, ⟨is_integral_closure.mk' C x
      (is_integral_trans (is_integral_closure.is_integral_algebra A L) _ hx),
    is_integral_closure.algebra_map_mk' _ _ _⟩)⟩
end

/- If `L` is a finite separable extension of `K = Frac(A)`, where `A` is a Dedekind domain,
the integral closure of `A` in `L` is a Dedekind domain.

Can't be an instance since `K` can't be inferred. See also the instance
`integral_closure.is_dedekind_domain_fraction_ring` where `K := fraction_ring A`.
-/
lemma integral_closure.is_dedekind_domain [h : is_dedekind_domain A] :
  is_dedekind_domain (integral_closure A L) :=
is_integral_closure.is_dedekind_domain A K L (integral_closure A L)

omit K

variables [algebra (fraction_ring A) L] [is_scalar_tower A (fraction_ring A) L]
variables [finite_dimensional (fraction_ring A) L] [is_separable (fraction_ring A) L]

/- If `L` is a finite separable extension of `Frac(A)`, where `A` is a Dedekind domain,
the integral closure of `A` in `L` is a Dedekind domain.

See also the lemma `integral_closure.is_dedekind_domain` where you can choose
the field of fractions yourself.
-/
instance integral_closure.is_dedekind_domain_fraction_ring
  [is_dedekind_domain A] : is_dedekind_domain (integral_closure A L) :=
integral_closure.is_dedekind_domain A (fraction_ring A) L

end is_integral_closure


lemma pow_pow (a m n : mynat) : (a ^ m) ^ n = a ^ (m * n) :=
begin
induction n with k Pk,
rw mul_zero,
rw pow_zero a,
exact pow_zero (a^m),

rw pow_succ,
rw Pk,
rw ← pow_add,
rw mul_succ,
refl,
end


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro, Kevin Buzzard, Yury Kudryashov, Eric Wieser

! This file was ported from Lean 3 source module linear_algebra.pi
! leanprover-community/mathlib commit dc6c365e751e34d100e80fe6e314c3c3e0fd2988
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.LinearAlgebra.Basic
import Mathlib.Logic.Equiv.Fin

/-!
# Pi types of modules

This file defines constructors for linear maps whose domains or codomains are pi types.

It contains theorems relating these to each other, as well as to `LinearMap.ker`.

## Main definitions

- pi types in the codomain:
  - `LinearMap.pi`
  - `LinearMap.single`
- pi types in the domain:
  - `LinearMap.proj`
  - `LinearMap.diag`

-/

universe u v w x y z u' v' w' x' y'

variable {R : Type u} {K : Type u'} {M : Type v} {V : Type v'} {M₂ : Type w} {V₂ : Type w'}

variable {M₃ : Type y} {V₃ : Type y'} {M₄ : Type z} {ι : Type x} {ι' : Type x'}

open Function Submodule

open BigOperators

namespace LinearMap

universe i

variable [Semiring R] [AddCommMonoid M₂] [Module R M₂] [AddCommMonoid M₃] [Module R M₃]
  {φ : ι → Type i} [(i : ι) → AddCommMonoid (φ i)] [(i : ι) → Module R (φ i)]

/-- `pi` construction for linear functions. From a family of linear functions it produces a linear
function into a family of modules. -/
def pi (f : (i : ι) → M₂ →ₗ[R] φ i) : M₂ →ₗ[R] (i : ι) → φ i :=
  { Pi.addHom fun i => (f i).toAddHom with
    toFun := fun c i => f i c
    map_smul' := fun _ _ => funext fun i => (f i).map_smul _ _ }
#align linear_map.pi LinearMap.pi

@[simp]
theorem pi_apply (f : (i : ι) → M₂ →ₗ[R] φ i) (c : M₂) (i : ι) : pi f c i = f i c :=
  rfl
#align linear_map.pi_apply LinearMap.pi_apply

theorem ker_pi (f : (i : ι) → M₂ →ₗ[R] φ i) : ker (pi f) = ⨅ i : ι, ker (f i) := by
  ext c; simp [funext_iff]
#align linear_map.ker_pi LinearMap.ker_pi

theorem pi_eq_zero (f : (i : ι) → M₂ →ₗ[R] φ i) : pi f = 0 ↔ ∀ i, f i = 0 := by
  simp only [LinearMap.ext_iff, pi_apply, funext_iff];
    exact ⟨fun h a b => h b a, fun h a b => h b a⟩
#align linear_map.pi_eq_zero LinearMap.pi_eq_zero

theorem pi_zero : pi (fun i => 0 : (i : ι) → M₂ →ₗ[R] φ i) = 0 := by ext; rfl
#align linear_map.pi_zero LinearMap.pi_zero

theorem pi_comp (f : (i : ι) → M₂ →ₗ[R] φ i) (g : M₃ →ₗ[R] M₂) :
    (pi f).comp g = pi fun i => (f i).comp g :=
  rfl
#align linear_map.pi_comp LinearMap.pi_comp

/-- The projections from a family of modules are linear maps.

Note:  known here as `LinearMap.proj`, this construction is in other categories called `eval`, for
example `Pi.evalMonoidHom`, `Pi.evalRingHom`. -/
def proj (i : ι) : ((i : ι) → φ i) →ₗ[R] φ i where
  toFun := Function.eval i
  map_add' _ _ := rfl
  map_smul' _ _ := rfl
#align linear_map.proj LinearMap.proj

@[simp]
theorem coe_proj (i : ι) : ⇑(proj i : ((i : ι) → φ i) →ₗ[R] φ i) = Function.eval i :=
  rfl
#align linear_map.coe_proj LinearMap.coe_proj

theorem proj_apply (i : ι) (b : (i : ι) → φ i) : (proj i : ((i : ι) → φ i) →ₗ[R] φ i) b = b i :=
  rfl
#align linear_map.proj_apply LinearMap.proj_apply

theorem proj_pi (f : (i : ι) → M₂ →ₗ[R] φ i) (i : ι) : (proj i).comp (pi f) = f i :=
  ext fun _ => rfl
#align linear_map.proj_pi LinearMap.proj_pi

theorem infᵢ_ker_proj : (⨅ i, ker (proj i : ((i : ι) → φ i) →ₗ[R] φ i) :
    Submodule R ((i : ι) → φ i)) = ⊥ :=
  bot_unique <|
    SetLike.le_def.2 fun a h => by
      simp only [mem_infᵢ, mem_ker, proj_apply] at h
      exact (mem_bot _).2 (funext fun i => h i)
#align linear_map.infi_ker_proj LinearMap.infᵢ_ker_proj

/-- Linear map between the function spaces `I → M₂` and `I → M₃`, induced by a linear map `f`
between `M₂` and `M₃`. -/
@[simps]
protected def compLeft (f : M₂ →ₗ[R] M₃) (I : Type _) : (I → M₂) →ₗ[R] I → M₃ :=
  { f.toAddMonoidHom.compLeft I with
    toFun := fun h => f ∘ h
    map_smul' := fun c h => by
      ext x
      exact f.map_smul' c (h x) }
#align linear_map.comp_left LinearMap.compLeft

theorem apply_single [AddCommMonoid M] [Module R M] [DecidableEq ι] (f : (i : ι) → φ i →ₗ[R] M)
    (i j : ι) (x : φ i) : f j (Pi.single i x j) = (Pi.single i (f i x) : ι → M) j :=
  Pi.apply_single (fun i => f i) (fun i => (f i).map_zero) _ _ _
#align linear_map.apply_single LinearMap.apply_single

/-- The `LinearMap` version of `AddMonoidHom.single` and `Pi.single`. -/
def single [DecidableEq ι] (i : ι) : φ i →ₗ[R] (i : ι) → φ i :=
  { AddMonoidHom.single φ i with
    toFun := Pi.single i
    map_smul' := Pi.single_smul i }
#align linear_map.single LinearMap.single

@[simp]
theorem coe_single [DecidableEq ι] (i : ι) : ⇑(single i : φ i →ₗ[R] (i : ι) → φ i) = Pi.single i :=
  rfl
#align linear_map.coe_single LinearMap.coe_single

variable (R φ)

/-- The linear equivalence between linear functions on a finite product of modules and
families of functions on these modules. See note [bundled maps over different rings]. -/
@[simps symm_apply]
def lsum (S) [AddCommMonoid M] [Module R M] [Fintype ι] [DecidableEq ι] [Semiring S] [Module S M]
    [SMulCommClass R S M] : ((i : ι) → φ i →ₗ[R] M) ≃ₗ[S] ((i : ι) → φ i) →ₗ[R] M where
  toFun f := ∑ i : ι, (f i).comp (proj i)
  invFun f i := f.comp (single i)
  map_add' f g := by simp only [Pi.add_apply, add_comp, Finset.sum_add_distrib]
  map_smul' c f := by simp only [Pi.smul_apply, smul_comp, Finset.smul_sum, RingHom.id_apply]
  left_inv f := by
    ext (i x)
    simp [apply_single]
  right_inv f := by
    ext x
    suffices f (∑ j, Pi.single j (x j)) = f x by simpa [apply_single]
    rw [Finset.univ_sum_single]
#align linear_map.lsum LinearMap.lsum
#align linear_map.lsum_symm_apply LinearMap.lsum_symm_apply

@[simp]
theorem lsum_apply (S) [AddCommMonoid M] [Module R M] [Fintype ι] [DecidableEq ι] [Semiring S]
    [Module S M] [SMulCommClass R S M] (f : (i : ι) → φ i →ₗ[R] M) :
    lsum R φ S f = ∑ i : ι, (f i).comp (proj i) := rfl
#align linear_map.apply LinearMap.lsum_apply

@[simp high]
theorem lsum_single {ι R : Type _} [Fintype ι] [DecidableEq ι] [CommRing R] {M : ι → Type _}
    [(i : ι) → AddCommGroup (M i)] [(i : ι) → Module R (M i)] :
    LinearMap.lsum R M R LinearMap.single = LinearMap.id :=
  LinearMap.ext fun x => by simp [Finset.univ_sum_single]
#align linear_map.lsum_single LinearMap.lsum_single

variable {R φ}

section Ext

variable [Finite ι] [DecidableEq ι] [AddCommMonoid M] [Module R M] {f g : ((i : ι) → φ i) →ₗ[R] M}

theorem pi_ext (h : ∀ i x, f (Pi.single i x) = g (Pi.single i x)) : f = g :=
  toAddMonoidHom_injective <| AddMonoidHom.functions_ext _ _ _ h
#align linear_map.pi_ext LinearMap.pi_ext

theorem pi_ext_iff : f = g ↔ ∀ i x, f (Pi.single i x) = g (Pi.single i x) :=
  ⟨fun h _ _ => h ▸ rfl, pi_ext⟩
#align linear_map.pi_ext_iff LinearMap.pi_ext_iff

/-- This is used as the ext lemma instead of `LinearMap.pi_ext` for reasons explained in
note [partially-applied ext lemmas]. -/
@[ext]
theorem pi_ext' (h : ∀ i, f.comp (single i) = g.comp (single i)) : f = g := by
  refine' pi_ext fun i x => _
  convert LinearMap.congr_fun (h i) x
#align linear_map.pi_ext' LinearMap.pi_ext'

theorem pi_ext'_iff : f = g ↔ ∀ i, f.comp (single i) = g.comp (single i) :=
  ⟨fun h _ => h ▸ rfl, pi_ext'⟩
#align linear_map.pi_ext'_iff LinearMap.pi_ext'_iff

end Ext

section

variable (R φ)

/-- If `I` and `J` are disjoint index sets, the product of the kernels of the `J`th projections of
`φ` is linearly equivalent to the product over `I`. -/
def infᵢKerProjEquiv {I J : Set ι} [DecidablePred fun i => i ∈ I] (hd : Disjoint I J)
    (hu : Set.univ ⊆ I ∪ J) :
    (⨅ i ∈ J, ker (proj i : ((i : ι) → φ i) →ₗ[R] φ i) :
    Submodule R ((i : ι) → φ i)) ≃ₗ[R] (i : I) → φ i := by
  refine'
    LinearEquiv.ofLinear (pi fun i => (proj (i : ι)).comp (Submodule.subtype _))
      (codRestrict _ (pi fun i => if h : i ∈ I then proj (⟨i, h⟩ : I) else 0) _) _ _
  · intro b
    simp only [mem_infᵢ, mem_ker, funext_iff, proj_apply, pi_apply]
    intro j hjJ
    have : j ∉ I := fun hjI => hd.le_bot ⟨hjI, hjJ⟩
    rw [dif_neg this, zero_apply]
  · simp only [pi_comp, comp_assoc, subtype_comp_codRestrict, proj_pi, Subtype.coe_prop]
    ext (b⟨j, hj⟩)
    simp only [dif_pos, Function.comp_apply, Function.eval_apply, LinearMap.codRestrict_apply,
      LinearMap.coe_comp, LinearMap.coe_proj, LinearMap.pi_apply, Submodule.subtype_apply,
      Subtype.coe_prop]
    rfl
  · ext1 ⟨b, hb⟩
    apply Subtype.ext
    ext j
    have hb : ∀ i ∈ J, b i = 0 := by
      simpa only [mem_infᵢ, mem_ker, proj_apply] using (mem_infᵢ _).1 hb
    simp only [comp_apply, pi_apply, id_apply, proj_apply, subtype_apply, codRestrict_apply]
    split_ifs with h
    · rfl
    · exact (hb _ <| (hu trivial).resolve_left h).symm
#align linear_map.infi_ker_proj_equiv LinearMap.infᵢKerProjEquiv

end

section

variable [DecidableEq ι]

/-- `diag i j` is the identity map if `i = j`. Otherwise it is the constant 0 map. -/
def diag (i j : ι) : φ i →ₗ[R] φ j :=
  @Function.update ι (fun j => φ i →ₗ[R] φ j) _ 0 i id j
#align linear_map.diag LinearMap.diag

theorem update_apply (f : (i : ι) → M₂ →ₗ[R] φ i) (c : M₂) (i j : ι) (b : M₂ →ₗ[R] φ i) :
    (update f i b j) c = update (fun i => f i c) i (b c) j := by
  by_cases h : j = i
  · rw [h, update_same, update_same]
  · rw [update_noteq h, update_noteq h]
#align linear_map.update_apply LinearMap.update_apply

end

end LinearMap

namespace Submodule

variable [Semiring R] {φ : ι → Type _} [(i : ι) → AddCommMonoid (φ i)] [(i : ι) → Module R (φ i)]

open LinearMap

/-- A version of `Set.pi` for submodules. Given an index set `I` and a family of submodules
`p : (i : ι) → Submodule R (φ i)`, `pi I s` is the submodule of dependent functions
`f : (i : ι) → φ i` such that `f i` belongs to `p a` whenever `i ∈ I`. -/
def pi (I : Set ι) (p : (i : ι) → Submodule R (φ i)) : Submodule R ((i : ι) → φ i) where
  carrier := Set.pi I fun i => p i
  zero_mem' i _ := (p i).zero_mem
  add_mem' {_ _} hx hy i hi := (p i).add_mem (hx i hi) (hy i hi)
  smul_mem' c _ hx i hi := (p i).smul_mem c (hx i hi)
#align submodule.pi Submodule.pi

variable {I : Set ι} {p q : (i : ι) → Submodule R (φ i)} {x : (i : ι) → φ i}

@[simp]
theorem mem_pi : x ∈ pi I p ↔ ∀ i ∈ I, x i ∈ p i :=
  Iff.rfl
#align submodule.mem_pi Submodule.mem_pi

@[simp, norm_cast]
theorem coe_pi : (pi I p : Set ((i : ι) → φ i)) = Set.pi I fun i => p i :=
  rfl
#align submodule.coe_pi Submodule.coe_pi

@[simp]
theorem pi_empty (p : (i : ι) → Submodule R (φ i)) : pi ∅ p = ⊤ :=
  SetLike.coe_injective <| Set.empty_pi _
#align submodule.pi_empty Submodule.pi_empty

@[simp]
theorem pi_top (s : Set ι) : (pi s fun i : ι => (⊤ : Submodule R (φ i))) = ⊤ :=
  SetLike.coe_injective <| Set.pi_univ _
#align submodule.pi_top Submodule.pi_top

theorem pi_mono {s : Set ι} (h : ∀ i ∈ s, p i ≤ q i) : pi s p ≤ pi s q :=
  Set.pi_mono h
#align submodule.pi_mono Submodule.pi_mono

theorem binfᵢ_comap_proj :
    (⨅ i ∈ I, comap (proj i : ((i : ι) →  φ i) →ₗ[R] φ i) (p i)) = pi I p := by
  ext x
  simp
#align submodule.binfi_comap_proj Submodule.binfᵢ_comap_proj

theorem infᵢ_comap_proj :
    (⨅ i, comap (proj i : ((i : ι) → φ i) →ₗ[R] φ i) (p i)) = pi Set.univ p := by
  ext x
  simp
#align submodule.infi_comap_proj Submodule.infᵢ_comap_proj

theorem supᵢ_map_single [DecidableEq ι] [Finite ι] :
    (⨆ i, map (LinearMap.single i : φ i →ₗ[R] (i : ι) → φ i) (p i)) = pi Set.univ p := by
  cases nonempty_fintype ι
  refine' (supᵢ_le fun i => _).antisymm _
  · rintro _ ⟨x, hx : x ∈ p i, rfl⟩ j -
    rcases em (j = i) with (rfl | hj) <;> simp [*]
  · intro x hx
    rw [← Finset.univ_sum_single x]
    exact sum_mem_supᵢ fun i => mem_map_of_mem (hx i trivial)
#align submodule.supr_map_single Submodule.supᵢ_map_single

theorem le_comap_single_pi [DecidableEq ι] (p : (i : ι) → Submodule R (φ i)) {i} :
    p i ≤ Submodule.comap (LinearMap.single i : φ i →ₗ[R] _) (Submodule.pi Set.univ p) := by
  intro x hx
  rw [Submodule.mem_comap, Submodule.mem_pi]
  rintro j -
  by_cases h : j = i
  · rwa [h, LinearMap.coe_single, Pi.single_eq_same]
  · rw [LinearMap.coe_single, Pi.single_eq_of_ne h]
    exact (p j).zero_mem
#align submodule.le_comap_single_pi Submodule.le_comap_single_pi

end Submodule

namespace LinearEquiv

variable [Semiring R] {φ ψ χ : ι → Type _}

variable [(i : ι) → AddCommMonoid (φ i)] [(i : ι) → Module R (φ i)]

variable [(i : ι) → AddCommMonoid (ψ i)] [(i : ι) → Module R (ψ i)]

variable [(i : ι) → AddCommMonoid (χ i)] [(i : ι) → Module R (χ i)]

/-- Combine a family of linear equivalences into a linear equivalence of `pi`-types.

This is `Equiv.piCongrRight` as a `LinearEquiv` -/
def piCongrRight (e : (i : ι) → φ i ≃ₗ[R] ψ i) : ((i : ι) → φ i) ≃ₗ[R] (i : ι) → ψ i :=
  { AddEquiv.piCongrRight fun j => (e j).toAddEquiv with
    toFun := fun f i => e i (f i)
    invFun := fun f i => (e i).symm (f i)
    map_smul' := fun c f => by ext; simp }
#align linear_equiv.Pi_congr_right LinearEquiv.piCongrRight

@[simp]
theorem piCongrRight_apply (e : (i : ι) → φ i ≃ₗ[R] ψ i) (f i) :
    piCongrRight e f i = e i (f i) := rfl
#align linear_equiv.Pi_congr_right_apply LinearEquiv.piCongrRight

@[simp]
theorem piCongrRight_refl : (piCongrRight fun j => refl R (φ j)) = refl _ _ :=
  rfl
#align linear_equiv.Pi_congr_right_refl LinearEquiv.piCongrRight_refl

@[simp]
theorem piCongrRight_symm (e : (i : ι) → φ i ≃ₗ[R] ψ i) :
    (piCongrRight e).symm = piCongrRight fun i => (e i).symm :=
  rfl
#align linear_equiv.Pi_congr_right_symm LinearEquiv.piCongrRight_symm

@[simp]
theorem piCongrRight_trans (e : (i : ι) → φ i ≃ₗ[R] ψ i) (f : (i : ι) → ψ i ≃ₗ[R] χ i) :
    (piCongrRight e).trans (piCongrRight f) = piCongrRight fun i => (e i).trans (f i) :=
  rfl
#align linear_equiv.Pi_congr_right_trans LinearEquiv.piCongrRight_trans

variable (R φ)

/-- Transport dependent functions through an equivalence of the base space.

This is `Equiv.piCongrLeft'` as a `LinearEquiv`. -/
@[simps (config := { simpRhs := true })]
def piCongrLeft' (e : ι ≃ ι') : ((i' : ι) → φ i') ≃ₗ[R] (i : ι') → φ <| e.symm i :=
  { Equiv.piCongrLeft' φ e with
    map_add' := fun _ _ => rfl
    map_smul' := fun _ _ => rfl }
#align linear_equiv.Pi_congr_left' LinearEquiv.piCongrLeft'

/-- Transporting dependent functions through an equivalence of the base,
expressed as a "simplification".

This is `Equiv.piCongrLeft` as a `LinearEquiv` -/
def piCongrLeft (e : ι' ≃ ι) : ((i' : ι') → φ (e i')) ≃ₗ[R] (i : ι) → φ i :=
  (piCongrLeft' R φ e.symm).symm
#align linear_equiv.Pi_congr_left LinearEquiv.piCongrLeft

/-- This is `Equiv.piOptionEquivProd` as a `LinearEquiv` -/
def piOptionEquivProd {ι : Type _} {M : Option ι → Type _} [(i : Option ι) → AddCommGroup (M i)]
    [(i : Option ι) → Module R (M i)] :
    ((i : Option ι) → M i) ≃ₗ[R] M none × ((i : ι) → M (some i)) :=
  { Equiv.piOptionEquivProd with
    map_add' := by simp [Function.funext_iff]
    map_smul' := by simp [Function.funext_iff] }
#align linear_equiv.pi_option_equiv_prod LinearEquiv.piOptionEquivProd

variable (ι M) (S : Type _) [Fintype ι] [DecidableEq ι] [Semiring S] [AddCommMonoid M]
  [Module R M] [Module S M] [SMulCommClass R S M]

/-- Linear equivalence between linear functions `Rⁿ → M` and `Mⁿ`. The spaces `Rⁿ` and `Mⁿ`
are represented as `ι → R` and `ι → M`, respectively, where `ι` is a finite type.

This as an `S`-linear equivalence, under the assumption that `S` acts on `M` commuting with `R`.
When `R` is commutative, we can take this to be the usual action with `S = R`.
Otherwise, `S = ℕ` shows that the equivalence is additive.
See note [bundled maps over different rings]. -/
def piRing : ((ι → R) →ₗ[R] M) ≃ₗ[S] ι → M :=
  (LinearMap.lsum R (fun _ : ι => R) S).symm.trans
    (piCongrRight fun _ => LinearMap.ringLmapEquivSelf R S M)
#align linear_equiv.pi_ring LinearEquiv.piRing

variable {ι R M}

@[simp]
theorem piRing_apply (f : (ι → R) →ₗ[R] M) (i : ι) : piRing R M ι S f i = f (Pi.single i 1) :=
  rfl
#align linear_equiv.pi_ring_apply LinearEquiv.piRing_apply

@[simp]
theorem piRing_symm_apply (f : ι → M) (g : ι → R) : (piRing R M ι S).symm f g = ∑ i, g i • f i := by
  simp [piRing, LinearMap.lsum_apply]
#align linear_equiv.pi_ring_symm_apply LinearEquiv.piRing_symm_apply

-- TODO additive version?
/-- `Equiv.sumArrowEquivProdArrow` as a linear equivalence.
-/
def sumArrowLequivProdArrow (α β R M : Type _) [Semiring R] [AddCommMonoid M] [Module R M] :
    (Sum α β → M) ≃ₗ[R] (α → M) × (β → M) :=
  { Equiv.sumArrowEquivProdArrow α β
      M with
    map_add' := by
      intro f g
      ext <;> rfl
    map_smul' := by
      intro r f
      ext <;> rfl }
#align linear_equiv.sum_arrow_lequiv_prod_arrow LinearEquiv.sumArrowLequivProdArrow

@[simp]
theorem sumArrowLequivProdArrow_apply_fst {α β} (f : Sum α β → M) (a : α) :
    (sumArrowLequivProdArrow α β R M f).1 a = f (Sum.inl a) :=
  rfl
#align linear_equiv.sum_arrow_lequiv_prod_arrow_apply_fst LinearEquiv.sumArrowLequivProdArrow_apply_fst

@[simp]
theorem sumArrowLequivProdArrow_apply_snd {α β} (f : Sum α β → M) (b : β) :
    (sumArrowLequivProdArrow α β R M f).2 b = f (Sum.inr b) :=
  rfl
#align linear_equiv.sum_arrow_lequiv_prod_arrow_apply_snd LinearEquiv.sumArrowLequivProdArrow_apply_snd

@[simp]
theorem sumArrowLequivProdArrow_symm_apply_inl {α β} (f : α → M) (g : β → M) (a : α) :
    ((sumArrowLequivProdArrow α β R M).symm (f, g)) (Sum.inl a) = f a :=
  rfl
#align linear_equiv.sum_arrow_lequiv_prod_arrow_symm_apply_inl LinearEquiv.sumArrowLequivProdArrow_symm_apply_inl

@[simp]
theorem sumArrowLequivProdArrow_symm_apply_inr {α β} (f : α → M) (g : β → M) (b : β) :
    ((sumArrowLequivProdArrow α β R M).symm (f, g)) (Sum.inr b) = g b :=
  rfl
#align linear_equiv.sum_arrow_lequiv_prod_arrow_symm_apply_inr LinearEquiv.sumArrowLequivProdArrow_symm_apply_inr

/-- If `ι` has a unique element, then `ι → M` is linearly equivalent to `M`. -/
@[simps (config :=
      { simpRhs := true
        fullyApplied := false }) symm_apply]
def funUnique (ι R M : Type _) [Unique ι] [Semiring R] [AddCommMonoid M] [Module R M] :
    (ι → M) ≃ₗ[R] M :=
  { Equiv.funUnique ι M with
    map_add' := fun _ _ => rfl
    map_smul' := fun _ _ => rfl }
#align linear_equiv.fun_unique LinearEquiv.funUnique
#align linear_equiv.fun_unique_symm_apply LinearEquiv.funUnique_symm_apply

@[simp]
theorem funUnique_apply (ι R M : Type _) [Unique ι] [Semiring R] [AddCommMonoid M] [Module R M] :
    (funUnique ι R M : (ι → M) → M) = eval default := rfl
#align linear_equiv.fun_unique_apply LinearEquiv.funUnique_apply

variable (R M)

/-- Linear equivalence between dependent functions `(i : fin 2) → M i` and `M 0 × M 1`. -/
@[simps (config :=
      { simpRhs := true
        fullyApplied := false }) symm_apply]
def piFinTwo (M : Fin 2 → Type v)
    [(i : Fin 2) → AddCommMonoid (M i)] [(i : Fin 2) → Module R (M i)] :
    ((i : Fin 2) → M i) ≃ₗ[R] M 0 × M 1 :=
  { piFinTwoEquiv M with
    map_add' := fun _ _ => rfl
    map_smul' := fun _ _ => rfl }
#align linear_equiv.pi_fin_two LinearEquiv.piFinTwo
#align linear_equiv.pi_fin_two_symm_apply LinearEquiv.piFinTwo_symm_apply

@[simp]
theorem piFinTwo_apply (M : Fin 2 → Type v)
    [(i : Fin 2) → AddCommMonoid (M i)] [(i : Fin 2) → Module R (M i)] :
    (piFinTwo R M : ((i : Fin 2) → M i) → M 0 × M 1) = fun f => (f 0, f 1) := rfl
#align linear_equiv.pi_fin_two_apply LinearEquiv.piFinTwo_apply

/-- Linear equivalence between vectors in `M² = fin 2 → M` and `M × M`. -/
@[simps! (config := .asFn)]
def finTwoArrow : (Fin 2 → M) ≃ₗ[R] M × M :=
  { finTwoArrowEquiv M, piFinTwo R fun _ => M with }
#align linear_equiv.fin_two_arrow LinearEquiv.finTwoArrow

end LinearEquiv

section Extend

variable (R) {η : Type x} [Semiring R] (s : ι → η)

/-- `Function.extend s f 0` as a bundled linear map. -/
@[simps]
noncomputable def Function.ExtendByZero.linearMap : (ι → R) →ₗ[R] η → R :=
  { Function.ExtendByZero.hom R s with
    toFun := fun f => Function.extend s f 0
    map_smul' := fun r f => by simpa using Function.extend_smul r s f 0 }
#align function.extend_by_zero.linear_map Function.ExtendByZero.linearMap

end Extend

/-! ### Bundled versions of `Matrix.vecCons` and `Matrix.vecEmpty`

The idea of these definitions is to be able to define a map as `x ↦ ![f₁ x, f₂ x, f₃ x]`, where
`f₁ f₂ f₃` are already linear maps, as `f₁.vecCons $ f₂.vecCons $ f₃.vecCons $ vecEmpty`.

While the same thing could be achieved using `LinearMap.pi ![f₁, f₂, f₃]`, this is not
definitionally equal to the result using `LinearMap.vecCons`, as `Fin.cases` and function
application do not commute definitionally.

Versions for when `f₁ f₂ f₃` are bilinear maps are also provided.

-/

section Fin

section Semiring

variable [Semiring R] [AddCommMonoid M] [AddCommMonoid M₂] [AddCommMonoid M₃]

variable [Module R M] [Module R M₂] [Module R M₃]

/-- The linear map defeq to `Matrix.vecEmpty` -/
def LinearMap.vecEmpty : M →ₗ[R] Fin 0 → M₃ where
  toFun _ := Matrix.vecEmpty
  map_add' _ _ := Subsingleton.elim _ _
  map_smul' _ _ := Subsingleton.elim _ _
#align linear_map.vec_empty LinearMap.vecEmpty

@[simp]
theorem LinearMap.vecEmpty_apply (m : M) : (LinearMap.vecEmpty : M →ₗ[R] Fin 0 → M₃) m = ![] :=
  rfl
#align linear_map.vec_empty_apply LinearMap.vecEmpty_apply

/-- A linear map into `Fin n.succ → M₃` can be built out of a map into `M₃` and a map into
`Fin n → M₃`. -/
def LinearMap.vecCons {n} (f : M →ₗ[R] M₂) (g : M →ₗ[R] Fin n → M₂) : M →ₗ[R] Fin n.succ → M₂ where
  toFun m := Matrix.vecCons (f m) (g m)
  map_add' x y := by
    simp only []
    rw [f.map_add, g.map_add, Matrix.cons_add_cons (f x)]
  map_smul' c x := by
    simp only []
    rw [f.map_smul, g.map_smul, RingHom.id_apply, Matrix.smul_cons c (f x)]
#align linear_map.vec_cons LinearMap.vecCons

@[simp]
theorem LinearMap.vecCons_apply {n} (f : M →ₗ[R] M₂) (g : M →ₗ[R] Fin n → M₂) (m : M) :
    f.vecCons g m = Matrix.vecCons (f m) (g m) :=
  rfl
#align linear_map.vec_cons_apply LinearMap.vecCons_apply

end Semiring

section CommSemiring

variable [CommSemiring R] [AddCommMonoid M] [AddCommMonoid M₂] [AddCommMonoid M₃]

variable [Module R M] [Module R M₂] [Module R M₃]

/-- The empty bilinear map defeq to `Matrix.vecEmpty` -/
@[simps]
def LinearMap.vecEmpty₂ : M →ₗ[R] M₂ →ₗ[R] Fin 0 → M₃ where
  toFun _ := LinearMap.vecEmpty
  map_add' _ _ := LinearMap.ext fun _ => Subsingleton.elim _ _
  map_smul' _ _ := LinearMap.ext fun _ => Subsingleton.elim _ _
#align linear_map.vec_empty₂ LinearMap.vecEmpty₂

/-- A bilinear map into `Fin n.succ → M₃` can be built out of a map into `M₃` and a map into
`Fin n → M₃` -/
@[simps]
def LinearMap.vecCons₂ {n} (f : M →ₗ[R] M₂ →ₗ[R] M₃) (g : M →ₗ[R] M₂ →ₗ[R] Fin n → M₃) :
    M →ₗ[R] M₂ →ₗ[R] Fin n.succ → M₃ where
  toFun m := LinearMap.vecCons (f m) (g m)
  map_add' x y :=
    LinearMap.ext fun z => by
      simp only [f.map_add, g.map_add, LinearMap.add_apply, LinearMap.vecCons_apply,
        Matrix.cons_add_cons (f x z)]
  map_smul' r x := LinearMap.ext fun z => by simp [Matrix.smul_cons r (f x z)]
#align linear_map.vec_cons₂ LinearMap.vecCons₂

end CommSemiring

end Fin


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.algebra.module
import Mathlib.topology.instances.real
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-!
# Continuous additive maps are `ℝ`-linear

In this file we prove that a continuous map `f : E →+ F` between two topological vector spaces
over `ℝ` is `ℝ`-linear
-/

namespace add_monoid_hom

/-- A continuous additive map between two vector spaces over `ℝ` is `ℝ`-linear. -/
theorem map_real_smul {E : Type u_1} [add_comm_group E] [vector_space ℝ E] [topological_space E]
    [topological_vector_space ℝ E] {F : Type u_2} [add_comm_group F] [vector_space ℝ F]
    [topological_space F] [topological_vector_space ℝ F] [t2_space F] (f : E →+ F)
    (hf : continuous ⇑f) (c : ℝ) (x : E) : coe_fn f (c • x) = c • coe_fn f x :=
  sorry

/-- Reinterpret a continuous additive homomorphism between two real vector spaces
as a continuous real-linear map. -/
def to_real_linear_map {E : Type u_1} [add_comm_group E] [vector_space ℝ E] [topological_space E]
    [topological_vector_space ℝ E] {F : Type u_2} [add_comm_group F] [vector_space ℝ F]
    [topological_space F] [topological_vector_space ℝ F] [t2_space F] (f : E →+ F)
    (hf : continuous ⇑f) : continuous_linear_map ℝ E F :=
  continuous_linear_map.mk (linear_map.mk ⇑f sorry (map_real_smul f hf))

@[simp] theorem coe_to_real_linear_map {E : Type u_1} [add_comm_group E] [vector_space ℝ E]
    [topological_space E] [topological_vector_space ℝ E] {F : Type u_2} [add_comm_group F]
    [vector_space ℝ F] [topological_space F] [topological_vector_space ℝ F] [t2_space F]
    (f : E →+ F) (hf : continuous ⇑f) : ⇑(to_real_linear_map f hf) = ⇑f :=
  rfl

end Mathlib


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/

import tactic.interval_cases

example (n : ℕ) : true :=
begin
  success_if_fail { interval_cases n },
  trivial
end

example (n : ℕ) (h : 2 ≤ n) : true :=
begin
  success_if_fail { interval_cases n },
  trivial
end

example (n m : ℕ) (h : n ≤ m) : true :=
begin
  success_if_fail { interval_cases n },
  trivial,
end

example (n : ℕ) (w₂ : n < 0) : false :=
by interval_cases n

example (n : ℕ) (w₂ : n < 1) : n = 0 :=
by { interval_cases n, }

example (n : ℕ) (w₂ : n < 2) : n = 0 ∨ n = 1 :=
by { interval_cases n, { left, refl }, { right, refl }, }

example (n : ℕ) (w₁ : 1 ≤ n) (w₂ : n < 3) : n = 1 ∨ n = 2 :=
by { interval_cases n, { left, refl }, { right, refl }, }

example (n : ℕ) (w₁ : 1 ≤ n) (w₂ : n < 3) : n = 1 ∨ n = 2 :=
by { interval_cases using w₁ w₂, { left, refl }, { right, refl }, }

-- make sure we only pick up bounds on the specified variable:
example (n m : ℕ) (w₁ : 1 ≤ n) (w₂ : n < 3) (w₃ : m < 2) : n = 1 ∨ n = 2 :=
by { interval_cases n, { left, refl }, { right, refl }, }

example (n : ℕ) (w₁ : 1 < n) (w₂ : n < 4) : n = 2 ∨ n = 3 :=
by { interval_cases n, { left, refl }, { right, refl }, }

example (n : ℕ) (w₁ : n ≥ 3) (w₂ : n < 5) : n = 3 ∨ n = 4 :=
by { interval_cases n, { left, refl }, { right, refl }, }

example (n : ℕ) (w₀ : n ≥ 2) (w₁ : n ≥ 3) (w₂ : n < 5) : n = 3 ∨ n = 4 :=
by { interval_cases n, { left, refl }, { right, refl }, }

example (n : ℕ) (w₁ : n > 2) (w₂ : n < 5) : n = 3 ∨ n = 4 :=
by { interval_cases n, { left, refl }, { right, refl }, }

example (n : ℕ) (w₁ : n > 2) (w₂ : n ≤ 4) : n = 3 ∨ n = 4 :=
by { interval_cases n, { left, refl }, { right, refl }, }

example (n : ℕ) (w₁ : 2 < n) (w₂ : 4 ≥ n) : n = 3 ∨ n = 4 :=
by { interval_cases n, { left, refl }, { right, refl }, }

example (n : ℕ) (h1 : 4 < n) (h2 : n ≤ 6) : n < 20 :=
begin
  interval_cases n,
  guard_target 5 < 20, norm_num,
  guard_target 6 < 20, norm_num,
end

example (n : ℕ) (w₁ : n % 3 < 1) : n % 3 = 0 :=
by { interval_cases n % 3, assumption }

example (n : ℕ) (h1 : 4 ≤ n) (h2 : n < 10) : n < 20 :=
begin
  interval_cases using h1 h2,
  all_goals {norm_num}
end

example (n : ℕ+) (w₂ : n < 1) : false :=
by interval_cases n

example (n : ℕ+) (w₂ : n < 2) : n = 1 :=
by interval_cases n

example (n : ℕ+) (h1 : 4 ≤ n) (h2 : n < 5) : n = 4 :=
by interval_cases n

example (n : ℕ+) (w₁ : 2 < n) (w₂ : 4 ≥ n) : n = 3 ∨ n = 4 :=
begin
  interval_cases n,
  { guard_target' (3 : ℕ+) = 3 ∨ (3 : ℕ+) = 4, left, refl },
  { guard_target' (4 : ℕ+) = 3 ∨ (4 : ℕ+) = 4, right, refl },
end

example (n : ℕ+) (w₁ : 1 < n) (w₂ : n < 4) : n = 2 ∨ n = 3 :=
by { interval_cases n, { left, refl }, { right, refl }, }

example (n : ℕ+) (w₂ : n < 3) : n = 1 ∨ n = 2 :=
by { interval_cases n, { left, refl }, { right, refl }, }

example (n : ℕ+) (w₂ : n < 4) : n = 1 ∨ n = 2 ∨ n = 3 :=
by { interval_cases n, { left, refl }, { right, left, refl }, { right, right, refl }, }

example (z : ℤ) (h1 : z ≥ -3) (h2 : z < 2) : z < 20 :=
begin
  interval_cases using h1 h2,
  all_goals {norm_num}
end

example (z : ℤ) (h1 : z ≥ -3) (h2 : z < 2) : z < 20 :=
begin
  interval_cases z,
  guard_target (-3 : ℤ) < 20, norm_num,
  guard_target (-2 : ℤ) < 20, norm_num,
  guard_target (-1 : ℤ) < 20, norm_num,
  guard_target (0 : ℤ) < 20, norm_num,
  guard_target (1 : ℤ) < 20, norm_num,
end

example (n : ℕ) : n % 2 = 0 ∨ n % 2 = 1 :=
begin
  set r := n % 2 with hr,
  have h2 : r < 2 := nat.mod_lt _ (dec_trivial),
  interval_cases r with hrv,
  { left, exact hrv },
  { right, exact hrv }
end

/- https://leanprover.zulipchat.com/#narrow/stream/113488-general/topic/interval_cases.20bug -/
example {x : ℕ} (hx2 : x < 2) (h : false) : false :=
begin
  have : x ≤ 1,
  interval_cases x,
  exact zero_le_one,  -- this solves the side-goal left by `interval_cases`, closing the `have`
  exact h,
end

/-
Sadly, this one doesn't work, reporting:
  `deep recursion was detected at 'expression equality test'`
-/
-- example (n : ℕ) (w₁ : n > 1000000) (w₁ : n < 1000002) : n < 2000000 :=
-- begin
--   interval_cases n,
--   norm_num,
-- end


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem amc12_2001_p2
  (a b n : ℕ)
  (h₀ : 1 ≤ a ∧ a ≤ 9)
  (h₁ : 0 ≤ b ∧ b ≤ 9)
  (h₂ : n = 10 * a + b)
  (h₃ : n = a * b + a + b) :
  b = 9 :=
begin
  simp [*] at *,
  nlinarith,
end


-- TODO: This is partly outdated.

import Structure.Basic
import Structure.SortStructure
import Structure.AbstractPiSigma

open StructureFunctor
open PiSigma

set_option autoBoundImplicitLocal false

universes u v

namespace TypeClasses

-- If `C` is a type class, we need to show that it is a functor in order to use our abstract framework.
-- We can do that by providing equivalences between `C α` and `D α`, where `D` is already known to be a
-- functor from `sortStructure` to `sortStructure`.

def TypeClass := Sort u → Sort v

def TypeClassEquiv (C D : TypeClass) := ∀ α, C α ≃ D α

@[reducible] def TypeClassFunctor := StructureFunctor sortStructure sortStructure

class StructuralTypeClass (C : TypeClass) where
(F : TypeClassFunctor)
(η : TypeClassEquiv C F.map)

def toTypeClassFunctor (C : TypeClass) [h : StructuralTypeClass C] : TypeClassFunctor :=
proxyFunctor C h.F h.η

-- A bundled instance of a type class is just a dependent pair. If the type class is a functor, we can
-- build a `SigmaExpr`, which has a structure.

def toStructureDependency {S : Structure} (F : StructureFunctor S sortStructure) : StructureDependency :=
⟨S, sortToStructureFunctor ⊙ F⟩

def bundledStructure (C : TypeClass) [h : StructuralTypeClass C] := SigmaExpr.sigmaStructure (toStructureDependency (toTypeClassFunctor C))

def bundled (C : TypeClass) [h : StructuralTypeClass C] (α : Sort u) (x : C α) : bundledStructure C := ⟨α, x⟩

def bundledType     {C : TypeClass} [h : StructuralTypeClass C] (S : bundledStructure C) : Sort u := S.fst
def bundledInstance {C : TypeClass} [h : StructuralTypeClass C] (S : bundledStructure C) : C S.fst  := S.snd

-- This lets us define isomorphism of two instances of a type class as equivalence of the corresponding
-- bundled structures.

def Isomorphism {C : TypeClass} [h : StructuralTypeClass C] (α : Sort u) (x : C α) (β : Sort u) (y : C β) :=
bundled C α x ≃ bundled C β y

-- From an isomorphism, we can recover the `Equiv` of the types and the condition on the instances.

def isoTypeEquiv {C : TypeClass} [h : StructuralTypeClass C] {α : Sort u} {x : C α} {β : Sort u} {y : C β} (e : Isomorphism α x β y) :
  α ≃ β :=
e.fst

def isoInstanceEquiv {C : TypeClass} [h : StructuralTypeClass C] {α : Sort u} {x : C α} {β : Sort u} {y : C β} (e : Isomorphism α x β y) :
  C α ≃ C β :=
congrArg (toTypeClassFunctor C) e.fst

theorem isoCondition {C : TypeClass} [h : StructuralTypeClass C] {α : Sort u} {x : C α} {β : Sort u} {y : C β} (e : Isomorphism α x β y) :
-- TODO: Write in terms of `congrArg D e.fst`.
  (isoInstanceEquiv e).toFun x = y :=
-- TODO: Need to undo `sortToStructureFunctor`.
sorry --e.snd

end TypeClasses


/-!
# Applicative Functors

Building on [Functors](functors.lean.md) is the [Applicative
Functor](https://en.wikipedia.org/wiki/Applicative_functor). For simplicity, you can refer to these
simply as "Applicatives". These are a little tricker than functors, but still simpler than monads.
Let's see how they work!

## What is an Applicative Functor?

An applicative functor defines a default or "base" construction for an object and allows
function application to be chained across multiple instances of the structure. All applicative
functors are functors, meaning they must also support the "map" operation.

## How are Applicatives represented in Lean?

An [applicative functor](https://en.wikipedia.org/wiki/Applicative_functor) is an intermediate
structure between `Functor` and `Monad`. It mainly consists of two operations:

* `pure : α → F α`
* `seq : F (α → β) → F α → F β` (written as `<*>`)

The `pure` operator specifies how you can wrap a normal object `α` into an instance of this structure `F α`.
This is the "default" mechanism mentioned above.

The `seq` operator allows you to chain operations by wrapping a function in a structure. The name
"applicative" comes from the fact that you "apply" functions from within the structure, rather than
simply from outside the structure, as was the case with `Functor.map`.

Applicative in Lean is built on some helper type classes, `Functor`, `Pure` and `Seq`:

-/
namespace hidden -- hidden
class Applicative (f : Type u → Type v) extends Functor f, Pure f, Seq f, SeqLeft f, SeqRight f where
  map      := fun x y => Seq.seq (pure x) fun _ => y
  seqLeft  := fun a b => Seq.seq (Functor.map (Function.const _) a) b
  seqRight := fun a b => Seq.seq (Functor.map (Function.const _ id) a) b
end hidden -- hidden
/-!
Notice that as with `Functor` it is also a type transformer `(f : Type u → Type v)` and notice the
`extends Functor f` is ensuring the base `Functor` also performs that same type transformation.

As stated above, all applicatives are then functors. This means you can assume that `map` already
exists for all these types.

The `Pure` base type class is a very simple type class that supplies the `pure` function.

-/
namespace hidden -- hidden
class Pure (f : Type u → Type v) where
   pure {α : Type u} : α → f α
end hidden -- hidden
/-!

You can think of it as lifting the result of a pure value to some monadic type. The simplest example
of `pure` is the `Option` type:

-/
#eval (pure 10 : Option Nat)  -- some 10
/-!

Here we used the `Option` implementation of `pure` to wrap the `Nat 10` value in an `Option Nat`
type resulting in the value `some 10`, and in fact if you look at the Monad instance of `Option` , you
will see that `pure` is indeed implemented using `Option.some`:

-/
instance : Monad Option where
    pure := Option.some
/-!

The `Seq` type class is also a simple type class that provides the `seq` operator which can
also be written using the special syntax `<*>`.

-/
namespace hidden -- hidden
class Seq (f : Type u → Type v) : Type (max (u+1) v) where
  seq : {α β : Type u} → f (α → β) → (Unit → f α) → f β
end hidden -- hidden
/-!

## Basic Applicative Examples

Many of the basic functors also have instances of `Applicative`.
For example, `Option` is also `Applicative`.

So let's take a look and what the `seq` operator can do.  Suppose you want to multiply two `Option Nat`
objects.  Your first attempt might be this:

-/
#check_failure (some 4) * (some 5)      -- failed to synthesize instance
/-!

You then might wonder how to use the `Functor.map` to solve this since you could do these before:

-/
#eval (some 4).map (fun x => x * 5)  -- some 20

#eval (some 4).map (· * 5)  -- some 20

#eval (· * 5) <$> (some 4)   -- some 20
/-!

Remember that `<$>` is the infix notation for `Functor.map`.

The functor `map` operation can apply a multiplication to the value in the `Option` and then lift the
result back up to become a new `Option` , but this isn't what you need here.

The `Seq.seq` operator `<*>` can help since it can apply a function to the items inside a
container and then lift the result back up to the desired type, namely `Option` .

There are two ways to do this:

-/
#eval pure (.*.) <*> some 4 <*> some 5 -- some 20

#eval (.*.) <$> some 4 <*> some 5 -- some 20
/-!

In the first way, we start off by wrapping the function in an applicative using pure. Then we apply
this to the first `Option` , and again to the second `Option`  in a chain of operations.  So  you can see
how `Seq.seq` can be chained in fact, `Seq.seq` is really all about chaining of operations.

But in this case there is a simpler way.  In the second way, you can see that "applying" a single
function to a container is the same as using `Functor.map`. So you use `<$>` to "transform" the first
option into an `Option` containing a function, and then apply this function over the second value.

Now if either side is `none`, the result is `none`, as expected, and in this case the
`seq` operator was able to eliminate the multiplication:

-/
#eval (.*.) <$> none <*> some 5  -- none
#eval (.*.) <$> some 4 <*> none  -- none
/-!

For a more interesting example, let's make `List` an applicative by adding the following
definition:

-/
instance : Applicative List where
  pure := List.pure
  seq f x := List.bind f fun y => Functor.map y (x ())
/-!

Notice you can now sequence a _list_ of functions and a _list_ of items.
The trivial case of sequencing a singleton list is in fact the same as `map`, as you saw
earlier with the `Option`  examples:

-/
#eval [ (·+2)] <*> [4, 6] -- [6, 8]
#eval (·+2) <$> [4,6]    -- [6, 8]
/-!

But now with list it is easier to show the difference when you do this:

-/
#eval [(·+2), (· *3)] <*> [4, 6] -- [6, 8, 12, 18]
/-!

Why did this produce 4 values?  The reason is because `<*>` applies _every_ function to _every_
value in a pairwise manner.  This makes sequence really convenient for solving certain problems. For
example, how do you get the pairwise combinations of all values from two lists?

-/
#eval Prod.mk <$> [1, 2, 3] <*> [4, 5, 6]
-- [(1, 4), (1, 5), (1, 6), (2, 4), (2, 5), (2, 6), (3, 4), (3, 5), (3, 6)]
/-!

How do you get the sum of these pairwise values?
-/
#eval (·+·) <$> [1, 2, 3] <*> [4, 5, 6]
-- [5, 6, 7, 6, 7, 8, 7, 8, 9]
/-!

Here you can use `<$>` to "transform" each element of the first list into a function, and then apply
these functions over the second list.

If you have 3 lists, and want to find all combinations of 3 values across those lists you
would need helper function that can create a tuple out of 3 values, and Lean provides a
very convenient syntax for that `(·,·,·)`:

-/
#eval (·,·,·) <$> [1, 2] <*> [3, 4] <*> [5, 6]
-- [(1, 3, 5), (1, 3, 6), (1, 4, 5), (1, 4, 6), (2, 3, 5), (2, 3, 6), (2, 4, 5), (2, 4, 6)]
/-!

And you could sum these combinations if you first define a sum function that takes three inputs and
then you could chain apply this over the three lists.  Again lean can create such a function
with the expression `(·+·+·)`:

-/
#eval (·+·+·) <$> [1, 2] <*> [3, 4] <*> [5, 6]
-- [9, 10, 10, 11, 10, 11, 11, 12]
/-!

And indeed each sum here matches the expected values if you manually sum the triples we
show above.

**Side note:** there is another way to combine lists with a function that does not do the pairwise
combinatorics, it is called `List.zipWith`:

-/
#eval List.zipWith (·+·) [1, 2, 3] [4, 5, 6]
-- [5, 7, 9]
/-!

And there is a helper function named `List.zip` that calls `zipWith` using the function `Prod.mk`
so you get a nice zipped list like this:

-/
#eval List.zip [1, 2, 3] [4, 5, 6]
-- [(1, 4), (2, 5), (3, 6)]
/-!

And of couse, as you would expect, there is an `unzip` also:

-/
#eval List.unzip (List.zip [1, 2, 3] [4, 5, 6])
-- ([1, 2, 3], [4, 5, 6])
/-!

## Example: A Functor that is not Applicative

From the chapter on [functors](functors.lean.md) you might remember this example of `LivingSpace`
that had a `Functor` instance:

-/
structure LivingSpace (α : Type) where
  totalSize : α
  numBedrooms : Nat
  masterBedroomSize : α
  livingRoomSize : α
  kitchenSize : α
  deriving Repr, BEq

def LivingSpace.map (f : α → β) (s : LivingSpace α) : LivingSpace β :=
  { totalSize := f s.totalSize
    numBedrooms := s.numBedrooms
    masterBedroomSize := f s.masterBedroomSize
    livingRoomSize := f s.livingRoomSize
    kitchenSize := f s.kitchenSize }

instance : Functor LivingSpace where
  map := LivingSpace.map
/-!

It wouldn't really make sense to make an `Applicative` instance here. How would you write `pure` in
the `Applicative` instance? By taking a single value and plugging it in for total size _and_ the
master bedroom size _and_ the living room size? That wouldn't really make sense. And what would the
numBedrooms value be for the default? What would it mean to "chain" two of these objects together?

If you can't answer these questions very well, then it suggests this type isn't really an
Applicative functor.

## SeqLeft and SeqRight

You may remember seeing the `SeqLeft` and `SeqRight` base types on `class Applicative` earlier.
These provide the `seqLeft` and `seqRight` operations which also have some handy notation
shorthands `<*` and `*>` respectively. Where: `x <* y` evaluates `x`, then `y`, and returns the
result of `x` and `x *> y` evaluates `x`, then `y`,  and returns the result of `y`.

To make it easier to remember, notice that it returns that value that the `<*` or `*>` notation is
pointing at.  For example:

-/
#eval (some 1) *> (some 2) -- Some 2
#eval (some 1) <* (some 2) -- Some 1
/-!

So these are a kind of "discard" operation.  Run all the actions, but only return the values that you
care about. It will be easier to see these in action when you get to full Monads, but they are used
heavily in the Lean `Parsec` parser combinator library where you will find parsing functions like
this one which parses the XML declaration `<?xml version="1.0" encoding='utf-8' standalone="yes">`:

```lean
def XMLdecl : Parsec Unit := do
  skipString "<?xml"
  VersionInfo
  optional EncodingDecl *> optional SDDecl *> optional S *> skipString "?>"
```

But you will need to understand full Monads before this will make sense.

## Lazy Evaluation

Diving a bit deeper, (you can skip this and jump to the [Applicative
Laws](laws.lean.md#what-are-the-applicative-laws) if don't want to dive into this implementation detail right
now). But, if you write a simple `Option` example `(.*.) <$> some 4 <*> some 5` that produces `some 20`
using `Seq.seq` you will see somthing interesting:

-/
#eval Seq.seq ((.*.) <$> some 4) (fun (_ : Unit) => some 5) -- some 20
/-!

This may look a bit cumbersome, specifically, why did we need to invent this funny looking function
`fun (_ : Unit) => (some 5)`?

Well if you take a close look at the type class definition:
```lean
class Seq (f : Type u → Type v) where
  seq : {α β : Type u} → f (α → β) → (Unit → f α) → f β
```

You will see this function defined here: `(Unit → f α)`, this is a function that takes `Unit` as input
and produces the output of type `f α` where `f` is the container type `Type u -> Type v`, in this example `Option`
and `α` is the element type `Nat`, so `fun (_ : Unit) => some 5` matches this definition because
it is taking an input of type Unit and producing `some 5` which is type `Option Nat`.

The that `seq` is defined this way is because Lean is an eagerly evaluated language
(call-by-value), you have to use this kind of Unit function whenever you want to explicitly delay
evaluation and `seq` wants that so it can eliminate unnecessary function evaluations whenever
possible.

Fortunately the `<*>` infix notation hides this from you by creating this wrapper function for you.
If you look up the notation using F12 in VS Code you will find it contains `(fun _ : Unit => b)`.

Now to complete this picture you will find the default implementation of `seq` on the Lean `Monad`
type class:

```lean
class Monad (m : Type u → Type v) extends Applicative m, Bind m where
  seq      f x := bind f fun y => Functor.map y (x ())
```

Notice here that `x` is the `(Unit → f α)` function, and it is calling that function by passing the
Unit value `()`, which is the Unit value (Unit.unit).  All this just to ensure delayed evaluation.

## How do Applicatives help with Monads?

Applicatives are helpful for the same reasons as functors. They're a relatively simple abstract
structure that has practical applications in your code. Now that you understand how chaining
operations can fit into a structure definition, you're in a good position to start learning about
[Monads](monads.lean.md)!
-/


/-
Copyright (c) 2014 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Floris van Doorn
-/
import .basic
import logic.cast
open function
open category eq eq.ops heq

structure functor (C D : Category) : Type :=
  (object : C → D)
  (morphism : Π⦃a b : C⦄, hom a b → hom (object a) (object b))
  (respect_id : Π (a : C), morphism (ID a) = ID (object a))
  (respect_comp : Π ⦃a b c : C⦄ (g : hom b c) (f : hom a b),
      morphism (g ∘ f) = morphism g ∘ morphism f)

infixl `⇒`:25 := functor

namespace functor
  attribute object [coercion]
  attribute morphism [coercion]
  attribute respect_id [irreducible]
  attribute respect_comp [irreducible]

  variables {A B C D : Category}

  protected definition compose [reducible] (G : functor B C) (F : functor A B) : functor A C :=
  functor.mk
    (λx, G (F x))
    (λ a b f, G (F f))
    (λ a, proof calc
      G (F (ID a)) = G id : {respect_id F a}
      --not giving the braces explicitly makes the elaborator compute a couple more seconds
               ... = id   : respect_id G (F a) qed)
    (λ a b c g f, proof calc
      G (F (g ∘ f)) = G (F g ∘ F f)     : respect_comp F g f
                ... = G (F g) ∘ G (F f) : respect_comp G (F g) (F f) qed)

  infixr `∘f`:60 := functor.compose

  protected theorem assoc (H : functor C D) (G : functor B C) (F : functor A B) :
      H ∘f (G ∘f F) = (H ∘f G) ∘f F :=
  rfl

  protected definition id [reducible] {C : Category} : functor C C :=
  mk (λa, a) (λ a b f, f) (λ a, rfl) (λ a b c f g, rfl)
  protected definition ID [reducible] (C : Category) : functor C C := @functor.id C

  protected theorem id_left  (F : functor C D) : (@functor.id D) ∘f F = F :=
  functor.rec (λ obF homF idF compF, dcongr_arg4 mk rfl rfl !proof_irrel !proof_irrel) F
  protected theorem id_right (F : functor C D) : F ∘f (@functor.id C) = F :=
  functor.rec (λ obF homF idF compF, dcongr_arg4 mk rfl rfl !proof_irrel !proof_irrel) F

end functor

namespace category
  open functor
  definition category_of_categories [reducible] : category Category :=
  mk (λ a b, functor a b)
     (λ a b c g f, functor.compose g f)
     (λ a, functor.id)
     (λ a b c d h g f, !functor.assoc)
     (λ a b f, !functor.id_left)
     (λ a b f, !functor.id_right)

  definition Category_of_categories [reducible] := Mk category_of_categories

  namespace ops
    notation `Cat`:max := Category_of_categories
    attribute category_of_categories [instance]
  end ops
end category

namespace functor

   variables {C D : Category}

  theorem mk_heq {obF obG : C → D} {homF homG idF idG compF compG} (Hob : ∀x, obF x = obG x)
     (Hmor : ∀(a b : C) (f : a ⟶ b), homF a b f == homG a b f)
       : mk obF homF idF compF = mk obG homG idG compG :=
  hddcongr_arg4 mk
              (funext Hob)
              (hfunext (λ a, hfunext (λ b, hfunext (λ f, !Hmor))))
              !proof_irrel
              !proof_irrel

  protected theorem hequal {F G : C ⇒ D} : Π (Hob : ∀x, F x = G x)
      (Hmor : ∀a b (f : a ⟶ b), F f == G f), F = G :=
  functor.rec
    (λ obF homF idF compF,
      functor.rec
        (λ obG homG idG compG Hob Hmor, mk_heq Hob Hmor)
      G)
    F

--   theorem mk_eq {obF obG : C → D} {homF homG idF idG compF compG} (Hob : ∀x, obF x = obG x)
--      (Hmor : ∀(a b : C) (f : a ⟶ b), cast (congr_arg (λ x, x a ⟶ x b) (funext Hob)) (homF a b f)
--                                        = homG a b f)
--        : mk obF homF idF compF = mk obG homG idG compG :=
--   dcongr_arg4 mk
--               (funext Hob)
--               (funext (λ a, funext (λ b, funext (λ f, sorry ⬝ Hmor a b f))))
-- -- to fill this sorry use (a generalization of) cast_pull
--               !proof_irrel
--               !proof_irrel

--   protected theorem equal {F G : C ⇒ D} : Π (Hob : ∀x, F x = G x)
--       (Hmor : ∀a b (f : a ⟶ b), cast (congr_arg (λ x, x a ⟶ x b) (funext Hob)) (F f) = G f), F = G :=
--   functor.rec
--     (λ obF homF idF compF,
--       functor.rec
--         (λ obG homG idG compG Hob Hmor, mk_eq Hob Hmor)
--       G)
--     F

end functor


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

import measure_theory.function.l1_space
import analysis.normed_space.indicator_function

/-! # Functions integrable on a set and at a filter

We define `integrable_on f s μ := integrable f (μ.restrict s)` and prove theorems like
`integrable_on_union : integrable_on f (s ∪ t) μ ↔ integrable_on f s μ ∧ integrable_on f t μ`.

Next we define a predicate `integrable_at_filter (f : α → E) (l : filter α) (μ : measure α)`
saying that `f` is integrable at some set `s ∈ l` and prove that a measurable function is integrable
at `l` with respect to `μ` provided that `f` is bounded above at `l ⊓ μ.ae` and `μ` is finite
at `l`.

-/

noncomputable theory
open set filter topological_space measure_theory function
open_locale classical topological_space interval big_operators filter ennreal measure_theory

variables {α β E F : Type*} [measurable_space α]

section

variables [topological_space β] {l l' : filter α} {f g : α → β} {μ ν : measure α}

/-- A function `f` is strongly measurable at a filter `l` w.r.t. a measure `μ` if it is
ae strongly measurable w.r.t. `μ.restrict s` for some `s ∈ l`. -/
def strongly_measurable_at_filter (f : α → β) (l : filter α) (μ : measure α . volume_tac) :=
∃ s ∈ l, ae_strongly_measurable f (μ.restrict s)

@[simp] lemma strongly_measurable_at_bot {f : α → β} : strongly_measurable_at_filter f ⊥ μ :=
⟨∅, mem_bot, by simp⟩

protected lemma strongly_measurable_at_filter.eventually (h : strongly_measurable_at_filter f l μ) :
  ∀ᶠ s in l.small_sets, ae_strongly_measurable f (μ.restrict s) :=
(eventually_small_sets' $ λ s t, ae_strongly_measurable.mono_set).2 h

protected lemma strongly_measurable_at_filter.filter_mono
  (h : strongly_measurable_at_filter f l μ) (h' : l' ≤ l) :
  strongly_measurable_at_filter f l' μ :=
let ⟨s, hsl, hs⟩ := h in ⟨s, h' hsl, hs⟩

protected lemma measure_theory.ae_strongly_measurable.strongly_measurable_at_filter
  (h : ae_strongly_measurable f μ) :
  strongly_measurable_at_filter f l μ :=
⟨univ, univ_mem, by rwa measure.restrict_univ⟩

lemma ae_strongly_measurable.strongly_measurable_at_filter_of_mem
  {s} (h : ae_strongly_measurable f (μ.restrict s)) (hl : s ∈ l) :
  strongly_measurable_at_filter f l μ :=
⟨s, hl, h⟩

protected lemma measure_theory.strongly_measurable.strongly_measurable_at_filter
  (h : strongly_measurable f) :
  strongly_measurable_at_filter f l μ :=
h.ae_strongly_measurable.strongly_measurable_at_filter

end

namespace measure_theory

section normed_group

lemma has_finite_integral_restrict_of_bounded [normed_group E] {f : α → E} {s : set α}
  {μ : measure α} {C}  (hs : μ s < ∞) (hf : ∀ᵐ x ∂(μ.restrict s), ∥f x∥ ≤ C) :
  has_finite_integral f (μ.restrict s) :=
by haveI : is_finite_measure (μ.restrict s) := ⟨by rwa [measure.restrict_apply_univ]⟩;
  exact has_finite_integral_of_bounded hf

variables [normed_group E] {f g : α → E} {s t : set α} {μ ν : measure α}

/-- A function is `integrable_on` a set `s` if it is almost everywhere strongly measurable on `s`
and if the integral of its pointwise norm over `s` is less than infinity. -/
def integrable_on (f : α → E) (s : set α) (μ : measure α . volume_tac) : Prop :=
integrable f (μ.restrict s)

lemma integrable_on.integrable (h : integrable_on f s μ) :
  integrable f (μ.restrict s) := h

@[simp] lemma integrable_on_empty : integrable_on f ∅ μ :=
by simp [integrable_on, integrable_zero_measure]

@[simp] lemma integrable_on_univ : integrable_on f univ μ ↔ integrable f μ :=
by rw [integrable_on, measure.restrict_univ]

lemma integrable_on_zero : integrable_on (λ _, (0:E)) s μ := integrable_zero _ _ _

@[simp] lemma integrable_on_const {C : E} : integrable_on (λ _, C) s μ ↔ C = 0 ∨ μ s < ∞ :=
integrable_const_iff.trans $ by rw [measure.restrict_apply_univ]

lemma integrable_on.mono (h : integrable_on f t ν) (hs : s ⊆ t) (hμ : μ ≤ ν) :
  integrable_on f s μ :=
h.mono_measure $ measure.restrict_mono hs hμ

lemma integrable_on.mono_set (h : integrable_on f t μ) (hst : s ⊆ t) :
  integrable_on f s μ :=
h.mono hst le_rfl

lemma integrable_on.mono_measure (h : integrable_on f s ν) (hμ : μ ≤ ν) :
  integrable_on f s μ :=
h.mono (subset.refl _) hμ

lemma integrable_on.mono_set_ae (h : integrable_on f t μ) (hst : s ≤ᵐ[μ] t) :
  integrable_on f s μ :=
h.integrable.mono_measure $ measure.restrict_mono_ae hst

lemma integrable_on.congr_set_ae (h : integrable_on f t μ) (hst : s =ᵐ[μ] t) :
  integrable_on f s μ :=
h.mono_set_ae hst.le

lemma integrable_on.congr_fun' (h : integrable_on f s μ) (hst : f =ᵐ[μ.restrict s] g) :
  integrable_on g s μ :=
integrable.congr h hst

lemma integrable_on.congr_fun (h : integrable_on f s μ) (hst : eq_on f g s)
  (hs : measurable_set s) :
  integrable_on g s μ :=
h.congr_fun' ((ae_restrict_iff' hs).2 (eventually_of_forall hst))

lemma integrable.integrable_on (h : integrable f μ) : integrable_on f s μ :=
h.mono_measure $ measure.restrict_le_self

lemma integrable.integrable_on' (h : integrable f (μ.restrict s)) : integrable_on f s μ :=
h

lemma integrable_on.restrict (h : integrable_on f s μ) (hs : measurable_set s) :
  integrable_on f s (μ.restrict t) :=
by { rw [integrable_on, measure.restrict_restrict hs], exact h.mono_set (inter_subset_left _ _) }

lemma integrable_on.left_of_union (h : integrable_on f (s ∪ t) μ) : integrable_on f s μ :=
h.mono_set $ subset_union_left _ _

lemma integrable_on.right_of_union (h : integrable_on f (s ∪ t) μ) : integrable_on f t μ :=
h.mono_set $ subset_union_right _ _

lemma integrable_on.union (hs : integrable_on f s μ) (ht : integrable_on f t μ) :
  integrable_on f (s ∪ t) μ :=
(hs.add_measure ht).mono_measure $ measure.restrict_union_le _ _

@[simp] lemma integrable_on_union :
  integrable_on f (s ∪ t) μ ↔ integrable_on f s μ ∧ integrable_on f t μ :=
⟨λ h, ⟨h.left_of_union, h.right_of_union⟩, λ h, h.1.union h.2⟩

@[simp] lemma integrable_on_singleton_iff {x : α} [measurable_singleton_class α] :
  integrable_on f {x} μ ↔ f x = 0 ∨ μ {x} < ∞ :=
begin
  have : f =ᵐ[μ.restrict {x}] (λ y, f x),
  { filter_upwards [ae_restrict_mem (measurable_set_singleton x)] with _ ha,
    simp only [mem_singleton_iff.1 ha], },
  rw [integrable_on, integrable_congr this, integrable_const_iff],
  simp,
end

@[simp] lemma integrable_on_finite_Union {s : set β} (hs : s.finite)
  {t : β → set α} : integrable_on f (⋃ i ∈ s, t i) μ ↔ ∀ i ∈ s, integrable_on f (t i) μ :=
begin
  apply hs.induction_on,
  { simp },
  { intros a s ha hs hf, simp [hf, or_imp_distrib, forall_and_distrib] }
end

@[simp] lemma integrable_on_finset_Union {s : finset β} {t : β → set α} :
  integrable_on f (⋃ i ∈ s, t i) μ ↔ ∀ i ∈ s, integrable_on f (t i) μ :=
integrable_on_finite_Union s.finite_to_set

@[simp] lemma integrable_on_fintype_Union [fintype β] {t : β → set α} :
  integrable_on f (⋃ i, t i) μ ↔ ∀ i, integrable_on f (t i) μ :=
by simpa using @integrable_on_finset_Union _ _ _ _ _ f μ finset.univ t

lemma integrable_on.add_measure (hμ : integrable_on f s μ) (hν : integrable_on f s ν) :
  integrable_on f s (μ + ν) :=
by { delta integrable_on, rw measure.restrict_add, exact hμ.integrable.add_measure hν }

@[simp] lemma integrable_on_add_measure :
  integrable_on f s (μ + ν) ↔ integrable_on f s μ ∧ integrable_on f s ν :=
⟨λ h, ⟨h.mono_measure (measure.le_add_right le_rfl),
  h.mono_measure (measure.le_add_left le_rfl)⟩,
  λ h, h.1.add_measure h.2⟩

lemma _root_.measurable_embedding.integrable_on_map_iff [measurable_space β] {e : α → β}
  (he : measurable_embedding e) {f : β → E} {μ : measure α} {s : set β} :
  integrable_on f s (measure.map e μ) ↔ integrable_on (f ∘ e) (e ⁻¹' s) μ :=
by simp only [integrable_on, he.restrict_map, he.integrable_map_iff]

lemma integrable_on_map_equiv [measurable_space β] (e : α ≃ᵐ β) {f : β → E} {μ : measure α}
  {s : set β} :
  integrable_on f s (measure.map e μ) ↔ integrable_on (f ∘ e) (e ⁻¹' s) μ :=
by simp only [integrable_on, e.restrict_map, integrable_map_equiv e]

lemma measure_preserving.integrable_on_comp_preimage [measurable_space β] {e : α → β} {ν}
  (h₁ : measure_preserving e μ ν) (h₂ : measurable_embedding e) {f : β → E} {s : set β} :
  integrable_on (f ∘ e) (e ⁻¹' s) μ ↔ integrable_on f s ν :=
(h₁.restrict_preimage_emb h₂ s).integrable_comp_emb h₂

lemma measure_preserving.integrable_on_image [measurable_space β] {e : α → β} {ν}
  (h₁ : measure_preserving e μ ν) (h₂ : measurable_embedding e) {f : β → E} {s : set α} :
  integrable_on f (e '' s) ν ↔  integrable_on (f ∘ e) s μ :=
((h₁.restrict_image_emb h₂ s).integrable_comp_emb h₂).symm

lemma integrable_indicator_iff (hs : measurable_set s) :
  integrable (indicator s f) μ ↔ integrable_on f s μ :=
by simp [integrable_on, integrable, has_finite_integral, nnnorm_indicator_eq_indicator_nnnorm,
  ennreal.coe_indicator, lintegral_indicator _ hs, ae_strongly_measurable_indicator_iff hs]

lemma integrable_on.indicator (h : integrable_on f s μ) (hs : measurable_set s) :
  integrable (indicator s f) μ :=
(integrable_indicator_iff hs).2 h

lemma integrable.indicator (h : integrable f μ) (hs : measurable_set s) :
  integrable (indicator s f) μ :=
h.integrable_on.indicator hs

lemma integrable_indicator_const_Lp {E} [normed_group E]
  {p : ℝ≥0∞} {s : set α} (hs : measurable_set s) (hμs : μ s ≠ ∞) (c : E) :
  integrable (indicator_const_Lp p hs hμs c) μ :=
begin
  rw [integrable_congr indicator_const_Lp_coe_fn, integrable_indicator_iff hs, integrable_on,
    integrable_const_iff, lt_top_iff_ne_top],
  right,
  simpa only [set.univ_inter, measurable_set.univ, measure.restrict_apply] using hμs,
end

lemma integrable_on_iff_integable_of_support_subset {f : α → E} {s : set α}
  (h1s : support f ⊆ s) (h2s : measurable_set s) :
  integrable_on f s μ ↔ integrable f μ :=
begin
  refine ⟨λ h, _, λ h, h.integrable_on⟩,
  rwa [← indicator_eq_self.2 h1s, integrable_indicator_iff h2s]
end

lemma integrable_on_Lp_of_measure_ne_top {E} [normed_group E]
  {p : ℝ≥0∞} {s : set α} (f : Lp E p μ) (hp : 1 ≤ p) (hμs : μ s ≠ ∞) :
  integrable_on f s μ :=
begin
  refine mem_ℒp_one_iff_integrable.mp _,
  have hμ_restrict_univ : (μ.restrict s) set.univ < ∞,
    by simpa only [set.univ_inter, measurable_set.univ, measure.restrict_apply, lt_top_iff_ne_top],
  haveI hμ_finite : is_finite_measure (μ.restrict s) := ⟨hμ_restrict_univ⟩,
  exact ((Lp.mem_ℒp _).restrict s).mem_ℒp_of_exponent_le hp,
end

/-- We say that a function `f` is *integrable at filter* `l` if it is integrable on some
set `s ∈ l`. Equivalently, it is eventually integrable on `s` in `l.small_sets`. -/
def integrable_at_filter (f : α → E) (l : filter α) (μ : measure α . volume_tac) :=
∃ s ∈ l, integrable_on f s μ

variables {l l' : filter α}

protected lemma integrable_at_filter.eventually (h : integrable_at_filter f l μ) :
  ∀ᶠ s in l.small_sets, integrable_on f s μ :=
iff.mpr (eventually_small_sets' $ λ s t hst ht, ht.mono_set hst) h

lemma integrable_at_filter.filter_mono (hl : l ≤ l') (hl' : integrable_at_filter f l' μ) :
  integrable_at_filter f l μ :=
let ⟨s, hs, hsf⟩ := hl' in ⟨s, hl hs, hsf⟩

lemma integrable_at_filter.inf_of_left (hl : integrable_at_filter f l μ) :
  integrable_at_filter f (l ⊓ l') μ :=
hl.filter_mono inf_le_left

lemma integrable_at_filter.inf_of_right (hl : integrable_at_filter f l μ) :
  integrable_at_filter f (l' ⊓ l) μ :=
hl.filter_mono inf_le_right

@[simp] lemma integrable_at_filter.inf_ae_iff {l : filter α} :
  integrable_at_filter f (l ⊓ μ.ae) μ ↔ integrable_at_filter f l μ :=
begin
  refine ⟨_, λ h, h.filter_mono inf_le_left⟩,
  rintros ⟨s, ⟨t, ht, u, hu, rfl⟩, hf⟩,
  refine ⟨t, ht, _⟩,
  refine hf.integrable.mono_measure (λ v hv, _),
  simp only [measure.restrict_apply hv],
  refine measure_mono_ae (mem_of_superset hu $ λ x hx, _),
  exact λ ⟨hv, ht⟩, ⟨hv, ⟨ht, hx⟩⟩
end

alias integrable_at_filter.inf_ae_iff ↔ measure_theory.integrable_at_filter.of_inf_ae _

/-- If `μ` is a measure finite at filter `l` and `f` is a function such that its norm is bounded
above at `l`, then `f` is integrable at `l`. -/
lemma measure.finite_at_filter.integrable_at_filter {l : filter α} [is_measurably_generated l]
  (hfm : strongly_measurable_at_filter f l μ) (hμ : μ.finite_at_filter l)
  (hf : l.is_bounded_under (≤) (norm ∘ f)) :
  integrable_at_filter f l μ :=
begin
  obtain ⟨C, hC⟩ : ∃ C, ∀ᶠ s in l.small_sets, ∀ x ∈ s, ∥f x∥ ≤ C,
    from hf.imp (λ C hC, eventually_small_sets.2 ⟨_, hC, λ t, id⟩),
  rcases (hfm.eventually.and (hμ.eventually.and hC)).exists_measurable_mem_of_small_sets
    with ⟨s, hsl, hsm, hfm, hμ, hC⟩,
  refine ⟨s, hsl, ⟨hfm, has_finite_integral_restrict_of_bounded hμ _⟩⟩,
  exact C,
  rw [ae_restrict_eq hsm, eventually_inf_principal],
  exact eventually_of_forall hC
end

lemma measure.finite_at_filter.integrable_at_filter_of_tendsto_ae
  {l : filter α} [is_measurably_generated l] (hfm : strongly_measurable_at_filter f l μ)
  (hμ : μ.finite_at_filter l) {b} (hf : tendsto f (l ⊓ μ.ae) (𝓝 b)) :
  integrable_at_filter f l μ :=
(hμ.inf_of_left.integrable_at_filter (hfm.filter_mono inf_le_left)
  hf.norm.is_bounded_under_le).of_inf_ae

alias measure.finite_at_filter.integrable_at_filter_of_tendsto_ae ←
  filter.tendsto.integrable_at_filter_ae

lemma measure.finite_at_filter.integrable_at_filter_of_tendsto {l : filter α}
  [is_measurably_generated l] (hfm : strongly_measurable_at_filter f l μ)
  (hμ : μ.finite_at_filter l) {b} (hf : tendsto f l (𝓝 b)) :
  integrable_at_filter f l μ :=
hμ.integrable_at_filter hfm hf.norm.is_bounded_under_le

alias measure.finite_at_filter.integrable_at_filter_of_tendsto ← filter.tendsto.integrable_at_filter

lemma integrable_add_of_disjoint {f g : α → E}
  (h : disjoint (support f) (support g)) (hf : strongly_measurable f) (hg : strongly_measurable g) :
  integrable (f + g) μ ↔ integrable f μ ∧ integrable g μ :=
begin
  refine ⟨λ hfg, ⟨_, _⟩, λ h, h.1.add h.2⟩,
  { rw ← indicator_add_eq_left h, exact hfg.indicator hf.measurable_set_support },
  { rw ← indicator_add_eq_right h, exact hfg.indicator hg.measurable_set_support }
end

end normed_group

end measure_theory

open measure_theory

variables [normed_group E]

/-- A function which is continuous on a set `s` is almost everywhere measurable with respect to
`μ.restrict s`. -/
lemma continuous_on.ae_measurable [topological_space α] [opens_measurable_space α]
  [measurable_space β] [topological_space β] [borel_space β]
  {f : α → β} {s : set α} {μ : measure α} (hf : continuous_on f s) (hs : measurable_set s) :
  ae_measurable f (μ.restrict s) :=
begin
  nontriviality α, inhabit α,
  have : piecewise s f (λ _, f default) =ᵐ[μ.restrict s] f := piecewise_ae_eq_restrict hs,
  refine ⟨piecewise s f (λ _, f default), _, this.symm⟩,
  apply measurable_of_is_open,
  assume t ht,
  obtain ⟨u, u_open, hu⟩ : ∃ (u : set α), is_open u ∧ f ⁻¹' t ∩ s = u ∩ s :=
    _root_.continuous_on_iff'.1 hf t ht,
  rw [piecewise_preimage, set.ite, hu],
  exact (u_open.measurable_set.inter hs).union ((measurable_const ht.measurable_set).diff hs)
end

/-- A function which is continuous on a separable set `s` is almost everywhere strongly measurable
with respect to `μ.restrict s`. -/
lemma continuous_on.ae_strongly_measurable_of_is_separable
  [topological_space α] [pseudo_metrizable_space α] [opens_measurable_space α]
  [topological_space β] [pseudo_metrizable_space β]
  {f : α → β} {s : set α} {μ : measure α} (hf : continuous_on f s) (hs : measurable_set s)
  (h's : topological_space.is_separable s) :
  ae_strongly_measurable f (μ.restrict s) :=
begin
  letI := pseudo_metrizable_space_pseudo_metric α,
  borelize β,
  rw ae_strongly_measurable_iff_ae_measurable_separable,
  refine ⟨hf.ae_measurable hs, f '' s, hf.is_separable_image h's, _⟩,
  exact mem_of_superset (self_mem_ae_restrict hs) (subset_preimage_image _ _),
end

/-- A function which is continuous on a set `s` is almost everywhere strongly measurable with
respect to `μ.restrict s` when either the source space or the target space is second-countable. -/
lemma continuous_on.ae_strongly_measurable
  [topological_space α] [topological_space β] [h : second_countable_topology_either α β]
  [opens_measurable_space α] [pseudo_metrizable_space β]
  {f : α → β} {s : set α} {μ : measure α} (hf : continuous_on f s) (hs : measurable_set s) :
  ae_strongly_measurable f (μ.restrict s) :=
begin
  borelize β,
  refine ae_strongly_measurable_iff_ae_measurable_separable.2 ⟨hf.ae_measurable hs, f '' s, _,
    mem_of_superset (self_mem_ae_restrict hs) (subset_preimage_image _ _)⟩,
  casesI h.out,
  { let f' : s → β := s.restrict f,
    have A : continuous f' := continuous_on_iff_continuous_restrict.1 hf,
    have B : is_separable (univ : set s) := is_separable_of_separable_space _,
    convert is_separable.image B A using 1,
    ext x,
    simp },
  { exact is_separable_of_separable_space _ }
end

lemma continuous_on.integrable_at_nhds_within_of_is_separable
  [topological_space α] [pseudo_metrizable_space α]
  [opens_measurable_space α] {μ : measure α} [is_locally_finite_measure μ]
  {a : α} {t : set α} {f : α → E} (hft : continuous_on f t) (ht : measurable_set t)
  (h't : topological_space.is_separable t) (ha : a ∈ t) :
  integrable_at_filter f (𝓝[t] a) μ :=
begin
  haveI : (𝓝[t] a).is_measurably_generated := ht.nhds_within_is_measurably_generated _,
  exact (hft a ha).integrable_at_filter ⟨_, self_mem_nhds_within,
    hft.ae_strongly_measurable_of_is_separable ht h't⟩ (μ.finite_at_nhds_within _ _),
end

lemma continuous_on.integrable_at_nhds_within
  [topological_space α] [second_countable_topology_either α E]
  [opens_measurable_space α] {μ : measure α} [is_locally_finite_measure μ]
  {a : α} {t : set α} {f : α → E} (hft : continuous_on f t) (ht : measurable_set t) (ha : a ∈ t) :
  integrable_at_filter f (𝓝[t] a) μ :=
begin
  haveI : (𝓝[t] a).is_measurably_generated := ht.nhds_within_is_measurably_generated _,
  exact (hft a ha).integrable_at_filter ⟨_, self_mem_nhds_within, hft.ae_strongly_measurable ht⟩
    (μ.finite_at_nhds_within _ _),
end

/-- If a function is continuous on an open set `s`, then it is strongly measurable at the filter
`𝓝 x` for all `x ∈ s` if either the source space or the target space is second-countable. -/
lemma continuous_on.strongly_measurable_at_filter [topological_space α]
  [opens_measurable_space α] [topological_space β] [pseudo_metrizable_space β]
  [second_countable_topology_either α β] {f : α → β} {s : set α} {μ : measure α}
  (hs : is_open s) (hf : continuous_on f s) :
  ∀ x ∈ s, strongly_measurable_at_filter f (𝓝 x) μ :=
λ x hx, ⟨s, is_open.mem_nhds hs hx, hf.ae_strongly_measurable hs.measurable_set⟩

lemma continuous_at.strongly_measurable_at_filter
  [topological_space α] [opens_measurable_space α] [second_countable_topology_either α E]
  {f : α → E} {s : set α} {μ : measure α} (hs : is_open s) (hf : ∀ x ∈ s, continuous_at f x) :
  ∀ x ∈ s, strongly_measurable_at_filter f (𝓝 x) μ :=
continuous_on.strongly_measurable_at_filter hs $ continuous_at.continuous_on hf

lemma continuous.strongly_measurable_at_filter [topological_space α] [opens_measurable_space α]
  [topological_space β] [pseudo_metrizable_space β] [second_countable_topology_either α β]
  {f : α → β} (hf : continuous f) (μ : measure α) (l : filter α) :
  strongly_measurable_at_filter f l μ :=
hf.strongly_measurable.strongly_measurable_at_filter

/-- If a function is continuous on a measurable set `s`, then it is measurable at the filter
  `𝓝[s] x` for all `x`. -/
lemma continuous_on.strongly_measurable_at_filter_nhds_within {α β : Type*} [measurable_space α]
  [topological_space α] [opens_measurable_space α] [topological_space β] [pseudo_metrizable_space β]
  [second_countable_topology_either α β] {f : α → β} {s : set α} {μ : measure α}
  (hf : continuous_on f s) (hs : measurable_set s) (x : α) :
  strongly_measurable_at_filter f (𝓝[s] x) μ :=
⟨s, self_mem_nhds_within, hf.ae_strongly_measurable hs⟩


/-
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 data.set.pointwise.smul

/-!
# Support of an element under an action action

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

Given an action of a group `G` on a type `α`, we say that a set `s : set α` supports an element
`a : α` if, for all `g` that fix `s` pointwise, `g` fixes `a`.

This is crucial in Fourier-Motzkin constructions.
-/

open_locale pointwise

variables {G H α β : Type*}

namespace mul_action
section has_smul
variables (G) [has_smul G α] [has_smul G β]

/-- A set `s` supports `b` if `g • b = b` whenever `g • a = a` for all `a ∈ s`. -/
@[to_additive "A set `s` supports `b` if `g +ᵥ b = b` whenever `g +ᵥ a = a` for all `a ∈ s`."]
def supports (s : set α) (b : β) := ∀ g : G, (∀ ⦃a⦄, a ∈ s → g • a = a) → g • b = b

variables {s t : set α} {a : α} {b : β}

@[to_additive] lemma supports_of_mem (ha : a ∈ s) : supports G s a := λ g h, h ha

variables {G}

@[to_additive] lemma supports.mono (h : s ⊆ t) (hs : supports G s b) : supports G t b :=
λ g hg, hs _ $ λ a ha, hg $ h ha

end has_smul

variables [group H] [has_smul G α] [has_smul G β] [mul_action H α] [has_smul H β]
  [smul_comm_class G H β] [smul_comm_class G H α] {s t : set α} {b : β}

-- TODO: This should work without `smul_comm_class`
@[to_additive] lemma supports.smul (g : H) (h : supports G s b) : supports G (g • s) (g • b) :=
begin
  rintro g' hg',
  rw [smul_comm, h],
  rintro a ha,
  have := set.ball_image_iff.1 hg' a ha,
  rwa [smul_comm, smul_left_cancel_iff] at this,
end

end mul_action


import Mathlib.Tactic.Basic
/-!
## Summary of New Lean Constructs

**Proof Commands**

| command | description |
| :--- | :--- |
| `λ x =>`             |  introduces assumptions            |
| `calc`               |  combines proofs by transitivity   |
| `have`               |  states an intermediate lemma      |
| `let . . . `         |  introduces a local definition     |
| `show . . .  from`   |  states the target                 |

**Tactics**

| tactic | description |
| :--- | :--- |
| `calc` | combines proofs by transitivity |
| `have` | states an intermediate lemma |
| `let`  | introduces a local definition |
| `case` | handles a inductive case |

-/