import ring_theory.tensor_product

variables {R : Type*} [comm_ring R]
variables {A B : Type*} [comm_ring A] [comm_ring B] [algebra R A] [algebra R B]

example : semiring (tensor_product R A B) :=
begin
apply_instance,
end

example : algebra R (tensor_product R A B) :=
begin
apply_instance,
end

variables {ι : Type*} [add_monoid ι]

example : add_monoid (unit) := infer_instance

example : add_monoid (with_top unit) := infer_instance

example : with_top unit := unit.star

example : with_top unit := 0

example : (0 : with_top unit) = unit.star := rfl

example : with_top unit := ⊤

example : (unit.star  : with_top unit) ≠ (⊤ : with_top unit) := with_top.coe_ne_top

#check unit.star

#eval unit.star


import ring_theory.principal_ideal_domain ring_theory.ideal.basic
import order.zorn data.real.basic

variables {V M : Type*} [integral_domain V] [is_principal_ideal_ring V]
   [add_comm_group M] -- I added field here, it *may* break things
   [module V M]

open module
open ideal zorn

variables (Iₙ : ℕ → (set (ideal V))) (hIₙ : ∀ i j, i < j → Iₙ i ⊆ Iₙ j) (n : ℕ)

/-- An ideal is maximal if it is maximal in the collection of proper ideals. -/
class is_maximal_set (S : set (ideal V)) : Prop := (out : is_coatom S)

lemma first_sub_all (I : set (ideal V)) (Iₙ : ℕ → (set I))
  {hIₙ : ∀ i j, i < j → Iₙ i ⊆ Iₙ j} (n : ℕ) : Iₙ 0 ⊆ Iₙ n :=
begin
  induction n with m h₂,
  { refl},
  { -- have H : Iₙ n = Iₙ (n + 1),
    have H := hIₙ m (m + 1) (show m < m + 1, by linarith),
    tauto
  },
end

lemma second (I : set (ideal V)) {Iₙ : ℕ → (set I)}
  {hIₙ : ∀ i j, i < j → Iₙ i ⊆ Iₙ j} (n : ℕ) (a : I) : a ∈ Iₙ 0 → a ∈ Iₙ n :=
begin
  have H := first_sub_all I Iₙ n,
  rw set.subset_def at H,
  exact H a,
  exact hIₙ,
end

/-
begin
  induction n with m hm,
  { intro x, exact x},
  { intro a_in_I_zero,
    specialize hm a_in_I_zero,
    have H := hIₙ m (m + 1) (show m < m + 1, by linarith),
    rw set.subset_def at H,
    exact H a hm,
  },
end
-/

lemma third (Iₙ : ℕ → (set (ideal V)))
  (hIₙ : ∀ i j, i < j → Iₙ i ⊆ Iₙ j) (a : ideal V) : a ∈ Iₙ 0 → a ∈ ⋃ n, Iₙ n :=
begin
  intros ha,
  rw set.mem_Union,
  use 0,
  exact ha,
end

#check ⋃ n, Iₙ n
variables (J : set (⋃ n, Iₙ n)) (x : ideal V) (hx : x ∈ Iₙ 0)
#check zorn.chain (≤) (Iₙ 0)
#check nonempty J
#check J.nonempty

#check third Iₙ hIₙ x hx
open set

lemma big_union_nonempty {Iₙ : ℕ → set(ideal V)} (hIₙ : ∀ i j, i < j → Iₙ i ⊆ Iₙ j) :
  (Iₙ 0).nonempty → (⋃ n, Iₙ n).nonempty :=
begin
  intros hIₙ,
  rw set.nonempty_def at hIₙ,
  cases hIₙ with x hx,
  rw set.nonempty_def,
  use x,
  exact third Iₙ hIₙ x hx,
end

example (I : set (ideal V)) : zorn.chain (≤) I :=
begin
  rw [zorn.chain, pairwise_on],
  intros i hi j hj hij,
  by_cases (i < j),
  { rw le_iff_lt_or_eq,
    left, left,
    exact h,
  },
  { right,
    rw le_iff_lt_or_eq,
    left,
    -- rw lt_or_eq_of_le,
    -- rw not_lt at h, -- why are you like this.
    sorry},
end

-- ∃ (m : ?m_1) (H : m ∈ ?m_2), ∀ (z : ?m_1), z ∈ ?m_2 → m ≤ z → z = m
lemma exists_maximal_in_set (I : set (ideal V)) (H : zorn.chain (≤) I) (hI : I.nonempty)
  {Iₙ : ℕ → set(ideal V)} {hIₙ : ∀ i j, i < j → Iₙ i ⊆ Iₙ j}
  : ∃ s ∈ I, ∀ t ∈ I, s ≤ t → t = s:=
begin
  apply zorn.zorn_partial_order₀,
  intros X hXI XChain,
  -- use (⨆ n, Iₙ n),
  sorry
end

#exit

#check set (ideal V)
variables (S : set(ideal V)) (T : set(set(ideal V))) (a b : S)
#check a ≤ b
#check S.nonempty
#check ideal.exists_maximal V

lemma test (hS : zorn.chain (≤) T) : ∃ ub, ∀ a ∈ T, a ≤ ub := sorry

#check zorn.exists_maximal_of_chains_bounded test _

lemma ideals_nonempty (S : set (ideal V)) : S.nonempty := -- not necessarily true
begin
  rw set.nonempty_def,
  use 0,
  -- apply ideal.zero_mem,
  sorry
end


-- Note: see tweet https://twitter.com/dwrensha/status/1475207151534710790?s=20
-- This now contains the fix.

import tactic
import data.int.basic
import data.nat.basic
import data.stream.init
import tactic.binder_matching

open classical

-- https://github.com/leanprover-community/mathlib/blob/master/test/coinductive.lean
-- https://leanprover-community.github.io/mathlib_docs/data/stream/init.
-- https://leanprover-community.github.io/mathlib_docs/tactics.html

constant alphabet : Type
def String := ℕ → alphabet
constant a : String

-- States that substring [i, j) is decent
constant decent : ℕ → ℕ → String → Prop
def indecent (i j : ℕ) (a : String) : Prop := ¬ decent i j a

def prefix_decent (i : ℕ) (a : String) : Prop :=
  ∀ (j : ℕ), i < j → decent i j a

lemma lemma0 {a : Prop} {b : Prop} : ¬ (a → b) → a :=
begin
  tautology!,
end

def breakable (a : String)
              (prop : ℕ → ℕ → String → Prop) : Prop
              := ∃ (P : ℕ → Prop),
                 ∃ (n : ℕ),
                 (∃ (i : ℕ), (P i)) ∧
                  ∀ (i : ℕ), (P i) → ∃ (j : ℕ), i < j ∧ prop i j a ∧ P j

theorem kolmogorov : breakable a decent ∨ breakable a indecent :=
begin
  by_cases h : ∃ (n : ℕ), ∀ (i : ℕ), n < i → ¬ prefix_decent i a,
    cases h with n h1,
    -- Suppose we have h
      right,
        unfold breakable,
        let P : ℕ → Prop, intro i, exact n < i,
        existsi [P, n],
          split,
            apply exists.intro, simp [P],
            apply nat.lt_succ_iff.mpr, trivial,

            simp_intros i hj [P],
              have : n < i, finish,
              have h1 : ∃ (x : ℕ), ¬(i < x → decent i x a),
                apply not_forall.mp, tautology!,
              cases h1 with j h6,
                have : i < j, finish,
                existsi j,
                  split,
                    assumption,
                    split, tautology, linarith,

      -- Suppose not...
      left,
        unfold breakable,
          -- The property Q i says we can start a new decent word at position i
          let Q : ℕ → Prop := λ i, 0 < i ∧ prefix_decent i a,
          existsi [Q, 0],
            -- We can start the ball rolling at i
            have q : ∃ (i : ℕ), ¬(0 < i → ¬prefix_decent i a),
              from not_forall.mp (forall_not_of_not_exists h 0),
            cases q with i m11,
              split, finish,
                -- And now we need to keep the ball rolling
                intros i,
                  intro,
                    have k : ∃ (j : ℕ), ¬(i < j → ¬prefix_decent j a),
                      from not_forall.mp (forall_not_of_not_exists h i),
                    cases k with j h15,
                      existsi j, have : i < j, finish,
                        split,
                          assumption,
                          split,
                            tautology,
                            finish
end


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

import topology.category.Profinite
import category_theory.sites.pretopology
import category_theory.sites.sheaf_of_types
import category_theory.sites.sheaf
import category_theory.limits.opposites
import algebra.category.Group

/-!
# Proetale site of a point on Profinite

Defines the proetale site of a point on the category of Profinite sets.
-/
open category_theory category_theory.limits

universes v u

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

-- This section is in the process of being generalised for mathlib, PR #7436.
section to_generalise

/-- A terminal Profinite type, which has the important property that morphisms to `X` are the same
thing as elements of `X`. -/
def point : Profinite.{u} := Profinite.of punit

/-- There is a (natural) bijection between morphisms `* ⟶ X` and elements of `X`.  -/
def from_point {X : Profinite.{u}} :
  (point ⟶ X) ≃ X :=
{ to_fun := λ f, f punit.star,
  inv_fun := λ x, ⟨λ _, x⟩,
  left_inv := λ x, by { ext ⟨⟩, refl },
  right_inv := λ x, rfl}

lemma from_point_apply {X Y : Profinite} (f : point ⟶ X) (g : X ⟶ Y) :
  g (from_point f) = from_point (f ≫ g) :=
rfl

noncomputable def mk_pullback {X Y Z : Profinite.{u}} {f : X ⟶ Z} {g : Y ⟶ Z} {x : X} {y : Y}
  (h : f x = g y) :
  (pullback f g : Profinite) :=
from_point (pullback.lift (from_point.symm x) (from_point.symm y) (by { ext ⟨⟩, exact h }))

lemma mk_pullback_fst {X Y Z : Profinite} {f : X ⟶ Z} {g : Y ⟶ Z} {x : X} {y : Y}
  {h : f x = g y} : (pullback.fst : pullback f g ⟶ _) (mk_pullback h) = x :=
begin
  rw [mk_pullback, from_point_apply],
  simp
end

lemma mk_pullback_snd {X Y Z : Profinite.{u}} {f : X ⟶ Z} {g : Y ⟶ Z} {x : X} {y : Y}
  {h : f x = g y} : (pullback.snd : pullback f g ⟶ _) (mk_pullback h) = y :=
begin
  rw [mk_pullback, from_point_apply],
  simp
end

end to_generalise

