import
  number_theory.padics.padic_integers
  data.nat.choose.dvd
  data.zmod.basic
  field_theory.finite.basic

/-! # IMO 2011 N7 -/

namespace IMOSL
namespace IMO2011N7

open finset

variables {p : ℕ} [fact p.prime]

noncomputable def S (a : ℚ_[p]) := (Ico 1 p).sum (λ i, a ^ i / i)

private lemma padic_norm_int_eq_one_iff_not_dvd (k : ℤ) : ‖(k : ℚ_[p])‖ = 1 ↔ ¬(p : ℤ) ∣ k :=
  by rw ← padic_norm_e.norm_int_lt_one_iff_dvd;
    exact (has_le.le.not_lt_iff_eq (padic_norm_e.norm_int_le_one k)).symm

private lemma padic_binom_norm {k : ℕ} (h : 0 < k) (h0 : k < p) :
  ‖(p : ℚ_[p]) / k + (-1) ^ k * p.choose k‖ ≤ p ^ (-2 : ℤ) :=
begin
  ---- Reduce to `p^2 ∣ p + (-1)^k k C(p, k)`
  have h1 : (k : ℚ_[p]) ≠ 0 := nat.cast_ne_zero.mpr (ne_of_gt h),
  rw [div_add' _ _ _ h1, norm_div, mul_assoc, ← nat.cast_mul],
  replace h1 : ‖(k : ℚ_[p])‖ = 1 :=
    by rw [← int.cast_coe_nat, padic_norm_int_eq_one_iff_not_dvd, int.coe_nat_dvd];
      exact nat.not_dvd_of_pos_of_lt h h0,
  rw [h1, div_one, ← nat.cast_two, ← int.cast_coe_nat, ← int.cast_coe_nat (_ * _),
      ← int.cast_one, ← int.cast_neg, ← int.cast_pow, ← int.cast_mul, ← int.cast_add,
      padic_norm_e.norm_int_le_pow_iff_dvd],

  ---- Induction on `k`
  clear h1; rw [← nat.succ_le_iff, le_iff_exists_add'] at h,
  rcases h with ⟨k, rfl⟩; induction k with k h,
  rw [zero_add, mul_one, pow_one, nat.choose_one_right, neg_one_mul, add_neg_self],
  exact dvd_zero _,
  replace h0 := lt_trans (k + 1).lt_succ_self h0,
  replace h := h h0; revert h; refine (dvd_iff_dvd_of_dvd_sub _).mp,
  rw [add_sub_add_left_eq_sub, pow_succ _ k.succ, neg_one_mul,
      neg_mul, sub_neg_eq_add, ← mul_add, ← nat.cast_add],
  refine dvd_mul_of_dvd_right (int.coe_nat_dvd.mpr _) _,
  rw [nat.choose_succ_right_eq p k.succ, ← mul_add, nat.add_sub_of_le (le_of_lt h0), sq],
  exact mul_dvd_mul_right ((fact.out p.prime).dvd_choose_self k.succ_pos h0) p
end

private lemma ultra_norm_add_le {t : ℝ} {a b : ℚ_[p]} (h : ‖a‖ ≤ t) (h0 : ‖b‖ ≤ t) :
  ‖a + b‖ ≤ t :=
  le_trans (padic_norm_e.nonarchimedean _ _) (max_le h h0)

private lemma ultra_norm_sum_le {ι : Type*} [decidable_eq ι] {f : ι → ℚ_[p]} {s : finset ι}
  {t : ℝ} (h : 0 ≤ t) (h0 : ∀ i : ι, i ∈ s → ‖f i‖ ≤ t) : ‖s.sum f‖ ≤ t :=
begin
  induction s using finset.induction with j s h1 h2,
  rw [sum_empty, norm_zero]; exact h,
  simp_rw [mem_insert, forall_eq_or_imp] at h0,
  rw sum_insert h1; exact ultra_norm_add_le h0.1 (h2 h0.2)
end

private lemma special_identity {p : ℕ} (h : odd p) {R : Type*} [comm_ring R] (a : R) :
  a ^ p - (a - 1) ^ p - 1 = (Ico 1 p).sum (λ i, (-a) ^ i * p.choose i) :=
begin
  rw nat.odd_iff at h,
  have h0 : 1 ≤ p := by rw ← h; exact nat.mod_le p 2,
  rw [sum_Ico_eq_add_neg _ h0, sum_range_one, pow_zero, p.choose_zero_right, one_mul,
      nat.cast_one, ← sub_eq_add_neg, sub_left_inj, sub_eq_iff_eq_add, sub_eq_add_neg,
      add_pow, sum_range_succ, ← add_assoc, ← sum_add_distrib, nat.sub_self,
      pow_zero, mul_one, p.choose_self, nat.cast_one, mul_one, self_eq_add_left],
  refine sum_eq_zero (λ x h1, _),
  rw [← add_mul, neg_pow, mul_comm (a ^ x), ← add_mul, mul_assoc],
  apply mul_eq_zero_of_left; clear h0 a,

  rw [mem_range, lt_iff_exists_add] at h1,
  rcases h1 with ⟨c, -, rfl⟩,
  rw [nat.add_sub_cancel_left, neg_one_pow_eq_pow_mod_two],
  cases nat.mod_two_eq_zero_or_one x with h0 h0,
  rw [h0, pow_zero, add_eq_zero_iff_neg_eq, eq_comm],
  rw [nat.add_mod, h0, zero_add, nat.mod_mod] at h,
  rw [neg_one_pow_eq_pow_mod_two, h, pow_one],
  rw [h0, pow_one, neg_add_eq_zero, eq_comm],
  rw [← nat.odd_iff, nat.odd_iff_not_even] at h h0,
  rw [nat.even_add, not_iff, iff_true_left h0] at h,
  exact h.neg_one_pow
end

private lemma S_equiv_mod_p_sq (h : odd p) {a : ℚ_[p]} (h0 : ‖a‖ ≤ 1) :
  ‖(p : ℚ_[p]) * S a + (a ^ p - (a - 1) ^ p - 1)‖ ≤ p ^ (-2 : ℤ) :=
begin
  rw [special_identity h, S, mul_sum, ← sum_add_distrib],
  refine ultra_norm_sum_le (zpow_nonneg p.cast_nonneg _) (λ i h1, _),
  rw [mul_div_left_comm, ← mul_neg_one, mul_pow, mul_assoc, ← mul_add, norm_mul, norm_pow],
  rw mem_Ico at h1; exact mul_le_of_le_one_of_le_of_nonneg
    (pow_le_one i (norm_nonneg a) h0) (padic_binom_norm h1.1 h1.2) (norm_nonneg _)
end

/- Final solution -/
theorem final_solution (h : odd p) : ‖S (3 : ℚ_[p]) + S 4 - 3 * S 2‖ < 1 :=
begin
  ---- Reduce to showing that an expression equivalent to `(2^p - 2)^2` has norm at most `p^{-2}`
  set T := λ (z : ℤ), z ^ p - (z - 1) ^ p - 1,
  have h0 : ∀ z : ℤ, ‖(p : ℚ_[p]) * S z + T z‖ ≤ p ^ (-2 : ℤ) :=
    λ z, by simp_rw [T, int.cast_sub, int.cast_pow, int.cast_sub, int.cast_one];
      exact S_equiv_mod_p_sq h (padic_norm_e.norm_int_le_one z),
  replace h : ‖((-3 : ℤ) : ℚ_[p])‖ ≤ 1 := padic_norm_e.norm_int_le_one (-3),
  replace h := mul_le_of_le_one_of_le_of_nonneg h (h0 2) (norm_nonneg _); rw ← norm_mul at h,
  replace h0 := ultra_norm_add_le (ultra_norm_add_le (h0 3) (h0 4)) h; clear h,
  rw [add_add_add_comm, mul_add, ← mul_add, add_add_add_comm, mul_left_comm,
      ← mul_add, ← int.cast_mul, ← int.cast_add, ← int.cast_add] at h0,
  simp_rw [int.cast_neg, int.cast_bit1, int.cast_bit0, int.cast_one] at h0,
  rw [sub_eq_add_neg, ← neg_mul]; revert h0,
  suffices : ‖((T 3 + T 4 + (-3) * T 2 : ℤ) : ℚ_[p])‖ ≤ p ^ (-(2 : ℕ) : ℤ),
  { rw ← norm_neg at this,
    intros h; replace h := ultra_norm_add_le h this,
    replace this : 0 < (p : ℝ) := nat.cast_pos.mpr (fact.out p.prime).pos,
    rw [add_neg_cancel_right, norm_mul, padic_norm_e.norm_p, inv_mul_le_iff this,
        mul_comm (p : ℝ), ← zpow_add_one₀ (ne_of_gt this)] at h,
    change (-2 + 1 : ℤ) with (-1 : ℤ) at h,
    rw [zpow_neg_one, ← padic_norm_e.norm_p] at h,
    exact lt_of_le_of_lt h padic_norm_e.norm_p_lt_one },

  ---- Reduce to `T(3) + T(4) - 3 T(2) = (2^p - 2)^2`
  rw [padic_norm_e.norm_int_le_pow_iff_dvd, nat.cast_pow, neg_mul, ← sub_eq_add_neg],
  suffices : T 3 + T 4 - 3 * T 2 = (2 ^ p - 2) ^ 2,
    rw this; apply pow_dvd_pow_of_dvd;
      rw [← zmod.int_coe_eq_int_coe_iff_dvd_sub, int.cast_pow, int.cast_two, zmod.pow_card],

  ---- Prove that `T(3) + T(4) - 3 T(2) = (2^p - 2)^2`
  change T 3 with (3 : ℤ) ^ p - 2 ^ p - 1,
  change T 4 with (2 * 2 : ℤ) ^ p - 3 ^ p - 1,
  change T 2 with (2 : ℤ) ^ p - 1 ^ p - 1,
  rw [one_pow, mul_pow, ← sq, sub_add_sub_comm, sub_add_sub_cancel'],
  generalize : (2 : ℤ) ^ p = q,
  rw [sub_eq_iff_eq_add, sub_sub q, ← bit0, sq, sq, ← add_mul, bit1,
      ← add_assoc, sub_add_cancel, add_one_mul, sub_sub, sub_eq_iff_eq_add,
      add_assoc, sub_add_add_cancel, ← mul_two, ← mul_add, sub_add_cancel]
end

end IMO2011N7
end IMOSL


import mynat.definition -- hide
import mynat.add -- hide
import game.world8.level3 -- hide
namespace mynat -- hide

/-

# Advanced Addition World

## Level 4: `eq_iff_succ_eq_succ`

Here is an `iff` goal. You can split it into two goals (the implications in both
directions) using the `split` tactic, which is how you're going to have to start.

`split,`

Now you have two goals. The first is exactly `succ_inj` so you can close
it with

`exact succ_inj,`

and the second one you could solve by looking up the name of the theorem
you proved in the last level and doing `exact <that name>`, or alternatively
you could get some more `intro` practice and seeing if you can prove it
using `intro`, `rw` and `refl`.
-/

/- Theorem
Two natural numbers are equal if and only if their successors are equal.
-/
theorem succ_eq_succ_iff (a b : mynat) : succ a = succ b ↔ a = b :=
begin [nat_num_game]
  split,
  { exact succ_inj},
--  exact succ_eq_succ_of_eq,
  { intro H,
    rw H,
    refl,
  }

end

end mynat -- hide


/-
Copyright (c) 2021 Heather Macbeth. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Heather Macbeth
-/
import analysis.mean_inequalities
import analysis.mean_inequalities_pow
import topology.algebra.order.liminf_limsup

/-!
# ℓp space

This file describes properties of elements `f` of a pi-type `Π i, E i` with finite "norm",
defined for `p:ℝ≥0∞` as the size of the support of `f` if `p=0`, `(∑' a, ‖f a‖^p) ^ (1/p)` for
`0 < p < ∞` and `⨆ a, ‖f a‖` for `p=∞`.

The Prop-valued `mem_ℓp f p` states that a function `f : Π i, E i` has finite norm according
to the above definition; that is, `f` has finite support if `p = 0`, `summable (λ a, ‖f a‖^p)` if
`0 < p < ∞`, and `bdd_above (norm '' (set.range f))` if `p = ∞`.

The space `lp E p` is the subtype of elements of `Π i : α, E i` which satisfy `mem_ℓp f p`. For
`1 ≤ p`, the "norm" is genuinely a norm and `lp` is a complete metric space.

## Main definitions

* `mem_ℓp f p` : property that the function `f` satisfies, as appropriate, `f` finitely supported
  if `p = 0`, `summable (λ a, ‖f a‖^p)` if `0 < p < ∞`, and `bdd_above (norm '' (set.range f))` if
  `p = ∞`.
* `lp E p` : elements of `Π i : α, E i` such that `mem_ℓp f p`. Defined as an `add_subgroup` of
  a type synonym `pre_lp` for `Π i : α, E i`, and equipped with a `normed_add_comm_group` structure.
  Under appropriate conditions, this is also equipped with the instances `lp.normed_space`,
  `lp.complete_space`. For `p=∞`, there is also `lp.infty_normed_ring`,
  `lp.infty_normed_algebra`, `lp.infty_star_ring` and `lp.infty_cstar_ring`.

## Main results

* `mem_ℓp.of_exponent_ge`: For `q ≤ p`, a function which is `mem_ℓp` for `q` is also `mem_ℓp` for
  `p`
* `lp.mem_ℓp_of_tendsto`, `lp.norm_le_of_tendsto`: A pointwise limit of functions in `lp`, all with
  `lp` norm `≤ C`, is itself in `lp` and has `lp` norm `≤ C`.
* `lp.tsum_mul_le_mul_norm`: basic form of Hölder's inequality

## Implementation

Since `lp` is defined as an `add_subgroup`, dot notation does not work. Use `lp.norm_neg f` to
say that `‖-f‖ = ‖f‖`, instead of the non-working `f.norm_neg`.

## TODO

* More versions of Hölder's inequality (for example: the case `p = 1`, `q = ∞`; a version for normed
  rings which has `‖∑' i, f i * g i‖` rather than `∑' i, ‖f i‖ * g i‖` on the RHS; a version for
  three exponents satisfying `1 / r = 1 / p + 1 / q`)

-/

noncomputable theory
open_locale nnreal ennreal big_operators

variables {α : Type*} {E : α → Type*} {p q : ℝ≥0∞} [Π i, normed_add_comm_group (E i)]

/-!
### `mem_ℓp` predicate

-/

/-- The property that `f : Π i : α, E i`
* is finitely supported, if `p = 0`, or
* admits an upper bound for `set.range (λ i, ‖f i‖)`, if `p = ∞`, or
* has the series `∑' i, ‖f i‖ ^ p` be summable, if `0 < p < ∞`. -/
def mem_ℓp (f : Π i, E i) (p : ℝ≥0∞) : Prop :=
if p = 0 then (set.finite {i | f i ≠ 0}) else
  (if p = ∞ then bdd_above (set.range (λ i, ‖f i‖)) else summable (λ i, ‖f i‖ ^ p.to_real))

lemma mem_ℓp_zero_iff {f : Π i, E i} : mem_ℓp f 0 ↔ set.finite {i | f i ≠ 0} :=
by dsimp [mem_ℓp]; rw [if_pos rfl]

lemma mem_ℓp_zero {f : Π i, E i} (hf : set.finite {i | f i ≠ 0}) : mem_ℓp f 0 :=
mem_ℓp_zero_iff.2 hf

lemma mem_ℓp_infty_iff {f : Π i, E i} : mem_ℓp f ∞ ↔ bdd_above (set.range (λ i, ‖f i‖)) :=
by dsimp [mem_ℓp]; rw [if_neg ennreal.top_ne_zero, if_pos rfl]

lemma mem_ℓp_infty {f : Π i, E i} (hf : bdd_above (set.range (λ i, ‖f i‖))) : mem_ℓp f ∞ :=
mem_ℓp_infty_iff.2 hf

lemma mem_ℓp_gen_iff (hp : 0 < p.to_real) {f : Π i, E i} :
  mem_ℓp f p ↔ summable (λ i, ‖f i‖ ^ p.to_real) :=
begin
  rw ennreal.to_real_pos_iff at hp,
  dsimp [mem_ℓp],
  rw [if_neg hp.1.ne', if_neg hp.2.ne],
end

lemma mem_ℓp_gen {f : Π i, E i} (hf : summable (λ i, ‖f i‖ ^ p.to_real)) :
  mem_ℓp f p :=
begin
  rcases p.trichotomy with rfl | rfl | hp,
  { apply mem_ℓp_zero,
    have H : summable (λ i : α, (1:ℝ)) := by simpa using hf,
    exact (finite_of_summable_const (by norm_num) H).subset (set.subset_univ _) },
  { apply mem_ℓp_infty,
    have H : summable (λ i : α, (1:ℝ)) := by simpa using hf,
    simpa using ((finite_of_summable_const (by norm_num) H).image (λ i, ‖f i‖)).bdd_above },
  exact (mem_ℓp_gen_iff hp).2 hf
end

lemma mem_ℓp_gen' {C : ℝ} {f : Π i, E i} (hf : ∀ s : finset α, ∑ i in s, ‖f i‖ ^ p.to_real ≤ C) :
  mem_ℓp f p :=
begin
  apply mem_ℓp_gen,
  use ⨆ s : finset α, ∑ i in s, ‖f i‖ ^ p.to_real,
  apply has_sum_of_is_lub_of_nonneg,
  { intros b,
    exact real.rpow_nonneg_of_nonneg (norm_nonneg _) _ },
  apply is_lub_csupr,
  use C,
  rintros - ⟨s, rfl⟩,
  exact hf s
end

lemma zero_mem_ℓp : mem_ℓp (0 : Π i, E i) p :=
begin
  rcases p.trichotomy with rfl | rfl | hp,
  { apply mem_ℓp_zero,
    simp },
  { apply mem_ℓp_infty,
    simp only [norm_zero, pi.zero_apply],
    exact bdd_above_singleton.mono set.range_const_subset, },
  { apply mem_ℓp_gen,
    simp [real.zero_rpow hp.ne', summable_zero], }
end

lemma zero_mem_ℓp' : mem_ℓp (λ i : α, (0 : E i)) p := zero_mem_ℓp

namespace mem_ℓp

lemma finite_dsupport {f : Π i, E i} (hf : mem_ℓp f 0) : set.finite {i | f i ≠ 0} :=
mem_ℓp_zero_iff.1 hf

lemma bdd_above {f : Π i, E i} (hf : mem_ℓp f ∞) : bdd_above (set.range (λ i, ‖f i‖)) :=
mem_ℓp_infty_iff.1 hf

lemma summable (hp : 0 < p.to_real) {f : Π i, E i} (hf : mem_ℓp f p) :
  summable (λ i, ‖f i‖ ^ p.to_real) :=
(mem_ℓp_gen_iff hp).1 hf

lemma neg {f : Π i, E i} (hf : mem_ℓp f p) : mem_ℓp (-f) p :=
begin
  rcases p.trichotomy with rfl | rfl | hp,
  { apply mem_ℓp_zero,
    simp [hf.finite_dsupport] },
  { apply mem_ℓp_infty,
    simpa using hf.bdd_above },
  { apply mem_ℓp_gen,
    simpa using hf.summable hp },
end

@[simp] lemma neg_iff {f : Π i, E i} : mem_ℓp (-f) p ↔ mem_ℓp f p :=
⟨λ h, neg_neg f ▸ h.neg, mem_ℓp.neg⟩

lemma of_exponent_ge {p q : ℝ≥0∞} {f : Π i, E i}
  (hfq : mem_ℓp f q) (hpq : q ≤ p) :
  mem_ℓp f p :=
begin
  rcases ennreal.trichotomy₂ hpq with ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩ | ⟨rfl, hp⟩ | ⟨rfl, rfl⟩ | ⟨hq, rfl⟩
    | ⟨hq, hp, hpq'⟩,
  { exact hfq },
  { apply mem_ℓp_infty,
    obtain ⟨C, hC⟩ := (hfq.finite_dsupport.image (λ i, ‖f i‖)).bdd_above,
    use max 0 C,
    rintros x ⟨i, rfl⟩,
    by_cases hi : f i = 0,
    { simp [hi] },
    { exact (hC ⟨i, hi, rfl⟩).trans (le_max_right _ _) } },
  { apply mem_ℓp_gen,
    have : ∀ i ∉ hfq.finite_dsupport.to_finset, ‖f i‖ ^ p.to_real = 0,
    { intros i hi,
      have : f i = 0 := by simpa using hi,
      simp [this, real.zero_rpow hp.ne'] },
    exact summable_of_ne_finset_zero this },
  { exact hfq },
  { apply mem_ℓp_infty,
    obtain ⟨A, hA⟩ := (hfq.summable hq).tendsto_cofinite_zero.bdd_above_range_of_cofinite,
    use A ^ (q.to_real⁻¹),
    rintros x ⟨i, rfl⟩,
    have : 0 ≤ ‖f i‖ ^ q.to_real := real.rpow_nonneg_of_nonneg (norm_nonneg _) _,
    simpa [← real.rpow_mul, mul_inv_cancel hq.ne'] using
      real.rpow_le_rpow this (hA ⟨i, rfl⟩) (inv_nonneg.mpr hq.le) },
  { apply mem_ℓp_gen,
    have hf' := hfq.summable hq,
    refine summable_of_norm_bounded_eventually _ hf' (@set.finite.subset _ {i | 1 ≤ ‖f i‖} _ _ _),
    { have H : {x : α | 1 ≤ ‖f x‖ ^ q.to_real}.finite,
      { simpa using eventually_lt_of_tendsto_lt (by norm_num : (0:ℝ) < 1)
          hf'.tendsto_cofinite_zero },
      exact H.subset (λ i hi, real.one_le_rpow hi hq.le) },
    { show ∀ i, ¬ (|‖f i‖ ^ p.to_real| ≤ ‖f i‖ ^ q.to_real) → 1 ≤ ‖f i‖,
      intros i hi,
      have : 0 ≤ ‖f i‖ ^ p.to_real := real.rpow_nonneg_of_nonneg (norm_nonneg _) p.to_real,
      simp only [abs_of_nonneg, this] at hi,
      contrapose! hi,
      exact real.rpow_le_rpow_of_exponent_ge' (norm_nonneg _) hi.le hq.le hpq' } }
end

lemma add {f g : Π i, E i} (hf : mem_ℓp f p) (hg : mem_ℓp g p) : mem_ℓp (f + g) p :=
begin
  rcases p.trichotomy with rfl | rfl | hp,
  { apply mem_ℓp_zero,
    refine (hf.finite_dsupport.union hg.finite_dsupport).subset (λ i, _),
    simp only [pi.add_apply, ne.def, set.mem_union, set.mem_set_of_eq],
    contrapose!,
    rintros ⟨hf', hg'⟩,
    simp [hf', hg'] },
  { apply mem_ℓp_infty,
    obtain ⟨A, hA⟩ := hf.bdd_above,
    obtain ⟨B, hB⟩ := hg.bdd_above,
    refine ⟨A + B, _⟩,
    rintros a ⟨i, rfl⟩,
    exact le_trans (norm_add_le _ _) (add_le_add (hA ⟨i, rfl⟩) (hB ⟨i, rfl⟩)) },
  apply mem_ℓp_gen,
  let C : ℝ := if p.to_real < 1 then 1 else 2 ^ (p.to_real - 1),
  refine summable_of_nonneg_of_le _ (λ i, _) (((hf.summable hp).add (hg.summable hp)).mul_left C),
  { exact λ b, real.rpow_nonneg_of_nonneg (norm_nonneg (f b + g b)) p.to_real },
  { refine (real.rpow_le_rpow (norm_nonneg _) (norm_add_le _ _) hp.le).trans _,
    dsimp [C],
    split_ifs with h h,
    { simpa using nnreal.coe_le_coe.2 (nnreal.rpow_add_le_add_rpow (‖f i‖₊) (‖g i‖₊) hp.le h.le) },
    { let F : fin 2 → ℝ≥0 := ![‖f i‖₊, ‖g i‖₊],
      have : ∀ i, (0:ℝ) ≤ F i := λ i, (F i).coe_nonneg,
      simp only [not_lt] at h,
      simpa [F, fin.sum_univ_succ] using
        real.rpow_sum_le_const_mul_sum_rpow_of_nonneg (finset.univ : finset (fin 2)) h
        (λ i _, (F i).coe_nonneg) } }
end

lemma sub {f g : Π i, E i} (hf : mem_ℓp f p) (hg : mem_ℓp g p) : mem_ℓp (f - g) p :=
by { rw sub_eq_add_neg, exact hf.add hg.neg }

lemma finset_sum {ι} (s : finset ι) {f : ι → Π i, E i} (hf : ∀ i ∈ s, mem_ℓp (f i) p) :
  mem_ℓp (λ a, ∑ i in s, f i a) p :=
begin
  haveI : decidable_eq ι := classical.dec_eq _,
  revert hf,
  refine finset.induction_on s _ _,
  { simp only [zero_mem_ℓp', finset.sum_empty, implies_true_iff], },
  { intros i s his ih hf,
    simp only [his, finset.sum_insert, not_false_iff],
    exact (hf i (s.mem_insert_self i)).add (ih (λ j hj, hf j (finset.mem_insert_of_mem hj))), },
end

section normed_space

variables {𝕜 : Type*} [normed_field 𝕜] [Π i, normed_space 𝕜 (E i)]

lemma const_smul {f : Π i, E i} (hf : mem_ℓp f p) (c : 𝕜) : mem_ℓp (c • f) p :=
begin
  rcases p.trichotomy with rfl | rfl | hp,
  { apply mem_ℓp_zero,
    refine hf.finite_dsupport.subset (λ i, (_ : ¬c • f i = 0 → ¬f i = 0)),
    exact not_imp_not.mpr (λ hf', hf'.symm ▸ (smul_zero c)) },
  { obtain ⟨A, hA⟩ := hf.bdd_above,
    refine mem_ℓp_infty ⟨‖c‖ * A, _⟩,
    rintros a ⟨i, rfl⟩,
    simpa [norm_smul] using mul_le_mul_of_nonneg_left (hA ⟨i, rfl⟩) (norm_nonneg c) },
  { apply mem_ℓp_gen,
    convert (hf.summable hp).mul_left (‖c‖ ^ p.to_real),
    ext i,
    simp [norm_smul, real.mul_rpow (norm_nonneg c) (norm_nonneg (f i))] },
end

lemma const_mul {f : α → 𝕜} (hf : mem_ℓp f p) (c : 𝕜) : mem_ℓp (λ x, c * f x) p :=
@mem_ℓp.const_smul α (λ i, 𝕜) _ _ 𝕜 _ _ _ hf c

end normed_space

end mem_ℓp

/-!
### lp space

The space of elements of `Π i, E i` satisfying the predicate `mem_ℓp`.
-/

/-- We define `pre_lp E` to be a type synonym for `Π i, E i` which, importantly, does not inherit
the `pi` topology on `Π i, E i` (otherwise this topology would descend to `lp E p` and conflict
with the normed group topology we will later equip it with.)

We choose to deal with this issue by making a type synonym for `Π i, E i` rather than for the `lp`
subgroup itself, because this allows all the spaces `lp E p` (for varying `p`) to be subgroups of
the same ambient group, which permits lemma statements like `lp.monotone` (below). -/
@[derive add_comm_group, nolint unused_arguments]
def pre_lp (E : α → Type*) [Π i, normed_add_comm_group (E i)] : Type* := Π i, E i

instance pre_lp.unique [is_empty α] : unique (pre_lp E) := pi.unique_of_is_empty E

/-- lp space -/
def lp (E : α → Type*) [Π i, normed_add_comm_group (E i)]
  (p : ℝ≥0∞) : add_subgroup (pre_lp E) :=
{ carrier := {f | mem_ℓp f p},
  zero_mem' := zero_mem_ℓp,
  add_mem' := λ f g, mem_ℓp.add,
  neg_mem' := λ f, mem_ℓp.neg }

namespace lp

instance : has_coe (lp E p) (Π i, E i) := coe_subtype
instance : has_coe_to_fun (lp E p) (λ _, Π i, E i) := ⟨λ f, ((f : Π i, E i) : Π i, E i)⟩

@[ext] lemma ext {f g : lp E p} (h : (f : Π i, E i) = g) : f = g :=
subtype.ext h

protected lemma ext_iff {f g : lp E p} : f = g ↔ (f : Π i, E i) = g :=
subtype.ext_iff

lemma eq_zero' [is_empty α] (f : lp E p) : f = 0 := subsingleton.elim f 0

protected lemma monotone {p q : ℝ≥0∞} (hpq : q ≤ p) : lp E q ≤ lp E p :=
λ f hf, mem_ℓp.of_exponent_ge hf hpq

protected lemma mem_ℓp (f : lp E p) : mem_ℓp f p := f.prop

variables (E p)
@[simp] lemma coe_fn_zero : ⇑(0 : lp E p) = 0 := rfl
variables {E p}

@[simp] lemma coe_fn_neg (f : lp E p) : ⇑(-f) = -f := rfl

@[simp] lemma coe_fn_add (f g : lp E p) : ⇑(f + g) = f + g := rfl

@[simp] lemma coe_fn_sum {ι : Type*} (f : ι → lp E p) (s : finset ι) :
  ⇑(∑ i in s, f i) = ∑ i in s, ⇑(f i) :=
begin
  classical,
  refine finset.induction _ _ s,
  { simp },
  intros i s his,
  simp [finset.sum_insert his],
end

@[simp] lemma coe_fn_sub (f g : lp E p) : ⇑(f - g) = f - g := rfl

instance : has_norm (lp E p) :=
{ norm := λ f, if hp : p = 0 then by subst hp; exact (lp.mem_ℓp f).finite_dsupport.to_finset.card
   else (if p = ∞ then ⨆ i, ‖f i‖ else (∑' i, ‖f i‖ ^ p.to_real) ^ (1/p.to_real)) }

lemma norm_eq_card_dsupport (f : lp E 0) : ‖f‖ = (lp.mem_ℓp f).finite_dsupport.to_finset.card :=
dif_pos rfl

lemma norm_eq_csupr (f : lp E ∞) : ‖f‖ = ⨆ i, ‖f i‖ :=
begin
  dsimp [norm],
  rw [dif_neg ennreal.top_ne_zero, if_pos rfl]
end

lemma is_lub_norm [nonempty α] (f : lp E ∞) : is_lub (set.range (λ i, ‖f i‖)) ‖f‖ :=
begin
  rw lp.norm_eq_csupr,
  exact is_lub_csupr (lp.mem_ℓp f)
end

lemma norm_eq_tsum_rpow (hp : 0 < p.to_real) (f : lp E p) :
  ‖f‖ = (∑' i, ‖f i‖ ^ p.to_real) ^ (1/p.to_real) :=
begin
  dsimp [norm],
  rw ennreal.to_real_pos_iff at hp,
  rw [dif_neg hp.1.ne', if_neg hp.2.ne],
end

lemma norm_rpow_eq_tsum (hp : 0 < p.to_real) (f : lp E p) :
  ‖f‖ ^ p.to_real = ∑' i, ‖f i‖ ^ p.to_real :=
begin
  rw [norm_eq_tsum_rpow hp, ← real.rpow_mul],
  { field_simp [hp.ne'] },
  apply tsum_nonneg,
  intros i,
  calc (0:ℝ) = 0 ^ p.to_real : by rw real.zero_rpow hp.ne'
  ... ≤ _ : real.rpow_le_rpow rfl.le (norm_nonneg (f i)) hp.le
end

lemma has_sum_norm (hp : 0 < p.to_real) (f : lp E p) :
  has_sum (λ i, ‖f i‖ ^ p.to_real) (‖f‖ ^ p.to_real) :=
begin
  rw norm_rpow_eq_tsum hp,
  exact ((lp.mem_ℓp f).summable hp).has_sum
end

lemma norm_nonneg' (f : lp E p) : 0 ≤ ‖f‖ :=
begin
  rcases p.trichotomy with rfl | rfl | hp,
  { simp [lp.norm_eq_card_dsupport f] },
  { cases is_empty_or_nonempty α with _i _i; resetI,
    { rw lp.norm_eq_csupr,
      simp [real.csupr_empty] },
    inhabit α,
    exact (norm_nonneg (f default)).trans ((lp.is_lub_norm f).1 ⟨default, rfl⟩) },
  { rw lp.norm_eq_tsum_rpow hp f,
    refine real.rpow_nonneg_of_nonneg (tsum_nonneg _) _,
    exact λ i, real.rpow_nonneg_of_nonneg (norm_nonneg _) _ },
end

@[simp] lemma norm_zero : ‖(0 : lp E p)‖ = 0 :=
begin
  rcases p.trichotomy with rfl | rfl | hp,
  { simp [lp.norm_eq_card_dsupport] },
  { simp [lp.norm_eq_csupr] },
  { rw lp.norm_eq_tsum_rpow hp,
    have hp' : 1 / p.to_real ≠ 0 := one_div_ne_zero hp.ne',
    simpa [real.zero_rpow hp.ne'] using real.zero_rpow hp' }
end

lemma norm_eq_zero_iff {f : lp E p} : ‖f‖ = 0 ↔ f = 0 :=
begin
  classical,
  refine ⟨λ h, _, by { rintros rfl, exact norm_zero }⟩,
  rcases p.trichotomy with rfl | rfl | hp,
  { ext i,
    have : {i : α | ¬f i = 0} = ∅ := by simpa [lp.norm_eq_card_dsupport f] using h,
    have : (¬ (f i = 0)) = false := congr_fun this i,
    tauto },
  { cases is_empty_or_nonempty α with _i _i; resetI,
    { simp },
    have H : is_lub (set.range (λ i, ‖f i‖)) 0,
    { simpa [h] using lp.is_lub_norm f },
    ext i,
    have : ‖f i‖ = 0 := le_antisymm (H.1 ⟨i, rfl⟩) (norm_nonneg _),
    simpa using this },
  { have hf : has_sum (λ (i : α), ‖f i‖ ^ p.to_real) 0,
    { have := lp.has_sum_norm hp f,
      rwa [h, real.zero_rpow hp.ne'] at this },
    have : ∀ i, 0 ≤ ‖f i‖ ^ p.to_real := λ i, real.rpow_nonneg_of_nonneg (norm_nonneg _) _,
    rw has_sum_zero_iff_of_nonneg this at hf,
    ext i,
    have : f i = 0 ∧ p.to_real ≠ 0,
    { simpa [real.rpow_eq_zero_iff_of_nonneg (norm_nonneg (f i))] using congr_fun hf i },
    exact this.1 },
end

lemma eq_zero_iff_coe_fn_eq_zero {f : lp E p} : f = 0 ↔ ⇑f = 0 :=
by rw [lp.ext_iff, coe_fn_zero]

@[simp] lemma norm_neg ⦃f : lp E p⦄ : ‖-f‖ = ‖f‖ :=
begin
  rcases p.trichotomy with rfl | rfl | hp,
  { simp [lp.norm_eq_card_dsupport] },
  { cases is_empty_or_nonempty α; resetI,
    { simp [lp.eq_zero' f], },
    apply (lp.is_lub_norm (-f)).unique,
    simpa using lp.is_lub_norm f },
  { suffices : ‖-f‖ ^ p.to_real = ‖f‖ ^ p.to_real,
    { exact real.rpow_left_inj_on hp.ne' (norm_nonneg' _) (norm_nonneg' _) this },
    apply (lp.has_sum_norm hp (-f)).unique,
    simpa using lp.has_sum_norm hp f }
end

instance [hp : fact (1 ≤ p)] : normed_add_comm_group (lp E p) :=
add_group_norm.to_normed_add_comm_group
{ to_fun := norm,
  map_zero' := norm_zero,
  neg' := norm_neg,
  add_le' := λ f g, begin
    unfreezingI { rcases p.dichotomy with rfl | hp' },
    { casesI is_empty_or_nonempty α,
      { simp [lp.eq_zero' f] },
      refine (lp.is_lub_norm (f + g)).2 _,
      rintros x ⟨i, rfl⟩,
      refine le_trans _ (add_mem_upper_bounds_add (lp.is_lub_norm f).1 (lp.is_lub_norm g).1
        ⟨_, _, ⟨i, rfl⟩, ⟨i, rfl⟩, rfl⟩),
      exact norm_add_le (f i) (g i) },
    { have hp'' : 0 < p.to_real := zero_lt_one.trans_le hp',
      have hf₁ : ∀ i, 0 ≤ ‖f i‖ := λ i, norm_nonneg _,
      have hg₁ : ∀ i, 0 ≤ ‖g i‖ := λ i, norm_nonneg _,
      have hf₂ := lp.has_sum_norm hp'' f,
      have hg₂ := lp.has_sum_norm hp'' g,
      -- apply Minkowski's inequality
      obtain ⟨C, hC₁, hC₂, hCfg⟩ :=
        real.Lp_add_le_has_sum_of_nonneg hp' hf₁ hg₁ (norm_nonneg' _) (norm_nonneg' _) hf₂ hg₂,
      refine le_trans _ hC₂,
      rw ← real.rpow_le_rpow_iff (norm_nonneg' (f + g)) hC₁ hp'',
      refine has_sum_le _ (lp.has_sum_norm hp'' (f + g)) hCfg,
      intros i,
      exact real.rpow_le_rpow (norm_nonneg _) (norm_add_le _ _) hp''.le },
  end,
  eq_zero_of_map_eq_zero' := λ f, norm_eq_zero_iff.1 }

-- TODO: define an `ennreal` version of `is_conjugate_exponent`, and then express this inequality
-- in a better version which also covers the case `p = 1, q = ∞`.
/-- Hölder inequality -/
protected

protected lemma summable_mul {p q : ℝ≥0∞}
  (hpq : p.to_real.is_conjugate_exponent q.to_real) (f : lp E p) (g : lp E q) :
  summable (λ i, ‖f i‖ * ‖g i‖) :=
(lp.tsum_mul_le_mul_norm hpq f g).1

protected lemma tsum_mul_le_mul_norm' {p q : ℝ≥0∞}
  (hpq : p.to_real.is_conjugate_exponent q.to_real) (f : lp E p) (g : lp E q) :
  ∑' i, ‖f i‖ * ‖g i‖ ≤ ‖f‖ * ‖g‖ :=
(lp.tsum_mul_le_mul_norm hpq f g).2

section compare_pointwise

lemma norm_apply_le_norm (hp : p ≠ 0) (f : lp E p) (i : α) : ‖f i‖ ≤ ‖f‖ :=
begin
  rcases eq_or_ne p ∞ with rfl | hp',
  { haveI : nonempty α := ⟨i⟩,
    exact (is_lub_norm f).1 ⟨i, rfl⟩ },
  have hp'' : 0 < p.to_real := ennreal.to_real_pos hp hp',
  have : ∀ i, 0 ≤ ‖f i‖ ^ p.to_real,
  { exact λ i, real.rpow_nonneg_of_nonneg (norm_nonneg _) _ },
  rw ← real.rpow_le_rpow_iff (norm_nonneg _) (norm_nonneg' _) hp'',
  convert le_has_sum (has_sum_norm hp'' f) i (λ i hi, this i),
end

lemma sum_rpow_le_norm_rpow (hp : 0 < p.to_real) (f : lp E p) (s : finset α) :
  ∑ i in s, ‖f i‖ ^ p.to_real ≤ ‖f‖ ^ p.to_real :=
begin
  rw lp.norm_rpow_eq_tsum hp f,
  have : ∀ i, 0 ≤ ‖f i‖ ^ p.to_real,
  { exact λ i, real.rpow_nonneg_of_nonneg (norm_nonneg _) _ },
  refine sum_le_tsum _ (λ i hi, this i) _,
  exact (lp.mem_ℓp f).summable hp
end

lemma norm_le_of_forall_le' [nonempty α] {f : lp E ∞} (C : ℝ) (hCf : ∀ i, ‖f i‖ ≤ C) : ‖f‖ ≤ C :=
begin
  refine (is_lub_norm f).2 _,
  rintros - ⟨i, rfl⟩,
  exact hCf i,
end

lemma norm_le_of_forall_le {f : lp E ∞} {C : ℝ} (hC : 0 ≤ C) (hCf : ∀ i, ‖f i‖ ≤ C) : ‖f‖ ≤ C :=
begin
  casesI is_empty_or_nonempty α,
  { simpa [eq_zero' f] using hC, },
  { exact norm_le_of_forall_le' C hCf },
end

lemma norm_le_of_tsum_le (hp : 0 < p.to_real) {C : ℝ} (hC : 0 ≤ C) {f : lp E p}
  (hf : ∑' i, ‖f i‖ ^ p.to_real ≤ C ^ p.to_real) :
  ‖f‖ ≤ C :=
begin
  rw [← real.rpow_le_rpow_iff (norm_nonneg' _) hC hp, norm_rpow_eq_tsum hp],
  exact hf,
end

lemma norm_le_of_forall_sum_le (hp : 0 < p.to_real) {C : ℝ} (hC : 0 ≤ C) {f : lp E p}
  (hf : ∀ s : finset α, ∑ i in s, ‖f i‖ ^ p.to_real ≤ C ^ p.to_real) :
  ‖f‖ ≤ C :=
norm_le_of_tsum_le hp hC (tsum_le_of_sum_le ((lp.mem_ℓp f).summable hp) hf)

end compare_pointwise

section normed_space

variables {𝕜 : Type*} [normed_field 𝕜] [Π i, normed_space 𝕜 (E i)]

instance : module 𝕜 (pre_lp E) := pi.module α E 𝕜

lemma mem_lp_const_smul (c : 𝕜) (f : lp E p) : c • (f : pre_lp E) ∈ lp E p :=
(lp.mem_ℓp f).const_smul c

variables (E p 𝕜)

/-- The `𝕜`-submodule of elements of `Π i : α, E i` whose `lp` norm is finite.  This is `lp E p`,
with extra structure. -/
def _root_.lp_submodule : submodule 𝕜 (pre_lp E) :=
{ smul_mem' := λ c f hf, by simpa using mem_lp_const_smul c ⟨f, hf⟩,
  .. lp E p }

variables {E p 𝕜}

lemma coe_lp_submodule : (lp_submodule E p 𝕜).to_add_subgroup = lp E p := rfl

instance : module 𝕜 (lp E p) :=
{ .. (lp_submodule E p 𝕜).module }

@[simp] lemma coe_fn_smul (c : 𝕜) (f : lp E p) : ⇑(c • f) = c • f := rfl

lemma norm_const_smul (hp : p ≠ 0) {c : 𝕜} (f : lp E p) : ‖c • f‖ = ‖c‖ * ‖f‖ :=
begin
  rcases p.trichotomy with rfl | rfl | hp,
  { exact absurd rfl hp },
  { cases is_empty_or_nonempty α; resetI,
    { simp [lp.eq_zero' f], },
    apply (lp.is_lub_norm (c • f)).unique,
    convert (lp.is_lub_norm f).mul_left (norm_nonneg c),
    ext a,
    simp [coe_fn_smul, norm_smul] },
  { suffices : ‖c • f‖ ^ p.to_real = (‖c‖ * ‖f‖) ^ p.to_real,
    { refine real.rpow_left_inj_on hp.ne' _ _ this,
      { exact norm_nonneg' _ },
      { exact mul_nonneg (norm_nonneg _) (norm_nonneg' _) } },
    apply (lp.has_sum_norm hp (c • f)).unique,
    convert (lp.has_sum_norm hp f).mul_left (‖c‖ ^ p.to_real),
    { simp [coe_fn_smul, norm_smul, real.mul_rpow (norm_nonneg c) (norm_nonneg _)] },
    have hf : 0 ≤ ‖f‖ := lp.norm_nonneg' f,
    simp [coe_fn_smul, norm_smul, real.mul_rpow (norm_nonneg c) hf] }
end

instance [fact (1 ≤ p)] : normed_space 𝕜 (lp E p) :=
{ norm_smul_le := λ c f, begin
    have hp : 0 < p := zero_lt_one.trans_le (fact.out _),
    simp [norm_const_smul hp.ne']
  end }

variables {𝕜' : Type*} [normed_field 𝕜']

instance [Π i, normed_space 𝕜' (E i)] [has_smul 𝕜' 𝕜] [Π i, is_scalar_tower 𝕜' 𝕜 (E i)] :
  is_scalar_tower 𝕜' 𝕜 (lp E p) :=
begin
  refine ⟨λ r c f, _⟩,
  ext1,
  exact (lp.coe_fn_smul _ _).trans (smul_assoc _ _ _)
end

end normed_space

section normed_star_group

variables [Π i, star_add_monoid (E i)] [Π i, normed_star_group (E i)]

lemma _root_.mem_ℓp.star_mem {f : Π i, E i}
  (hf : mem_ℓp f p) : mem_ℓp (star f) p :=
begin
  rcases p.trichotomy with rfl | rfl | hp,
  { apply mem_ℓp_zero,
    simp [hf.finite_dsupport] },
  { apply mem_ℓp_infty,
    simpa using hf.bdd_above },
  { apply mem_ℓp_gen,
    simpa using hf.summable hp },
end

@[simp] lemma _root_.mem_ℓp.star_iff {f : Π i, E i} : mem_ℓp (star f) p ↔ mem_ℓp f p :=
⟨λ h, star_star f ▸ mem_ℓp.star_mem h ,mem_ℓp.star_mem⟩

instance : has_star (lp E p) :=
{ star := λ f, ⟨(star f : Π i, E i), f.property.star_mem⟩}

@[simp] lemma coe_fn_star (f : lp E p) : ⇑(star f) = star f := rfl
@[simp] protected theorem star_apply (f : lp E p) (i : α) : star f i = star (f i) := rfl

instance : has_involutive_star (lp E p) := { star_involutive := λ x, by {ext, simp} }

instance : star_add_monoid (lp E p) := { star_add := λ f g, ext $ star_add _ _ }

instance [hp : fact (1 ≤ p)] : normed_star_group (lp E p) :=
{ norm_star := λ f,
  begin
    unfreezingI { rcases p.trichotomy with rfl | rfl | h },
    { exfalso,
      have := ennreal.to_real_mono ennreal.zero_ne_top hp.elim,
      norm_num at this,},
    { simp only [lp.norm_eq_csupr, lp.star_apply, norm_star] },
    { simp only [lp.norm_eq_tsum_rpow h, lp.star_apply, norm_star] }
  end }

variables {𝕜 : Type*} [has_star 𝕜] [normed_field 𝕜]
variables [Π i, normed_space 𝕜 (E i)] [Π i, star_module 𝕜 (E i)]

instance : star_module 𝕜 (lp E p) := { star_smul := λ r f, ext $ star_smul _ _ }

end normed_star_group

section non_unital_normed_ring

variables {I : Type*} {B : I → Type*} [Π i, non_unital_normed_ring (B i)]

lemma _root_.mem_ℓp.infty_mul {f g : Π i, B i} (hf : mem_ℓp f ∞) (hg : mem_ℓp g ∞) :
  mem_ℓp (f * g) ∞ :=
begin
  rw mem_ℓp_infty_iff,
  obtain ⟨⟨Cf, hCf⟩, ⟨Cg, hCg⟩⟩ := ⟨hf.bdd_above, hg.bdd_above⟩,
  refine ⟨Cf * Cg, _⟩,
  rintros _ ⟨i, rfl⟩,
  calc ‖(f * g) i‖ ≤ ‖f i‖ * ‖g i‖ : norm_mul_le (f i) (g i)
  ...             ≤ Cf * Cg       : mul_le_mul (hCf ⟨i, rfl⟩) (hCg ⟨i, rfl⟩) (norm_nonneg _)
                                      ((norm_nonneg _).trans (hCf ⟨i, rfl⟩))
end

instance : has_mul (lp B ∞) :=
{ mul := λ f g, ⟨(f  * g : Π i, B i) , f.property.infty_mul g.property⟩}

@[simp] lemma infty_coe_fn_mul (f g : lp B ∞) : ⇑(f * g) = f * g := rfl

instance : non_unital_ring (lp B ∞) :=
function.injective.non_unital_ring lp.has_coe_to_fun.coe (subtype.coe_injective)
  (lp.coe_fn_zero B ∞) lp.coe_fn_add infty_coe_fn_mul lp.coe_fn_neg lp.coe_fn_sub
  (λ _ _, rfl) (λ _ _,rfl)

instance : non_unital_normed_ring (lp B ∞) :=
{ norm_mul := λ f g, lp.norm_le_of_forall_le (mul_nonneg (norm_nonneg f) (norm_nonneg g))
    (λ i, calc ‖(f * g) i‖ ≤ ‖f i‖ * ‖g i‖ : norm_mul_le _ _
    ...                    ≤ ‖f‖ * ‖g‖
    : mul_le_mul (lp.norm_apply_le_norm ennreal.top_ne_zero f i)
        (lp.norm_apply_le_norm ennreal.top_ne_zero g i) (norm_nonneg _) (norm_nonneg _)),
  .. lp.normed_add_comm_group }

-- we also want a `non_unital_normed_comm_ring` instance, but this has to wait for #13719

instance infty_is_scalar_tower {𝕜} [normed_field 𝕜] [Π i, normed_space 𝕜 (B i)]
  [Π i, is_scalar_tower 𝕜 (B i) (B i)] :
  is_scalar_tower 𝕜 (lp B ∞) (lp B ∞) :=
⟨λ r f g, lp.ext $ smul_assoc r ⇑f ⇑g⟩

instance infty_smul_comm_class {𝕜} [normed_field 𝕜] [Π i, normed_space 𝕜 (B i)]
  [Π i, smul_comm_class 𝕜 (B i) (B i)] :
  smul_comm_class 𝕜 (lp B ∞) (lp B ∞) :=
⟨λ r f g, lp.ext $ smul_comm r ⇑f ⇑g⟩

section star_ring

variables [Π i, star_ring (B i)] [Π i, normed_star_group (B i)]

instance infty_star_ring : star_ring (lp B ∞) :=
{ star_mul := λ f g, ext $ star_mul (_ : Π i, B i) _,
  .. (show star_add_monoid (lp B ∞),
      by { letI : Π i, star_add_monoid (B i) := λ i, infer_instance, apply_instance }) }

instance infty_cstar_ring [∀ i, cstar_ring (B i)] : cstar_ring (lp B ∞) :=
{ norm_star_mul_self := λ f,
  begin
    apply le_antisymm,
    { rw ←sq,
      refine lp.norm_le_of_forall_le (sq_nonneg ‖ f ‖) (λ i, _),
      simp only [lp.star_apply, cstar_ring.norm_star_mul_self, ←sq, infty_coe_fn_mul, pi.mul_apply],
      refine sq_le_sq' _ (lp.norm_apply_le_norm ennreal.top_ne_zero _ _),
      linarith [norm_nonneg (f i), norm_nonneg f] },
    { rw [←sq, ←real.le_sqrt (norm_nonneg _) (norm_nonneg _)],
      refine lp.norm_le_of_forall_le (‖star f * f‖.sqrt_nonneg) (λ i, _),
      rw [real.le_sqrt (norm_nonneg _) (norm_nonneg _), sq, ←cstar_ring.norm_star_mul_self],
      exact lp.norm_apply_le_norm ennreal.top_ne_zero (star f * f) i, }
  end }

end star_ring

end non_unital_normed_ring

section normed_ring

variables {I : Type*} {B : I → Type*} [Π i, normed_ring (B i)]

instance _root_.pre_lp.ring : ring (pre_lp B) := pi.ring

variables [Π i, norm_one_class (B i)]

lemma _root_.one_mem_ℓp_infty : mem_ℓp (1 : Π i, B i) ∞ :=
⟨1, by { rintros i ⟨i, rfl⟩, exact norm_one.le,}⟩

variables (B)

/-- The `𝕜`-subring of elements of `Π i : α, B i` whose `lp` norm is finite. This is `lp E ∞`,
with extra structure. -/
def _root_.lp_infty_subring : subring (pre_lp B) :=
{ carrier := {f | mem_ℓp f ∞},
  one_mem' := one_mem_ℓp_infty,
  mul_mem' := λ f g hf hg, hf.infty_mul hg,
  .. lp B ∞ }

variables {B}

instance infty_ring : ring (lp B ∞) := (lp_infty_subring B).to_ring

lemma _root_.mem_ℓp.infty_pow {f : Π i, B i} (hf : mem_ℓp f ∞) (n : ℕ) : mem_ℓp (f ^ n) ∞ :=
(lp_infty_subring B).pow_mem hf n

lemma _root_.nat_cast_mem_ℓp_infty (n : ℕ) : mem_ℓp (n : Π i, B i) ∞ :=
nat_cast_mem (lp_infty_subring B) n

lemma _root_.int_cast_mem_ℓp_infty (z : ℤ) : mem_ℓp (z : Π i, B i) ∞ :=
coe_int_mem (lp_infty_subring B) z

@[simp] lemma infty_coe_fn_one : ⇑(1 : lp B ∞) = 1 := rfl

@[simp] lemma infty_coe_fn_pow (f : lp B ∞) (n : ℕ) : ⇑(f ^ n) = f ^ n := rfl

@[simp] lemma infty_coe_fn_nat_cast (n : ℕ) : ⇑(n : lp B ∞) = n := rfl

@[simp] lemma infty_coe_fn_int_cast (z : ℤ) : ⇑(z : lp B ∞) = z := rfl

instance [nonempty I] : norm_one_class (lp B ∞) :=
{ norm_one := by simp_rw [lp.norm_eq_csupr, infty_coe_fn_one, pi.one_apply, norm_one, csupr_const]}

instance infty_normed_ring : normed_ring (lp B ∞) :=
{ .. lp.infty_ring, .. lp.non_unital_normed_ring }

end normed_ring

section normed_comm_ring

variables {I : Type*} {B : I → Type*} [Π i, normed_comm_ring (B i)] [∀ i, norm_one_class (B i)]

instance infty_comm_ring : comm_ring (lp B ∞) :=
{ mul_comm := λ f g, by { ext, simp only [lp.infty_coe_fn_mul, pi.mul_apply, mul_comm] },
  .. lp.infty_ring }

instance infty_normed_comm_ring : normed_comm_ring (lp B ∞) :=
{ .. lp.infty_comm_ring, .. lp.infty_normed_ring }

end normed_comm_ring

section algebra
variables {I : Type*} {𝕜 : Type*} {B : I → Type*}
variables [normed_field 𝕜] [Π i, normed_ring (B i)] [Π i, normed_algebra 𝕜 (B i)]

/-- A variant of `pi.algebra` that lean can't find otherwise. -/
instance _root_.pi.algebra_of_normed_algebra : algebra 𝕜 (Π i, B i) :=
@pi.algebra I 𝕜 B _ _ $ λ i, normed_algebra.to_algebra

instance _root_.pre_lp.algebra : algebra 𝕜 (pre_lp B) := _root_.pi.algebra_of_normed_algebra

variables [∀ i, norm_one_class (B i)]

lemma _root_.algebra_map_mem_ℓp_infty (k : 𝕜) : mem_ℓp (algebra_map 𝕜 (Π i, B i) k) ∞ :=
begin
  rw algebra.algebra_map_eq_smul_one,
  exact (one_mem_ℓp_infty.const_smul k : mem_ℓp (k • 1 : Π i, B i) ∞)
end

variables (𝕜 B)

/-- The `𝕜`-subalgebra of elements of `Π i : α, B i` whose `lp` norm is finite. This is `lp E ∞`,
with extra structure. -/
def _root_.lp_infty_subalgebra : subalgebra 𝕜 (pre_lp B) :=
{ carrier := {f | mem_ℓp f ∞},
  algebra_map_mem' := algebra_map_mem_ℓp_infty,
  .. lp_infty_subring B }

variables {𝕜 B}

instance infty_normed_algebra : normed_algebra 𝕜 (lp B ∞) :=
{ ..(lp_infty_subalgebra 𝕜 B).algebra,
  ..(lp.normed_space : normed_space 𝕜 (lp B ∞)) }

end algebra

section single
variables {𝕜 : Type*} [normed_field 𝕜] [Π i, normed_space 𝕜 (E i)]
variables [decidable_eq α]

/-- The element of `lp E p` which is `a : E i` at the index `i`, and zero elsewhere. -/
protected def single (p) (i : α) (a : E i) : lp E p :=
⟨ λ j, if h : j = i then eq.rec a h.symm else 0,
  begin
    refine (mem_ℓp_zero _).of_exponent_ge (zero_le p),
    refine (set.finite_singleton i).subset _,
    intros j,
    simp only [forall_exists_index, set.mem_singleton_iff, ne.def, dite_eq_right_iff,
      set.mem_set_of_eq, not_forall],
    rintros rfl,
    simp,
  end ⟩

protected lemma single_apply (p) (i : α) (a : E i) (j : α) :
  lp.single p i a j = if h : j = i then eq.rec a h.symm else 0 :=
rfl

protected lemma single_apply_self (p) (i : α) (a : E i) :
  lp.single p i a i = a :=
by rw [lp.single_apply, dif_pos rfl]

protected lemma single_apply_ne (p) (i : α) (a : E i) {j : α} (hij : j ≠ i) :
  lp.single p i a j = 0 :=
by rw [lp.single_apply, dif_neg hij]

@[simp] protected lemma single_neg (p) (i : α) (a : E i) :
  lp.single p i (- a) = - lp.single p i a :=
begin
  ext j,
  by_cases hi : j = i,
  { subst hi,
    simp [lp.single_apply_self] },
  { simp [lp.single_apply_ne p i _ hi] }
end

@[simp] protected lemma single_smul (p) (i : α) (a : E i) (c : 𝕜) :
  lp.single p i (c • a) = c • lp.single p i a :=
begin
  ext j,
  by_cases hi : j = i,
  { subst hi,
    simp [lp.single_apply_self] },
  { simp [lp.single_apply_ne p i _ hi] }
end

protected lemma norm_sum_single (hp : 0 < p.to_real) (f : Π i, E i) (s : finset α) :
  ‖∑ i in s, lp.single p i (f i)‖ ^ p.to_real = ∑ i in s, ‖f i‖ ^ p.to_real :=
begin
  refine (has_sum_norm hp (∑ i in s, lp.single p i (f i))).unique _,
  simp only [lp.single_apply, coe_fn_sum, finset.sum_apply, finset.sum_dite_eq],
  have h : ∀ i ∉ s, ‖ite (i ∈ s) (f i) 0‖ ^ p.to_real = 0,
  { intros i hi,
    simp [if_neg hi, real.zero_rpow hp.ne'], },
  have h' : ∀ i ∈ s, ‖f i‖ ^ p.to_real = ‖ite (i ∈ s) (f i) 0‖ ^ p.to_real,
  { intros i hi,
    rw if_pos hi },
  simpa [finset.sum_congr rfl h'] using has_sum_sum_of_ne_finset_zero h,
end

protected lemma norm_single (hp : 0 < p.to_real) (f : Π i, E i) (i : α) :
  ‖lp.single p i (f i)‖ = ‖f i‖ :=
begin
  refine real.rpow_left_inj_on hp.ne' (norm_nonneg' _) (norm_nonneg _) _,
  simpa using lp.norm_sum_single hp f {i},
end

protected lemma norm_sub_norm_compl_sub_single (hp : 0 < p.to_real) (f : lp E p) (s : finset α) :
  ‖f‖ ^ p.to_real - ‖f - ∑ i in s, lp.single p i (f i)‖ ^ p.to_real = ∑ i in s, ‖f i‖ ^ p.to_real :=
begin
  refine ((has_sum_norm hp f).sub (has_sum_norm hp (f - ∑ i in s, lp.single p i (f i)))).unique _,
  let F : α → ℝ := λ i, ‖f i‖ ^ p.to_real - ‖(f - ∑ i in s, lp.single p i (f i)) i‖ ^ p.to_real,
  have hF : ∀ i ∉ s, F i = 0,
  { intros i hi,
    suffices : ‖f i‖ ^ p.to_real - ‖f i - ite (i ∈ s) (f i) 0‖ ^ p.to_real = 0,
    { simpa only [F, coe_fn_sum, lp.single_apply, coe_fn_sub, pi.sub_apply, finset.sum_apply,
        finset.sum_dite_eq] using this, },
    simp only [if_neg hi, sub_zero, sub_self] },
  have hF' : ∀ i ∈ s, F i = ‖f i‖ ^ p.to_real,
  { intros i hi,
    simp only [F, coe_fn_sum, lp.single_apply, if_pos hi, sub_self, eq_self_iff_true,
      coe_fn_sub, pi.sub_apply, finset.sum_apply, finset.sum_dite_eq, sub_eq_self],
    simp [real.zero_rpow hp.ne'], },
  have : has_sum F (∑ i in s, F i) := has_sum_sum_of_ne_finset_zero hF,
  rwa [finset.sum_congr rfl hF'] at this,
end

protected lemma norm_compl_sum_single (hp : 0 < p.to_real) (f : lp E p) (s : finset α) :
  ‖f - ∑ i in s, lp.single p i (f i)‖ ^ p.to_real = ‖f‖ ^ p.to_real - ∑ i in s, ‖f i‖ ^ p.to_real :=
by linarith [lp.norm_sub_norm_compl_sub_single hp f s]

/-- The canonical finitely-supported approximations to an element `f` of `lp` converge to it, in the
`lp` topology. -/
protected lemma has_sum_single [fact (1 ≤ p)] (hp : p ≠ ⊤) (f : lp E p) :
  has_sum (λ i : α, lp.single p i (f i : E i)) f :=
begin
  have hp₀ : 0 < p := zero_lt_one.trans_le (fact.out _),
  have hp' : 0 < p.to_real := ennreal.to_real_pos hp₀.ne' hp,
  have := lp.has_sum_norm hp' f,
  rw [has_sum, metric.tendsto_nhds] at this ⊢,
  intros ε hε,
  refine (this _ (real.rpow_pos_of_pos hε p.to_real)).mono _,
  intros s hs,
  rw ← real.rpow_lt_rpow_iff dist_nonneg (le_of_lt hε) hp',
  rw dist_comm at hs,
  simp only [dist_eq_norm, real.norm_eq_abs] at hs ⊢,
  have H : ‖∑ i in s, lp.single p i (f i : E i) - f‖ ^ p.to_real
    = ‖f‖ ^ p.to_real - ∑ i in s, ‖f i‖ ^ p.to_real,
  { simpa only [coe_fn_neg, pi.neg_apply, lp.single_neg, finset.sum_neg_distrib,
      neg_sub_neg, norm_neg, _root_.norm_neg] using lp.norm_compl_sum_single hp' (-f) s },
  rw ← H at hs,
  have : |‖∑ i in s, lp.single p i (f i : E i) - f‖ ^ p.to_real|
    = ‖∑ i in s, lp.single p i (f i : E i) - f‖ ^ p.to_real,
  { simp only [real.abs_rpow_of_nonneg (norm_nonneg _), abs_norm_eq_norm] },
  linarith
end

end single

section topology

open filter
open_locale topology uniformity

/-- The coercion from `lp E p` to `Π i, E i` is uniformly continuous. -/
lemma uniform_continuous_coe [_i : fact (1 ≤ p)] : uniform_continuous (coe : lp E p → Π i, E i) :=
begin
  have hp : p ≠ 0 := (zero_lt_one.trans_le _i.elim).ne',
  rw uniform_continuous_pi,
  intros i,
  rw normed_add_comm_group.uniformity_basis_dist.uniform_continuous_iff
    normed_add_comm_group.uniformity_basis_dist,
  intros ε hε,
  refine ⟨ε, hε, _⟩,
  rintros f g (hfg : ‖f - g‖ < ε),
  have : ‖f i - g i‖ ≤ ‖f - g‖ := norm_apply_le_norm hp (f - g) i,
  exact this.trans_lt hfg,
end

variables {ι : Type*} {l : filter ι} [filter.ne_bot l]

lemma norm_apply_le_of_tendsto {C : ℝ} {F : ι → lp E ∞} (hCF : ∀ᶠ k in l, ‖F k‖ ≤ C)
  {f : Π a, E a} (hf : tendsto (id (λ i, F i) : ι → Π a, E a) l (𝓝 f)) (a : α) :
  ‖f a‖ ≤ C :=
begin
  have : tendsto (λ k, ‖F k a‖) l (𝓝 ‖f a‖) :=
    (tendsto.comp (continuous_apply a).continuous_at hf).norm,
  refine le_of_tendsto this (hCF.mono _),
  intros k hCFk,
  exact (norm_apply_le_norm ennreal.top_ne_zero (F k) a).trans hCFk,
end

variables [_i : fact (1 ≤ p)]

include _i

lemma sum_rpow_le_of_tendsto (hp : p ≠ ∞) {C : ℝ} {F : ι → lp E p} (hCF : ∀ᶠ k in l, ‖F k‖ ≤ C)
  {f : Π a, E a} (hf : tendsto (id (λ i, F i) : ι → Π a, E a) l (𝓝 f)) (s : finset α) :
  ∑ (i : α) in s, ‖f i‖ ^ p.to_real ≤ C ^ p.to_real :=
begin
  have hp' : p ≠ 0 := (zero_lt_one.trans_le _i.elim).ne',
  have hp'' : 0 < p.to_real := ennreal.to_real_pos hp' hp,
  let G : (Π a, E a) → ℝ := λ f, ∑ a in s, ‖f a‖ ^ p.to_real,
  have hG : continuous G,
  { refine continuous_finset_sum s _,
    intros a ha,
    have : continuous (λ f : Π a, E a, f a):= continuous_apply a,
    exact this.norm.rpow_const (λ _, or.inr hp''.le) },
  refine le_of_tendsto (hG.continuous_at.tendsto.comp hf) _,
  refine hCF.mono _,
  intros k hCFk,
  refine (lp.sum_rpow_le_norm_rpow hp'' (F k) s).trans _,
  exact real.rpow_le_rpow (norm_nonneg _) hCFk hp''.le,
end

/-- "Semicontinuity of the `lp` norm": If all sufficiently large elements of a sequence in `lp E p`
 have `lp` norm `≤ C`, then the pointwise limit, if it exists, also has `lp` norm `≤ C`. -/
lemma norm_le_of_tendsto {C : ℝ} {F : ι → lp E p} (hCF : ∀ᶠ k in l, ‖F k‖ ≤ C) {f : lp E p}
  (hf : tendsto (id (λ i, F i) : ι → Π a, E a) l (𝓝 f)) :
  ‖f‖ ≤ C :=
begin
  obtain ⟨i, hi⟩ := hCF.exists,
  have hC : 0 ≤ C := (norm_nonneg _).trans hi,
  unfreezingI { rcases eq_top_or_lt_top p with rfl | hp },
  { apply norm_le_of_forall_le hC,
    exact norm_apply_le_of_tendsto hCF hf, },
  { have : 0 < p := zero_lt_one.trans_le _i.elim,
    have hp' : 0 < p.to_real := ennreal.to_real_pos this.ne' hp.ne,
    apply norm_le_of_forall_sum_le hp' hC,
    exact sum_rpow_le_of_tendsto hp.ne hCF hf, }
end

/-- If `f` is the pointwise limit of a bounded sequence in `lp E p`, then `f` is in `lp E p`. -/
lemma mem_ℓp_of_tendsto {F : ι → lp E p} (hF : metric.bounded (set.range F)) {f : Π a, E a}
  (hf : tendsto (id (λ i, F i) : ι → Π a, E a) l (𝓝 f)) :
  mem_ℓp f p :=
begin
  obtain ⟨C, hC, hCF'⟩ := hF.exists_pos_norm_le,
  have hCF : ∀ k, ‖F k‖ ≤ C := λ k, hCF' _ ⟨k, rfl⟩,
  unfreezingI { rcases eq_top_or_lt_top p with rfl | hp },
  { apply mem_ℓp_infty,
    use C,
    rintros _ ⟨a, rfl⟩,
    refine norm_apply_le_of_tendsto (eventually_of_forall hCF) hf a, },
  { apply mem_ℓp_gen',
    exact sum_rpow_le_of_tendsto hp.ne (eventually_of_forall hCF) hf },
end

/-- If a sequence is Cauchy in the `lp E p` topology and pointwise convergent to a element `f` of
`lp E p`, then it converges to `f` in the `lp E p` topology. -/
lemma tendsto_lp_of_tendsto_pi {F : ℕ → lp E p} (hF : cauchy_seq F) {f : lp E p}
  (hf : tendsto (id (λ i, F i) : ℕ → Π a, E a) at_top (𝓝 f)) :
  tendsto F at_top (𝓝 f) :=
begin
  rw metric.nhds_basis_closed_ball.tendsto_right_iff,
  intros ε hε,
  have hε' : {p : (lp E p) × (lp E p) | ‖p.1 - p.2‖ < ε} ∈ 𝓤 (lp E p),
  { exact normed_add_comm_group.uniformity_basis_dist.mem_of_mem hε },
  refine (hF.eventually_eventually hε').mono _,
  rintros n (hn : ∀ᶠ l in at_top, ‖(λ f, F n - f) (F l)‖ < ε),
  refine norm_le_of_tendsto (hn.mono (λ k hk, hk.le)) _,
  rw tendsto_pi_nhds,
  intros a,
  exact (hf.apply a).const_sub (F n a),
end

variables [Π a, complete_space (E a)]

instance : complete_space (lp E p) :=
metric.complete_of_cauchy_seq_tendsto
begin
  intros F hF,
  -- A Cauchy sequence in `lp E p` is pointwise convergent; let `f` be the pointwise limit.
  obtain ⟨f, hf⟩ := cauchy_seq_tendsto_of_complete (uniform_continuous_coe.comp_cauchy_seq hF),
  -- Since the Cauchy sequence is bounded, its pointwise limit `f` is in `lp E p`.
  have hf' : mem_ℓp f p := mem_ℓp_of_tendsto hF.bounded_range hf,
  -- And therefore `f` is its limit in the `lp E p` topology as well as pointwise.
  exact ⟨⟨f, hf'⟩, tendsto_lp_of_tendsto_pi hF hf⟩
end

end topology

end lp


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

import group_theory.submonoid.pointwise

/-!

# Submonoid of inverses

Given a submonoid `N` of a monoid `M`, we define the submonoid `N.left_inv` as the submonoid of
left inverses of `N`. When `M` is commutative, we may define `from_comm_left_inv : N.left_inv →* N`
since the inverses are unique. When `N ≤ is_unit.submonoid M`, this is precisely
the pointwise inverse of `N`, and we may define `left_inv_equiv : S.left_inv ≃* S`.

For the pointwise inverse of submonoids of groups, please refer to
`group_theory.submonoid.pointwise`.

## TODO

Define the submonoid of right inverses and two-sided inverses.
See the comments of #10679 for a possible implementation.

-/
variables {M : Type*}

namespace submonoid

@[to_additive]
noncomputable instance [monoid M] : group (is_unit.submonoid M) :=
{ inv := λ x, ⟨_, (x.prop.unit⁻¹).is_unit⟩,
  mul_left_inv := λ x, subtype.eq x.prop.unit.inv_val,
 ..(show monoid (is_unit.submonoid M), by apply_instance) }

@[to_additive]
noncomputable instance [comm_monoid M] : comm_group (is_unit.submonoid M) :=
{ mul_comm := λ a b, mul_comm a b,
 ..(show group (is_unit.submonoid M), by apply_instance) }

@[to_additive] lemma is_unit.submonoid.coe_inv [monoid M] (x : is_unit.submonoid M) :
  ↑(x⁻¹) = (↑x.prop.unit⁻¹ : M) := rfl

section monoid

variables [monoid M] (S : submonoid M)

/-- `S.left_inv` is the submonoid containing all the left inverses of `S`. -/
@[to_additive "`S.left_neg` is the additive submonoid containing all the left additive inverses
of `S`."]
def left_inv : submonoid M :=
{ carrier := { x : M | ∃ y : S, x * y = 1 },
  one_mem' := ⟨1, mul_one 1⟩,
  mul_mem' := λ a b ⟨a', ha⟩ ⟨b', hb⟩,
    ⟨b' * a', by rw [coe_mul, ← mul_assoc, mul_assoc a, hb, mul_one, ha]⟩ }

@[to_additive]

@[to_additive]
lemma unit_mem_left_inv (x : Mˣ) (hx : (x : M) ∈ S) : ((x⁻¹ : _) : M) ∈ S.left_inv :=
⟨⟨x, hx⟩, x.inv_val⟩

@[to_additive]
lemma left_inv_left_inv_eq (hS : S ≤ is_unit.submonoid M) : S.left_inv.left_inv = S :=
begin
  refine le_antisymm S.left_inv_left_inv_le _,
  intros x hx,
  have : x = ((hS hx).unit⁻¹⁻¹ : Mˣ) := by { rw [inv_inv (hS hx).unit], refl },
  rw this,
  exact S.left_inv.unit_mem_left_inv _ (S.unit_mem_left_inv _ hx)
end

/-- The function from `S.left_inv` to `S` sending an element to its right inverse in `S`.
This is a `monoid_hom` when `M` is commutative. -/
@[to_additive "The function from `S.left_add` to `S` sending an element to its right additive
inverse in `S`. This is an `add_monoid_hom` when `M` is commutative."]
noncomputable
def from_left_inv : S.left_inv → S := λ x, x.prop.some

@[simp, to_additive]
lemma mul_from_left_inv (x : S.left_inv) : (x : M) * S.from_left_inv x = 1 :=
x.prop.some_spec

@[simp, to_additive] lemma from_left_inv_one : S.from_left_inv 1 = 1 :=
(one_mul _).symm.trans (subtype.eq $ S.mul_from_left_inv 1)

end monoid

section comm_monoid

variables [comm_monoid M] (S : submonoid M)

@[simp, to_additive]
lemma from_left_inv_mul (x : S.left_inv) : (S.from_left_inv x : M) * x = 1 :=
by rw [mul_comm, mul_from_left_inv]

@[to_additive]
lemma left_inv_le_is_unit : S.left_inv ≤ is_unit.submonoid M :=
λ x ⟨y, hx⟩, ⟨⟨x, y, hx, mul_comm x y ▸ hx⟩, rfl⟩

@[to_additive]
lemma from_left_inv_eq_iff (a : S.left_inv) (b : M) :
  (S.from_left_inv a : M) = b ↔ (a : M) * b = 1 :=
by rw [← is_unit.mul_right_inj (left_inv_le_is_unit _ a.prop), S.mul_from_left_inv, eq_comm]

/-- The `monoid_hom` from `S.left_inv` to `S` sending an element to its right inverse in `S`. -/
@[to_additive "The `add_monoid_hom` from `S.left_neg` to `S` sending an element to its
right additive inverse in `S`.", simps]
noncomputable
def from_comm_left_inv : S.left_inv →* S :=
{ to_fun := S.from_left_inv,
  map_one' := S.from_left_inv_one,
  map_mul' := λ x y, subtype.ext $
    by rw [from_left_inv_eq_iff, mul_comm x, submonoid.coe_mul, submonoid.coe_mul, mul_assoc,
      ← mul_assoc (x : M), mul_from_left_inv, one_mul, mul_from_left_inv] }

variable (hS : S ≤ is_unit.submonoid M)

include hS

/-- The submonoid of pointwise inverse of `S` is `mul_equiv` to `S`. -/
@[to_additive "The additive submonoid of pointwise additive inverse of `S` is
`add_equiv` to `S`.", simps apply]
noncomputable
def left_inv_equiv : S.left_inv ≃* S :=
{ inv_fun := λ x, by { choose x' hx using (hS x.prop), exact ⟨x'.inv, x, hx ▸ x'.inv_val⟩ },
  left_inv := λ x, subtype.eq $ begin
      dsimp, generalize_proofs h, rw ← h.some.mul_left_inj,
      exact h.some.inv_val.trans ((S.mul_from_left_inv x).symm.trans (by rw h.some_spec)),
  end,
  right_inv := λ x, by { dsimp, ext, rw [from_left_inv_eq_iff], convert (hS x.prop).some.inv_val,
    exact (hS x.prop).some_spec.symm },
  ..S.from_comm_left_inv }

@[simp, to_additive] lemma from_left_inv_left_inv_equiv_symm (x : S) :
  S.from_left_inv ((S.left_inv_equiv hS).symm x) = x := (S.left_inv_equiv hS).right_inv x

@[simp, to_additive] lemma left_inv_equiv_symm_from_left_inv (x : S.left_inv) :
  (S.left_inv_equiv hS).symm (S.from_left_inv x) = x := (S.left_inv_equiv hS).left_inv x

@[to_additive]
lemma left_inv_equiv_mul (x : S.left_inv) : (S.left_inv_equiv hS x : M) * x = 1 := by simp

@[to_additive]
lemma mul_left_inv_equiv (x : S.left_inv) : (x : M) * S.left_inv_equiv hS x = 1 := by simp

@[simp, to_additive] lemma left_inv_equiv_symm_mul (x : S) :
  ((S.left_inv_equiv hS).symm x : M) * x = 1 :=
by { convert S.mul_left_inv_equiv hS ((S.left_inv_equiv hS).symm x), simp }

@[simp, to_additive] lemma mul_left_inv_equiv_symm (x : S) :
  (x : M) * (S.left_inv_equiv hS).symm x = 1 :=
by { convert S.left_inv_equiv_mul hS ((S.left_inv_equiv hS).symm x), simp }

end comm_monoid

section group

variables [group M] (S : submonoid M)

open_locale pointwise

@[to_additive] lemma left_inv_eq_inv : S.left_inv = S⁻¹ :=
submonoid.ext $ λ x,
  ⟨λ h, submonoid.mem_inv.mpr ((inv_eq_of_mul_eq_one h.some_spec).symm ▸ h.some.prop),
    λ h, ⟨⟨_, h⟩, mul_right_inv _⟩⟩

@[simp, to_additive] lemma from_left_inv_eq_inv (x : S.left_inv) :
  (S.from_left_inv x : M) = x⁻¹ :=
by rw [← mul_right_inj (x : M), mul_right_inv, mul_from_left_inv]

end group

section comm_group

variables [comm_group M] (S : submonoid M) (hS : S ≤ is_unit.submonoid M)

@[simp, to_additive] lemma left_inv_equiv_symm_eq_inv (x : S) :
  ((S.left_inv_equiv hS).symm x : M) = x⁻¹ :=
by rw [← mul_right_inj (x : M), mul_right_inv, mul_left_inv_equiv_symm]

end comm_group

end submonoid


import ring_theory.algebra
import ring_theory.ideals
/-!
    Galois algebra : B : Algebra A.
    G →* Aut (B / A)
    est-ce que le groupe des automorphismes d'algebre est ok !
 `A →ₐ[R] B`

-/
namespace prio
variables (k : Type)[comm_ring k] (B : Type)[comm_ring B][algebra k B](G : Type)[group G][fintype G] [mul_action G B]

instance coe_base_to_algebra : has_coe(k)B := ⟨λ r, algebra_map k B r ⟩
end prio
class Galois_algebra (k : Type)[comm_ring k] (B : Type)[comm_ring B][algebra k B](G : Type)[group G][fintype G] [mul_action G B]
 :=
(G_mul' : ∀ g : G, ∀ x y : B, g • (x * y) = g • x * g • y)
(G_add' : ∀ g : G, ∀ x y : B, g • (x+y) = g • x + g • y)
(G_smul' : ∀ g : G, ∀ x : B, ∀ r : k, g • (r • x) = r • (g • x) )
(invariant' : ∀ b : B, ( (∀ g : G,  g •  b =  b) → (∃ a : k, b = a )))
/-!
*    ⟨ b - σ b | σ ∈ G ⟩
*
-/
variables {k : Type}[comm_ring k] {B : Type}[comm_ring B][algebra k B]
{G : Type}[group G][fintype G] [mul_action G B]
[Galois_algebra k B G]
#check Galois_algebra

example (g : G ) (b1 b2 : B):  g • (b1+b2) = g • (b1) + g • b2  := Galois_algebra.G_add'

def 𝒥   : G → ideal B := λ g : G,  ideal.span $ set.image (λ b, b -  (g ⊚ b)) set.univ

def separate_action (Δ : (Galois_algebra R B G)) : Prop := ∀ g : G, g ≠  1 → 𝒥  Δ  g  = ⊤

-- other has_mul_action ?  st g • (a * b)  = g • a * g • b,


import data.vector logic.embedding data.fin.basic data.list.basic
import data.list_extra

namespace vector
open vector

variables {α : Type*} {β : Type*} {n m : ℕ}

lemma head_eq_zeroth : ∀ (v : vector α (n + 1)), v.head = nth v 0
| ⟨list.nil,l_len⟩ := by {cases l_len}
| ⟨_ :: _,_⟩ := rfl

def single (a : α) : vector α 1 := vector.cons a vector.nil

lemma head_single (a : α) : (single a).head = a := rfl
lemma single_val (a : α) : (single a).val = [a] := rfl

lemma single_head : ∀ v : vector α 1, v = single v.head
| ⟨list.nil,l_len⟩ := by {cases l_len}
| ⟨[_],l_len⟩ := rfl
| ⟨_ :: _ :: _,l_len⟩ := by {cases l_len}

lemma veq_of_eq {x₀ x₁ : vector α n} (e : x₀ = x₁) :
 x₀.val = x₁.val := congr_arg subtype.val e

def concat (v : vector α n) (a : α) : vector α (n + 1) :=
 v.append (vector.single a)

def trim : ∀ (v : vector α (n + 1)), vector α n
| ⟨l,l_len⟩ := ⟨l.take n,
   by { rw[list.length_take,l_len],
        exact min_eq_left (le_of_lt n.lt_succ_self)}⟩

def last (v : vector α (n + 1)) : α := v.nth ⟨n,n.lt_succ_self⟩

lemma trim_to_list : ∀ (v : vector α (n + 1)), v.trim.to_list = v.to_list.take n
| ⟨l,l_len⟩ := rfl

lemma trim_concat : ∀ (v : vector α n) (a : α), (v.concat a).trim = v
| ⟨l,l_len⟩ a := subtype.eq $ by {
 change (l ++ [a]).take n = l,
 rw[← l_len,list.take_append_of_le_length (le_refl l.length),list.take_length],}

lemma last_concat : ∀ (v : vector α n) (a : α), (v.concat a).last = a
| ⟨l,l_len⟩ a := by {
 have h : n < (l ++ [a]).length :=
  by {rw[list.length_append,list.length,list.length,zero_add,l_len],
      exact n.lt_succ_self,},
 have h' : (l ++ [a]).nth n = some a := l_len ▸ (l.nth_concat_length a),
 injection ((list.nth_le_nth h).symm.trans h'),}

lemma concat_trim_last : ∀ (v : vector α (n + 1)), v.trim.concat v.last = v
| ⟨l,l_len⟩ := subtype.eq $ begin
 change (l.take n) ++ [l.nth_le n _] = l,
 let h := list.take_append_drop n l,
 let h' := list.drop_eq_last l_len,
 rw[h'] at h,
 exact h,
end

def cons_inj (n : ℕ) (a : α) : vector α n ↪ vector α (n + 1) := {
 to_fun := vector.cons a,
 inj' := λ ⟨l₀,l₀_len⟩ ⟨l₁,l₁_len⟩ e,
 begin
  apply subtype.eq,
  dsimp[vector.cons] at e,
  let f : vector α n → list α := @vector.to_list α n,
  let e' : list.cons a l₀ = list.cons a l₁ := vector.veq_of_eq e,
  injection e' with em ev
 end
}

def concat_inj (n : ℕ) (a : α) : vector α n ↪ vector α (n + 1) := {
 to_fun := λ v, v.concat a,
 inj' := λ ⟨l₀,l₀_len⟩ ⟨l₁,l₁_len⟩ e,
 begin
  apply subtype.eq,
  replace e := vector.veq_of_eq e,
  change l₀.append [a] = l₁.append [a] at e,
  change l₀ = l₁,
  exact list.append_inj_left e (l₀_len.trans l₁_len.symm),
 end
}

section prod

variable [monoid α]
variable [add_monoid β]

@[to_additive vector.sum]
def prod (v : vector α n) : α := v.val.prod

@[to_additive vector.sum_eq_val_sum]
lemma prod_eq_val_prod (v : vector α n) : v.prod = v.val.prod := rfl

@[to_additive vector.sum_cons]
lemma prod_cons : ∀ (a : α) (v : vector α n),
 (vector.cons a v).prod = a * v.prod
| a ⟨l,l_len⟩ := list.prod_cons

@[to_additive vector.sum_append]
lemma prod_append : ∀ (v : vector α n) (w : vector α m), (vector.append v w).prod = v.prod * w.prod
| ⟨l,l_len⟩ ⟨k,k_len⟩ := list.prod_append

lemma prod_concat (n : ℕ) : ∀ (v : vector α n) (a : α),
 (v.concat a).prod = v.prod * a
| ⟨l,l_len⟩ a := by {rw[concat],change (l ++ [a]).prod = l.prod * a,
                    rw[list.prod_append,list.prod_cons,list.prod_nil,mul_one],}

lemma sum_concat (n : ℕ) : ∀ (v : vector β n) (b : β),
 (v.concat b).sum = v.sum + b
| ⟨l,l_len⟩ b := by {rw[concat],change (l ++ [b]).sum = l.sum + b,
                    rw[list.sum_append,list.sum_cons,list.sum_nil,add_zero],}

end prod
end vector


import data.real.basic
import algebra.big_operators.finprod
import .external_lemmas

open set set.finite

open_locale classical big_operators

structure findist (Ω : Type*) :=
(pr : Ω → ℝ)
(finite : (function.support pr).finite)
(nonneg : ∀ x, 0 ≤ pr x)
(normal : ∑ᶠ x, pr x = 1)

namespace findist

variables {Ω : Type*} (σ : findist Ω)

def support : set Ω := function.support σ.pr

lemma nmem_support (x : Ω) : x ∉ σ.support ↔ σ.pr x = 0 := function.nmem_support

lemma mem_support (x : Ω) : x ∈ σ.support ↔ σ.pr x ≠ 0 := function.mem_support

lemma support_finite : σ.support.finite := σ.finite

lemma support_of_set_finite (A : set Ω) : (A ∩ σ.support).finite :=
inter_of_right σ.support_finite _

lemma le_one_of_mem_support {x : Ω} (h : x ∈ σ.support) : σ.pr x ≤ 1 :=
  le_trans (single_le_finsum _ σ.support_finite σ.nonneg) (le_of_eq σ.normal)

lemma le_one_of_nmem_support {x : Ω} (h : x ∉ σ.support) : σ.pr x ≤ 1 :=
  le_trans (le_of_eq ((σ.nmem_support _).mp h)) zero_le_one

lemma pr_le_one (x : Ω) : σ.pr x ≤ 1 := dite (x ∈ σ.support) (σ.le_one_of_mem_support) (σ.le_one_of_nmem_support)

noncomputable def Pr (A : set Ω) : ℝ := ∑ᶠ x ∈ A, σ.pr x

lemma Pr_eq (A : set Ω) : σ.Pr A = ∑ᶠ x ∈ A, σ.pr x := rfl

lemma Pr_singleton (x : Ω) : σ.Pr {x} = σ.pr x := finsum_mem_singleton

lemma Pr_sum_singletons (A : set Ω) : ∑ᶠ x ∈ A, σ.Pr {x} = σ.Pr A :=
  by simp only [Pr_eq, finsum_mem_congr, Pr_singleton]

lemma Pr_nonneg (A : set Ω) : 0 ≤ σ.Pr A :=
begin
  rw Pr, apply finsum_mem_nonneg,
  exact (λ _ _, σ.nonneg _)
end

lemma Pr_normal : σ.Pr univ = 1 :=
begin
  rw [Pr, finsum_mem_univ],
  exact σ.normal
end

lemma Pr_additive {A B : set Ω} (h: disjoint A B) : σ.Pr (A ∪ B) = σ.Pr A + σ.Pr B
:=
begin
  rw Pr, rw finsum_mem_union' h (σ.support_of_set_finite _) (σ.support_of_set_finite _),
  refl
end

lemma Pr_empty_eq_zero (σ : findist Ω) : σ.Pr ∅ = 0 :=
begin
  have h := σ.Pr_additive (empty_disjoint _),
  rwa [set.union_empty, self_eq_add_left] at h,
end

lemma Pr_finitely_additive (f : ℕ → set Ω) (n : ℕ) (h : pairwise (disjoint on f)) : σ.Pr (⋃ i ∈ Ico 0 n, f i) = ∑ᶠ i ∈ Ico 0 n, σ.Pr (f i) :=
begin
  induction n,
  { rw [Ico_self, finsum_mem_empty, ← σ.Pr_empty_eq_zero,bUnion_empty] },
  case succ : n ih {
    rw [bUnion_range_succ, finsum_range_succ], rw [Pr_additive, ih],
    rw set.disjoint_bUnion_left, intros i hi,
    apply h, rintro rfl,
    apply nat_ico_range_nmem i hi,
  }
end

lemma Pr_whole_eq_one (σ : findist Ω) : σ.Pr univ = 1 := σ.Pr_normal

lemma Pr_mono (σ : findist Ω) : monotone σ.Pr :=
begin
  intros A B hAB,
  have h := σ.Pr_additive (disjoint_diff),
  rw [set.union_comm, diff_union_of_subset hAB] at h,
  rw [h, le_add_iff_nonneg_right],
  apply σ.Pr_nonneg
end

lemma Pr_le_one (σ : findist Ω) (A : set Ω) : σ.Pr A ≤ 1 :=
begin
  rw ← σ.Pr_normal,
  apply σ.Pr_mono (subset_univ _)
end

lemma Pr_complement_eq_one_sub (σ : findist Ω) (A : set Ω) : σ.Pr Aᶜ = 1 - σ.Pr A :=
  by {  rw [← σ.Pr_normal, ←union_compl_self A, Pr_additive, add_tsub_cancel_left],
        rw [set.disjoint_iff_inter_eq_empty, inter_compl_self]}

lemma Pr_total_pair_compl (σ : findist Ω) (A B : set Ω) : σ.Pr A = σ.Pr (A ∩ B) + σ.Pr (A ∩ Bᶜ) := by rw [← σ.Pr_additive (disjoint_inter_inter_compl _ _), inter_union_compl]

/-
TODO: Finite version of this pair lemma.
-/

lemma Pr_total_pair_diff (σ : findist Ω) (A B : set Ω) : σ.Pr A = σ.Pr (A ∩ B) + σ.Pr (A \ B) := by {rw [diff_eq, Pr_total_pair_compl]}

lemma Pr_diff_eq_sub_Pr_inter (σ : findist Ω) (A B : set Ω) : σ.Pr (A \ B) = σ.Pr A - σ.Pr (A ∩ B) := by rw [σ.Pr_total_pair_diff A, add_tsub_cancel_left]

lemma Pr_union_inter (σ : findist Ω) (A B : set Ω)
  : σ.Pr (A ∪ B) + σ.Pr (A ∩ B) = σ.Pr A + σ.Pr B :=
begin
  rw union_eq_diff_union_diff_union_inter,
  rw [σ.Pr_additive (disjoint_diff_union_diff_inter _ _), σ.Pr_additive (disjoint_diff_diff A B), σ.Pr_total_pair_diff A B, σ.Pr_total_pair_diff B A, inter_comm B A],
  ring
end

lemma Pr_union_eq_inc_exc (σ : findist Ω) (A B : set Ω)
  : σ.Pr (A ∪ B) = σ.Pr A + σ.Pr B - σ.Pr (A ∩ B) :=
begin
  rw eq_sub_iff_add_eq,
  apply σ.Pr_union_inter
end

lemma Pr_inter_le_left (σ : findist Ω) (A B : set Ω)
  : σ.Pr (A ∩ B) ≤ σ.Pr A := σ.Pr_mono (inter_subset_left _ _)

lemma Pr_inter_le_right (σ : findist Ω) (A B : set Ω)
  : σ.Pr (A ∩ B) ≤ σ.Pr B := σ.Pr_mono (inter_subset_right _ _)

lemma Pr_subadditive (σ : findist Ω) (A B : set Ω) : σ.Pr (A ∪ B) ≤ σ.Pr A + σ.Pr B := by { rw [σ.Pr_union_eq_inc_exc, sub_le_self_iff], apply σ.Pr_nonneg }

lemma Pr_finitely_subadditive  (f : ℕ → set Ω) (n : ℕ) : σ.Pr (⋃ i ∈ Ico 0 n, f i) ≤ ∑ᶠ i ∈ Ico 0 n, σ.Pr (f i) :=
begin
  induction n,
  { rw [Ico_self, finsum_mem_empty, ← σ.Pr_empty_eq_zero,bUnion_empty] },
  case succ : n ih {
    rw [bUnion_range_succ, finsum_range_succ],
    exact le_trans (σ.Pr_subadditive _ _) (add_le_add ih (by refl)),
  }
end

noncomputable def Pr_cond (σ : findist Ω) (A B : set Ω) : ℝ := σ.Pr (A ∩ B) / σ.Pr B

lemma Pr_cond_mul_eq_Pr_inter (σ : findist Ω) (A B : set Ω)
  : σ.Pr (A ∩ B) = σ.Pr_cond A B * σ.Pr B :=
begin
  by_cases hB : (σ.Pr B = 0),
  {
    rw [hB, mul_zero],
    apply ge_antisymm (Pr_nonneg _ _),
    rw ← hB,
    apply Pr_inter_le_right
  },
  { rw [Pr_cond, div_mul_cancel _ hB], },
end

lemma Pr_cond_total_pair (σ : findist Ω) (A B : set Ω)
  : σ.Pr A = σ.Pr_cond A B * σ.Pr B + σ.Pr_cond A Bᶜ * σ.Pr Bᶜ :=
  by rw [σ.Pr_total_pair_compl _ B, Pr_cond_mul_eq_Pr_inter, Pr_cond_mul_eq_Pr_inter]

/-
TODO: Finite version of this pair lemma.
-/

lemma Pr_bayes {σ : findist Ω} (A B : set Ω)
  : σ.Pr_cond A B = (σ.Pr_cond B A * σ.Pr A) / σ.Pr B  :=
begin
  rw [Pr_cond, set.inter_comm, Pr_cond_mul_eq_Pr_inter],
end

lemma Pr_total_bayes {σ : findist Ω} (A B : set Ω)
  : σ.Pr_cond A B = (σ.Pr_cond B A * σ.Pr A) / (σ.Pr_cond B A * σ.Pr A + σ.Pr_cond B Aᶜ * σ.Pr Aᶜ) := by rw [Pr_bayes, Pr_cond_total_pair _ B A]

lemma Pr_cond_nonneg {σ : findist Ω} {B : set Ω} (h : σ.Pr B ≠ 0 ) : ∀ (A : set Ω), 0 ≤ σ.Pr_cond A B :=
begin
  intros A,
  unfold Pr_cond,
  rw le_div_iff,
  { simp only [zero_mul],
    apply Pr_nonneg,
  },
  rw lt_iff_le_and_ne,
  exact ⟨Pr_nonneg σ B, h.symm⟩
end

lemma Pr_cond_normal {σ : findist Ω} {B : set Ω} (h : σ.Pr B ≠ 0) : σ.Pr_cond univ B = 1 := by rw [Pr_cond, set.univ_inter, div_self h]

lemma Pr_cond_σ_add {σ : findist Ω} {B : set Ω} (h : σ.Pr B ≠ 0) : ∀ (S T : set Ω), disjoint S T → σ.Pr_cond (S ∪ T) B = σ.Pr_cond S B + σ.Pr_cond T B :=
begin
  intros _ _ _,
  unfold Pr_cond,
  rw [set.inter_distrib_right, Pr_additive, add_div],
  apply disjoint_of_subset_left (set.inter_subset_left _ _),
  apply disjoint_of_subset_right (set.inter_subset_left _ _),
  assumption
end

noncomputable def dirac_pr (ω x : Ω) : ℝ := if x = ω then 1 else 0

lemma dirac_pr_eq (ω x : Ω) : dirac_pr ω x = if x = ω then 1 else 0 := rfl

lemma dirac_ω (ω : Ω) : dirac_pr ω ω = 1 :=
  by { rw [dirac_pr_eq, if_pos], refl }

lemma dirac_nω (ω : Ω) : ∀ x, x ≠ ω → dirac_pr ω x = 0 := λ _ h, if_neg h

lemma dirac_support (ω : Ω) : function.support (dirac_pr ω) = {ω} :=
  by {  ext, rw [function.mem_support, dirac_pr, mem_singleton_iff,
        ite_ne_right_iff], finish }

lemma dirac_finite (ω : Ω) : (function.support (dirac_pr ω)).finite :=
  by { rw dirac_support, apply finite_singleton }

lemma dirac_nonneg (ω x : Ω) : 0 ≤ dirac_pr ω x :=
  by { rw dirac_pr_eq, split_ifs; finish }

lemma dirac_normal (ω : Ω) : ∑ᶠ (x : Ω), dirac_pr ω x = 1 :=
  by { rw finsum_eq_single _ _ (dirac_nω _), apply dirac_ω }

noncomputable def dirac (ω : Ω) : findist Ω :=
⟨dirac_pr ω,
dirac_finite _,
dirac_nonneg _,
dirac_normal _⟩

variables {Ξ : Type*} (θ : findist Ξ)

def product_pr : Ω × Ξ → ℝ
  := λ xy, σ.pr xy.fst * θ.pr xy.snd

lemma product_pr_eq (xy : Ω × Ξ) : σ.product_pr θ xy = σ.pr xy.fst * θ.pr xy.snd := rfl

lemma product_finite {Ξ : Type*} (θ : findist Ξ) : (function.support (σ.product_pr θ)).finite := (function.support_mul_finite_of_supports_finite (σ.finite) (θ.finite))

lemma product_nonneg {Ξ : Type*} (θ : findist Ξ) : ∀ (xy : Ω × Ξ), 0 ≤ σ.product_pr θ xy :=
begin
  intro xy, rw product_pr_eq,
  apply mul_nonneg (σ.nonneg _) (θ.nonneg _)
end

lemma product_normal {Ξ : Type*} (θ : findist Ξ) : ∑ᶠ (xy : Ω × Ξ), σ.product_pr θ xy = 1 :=
begin
  rw [finsum_congr (product_pr_eq _ _), finsum_sum_mul (σ.finite) (θ.finite),
  σ.normal, θ.normal, mul_one]
end

def product {Ξ : Type*} (θ : findist Ξ) : findist (Ω × Ξ)
:= ⟨σ.product_pr θ, σ.product_finite θ, σ.product_nonneg θ, σ.product_normal θ⟩

-- Uniform
-- "Map"
-- "Concat"
-- Bind?

end findist

structure rvar (Ω : Type*) (α : Type*) :=
(map : Ω → α)
(σ : findist Ω)

namespace rvar

variables {Ω : Type*} {α : Type*}

noncomputable def Pr (X : rvar Ω α) (T : set α) : ℝ := X.σ.Pr (X.map⁻¹' T)

noncomputable def pure (Ω : Type*) {α : Type*} (b : α) : rvar α α := ⟨id, findist.dirac b⟩

end rvar


import NBG.SetTheory.Defs
import NBG.SetTheory.Axioms.Universe

open Classical

-- 3. AxiomDifference
axiom AxiomDifference :
  ∀X Y: Class, ∃Z: Class,
    ∀u: Class, (u∈Z ↔ (u ∈ X ∧ u ∉ Y))
noncomputable def Diff (X Y: Class): Class :=
  choose (AxiomDifference X Y)
noncomputable instance : HasDiff Class where
  Diff := Diff
noncomputable def Diff_def (X Y: Class):
  ∀u: Class, (u ∈ (X ＼ Y) ↔ (u ∈ X ∧ u ∉ Y)) :=
  choose_spec (AxiomDifference X Y)

-- intersection
noncomputable def IntersectionClass_mk' (X Y: Class) :=
  X ＼ (X ＼ Y)
theorem IntersectionClassExists:
  ∀X Y: Class, ∃Z: Class,
    ∀z: Class, ((z ∈ Z) ↔ (z ∈ X) ∧ (z ∈ Y)) := by {
  intro X Y;
  let inter := IntersectionClass_mk' X Y;
  exists inter;
  have inter_def:
    ∀u: Class, (u ∈ inter ↔ (u ∈ X ∧ u ∉ (X ＼ Y))) :=
    choose_spec (AxiomDifference X (X ＼ Y));
  have diff_def:
    ∀u: Class, (u ∈ (X ＼ Y) ↔ (u ∈ X ∧ u ∉ Y)) :=
    choose_spec (AxiomDifference X Y);
  sorry;
}
noncomputable def IntersectionClass_mk (X Y: Class) :=
  choose (IntersectionClassExists X Y)
noncomputable instance : HasInter Class where
  Inter := IntersectionClass_mk
noncomputable def IntersectionClass_def (X Y: Class):
  ∀z: Class, ((z ∈ (X ∩ Y)) ↔ (z ∈ X) ∧ (z ∈ Y)) :=
  choose_spec (IntersectionClassExists X Y)
theorem IntersectionClassIntro (X Y: Class) :
  ∀z: Class, (z ∈ (X ∩ Y)) ↔ (z ∈ X) ∧ (z ∈ Y) :=
  IntersectionClass_def X Y
def isIntersectionClass {X Y: Class} (I: Class) :=
  ∀z: Class, (z ∈ I) ↔ (z ∈ X) ∧ (z ∈ Y)
class IntersectionClass {X Y: Class} (I : Class) where
  isIntersectionClass: (@isIntersectionClass X Y I)

-- union
noncomputable def UnionClass_mk' (X Y: Class) :=
  U ＼ ((U ＼ X) ∩ (U ＼ Y))
theorem UnionClassExists:
  ∀X Y: Class, ∃Z: Class,
    ∀z: Class, ((z ∈ Z) ↔ (z ∈ X) ∨ (z ∈ Y)) := by {
  intro X Y;
  let union := UnionClass_mk' X Y;
  exists union;
  have union_def:
    ∀u: Class, (u ∈ union ↔ (u ∈ U ∧ u ∉ ((U ＼ X) ∩ (U ＼ Y)))) :=
    choose_spec (AxiomDifference U ((U ＼ X) ∩ (U ＼ Y)));
  have inter_def:
    ∀u: Class, (u ∈ ((U ＼ X) ∩ (U ＼ Y)) ↔ (u ∈ (U ＼ X) ∧ u ∈ (U ＼ Y))) :=
    choose_spec (IntersectionClassExists (U ＼ X) (U ＼ Y));
  have diff_x_def:
    ∀u: Class, (u ∈ (U ＼ X) ↔ (u ∈ U ∧ u ∉ X)) :=
    choose_spec (AxiomDifference U X);
  have diff_y_def:
    ∀u: Class, (u ∈ (U ＼ Y) ↔ (u ∈ U ∧ u ∉ Y)) :=
    choose_spec (AxiomDifference U Y);
  sorry;
}
noncomputable def UnionClass_mk (X Y: Class) :=
  choose (UnionClassExists X Y)
noncomputable instance : HasUnion Class where
  Union := UnionClass_mk
noncomputable def UnionClass_def (X Y: Class):
  ∀z: Class, ((z ∈ (X ∪ Y)) ↔ (z ∈ X) ∨ (z ∈ Y)) :=
  choose_spec (UnionClassExists X Y)
theorem UnionClassIntro (X Y: Class) :
  ∀z: Class, (z ∈ (X ∪ Y)) ↔ (z ∈ X) ∨ (z ∈ Y) :=
  UnionClass_def X Y
def isUnionClass {X Y: Class} (I: Class) :=
  ∀z: Class, (z ∈ I) ↔ (z ∈ X) ∨ (z ∈ Y)
class UnionClass {X Y: Class} (I : Class) where
  isUnionClass: (@isUnionClass X Y I)

-- empty class
noncomputable def EmptyClass_mk' : Class :=
  U ＼ U
theorem EmptyClassExists:
  ∃Z: Class, ∀u: Class, (¬ u ∈ Z) := by {
  let emp := EmptyClass_mk';
  exists emp;
  have emp_def: ∀u: Class, (u ∈ emp ↔ (u ∈ U ∧ u ∉ U)) :=
    choose_spec (AxiomDifference U U);
  exact fun z h => ((emp_def z).1 h).2 ((emp_def z).1 h).1
}
noncomputable def EmptyClass_mk : Class :=
  choose EmptyClassExists
notation " ø " => EmptyClass_mk
def EmptyClass_def:
  ∀(z : Class), ¬ z ∈ ø :=
  choose_spec EmptyClassExists

def isEmptyClass (E : Class) : Prop := ∀(z : Class), ¬ z ∈ E
class EmptyClass (E : Class) where
  isEmptyClass: isEmptyClass E

def isNonEmptyClass (X : Class) : Prop := ∃(z : Class), z ∈ X
class NonEmptyClass (X : Class) where
  isNonEmptyClass: isNonEmptyClass X

theorem EmptyClassIsNotNonEmpty {X : Class}:
  isEmptyClass X → ¬ isNonEmptyClass X :=
  fun h1 ⟨z, h2⟩ => (h1 z) h2
theorem NonEmptyClassIsNotEmpty {X : Class}:
  isNonEmptyClass X → ¬ isEmptyClass X :=
  fun ⟨z, h1⟩ h2 => (h2 z) h1

-- -- symmdiff
-- noncomputable def SymmDiffClass_mk' (X Y: Class) :=
--   (X ＼ Y) ∩ (Y ＼ X)
-- theorem SymmDiffClassExists (X Y: Class):
--   ∃Z:Class,
--     ∀z: Class, (z ∈ Z) ↔
--     (z ∈ (X ＼ Y)) ∧ (z ∈ (Y ＼ X)) := by {
--   sorry;
-- }
-- noncomputable def SymmDiffClass_mk (X Y: Class) :=
--   choose (SymmDiffClassExists X Y)
-- noncomputable def SymmDiffClass_def (X Y: Class) :=
--   choose_spec (SymmDiffClassExists X Y)
-- infix:50 " △ " => SymmDiffClass_mk
-- theorem SymmDiffClassIntro (X Y: Class) :
--   ∀z: Class, (z ∈ (X △ Y)) ↔
--     (z ∈ (X ＼ Y)) ∧ (z ∈ (Y ＼ X)) :=
--   SymmDiffClass_def X Y
-- def isSymmDiffClass {X Y: Class} (Z: Class) :=
--   ∀z: Class, (z ∈ Z) ↔ (z ∈ (X ＼ Y) ∧ z ∈ (Y ＼ X))
-- class SymmDiffClass {X Y: Class} (I : Class) where
--   isSymmDiffClass: (@isSymmDiffClass X Y I)

-- empty class property
theorem EmptyHasNoClass : ∀(X : Class), ¬(X ∈ ø) :=
  EmptyClass_def

theorem EmptySetIsUnique :
  isUnique (fun E : Class => ∀(z : Class), ¬ z ∈ E) := by {
  intro E E' hE hE';
  apply (AxiomExtensionality E E').2;
  intro z;
  apply Iff.intro;
  {
    intro h;
    apply False.elim;
    exact (hE z) h;
  }
  {
    intro h;
    apply False.elim;
    exact (hE' z) h;
  }
}


-- ---------------------------------------------------------------------
-- Ejercicio. Importar la teoría de filtros sobre conjuntos.
-- ---------------------------------------------------------------------

import order.filter.basic

-- =====================================================================
-- § La función tendencia (`tendsto`)                                  --
-- =====================================================================

-- Si `X` y `Y` son tipos, `φ : X → Y` es una función, `F : filter X` y
-- `G : filter Y` son filtros, entonces `filter.tendsto φ F G` es una
-- afirmación verdadero-falso, que se pronuncia algo así como "`F`
-- tiende a `G` a lo largo de `φ`". Por supuesto, vamos a usar `open
-- filter` en este archivo, por lo que puede escribir simplemente
-- `tendsto φ F G`, o si te gusta la notación de puntos puedes incluso
-- escribir `F.tendsto φ G`.

-- =====================================================================
-- § Significado geométrico de tendencia (`tendsto`)                  --
-- =====================================================================

-- Empecemos pensando el caso fácil en el que `F` y `G` son en realidad
-- subconjuntos de `X` y `Y` (es decir, filtros principales, asociados a
-- conjuntos que también llamaremos `F` y `G`). En este caso
-- `tendsto φ F G` significa simplemente que "`φ` se restringe a una
-- función de `F` a `G`", o en otras palabras `∀ x ∈ F, φ(x) ∈ G`.
--
-- Hay otras dos formas de escribir este predicado. La primera implica
-- empujar un conjunto hacia adelante mediate una aplicación. Si `F` es
-- un subconjunto de `X` entonces `φ(F)` denota la imagen de `F` bajo
-- `φ`, es decir es decir, el subconjunto `{y : Y | ∃ x : X, φ x = y}`
-- de `Y`. Entonces, `tendsto φ F G` significa simplemente `φ(F) ⊆ G`.
--
-- La segunda implica retroceder un conjunto mediante una aplicación. Si
-- `G` es un subconjunto de `Y` entonces `φ-¹(G)` denota la preimagen de
-- `G` bajo `φ`; es decir, el subconjunto `{x : X | φ x ∈ G}` de
-- `Y`. Entonces `tendsto φ F G` significa simplemente `F ⊆ φ-¹(G)`.
--
-- Así es como funciona todo en el caso de los conjuntos. Lo que tenemos
-- que hacer hacer hoy es averiguar cómo empujar hacia adelante y tirar
-- hacia atrás filtros mediante una aplicación `φ`. Una vez hecho esto,
-- podemos demostrar que `φ(F) ≤ G ↔ F ≤ φ-¹(G)` y utilizar cualquiera
-- de estos como nuestra definición de `tendsto φ F G`, no importa cuál.

-- =====================================================================
-- § Digresión: funtores adjuntos                                     --
-- =====================================================================

-- La siguiente discusión no es necesaria para poder hacer los problemas
-- de esta semana, pero puede proporcionar algunos antecedentes útiles.
-- También hay que tener en cuenta que cualquiera que no le guste la
-- palabra "tipo" puede literalmente cambiarla por la palabra "conjunto"
-- (y cambiar "término de tipo" por "elemento del conjunto"), que es
-- como los argumentos de esta clase aparecen en la literatura
-- matemática tradicional.
--
-- Los tipos parcialmente ordenados, como el tipo de subconjuntos de un
-- tipo fijo tipo `X` o el tipo de los filtros en `X`, son en realidad
-- ejemplos de categorías. En general, si "P" es un tipo parcialmente
-- ordenado y `x, y` son términos del tipo `P`, la idea es que podemos
-- definir que `Hom(x,y)` tiene un elemento si `x ≤ y` es verdadero y
-- ningún elemento si "x ≤ y" es falso. Los axiomas de una categoría son
-- que `Hom(x,x)` tiene un elemento identidad, lo que se deduce de la
-- reflexividad de `≤`, y que se pueden componer morfismos, lo que se
-- deduce de la transitividad de `≤`. La antisimetría establece que si
-- dos objetos son isomorfos (es decir, en este caso, si `Hom(x,y)` y
-- `Hom(y,x)` son ambos no vacíos), entonces son iguales. Si `φ : X → Y`
-- es una aplicación de tipos, entonces las imágenes y contraimágenes
-- son ambos funtores del `set X` al `set Y`, porque `S ⊆ T → φ(S) ⊆
-- φ(T)` y `U ⊆ V → φ-¹(U) ⊆ φ-¹(V)`. La afirmación de que `φ(S) ≤ U ↔ S
-- ≤ φ-¹(U)` es simplemente la afirmación de que estos funtores son
-- adjuntos entre sí. Hoy definiremos progrediente y regrediente para
-- filtros, y mostraremos que también son un par de funtores adjuntos,
-- pero no utilizaremos este lenguaje. De hecho, existe un lenguaje
-- especial para los funtores adjuntos en esta sencilla situación:
-- diremos que pushforward y pullback forman una conexión de Galois.

-- =====================================================================
-- § Aplicaciones progredientes y regredientes                        --
-- =====================================================================

-- ---------------------------------------------------------------------
-- Ejercicio. Declara las variables
-- + X, Y sobre tipos
-- + f sobre funciones de X en Y.
-- ---------------------------------------------------------------------

variables (X Y : Type)
variable  (f : X → Y)

-- =====================================================================
-- §§ Imágenes directas de conjuntos                                  --
-- =====================================================================

-- En Lean, la imagen `f(S)` de un subconjunto `S : set X` no puede
-- denotarse por `f S`, porque `f` espera un elemento de `X` como
-- argumento, no un subconjunto de `X`, por lo que necesitamos
-- una nueva notación.
--
-- Notación : `f '' S` es la imagen de `S` bajo `f`. Vamos a
-- comprobarlo.

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    f '' S = {y : Y | ∃ x : X, x ∈ S ∧ f x = y}
-- ---------------------------------------------------------------------

example
  (S : set X)
  : f '' S = {y : Y | ∃ x : X, x ∈ S ∧ f x = y} :=
begin
  refl
end

-- =====================================================================
-- § Imágenes inversas de conjuntos                                   --
-- =====================================================================

-- En Lean, la imagen invers `f-¹(T)` de un subconjunto `T : set Y` no
-- puede denotarse como `f-¹ T` porque `-¹` es la notación para la
-- inversa de f que es una función de `Y` a `X`, no una función sobre
-- subconjuntos de `Y`.
--
-- Notación : `f -¹' T` es la imagen inversa de `T` bajo `f`.
--
-- Se escribe `\-1'` para `-¹'`

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    f ⁻¹' T = {x : X | f x ∈ T}
-- ---------------------------------------------------------------------

example
  (T : set Y)
  : f ⁻¹' T = {x : X | f x ∈ T} :=
begin
  refl
end

-- ---------------------------------------------------------------------
-- Ejercicio. Abrir el espacio de nombre de conjuntos.
-- ---------------------------------------------------------------------

open set

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que las siguientes condiciones son
-- equivalentes:
-- 1) `f '' S ⊆ T`
-- 2) `S ⊆ f-¹' T`
--
-- Para demostrarlo, es útil el lema
--    mem_preimage : a ∈ f -¹' s ↔ f a ∈ s`
-- ---------------------------------------------------------------------

-- 1ª demostración
example
  (S : set X)
  (T : set Y)
  : f '' S ⊆ T ↔ S ⊆ f⁻¹' T :=
begin
  split,
  { intros h x hxS,
    rw subset_def at h,
    rw mem_preimage,
    apply h,
    rw mem_image,
    use [x, hxS, rfl] },
  { intros h y hxy,
    rw mem_image at hxy,
    rcases hxy with ⟨x, xS, fxy⟩,
    rw ← fxy,
    specialize h xS,
    rw mem_preimage at h,
    exact h, }
end

-- 2ª demostración
example
  (S : set X)
  (T : set Y)
  : f '' S ⊆ T ↔ S ⊆ f⁻¹' T :=
begin
  split,
  { intros h x hxS,
    apply h,
    use [x, hxS, rfl] },
  { rintros h - ⟨x, hxS, rfl⟩,
    exact h hxS }
end

-- 3ª demostración
example
  (S : set X)
  (T : set Y)
  : f '' S ⊆ T ↔ S ⊆ f⁻¹' T :=
-- by library_search
image_subset_iff

-- =====================================================================
-- § Filtros progredientes                                            --
-- =====================================================================

-- La imagen directa es fácil, así que vamos a hacer eso primero.  Se
-- llama `filter.map` en Lean.
--
-- Definimos el filtro progrediente `map f F` en `Y` como sigue:
-- un subconjunto de `Y` está en `map f F` si `f-¹(Y)`
-- está en `F`.
--
-- Vamos a probar que `map f F` es un filtro. Para ello, serán útiles
-- los siguientes lemas:
-- + mem_set_of_eq {α : Type u} {a : α} {p : α → Prop} :
--      a ∈ {x : α | p x} = p a
-- + univ_mem_sets {α : Type u} {f : filter α} :
--      univ ∈ f
-- + mem_sets_of_superset {α : Type u} {f : filter α} {x y : set α} :
--      x ∈ f → x ⊆ y → y ∈ f
-- + inter_mem_sets {α : Type u} {f : filter α} {s t : set α} :
--      s ∈ f → t ∈ f → s ∩ t ∈ f

-- ---------------------------------------------------------------------
-- Ejercicio. Abrir el espacio de nombre de los filtros.
-- ---------------------------------------------------------------------

open filter

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que `map f F` es un filtro.
-- ---------------------------------------------------------------------

-- Demostración. Por definición, `map f F` es
--    G = {T : set Y | f ⁻¹' T ∈ F}
-- Tenemos que demostrar que G es un filtro comprobando que cumple los
-- axiomas.
--
-- (1º axioma: univ_sets). Tenemos que
--    f ⁻¹' univ
--    = univ       [por preimage_univ]
--    ∈ F          [porque F es un filtro]
-- Por tanto, univ ∈ G.
--
-- (2º axioma: sets_of_superset). Sean S y T tales que S ∈ G y S ⊆ T. Se
-- tiene, f ⁻¹' S ∈ F (porque S ∈ G). Veamos que f ⁻¹' S ⊆ f ⁻¹' T. Para
-- ello, sea x ∈ f ⁻¹' S.  Entonces,
--     x ∈ f ⁻¹' S
--     ⟹ f x ∈ S        [por def. de f ⁻¹']
--     ⟹ f x ∈ T        [porque S ⊆ T]
--     ⟹ x ∈ f ⁻¹' T    [por def. de f ⁻¹']
-- Por tanto, f ⁻¹' S ⊆ f ⁻¹' T y, como f ⁻¹' S ∈ F, se tiene que
-- f ⁻¹' T ∈ F (porque F es un filtro). Luego. T ∈ G.
--
-- (3º axioma: inter_sets). Sean S, T in G. Entonces,
--    f ⁻¹' S ∈ F ∧ f ⁻¹' T ∈ F   [por def. de G]
--    ⟹ f ⁻¹' S ∩ f ⁻¹' T ∈ F   [porque F es un filtro]
--    ⟹ f ⁻¹' (S ∩ T) ∈ F       [por preimage_inter]
--    ⟹ S ∩ T ∈ G               [por def. de G]

example (F : filter X) : filter Y :=
{ sets := {T : set Y | f ⁻¹' T ∈ F},
  univ_sets :=
  begin
    rw mem_set_of_eq,
    exact univ_mem_sets,
  end,
  sets_of_superset :=
  begin
    intros S T hS hST,
    rw mem_set_of_eq at *,
    refine mem_sets_of_superset hS _,
    intros x hx,
    rw mem_preimage at *,
    exact hST hx,
  end,
  inter_sets :=
  begin
    intros S T hS hT,
    rw mem_set_of_eq at *,
    rw preimage_inter,
    exact inter_mem_sets hS hT,
  end, }

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    T ∈ map f F ↔ f ⁻¹' T ∈ F
-- También se puede escribir como
--    T ∈ F.map f ↔ f ⁻¹' T ∈ F
-- ---------------------------------------------------------------------

example
  (F : filter X)
  (T : set Y)
  : T ∈ map f F ↔ f ⁻¹' T ∈ F :=
begin
  refl
end

-- Vamos a demostrar que map cumple las propiedades de los functores.
--
-- Para comprobar que dos filtros son iguales, se puede utilizar la
-- táctica `ext`.

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    map id F = F
-- ---------------------------------------------------------------------

-- Demostración. Sea S ∈ X. Tenemos que demostrar que
--    S ∈ map id F ↔ S ∈ F
-- Su prueba es
--    S ∈ map id F
--    ↔ {x : X | id x ∈ S} ∈ F     [por def. de map]
--    ↔ {x : X | x ∈ S} ∈ F        [por def. de id]
--    ↔ S ∈ F                      [por def. de id]

-- 1ª demostración
example
  (F : filter X)
  : map id F = F :=
begin
  ext S,
  rw filter.mem_map,
  calc S ∈ map id F
       ↔ {x : X | id x ∈ S} ∈ F : by rw filter.mem_map
  ...  ↔ {x : X | x ∈ S} ∈ F    : by unfold id
  ...  ↔ S ∈ F                  : by refl,
end

-- 2ª demostración
example
  (F : filter X)
  : map id F = F :=
begin
  ext S,
  rw filter.mem_map,
  unfold id,
  change S ∈ F ↔ S ∈ F,
  exact iff.rfl,
end

-- 3ª demostración
example
  (F : filter X)
  : F.map id = F :=
begin
  ext S,
  refl,
end

-- 4ª demostración
example
  (F : filter X)
  : F.map id = F :=
-- by library_search
map_id

-- 5ª demostración
example
  (F : filter X)
  : map id F = F :=
begin
  apply filter_eq,
  refl,
end

-- 6ª demostración
example
  (F : filter X)
  : map id F = F :=
by simp

-- ---------------------------------------------------------------------
-- Ejercicio. Declarar las siguientes variables:
-- + Z sobre tipos.
-- + g sobre funciones de Y en Z.
-- ---------------------------------------------------------------------

variable (Z : Type)
variable (g : Y → Z)

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    map (g ∘ f) F = map g (map f F)
-- ---------------------------------------------------------------------

-- Demostración. Tenemos que probar que, para todo S : set Z,
--    S ∈ map (g ∘ f) F ↔ S ∈ map g (map f F)
-- Lo haremos por doble implicación.
--
-- (⟹) Supongamos que S ∈ map (g ∘ f) F. Entonces, existe un T ∈ F tal
-- que (g ∘ f)[T] ⊆ S. Luego f[T] ∈ map f F y g[f[T] ] ⊆ S. Por tanto,
-- S ∈ map g (map f F).
--
-- (⟸) Supongamos que S ∈ map g (map f F). Entonces, existe un T ∈ map f F
-- tal que g[T] ⊆ S. Luego, existe un U ∈ F tal que f[U] ⊆ T. Por tanto,
--    (g ∘ f)[U]
--    = g[f[U]]
--    ⊆ g[T]       [porque f[U] ⊆ T]
--    ⊆ S
-- Por tanto, S ∈ map (g ∘ f) F.

-- 1ª demostración
example
  (F : filter X)
  : map (g ∘ f) F = map g (map f F) :=
begin
  ext S,
  split,
  { intro h,
    rw mem_map_sets_iff at *,
    rcases h with ⟨T, hTF, gfT⟩,
    use f '' T,
    split,
    { rw mem_map_sets_iff,
      use T,
      exact ⟨hTF, rfl.subset⟩, },
    { rw ← image_comp,
      exact gfT, }},
  { intro h,
    rw mem_map_sets_iff at *,
    rcases h with ⟨T, hTF, gfT⟩,
    rw mem_map_sets_iff at hTF,
    rcases hTF with ⟨U, hUF, fU⟩,
    use U,
    split,
    { exact hUF, },
    { rw image_comp,
      calc  g '' (f '' U)
          ⊆ g '' T        : image_subset g fU
      ... ⊆ S             : gfT } },
end

-- 2ª demostración
example
  (F : filter X) :
  map (g ∘ f) F = map g (map f F) :=
begin
  ext S,
  refl,
end

-- 3ª demostración
example
  (F : filter X) :
  map (g ∘ f) F = map g (map f F) :=
-- by library_search
map_map.symm

-- 4ª demostración
example
  (F : filter X) :
  map (g ∘ f) F = map g (map f F) :=
by simp

-- ---------------------------------------------------------------------
-- Ejercicio. Abrir localmente el entorno de filtros (para usar 𝓟).
-- ---------------------------------------------------------------------

open_locale filter

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    map f (𝓟 S) = 𝓟 (f '' S)
-- ---------------------------------------------------------------------

-- Demostración. Tenemos que demostrar que para todo T ⊆ Y,
--    T ∈ map f (𝓟 S) ↔ T ∈ 𝓟 (f '' S)
-- que es equivalente a
--    {x : X | f x ∈ T} ∈ 𝓟 S ↔ T ∈ 𝓟 (f '' S)
-- que es equivalente a
--    S ⊆ {x : X | f x ∈ T} ↔ f '' S ⊆ T
-- Lo demostraremos por doble inmplicación.
--
-- (⟹) Supongamos que
--    S ⊆ {x : X | f x ∈ T},                                         (1)
-- y sea x ∈ S. Tenemos que probar que f x ∈ T, que se tiene por (1).
--
-- (⟸) Supongamos que
--    f '' S ⊆ T                                                     (2)
-- y sea x ∈ S. Tenemos que demostrar que x ∈ {x : X | f x ∈ T}, que se
-- tiene por (2).

-- 1ª demostración
example
  (S : set X)
  : map f (𝓟 S) = 𝓟 (f '' S) :=
begin
  ext T,
  rw mem_map,
  rw mem_principal_sets,
  rw mem_principal_sets,
  split,
  { rintro h y ⟨x, hx, rfl⟩,
    exact h hx },
  { rintro h x hx,
    apply h,
    exact ⟨x, hx, rfl⟩ }
end

-- 2ª demostración
example
  (S : set X)
  : map f (𝓟 S) = 𝓟 (f '' S) :=
-- by library_search
map_principal

-- =====================================================================
-- § Tendencia ("tendsto")                                            --
-- =====================================================================

-- La definición: si `f : X → Y` y `F : filter X` y `G : filter Y`
-- entonces `tendsto f F G : Prop := map f F ≤ G`. Esto es una
-- definición (tiene tiene el tipo `Prop`), no la demostración de un
-- teorema. Es un enunciado con argumentos `f`, `F` y `G`. Es un poco
-- como decir "f es continua en x" o algo así, que puede ser verdadero o
-- puede ser falso.
--
-- Se puede leer `tendsto f F G` como `f` es una tendencia de `F` en `F`
-- (como se lee f es una función continua de F en G).

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    tendsto f F G ↔ ∀ T, T ∈ G → f ⁻¹' T ∈ F
-- ---------------------------------------------------------------------

-- 1ª demostración
example
  (F : filter X)
  (G : filter Y)
  : tendsto f F G ↔ ∀ T, T ∈ G → f ⁻¹' T ∈ F :=
begin
  refl
end

-- 2ª demostración
example
  (F : filter X)
  (G : filter Y)
  : tendsto f F G ↔ ∀ T, T ∈ G → f ⁻¹' T ∈ F :=
-- by library_search
tendsto_def

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    tendsto id F F
-- ---------------------------------------------------------------------

-- Demostración. Por la definición de tendsof, hay que demostrar que
--    ∀ T, T ∈ F → id ⁻¹' T ∈ F
-- Sea T ∈ F. Entonces, id ⁻¹' T = T ∈ F

-- 1ª demostración
example
  (F : filter X)
  : tendsto id F F :=
begin
  change ∀ T, T ∈ F → id ⁻¹' T ∈ F,
  intros T h,
  rw preimage_id,
  exact h,
end

-- 2ª demostración
example
  (F : filter X)
  : tendsto id F F :=
begin
  intro S,
  exact id,
end

-- 3ª demostración
example
  (F : filter X)
  : tendsto id F F :=
-- by library_search
tendsto_id

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si `tendsto f F G` y `tendsto g G H),
-- entonces `tendsto (g ∘ f) F H`.
-- ---------------------------------------------------------------------

--- Demostración. Por la definición de tendsto, las hipótesis son
--     ∀ (s : set Y), s ∈ G → f ⁻¹' s ∈ F                         (1)
--     ∀ (s : set Z), s ∈ H → g ⁻¹' s ∈ G                         (2)
-- y la conclusión es
--     ∀ (s : set Z), s ∈ H → g ∘ f ⁻¹' s ∈ F
-- Para demostrarla, sea S : set Z tal que S ∈ H. Por (2), g ⁻¹' S ∈ G y
-- por (1), f ⁻¹' (g ⁻¹' S) ∈ F. Por tanto, g ∘ f ⁻¹' S ∈ F.

-- 1ª demostración
example
  (F : filter X)
  (G : filter Y)
  (H : filter Z)
  (f : X → Y)
  (g : Y → Z)
  (hf : tendsto f F G)
  (hg : tendsto g G H)
  : tendsto (g ∘ f) F H :=
begin
  rw tendsto_def at *,
  rintro S hS,
  specialize hg _ hS,
  specialize hf _ hg,
  rw preimage_comp,
  exact hf,
end

-- 2ª demostración
example
  (F : filter X)
  (G : filter Y)
  (H : filter Z)
  (f : X → Y)
  (g : Y → Z)
  (hf : tendsto f F G)
  (hg : tendsto g G H)
  : tendsto (g ∘ f) F H :=
begin
  rintro S hS,
  specialize hg hS,
  specialize hf hg,
  exact hf,
end

-- 3ª demostración
example
  (F : filter X)
  (G : filter Y)
  (H : filter Z)
  (f : X → Y)
  (g : Y → Z)
  (hf : tendsto f F G)
  (hg : tendsto g G H)
  : tendsto (g ∘ f) F H :=
-- by library_search
tendsto.comp hg hf

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    tendsto (g ∘ f) F G ↔ tendsto g (map f F) G
-- ---------------------------------------------------------------------

-- 1ª demostración
example
  (g : Y → Z)
  (F : filter X)
  (G : filter Z)
  : tendsto (g ∘ f) F G ↔ tendsto g (map f F) G :=
begin
  rw tendsto_def,
  rw tendsto_def,
  split,
  { intros h S hS,
    rw mem_map,
    specialize h S hS,
    have h1 : {x : X | f x ∈ g ⁻¹' S} = g ∘ f ⁻¹' S,
    { ext y,
      split,
      { assume h1,
        rw mem_set_of_eq at h1,
        rw mem_preimage at *,
        unfold function.comp,
        exact h1, },
      { intro h1,
        rw mem_set_of_eq,
        rw mem_preimage at *,
        unfold function.comp at h1,
        exact h1, }},
    rw h1,
    exact h, },
  { intros h S hS,
    specialize h S hS,
    rw mem_map at h,
    have h1 : {x : X | f x ∈ g ⁻¹' S} = g ∘ f ⁻¹' S,
    { refl },
    { rw ← h1,
      exact h, } },
end

-- 2ª demostración
example
  (g : Y → Z)
  (F : filter X)
  (G : filter Z)
  : tendsto (g ∘ f) F G ↔ tendsto g (map f F) G :=
begin
  refl,
end

-- 3ª demostración
lemma tendsto_comp_map
  (g : Y → Z)
  (F : filter X)
  (G : filter Z)
  : tendsto (g ∘ f) F G ↔ tendsto g (map f F) G :=
-- library_search
tendsto_map'_iff.symm

-- =====================================================================
-- § Filtros regredientes                                             --
-- =====================================================================

-- No usaremos esto en la siguiente parte.
--
-- Sea `f : X → Y` y `G : filter Y`, y queremos un filtro sobre
-- `X`. Hagamos una definición ingenua. Queremos una colección de
-- subconjuntos de `X` correspondiente al filtro obtenido al retirar `G`
-- a lo largo de `f`. ¿Cuándo debe estar `S : set X` en este filtro?
-- Quizás sea cuando `f '' S ∈ G`. Sin embargo, no hay ninguna razón que
-- la colección de `S` que satisface esta propiedad sea un filtro en
-- `X`. Por ejemplo, no hay razón para esperar que `f '' univ ∈ G` si
-- `f` no es suryectiva.
--
-- Aquí hay una forma de arreglar esto. Recordemos que nuestro modelo de
-- filtro `G` es una especie de tipo de noción generalizada de
-- conjunto. Si `T : set Y` entonces `T ∈ G` se supone que significa que
-- el "conjunto" `G` es un subconjunto de `T`. Así que esto debería
-- implicar que `f-¹(G) ⊆ f-¹(T)`. En particular, si `T ∈ G` y `f-¹(T) ⊆
-- S` entonces esto debería significar que `f-¹(G) ⊆ S` y por tanto `S ∈
-- f-¹(G)`. Probemos esto y veamos si funciona.
--
-- Lemas útiles (puede que estés llegando al punto en que puedas
-- adivinar los nombres de los lemas):
-- + `subset_univ S : S ⊆ univ`
-- + `subset.trans : A ⊆ B → B ⊆ C → A ⊆ C`

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si G es un filtro de Y, entonces
--    {S : set X | ∃ T ∈ G, f ⁻¹' T ⊆ S}
-- es un filtro de X (llamado comap)
-- ---------------------------------------------------------------------

example (G : filter Y) : filter X :=
{ sets := {S : set X | ∃ T ∈ G, f ⁻¹' T ⊆ S},
  univ_sets :=
  begin
    use univ,
    split,
    { exact univ_mem_sets },
    { exact subset_univ _ }
  end,
  sets_of_superset :=
  begin
    rintros S T ⟨U, hUG, hUS⟩ hST,
    use [U, hUG],
    exact subset.trans hUS hST
  end,
  inter_sets :=
  begin
    rintro S T ⟨U, hUG, hUS⟩ ⟨V, hVG, hVT⟩,
    use [U ∩ V, inter_mem_sets hUG hVG],
    rintro x ⟨hxU, hxV⟩,
    exact ⟨hUS hxU, hVT hxV⟩,
  end }

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    S ∈ comap f G ↔ ∃ T ∈ G, f ⁻¹' T ⊆ S
-- ---------------------------------------------------------------------

lemma mem_comap
  (f : X → Y)
  (G : filter Y)
  (S : set X)
  : S ∈ comap f G ↔ ∃ T ∈ G, f ⁻¹' T ⊆ S :=
begin
  refl
end

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    comap id G = G
-- ---------------------------------------------------------------------

-- 1ª demostración
example
  (G : filter Y)
  : comap id G = G :=
begin
  ext S,
  rw mem_comap,
  split,
  { rintro ⟨T, hT, h⟩,
    exact mem_sets_of_superset hT h,},
  { intro hS,
    use [S, hS],
    refl },
end

-- 2ª demostración
example
  (G : filter Y)
  : comap id G = G :=
-- by library_search
comap_id

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    comap (g ∘ f) H = comap f (comap g H)
-- ---------------------------------------------------------------------

-- 1ª demostración
example
  (H : filter Z)
  : comap (g ∘ f) H = comap f (comap g H) :=
begin
  ext S,
  simp only [mem_comap],
  split,
  { rintro ⟨U, hU, h⟩,
    use g ⁻¹' U,
    refine ⟨_, h⟩,
    rw mem_comap,
    use [U, hU] },
  { rintro ⟨T, ⟨U, hU, h2⟩, h⟩,
    use [U, hU],
    refine subset.trans _ h,
    intros x hx,
    exact h2 hx }
end

lemma comap_comp
  (H : filter Z)
  : comap (g ∘ f) H = comap f (comap g H) :=
-- by library_search
comap_comap.symm

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    comap f (𝓟 T) = 𝓟 (f ⁻¹' T)
-- ---------------------------------------------------------------------

-- 1ª demostrción
example
  (T : set Y)
  : comap f (𝓟 T) = 𝓟 (f ⁻¹' T) :=
begin
  ext S,
  rw mem_comap,
  rw mem_principal_sets,
  split,
  { rintro ⟨U, hU, h⟩,
    refine subset.trans (λ x, _) h,
    apply hU },
  { intro h,
    exact ⟨T, mem_principal_self T, h⟩ }
end

-- 2ª demostración
example
  (T : set Y)
  : comap f (𝓟 T) = 𝓟 (f ⁻¹' T) :=
-- by library_search
comap_principal

-- En el siguiente ejercicio se prueba que `map f` y `comap f` son
-- funtores adjuntos o, en otras palabras, forman una conexión de
-- Galois. Es análoga a la afirmación de que si S es un subconjunto de X
-- y T es un subconjunto de Y entonces f(S) ⊆ T ↔ S ⊆ f-¹(T), siendo
-- ambas formas de decir que `f` restringe a una función de `S` a `T`.

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    map f F ≤ G ↔ F ≤ comap f G
-- ---------------------------------------------------------------------

lemma filter.galois_connection
  (F : filter X)
  (G : filter Y)
  : map f F ≤ G ↔ F ≤ comap f G :=
begin
  split,
  { rintro h S ⟨T, hT, hTS⟩,
    rw le_def at h,
    exact mem_sets_of_superset (h T hT) hTS },
  { rintro h T hT,
    rw le_def at h,
    exact h (f ⁻¹' T) ⟨T, hT, subset.refl _⟩ },
end

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que `map f` and `comap f` forman una conexión de
-- Galois.
-- ---------------------------------------------------------------------

example : galois_connection (map f) (comap f) :=
filter.galois_connection X Y f