/-
Copyright (c) 2020 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn
-/
import measure_theory.constructions.prod
import measure_theory.group.measure
import topology.constructions

/-!
# Product measures

In this file we define and prove properties about finite products of measures
(and at some point, countable products of measures).

## Main definition

* `measure_theory.measure.pi`: The product of finitely many σ-finite measures.
  Given `μ : Π i : ι, measure (α i)` for `[fintype ι]` it has type `measure (Π i : ι, α i)`.

To apply Fubini along some subset of the variables, use
`measure_theory.measure_preserving_pi_equiv_pi_subtype_prod` to reduce to the situation of a product
of two measures: this lemma states that the bijection
`measurable_equiv.pi_equiv_pi_subtype_prod α p` between `(Π i : ι, α i)` and
`(Π i : {i // p i}, α i) × (Π i : {i // ¬ p i}, α i)` maps a product measure to a direct product of
product measures, to which one can apply the usual Fubini for direct product of measures.

## Implementation Notes

We define `measure_theory.outer_measure.pi`, the product of finitely many outer measures, as the
maximal outer measure `n` with the property that `n (pi univ s) ≤ ∏ i, m i (s i)`,
where `pi univ s` is the product of the sets `{s i | i : ι}`.

We then show that this induces a product of measures, called `measure_theory.measure.pi`.
For a collection of σ-finite measures `μ` and a collection of measurable sets `s` we show that
`measure.pi μ (pi univ s) = ∏ i, m i (s i)`. To do this, we follow the following steps:
* We know that there is some ordering on `ι`, given by an element of `[countable ι]`.
* Using this, we have an equivalence `measurable_equiv.pi_measurable_equiv_tprod` between
  `Π ι, α i` and an iterated product of `α i`, called `list.tprod α l` for some list `l`.
* On this iterated product we can easily define a product measure `measure_theory.measure.tprod`
  by iterating `measure_theory.measure.prod`
* Using the previous two steps we construct `measure_theory.measure.pi'` on `Π ι, α i` for countable
  `ι`.
* We know that `measure_theory.measure.pi'` sends products of sets to products of measures, and
  since `measure_theory.measure.pi` is the maximal such measure (or at least, it comes from an outer
  measure which is the maximal such outer measure), we get the same rule for
  `measure_theory.measure.pi`.

## Tags

finitary product measure

-/

noncomputable theory
open function set measure_theory.outer_measure filter measurable_space encodable
open_locale classical big_operators topology ennreal

universes u v