/-- The proetale pretopology on Profinites. -/
def proetale_pretopology : pretopology.{u} Profinite.{u} :=
{ coverings := λ X S, ∃ (ι : Type u) [fintype ι] (Y : ι → Profinite) (f : Π (i : ι), Y i ⟶ X),
      (∀ (x : X), ∃ i (y : Y i), f i y = x) ∧ S = presieve.of_arrows Y f,
  has_isos := λ X Y f i,
  begin
    refine ⟨punit, infer_instance, λ _, Y, λ _, f, _, _⟩,
    { introI x,
      refine ⟨punit.star, inv f x, _⟩,
      change (inv f ≫ f) x = x,
      rw is_iso.inv_hom_id,
      simp },
    { rw presieve.of_arrows_punit },
  end,
  pullbacks := λ X Y f S,
  begin
    rintro ⟨ι, hι, Z, g, hg, rfl⟩,
    refine ⟨ι, hι, λ i, pullback (g i) f, λ i, pullback.snd, _, _⟩,
    { intro y,
      rcases hg (f y) with ⟨i, z, hz⟩,
      exact ⟨i, mk_pullback hz, mk_pullback_snd⟩ },
    { rw presieve.of_arrows_pullback }
  end,
  transitive := λ X S Ti,
  begin
    rintro ⟨ι, hι, Z, g, hY, rfl⟩ hTi,
    choose j hj W k hk₁ hk₂ using hTi,
    resetI,
    refine ⟨Σ (i : ι), j (g i) (presieve.of_arrows.mk _), infer_instance, λ i, W _ _ i.2, _, _, _⟩,
    { intro ij,
      exact k _ _ ij.2 ≫ g ij.1 },
    { intro x,
      obtain ⟨i, y, rfl⟩ := hY x,
      obtain ⟨i', z, rfl⟩ := hk₁ (g i) (presieve.of_arrows.mk _) y,
      refine ⟨⟨i, i'⟩, z, rfl⟩ },
    { have : Ti = λ Y f H, presieve.of_arrows (W f H) (k f H),
      { ext Y f H : 3,
        apply hk₂ },
      rw this,
      apply presieve.of_arrows_bind },
  end }

def proetale_topology : grothendieck_topology.{u} Profinite.{u} :=
proetale_pretopology.to_grothendieck _

-- TODO (BM): We either want to generalise this topology to coherent? categories, or (less
-- generally) appropriate concrete categories; or (even less generally) repeat the construction for
-- ED and CH.


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

import data.nat.multiplicity
import data.zmod.algebra
import ring_theory.witt_vector.basic
import ring_theory.witt_vector.is_poly
import field_theory.perfect_closure

/-!
## The Frobenius operator

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

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

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

### Main definitions and results

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

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

## References

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

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

namespace witt_vector

variables {p : ℕ} {R S : Type*} [hp : fact p.prime] [comm_ring R] [comm_ring S]
local notation `𝕎` := witt_vector p -- type as `\bbW`

noncomputable theory
open mv_polynomial finset
open_locale big_operators

variables (p)
include hp

/-- The rational polynomials that give the coefficients of `frobenius x`,
in terms of the coefficients of `x`.
These polynomials actually have integral coefficients,
see `frobenius_poly` and `map_frobenius_poly`. -/
def frobenius_poly_rat (n : ℕ) : mv_polynomial ℕ ℚ :=
bind₁ (witt_polynomial p ℚ ∘ λ n, n + 1) (X_in_terms_of_W p ℚ n)

lemma bind₁_frobenius_poly_rat_witt_polynomial (n : ℕ) :
  bind₁ (frobenius_poly_rat p) (witt_polynomial p ℚ n) = (witt_polynomial p ℚ (n+1)) :=
begin
  delta frobenius_poly_rat,
  rw [← bind₁_bind₁, bind₁_X_in_terms_of_W_witt_polynomial, bind₁_X_right],
end

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

local notation `v` := pnat_multiplicity

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

lemma frobenius_poly_aux_eq (n : ℕ) :
  frobenius_poly_aux p n =
  X (n + 1) - ∑ i in range n, ∑ j in range (p ^ (n - i)),
    (X i ^ p) ^ (p ^ (n - i) - (j + 1)) *
    (frobenius_poly_aux p i) ^ (j + 1) *
    C ↑((p ^ (n - i)).choose (j + 1) / (p ^ (n - i - v p ⟨j + 1, nat.succ_pos j⟩)) *
      ↑p ^ (j - v p ⟨j + 1, nat.succ_pos j⟩) : ℕ) :=
by { rw [frobenius_poly_aux, ← fin.sum_univ_eq_sum_range] }

/-- The polynomials that give the coefficients of `frobenius x`,
in terms of the coefficients of `x`. -/
def frobenius_poly (n : ℕ) : mv_polynomial ℕ ℤ :=
X n ^ p + C ↑p * (frobenius_poly_aux p n)

/-
Our next goal is to prove
```
lemma map_frobenius_poly (n : ℕ) :
  mv_polynomial.map (int.cast_ring_hom ℚ) (frobenius_poly p n) = frobenius_poly_rat p n
```
This lemma has a rather long proof, but it mostly boils down to applying induction,
and then using the following two key facts at the right point.
-/

/-- A key divisibility fact for the proof of `witt_vector.map_frobenius_poly`. -/
lemma map_frobenius_poly.key₁ (n j : ℕ) (hj : j < p ^ (n)) :
  p ^ (n - v p ⟨j + 1, j.succ_pos⟩) ∣ (p ^ n).choose (j + 1) :=
begin
  apply multiplicity.pow_dvd_of_le_multiplicity,
  rw [hp.out.multiplicity_choose_prime_pow hj j.succ_ne_zero],
  refl,
end

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

lemma map_frobenius_poly (n : ℕ) :
  mv_polynomial.map (int.cast_ring_hom ℚ) (frobenius_poly p n) = frobenius_poly_rat p n :=
begin
  rw [frobenius_poly, ring_hom.map_add, ring_hom.map_mul, ring_hom.map_pow, map_C, map_X,
      eq_int_cast, int.cast_coe_nat, frobenius_poly_rat],
  apply nat.strong_induction_on n, clear n,
  intros n IH,
  rw [X_in_terms_of_W_eq],
  simp only [alg_hom.map_sum, alg_hom.map_sub, alg_hom.map_mul, alg_hom.map_pow, bind₁_C_right],
  have h1 : (↑p ^ n) * (⅟ (↑p : ℚ) ^ n) = 1 := by rw [←mul_pow, mul_inv_of_self, one_pow],
  rw [bind₁_X_right, function.comp_app, witt_polynomial_eq_sum_C_mul_X_pow, sum_range_succ,
      sum_range_succ, tsub_self, add_tsub_cancel_left, pow_zero, pow_one, pow_one, sub_mul,
      add_mul, add_mul, mul_right_comm, mul_right_comm (C (↑p ^ (n + 1))), ←C_mul, ←C_mul, pow_succ,
      mul_assoc ↑p (↑p ^ n), h1, mul_one, C_1, one_mul, add_comm _ (X n ^ p), add_assoc, ←add_sub,
      add_right_inj, frobenius_poly_aux_eq, ring_hom.map_sub, map_X, mul_sub, sub_eq_add_neg,
      add_comm _ (C ↑p * X (n + 1)), ←add_sub, add_right_inj, neg_eq_iff_eq_neg, neg_sub, eq_comm],
  simp only [ring_hom.map_sum, mul_sum, sum_mul, ←sum_sub_distrib],
  apply sum_congr rfl,
  intros i hi,
  rw mem_range at hi,
  rw [← IH i hi],
  clear IH,
  rw [add_comm (X i ^ p), add_pow, sum_range_succ', pow_zero, tsub_zero, nat.choose_zero_right,
      one_mul, nat.cast_one, mul_one, mul_add, add_mul, nat.succ_sub (le_of_lt hi),
      nat.succ_eq_add_one (n - i), pow_succ, pow_mul, add_sub_cancel, mul_sum, sum_mul],
  apply sum_congr rfl,
  intros j hj,
  rw mem_range at hj,
  rw [ring_hom.map_mul, ring_hom.map_mul, ring_hom.map_pow, ring_hom.map_pow, ring_hom.map_pow,
      ring_hom.map_pow, ring_hom.map_pow, map_C, map_X, mul_pow],
  rw [mul_comm (C ↑p ^ i), mul_comm _ ((X i ^ p) ^ _), mul_comm (C ↑p ^ (j + 1)), mul_comm (C ↑p)],
  simp only [mul_assoc],
  apply congr_arg,
  apply congr_arg,
  rw [←C_eq_coe_nat],
  simp only [←ring_hom.map_pow, ←C_mul],
  rw C_inj,
  simp only [inv_of_eq_inv, eq_int_cast, inv_pow, int.cast_coe_nat, nat.cast_mul,
    int.cast_mul],
  rw [rat.coe_nat_div _ _ (map_frobenius_poly.key₁ p (n - i) j hj)],
  simp only [nat.cast_pow, pow_add, pow_one],
  suffices : ((p ^ (n - i)).choose (j + 1) * p ^ (j - v p ⟨j + 1, j.succ_pos⟩) * p * p ^ n : ℚ) =
    p ^ j * p * ((p ^ (n - i)).choose (j + 1) * p ^ i) * p ^ (n - i - v p ⟨j + 1, j.succ_pos⟩),
  { have aux : ∀ k : ℕ, (p ^ k : ℚ) ≠ 0,
    { intro, apply pow_ne_zero, exact_mod_cast hp.1.ne_zero },
    simpa [aux, -one_div] with field_simps using this.symm },
  rw [mul_comm _ (p : ℚ), mul_assoc, mul_assoc, ← pow_add, map_frobenius_poly.key₂ p hi.le hj],
  ring_exp
end

lemma frobenius_poly_zmod (n : ℕ) :
  mv_polynomial.map (int.cast_ring_hom (zmod p)) (frobenius_poly p n) = X n ^ p :=
begin
  rw [frobenius_poly, ring_hom.map_add, ring_hom.map_pow, ring_hom.map_mul, map_X, map_C],
  simp only [int.cast_coe_nat, add_zero, eq_int_cast, zmod.nat_cast_self, zero_mul, C_0],
end

@[simp]
lemma bind₁_frobenius_poly_witt_polynomial (n : ℕ) :
  bind₁ (frobenius_poly p) (witt_polynomial p ℤ n) = (witt_polynomial p ℤ (n+1)) :=
begin
  apply mv_polynomial.map_injective (int.cast_ring_hom ℚ) int.cast_injective,
  simp only [map_bind₁, map_frobenius_poly, bind₁_frobenius_poly_rat_witt_polynomial,
    map_witt_polynomial],
end

variables {p}

/-- `frobenius_fun` is the function underlying the ring endomorphism
`frobenius : 𝕎 R →+* frobenius 𝕎 R`. -/
def frobenius_fun (x : 𝕎 R) : 𝕎 R :=
mk p $ λ n, mv_polynomial.aeval x.coeff (frobenius_poly p n)

lemma coeff_frobenius_fun (x : 𝕎 R) (n : ℕ) :
  coeff (frobenius_fun x) n = mv_polynomial.aeval x.coeff (frobenius_poly p n) :=
by rw [frobenius_fun, coeff_mk]

variables (p)

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

See also `frobenius_is_poly`. -/
@[is_poly] lemma frobenius_fun_is_poly : is_poly p (λ R _Rcr, @frobenius_fun p R _ _Rcr) :=
⟨⟨frobenius_poly p, by { introsI, funext n, apply coeff_frobenius_fun }⟩⟩

variable {p}

@[ghost_simps] lemma ghost_component_frobenius_fun (n : ℕ) (x : 𝕎 R) :
  ghost_component n (frobenius_fun x) = ghost_component (n + 1) x :=
by simp only [ghost_component_apply, frobenius_fun, coeff_mk,
    ← bind₁_frobenius_poly_witt_polynomial, aeval_bind₁]

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

The underlying function of this morphism is `witt_vector.frobenius_fun`.
-/
def frobenius : 𝕎 R →+* 𝕎 R :=
{ to_fun := frobenius_fun,
  map_zero' :=
  begin
    refine is_poly.ext
      ((frobenius_fun_is_poly p).comp (witt_vector.zero_is_poly))
      ((witt_vector.zero_is_poly).comp (frobenius_fun_is_poly p)) _ _ 0,
    ghost_simp
  end,
  map_one' :=
  begin
    refine is_poly.ext
      ((frobenius_fun_is_poly p).comp (witt_vector.one_is_poly))
      ((witt_vector.one_is_poly).comp (frobenius_fun_is_poly p)) _ _ 0,
    ghost_simp
  end,
  map_add' := by ghost_calc _ _; ghost_simp,
  map_mul' := by ghost_calc _ _; ghost_simp }

lemma coeff_frobenius (x : 𝕎 R) (n : ℕ) :
  coeff (frobenius x) n = mv_polynomial.aeval x.coeff (frobenius_poly p n) :=
coeff_frobenius_fun _ _

@[ghost_simps] lemma ghost_component_frobenius (n : ℕ) (x : 𝕎 R) :
  ghost_component n (frobenius x) = ghost_component (n + 1) x :=
ghost_component_frobenius_fun _ _

variables (p)

/-- `frobenius` is tautologically a polynomial function. -/
@[is_poly] lemma frobenius_is_poly : is_poly p (λ R _Rcr, @frobenius p R _ _Rcr) :=
frobenius_fun_is_poly _

section char_p
variables [char_p R p]

@[simp]
lemma coeff_frobenius_char_p (x : 𝕎 R) (n : ℕ) :
  coeff (frobenius x) n = (x.coeff n) ^ p :=
begin
  rw [coeff_frobenius],
  -- outline of the calculation, proofs follow below
  calc aeval (λ k, x.coeff k) (frobenius_poly p n)
      = aeval (λ k, x.coeff k)
          (mv_polynomial.map (int.cast_ring_hom (zmod p)) (frobenius_poly p n)) : _
  ... = aeval (λ k, x.coeff k) (X n ^ p : mv_polynomial ℕ (zmod p)) : _
  ... = (x.coeff n) ^ p : _,
  { conv_rhs { rw [aeval_eq_eval₂_hom, eval₂_hom_map_hom] },
    apply eval₂_hom_congr (ring_hom.ext_int _ _) rfl rfl },
  { rw frobenius_poly_zmod },
  { rw [alg_hom.map_pow, aeval_X] }
end

lemma frobenius_eq_map_frobenius :
  @frobenius p R _ _ = map (_root_.frobenius R p) :=
begin
  ext x n,
  simp only [coeff_frobenius_char_p, map_coeff, frobenius_def],
end

@[simp]
lemma frobenius_zmodp (x : 𝕎 (zmod p)) :
  (frobenius x) = x :=
by simp only [ext_iff, coeff_frobenius_char_p, zmod.pow_card, eq_self_iff_true, forall_const]

variables (p R)
/-- `witt_vector.frobenius` as an equiv. -/
@[simps {fully_applied := ff}]
def frobenius_equiv [perfect_ring R p] : witt_vector p R ≃+* witt_vector p R :=
{ to_fun := witt_vector.frobenius,
  inv_fun := map (pth_root R p),
  left_inv := λ f, ext $ λ n, by { rw frobenius_eq_map_frobenius, exact pth_root_frobenius _ },
  right_inv := λ f, ext $ λ n, by { rw frobenius_eq_map_frobenius, exact frobenius_pth_root _ },
   ..(witt_vector.frobenius : witt_vector p R →+* witt_vector p R) }

lemma frobenius_bijective [perfect_ring R p] :
  function.bijective (@witt_vector.frobenius p R _ _) :=
(frobenius_equiv p R).bijective

end char_p

end witt_vector


universe variables u v w

namespace list

variable {m : Type u → Type v}

@[simp]
theorem mfoldl_nil [monad m]
                   {s : Type u}
                   {α : Type w}
                   (f : s → α → m s)
                   (x : s)
: mfoldl f x nil = pure x :=
by simp [mfoldl, return]

theorem mfoldl_cons [monad m]
                    {s : Type u}
                    {α : Type w}
                    (f : s → α → m s)
                    (x : s)
                    (h : α)
                    (r : list α)
: mfoldl f x (h :: r) =  f x h >>= λy, mfoldl f y r :=
by simp [mfoldl]

end list


/-
Copyright (c) 2021 Yakov Pechersky. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yakov Pechersky
-/
import data.multiset.sort
import data.fintype.list
import data.list.rotate

/-!
# Cycles of a list

Lists have an equivalence relation of whether they are rotational permutations of one another.
This relation is defined as `is_rotated`.

Based on this, we define the quotient of lists by the rotation relation, called `cycle`.

We also define a representation of concrete cycles, available when viewing them in a goal state or
via `#eval`, when over representatble types. For example, the cycle `(2 1 4 3)` will be shown
as `c[1, 4, 3, 2]`. The representation of the cycle sorts the elements by the string value of the
underlying element. This representation also supports cycles that can contain duplicates.

-/

namespace list

variables {α : Type*} [decidable_eq α]

/-- Return the `z` such that `x :: z :: _` appears in `xs`, or `default` if there is no such `z`. -/
def next_or : Π (xs : list α) (x default : α), α
| [] x default := default
| [y] x default := default -- Handles the not-found and the wraparound case
| (y :: z :: xs) x default := if x = y then z else next_or (z :: xs) x default

@[simp] lemma next_or_nil (x d : α) : next_or [] x d = d := rfl

@[simp] lemma next_or_singleton (x y d : α) : next_or [y] x d = d := rfl

@[simp] lemma next_or_self_cons_cons (xs : list α) (x y d : α) :
  next_or (x :: y :: xs) x d = y :=
if_pos rfl

lemma next_or_cons_of_ne (xs : list α) (y x d : α) (h : x ≠ y) :
  next_or (y :: xs) x d = next_or xs x d :=
begin
  cases xs with z zs,
  { refl },
  { exact if_neg h }
end

/-- `next_or` does not depend on the default value, if the next value appears. -/
lemma next_or_eq_next_or_of_mem_of_ne (xs : list α) (x d d' : α)
  (x_mem : x ∈ xs) (x_ne : x ≠ xs.last (ne_nil_of_mem x_mem)) :
  next_or xs x d = next_or xs x d' :=
begin
  induction xs with y ys IH,
  { cases x_mem },
  cases ys with z zs,
  { simp at x_mem x_ne, contradiction },
  by_cases h : x = y,
  { rw [h, next_or_self_cons_cons, next_or_self_cons_cons] },
  { rw [next_or, next_or, IH];
      simpa [h] using x_mem }
end

lemma mem_of_next_or_ne {xs : list α} {x d : α} (h : next_or xs x d ≠ d) :
  x ∈ xs :=
begin
  induction xs with y ys IH,
  { simpa using h },
  cases ys with z zs,
  { simpa using h },
  { by_cases hx : x = y,
    { simp [hx] },
    { rw [next_or_cons_of_ne _ _ _ _ hx] at h,
      simpa [hx] using IH h } }
end

lemma next_or_concat {xs : list α} {x : α} (d : α) (h : x ∉ xs) :
  next_or (xs ++ [x]) x d = d :=
begin
  induction xs with z zs IH,
  { simp },
  { obtain ⟨hz, hzs⟩ := not_or_distrib.mp (mt (mem_cons_iff _ _ _).mp h),
    rw [cons_append, next_or_cons_of_ne _ _ _ _ hz, IH hzs] }
end

lemma next_or_mem {xs : list α} {x d : α} (hd : d ∈ xs) :
  next_or xs x d ∈ xs :=
begin
  revert hd,
  suffices : ∀ (xs' : list α) (h : ∀ x ∈ xs, x ∈ xs') (hd : d ∈ xs'), next_or xs x d ∈ xs',
  { exact this xs (λ _, id) },
  intros xs' hxs' hd,
  induction xs with y ys ih,
  { exact hd },
  cases ys with z zs,
  { exact hd },
  rw next_or,
  split_ifs with h,
  { exact hxs' _ (mem_cons_of_mem _ (mem_cons_self _ _)) },
  { exact ih (λ _ h, hxs' _ (mem_cons_of_mem _ h)) },
end

/--
Given an element `x : α` of `l : list α` such that `x ∈ l`, get the next
element of `l`. This works from head to tail, (including a check for last element)
so it will match on first hit, ignoring later duplicates.

For example:
 * `next [1, 2, 3] 2 _ = 3`
 * `next [1, 2, 3] 3 _ = 1`
 * `next [1, 2, 3, 2, 4] 2 _ = 3`
 * `next [1, 2, 3, 2] 2 _ = 3`
 * `next [1, 1, 2, 3, 2] 1 _ = 1`
-/
def next (l : list α) (x : α) (h : x ∈ l) : α :=
next_or l x (l.nth_le 0 (length_pos_of_mem h))

/--
Given an element `x : α` of `l : list α` such that `x ∈ l`, get the previous
element of `l`. This works from head to tail, (including a check for last element)
so it will match on first hit, ignoring later duplicates.

 * `prev [1, 2, 3] 2 _ = 1`
 * `prev [1, 2, 3] 1 _ = 3`
 * `prev [1, 2, 3, 2, 4] 2 _ = 1`
 * `prev [1, 2, 3, 4, 2] 2 _ = 1`
 * `prev [1, 1, 2] 1 _ = 2`
-/
def prev : Π (l : list α) (x : α) (h : x ∈ l), α
| []             _ h := by simpa using h
| [y]            _ _ := y
| (y :: z :: xs) x h := if hx : x = y then (last (z :: xs) (cons_ne_nil _ _)) else
  if x = z then y else prev (z :: xs) x (by simpa [hx] using h)

variables (l : list α) (x : α) (h : x ∈ l)

@[simp] lemma next_singleton (x y : α) (h : x ∈ [y]) :
  next [y] x h = y := rfl

@[simp] lemma prev_singleton (x y : α) (h : x ∈ [y]) :
  prev [y] x h = y := rfl

lemma next_cons_cons_eq' (y z : α) (h : x ∈ (y :: z :: l)) (hx : x = y) :
  next (y :: z :: l) x h = z :=
by rw [next, next_or, if_pos hx]

@[simp] lemma next_cons_cons_eq (z : α) (h : x ∈ (x :: z :: l)) :
  next (x :: z :: l) x h = z :=
next_cons_cons_eq' l x x z h rfl

lemma next_ne_head_ne_last (y : α) (h : x ∈ (y :: l)) (hy : x ≠ y)
  (hx : x ≠ last (y :: l) (cons_ne_nil _ _)) :
  next (y :: l) x h = next l x (by simpa [hy] using h) :=
begin
  rw [next, next, next_or_cons_of_ne _ _ _ _ hy, next_or_eq_next_or_of_mem_of_ne],
  { rwa last_cons at hx },
  { simpa [hy] using h }
end

lemma next_cons_concat (y : α) (hy : x ≠ y) (hx : x ∉ l)
  (h : x ∈ y :: l ++ [x] := mem_append_right _ (mem_singleton_self x)) :
  next (y :: l ++ [x]) x h = y :=
begin
  rw [next, next_or_concat],
  { refl },
  { simp [hy, hx] }
end

lemma next_last_cons (y : α) (h : x ∈ (y :: l)) (hy : x ≠ y)
  (hx : x = last (y :: l) (cons_ne_nil _ _)) (hl : nodup l) :
  next (y :: l) x h = y :=
begin
  rw [next, nth_le, ←init_append_last (cons_ne_nil y l), hx, next_or_concat],
  subst hx,
  intro H,
  obtain ⟨_ | k, hk, hk'⟩ := nth_le_of_mem H,
  { simpa [init_eq_take, nth_le_take', hy.symm] using hk' },
  suffices : k.succ = l.length,
  { simpa [this] using hk },
  cases l with hd tl,
  { simpa using hk },
  { rw nodup_iff_nth_le_inj at hl,
    rw [length, nat.succ_inj'],
    apply hl,
    simpa [init_eq_take, nth_le_take', last_eq_nth_le] using hk' }
end

lemma prev_last_cons' (y : α) (h : x ∈ (y :: l)) (hx : x = y) :
  prev (y :: l) x h = last (y :: l) (cons_ne_nil _ _) :=
begin
  cases l;
  simp [prev, hx]
end

@[simp] lemma prev_last_cons (h : x ∈ (x :: l)) :
  prev (x :: l) x h = last (x :: l) (cons_ne_nil _ _) :=
prev_last_cons' l x x h rfl

lemma prev_cons_cons_eq' (y z : α) (h : x ∈ (y :: z :: l)) (hx : x = y) :
  prev (y :: z :: l) x h = last (z :: l) (cons_ne_nil _ _) :=
by rw [prev, dif_pos hx]

@[simp] lemma prev_cons_cons_eq (z : α) (h : x ∈ (x :: z :: l)) :
  prev (x :: z :: l) x h = last (z :: l) (cons_ne_nil _ _) :=
prev_cons_cons_eq' l x x z h rfl

lemma prev_cons_cons_of_ne' (y z : α) (h : x ∈ (y :: z :: l)) (hy : x ≠ y) (hz : x = z) :
  prev (y :: z :: l) x h = y :=
begin
  cases l,
  { simp [prev, hy, hz] },
  { rw [prev, dif_neg hy, if_pos hz] }
end

lemma prev_cons_cons_of_ne (y : α) (h : x ∈ (y :: x :: l)) (hy : x ≠ y) :
  prev (y :: x :: l) x h = y :=
prev_cons_cons_of_ne' _ _ _ _ _ hy rfl

lemma prev_ne_cons_cons (y z : α) (h : x ∈ (y :: z :: l)) (hy : x ≠ y) (hz : x ≠ z) :
  prev (y :: z :: l) x h = prev (z :: l) x (by simpa [hy] using h) :=
begin
  cases l,
  { simpa [hy, hz] using h },
  { rw [prev, dif_neg hy, if_neg hz] }
end

include h

lemma next_mem : l.next x h ∈ l :=
next_or_mem (nth_le_mem _ _ _)

lemma prev_mem : l.prev x h ∈ l :=
begin
  cases l with hd tl,
  { simpa using h },
  induction tl with hd' tl hl generalizing hd,
  { simp },
  { by_cases hx : x = hd,
    { simp only [hx, prev_cons_cons_eq],
      exact mem_cons_of_mem _ (last_mem _) },
    { rw [prev, dif_neg hx],
      split_ifs with hm,
      { exact mem_cons_self _ _ },
      { exact mem_cons_of_mem _ (hl _ _) } } }
end

lemma next_nth_le (l : list α) (h : nodup l) (n : ℕ) (hn : n < l.length) :
  next l (l.nth_le n hn) (nth_le_mem _ _ _) = l.nth_le ((n + 1) % l.length)
    (nat.mod_lt _ (n.zero_le.trans_lt hn)) :=
begin
  cases l with x l,
  { simpa using hn },
  induction l with y l hl generalizing x n,
  { simp },
  { cases n,
    { simp },
    { have hn' : n.succ ≤ l.length.succ,
      { refine nat.succ_le_of_lt _,
        simpa [nat.succ_lt_succ_iff] using hn },
      have hx': (x :: y :: l).nth_le n.succ hn ≠ x,
      { intro H,
        suffices : n.succ = 0,
        { simpa },
        rw nodup_iff_nth_le_inj at h,
        refine h _ _ hn nat.succ_pos' _,
        simpa using H },
      rcases hn'.eq_or_lt with hn''|hn'',
      { rw [next_last_cons],
        { simp [hn''] },
        { exact hx' },
        { simp [last_eq_nth_le, hn''] },
        { exact nodup_of_nodup_cons h } },
      { have : n < l.length := by simpa [nat.succ_lt_succ_iff] using hn'' ,
        rw [next_ne_head_ne_last _ _ _ _ hx'],
        { simp [nat.mod_eq_of_lt (nat.succ_lt_succ (nat.succ_lt_succ this)),
                hl _ _ (nodup_of_nodup_cons h), nat.mod_eq_of_lt (nat.succ_lt_succ this)] },
        { rw last_eq_nth_le,
          intro H,
          suffices : n.succ = l.length.succ,
          { exact absurd hn'' this.ge.not_lt },
          rw nodup_iff_nth_le_inj at h,
          refine h _ _ hn _ _,
          { simp },
          { simpa using H } } } } }
end

lemma prev_nth_le (l : list α) (h : nodup l) (n : ℕ) (hn : n < l.length) :
  prev l (l.nth_le n hn) (nth_le_mem _ _ _) = l.nth_le ((n + (l.length - 1)) % l.length)
    (nat.mod_lt _ (n.zero_le.trans_lt hn)) :=
begin
  cases l with x l,
  { simpa using hn },
  induction l with y l hl generalizing n x,
  { simp },
  { rcases n with _|_|n,
    { simpa [last_eq_nth_le, nat.mod_eq_of_lt (nat.succ_lt_succ l.length.lt_succ_self)] },
    { simp only [mem_cons_iff, nodup_cons] at h,
      push_neg at h,
      simp [add_comm, prev_cons_cons_of_ne, h.left.left.symm] },
    { rw [prev_ne_cons_cons],
      { convert hl _ _ (nodup_of_nodup_cons h) _ using 1,
        have : ∀ k hk, (y :: l).nth_le k hk = (x :: y :: l).nth_le (k + 1) (nat.succ_lt_succ hk),
        { intros,
          simpa },
        rw [this],
        congr,
        simp only [nat.add_succ_sub_one, add_zero, length],
        simp only [length, nat.succ_lt_succ_iff] at hn,
        set k := l.length,
        rw [nat.succ_add, ←nat.add_succ, nat.add_mod_right, nat.succ_add, ←nat.add_succ _ k,
            nat.add_mod_right, nat.mod_eq_of_lt, nat.mod_eq_of_lt],
        { exact nat.lt_succ_of_lt hn },
        { exact nat.succ_lt_succ (nat.lt_succ_of_lt hn) } },
      { intro H,
        suffices : n.succ.succ = 0,
        { simpa },
        rw nodup_iff_nth_le_inj at h,
        refine h _ _ hn nat.succ_pos' _,
        simpa using H },
      { intro H,
        suffices : n.succ.succ = 1,
        { simpa },
        rw nodup_iff_nth_le_inj at h,
        refine h _ _ hn (nat.succ_lt_succ nat.succ_pos') _,
        simpa using H } } }
end

lemma pmap_next_eq_rotate_one (h : nodup l) :
  l.pmap l.next (λ _ h, h) = l.rotate 1 :=
begin
  apply list.ext_le,
  { simp },
  { intros,
    rw [nth_le_pmap, nth_le_rotate, next_nth_le _ h] }
end

lemma pmap_prev_eq_rotate_length_sub_one (h : nodup l) :
  l.pmap l.prev (λ _ h, h) = l.rotate (l.length - 1) :=
begin
  apply list.ext_le,
  { simp },
  { intros n hn hn',
    rw [nth_le_rotate, nth_le_pmap, prev_nth_le _ h] }
end

lemma prev_next (l : list α) (h : nodup l) (x : α) (hx : x ∈ l) :
  prev l (next l x hx) (next_mem _ _ _) = x :=
begin
  obtain ⟨n, hn, rfl⟩ := nth_le_of_mem hx,
  simp only [next_nth_le, prev_nth_le, h, nat.mod_add_mod],
  cases l with hd tl,
  { simp },
  { have : n < 1 + tl.length := by simpa [add_comm] using hn,
    simp [add_left_comm, add_comm, add_assoc, nat.mod_eq_of_lt this] }
end

lemma next_prev (l : list α) (h : nodup l) (x : α) (hx : x ∈ l) :
  next l (prev l x hx) (prev_mem _ _ _) = x :=
begin
  obtain ⟨n, hn, rfl⟩ := nth_le_of_mem hx,
  simp only [next_nth_le, prev_nth_le, h, nat.mod_add_mod],
  cases l with hd tl,
  { simp },
  { have : n < 1 + tl.length := by simpa [add_comm] using hn,
    simp [add_left_comm, add_comm, add_assoc, nat.mod_eq_of_lt this] }
end

lemma prev_reverse_eq_next (l : list α) (h : nodup l) (x : α) (hx : x ∈ l) :
  prev l.reverse x (mem_reverse.mpr hx) = next l x hx :=
begin
  obtain ⟨k, hk, rfl⟩ := nth_le_of_mem hx,
  have lpos : 0 < l.length := k.zero_le.trans_lt hk,
  have key : l.length - 1 - k < l.length :=
    (nat.sub_le _ _).trans_lt (tsub_lt_self lpos nat.succ_pos'),
  rw ←nth_le_pmap l.next (λ _ h, h) (by simpa using hk),
  simp_rw [←nth_le_reverse l k (key.trans_le (by simp)), pmap_next_eq_rotate_one _ h],
  rw ←nth_le_pmap l.reverse.prev (λ _ h, h),
  { simp_rw [pmap_prev_eq_rotate_length_sub_one _ (nodup_reverse.mpr h), rotate_reverse,
             length_reverse, nat.mod_eq_of_lt (tsub_lt_self lpos nat.succ_pos'),
             tsub_tsub_cancel_of_le (nat.succ_le_of_lt lpos)],
    rw ←nth_le_reverse,
    { simp [tsub_tsub_cancel_of_le (nat.le_pred_of_lt hk)] },
    { simpa using (nat.sub_le _ _).trans_lt (tsub_lt_self lpos nat.succ_pos') } },
  { simpa using (nat.sub_le _ _).trans_lt (tsub_lt_self lpos nat.succ_pos') }
end

lemma next_reverse_eq_prev (l : list α) (h : nodup l) (x : α) (hx : x ∈ l) :
  next l.reverse x (mem_reverse.mpr hx) = prev l x hx :=
begin
  convert (prev_reverse_eq_next l.reverse (nodup_reverse.mpr h) x (mem_reverse.mpr hx)).symm,
  exact (reverse_reverse l).symm
end

lemma is_rotated_next_eq {l l' : list α} (h : l ~r l') (hn : nodup l) {x : α} (hx : x ∈ l) :
  l.next x hx = l'.next x (h.mem_iff.mp hx) :=
begin
  obtain ⟨k, hk, rfl⟩ := nth_le_of_mem hx,
  obtain ⟨n, rfl⟩ := id h,
  rw [next_nth_le _ hn],
  simp_rw ←nth_le_rotate' _ n k,
  rw [next_nth_le _ (h.nodup_iff.mp hn), ←nth_le_rotate' _ n],
  simp [add_assoc]
end

lemma is_rotated_prev_eq {l l' : list α} (h : l ~r l') (hn : nodup l) {x : α} (hx : x ∈ l) :
  l.prev x hx = l'.prev x (h.mem_iff.mp hx) :=
begin
  rw [←next_reverse_eq_prev _ hn, ←next_reverse_eq_prev _ (h.nodup_iff.mp hn)],
  exact is_rotated_next_eq h.reverse (nodup_reverse.mpr hn) _
end

end list

open list

/--
`cycle α` is the quotient of `list α` by cyclic permutation.
Duplicates are allowed.
-/
def cycle (α : Type*) : Type* := quotient (is_rotated.setoid α)

namespace cycle

variables {α : Type*}

instance : has_coe (list α) (cycle α) := ⟨quot.mk _⟩

@[simp] lemma coe_eq_coe {l₁ l₂ : list α} : (l₁ : cycle α) = l₂ ↔ (l₁ ~r l₂) :=
@quotient.eq _ (is_rotated.setoid _) _ _

@[simp] lemma mk_eq_coe (l : list α) :
  quot.mk _ l = (l : cycle α) := rfl

@[simp] lemma mk'_eq_coe (l : list α) :
  quotient.mk' l = (l : cycle α) := rfl

instance : inhabited (cycle α) := ⟨(([] : list α) : cycle α)⟩

/--
For `x : α`, `s : cycle α`, `x ∈ s` indicates that `x` occurs at least once in `s`.
-/
def mem (a : α) (s : cycle α) : Prop :=
quot.lift_on s (λ l, a ∈ l) (λ l₁ l₂ (e : l₁ ~r l₂), propext $ e.mem_iff)

instance : has_mem α (cycle α) := ⟨mem⟩

@[simp] lemma mem_coe_iff {a : α} {l : list α} :
  a ∈ (l : cycle α) ↔ a ∈ l := iff.rfl

instance [decidable_eq α] : decidable_eq (cycle α) :=
λ s₁ s₂, quotient.rec_on_subsingleton₂' s₁ s₂ (λ l₁ l₂,
  decidable_of_iff' _ quotient.eq')

instance [decidable_eq α] (x : α) (s : cycle α) : decidable (x ∈ s) :=
quotient.rec_on_subsingleton' s (λ l, list.decidable_mem x l)

/--
Reverse a `s : cycle α` by reversing the underlying `list`.
-/
def reverse (s : cycle α) : cycle α :=
quot.map reverse (λ l₁ l₂ (e : l₁ ~r l₂), e.reverse) s

@[simp] lemma reverse_coe (l : list α) :
  (l : cycle α).reverse = l.reverse := rfl

@[simp] lemma mem_reverse_iff {a : α} {s : cycle α} :
  a ∈ s.reverse ↔ a ∈ s :=
quot.induction_on s (λ _, mem_reverse)

@[simp] lemma reverse_reverse (s : cycle α) :
  s.reverse.reverse = s :=
quot.induction_on s (λ _, by simp)

/--
The length of the `s : cycle α`, which is the number of elements, counting duplicates.
-/
def length (s : cycle α) : ℕ :=
quot.lift_on s length (λ l₁ l₂ (e : l₁ ~r l₂), e.perm.length_eq)

@[simp] lemma length_coe (l : list α) :
  length (l : cycle α) = l.length := rfl

@[simp] lemma length_reverse (s : cycle α) :
  s.reverse.length = s.length :=
quot.induction_on s length_reverse

/--
A `s : cycle α` that is at most one element.
-/
def subsingleton (s : cycle α) : Prop :=
s.length ≤ 1

lemma length_subsingleton_iff {s : cycle α} :
  subsingleton s ↔ length s ≤ 1 := iff.rfl

@[simp] lemma subsingleton_reverse_iff {s : cycle α} :
  s.reverse.subsingleton ↔ s.subsingleton :=
by simp [length_subsingleton_iff]

lemma subsingleton.congr {s : cycle α} (h : subsingleton s) :
  ∀ ⦃x⦄ (hx : x ∈ s) ⦃y⦄ (hy : y ∈ s), x = y :=
begin
  induction s using quot.induction_on with l,
  simp only [length_subsingleton_iff, length_coe, mk_eq_coe, le_iff_lt_or_eq, nat.lt_add_one_iff,
             length_eq_zero, length_eq_one, nat.not_lt_zero, false_or] at h,
  rcases h with rfl|⟨z, rfl⟩;
  simp
end

/--
A `s : cycle α` that is made up of at least two unique elements.
-/
def nontrivial (s : cycle α) : Prop := ∃ (x y : α) (h : x ≠ y), x ∈ s ∧ y ∈ s

@[simp] lemma nontrivial_coe_nodup_iff {l : list α} (hl : l.nodup) :
  nontrivial (l : cycle α) ↔ 2 ≤ l.length :=
begin
  rw nontrivial,
  rcases l with (_ | ⟨hd, _ | ⟨hd', tl⟩⟩),
  { simp },
  { simp },
  { simp only [mem_cons_iff, exists_prop, mem_coe_iff, list.length, ne.def, nat.succ_le_succ_iff,
               zero_le, iff_true],
    refine ⟨hd, hd', _, by simp⟩,
    simp only [not_or_distrib, mem_cons_iff, nodup_cons] at hl,
    exact hl.left.left }
end

@[simp] lemma nontrivial_reverse_iff {s : cycle α} :
  s.reverse.nontrivial ↔ s.nontrivial :=
by simp [nontrivial]

lemma length_nontrivial {s : cycle α} (h : nontrivial s) :
  2 ≤ length s :=
begin
  obtain ⟨x, y, hxy, hx, hy⟩ := h,
  induction s using quot.induction_on with l,
  rcases l with (_ | ⟨hd, _ | ⟨hd', tl⟩⟩),
  { simpa using hx },
  { simp only [mem_coe_iff, mk_eq_coe, mem_singleton] at hx hy,
    simpa [hx, hy] using hxy },
  { simp [bit0] }
end

/--
The `s : cycle α` contains no duplicates.
-/
def nodup (s : cycle α) : Prop :=
quot.lift_on s nodup (λ l₁ l₂ (e : l₁ ~r l₂), propext $ e.nodup_iff)

@[simp] lemma nodup_coe_iff {l : list α} :
  nodup (l : cycle α) ↔ l.nodup := iff.rfl

@[simp] lemma nodup_reverse_iff {s : cycle α} :
  s.reverse.nodup ↔ s.nodup :=
quot.induction_on s (λ _, nodup_reverse)

lemma subsingleton.nodup {s : cycle α} (h : subsingleton s) :
  nodup s :=
begin
  induction s using quot.induction_on with l,
  cases l with hd tl,
  { simp },
  { have : tl = [] := by simpa [subsingleton, length_eq_zero] using h,
    simp [this] }
end

lemma nodup.nontrivial_iff {s : cycle α} (h : nodup s) :
  nontrivial s ↔ ¬ subsingleton s :=
begin
  rw length_subsingleton_iff,
  induction s using quotient.induction_on',
  simp only [mk'_eq_coe, nodup_coe_iff] at h,
  simp [h, nat.succ_le_iff]
end

/--
The `s : cycle α` as a `multiset α`.
-/
def to_multiset (s : cycle α) : multiset α :=
quotient.lift_on' s (λ l, (l : multiset α)) (λ l₁ l₂ (h : l₁ ~r l₂), multiset.coe_eq_coe.mpr h.perm)

/--
The lift of `list.map`.
-/
def map {β : Type*} (f : α → β) : cycle α → cycle β :=
quotient.map' (list.map f) $ λ l₁ l₂ h, h.map _

/--
The `multiset` of lists that can make the cycle.
-/
def lists (s : cycle α) : multiset (list α) :=
quotient.lift_on' s
  (λ l, (l.cyclic_permutations : multiset (list α))) $
  λ l₁ l₂ (h : l₁ ~r l₂), by simpa using h.cyclic_permutations.perm

@[simp] lemma mem_lists_iff_coe_eq {s : cycle α} {l : list α} :
  l ∈ s.lists ↔ (l : cycle α) = s :=
begin
  induction s using quotient.induction_on',
  rw [lists, quotient.lift_on'_mk'],
  simp
end

section decidable

variable [decidable_eq α]

/--
Auxiliary decidability algorithm for lists that contain at least two unique elements.
-/
def decidable_nontrivial_coe : Π (l : list α), decidable (nontrivial (l : cycle α))
| []            := is_false (by simp [nontrivial])
| [x]           := is_false (by simp [nontrivial])
| (x :: y :: l) := if h : x = y
  then @decidable_of_iff' _ (nontrivial ((x :: l) : cycle α))
    (by simp [h, nontrivial])
    (decidable_nontrivial_coe (x :: l))
  else is_true ⟨x, y, h, by simp, by simp⟩

instance {s : cycle α} : decidable (nontrivial s) :=
quot.rec_on_subsingleton s decidable_nontrivial_coe

instance {s : cycle α} : decidable (nodup s) :=
quot.rec_on_subsingleton s (λ (l : list α), list.nodup_decidable l)

instance fintype_nodup_cycle [fintype α] : fintype {s : cycle α // s.nodup} :=
fintype.of_surjective (λ (l : {l : list α // l.nodup}), ⟨l.val, by simpa using l.prop⟩) (λ ⟨s, hs⟩,
  begin
    induction s using quotient.induction_on',
    exact ⟨⟨s, hs⟩, by simp⟩
  end)

instance fintype_nodup_nontrivial_cycle [fintype α] :
  fintype {s : cycle α // s.nodup ∧ s.nontrivial} :=
fintype.subtype (((finset.univ : finset {s : cycle α // s.nodup}).map
  (function.embedding.subtype _)).filter cycle.nontrivial)
  (by simp)

/--
The `s : cycle α` as a `finset α`.
-/
def to_finset (s : cycle α) : finset α :=
s.to_multiset.to_finset

/-- Given a `s : cycle α` such that `nodup s`, retrieve the next element after `x ∈ s`. -/
def next : Π (s : cycle α) (hs : nodup s) (x : α) (hx : x ∈ s), α :=
λ s, quot.hrec_on s (λ l hn x hx, next l x hx)
  (λ l₁ l₂ (h : l₁ ~r l₂),
  function.hfunext (propext h.nodup_iff) (λ h₁ h₂ he, function.hfunext rfl
    (λ x y hxy, function.hfunext (propext (by simpa [eq_of_heq hxy] using h.mem_iff))
    (λ hm hm' he', heq_of_eq (by simpa [eq_of_heq hxy] using is_rotated_next_eq h h₁ _)))))

/-- Given a `s : cycle α` such that `nodup s`, retrieve the previous element before `x ∈ s`. -/
def prev : Π (s : cycle α) (hs : nodup s) (x : α) (hx : x ∈ s), α :=
λ s, quot.hrec_on s (λ l hn x hx, prev l x hx)
  (λ l₁ l₂ (h : l₁ ~r l₂),
  function.hfunext (propext h.nodup_iff) (λ h₁ h₂ he, function.hfunext rfl
    (λ x y hxy, function.hfunext (propext (by simpa [eq_of_heq hxy] using h.mem_iff))
    (λ hm hm' he', heq_of_eq (by simpa [eq_of_heq hxy] using is_rotated_prev_eq h h₁ _)))))

@[simp] lemma prev_reverse_eq_next (s : cycle α) (hs : nodup s) (x : α) (hx : x ∈ s) :
  s.reverse.prev (nodup_reverse_iff.mpr hs) x (mem_reverse_iff.mpr hx) = s.next hs x hx :=
(quotient.induction_on' s prev_reverse_eq_next) hs x hx

@[simp] lemma next_reverse_eq_prev (s : cycle α) (hs : nodup s) (x : α) (hx : x ∈ s) :
  s.reverse.next (nodup_reverse_iff.mpr hs) x (mem_reverse_iff.mpr hx) = s.prev hs x hx :=
by simp [←prev_reverse_eq_next]

@[simp] lemma next_mem (s : cycle α) (hs : nodup s) (x : α) (hx : x ∈ s) :
  s.next hs x hx ∈ s :=
begin
  induction s using quot.induction_on,
  exact next_mem _ _ _
end

lemma prev_mem (s : cycle α) (hs : nodup s) (x : α) (hx : x ∈ s) :
  s.prev hs x hx ∈ s :=
by { rw [←next_reverse_eq_prev, ←mem_reverse_iff], exact next_mem _ _ _ _ }

@[simp] lemma prev_next (s : cycle α) (hs : nodup s) (x : α) (hx : x ∈ s) :
  s.prev hs (s.next hs x hx) (next_mem s hs x hx) = x :=
(quotient.induction_on' s prev_next) hs x hx

@[simp] lemma next_prev (s : cycle α) (hs : nodup s) (x : α) (hx : x ∈ s) :
  s.next hs (s.prev hs x hx) (prev_mem s hs x hx) = x :=
(quotient.induction_on' s next_prev) hs x hx

end decidable

/--
We define a representation of concrete cycles, available when viewing them in a goal state or
via `#eval`, when over representatble types. For example, the cycle `(2 1 4 3)` will be shown
as `c[1, 4, 3, 2]`. The representation of the cycle sorts the elements by the string value of the
underlying element. This representation also supports cycles that can contain duplicates.
-/
instance [has_repr α] : has_repr (cycle α) :=
⟨λ s, "c[" ++ string.intercalate ", " ((s.map repr).lists.sort (≤)).head ++ "]"⟩

end cycle


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

import .obviously

-- **** Begin caching stuff ****

-- **** Enable tactic block caching (just include) ****
import tactic.tcache.enable

-- Trace which declarations have blocks being cached
set_option trace.tcache true

-- Uncomment to clear the cache (recomment afterword)
-- #clear tcache

-- **** End of caching stuff ****

open category_theory

namespace category_theory.adjunctions

section

universes u₁ v₁ u₂ v₂

variables {C : Type u₁} [𝒞 : category.{v₁ u₁} C] {D : Type u₂} [𝒟 : category.{v₂ u₂} D]
include 𝒞 𝒟

structure Adjunction (L : C ⥤ D) (R : D ⥤ C) :=
  (unit       : functor.id _ ⟹ (L ⋙ R))
  (counit     : (R ⋙ L) ⟹ functor.id _)
  (triangle_1 : ∀ X : D, (unit.app (R.obj X)) ≫ (R.map (counit.app X)) = 𝟙 (R.obj X))
  (triangle_2 : ∀ X : C, (L.map (unit.app X)) ≫ (counit.app (L.obj X)) = 𝟙 (L.obj X))

attribute [simp,search] Adjunction.triangle_1 Adjunction.triangle_2

lemma Adjunctions_pointwise_equal
  (L : C ⥤ D) (R : D ⥤ C) (A B : Adjunction L R)
  (w1 : A.unit = B.unit) (w2 : A.counit = B.counit) : A = B :=
  begin
    induction A,
    induction B,
    tidy
  end

@[simp,search] lemma Adjunction.unit_naturality {L : C ⥤ D} {R : D ⥤ C} (A : Adjunction L R) {X Y : C} (f : X ⟶ Y) : (A.unit.app X) ≫ (R.map (L.map f)) = f ≫ (A.unit.app Y) :=
by obviously

@[simp,search] lemma Adjunction.counit_naturality {L : C ⥤ D} {R : D ⥤ C} (A : Adjunction L R) {X Y : D} (f : X ⟶ Y) : (L.map (R.map f)) ≫ (A.counit.app Y) = (A.counit.app X) ≫ f :=
by obviously

end

infix ` ⊣ `:50 := Adjunction

section
universes u₁ v₁

variables {C : Type u₁} [𝒞 : category.{v₁ u₁} C] {D : Type u₁} [𝒟 : category.{v₁ u₁} D]
include 𝒞 𝒟

def hom_adjunction (L : C ⥤ D) (R : D ⥤ C) :=
    ((functor.prod L.op (functor.id D)) ⋙ (functor.hom D))
      ≅
    (functor.prod (functor.id (Cᵒᵖ)) R) ⋙ (functor.hom C)

def mate {L : C ⥤ D} {R : D ⥤ C} (A : hom_adjunction L R) {X : C} {Y : D} (f : (L.obj X) ⟶ Y) :
  X ⟶ (R.obj Y) :=
((A.hom).app (op X, Y)) f

end
end category_theory.adjunctions

namespace category_theory.adjunctions

universes u v v₁ u₁ u₂ v₂ u₃ v₃ u₄ v₄

section
variables {A : Type u₁} [𝒜 : category.{v₁ u₁} A] {B : Type u₂} [ℬ : category.{v₂ u₂} B] {C : Type u₃} [𝒞 : category.{v₃ u₃} C] {D : Type u₄} [𝒟 : category.{v₄ u₄} D]
include 𝒜 ℬ 𝒞 𝒟

@[simp,search] lemma prod_obj' (F : A ⥤ B) (G : C ⥤ D) (a : A) (c : C) : (functor.prod F G).obj (a, c) = (F.obj a, G.obj c) := rfl
@[simp,search] lemma prod_app' {F G : A ⥤ B} {H I : C ⥤ D} (α : F ⟹ G) (β : H ⟹ I) (a : A) (c : C) : (nat_trans.prod α β).app (a, c) = (α.app a, β.app c) := rfl
end

variables {C : Type u₁} [𝒞 : category.{v₁ u₁} C] {D : Type u₁} [𝒟 : category.{v₁ u₁} D]
include 𝒞 𝒟
variables {L : C ⥤ D} {R : D ⥤ C}

@[reducible] private def Adjunction_to_HomAdjunction_morphism (A : L ⊣ R)
  : ((functor.prod L.op (functor.id D)) ⋙ (functor.hom D)) ⟹
                          (functor.prod (functor.id (Cᵒᵖ)) R) ⋙ (functor.hom C) :=
{ app := λ P,
    -- We need to construct the map from D.Hom (L P.1) P.2 to C.Hom P.1 (R P.2)
    λ f, (A.unit.app (unop P.1)) ≫ (R.map f) }

@[reducible] private def Adjunction_to_HomAdjunction_inverse (A : L ⊣ R)
  : (functor.prod (functor.id (Cᵒᵖ)) R) ⋙ (functor.hom C) ⟹
                          ((functor.prod L.op (functor.id D)) ⋙ (functor.hom D)) :=
{ app := λ P,
    -- We need to construct the map back to D.Hom (L P.1) P.2 from C.Hom P.1 (R P.2)
    λ f, (L.map f) ≫ (A.counit.app P.2) }

def Adjunction_to_HomAdjunction (A : L ⊣ R) : hom_adjunction L R :=
{ hom := Adjunction_to_HomAdjunction_morphism A,
  inv := Adjunction_to_HomAdjunction_inverse A }

@[simp,search] lemma mate_of_L (A : hom_adjunction L R) {X Y : C} (f : X ⟶ Y) : (((A.hom).app (op X, L.obj X)) (𝟙 (L.obj X))) ≫
      (R.map (L.map f))
      = ((A.hom).app (op X, L.obj Y)) (L.map f) :=
begin
  have p := @nat_trans.naturality _ _ _ _ _ _ A.hom (op X, L.obj X) (op X, L.obj Y) (𝟙 (op X), L.map f),
  have q := congr_fun p (L.map (𝟙 X)),
  tidy,
  erw category_theory.functor.map_id at q,
  obviously,
end

@[simp,search] lemma mate_of_L' (A : hom_adjunction L R) {X Y : C} (f : X ⟶ Y) : f ≫ (((A.hom).app (op Y, L.obj Y)) (𝟙 (L.obj Y)))
      = ((A.hom).app (op X, L.obj Y)) (L.map f) :=
begin
  have p := @nat_trans.naturality _ _ _ _ _ _ A.hom (op Y, L.obj Y) (op X, L.obj Y) (f.op, 𝟙 (L.obj Y)),
  have q := congr_fun p (L.map (𝟙 Y)),
  obviously,
end

@[simp,search] lemma mate_of_R (A : hom_adjunction L R) {X Y : D} (f : X ⟶ Y) : (L.map (R.map f)) ≫ (((A.inv).app (op (R.obj Y), Y)) (𝟙 (R.obj Y)))
      = ((A.inv).app (op (R.obj X), Y)) (R.map f) :=
begin
  have p := @nat_trans.naturality _ _ _ _ _ _ A.inv (op (R.obj Y), Y) (op (R.obj X), Y) ((R.map f).op, 𝟙 Y),
  have q := congr_fun p (R.map (𝟙 Y)),
  tidy,
end

@[simp,search] lemma mate_of_R' (A : hom_adjunction L R) {X Y : D} (f : X ⟶ Y) : (((A.inv).app (op (R.obj X), X)) (𝟙 (R.obj X))) ≫ f =
    ((A.inv).app (op (R.obj X), Y)) (R.map f) :=
begin
  have p := @nat_trans.naturality _ _ _ _ _ _ A.inv (op (R.obj X), X) (op (R.obj X), Y) (𝟙 (op (R.obj X)), f),
  have q := congr_fun p (R.map (𝟙 X)),
  obviously,
end

private def counit_from_HomAdjunction (A : hom_adjunction L R) : (R ⋙ L) ⟹ (functor.id _) :=
{ app := λ X : D, (A.inv.app (op (R.obj X), X)) (𝟙 (R.obj X)) }

private def unit_from_HomAdjunction (A : hom_adjunction L R) : (functor.id _) ⟹ (L ⋙ R) :=
{ app := λ X : C, (A.hom.app (op X, L.obj X)) (𝟙 (L.obj X)) }

end category_theory.adjunctions


/-
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 topology 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_add_comm_group

lemma has_finite_integral_restrict_of_bounded [normed_add_comm_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_add_comm_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_bUnion {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_bUnion s.finite_to_set

@[simp] lemma integrable_on_finite_Union [finite β] {t : β → set α} :
  integrable_on f (⋃ i, t i) μ ↔ ∀ i, integrable_on f (t i) μ :=
by { casesI nonempty_fintype β,
  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.integrable_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.integrable_indicator hs

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

lemma integrable_indicator_const_Lp {E} [normed_add_comm_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

/-- If a function is integrable on a set `s` and nonzero there, then the measurable hull of `s` is
well behaved: the restriction of the measure to `to_measurable μ s` coincides with its restriction
to `s`. -/
lemma integrable_on.restrict_to_measurable (hf : integrable_on f s μ) (h's : ∀ x ∈ s, f x ≠ 0) :
  μ.restrict (to_measurable μ s) = μ.restrict s :=
begin
  rcases exists_seq_strict_anti_tendsto (0 : ℝ) with ⟨u, u_anti, u_pos, u_lim⟩,
  let v := λ n, to_measurable (μ.restrict s) {x | u n ≤ ‖f x‖},
  have A : ∀ n, μ (s ∩ v n) ≠ ∞,
  { assume n,
    rw [inter_comm, ← measure.restrict_apply (measurable_set_to_measurable _ _),
      measure_to_measurable],
    exact (hf.measure_ge_lt_top (u_pos n)).ne },
  apply measure.restrict_to_measurable_of_cover _ A,
  assume x hx,
  have : 0 < ‖f x‖, by simp only [h's x hx, norm_pos_iff, ne.def, not_false_iff],
  obtain ⟨n, hn⟩ : ∃ n, u n < ‖f x‖, from ((tendsto_order.1 u_lim).2 _ this).exists,
  refine mem_Union.2 ⟨n, _⟩,
  exact subset_to_measurable _ _ hn.le
end

/-- If a function is integrable on a set `s`, and vanishes on `t \ s`, then it is integrable on `t`
if `t` is null-measurable. -/
lemma integrable_on.of_ae_diff_eq_zero (hf : integrable_on f s μ)
  (ht : null_measurable_set t μ) (h't : ∀ᵐ x ∂μ, x ∈ t \ s → f x = 0) :
  integrable_on f t μ :=
begin
  let u := {x ∈ s | f x ≠ 0},
  have hu : integrable_on f u μ := hf.mono_set (λ x hx, hx.1),
  let v := to_measurable μ u,
  have A : integrable_on f v μ,
  { rw [integrable_on, hu.restrict_to_measurable],
    { exact hu },
    { assume x hx, exact hx.2 } },
  have B : integrable_on f (t \ v) μ,
  { apply integrable_on_zero.congr,
    filter_upwards [ae_restrict_of_ae h't, ae_restrict_mem₀
      (ht.diff (measurable_set_to_measurable μ u).null_measurable_set)] with x hxt hx,
    by_cases h'x : x ∈ s,
    { by_contra H,
      exact hx.2 (subset_to_measurable μ u ⟨h'x, ne.symm H⟩) },
    { exact (hxt ⟨hx.1, h'x⟩).symm, } },
  apply (A.union B).mono_set _,
  rw union_diff_self,
  exact subset_union_right _ _
end

/-- If a function is integrable on a set `s`, and vanishes on `t \ s`, then it is integrable on `t`
if `t` is measurable. -/
lemma integrable_on.of_forall_diff_eq_zero (hf : integrable_on f s μ)
  (ht : measurable_set t) (h't : ∀ x ∈ t \ s, f x = 0) :
  integrable_on f t μ :=
hf.of_ae_diff_eq_zero ht.null_measurable_set (eventually_of_forall h't)

/-- If a function is integrable on a set `s` and vanishes almost everywhere on its complement,
then it is integrable. -/
lemma integrable_on.integrable_of_ae_not_mem_eq_zero (hf : integrable_on f s μ)
  (h't : ∀ᵐ x ∂μ, x ∉ s → f x = 0) : integrable f μ :=
begin
  rw ← integrable_on_univ,
  apply hf.of_ae_diff_eq_zero null_measurable_set_univ,
  filter_upwards [h't] with x hx h'x using hx h'x.2,
end

/-- If a function is integrable on a set `s` and vanishes everywhere on its complement,
then it is integrable. -/
lemma integrable_on.integrable_of_forall_not_mem_eq_zero (hf : integrable_on f s μ)
  (h't : ∀ x ∉ s, f x = 0) : integrable f μ :=
hf.integrable_of_ae_not_mem_eq_zero (eventually_of_forall (λ x hx, h't x hx))

lemma integrable_on_iff_integrable_of_support_subset (h1s : support f ⊆ s) :
  integrable_on f s μ ↔ integrable f μ :=
begin
  refine ⟨λ h, _, λ h, h.integrable_on⟩,
  apply h.integrable_of_forall_not_mem_eq_zero (λ x hx, _),
  contrapose! hx,
  exact h1s (mem_support.2 hx),
end

lemma integrable_on_Lp_of_measure_ne_top {E} [normed_add_comm_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

lemma integrable.lintegral_lt_top {f : α → ℝ} (hf : integrable f μ) :
  ∫⁻ x, ennreal.of_real (f x) ∂μ < ∞ :=
calc ∫⁻ x, ennreal.of_real (f x) ∂μ
    ≤ ∫⁻ x, ↑‖f x‖₊ ∂μ : lintegral_of_real_le_lintegral_nnnorm f
... < ∞ : hf.2

lemma integrable_on.set_lintegral_lt_top {f : α → ℝ} {s : set α} (hf : integrable_on f s μ) :
  ∫⁻ x in s, ennreal.of_real (f x) ∂μ < ∞ :=
integrable.lintegral_lt_top hf

/-- 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 α}

lemma integrable.integrable_at_filter (h : integrable f μ) (l : filter α) :
  integrable_at_filter f l μ :=
⟨univ, filter.univ_mem, integrable_on_univ.2 h⟩

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 ↔ 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 ←
  _root_.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 ←
  _root_.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_add_comm_group

end measure_theory

open measure_theory

variables [normed_add_comm_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

/-- A function which is continuous on a compact set `s` is almost everywhere strongly measurable
with respect to `μ.restrict s`. -/
lemma continuous_on.ae_strongly_measurable_of_is_compact
  [topological_space α] [opens_measurable_space α] [topological_space β] [pseudo_metrizable_space β]
  {f : α → β} {s : set α} {μ : measure α}
  (hf : continuous_on f s) (hs : is_compact s) (h's : measurable_set 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 h's, f '' s, _, _⟩,
  { exact (hs.image_of_continuous_on hf).is_separable },
  { exact mem_of_superset (self_mem_ae_restrict h's) (subset_preimage_image _ _) }
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

lemma continuous.integrable_at_nhds
  [topological_space α] [second_countable_topology_either α E]
  [opens_measurable_space α] {μ : measure α} [is_locally_finite_measure μ]
  {f : α → E} (hf : continuous f) (a : α) :
  integrable_at_filter f (𝓝 a) μ :=
begin
  rw ← nhds_within_univ,
  exact hf.continuous_on.integrable_at_nhds_within measurable_set.univ (mem_univ a),
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⟩


import data.nat.prime
import data.list
-- import data.bool

-- set_option trace.simplify true
set_option trace.simplify.rewrite true
set_option trace.simplify.failure false
set_option trace.simplify.rewrite_failure false

namespace first
constants a b : ℤ
constant f : ℤ → ℤ
constant g : ℤ → ℤ → ℤ

#check λ x : ℤ, g (f (g a x)) (g x _)
-- λ (x : ℤ), g (f (g a x)) (g x ?M_1) : ℤ → ℤ
#check λx, g (f (g a x)) (g x b)
-- λ x <=> λx
end first

namespace trools
-- constant trool : Type

-- constants trool.true trool.false trool.maybe : trool
inductive trool
| true : trool
| false : trool
| maybe : trool

#check trool.true -- trool.true : trool

def trool_to_bool (x : trool) : bool :=
match x with
| trool.true := tt
| trool.false := ff
| _ := ff
end

def trool_to_bool₂: trool → bool
| trool.true := tt
| trool.false := ff
| _ := ff

-- def prime (p : ℕ) := 2 ≤ p ∧ ∀ m ∣ p, m = 1 ∨ m = p
def or (a b : trool) := (a = trool.true) ∨ (b = trool.true)

-- or a a = (a = trool.true) ∨ (a = trool.true) = X ∨ X = X = (a = trool.true)
-- (a = trool.true) =>
-- case 1: trool_to_bool trool.true  ↔ (trool.true  = trool.true)
-- case 2: trool_to_bool trool.false ↔ (trool.false = trool.true)
-- case 3: trool_to_bool trool.maybe ↔ (trool.maybe = trool.true)
--
lemma or_self (a : trool) : or a a = trool_to_bool a :=
begin
  simp [or],
  cases a; dsimp [trool_to_bool],
  {
    -- rw [eq.refl trool.true], -- do nothing :D
    rw eq_self_iff_true,
    rw bool.coe_sort_tt, -- I'm found it from idea of coe_sort_ff + (if exist ff then exist tt)
  },
  {
    -- simp [trool_to_bool],
    -- [bool.coe_sort_ff]: ↥ff ==> false
    -- [iff_self]: false ↔ false ==> true
    rw bool.coe_sort_ff,
    -- apply iff.symm,
    -- change false ↔ false, -- fails
    simp,

    -- all below not useful and generated by suggest
    -- refine iff.symm _
    -- refine iff_of_eq _
    -- refine eq.to_iff _
    -- refine iff_false_intro _
  },
  {
    simp,
  },
end
end trools

namespace axiom_examples
constants a b : ℤ
-- lemma a_less_b : a < b := sorry
-- <=>
axiom a_less_b : a < b
axiom symm_lt (x y : ℤ): x < y → y > x
axiom not_eq_imp_lt (x y : ℤ): x ≠ y → x < y ∨ x > y

example : b > a :=
begin
  have s := symm_lt _ _ a_less_b,
  exact s,
end

lemma p_q_not (P Q: Prop) : P = Q → P ∧ ¬ Q → false :=
begin
  intro pq,
  rw ← pq,
  intro h,
  simp at h,
  exact h,
end

example (x: nat): x = x :=
begin
  have h1: 1 = 1,{refl,},
  have h2: 2 = 2 := rfl,
  -- have h3 := h1 ∧ h2, -- wrong
  have h3 := and.intro h1 h2, -- right
  refl,
end

constants P Q : Type
-- lemma p_q_not (p : P)(q : Q) : p = q → p ∧ ¬ q → false := sorry

lemma example_forward_proof (p : Prop) : p = p :=
begin
  -- simp, -- [simplify.rewrite] [eq_self_iff_true]: p = p ==> true
  -- refl,
  -- apply eq_self_iff_true p,

  have h1 := eq_self_iff_true p, -- we don't need this, only for example
  have h2 := h1.to_eq, -- also works: propext h1
  have h3 := h1.mpr,
  have h4 := h3 true.intro,
  exact h4,
end

#print example_forward_proof
-- λ (p : Prop), (eq_self_iff_true p).mpr true.intro

-- this can be proved by reflexivity
lemma example_forward_proof₂ (p : Prop) : p = p := eq.refl _

#print example_forward_proof₂ -- λ (p : Prop), eq.refl p

lemma example_forward_proof₃ (p q : Prop) : p = q → (p ∧ q) = p :=
begin
  assume h1 : p = q,
  have h2 : p ∧ p ↔ p := and_self p,
  have h3 : (p ∧ p) = p := h2.to_eq, -- iff.to_eq
  have h4 : (p ∧ p) = p → (p ∧ q) = p :=
    assume (h: (p ∧ p) = p), eq.subst h1 h,
  show (p ∧ q) = p, from h4 h3, -- ≈ exact h4 h3, but more readable
end

example (expr : Prop): (expr ∨ expr) → true :=
begin
  -- simp,
-- 0. [simplify.rewrite] [or_self]: expr ∨ expr ==> expr
-- 0. [simplify.rewrite] [forall_true_iff]: expr → true ==> true
  rw or_self,
  rw forall_true_iff,
  exact true.intro,
end

-- id <=> ∀ A : Type, A → A
example : ∀ A : Type, A → A := λ _, id
example : ∀ A : Type, A → A := λ A, @id A
example : ∀ A : Type, A → A := assume A, @id A
example (A : Type) : A → A := id -- explicit (argument)
example {A : Type} : A → A := id -- implicit {argument}
example ⦃A : Type⦄ : A → A := id -- i don't know, but possible

example (x y : ℤ): ¬ (x = y) ∧ ¬ (x > y) → (y > x) :=
begin
  assume f : ¬x = y ∧ ¬x > y,
  apply symm_lt,
  -- exact a_less_b, -- not works
  have f₂ : _ ∧ _ := f, -- example pattern matching
  clear f₂,
  have h₂ : ¬ (x = y) → x ≠ y, by {
    tactic.trace_state,
  -- simp,
  -- [ne.def]: x ≠ y ==> ¬x = y
  -- [classical.not_not]: ¬¬x = y ==> x = y
  -- [imp_self]: ¬x = y → ¬x = y ==> true
    show_term { rw [ne.def], },
    exact id, -- id <=> ∀ A : Type, A → A
    tactic.trace_result,
  },
  have f1 := f.1,
  have f2 := f.2,
  clear f,
  have not_eq_xy : x ≠ y := h₂ f1,
  have h₃ : x < y ∨ x > y := not_eq_imp_lt _ _ not_eq_xy,
  cases h₃ with first second,
  {
    -- first : x < y
    -- i think this one command `exact first` must be solution
    exact first,
  },
  {
    -- contradiction,
    exfalso,
    -- have t₁ := p_q_not second f2,
    -- have h₅ := p_q_not _ _,

    -- have u := and.intro second f2,
    -- simp [second] at u,
    -- exact u,
    exact absurd second f2,
  },
end

end axiom_examples

namespace backward_proofs
/-
Forward proof:
From a and a → b, we have b. (Goal unchanged)
From b and b → c, we have c, as desired.
* A forward proof only manipulates theorems, not goals.

Backward proof:
To prove c, by b → c it suffices to prove b. (Goal changed from ⊢ c to ⊢ b)
To prove b, by a → b it suffices to prove a. (Goal changed from ⊢ b to ⊢ a)
To prove a, we use a.
* A Backward proof start from the goal and work backwards towards the already proved lemmas.
-/

-- Example of forward proof:
lemma fst_of_two_props :
  ∀ a b : Prop, a → b → (a → b) :=
begin -- ⊢ ∀ (a b : Prop), a → b → a
  introv,
  intros ha hb,
  have h := imp_intro hb, -- it's example very trivial
  exact h,
end

-- Example of backward proof:
lemma fst_of_two_props' :
  ∀ a b : Prop, a → b → a :=
begin -- ⊢ ∀ (a b : Prop), a → b → a
  introv, -- ⊢ a → b → a (Goal changed)
  intros ha hb, -- ⊢ a (Goal changed)
  apply ha, -- goals accomplished (Goal changed)
end

lemma and_swap :
  ∀ a b : Prop, a ∧ b → b ∧ a :=
begin
  intros a b hab,
  apply and.intro,
  -- { exact hab.2 },
  -- { exact hab.1 },
  { exact and.elim_right hab },
  { exact and.elim_left hab },
end

def double (n : ℕ) := n + n

lemma nat_exists_double_iden :
  ∃ n : ℕ, double n = n :=
begin
  apply exists.intro 0, -- ↔ use 0
  refl,
end

lemma double_prop : ∀ n : ℕ, n ≠ 1 → double n ≠ n + 1 :=
begin
  type_check double.equations._eqn_1, -- ∀ (n : ℕ), double n = n + n
  intros,
  apply not.intro,
  induction n with x hx,
  simp [double],
  have a2 : x ≠ 0, from sorry,
  dsimp only [double],
  simp,
  -- simp at hx ⊢, -- example how to simplify goal and hypothesis simultaniously
  simp only [a],
  -- show_term { trivial, }, -- λ (a_1 : false), false.rec false a_1
  exact id, -- shortest proof
end

#print double_prop

end backward_proofs

namespace lemma_statements

set_option trace.simplify.rewrite_failure true

lemma my_add_comm (m n : ℕ) :
  nat.add m n = nat.add n m :=
begin
  simp,
  simp only [backward_proofs.double_prop, nat.add_comm],  --
  -- output:
  -- perm rejected: n + m !< m + n
  -- [simplify.rewrite] [nat.add_comm]: n + m ==> m + n

  -- simp works only with second part of equation n + m = m + n:
  -- n + m = (m + n) ==> n + m = (n + m) ==> true
  -- 1. because theorem nat.add_comm is ∀ (m n : ℕ), m + n = n + m [it's wrong]
  -- 2.
  -- maybe simp use lecsicographical order?
end

#print nat.add_comm

lemma and_swap (a b : Prop) :
  a ∧ b → b ∧ a :=
begin
  intro hab,
  apply and.intro,
  -- {
        -- apply and.elim_right,
        -- exact hab,
  -- }
  -- <=>
  -- apply and.elim_right hab, <=>
  exact hab.2,
  exact hab.1,
end

/-
  3.1 Structured Proofs
-/

lemma fst_of_two_props'' :
  ∀ a b : Prop, a → b → a :=
assume a b : Prop,
assume (ha : a)(hb : b),
show a, from ha

lemma snd_of_two_props'' :
  ∀ a b : Prop, a → b → b :=
assume _ b : Prop,
assume (_)(hb : b),
show _, from hb -- placeholder _ is important thing

lemma prop_comp (a b c : Prop) (hab : a → b) (hbc : b → c) :
  a → c :=
assume ha : a,
have hb : b := hab ha,
have hc : c := hbc hb,
show c, from hc

#print fst_of_two_props''
-- λ (a b : Prop) (ha : a) (hb : b), show a, from ha
#print snd_of_two_props''
-- λ (_x b : Prop) (_x : _x) (hb : b), show b, from hb
#print prop_comp
-- λ (a b c : Prop) (hab : a → b) (hbc : b → c) (ha : a),
--   have hb : b, from hab ha,
--   have hc : c, from hbc hb,
--   show c, from hc

/-
  3.3 Forward Reasoning about Connectives and Quantifiers
-/

-- lemma forall.one_point {α : Type} (t : α) (p : α → Prop) :
--   (∀x, x = t → p x) ↔ p t :=
-- iff.intro
--   (assume hall : ∀x, x = t → p x,
--     show p t, from
--      begin
--        apply hall t,
--        refl
--      end)
--   (assume hp : p t,
--     fix x,
--     assume heq : x = t,
--     show p x, from
--     begin
--       rewrite heq,
--       exact hp
--     end)

example : 1 = 2 → 2 = 3 → 1 = 3 :=
  λ (h₁ : 1 = 2) (h₂ : 2 = 3), @eq.subst nat (λ n, 1 = n) 2 3 h₂ h₁

example : 1 = 2 → 2 = 3 → 1 = 3 := by {
  intros h1 h2,
  -- apply @eq.subst nat (λ n, 1 = n) 2 3 h2 h1,
  -- exact eq.subst h2 h1,
  exact h2 ▸ h1,
}

lemma forall.one_point' {α : Type} (t : α) (p : α → Prop) :
  (∀x, x = t → p x) ↔ p t :=
iff.intro
  (assume hall: ∀ x, x = t → p x,
   have h₁ : t = t → p t, from hall t,
   show p t, from h₁ (rfl : t = t))
  (λ h₁ x (h₂ : x = t),
  show p x, from (h₂.symm : t = x) ▸ (h₁ : p t)) -- λ ↔ assume
  --by {
    -- refine @eq.subst α _ t x h₂.symm h₁,
  -- exact h₂.symm ▸ h₁ }

lemma beast_666 (beast : ℕ) :
  (∀n, n = 666 → beast ≥ n) ↔ beast ≥ 666 :=
forall.one_point' 666 (λ n, nat.le n beast) -- x ≥ y ↔ ge x y ↔ le y x
 -- nat.ge don't exists because developers of lean lib want to minimize number of equivalent functions
-- λ (beast : ℕ), forall.one_point' 666 (λ (n : ℕ), beast ≥ n)

#print beast_666

/-
  3.4 Calculational Proofs
-/
-- Calculational proof example:
lemma two_mul_example (m n : nat) :
  2 * m + n = m + n + m :=
calc  2 * m + n
    = (m + m) + n : by rewrite two_mul
    ... = m + n + m : by cc

-- Forward proof example:
lemma two_mul_example₂ (m n : nat) :
  2 * m + n = m + n + m :=
have h₁ : 2 * m + n = (m + m) + n :=
  by rewrite two_mul,
have h₂ : (m + m) + n = m + n + m :=
  by show_term { cc },
show _, from
  eq.trans h₁ h₂

end lemma_statements

namespace proofs_by_induction

constant add : ℕ → ℕ → ℕ

axiom add_zero (m : ℕ): add m 0 = m
axiom add_succ (m n : ℕ): add n (nat.succ n) = nat.succ (add m n)

-- lemma add_zero (n : ℕ)

end proofs_by_induction

namespace induction_by_pattern_matching

def reverse {α : Type} : list α → list α
| []       := []
| (x :: xs) := reverse xs ++ [x]

-- The induction step is:
-- ih : ∀xs, reverse (reverse xs) = xs ⊢ reverse (reverse xs ++ [x]) = x :: xs

/-
We need a way to "distribute" the outer reverse over ++ to obtain a term
matches the induction hypothesis's left-hand side. The trick is to prove
and use the following lemma:
-/

-- Step 1:
-- lemma reverse_append {α : Type} :
--   ∀xs ys : list α, reverse (xs ++ ys) = reverse ys ++ reverse xs
-- | [] ys := sorry
-- | (x :: xs) ys := sorry

-- Step 2:

-- failed to prove recursive application is decreasing, well founded relation
lemma reverse_append_wrong {α : Type} :
  ∀ xs ys : list α, reverse (xs ++ ys) = reverse ys ++ reverse xs
| [] ys := begin
  -- rw reverse,
  -- simp,
  rw reverse_append_wrong,
end
| (x :: xs) ys := begin
  simp [reverse, reverse_append_wrong xs],
end

-- OK
lemma reverse_append {α : Type} :
  ∀ xs ys : list α, reverse (xs ++ ys) = reverse ys ++ reverse xs
| [] ys := begin
  rw reverse,
  simp only [list.nil_append, list.append_nil],
  -- rw reverse_append,
end
| (x :: xs) ys := begin
  simp only [reverse, reverse_append xs, list.append_assoc, list.cons_append],
end

lemma reverse_append₂ {α : Type} (xs ys : list α) :
  reverse (xs ++ ys) = reverse ys ++ reverse xs :=
begin
  induction xs with xs list_h ih,
  case nil {
    simp [reverse],
  },
  case cons {
    simp [reverse, ih],
  },
end

set_option trace.simp_lemmas false

lemma reverse_reverse {α : Type} :
  ∀xs : list α, reverse (reverse xs) = xs
| [] := rfl
| (x :: xs) := begin
  -- rw reverse_reverse, -- failed to prove recursive application is decreasing
  rw reverse,
  rw reverse_append,
  rw reverse_reverse,
  rw reverse.equations._eqn_2,
  rw reverse.equations._eqn_1,
  rw list.nil_append,
  rw list.cons_append,
  rw list.nil_append,
  -- rw reverse,
  -- simp [reverse],
  -- Trace output of simplify.rewrite:
  -- 1. [reverse.equations._eqn_2]: reverse [x] ==> reverse list.nil ++ [x]
  -- 2. [reverse.equations._eqn_1]: reverse list.nil ==> list.nil
  -- 3. [list.nil_append]: list.nil ++ [x] ==> [x]
  -- 4. [list.cons_append]: [x] ++ xs ==> x :: (list.nil ++ xs)
  -- 5. [list.nil_append]: list.nil ++ xs ==> xs
  -- 6. [eq_self_iff_true]: x = x ==> true
  -- 7. [eq_self_iff_true]: xs = xs ==> true
  -- 8. [and_self]: true ∧ true ==> true
end

lemma reverse_reverse₂ {α : Type} :
  ∀xs : list α, reverse (reverse xs) = xs
| [] := rfl
| (x :: xs) := by simp [reverse, reverse_append, reverse_reverse₂ xs]

end induction_by_pattern_matching
namespace inductive_types

namespace hidden
inductive nat : Type
| zero : nat
| succ : nat → nat
end hidden
-- <=>
namespace hidden2
constant nat : Type
constant nat.zero : nat
constant nat.succ : nat → nat
end hidden2
-- + some properties about nat.zero and nat.succ, which is why we use the "inductive" commmand

set_option trace.debug.dsimplify true
-- set_option trace.simplify false
set_option trace.simplify.context false
set_option trace.simplify.congruence false
set_option trace.simplify.canonize false
set_option trace.simplify.rewrite true

lemma succ_neq_self (n : ℕ) :
  nat.succ n ≠ n :=
begin
  induction n with n ih,
  {
    -- [nat.nat_zero_eq_zero]: 0 ==> 0
    -- [ne.def]: 1 ≠ 0 ==> ¬1 = 0
    simp,
  },
  {
    rewrite ne.def,
    simp only [ih, ne.def, not_false_iff],
  },
  -- [ne.def]: n_n.succ.succ ≠ n_n.succ ==> ¬n_n.succ.succ = n_n.succ
-- 2. [simplify.rewrite] [n_ih]: n_n.succ = n_n ==> false
-- [simplify] eq: not
-- 1. [simplify.rewrite] [not_false_iff]: ¬false ==> true
end

end inductive_types


/-
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.analysis.normed_space.banach
import Mathlib.analysis.normed_space.finite_dimension
import Mathlib.PostPort

universes u_1 u_2 u_3 u_4

namespace Mathlib

/-!
# Complemented subspaces of normed vector spaces

A submodule `p` of a topological module `E` over `R` is called *complemented* if there exists
a continuous linear projection `f : E →ₗ[R] p`, `∀ x : p, f x = x`. We prove that for
a closed subspace of a normed space this condition is equivalent to existence of a closed
subspace `q` such that `p ⊓ q = ⊥`, `p ⊔ q = ⊤`. We also prove that a subspace of finite codimension
is always a complemented subspace.

## Tags

complemented subspace, normed vector space
-/

namespace continuous_linear_map

theorem ker_closed_complemented_of_finite_dimensional_range {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] [complete_space 𝕜] (f : continuous_linear_map 𝕜 E F) [finite_dimensional 𝕜 ↥(range f)] : submodule.closed_complemented (ker f) := sorry

/-- If `f : E →L[R] F` and `g : E →L[R] G` are two surjective linear maps and
their kernels are complement of each other, then `x ↦ (f x, g x)` defines
a linear equivalence `E ≃L[R] F × G`. -/
def equiv_prod_of_surjective_of_is_compl {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] {G : Type u_4} [normed_group G] [normed_space 𝕜 G] [complete_space E] [complete_space (F × G)] (f : continuous_linear_map 𝕜 E F) (g : continuous_linear_map 𝕜 E G) (hf : range f = ⊤) (hg : range g = ⊤) (hfg : is_compl (ker f) (ker g)) : continuous_linear_equiv 𝕜 E (F × G) :=
  linear_equiv.to_continuous_linear_equiv_of_continuous
    (linear_map.equiv_prod_of_surjective_of_is_compl (↑f) (↑g) hf hg hfg) sorry

@[simp] theorem coe_equiv_prod_of_surjective_of_is_compl {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] {G : Type u_4} [normed_group G] [normed_space 𝕜 G] [complete_space E] [complete_space (F × G)] {f : continuous_linear_map 𝕜 E F} {g : continuous_linear_map 𝕜 E G} (hf : range f = ⊤) (hg : range g = ⊤) (hfg : is_compl (ker f) (ker g)) : ↑(equiv_prod_of_surjective_of_is_compl f g hf hg hfg) = ↑(continuous_linear_map.prod f g) :=
  rfl

@[simp] theorem equiv_prod_of_surjective_of_is_compl_to_linear_equiv {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] {G : Type u_4} [normed_group G] [normed_space 𝕜 G] [complete_space E] [complete_space (F × G)] {f : continuous_linear_map 𝕜 E F} {g : continuous_linear_map 𝕜 E G} (hf : range f = ⊤) (hg : range g = ⊤) (hfg : is_compl (ker f) (ker g)) : continuous_linear_equiv.to_linear_equiv (equiv_prod_of_surjective_of_is_compl f g hf hg hfg) =
  linear_map.equiv_prod_of_surjective_of_is_compl (↑f) (↑g) hf hg hfg :=
  rfl

@[simp] theorem equiv_prod_of_surjective_of_is_compl_apply {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] {F : Type u_3} [normed_group F] [normed_space 𝕜 F] {G : Type u_4} [normed_group G] [normed_space 𝕜 G] [complete_space E] [complete_space (F × G)] {f : continuous_linear_map 𝕜 E F} {g : continuous_linear_map 𝕜 E G} (hf : range f = ⊤) (hg : range g = ⊤) (hfg : is_compl (ker f) (ker g)) (x : E) : coe_fn (equiv_prod_of_surjective_of_is_compl f g hf hg hfg) x = (coe_fn f x, coe_fn g x) :=
  rfl

end continuous_linear_map

namespace subspace

/-- If `q` is a closed complement of a closed subspace `p`, then `p × q` is continuously
isomorphic to `E`. -/
def prod_equiv_of_closed_compl {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] [complete_space E] (p : subspace 𝕜 E) (q : subspace 𝕜 E) (h : is_compl p q) (hp : is_closed ↑p) (hq : is_closed ↑q) : continuous_linear_equiv 𝕜 (↥p × ↥q) E :=
  linear_equiv.to_continuous_linear_equiv_of_continuous (submodule.prod_equiv_of_is_compl p q h) sorry

/-- Projection to a closed submodule along a closed complement. -/
def linear_proj_of_closed_compl {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] [complete_space E] (p : subspace 𝕜 E) (q : subspace 𝕜 E) (h : is_compl p q) (hp : is_closed ↑p) (hq : is_closed ↑q) : continuous_linear_map 𝕜 E ↥p :=
  continuous_linear_map.comp (continuous_linear_map.fst 𝕜 ↥p ↥q)
    ↑(continuous_linear_equiv.symm (prod_equiv_of_closed_compl p q h hp hq))

@[simp] theorem coe_prod_equiv_of_closed_compl {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] [complete_space E] {p : subspace 𝕜 E} {q : subspace 𝕜 E} (h : is_compl p q) (hp : is_closed ↑p) (hq : is_closed ↑q) : ⇑(prod_equiv_of_closed_compl p q h hp hq) = ⇑(submodule.prod_equiv_of_is_compl p q h) :=
  rfl

@[simp] theorem coe_prod_equiv_of_closed_compl_symm {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] [complete_space E] {p : subspace 𝕜 E} {q : subspace 𝕜 E} (h : is_compl p q) (hp : is_closed ↑p) (hq : is_closed ↑q) : ⇑(continuous_linear_equiv.symm (prod_equiv_of_closed_compl p q h hp hq)) =
  ⇑(linear_equiv.symm (submodule.prod_equiv_of_is_compl p q h)) :=
  rfl

@[simp] theorem coe_continuous_linear_proj_of_closed_compl {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] [complete_space E] {p : subspace 𝕜 E} {q : subspace 𝕜 E} (h : is_compl p q) (hp : is_closed ↑p) (hq : is_closed ↑q) : ↑(linear_proj_of_closed_compl p q h hp hq) = submodule.linear_proj_of_is_compl p q h :=
  rfl

@[simp] theorem coe_continuous_linear_proj_of_closed_compl' {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] [complete_space E] {p : subspace 𝕜 E} {q : subspace 𝕜 E} (h : is_compl p q) (hp : is_closed ↑p) (hq : is_closed ↑q) : ⇑(linear_proj_of_closed_compl p q h hp hq) = ⇑(submodule.linear_proj_of_is_compl p q h) :=
  rfl

theorem closed_complemented_of_closed_compl {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] [complete_space E] {p : subspace 𝕜 E} {q : subspace 𝕜 E} (h : is_compl p q) (hp : is_closed ↑p) (hq : is_closed ↑q) : submodule.closed_complemented p :=
  Exists.intro (linear_proj_of_closed_compl p q h hp hq) (submodule.linear_proj_of_is_compl_apply_left h)

theorem closed_complemented_iff_has_closed_compl {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] [complete_space E] {p : subspace 𝕜 E} : submodule.closed_complemented p ↔ is_closed ↑p ∧ ∃ (q : subspace 𝕜 E), ∃ (hq : is_closed ↑q), is_compl p q := sorry

theorem closed_complemented_of_quotient_finite_dimensional {𝕜 : Type u_1} [nondiscrete_normed_field 𝕜] {E : Type u_2} [normed_group E] [normed_space 𝕜 E] [complete_space E] {p : subspace 𝕜 E} [complete_space 𝕜] [finite_dimensional 𝕜 (submodule.quotient p)] (hp : is_closed ↑p) : submodule.closed_complemented p := sorry