variables {ι ι' : Type*} {α : ι → Type*}

/-! We start with some measurability properties -/

/-- Boxes formed by π-systems form a π-system. -/
lemma is_pi_system.pi {C : Π i, set (set (α i))} (hC : ∀ i, is_pi_system (C i)) :
  is_pi_system (pi univ '' pi univ C) :=
begin
  rintro _ ⟨s₁, hs₁, rfl⟩ _ ⟨s₂, hs₂, rfl⟩ hst,
  rw [← pi_inter_distrib] at hst ⊢, rw [univ_pi_nonempty_iff] at hst,
  exact mem_image_of_mem _ (λ i _, hC i _ (hs₁ i (mem_univ i)) _ (hs₂ i (mem_univ i)) (hst i))
end

/-- Boxes form a π-system. -/
lemma is_pi_system_pi [Π i, measurable_space (α i)] :
  is_pi_system (pi univ '' pi univ (λ i, {s : set (α i) | measurable_set s})) :=
is_pi_system.pi (λ i, is_pi_system_measurable_set)

section finite
variables [finite ι] [finite ι']

/-- Boxes of countably spanning sets are countably spanning. -/
lemma is_countably_spanning.pi {C : Π i, set (set (α i))}
  (hC : ∀ i, is_countably_spanning (C i)) :
  is_countably_spanning (pi univ '' pi univ C) :=
begin
  choose s h1s h2s using hC,
  casesI nonempty_encodable (ι → ℕ),
  let e : ℕ → (ι → ℕ) := λ n, (decode (ι → ℕ) n).iget,
  refine ⟨λ n, pi univ (λ i, s i (e n i)), λ n, mem_image_of_mem _ (λ i _, h1s i _), _⟩,
  simp_rw [(surjective_decode_iget (ι → ℕ)).Union_comp (λ x, pi univ (λ i, s i (x i))),
      Union_univ_pi s, h2s, pi_univ]
end

/-- The product of generated σ-algebras is the one generated by boxes, if both generating sets
  are countably spanning. -/
lemma generate_from_pi_eq {C : Π i, set (set (α i))}
  (hC : ∀ i, is_countably_spanning (C i)) :
  @measurable_space.pi _ _ (λ i, generate_from (C i)) = generate_from (pi univ '' pi univ C) :=
begin
  casesI nonempty_encodable ι,
  apply le_antisymm,
  { refine supr_le _, intro i, rw [comap_generate_from],
    apply generate_from_le, rintro _ ⟨s, hs, rfl⟩, dsimp,
    choose t h1t h2t using hC,
    simp_rw [eval_preimage, ← h2t],
    rw [← @Union_const _ ℕ _ s],
    have : (pi univ (update (λ (i' : ι), Union (t i')) i (⋃ (i' : ℕ), s))) =
      (pi univ (λ k, ⋃ j : ℕ, @update ι (λ i', set (α i')) _ (λ i', t i' j) i s k)),
    { ext, simp_rw [mem_univ_pi], apply forall_congr, intro i',
      by_cases (i' = i), { subst h, simp }, { rw [← ne.def] at h, simp [h] }},
    rw [this, ← Union_univ_pi],
    apply measurable_set.Union,
    intro n, apply measurable_set_generate_from,
    apply mem_image_of_mem, intros j _, dsimp only,
    by_cases h: j = i, subst h, rwa [update_same], rw [update_noteq h], apply h1t },
  { apply generate_from_le, rintro _ ⟨s, hs, rfl⟩,
    rw [univ_pi_eq_Inter], apply measurable_set.Inter, intro i, apply measurable_pi_apply,
    exact measurable_set_generate_from (hs i (mem_univ i)) }
end

/-- If `C` and `D` generate the σ-algebras on `α` resp. `β`, then rectangles formed by `C` and `D`
  generate the σ-algebra on `α × β`. -/
lemma generate_from_eq_pi [h : Π i, measurable_space (α i)]
  {C : Π i, set (set (α i))} (hC : ∀ i, generate_from (C i) = h i)
  (h2C : ∀ i, is_countably_spanning (C i)) :
  generate_from (pi univ '' pi univ C) = measurable_space.pi :=
by rw [← funext hC, generate_from_pi_eq h2C]

/-- The product σ-algebra is generated from boxes, i.e. `s ×ˢ t` for sets `s : set α` and
  `t : set β`. -/
lemma generate_from_pi [Π i, measurable_space (α i)] :
  generate_from (pi univ '' pi univ (λ i, { s : set (α i) | measurable_set s})) =
  measurable_space.pi :=
generate_from_eq_pi (λ i, generate_from_measurable_set) (λ i, is_countably_spanning_measurable_set)

end finite

namespace measure_theory

variables [fintype ι] {m : Π i, outer_measure (α i)}

/-- An upper bound for the measure in a finite product space.
  It is defined to by taking the image of the set under all projections, and taking the product
  of the measures of these images.
  For measurable boxes it is equal to the correct measure. -/
@[simp] def pi_premeasure (m : Π i, outer_measure (α i)) (s : set (Π i, α i)) : ℝ≥0∞ :=
∏ i, m i (eval i '' s)

lemma pi_premeasure_pi {s : Π i, set (α i)} (hs : (pi univ s).nonempty) :
  pi_premeasure m (pi univ s) = ∏ i, m i (s i) :=
by simp [hs]

lemma pi_premeasure_pi' {s : Π i, set (α i)} :
  pi_premeasure m (pi univ s) = ∏ i, m i (s i) :=
begin
  casesI is_empty_or_nonempty ι,
  { simp, },
  cases (pi univ s).eq_empty_or_nonempty with h h,
  { rcases univ_pi_eq_empty_iff.mp h with ⟨i, hi⟩,
    have : ∃ i, m i (s i) = 0 := ⟨i, by simp [hi]⟩,
    simpa [h, finset.card_univ, zero_pow (fintype.card_pos_iff.mpr ‹_›),
      @eq_comm _ (0 : ℝ≥0∞), finset.prod_eq_zero_iff] },
  { simp [h] }
end

lemma pi_premeasure_pi_mono {s t : set (Π i, α i)} (h : s ⊆ t) :
  pi_premeasure m s ≤ pi_premeasure m t :=
finset.prod_le_prod' (λ i _, (m i).mono' (image_subset _ h))

lemma pi_premeasure_pi_eval {s : set (Π i, α i)} :
  pi_premeasure m (pi univ (λ i, eval i '' s)) = pi_premeasure m s :=
by simp [pi_premeasure_pi']

namespace outer_measure

/-- `outer_measure.pi m` is the finite product of the outer measures `{m i | i : ι}`.
  It is defined to be the maximal outer measure `n` with the property that
  `n (pi univ s) ≤ ∏ i, m i (s i)`, where `pi univ s` is the product of the sets
  `{s i | i : ι}`. -/
protected def pi (m : Π i, outer_measure (α i)) : outer_measure (Π i, α i) :=
bounded_by (pi_premeasure m)

lemma pi_pi_le (m : Π i, outer_measure (α i)) (s : Π i, set (α i)) :
  outer_measure.pi m (pi univ s) ≤ ∏ i, m i (s i) :=
by { cases (pi univ s).eq_empty_or_nonempty with h h, simp [h],
     exact (bounded_by_le _).trans_eq (pi_premeasure_pi h) }

lemma le_pi {m : Π i, outer_measure (α i)} {n : outer_measure (Π i, α i)} :
  n ≤ outer_measure.pi m ↔ ∀ (s : Π i, set (α i)), (pi univ s).nonempty →
    n (pi univ s) ≤ ∏ i, m i (s i) :=
begin
  rw [outer_measure.pi, le_bounded_by'], split,
  { intros h s hs, refine (h _ hs).trans_eq (pi_premeasure_pi hs) },
  { intros h s hs, refine le_trans (n.mono $ subset_pi_eval_image univ s) (h _ _),
    simp [univ_pi_nonempty_iff, hs] }
end

end outer_measure

namespace measure

variables [Π i, measurable_space (α i)] (μ : Π i, measure (α i))

section tprod

open list
variables {δ : Type*} {π : δ → Type*} [∀ x, measurable_space (π x)]

/-- A product of measures in `tprod α l`. -/
-- for some reason the equation compiler doesn't like this definition
protected def tprod (l : list δ) (μ : Π i, measure (π i)) : measure (tprod π l) :=
by { induction l with i l ih, exact dirac punit.star, exact (μ i).prod ih }

@[simp] lemma tprod_nil (μ : Π i, measure (π i)) : measure.tprod [] μ = dirac punit.star := rfl

@[simp] lemma tprod_cons (i : δ) (l : list δ) (μ : Π i, measure (π i)) :
  measure.tprod (i :: l) μ = (μ i).prod (measure.tprod l μ) := rfl

instance sigma_finite_tprod (l : list δ) (μ : Π i, measure (π i)) [∀ i, sigma_finite (μ i)] :
  sigma_finite (measure.tprod l μ) :=
begin
  induction l with i l ih,
  { rw [tprod_nil], apply_instance },
  { rw [tprod_cons], resetI, apply_instance }
end

lemma tprod_tprod (l : list δ) (μ : Π i, measure (π i)) [∀ i, sigma_finite (μ i)]
  (s : Π i, set (π i)) :
  measure.tprod l μ (set.tprod l s) = (l.map (λ i, (μ i) (s i))).prod :=
begin
  induction l with i l ih, { simp },
  rw [tprod_cons, set.tprod, prod_prod, map_cons, prod_cons, ih]
end

end tprod

section encodable

open list measurable_equiv
variables [encodable ι]

/-- The product measure on an encodable finite type, defined by mapping `measure.tprod` along the
  equivalence `measurable_equiv.pi_measurable_equiv_tprod`.
  The definition `measure_theory.measure.pi` should be used instead of this one. -/
def pi' : measure (Π i, α i) :=
measure.map (tprod.elim' mem_sorted_univ) (measure.tprod (sorted_univ ι) μ)

lemma pi'_pi [∀ i, sigma_finite (μ i)] (s : Π i, set (α i)) : pi' μ (pi univ s) = ∏ i, μ i (s i) :=
by rw [pi', ← measurable_equiv.pi_measurable_equiv_tprod_symm_apply, measurable_equiv.map_apply,
  measurable_equiv.pi_measurable_equiv_tprod_symm_apply, elim_preimage_pi, tprod_tprod _ μ,
  ← list.prod_to_finset, sorted_univ_to_finset]; exact sorted_univ_nodup ι

end encodable

lemma pi_caratheodory :
  measurable_space.pi ≤ (outer_measure.pi (λ i, (μ i).to_outer_measure)).caratheodory :=
begin
  refine supr_le _,
  intros i s hs,
  rw [measurable_space.comap] at hs,
  rcases hs with ⟨s, hs, rfl⟩,
  apply bounded_by_caratheodory,
  intro t,
  simp_rw [pi_premeasure],
  refine finset.prod_add_prod_le' (finset.mem_univ i) _ _ _,
  { simp [image_inter_preimage, image_diff_preimage, measure_inter_add_diff _ hs, le_refl] },
  { rintro j - hj, apply mono', apply image_subset, apply inter_subset_left },
  { rintro j - hj, apply mono', apply image_subset, apply diff_subset }
end

/-- `measure.pi μ` is the finite product of the measures `{μ i | i : ι}`.
  It is defined to be measure corresponding to `measure_theory.outer_measure.pi`. -/
@[irreducible] protected def pi : measure (Π i, α i) :=
to_measure (outer_measure.pi (λ i, (μ i).to_outer_measure)) (pi_caratheodory μ)

lemma pi_pi_aux [∀ i, sigma_finite (μ i)] (s : Π i, set (α i)) (hs : ∀ i, measurable_set (s i)) :
  measure.pi μ (pi univ s) = ∏ i, μ i (s i) :=
begin
  refine le_antisymm _ _,
  { rw [measure.pi, to_measure_apply _ _ (measurable_set.pi countable_univ (λ i _, hs i))],
    apply outer_measure.pi_pi_le },
  { haveI : encodable ι := fintype.to_encodable ι,
    rw [← pi'_pi μ s],
    simp_rw [← pi'_pi μ s, measure.pi, to_measure_apply _ _ (measurable_set.pi countable_univ
      (λ i _, hs i)), ← to_outer_measure_apply],
    suffices : (pi' μ).to_outer_measure ≤ outer_measure.pi (λ i, (μ i).to_outer_measure),
    { exact this _ },
    clear hs s,
    rw [outer_measure.le_pi],
    intros s hs,
    simp_rw [to_outer_measure_apply],
    exact (pi'_pi μ s).le }
end

variable {μ}

/-- `measure.pi μ` has finite spanning sets in rectangles of finite spanning sets. -/
def finite_spanning_sets_in.pi {C : Π i, set (set (α i))}
  (hμ : ∀ i, (μ i).finite_spanning_sets_in (C i)) :
  (measure.pi μ).finite_spanning_sets_in (pi univ '' pi univ C) :=
begin
  haveI := λ i, (hμ i).sigma_finite,
  haveI := fintype.to_encodable ι,
  refine ⟨λ n, pi univ (λ i, (hμ i).set ((decode (ι → ℕ) n).iget i)), λ n, _, λ n, _, _⟩;
  -- TODO (kmill) If this let comes before the refine, while the noncomputability checker
  -- correctly sees this definition is computable, the Lean VM fails to see the binding is
  -- computationally irrelevant. The `noncomputable theory` doesn't help because all it does
  -- is insert `noncomputable` for you when necessary.
  let e : ℕ → (ι → ℕ) := λ n, (decode (ι → ℕ) n).iget,
  { refine mem_image_of_mem _ (λ i _, (hμ i).set_mem _) },
  { calc measure.pi μ (pi univ (λ i, (hμ i).set (e n i)))
        ≤ measure.pi μ (pi univ (λ i, to_measurable (μ i) ((hμ i).set (e n i)))) :
      measure_mono (pi_mono $ λ i hi, subset_to_measurable _ _)
    ... = ∏ i, μ i (to_measurable (μ i) ((hμ i).set (e n i))) :
      pi_pi_aux μ _ (λ i, measurable_set_to_measurable _ _)
    ... = ∏ i, μ i ((hμ i).set (e n i)) :
      by simp only [measure_to_measurable]
    ... < ∞ : ennreal.prod_lt_top (λ i hi, ((hμ i).finite _).ne) },
  { simp_rw [(surjective_decode_iget (ι → ℕ)).Union_comp (λ x, pi univ (λ i, (hμ i).set (x i))),
      Union_univ_pi (λ i, (hμ i).set), (hμ _).spanning, set.pi_univ] }
end

/-- A measure on a finite product space equals the product measure if they are equal on rectangles
  with as sides sets that generate the corresponding σ-algebras. -/
lemma pi_eq_generate_from {C : Π i, set (set (α i))}
  (hC : ∀ i, generate_from (C i) = by apply_assumption)
  (h2C : ∀ i, is_pi_system (C i))
  (h3C : ∀ i, (μ i).finite_spanning_sets_in (C i))
  {μν : measure (Π i, α i)}
  (h₁ : ∀ s : Π i, set (α i), (∀ i, s i ∈ C i) → μν (pi univ s) = ∏ i, μ i (s i)) :
    measure.pi μ = μν :=
begin
  have h4C : ∀ i (s : set (α i)), s ∈ C i → measurable_set s,
  { intros i s hs, rw [← hC], exact measurable_set_generate_from hs },
  refine (finite_spanning_sets_in.pi h3C).ext
    (generate_from_eq_pi hC (λ i, (h3C i).is_countably_spanning)).symm
    (is_pi_system.pi h2C) _,
  rintro _ ⟨s, hs, rfl⟩,
  rw [mem_univ_pi] at hs,
  haveI := λ i, (h3C i).sigma_finite,
  simp_rw [h₁ s hs, pi_pi_aux μ s (λ i, h4C i _ (hs i))]
end

variables [∀ i, sigma_finite (μ i)]

/-- A measure on a finite product space equals the product measure if they are equal on
  rectangles. -/
lemma pi_eq {μ' : measure (Π i, α i)}
  (h : ∀ s : Π i, set (α i), (∀ i, measurable_set (s i)) → μ' (pi univ s) = ∏ i, μ i (s i)) :
  measure.pi μ = μ' :=
pi_eq_generate_from (λ i, generate_from_measurable_set)
  (λ i, is_pi_system_measurable_set)
  (λ i, (μ i).to_finite_spanning_sets_in) h

variables (μ)

lemma pi'_eq_pi [encodable ι] : pi' μ = measure.pi μ :=
eq.symm $ pi_eq $ λ s hs, pi'_pi μ s

@[simp] lemma pi_pi (s : Π i, set (α i)) : measure.pi μ (pi univ s) = ∏ i, μ i (s i) :=
begin
  haveI : encodable ι := fintype.to_encodable ι,
  rw [← pi'_eq_pi, pi'_pi]
end

lemma pi_univ : measure.pi μ univ = ∏ i, μ i univ := by rw [← pi_univ, pi_pi μ]

lemma pi_ball [∀ i, metric_space (α i)] (x : Π i, α i) {r : ℝ}
  (hr : 0 < r) :
  measure.pi μ (metric.ball x r) = ∏ i, μ i (metric.ball (x i) r) :=
by rw [ball_pi _ hr, pi_pi]

lemma pi_closed_ball [∀ i, metric_space (α i)] (x : Π i, α i) {r : ℝ}
  (hr : 0 ≤ r) :
  measure.pi μ (metric.closed_ball x r) = ∏ i, μ i (metric.closed_ball (x i) r) :=
by rw [closed_ball_pi _ hr, pi_pi]

instance pi.sigma_finite : sigma_finite (measure.pi μ) :=
(finite_spanning_sets_in.pi (λ i, (μ i).to_finite_spanning_sets_in)).sigma_finite

lemma pi_of_empty {α : Type*} [is_empty α] {β : α → Type*} {m : Π a, measurable_space (β a)}
  (μ : Π a : α, measure (β a)) (x : Π a, β a := is_empty_elim) :
  measure.pi μ = dirac x :=
begin
  haveI : ∀ a, sigma_finite (μ a) := is_empty_elim,
  refine pi_eq (λ s hs, _),
  rw [fintype.prod_empty, dirac_apply_of_mem],
  exact is_empty_elim
end

lemma pi_eval_preimage_null {i : ι} {s : set (α i)} (hs : μ i s = 0) :
  measure.pi μ (eval i ⁻¹' s) = 0 :=
begin
  /- WLOG, `s` is measurable -/
  rcases exists_measurable_superset_of_null hs with ⟨t, hst, htm, hμt⟩,
  suffices : measure.pi μ (eval i ⁻¹' t) = 0,
    from measure_mono_null (preimage_mono hst) this,
  clear_dependent s,
  /- Now rewrite it as `set.pi`, and apply `pi_pi` -/
  rw [← univ_pi_update_univ, pi_pi],
  apply finset.prod_eq_zero (finset.mem_univ i),
  simp [hμt]
end

lemma pi_hyperplane (i : ι) [has_no_atoms (μ i)] (x : α i) :
  measure.pi μ {f : Π i, α i | f i = x} = 0 :=
show measure.pi μ (eval i ⁻¹' {x}) = 0,
from pi_eval_preimage_null _ (measure_singleton x)

lemma ae_eval_ne (i : ι) [has_no_atoms (μ i)] (x : α i) :
  ∀ᵐ y : Π i, α i ∂measure.pi μ, y i ≠ x :=
compl_mem_ae_iff.2 (pi_hyperplane μ i x)

variable {μ}

lemma tendsto_eval_ae_ae {i : ι} : tendsto (eval i) (measure.pi μ).ae (μ i).ae :=
λ s hs, pi_eval_preimage_null μ hs

lemma ae_pi_le_pi : (measure.pi μ).ae ≤ filter.pi (λ i, (μ i).ae) :=
le_infi $ λ i, tendsto_eval_ae_ae.le_comap

lemma ae_eq_pi {β : ι → Type*} {f f' : Π i, α i → β i} (h : ∀ i, f i =ᵐ[μ i] f' i) :
  (λ (x : Π i, α i) i, f i (x i)) =ᵐ[measure.pi μ] (λ x i, f' i (x i)) :=
(eventually_all.2 (λ i, tendsto_eval_ae_ae.eventually (h i))).mono $ λ x hx, funext hx

lemma ae_le_pi {β : ι → Type*} [Π i, preorder (β i)] {f f' : Π i, α i → β i}
  (h : ∀ i, f i ≤ᵐ[μ i] f' i) :
  (λ (x : Π i, α i) i, f i (x i)) ≤ᵐ[measure.pi μ] (λ x i, f' i (x i)) :=
(eventually_all.2 (λ i, tendsto_eval_ae_ae.eventually (h i))).mono $ λ x hx, hx

lemma ae_le_set_pi {I : set ι} {s t : Π i, set (α i)} (h : ∀ i ∈ I, s i ≤ᵐ[μ i] t i) :
  (set.pi I s) ≤ᵐ[measure.pi μ] (set.pi I t) :=
((eventually_all_finite I.to_finite).2
  (λ i hi, tendsto_eval_ae_ae.eventually (h i hi))).mono $
    λ x hst hx i hi, hst i hi $ hx i hi

lemma ae_eq_set_pi {I : set ι} {s t : Π i, set (α i)} (h : ∀ i ∈ I, s i =ᵐ[μ i] t i) :
  (set.pi I s) =ᵐ[measure.pi μ] (set.pi I t) :=
(ae_le_set_pi (λ i hi, (h i hi).le)).antisymm (ae_le_set_pi (λ i hi, (h i hi).symm.le))

section intervals

variables {μ} [Π i, partial_order (α i)] [∀ i, has_no_atoms (μ i)]

lemma pi_Iio_ae_eq_pi_Iic {s : set ι} {f : Π i, α i} :
  pi s (λ i, Iio (f i)) =ᵐ[measure.pi μ] pi s (λ i, Iic (f i)) :=
ae_eq_set_pi $ λ i hi, Iio_ae_eq_Iic

lemma pi_Ioi_ae_eq_pi_Ici {s : set ι} {f : Π i, α i} :
  pi s (λ i, Ioi (f i)) =ᵐ[measure.pi μ] pi s (λ i, Ici (f i)) :=
ae_eq_set_pi $ λ i hi, Ioi_ae_eq_Ici

lemma univ_pi_Iio_ae_eq_Iic {f : Π i, α i} :
  pi univ (λ i, Iio (f i)) =ᵐ[measure.pi μ] Iic f :=
by { rw ← pi_univ_Iic, exact pi_Iio_ae_eq_pi_Iic }

lemma univ_pi_Ioi_ae_eq_Ici {f : Π i, α i} :
  pi univ (λ i, Ioi (f i)) =ᵐ[measure.pi μ] Ici f :=
by { rw ← pi_univ_Ici, exact pi_Ioi_ae_eq_pi_Ici }

lemma pi_Ioo_ae_eq_pi_Icc {s : set ι} {f g : Π i, α i} :
  pi s (λ i, Ioo (f i) (g i)) =ᵐ[measure.pi μ] pi s (λ i, Icc (f i) (g i)) :=
ae_eq_set_pi $ λ i hi, Ioo_ae_eq_Icc

lemma pi_Ioo_ae_eq_pi_Ioc {s : set ι} {f g : Π i, α i} :
  pi s (λ i, Ioo (f i) (g i)) =ᵐ[measure.pi μ] pi s (λ i, Ioc (f i) (g i)) :=
ae_eq_set_pi $ λ i hi, Ioo_ae_eq_Ioc

lemma univ_pi_Ioo_ae_eq_Icc {f g : Π i, α i} :
  pi univ (λ i, Ioo (f i) (g i)) =ᵐ[measure.pi μ] Icc f g :=
by { rw ← pi_univ_Icc, exact pi_Ioo_ae_eq_pi_Icc }

lemma pi_Ioc_ae_eq_pi_Icc {s : set ι} {f g : Π i, α i} :
  pi s (λ i, Ioc (f i) (g i)) =ᵐ[measure.pi μ] pi s (λ i, Icc (f i) (g i)) :=
ae_eq_set_pi $ λ i hi, Ioc_ae_eq_Icc

lemma univ_pi_Ioc_ae_eq_Icc {f g : Π i, α i} :
  pi univ (λ i, Ioc (f i) (g i)) =ᵐ[measure.pi μ] Icc f g :=
by { rw ← pi_univ_Icc, exact pi_Ioc_ae_eq_pi_Icc }

lemma pi_Ico_ae_eq_pi_Icc {s : set ι} {f g : Π i, α i} :
  pi s (λ i, Ico (f i) (g i)) =ᵐ[measure.pi μ] pi s (λ i, Icc (f i) (g i)) :=
ae_eq_set_pi $ λ i hi, Ico_ae_eq_Icc

lemma univ_pi_Ico_ae_eq_Icc {f g : Π i, α i} :
  pi univ (λ i, Ico (f i) (g i)) =ᵐ[measure.pi μ] Icc f g :=
by { rw ← pi_univ_Icc, exact pi_Ico_ae_eq_pi_Icc }

end intervals

/-- If one of the measures `μ i` has no atoms, them `measure.pi µ`
has no atoms. The instance below assumes that all `μ i` have no atoms. -/
lemma pi_has_no_atoms (i : ι) [has_no_atoms (μ i)] :
  has_no_atoms (measure.pi μ) :=
⟨λ x, flip measure_mono_null (pi_hyperplane μ i (x i)) (singleton_subset_iff.2 rfl)⟩

instance [h : nonempty ι] [∀ i, has_no_atoms (μ i)] : has_no_atoms (measure.pi μ) :=
h.elim $ λ i, pi_has_no_atoms i

instance [Π i, topological_space (α i)] [∀ i, is_locally_finite_measure (μ i)] :
  is_locally_finite_measure (measure.pi μ) :=
begin
  refine ⟨λ x, _⟩,
  choose s hxs ho hμ using λ i, (μ i).exists_is_open_measure_lt_top (x i),
  refine ⟨pi univ s, set_pi_mem_nhds finite_univ (λ i hi, is_open.mem_nhds (ho i) (hxs i)), _⟩,
  rw [pi_pi],
  exact ennreal.prod_lt_top (λ i _, (hμ i).ne)
end

variable (μ)

@[to_additive] instance pi.is_mul_left_invariant [∀ i, group (α i)] [∀ i, has_measurable_mul (α i)]
  [∀ i, is_mul_left_invariant (μ i)] : is_mul_left_invariant (measure.pi μ) :=
begin
  refine ⟨λ v, (pi_eq $ λ s hs, _).symm⟩,
  rw [map_apply (measurable_const_mul _) (measurable_set.univ_pi hs),
    (show (*) v ⁻¹' univ.pi s = univ.pi (λ i, (*) (v i) ⁻¹' s i), by refl), pi_pi],
  simp_rw measure_preimage_mul,
end

@[to_additive] instance pi.is_mul_right_invariant [Π i, group (α i)] [∀ i, has_measurable_mul (α i)]
  [∀ i, is_mul_right_invariant (μ i)] : is_mul_right_invariant (measure.pi μ) :=
begin
  refine ⟨λ v, (pi_eq $ λ s hs, _).symm⟩,
  rw [map_apply (measurable_mul_const _) (measurable_set.univ_pi hs),
    (show (* v)  ⁻¹' univ.pi s = univ.pi (λ i, (* v i) ⁻¹' s i), by refl), pi_pi],
  simp_rw measure_preimage_mul_right,
end

@[to_additive] instance pi.is_inv_invariant [∀ i, group (α i)] [∀ i, has_measurable_inv (α i)]
  [∀ i, is_inv_invariant (μ i)] : is_inv_invariant (measure.pi μ) :=
begin
  refine ⟨(measure.pi_eq (λ s hs, _)).symm⟩,
  have A : has_inv.inv ⁻¹' (pi univ s) = set.pi univ (λ i, has_inv.inv ⁻¹' s i),
  { ext, simp },
  simp_rw [measure.inv, measure.map_apply measurable_inv (measurable_set.univ_pi hs), A,
    pi_pi, measure_preimage_inv]
end

instance pi.is_open_pos_measure [Π i, topological_space (α i)] [Π i, is_open_pos_measure (μ i)] :
  is_open_pos_measure (measure_theory.measure.pi μ) :=
begin
  constructor,
  rintros U U_open ⟨a, ha⟩,
  obtain ⟨s, ⟨hs, hsU⟩⟩ := is_open_pi_iff'.1 U_open a ha,
  refine ne_of_gt (lt_of_lt_of_le _ (measure_mono hsU)),
  simp only [pi_pi],
  rw canonically_ordered_comm_semiring.prod_pos,
  intros i _,
  apply ((hs i).1.measure_pos (μ i) ⟨a i, (hs i).2⟩),
end

instance pi.is_finite_measure_on_compacts [Π i, topological_space (α i)]
  [Π i, is_finite_measure_on_compacts (μ i)] :
  is_finite_measure_on_compacts (measure_theory.measure.pi μ) :=
begin
  constructor,
  intros K hK,
  suffices : measure.pi μ (set.univ.pi ( λ j, (function.eval j) '' K)) < ⊤,
  { exact lt_of_le_of_lt (measure_mono (univ.subset_pi_eval_image K)) this, },
  rw measure.pi_pi,
  refine with_top.prod_lt_top _,
  exact λ i _, ne_of_lt (is_compact.measure_lt_top (is_compact.image hK (continuous_apply i))),
end

@[to_additive]
instance pi.is_haar_measure [Π i, group (α i)] [Π i, topological_space (α i)]
  [Π i, is_haar_measure (μ i)] [Π i, has_measurable_mul (α i)] :
  is_haar_measure (measure.pi μ) := {}

end measure
instance measure_space.pi [Π i, measure_space (α i)] : measure_space (Π i, α i) :=
⟨measure.pi (λ i, volume)⟩

lemma volume_pi [Π i, measure_space (α i)] :
  (volume : measure (Π i, α i)) = measure.pi (λ i, volume) :=
rfl

lemma volume_pi_pi [Π i, measure_space (α i)] [∀ i, sigma_finite (volume : measure (α i))]
  (s : Π i, set (α i)) :
  volume (pi univ s) = ∏ i, volume (s i) :=
measure.pi_pi (λ i, volume) s

lemma volume_pi_ball [Π i, measure_space (α i)] [∀ i, sigma_finite (volume : measure (α i))]
  [∀ i, metric_space (α i)] (x : Π i, α i) {r : ℝ} (hr : 0 < r) :
  volume (metric.ball x r) = ∏ i, volume (metric.ball (x i) r) :=
measure.pi_ball _ _ hr

lemma volume_pi_closed_ball [Π i, measure_space (α i)] [∀ i, sigma_finite (volume : measure (α i))]
  [∀ i, metric_space (α i)] (x : Π i, α i) {r : ℝ} (hr : 0 ≤ r) :
  volume (metric.closed_ball x r) = ∏ i, volume (metric.closed_ball (x i) r) :=
measure.pi_closed_ball _ _ hr

open measure
/-- We intentionally restrict this only to the nondependent function space, since type-class
inference cannot find an instance for `ι → ℝ` when this is stated for dependent function spaces. -/
@[to_additive "We intentionally restrict this only to the nondependent function space, since
type-class inference cannot find an instance for `ι → ℝ` when this is stated for dependent function
spaces."]
instance pi.is_mul_left_invariant_volume {α} [group α] [measure_space α]
  [sigma_finite (volume : measure α)]
  [has_measurable_mul α] [is_mul_left_invariant (volume : measure α)] :
  is_mul_left_invariant (volume : measure (ι → α)) :=
pi.is_mul_left_invariant _

/-- We intentionally restrict this only to the nondependent function space, since type-class
inference cannot find an instance for `ι → ℝ` when this is stated for dependent function spaces. -/
@[to_additive "We intentionally restrict this only to the nondependent function space, since
type-class inference cannot find an instance for `ι → ℝ` when this is stated for dependent function
spaces."]
instance pi.is_inv_invariant_volume {α} [group α] [measure_space α]
  [sigma_finite (volume : measure α)]
  [has_measurable_inv α] [is_inv_invariant (volume : measure α)] :
  is_inv_invariant (volume : measure (ι → α)) :=
pi.is_inv_invariant _

/-!
### Measure preserving equivalences

In this section we prove that some measurable equivalences (e.g., between `fin 1 → α` and `α` or
between `fin 2 → α` and `α × α`) preserve measure or volume. These lemmas can be used to prove that
measures of corresponding sets (images or preimages) have equal measures and functions `f ∘ e` and
`f` have equal integrals, see lemmas in the `measure_theory.measure_preserving` prefix.
-/

section measure_preserving

lemma measure_preserving_pi_equiv_pi_subtype_prod {ι : Type u} {α : ι → Type v} [fintype ι]
  {m : Π i, measurable_space (α i)} (μ : Π i, measure (α i)) [∀ i, sigma_finite (μ i)]
  (p : ι → Prop) [decidable_pred p] :
  measure_preserving (measurable_equiv.pi_equiv_pi_subtype_prod α p) (measure.pi μ)
    ((measure.pi $ λ i : subtype p, μ i).prod (measure.pi $ λ i, μ i)) :=
begin
  set e := (measurable_equiv.pi_equiv_pi_subtype_prod α p).symm,
  refine measure_preserving.symm e _,
  refine ⟨e.measurable, (pi_eq $ λ s hs, _).symm⟩,
  have : e ⁻¹' (pi univ s) =
    (pi univ (λ i : {i // p i}, s i)) ×ˢ (pi univ (λ i : {i // ¬p i}, s i)),
    from equiv.preimage_pi_equiv_pi_subtype_prod_symm_pi p s,
  rw [e.map_apply, this, prod_prod, pi_pi, pi_pi],
  exact fintype.prod_subtype_mul_prod_subtype p (λ i, μ i (s i))
end

lemma volume_preserving_pi_equiv_pi_subtype_prod {ι : Type*} (α : ι → Type*) [fintype ι]
  [Π i, measure_space (α i)] [∀ i, sigma_finite (volume : measure (α i))]
  (p : ι → Prop) [decidable_pred p] :
  measure_preserving (measurable_equiv.pi_equiv_pi_subtype_prod α p) :=
measure_preserving_pi_equiv_pi_subtype_prod (λ i, volume) p

lemma measure_preserving_pi_fin_succ_above_equiv {n : ℕ} {α : fin (n + 1) → Type u}
  {m : Π i, measurable_space (α i)} (μ : Π i, measure (α i)) [∀ i, sigma_finite (μ i)]
  (i : fin (n + 1)) :
  measure_preserving (measurable_equiv.pi_fin_succ_above_equiv α i) (measure.pi μ)
    ((μ i).prod $ measure.pi $ λ j, μ (i.succ_above j)) :=
begin
  set e := (measurable_equiv.pi_fin_succ_above_equiv α i).symm,
  refine measure_preserving.symm e _,
  refine ⟨e.measurable, (pi_eq $ λ s hs, _).symm⟩,
  rw [e.map_apply, i.prod_univ_succ_above _, ← pi_pi, ← prod_prod],
  congr' 1 with ⟨x, f⟩,
  simp [i.forall_iff_succ_above]
end

lemma volume_preserving_pi_fin_succ_above_equiv {n : ℕ} (α : fin (n + 1) → Type u)
  [Π i, measure_space (α i)] [∀ i, sigma_finite (volume : measure (α i))] (i : fin (n + 1)) :
  measure_preserving (measurable_equiv.pi_fin_succ_above_equiv α i) :=
measure_preserving_pi_fin_succ_above_equiv (λ _, volume) i

lemma measure_preserving_fun_unique {β : Type u} {m : measurable_space β} (μ : measure β)
  (α : Type v) [unique α] :
  measure_preserving (measurable_equiv.fun_unique α β) (measure.pi (λ a : α, μ)) μ :=
begin
  set e := measurable_equiv.fun_unique α β,
  have : pi_premeasure (λ _ : α, μ.to_outer_measure) = measure.map e.symm μ,
  { ext1 s,
    rw [pi_premeasure, fintype.prod_unique, to_outer_measure_apply, e.symm.map_apply],
    congr' 1, exact e.to_equiv.image_eq_preimage s },
  simp only [measure.pi, outer_measure.pi, this, bounded_by_measure, to_outer_measure_to_measure],
  exact (e.symm.measurable.measure_preserving _).symm e.symm
end

lemma volume_preserving_fun_unique (α : Type u) (β : Type v) [unique α] [measure_space β] :
  measure_preserving (measurable_equiv.fun_unique α β) volume volume :=
measure_preserving_fun_unique volume α

lemma measure_preserving_pi_fin_two {α : fin 2 → Type u} {m : Π i, measurable_space (α i)}
  (μ : Π i, measure (α i)) [∀ i, sigma_finite (μ i)] :
  measure_preserving (measurable_equiv.pi_fin_two α) (measure.pi μ) ((μ 0).prod (μ 1)) :=
begin
  refine ⟨measurable_equiv.measurable _, (measure.prod_eq $ λ s t hs ht, _).symm⟩,
  rw [measurable_equiv.map_apply, measurable_equiv.pi_fin_two_apply, fin.preimage_apply_01_prod,
    measure.pi_pi, fin.prod_univ_two],
  refl
end

lemma volume_preserving_pi_fin_two (α : fin 2 → Type u) [Π i, measure_space (α i)]
  [∀ i, sigma_finite (volume : measure (α i))] :
  measure_preserving (measurable_equiv.pi_fin_two α) volume volume :=
measure_preserving_pi_fin_two _

lemma measure_preserving_fin_two_arrow_vec {α : Type u} {m : measurable_space α}
  (μ ν : measure α) [sigma_finite μ] [sigma_finite ν] :
  measure_preserving measurable_equiv.fin_two_arrow (measure.pi ![μ, ν]) (μ.prod ν) :=
begin
  haveI : ∀ i, sigma_finite (![μ, ν] i) := fin.forall_fin_two.2 ⟨‹_›, ‹_›⟩,
  exact measure_preserving_pi_fin_two _
end

lemma measure_preserving_fin_two_arrow {α : Type u} {m : measurable_space α}
  (μ : measure α) [sigma_finite μ] :
  measure_preserving measurable_equiv.fin_two_arrow (measure.pi (λ _, μ)) (μ.prod μ) :=
by simpa only [matrix.vec_single_eq_const, matrix.vec_cons_const]
  using measure_preserving_fin_two_arrow_vec μ μ

lemma volume_preserving_fin_two_arrow (α : Type u) [measure_space α]
  [sigma_finite (volume : measure α)] :
  measure_preserving (@measurable_equiv.fin_two_arrow α _) volume volume :=
measure_preserving_fin_two_arrow volume

lemma measure_preserving_pi_empty {ι : Type u} {α : ι → Type v} [is_empty ι]
  {m : Π i, measurable_space (α i)} (μ : Π i, measure (α i)) :
  measure_preserving (measurable_equiv.of_unique_of_unique (Π i, α i) unit)
    (measure.pi μ) (measure.dirac ()) :=
begin
  set e := (measurable_equiv.of_unique_of_unique (Π i, α i) unit),
  refine ⟨e.measurable, _⟩,
  rw [measure.pi_of_empty, measure.map_dirac e.measurable], refl
end

lemma volume_preserving_pi_empty {ι : Type u} (α : ι → Type v) [is_empty ι]
  [Π i, measure_space (α i)] :
  measure_preserving (measurable_equiv.of_unique_of_unique (Π i, α i) unit) volume volume :=
measure_preserving_pi_empty (λ _, volume)

end measure_preserving

end measure_theory


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Kenny Lau
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.fin
import Mathlib.data.equiv.basic
import Mathlib.PostPort

universes u

namespace Mathlib

/-!
# Equivalences for `fin n`
-/

/-- Equivalence between `fin 0` and `empty`. -/
def fin_zero_equiv : fin 0 ≃ empty :=
  equiv.mk fin_zero_elim empty.elim sorry sorry

/-- Equivalence between `fin 0` and `pempty`. -/
def fin_zero_equiv' : fin 0 ≃ pempty :=
  equiv.equiv_pempty sorry

/-- Equivalence between `fin 1` and `punit`. -/
def fin_one_equiv : fin 1 ≃ PUnit :=
  equiv.mk (fun (_x : fin 1) => Unit.unit) (fun (_x : PUnit) => 0) sorry sorry

/-- Equivalence between `fin 2` and `bool`. -/
def fin_two_equiv : fin (bit0 1) ≃ Bool :=
  equiv.mk (fin.cases false fun (_x : fin 1) => tt) (fun (b : Bool) => cond b 1 0) sorry sorry

/-- Equivalence between `fin n.succ` and `option (fin n)` -/
def fin_succ_equiv (n : ℕ) : fin (Nat.succ n) ≃ Option (fin n) :=
  equiv.mk (fun (x : fin (Nat.succ n)) => fin.cases none some x) (fun (x : Option (fin n)) => option.rec_on x 0 fin.succ)
    sorry sorry

@[simp] theorem fin_succ_equiv_zero {n : ℕ} : coe_fn (fin_succ_equiv n) 0 = none :=
  rfl

@[simp] theorem fin_succ_equiv_succ {n : ℕ} (m : fin n) : coe_fn (fin_succ_equiv n) (fin.succ m) = some m := sorry

@[simp] theorem fin_succ_equiv_symm_none {n : ℕ} : coe_fn (equiv.symm (fin_succ_equiv n)) none = 0 :=
  rfl

@[simp] theorem fin_succ_equiv_symm_some {n : ℕ} (m : fin n) : coe_fn (equiv.symm (fin_succ_equiv n)) (some m) = fin.succ m :=
  rfl

/-- Equivalence between `fin m ⊕ fin n` and `fin (m + n)` -/
def sum_fin_sum_equiv {m : ℕ} {n : ℕ} : fin m ⊕ fin n ≃ fin (m + n) :=
  equiv.mk
    (fun (x : fin m ⊕ fin n) =>
      sum.rec_on x (fun (y : fin m) => { val := subtype.val y, property := sorry })
        fun (y : fin n) => { val := m + subtype.val y, property := sorry })
    (fun (x : fin (m + n)) =>
      dite (subtype.val x < m) (fun (H : subtype.val x < m) => sum.inl { val := subtype.val x, property := H })
        fun (H : ¬subtype.val x < m) => sum.inr { val := subtype.val x - m, property := sorry })
    sorry sorry

/-- Equivalence between `fin m × fin n` and `fin (m * n)` -/
def fin_prod_fin_equiv {m : ℕ} {n : ℕ} : fin m × fin n ≃ fin (m * n) :=
  equiv.mk
    (fun (x : fin m × fin n) => { val := subtype.val (prod.snd x) + n * subtype.val (prod.fst x), property := sorry })
    (fun (x : fin (m * n)) =>
      (fun (H : 0 < n) =>
          ({ val := subtype.val x / n, property := sorry }, { val := subtype.val x % n, property := sorry }))
        sorry)
    sorry sorry

/-- `fin 0` is a subsingleton. -/
protected instance subsingleton_fin_zero : subsingleton (fin 0) :=
  equiv.subsingleton fin_zero_equiv

/-- `fin 1` is a subsingleton. -/
protected instance subsingleton_fin_one : subsingleton (fin 1) :=
  equiv.subsingleton fin_one_equiv


import for_mathlib.Fintype
import pseudo_normed_group.basic
import Lbar.nnnorm_add_class

/-!
#  The standard filtration `c : ℝ≥0 ↦ {z : α | ∥z∥₊ ≤ c}`

Let `α` be a nnnormed type.  We use the naming convention `std_flt` for the function `ℝ≥0 → set α`
taking a non-negative real number `c` to the subset of all the terms of `α` of nnnorm at most `c`:
```
ℝ≥0 → set α
  c ↦ {z : α | ∥z∥₊ ≤ c}.
```
The main construction is `std_flt.to_pseudo_normed_group` asserting that the typeclass
`nnnorm_add_class α` (i.e. `α` is a Type with `∥_∥₊, 0, +, -` and compatibilities among them),
gives rise to a `pseudo_normed_group α` under the standard filtration.

We use `std_flt.to_pseudo_normed_group` to give a `pseudo_normed_group` instance on
`S → (ℕ →₀ ℤ)`.

For a fixed `r : ℝ≥0`, the nnnorm on `S → (ℕ →₀ ℤ)` is
`∥(s ↦ (n ↦ F s n))∥₊ = ∑ s : S, ∑ n in F.support, ∥F s n∥₊ * r⁻¹ ^ n`, where the sum is "really" a
finite sum, extending over all `s : S` and over `n : ℕ` contained in the (finite) support of `F n`.

The reason for this choice of nnnorm is that it arises as the nnnorm on the "non-positive tails" of
Laurent series, the kernel of the projection map from Laurent series to the series of their terms of
strictly positive degree.

##  Warning/Formalization note
We use the `nnnorm_add_class` instance on `S → (ℕ →₀ ℤ)` to prove that the standard filtration
determined a `pseudo_normed_group (S → (ℕ →₀ ℤ))`.  Note that the `seminormed_add_comm_group` instance on
the same type is *not* the same: the norm on finitely indexed finsupps for the `seminormed_add_comm_group`
is the `sup`norm and not the `sum_nnnorm`.
-/

open finset finsupp
open_locale nnreal big_operators

lemma mem_union_support_of_mem_support_add {α β : Type*} [add_zero_class β] [decidable_eq α] {k : α}
  (F G : α →₀ β) (hk : k ∈ (F + G).support) :
  k ∈ F.support ∪ G.support :=
begin
  simp only [finset.mem_union, finsupp.mem_support_iff, finsupp.coe_add, pi.add_apply] at ⊢ hk,
  contrapose! hk,
  simp only [hk, add_zero],
end

noncomputable theory

section std_flt_lemmas
variables (α : Type*) [has_nnnorm α]

lemma std_flt_mono ⦃c d : ℝ≥0⦄ (cd : c ≤ d) :
  {z : α | ∥z∥₊ ≤ c} ⊆ {z : α | ∥z∥₊ ≤ d} :=
λ x (hx : ∥x∥₊ ≤ c), hx.trans cd

lemma std_flt_zero_mem [has_zero α] (n0 : ∥(0 : α)∥₊ = 0) (c : ℝ≥0) :
  (0 : α) ∈ {z : α | ∥z∥₊ ≤ c} :=
by simp only [n0, set.mem_set_of_eq, zero_le']

lemma std_flt_neg_mem [has_neg α] (nn : ∀ {x : α}, ∥- x∥₊ = ∥x∥₊) ⦃c : ℝ≥0⦄ ⦃x : α⦄
  (xc : x ∈ {z : α | ∥z∥₊ ≤ c}) :
  - x ∈ {z : α | ∥z∥₊ ≤ c} :=
by simpa only [nn, set.mem_set_of_eq] using xc

lemma std_flt_add_mem [has_add α] (n_le : ∀ {x y : α}, ∥x + y∥₊ ≤ ∥x∥₊ + ∥y∥₊) ⦃c d : ℝ≥0⦄ ⦃x y : α⦄
  (xc : x ∈ {z : α | ∥z∥₊ ≤ c}) (yd : y ∈ {z : α | ∥z∥₊ ≤ d}) :
  x + y ∈ {z : α | ∥z∥₊ ≤ c + d} :=
n_le.trans (add_le_add xc yd)

open nnnorm_add_class
variable {α}

/--  Given a type `α` with a `nnnorm_add_class` instance, `std_flt.to_pseudo_normed_group`
shows that the standard filtration `λ c, {z : α | ∥z∥₊ ≤ c}` endows `α` with a
`pseudo_normed_group` class. -/
def std_flt.to_pseudo_normed_group [add_comm_group α] [nnnorm_add_class α] :
  pseudo_normed_group α :=
{ filtration          := λ c, {z : α | ∥z∥₊ ≤ c},
  filtration_mono     := std_flt_mono α,
  zero_mem_filtration := std_flt_zero_mem α nnn_zero,
  neg_mem_filtration  := std_flt_neg_mem α nnn_neg,
  add_mem_filtration  := std_flt_add_mem α nnn_add_le }

end std_flt_lemmas

/--  Let `r : ℝ≥0` be a non-negative real number.  `nnreal.normed r` or `r.normed` is the type of
finsupps `ℕ →₀ ℤ` with an extra parameter `r`.

The non-negative real number `r` is used in defining a norm on `r.normed`: given `F : ℕ →₀ ℤ`,
define `∥F∥₊ = ∑ x in F.support, ∥F x∥₊ * r⁻¹ ^ x`. -/
@[nolint unused_arguments, reducible, derive add_comm_group]
def nnreal.normed (r : ℝ≥0) := ℕ →₀ ℤ

namespace nnreal.normed
variables {r : ℝ≥0} (F G H : r.normed)

instance (r : ℝ≥0) : has_nnnorm r.normed :=
⟨λ F, ∑ x in F.support, ∥F x∥₊ * r⁻¹ ^ x⟩

@[simp]
lemma nnnorm_zero : ∥(0 : r.normed)∥₊ = 0 :=
by simp only [has_nnnorm.nnnorm, support_zero, sum_empty]

@[simp]
lemma nnnorm_neg : ∥-F∥₊ = ∥F∥₊ :=
by simp only [has_nnnorm.nnnorm, pi.neg_apply, finsupp.coe_neg, support_neg, norm_neg]

lemma nnnorm_add_le : ∥F + G∥₊ ≤ ∥F∥₊ + ∥G∥₊ :=
begin
  unfold nnnorm,
  rw [sum_subset (subset_union_left  F.support G.support),
      sum_subset (subset_union_right F.support G.support),
      sum_subset ((λ k, mem_union_support_of_mem_support_add F G) : _ ⊆ F.support ∪ G.support),
      ← finset.sum_add_distrib],
  { refine sum_le_sum (λ j hj, _),
    rw ← add_mul,
    exact mul_le_mul_of_nonneg_right (nnreal.coe_le_coe.mp (norm_add_le _ _)) (zero_le _) },
  repeat
  { simp only [mem_support_iff, not_not, norm_zero, mul_eq_zero, nonneg.mk_eq_zero,
      eq_self_iff_true, true_or, implies_true_iff] {contextual := true} }
end

instance : nnnorm_add_class r.normed :=
{ nnn_zero   := nnnorm_zero,
  nnn_neg    := nnnorm_neg,
  nnn_add_le := nnnorm_add_le,
  ..(infer_instance : add_comm_group _) }

instance : pseudo_normed_group r.normed :=
std_flt.to_pseudo_normed_group

end nnreal.normed

open nnnorm_add_class

variables {r : ℝ≥0} {α : Type*} [has_nnnorm α] {S : Fintype}

instance fintype.sum_nnnorm : has_nnnorm (S → α) :=
{ nnnorm := λ F, ∑ b, ∥F b∥₊ }

@[simp]
lemma fintype.sum_nnnorm_def (F : S → α) : ∥F∥₊ = ∑ b, ∥F b∥₊ := rfl

instance [add_group α] [nnnorm_add_class α] : nnnorm_add_class (S → α) :=
{ nnn_zero   := by simp,
  nnn_neg    := λ x, by simp [fintype.sum_nnnorm_def, pi.neg_apply, nnn_neg],
  nnn_add_le := λ F G, le_trans (sum_le_sum (λ j hj, nnnorm_add_le _ _)) sum_add_distrib.le,
  ..(infer_instance : add_comm_group _) }

/--  Let `r : ℝ≥0` be a non-negative real number and `S : Fintype` a finite type.
`invpoly' r S` is the type of `S`-indexed terms of type `r.normed`, that is, finsupps
`ℕ →₀ ℤ` with norm defined using `r⁻¹`. -/
@[derive add_comm_group]
def invpoly' (r : ℝ≥0) (S : Fintype) := S → r.normed

namespace invpoly'

instance : inhabited (invpoly' r S) := ⟨0⟩

instance : has_nnnorm (invpoly' r S) :=
@fintype.sum_nnnorm r.normed ⟨nnnorm⟩ S

instance : nnnorm_add_class (invpoly' r S) :=
pi.nnnorm_add_class

instance : pseudo_normed_group (invpoly' r S) :=
std_flt.to_pseudo_normed_group

end invpoly'


import Lean4Axiomatic.Natural
import Lean4Axiomatic.Natural.Impl.Generic

/-!
# Full implementation of `Natural` for Lean's prelude `Nat`
-/

namespace Lean4Axiomatic.Natural.Impl.Nat

local instance constructors : Constructors Nat := {
  zero := Nat.zero
  step := Nat.succ
}

local instance eqvOp? : Relation.Equivalence.EqvOp? Nat := {
  tildeDash := Eq
  refl := λ {x} => Eq.refl x
  symm := Eq.symm
  trans := Eq.trans
  tildeDashQuestion := Nat.decEq
}

local instance equality : Equality Nat := {
  eqvOp? := eqvOp?
}

local instance literals : Literals Nat := {
  literal := @instOfNatNat
  literal_zero := Rel.refl
  literal_step := Rel.refl
}

local instance step_substitutive
    : AA.Substitutive₁ (step : Nat → Nat) (· ≃ ·) (· ≃ ·)
    := {
  subst₁ := congrArg step
}

local instance core : Core Nat := {
  step_substitutive := step_substitutive
}

theorem succ_injective {n m : Nat} : Nat.succ n = Nat.succ m → n = m
| Eq.refl _ => Eq.refl _

local instance step_injective
    : AA.Injective (step : Nat → Nat) (· ≃ ·) (· ≃ ·)
    := {
  inject := succ_injective
}

def ind
    {motive : Nat → Sort v}
    (mz : motive 0) (ms : {n : Nat} → motive n → motive (Nat.succ n))
    : (n : Nat) → motive n
| Nat.zero => mz
| Nat.succ n => ms (ind mz ms n)

local instance axioms : Axioms Nat := {
  step_injective := step_injective
  step_neqv_zero := Nat.noConfusion
  -- 2022-01-11: Using `Nat.rec` directly here, gives the following error:
  -- code generator does not support recursor 'Nat.rec' yet, consider using
  -- 'match ... with' and/or structural recursion
  ind := ind
}

local instance addition : Addition Nat := {
  addOp := _root_.instAddNat
  zero_add := @Nat.zero_add
  step_add := @Nat.succ_add
}

local instance multiplication : Multiplication Nat := {
  mulOp := _root_.instMulNat
  zero_mul := @Nat.zero_mul
  step_mul := @Nat.succ_mul
}

local instance exponentiation : Exponentiation Nat := {
  powOp := _root_.instPowNat
  pow_zero := rfl
  pow_step := rfl
}

local instance sign : Sign Nat := Generic.sign

def order : Order Nat := {
  leOp := Generic.le_ex_add
  le_defn := Iff.intro id id

  ltOp := Generic.lt_le_neqv
  lt_defn := Iff.intro id id
}

open Generic (le lt)

def compare : Nat → Nat → Ordering := instOrdNat.compare

/--
Replacing `compare`'s left operand with an equivalent natural number gives an
identical result.

**Property intuition**: This must be true for `compare` to be a valid function.

**Proof intuition**: Equivalence of `Nat`s is just equality, so all functions
are trivially substitutive.
-/
theorem compare_substL
    {n₁ n₂ m : Nat} : n₁ ≃ n₂ → compare n₁ m = compare n₂ m
    := by
  intro (_ : n₁ ≃ n₂)
  show compare n₁ m = compare n₂ m
  rw [‹n₁ ≃ n₂›]

/--
Replacing `compare`'s right operand with an equivalent natural number gives an
identical result.

**Property intuition**: This must be true for `compare` to be a valid function.

**Proof intuition**: Equivalence of `Nat`s is just equality, so all functions
are trivially substitutive.
-/
theorem compare_substR
    {n₁ n₂ m : Nat} : n₁ ≃ n₂ → compare m n₁ = compare m n₂
    := by
  intro (_ : n₁ ≃ n₂)
  show compare m n₁ = compare m n₂
  rw [‹n₁ ≃ n₂›]

/--
Converts the Prelude's _less than or equal to_ relation on `Nat` to ours.

**Proof intuition**: Induction on the structure of `n ≤ m`.
-/
theorem impl_le_from_prelude_le {n m : Nat} : n ≤ m → le n m
| Nat.le.refl => by
  show le n n
  show ∃ k, n + k ≃ n
  have : n + 0 ≃ n := AA.identR
  exact Exists.intro 0 ‹n + 0 ≃ n›
| @Nat.le.step _ m' (_ : n ≤ m') => by
  show le n (step m')
  have : le n m' := impl_le_from_prelude_le ‹n ≤ m'›
  have (Exists.intro k (_ : n + k ≃ m')) := ‹le n m'›
  have : n + step k ≃ step m' := calc
    n + step k   ≃ _ := add_step
    step (n + k) ≃ _ := AA.subst₁ ‹n + k ≃ m'›
    step m'      ≃ _ := Rel.refl
  have : ∃ k, n + k ≃ step m' := Exists.intro (step k) ‹n + step k ≃ step m'›
  have : le n (step m') := ‹∃ k, n + k ≃ step m'›
  exact this

/--
Converts our _less than or equivalent to_ relation on `Nat` to the Prelude's
version.

**Proof intuition**: Induction on `m`, with a case split on the the value `k`
from `le`'s definition in the inductive step.
-/
theorem prelude_le_from_impl_le {n : Nat} : {m : Nat} → le n m → n ≤ m
| 0, Exists.intro k (_ : n + k ≃ 0) => by
  show n ≤ 0
  have (And.intro (_ : n ≃ 0) (_ : k ≃ 0)) := zero_sum_split ‹n + k ≃ 0›
  have : n = 0 := ‹n ≃ 0›
  match ‹n = 0› with
  | rfl => exact Nat.le.refl
| Nat.succ m', Exists.intro 0 (_ : n + 0 ≃ step m') => by
  show n ≤ step m'
  have : n ≃ step m' := Rel.trans (Rel.symm AA.identR) ‹n + 0 ≃ step m'›
  have : n = step m' := ‹n ≃ step m'›
  match ‹n = step m'› with
  | rfl => exact Nat.le.refl
| Nat.succ m', Exists.intro (Nat.succ k') (_ : n + step k' ≃ step m') => by
  show n ≤ step m'
  have : step (n + k') ≃ step m' := calc
    step (n + k') ≃ _ := Rel.symm add_step
    n + step k'   ≃ _ := ‹n + step k' ≃ step m'›
    step m'       ≃ _ := Rel.refl
  have : n + k' ≃ m' := AA.inject ‹step (n + k') ≃ step m'›
  have : ∃ k', n + k' ≃ m' := Exists.intro k' ‹n + k' ≃ m'›
  have : le n m' := ‹∃ k', n + k' ≃ m'›
  have : n ≤ m' := prelude_le_from_impl_le ‹le n m'›
  have : n ≤ step m' := Nat.le.step ‹n ≤ m'›
  exact this

/--
Our _less then or equivalent to_ relation on `Nat` is equivalent to the
Prelude's.
-/
theorem prelude_le_iff_impl_le {n m : Nat} : n ≤ m ↔ le n m :=
  Iff.intro impl_le_from_prelude_le prelude_le_from_impl_le

/--
Our _less than_ relation on `Nat` is equivalent to the Prelude's.

**Proof intuition**: For the Prelude-to-ours direction, derive `n ≤ m` from
`n < m`, then convert to `le n m`. Derive `n ≄ m` by contradiction with
`n ≤ m`. Combine them to obtain `lt n m`. For the ours-to-Prelude direction,
split `lt n m` into `le n m` and `n ≄ m`. Convert `le n m` to `n ≤ m` and split
it into `n = m ∨ n < m`. Eliminate the first case by contradiction with
`n ≃ m`, leaving the second case as the result.
-/
theorem prelude_lt_iff_impl_lt {n m : Nat} : n < m ↔ lt n m := by
  apply Iff.intro
  case mp =>
    intro (_ : n < m)
    show lt n m
    have : step n ≤ m := ‹n < m›
    have : step n ≤ step m := Nat.le_succ_of_le ‹step n ≤ m›
    have : n ≤ m := Nat.le_of_succ_le_succ ‹step n ≤ step m›
    have : le n m := prelude_le_iff_impl_le.mp ‹n ≤ m›
    have : n ≄ m := by
      intro (_ : n ≃ m)
      show False
      have : n = m := ‹n ≃ m›
      rw [‹n = m›] at ‹step n ≤ m›
      have : ¬(step m ≤ m) := Nat.not_succ_le_self m
      exact absurd ‹step m ≤ m› ‹¬(step m ≤ m)›
    have : lt n m := And.intro ‹le n m› ‹n ≄ m›
    exact this
  case mpr =>
    intro (_ : lt n m)
    show n < m
    have (And.intro (_ : le n m) (_ : n ≄ m)) := ‹lt n m›
    have : n ≤ m := prelude_le_iff_impl_le.mpr ‹le n m›
    have : n = m ∨ n < m := Nat.eq_or_lt_of_le ‹n ≤ m›
    match ‹n = m ∨ n < m› with
    | Or.inl (_ : n = m) =>
      have : n ≠ m := ‹n ≄ m›
      exact absurd ‹n = m› ‹n ≠ m›
    | Or.inr (_ : n < m) =>
      exact ‹n < m›

/--
If `compare` returns `Ordering.lt`, its first argument is less than its second
argument.

**Proof intuition**: Split the definition of `compare` into cases and eliminate
the incorrect ones by contradiction.
-/
theorem compare_lt {n m : Nat} : compare n m = Ordering.lt ↔ lt n m := by
  apply Iff.intro
  case mp =>
    intro (h : compare n m = Ordering.lt)
    show lt n m
    simp [compare, Ord.compare, compareOfLessAndEq] at h
    split at h
    case inl =>
      have : lt n m := prelude_lt_iff_impl_lt.mp ‹n < m›
      exact this
    case inr =>
      split at h <;> contradiction
  case mpr =>
    intro (_ : lt n m)
    show compare n m = Ordering.lt
    simp [compare, Ord.compare, compareOfLessAndEq]
    split
    case inl =>
      show Ordering.lt = Ordering.lt
      rfl
    case inr =>
      have : ¬(n < m) := by assumption
      have : n < m := prelude_lt_iff_impl_lt.mpr ‹lt n m›
      exact absurd ‹n < m› ‹¬(n < m)›

/--
If `compare` returns `Ordering.eq`, its arguments are equivalent.

**Proof intuition**: Split the definition of `compare` into cases and eliminate
the incorrect ones by contradiction.
-/
theorem compare_eq {n m : Nat} : compare n m = Ordering.eq ↔ n ≃ m := by
  apply Iff.intro
  case mp =>
    intro (h : compare n m = Ordering.eq)
    show n ≃ m
    simp [compare, Ord.compare, compareOfLessAndEq] at h
    split at h
    case inl =>
      have : n < m := by assumption
      contradiction
    case inr =>
      split at h
      case inl =>
        have : n = m := by assumption
        have : n ≃ m := ‹n = m›
        exact this
      case inr =>
        have : n ≠ m := by assumption
        contradiction
  case mpr =>
    intro (_ : n ≃ m)
    show compare n m = Ordering.eq
    simp [compare, Ord.compare, compareOfLessAndEq]
    split
    case inl =>
      have : n < m := by assumption
      have : n = m := ‹n ≃ m›
      rw [‹n = m›] at ‹n < m›
      have : ¬(m < m) := Nat.lt_irrefl m
      exact absurd ‹m < m› ‹¬(m < m)›
    case inr =>
      split
      case inl =>
        show Ordering.eq = Ordering.eq
        rfl
      case inr =>
        have : n ≠ m := by assumption
        have : n = m := ‹n ≃ m›
        exact absurd ‹n = m› ‹n ≠ m›

/--
If `compare` returns `Ordering.gt`, its first argument is greater than its
second argument.

**Proof intuition**: Split the definition of `compare` into cases and eliminate
the incorrect ones by contradiction and trichotomy.
-/
theorem compare_gt {n m : Nat} : compare n m = Ordering.gt ↔ lt m n := by
  apply Iff.intro
  case mp =>
    intro (h : compare n m = Ordering.gt)
    show lt m n
    simp [compare, Ord.compare, compareOfLessAndEq] at h
    split at h
    case inl =>
      have : n < m := by assumption
      contradiction
    case inr =>
      split at h
      case inl =>
        have : n = m := by assumption
        contradiction
      case inr =>
        have : ¬(n < m) := by assumption
        have : ¬(n = m) := by assumption
        have : n > m ∨ n ≤ m := Nat.lt_or_ge m n
        match ‹n > m ∨ n ≤ m› with
        | Or.inl (_ : n > m) =>
          have : m < n := ‹n > m›
          have : lt m n := prelude_lt_iff_impl_lt.mp ‹m < n›
          exact this
        | Or.inr (_ : n ≤ m) =>
          have : n = m ∨ n < m := Nat.eq_or_lt_of_le ‹n ≤ m›
          match ‹n = m ∨ n < m› with
          | Or.inl (_ : n = m) =>
            exact absurd ‹n = m› ‹¬(n = m)›
          | Or.inr (_ : n < m) =>
            exact absurd ‹n < m› ‹¬(n < m)›
  case mpr =>
    intro (_ : lt m n)
    show compare n m = Ordering.gt
    have notTwo : ¬ AA.TwoOfThree (lt n m) (n ≃ m) (lt m n) :=
      (trichotomy (order_inst := order) n m).atMostOne
    simp [compare, Ord.compare, compareOfLessAndEq]
    split
    case inl =>
      have : n < m := by assumption
      show False
      have : lt n m := prelude_lt_iff_impl_lt.mp ‹n < m›
      have two : AA.TwoOfThree (lt n m) (n ≃ m) (lt m n) :=
        AA.TwoOfThree.oneAndThree ‹lt n m› ‹lt m n›
      exact absurd two notTwo
    case inr =>
      split
      case inl =>
        have : n = m := by assumption
        show False
        have : n ≃ m := ‹n = m›
        have two : AA.TwoOfThree (lt n m) (n ≃ m) (lt m n) :=
          AA.TwoOfThree.twoAndThree ‹n ≃ m› ‹lt m n›
        exact absurd two notTwo
      case inr =>
        show Ordering.gt = Ordering.gt
        rfl

-- Needed for `compare_inst`, but delayed so its ordering operators don't
-- conflict with the Prelude ones used in the proofs above.
attribute [local instance] order

local instance compare_inst : Compare Nat := {
  compare := compare
  compare_substL := compare_substL
  compare_substR := compare_substR
  compare_lt := compare_lt
  compare_eq := compare_eq
  compare_gt := compare_gt
}

instance : Natural Nat := {
  toCore := core
  toAxioms := axioms
  toAddition := addition
  toSign := sign
  toOrder := order
  toCompare := compare_inst
  toMultiplication := multiplication
  toExponentiation := exponentiation
}

end Lean4Axiomatic.Natural.Impl.Nat


/-
Copyright (c) 2022 Anatole Dedecker. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Moritz Doll
-/
import analysis.locally_convex.bounded
import data.is_R_or_C.basic

/-!
# Continuity and Von Neumann boundedness

This files proves that for `E` and `F` two topological vector spaces over `ℝ` or `ℂ`,
if `E` is first countable, then every locally bounded linear map `E →ₛₗ[σ] F` is continuous
(this is `linear_map.continuous_of_locally_bounded`).

We keep this file separate from `analysis/locally_convex/bounded` in order not to import
`analysis/normed_space/is_R_or_C` there, because defining the strong topology on the space of
continuous linear maps will require importing `analysis/locally_convex/bounded` in
`analysis/normed_space/operator_norm`.

## References

* [Bourbaki, *Topological Vector Spaces*][bourbaki1987]

-/

open topological_space bornology filter
open_locale topology pointwise

variables {𝕜 𝕜' E F : Type*}
variables [add_comm_group E] [uniform_space E] [uniform_add_group E]
variables [add_comm_group F] [uniform_space F]

section nontrivially_normed_field

variables [uniform_add_group F]
variables [nontrivially_normed_field 𝕜] [module 𝕜 E] [module 𝕜 F] [has_continuous_smul 𝕜 E]

/-- Construct a continuous linear map from a linear map `f : E →ₗ[𝕜] F` and the existence of a
neighborhood of zero that gets mapped into a bounded set in `F`. -/
def linear_map.clm_of_exists_bounded_image (f : E →ₗ[𝕜] F)
  (h : ∃ (V : set E) (hV : V ∈ 𝓝 (0 : E)), bornology.is_vonN_bounded 𝕜 (f '' V)) : E →L[𝕜] F :=
⟨f, begin
  -- It suffices to show that `f` is continuous at `0`.
  refine continuous_of_continuous_at_zero f _,
  rw [continuous_at_def, f.map_zero],
  intros U hU,
  -- Continuity means that `U ∈ 𝓝 0` implies that `f ⁻¹' U ∈ 𝓝 0`.
  rcases h with ⟨V, hV, h⟩,
  rcases h hU with ⟨r, hr, h⟩,
  rcases normed_field.exists_lt_norm 𝕜 r with ⟨x, hx⟩,
  specialize h x hx.le,
  -- After unfolding all the definitions, we know that `f '' V ⊆ x • U`. We use this to show the
  -- inclusion `x⁻¹ • V ⊆ f⁻¹' U`.
  have x_ne := norm_pos_iff.mp (hr.trans hx),
  have : x⁻¹ • V ⊆ f⁻¹' U :=
  calc x⁻¹ • V ⊆  x⁻¹ • (f⁻¹' (f '' V)) : set.smul_set_mono (set.subset_preimage_image ⇑f V)
  ... ⊆ x⁻¹ • (f⁻¹' (x • U)) : set.smul_set_mono (set.preimage_mono h)
  ... = f⁻¹' (x⁻¹ • (x • U)) :
      by ext; simp only [set.mem_inv_smul_set_iff₀ x_ne, set.mem_preimage, linear_map.map_smul]
  ... ⊆ f⁻¹' U : by rw inv_smul_smul₀ x_ne _,
  -- Using this inclusion, it suffices to show that `x⁻¹ • V` is in `𝓝 0`, which is trivial.
  refine mem_of_superset _ this,
  convert set_smul_mem_nhds_smul hV (inv_ne_zero x_ne),
  exact (smul_zero _).symm,
end⟩

lemma linear_map.clm_of_exists_bounded_image_coe {f : E →ₗ[𝕜] F}
  {h : ∃ (V : set E) (hV : V ∈ 𝓝 (0 : E)), bornology.is_vonN_bounded 𝕜 (f '' V)} :
  (f.clm_of_exists_bounded_image h : E →ₗ[𝕜] F) = f := rfl

@[simp] lemma linear_map.clm_of_exists_bounded_image_apply {f : E →ₗ[𝕜] F}
  {h : ∃ (V : set E) (hV : V ∈ 𝓝 (0 : E)), bornology.is_vonN_bounded 𝕜 (f '' V)} {x : E} :
  f.clm_of_exists_bounded_image h x = f x := rfl

end nontrivially_normed_field

section is_R_or_C

open topological_space bornology

variables [first_countable_topology E]
variables [is_R_or_C 𝕜] [module 𝕜 E] [has_continuous_smul 𝕜 E]
variables [is_R_or_C 𝕜'] [module 𝕜' F] [has_continuous_smul 𝕜' F]
variables {σ : 𝕜 →+* 𝕜'}

lemma linear_map.continuous_at_zero_of_locally_bounded (f : E →ₛₗ[σ] F)
  (hf : ∀ (s : set E) (hs : is_vonN_bounded 𝕜 s), is_vonN_bounded 𝕜' (f '' s)) :
  continuous_at f 0 :=
begin
  -- Assume that f is not continuous at 0
  by_contradiction,
  -- We use a decreasing balanced basis for 0 : E and a balanced basis for 0 : F
  -- and reformulate non-continuity in terms of these bases
  rcases (nhds_basis_balanced 𝕜 E).exists_antitone_subbasis with ⟨b, bE1, bE⟩,
  simp only [id.def] at bE,
  have bE' : (𝓝 (0 : E)).has_basis (λ (x : ℕ), x ≠ 0) (λ n : ℕ, (n : 𝕜)⁻¹ • b n) :=
  begin
    refine bE.1.to_has_basis _ _,
    { intros n _,
      use n+1,
      simp only [ne.def, nat.succ_ne_zero, not_false_iff, nat.cast_add, nat.cast_one, true_and],
      -- `b (n + 1) ⊆ b n` follows from `antitone`.
      have h : b (n + 1) ⊆ b n := bE.2 (by simp),
      refine subset_trans _ h,
      rintros y ⟨x, hx, hy⟩,
      -- Since `b (n + 1)` is balanced `(n+1)⁻¹ b (n + 1) ⊆ b (n + 1)`
      rw ←hy,
      refine (bE1 (n+1)).2.smul_mem  _ hx,
      have h' : 0 < (n : ℝ) + 1 := n.cast_add_one_pos,
      rw [norm_inv, ←nat.cast_one, ←nat.cast_add, is_R_or_C.norm_eq_abs, is_R_or_C.abs_cast_nat,
        nat.cast_add, nat.cast_one, inv_le h' zero_lt_one],
      norm_cast,
      simp, },
    intros n hn,
    -- The converse direction follows from continuity of the scalar multiplication
    have hcont : continuous_at (λ (x : E), (n : 𝕜) • x) 0 :=
    (continuous_const_smul (n : 𝕜)).continuous_at,
    simp only [continuous_at, map_zero, smul_zero] at hcont,
    rw bE.1.tendsto_left_iff at hcont,
    rcases hcont (b n) (bE1 n).1 with ⟨i, _, hi⟩,
    refine ⟨i, trivial, λ x hx, ⟨(n : 𝕜) • x, hi hx, _⟩⟩,
    simp [←mul_smul, hn],
  end,
  rw [continuous_at, map_zero, bE'.tendsto_iff (nhds_basis_balanced 𝕜' F)] at h,
  push_neg at h,
  rcases h with ⟨V, ⟨hV, hV'⟩, h⟩,
  simp only [id.def, forall_true_left] at h,
  -- There exists `u : ℕ → E` such that for all `n : ℕ` we have `u n ∈ n⁻¹ • b n` and `f (u n) ∉ V`
  choose! u hu hu' using h,
  -- The sequence `(λ n, n • u n)` converges to `0`
  have h_tendsto : tendsto (λ n : ℕ, (n : 𝕜) • u n) at_top (𝓝 (0 : E)) :=
  begin
    apply bE.tendsto,
    intros n,
    by_cases h : n = 0,
    { rw [h, nat.cast_zero, zero_smul],
      refine mem_of_mem_nhds (bE.1.mem_of_mem $ by triv) },
    rcases hu n h with ⟨y, hy, hu1⟩,
    convert hy,
    rw [←hu1, ←mul_smul],
    simp only [h, mul_inv_cancel, ne.def, nat.cast_eq_zero, not_false_iff, one_smul],
  end,
  -- The image `(λ n, n • u n)` is von Neumann bounded:
  have h_bounded : is_vonN_bounded 𝕜 (set.range (λ n : ℕ, (n : 𝕜) • u n)) :=
  h_tendsto.cauchy_seq.totally_bounded_range.is_vonN_bounded 𝕜,
  -- Since `range u` is bounded it absorbs `V`
  rcases hf _ h_bounded hV with ⟨r, hr, h'⟩,
  cases exists_nat_gt r with n hn,
  -- We now find a contradiction between `f (u n) ∉ V` and the absorbing property
  have h1 : r ≤ ‖(n : 𝕜')‖ :=
  by { rw [is_R_or_C.norm_eq_abs, is_R_or_C.abs_cast_nat], exact hn.le },
  have hn' : 0 < ‖(n : 𝕜')‖ := lt_of_lt_of_le hr h1,
  rw [norm_pos_iff, ne.def, nat.cast_eq_zero] at hn',
  have h'' : f (u n) ∈ V :=
  begin
    simp only [set.image_subset_iff] at h',
    specialize h' (n : 𝕜') h1 (set.mem_range_self n),
    simp only [set.mem_preimage, linear_map.map_smulₛₗ, map_nat_cast] at h',
    rcases h' with ⟨y, hy, h'⟩,
    apply_fun (λ y : F, (n : 𝕜')⁻¹ • y) at h',
    simp only [hn', inv_smul_smul₀, ne.def, nat.cast_eq_zero, not_false_iff] at h',
    rwa ←h',
  end,
  exact hu' n hn' h'',
end

/-- If `E` is first countable, then every locally bounded linear map `E →ₛₗ[σ] F` is continuous. -/
lemma linear_map.continuous_of_locally_bounded [uniform_add_group F] (f : E →ₛₗ[σ] F)
  (hf : ∀ (s : set E) (hs : is_vonN_bounded 𝕜 s), is_vonN_bounded 𝕜' (f '' s)) :
  continuous f :=
(uniform_continuous_of_continuous_at_zero f $ f.continuous_at_zero_of_locally_bounded hf).continuous

end is_R_or_C


namespace fol_09

variable A : Type
variables P Q : A → Prop

theorem fol_09 : ((∀ x, P x → Q x) ∧ (∃ x, P x)) → ∃ x, Q x :=
assume h1: (∀ x, P x → Q x) ∧ (∃ x, P x),
have h2: ∀ x, P x → Q x, from and.left h1,
have h3: ∃ x, P x, from and.right h1,
show ∃ x, Q x, from exists.elim h3
  (assume t (h4: P t),
   have h5: P t → Q t, from h2 t,
   have h6: Q t, from h5 h4,
   show ∃ x, Q x, from exists.intro t h6)

end fol_09


import Mathlib.Tactic.Basic

/-!
## Rewriting Tactics

The rewriting tactic `rw` and its relative `simp` replace equals for equals. Unlike `cc`,
they use equations as left-to-right rewrite rules. By default, they operate on the
goal’s target, but they can also be used to rewrite hypotheses specified using the
`at` keyword:

| at | description |
|----|-------------|
|`at ⊢` | applies to the target (the default) |
| `at h₁ . . . hₙ` | applies to the specified hypotheses |
| `at *` | applies to all hypotheses and the target |

**rw**
```
rw lemma-or-constant [at position]
```

The rw tactic applies a single equation as a left-to-right rewrite rule. It searches for the first
subterm that matches the rule’s left-hand side; once found, all occurrences of that subterm are
replaced by the right-hand side of the rule. If the rule contains variables, these are instantiated
as necessary. To apply a lemma as a right-to-left rewrite rule, put a short left arrow (`←`) in front
of the lemma’s name.

Given the lemma `l : ∀x, g x = f x` and the goal `⊢ h (f a) (g b) (g c)`, the
tactic `rw l` produces the subgoal `⊢ h (f a) (f b) (g c)`, whereas `rw ←l` produces the subgoal
`⊢ h (g a) (g b) (g c)`.

Instead of a lemma, we can also specify the name of a constant. This will attempt to
use one of the constant’s defining equations as rewrite rules. For technical reasons, this does not
work with not (`¬`), and we must use `rw not_def` instead.

**simp**
```
simp [at position]
```

The simp tactic applies a standard set of rewrite rules, called the _simp_ set, exhaustively. The simp
set can be extended by putting the `attribute [simp]` on lemmas. Unlike `rw`, `simp` can rewrite terms
containing bound variables (e.g., occurrences of `x` in the body of `λx => . . .`, `∀x, . . .`, or
`∃x, . . .`).

```
simp [lemma-or-constant₁, . . . , lemma-or-constantₙ] [at position]
```
For the above `simp` variant, the specified lemmas are temporarily added to the simp set. In the
lemma list, an asterisk (`*`) can be use to represent all hypotheses. The minus sign (`-`) in front
of a lemma name temporarily removes the lemma from the simp set. A powerful incantation that both
simplifies the hypotheses and uses the result to simplify the goal’s target is `simp [*] at *`.

Given the `lemma l : ∀x, g x = f x` and the goal `⊢ h (f a) (g b) (g c)`, the tactic `simp [l]`
produces the subgoal `⊢ h (f a) (f b) (f c)`, where both `g b` and `g c` have been rewritten. Instead of a
lemma, we can also specify the name of a constant. This temporarily adds the constant’s defining
equations to the simp set.

To find out what simp does, you can enable tracing via the command just before your lemma
and you will see nice detailed information in the InfoView in VS Code.
```lean
set_option trace.Meta.Tactic.simp.rewrite true
```

-/


def f : Bool → Bool → Nat
  | true, true => 0
  | _, _       => 3

example : f true true = 0 :=
  rfl

def g : Bool → Bool → Bool → Nat
  | true, _,    true  => 1
  | _,   false, false => 2
  | a,   _,     b     => f a b

theorem ex1 : g true true true = 1 := rfl
theorem ex2 : g true false true = 1 := rfl
theorem ex3 : g true false false = 2 := rfl
theorem ex4 : g false false false = 2 := rfl
theorem ex5 : g false true true = 3 := rfl

theorem f_eq (h : a = true → b = true → False) : f a b = 3 := by
  simp (config := { iota := false }) [f]
  split
  · contradiction
  · rfl

theorem ex6 : g x y z > 0 := by
  simp [g]
  split
  next => decide
  next => decide
  next a b c h₁ h₂ => simp [f_eq h₁]


import heyting
import tactic.induction

open heyting

namespace intuitionistic_logic

universe u

inductive prop_formula
| bot : prop_formula
| var : ℕ → prop_formula
| imp : prop_formula → prop_formula → prop_formula
| or : prop_formula → prop_formula → prop_formula
| and : prop_formula → prop_formula → prop_formula

notation ⊥ := prop_formula.bot
notation ¬ := λp : prop_formula, p.imp ⊥
infixr ` \/ `:5 := prop_formula.or
infixr ` /\ `:5 := prop_formula.and

instance : has_imp prop_formula := ⟨prop_formula.imp⟩

inductive intui_thm : set prop_formula → prop_formula → Prop
| ax : ∀{Γ p}, p ∈ Γ → intui_thm Γ p
| imp_i : ∀{Γ p q}, intui_thm (Γ ∪ {p}) q → intui_thm Γ (p => q)
| imp_e : ∀{Γ p q}, intui_thm Γ (p => q) → intui_thm Γ p → intui_thm Γ q
| or_il : ∀{Γ p} q, intui_thm Γ p → intui_thm Γ (p \/ q)
| or_ir : ∀{Γ q} p, intui_thm Γ q → intui_thm Γ (p \/ q)
| or_e : ∀{Γ p q r}, intui_thm Γ (p \/ q) → intui_thm (Γ ∪ {p}) r →
intui_thm (Γ ∪ {q}) r → intui_thm Γ r
| and_i : ∀{Γ p q}, intui_thm Γ p → intui_thm Γ q → intui_thm Γ (p /\ q)
| and_el : ∀{Γ p q}, intui_thm Γ (p /\ q) → intui_thm Γ p
| and_er : ∀{Γ p q}, intui_thm Γ (p /\ q) → intui_thm Γ q
| bot_e : ∀{Γ p}, intui_thm Γ ⊥ → intui_thm Γ p

infix ` ⊢ `:50 := intui_thm

variables {Γ : set prop_formula} {p q r : prop_formula}

lemma proves_of_subset_proves {Γ' : set prop_formula} : Γ' ⊆ Γ → Γ' ⊢ p → Γ ⊢ p :=
begin
	intros hss hGp,
	induction hGp generalizing Γ,
	{ exact intui_thm.ax (hss hGp_ᾰ) },
	{
		apply intui_thm.imp_i,
		have : hGp_Γ ∪ {hGp_p} ⊆ Γ ∪ {hGp_p},
		{
			intros x hx,
			simp at *,
			cases hx,
			{exact or.inl hx},
			{exact or.inr (hss hx)},
		},
		exact hGp_ih this,
	},
	{ exact intui_thm.imp_e (hGp_ih_ᾰ hss) (hGp_ih_ᾰ_1 hss) },
	{ exact intui_thm.or_il hGp_q (hGp_ih hss) },
	{ exact intui_thm.or_ir hGp_p (hGp_ih hss) },
	{
		apply intui_thm.or_e (hGp_ih_ᾰ hss),
		{ exact hGp_ih_ᾰ_1  (set.union_subset_union_left {hGp_p} hss) },
		{ exact hGp_ih_ᾰ_2 (set.union_subset_union_left {hGp_q} hss) },
	},
	{ exact intui_thm.and_i (hGp_ih_ᾰ hss) (hGp_ih_ᾰ_1 hss) },
	{ exact intui_thm.and_el (hGp_ih hss) },
	{ exact intui_thm.and_er (hGp_ih hss) },
	{ exact intui_thm.bot_e (hGp_ih hss) }
end

theorem deduction_thm : Γ ∪ {p} ⊢ q ↔ Γ ⊢ (p => q) :=
begin
	split,
	{ exact λh, intui_thm.imp_i h },
	{
		intro h,
		have h1 := proves_of_subset_proves (set.subset_union_left Γ {p}) h,
		have h2 : Γ ∪ {p} ⊢ p,
		{
			apply intui_thm.ax,
			finish,
		},
		exact intui_thm.imp_e h1 h2,
	},
end

lemma fin_subset_proves_of_proves {Γ : set prop_formula} {φ : prop_formula}
  (h : Γ ⊢ φ) : ∃ (Δ : set prop_formula), Δ ⊆ Γ ∧ Δ.finite ∧ Δ ⊢ φ :=
begin
	sorry; {
	induction' h,
	{
		use [{φ}, by rwa set.singleton_subset_iff, set.finite_singleton _],
		apply intui_thm.ax, apply set.mem_singleton,
	},
	{
		rcases ih with ⟨Δ, h1, h2, h3⟩,
		use [Δ \ {φ}, by rwa [set.diff_subset_iff, set.union_comm], set.finite.diff h2 _],
		apply intui_thm.imp_i,
		rw set.diff_union_self,
		exact proves_of_subset_proves (set.subset_union_left Δ {φ}) h3,
	},
	{
		rcases ih_h with ⟨Δ, h1, h2, h3⟩,
		rcases ih_h_1 with ⟨Δ', h1', h2', h3'⟩,
		use [Δ ∪ Δ', set.union_subset h1 h1', set.finite.union h2 h2'],

		have t1 := proves_of_subset_proves (set.subset_union_left Δ Δ') h3,
		have t2 := proves_of_subset_proves (set.subset_union_right Δ Δ') h3',

		exact intui_thm.imp_e t1 t2,
	},
	{
		rcases ih with ⟨Δ, h1, h2, h3⟩,
		use [Δ, h1, h2, intui_thm.or_il φ_1 h3],
	},
	{
		rcases ih with ⟨Δ, h1, h2, h3⟩,
		use [Δ, h1, h2, intui_thm.or_ir φ_1 h3],
	},
	{
		rcases ih_h with ⟨Δ1, h1_1, h1_2, h1_3⟩,
		rcases ih_h_1 with ⟨Δ2, h2_1, h2_2, h2_3⟩,
		rcases ih_h_2 with ⟨Δ3, h3_1, h3_2, h3_3⟩,
		use [Δ1 ∪ (Δ2 \ {p}) ∪ Δ3 \ {q}], split,
		{
			intros x hx,
			cases hx, cases hx,
			{ exact h1_1 hx },
			{
				have h1 : Δ2 \ {p} ⊆ Δ2 := set.diff_subset Δ2 {p},
				have h2 := h1 hx,
				have x_ne_p : x ≠ p := by finish,
				cases h2_1 h2,
				{ exact h_3 },
				{ finish },
			},
			{
				have h1 : Δ3 \ {q} ⊆ Δ3 := set.diff_subset Δ3 {q},
				have h2 := h1 hx,
				have x_ne_p : x ≠ q := by finish,
				cases h3_1 h2,
				{ exact h_3 },
				{ finish },
			},
		},
		split,
		{
			apply set.finite.union,
			{
				apply set.finite.union,
				{ exact h1_2 },
				{ exact set.finite.diff h2_2 {p}}
			},
			{ exact set.finite.diff h3_2 _},
		},
		rw set.union_assoc,
		apply intui_thm.or_e
		(proves_of_subset_proves (set.subset_union_left Δ1 (Δ2 \ {p} ∪ Δ3 \ {q})) h1_3),
		have h1 : Δ2 ⊆ Δ1 ∪ (Δ2 \ {p} ∪ Δ3 \ {q}) ∪ {p},
		{
			intros x hx,
			by_cases hxp : x = p;finish,
		},
		exact proves_of_subset_proves h1 h2_3,

		have h2 : Δ3 ⊆ Δ1 ∪ (Δ2 \ {p} ∪ Δ3 \ {q}) ∪ {q},
		{
			intros x hx,
			by_cases hxp : x = p;finish,
		},
		exact proves_of_subset_proves h2 h3_3,
	},
	{
		rcases ih_h with ⟨Δ1, h1_1, h1_2, h1_3⟩,
		rcases ih_h_1 with ⟨Δ2, h2_1, h2_2, h2_3⟩,
		use [Δ1 ∪ Δ2, set.union_subset h1_1 h2_1, set.finite.union h1_2 h2_2,
		 (proves_of_subset_proves (set.subset_union_left Δ1 Δ2) h1_3).and_i
  	(proves_of_subset_proves (set.subset_union_right Δ1 Δ2) h2_3)],
	},
	{
		rcases ih with ⟨Δ, h1, h2, h3⟩,
		use [Δ, h1, h2, intui_thm.and_el h3],
	},
	{
		rcases ih with ⟨Δ, h1, h2, h3⟩,
		use [Δ, h1, h2, intui_thm.and_er h3],
	},
	{
		rcases ih with ⟨Δ, h1, h2, h3⟩,
		use [Δ, h1, h2, intui_thm.bot_e h3],
	}
	}
end

variables {H : Type u} [heyting H]

def assignment (H : Type u) [heyting H] := ℕ → H
def value (s : assignment H) : prop_formula → H
| ⊥ := ⊥
| (prop_formula.var n) := s n
| (p \/ q) := value p ∪ value q
| (p /\ q) := (value p) ∩ value q
| (prop_formula.imp p q) := value p => value q

def intui_implies (H : Type u) [heyting H] {Γ : set prop_formula} (Γ_fin : set.finite Γ) (p : prop_formula) :=
∀ (s : assignment H), infimum_of_finite _ (set.finite.image (value s) Γ_fin) ≤ value s p

lemma pseudo_soundness (H : Type u) [heyting H] (Γ_fin : set.finite Γ) :
 Γ ⊢ p → (intui_implies H Γ_fin p) :=
begin
	intro Γ_proves,
	induction' Γ_proves,
	{
		sorry; {
		intro s,
		have Γ_img_fin := λs, set.finite.image (@value H _inst_2 s) Γ_fin,
		have : (@value H _inst_2 s) p ∈ (@value H _inst_2 s ) '' Γ :=
		set.mem_image_of_mem _ h,
		have h_inf := @infimum_of_finite_spec _ _inst_2 _ (Γ_img_fin s),
		exact h_inf.1 this,
		}
	},
	{
		intros s,
		have Γ_img_fin := λs, set.finite.image (@value H _inst_2 s) Γ_fin,
		have Γ_insert : Γ ∪ {p} = insert p Γ := by finish,
		rw Γ_insert at *,

		have ih2 := @ih _ _inst_2 (by finish) s,
		have h_inf := @infimum_of_finite_spec _ _inst_2
		 ((@value H _inst_2 s ) '' (insert p Γ)) _, swap,
		 {
			rw← Γ_insert,
			rw set.image_union (@value H _inst_2 s ),
			apply set.finite.union, exact Γ_img_fin s,
			simp,
		 },

		 sorry,
	},

	repeat {sorry},
end

end intuitionistic_logic