/-
Copyright (c) 2019 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov, Sébastien Gouëzel, Rémy Degenne
-/
import analysis.convex.specific_functions
import data.real.conjugate_exponents

/-!
# Mean value inequalities

In this file we prove several inequalities for finite sums, including AM-GM inequality,
Young's inequality, Hölder inequality, and Minkowski inequality. Versions for integrals of some of
these inequalities are available in `measure_theory.mean_inequalities`.

## Main theorems

### AM-GM inequality:

The inequality says that the geometric mean of a tuple of non-negative numbers is less than or equal
to their arithmetic mean. We prove the weighted version of this inequality: if $w$ and $z$
are two non-negative vectors and $\sum_{i\in s} w_i=1$, then
$$
\prod_{i\in s} z_i^{w_i} ≤ \sum_{i\in s} w_iz_i.
$$
The classical version is a special case of this inequality for $w_i=\frac{1}{n}$.

We prove a few versions of this inequality. Each of the following lemmas comes in two versions:
a version for real-valued non-negative functions is in the `real` namespace, and a version for
`nnreal`-valued functions is in the `nnreal` namespace.

- `geom_mean_le_arith_mean_weighted` : weighted version for functions on `finset`s;
- `geom_mean_le_arith_mean2_weighted` : weighted version for two numbers;
- `geom_mean_le_arith_mean3_weighted` : weighted version for three numbers;
- `geom_mean_le_arith_mean4_weighted` : weighted version for four numbers.

### Young's inequality

Young's inequality says that for non-negative numbers `a`, `b`, `p`, `q` such that
$\frac{1}{p}+\frac{1}{q}=1$ we have
$$
ab ≤ \frac{a^p}{p} + \frac{b^q}{q}.
$$

This inequality is a special case of the AM-GM inequality. It is then used to prove Hölder's
inequality (see below).

### Hölder's inequality

The inequality says that for two conjugate exponents `p` and `q` (i.e., for two positive numbers
such that $\frac{1}{p}+\frac{1}{q}=1$) and any two non-negative vectors their inner product is
less than or equal to the product of the $L_p$ norm of the first vector and the $L_q$ norm of the
second vector:
$$
\sum_{i\in s} a_ib_i ≤ \sqrt[p]{\sum_{i\in s} a_i^p}\sqrt[q]{\sum_{i\in s} b_i^q}.
$$

We give versions of this result in `ℝ`, `ℝ≥0` and `ℝ≥0∞`.

There are at least two short proofs of this inequality. In our proof we prenormalize both vectors,
then apply Young's inequality to each $a_ib_i$. Another possible proof would be to deduce this
inequality from the generalized mean inequality for well-chosen vectors and weights.

### Minkowski's inequality

The inequality says that for `p ≥ 1` the function
$$
\|a\|_p=\sqrt[p]{\sum_{i\in s} a_i^p}
$$
satisfies the triangle inequality $\|a+b\|_p\le \|a\|_p+\|b\|_p$.

We give versions of this result in `real`, `ℝ≥0` and `ℝ≥0∞`.

We deduce this inequality from Hölder's inequality. Namely, Hölder inequality implies that $\|a\|_p$
is the maximum of the inner product $\sum_{i\in s}a_ib_i$ over `b` such that $\|b\|_q\le 1$. Now
Minkowski's inequality follows from the fact that the maximum value of the sum of two functions is
less than or equal to the sum of the maximum values of the summands.

## TODO

- each inequality `A ≤ B` should come with a theorem `A = B ↔ _`; one of the ways to prove them
  is to define `strict_convex_on` functions.
- generalized mean inequality with any `p ≤ q`, including negative numbers;
- prove that the power mean tends to the geometric mean as the exponent tends to zero.

-/

universes u v

open finset
open_locale classical big_operators nnreal ennreal
noncomputable theory

variables {ι : Type u} (s : finset ι)

section geom_mean_le_arith_mean

/-! ### AM-GM inequality -/

namespace real

/-- AM-GM inequality: the **geometric mean is less than or equal to the arithmetic mean**, weighted
version for real-valued nonnegative functions. -/
theorem geom_mean_le_arith_mean_weighted (w z : ι → ℝ) (hw : ∀ i ∈ s, 0 ≤ w i)
  (hw' : ∑ i in s, w i = 1) (hz : ∀ i ∈ s, 0 ≤ z i) :
  (∏ i in s, (z i) ^ (w i)) ≤ ∑ i in s, w i * z i :=
begin
  -- If some number `z i` equals zero and has non-zero weight, then LHS is 0 and RHS is nonnegative.
  by_cases A : ∃ i ∈ s, z i = 0 ∧ w i ≠ 0,
  { rcases A with ⟨i, his, hzi, hwi⟩,
    rw [prod_eq_zero his],
    { exact sum_nonneg (λ j hj, mul_nonneg (hw j hj) (hz j hj)) },
    { rw hzi, exact zero_rpow hwi } },
  -- If all numbers `z i` with non-zero weight are positive, then we apply Jensen's inequality
  -- for `exp` and numbers `log (z i)` with weights `w i`.
  { simp only [not_exists, not_and, ne.def, not_not] at A,
    have := convex_on_exp.map_sum_le hw hw' (λ i _, set.mem_univ $ log (z i)),
    simp only [exp_sum, (∘), smul_eq_mul, mul_comm (w _) (log _)] at this,
    convert this using 1; [apply prod_congr rfl, apply sum_congr rfl]; intros i hi,
    { cases eq_or_lt_of_le (hz i hi) with hz hz,
      { simp [A i hi hz.symm] },
      { exact rpow_def_of_pos hz _ } },
    { cases eq_or_lt_of_le (hz i hi) with hz hz,
      { simp [A i hi hz.symm] },
      { rw [exp_log hz] } } }
end

theorem geom_mean_weighted_of_constant (w z : ι → ℝ) (x : ℝ) (hw : ∀ i ∈ s, 0 ≤ w i)
  (hw' : ∑ i in s, w i = 1) (hz : ∀ i ∈ s, 0 ≤ z i) (hx : ∀ i ∈ s, w i ≠ 0 → z i = x) :
  (∏ i in s, (z i) ^ (w i)) = x :=
calc (∏ i in s, (z i) ^ (w i)) = ∏ i in s, x ^ w i :
  begin
    refine prod_congr rfl (λ i hi, _),
    cases eq_or_ne (w i) 0 with h₀ h₀,
    { rw [h₀, rpow_zero, rpow_zero] },
    { rw hx i hi h₀ }
  end
... = x :
  begin
    rw [← rpow_sum_of_nonneg _ hw, hw', rpow_one],
    have : (∑ i in s, w i) ≠ 0,
    { rw hw', exact one_ne_zero },
    obtain ⟨i, his, hi⟩ := exists_ne_zero_of_sum_ne_zero this,
    rw ← hx i his hi,
    exact hz i his
  end

theorem geom_mean_eq_arith_mean_weighted_of_constant (w z : ι → ℝ) (x : ℝ) (hw : ∀ i ∈ s, 0 ≤ w i)
  (hw' : ∑ i in s, w i = 1) (hz : ∀ i ∈ s, 0 ≤ z i) (hx : ∀ i ∈ s, w i ≠ 0 → z i = x) :
  (∏ i in s, (z i) ^ (w i)) = ∑ i in s, w i * z i :=
by rw [geom_mean_weighted_of_constant, arith_mean_weighted_of_constant]; assumption

end real

namespace nnreal

/-- The geometric mean is less than or equal to the arithmetic mean, weighted version
for `nnreal`-valued functions. -/
theorem geom_mean_le_arith_mean_weighted (w z : ι → ℝ≥0) (hw' : ∑ i in s, w i = 1) :
  (∏ i in s, (z i) ^ (w i:ℝ)) ≤ ∑ i in s, w i * z i :=
by exact_mod_cast real.geom_mean_le_arith_mean_weighted _ _ _ (λ i _, (w i).coe_nonneg)
  (by assumption_mod_cast) (λ i _, (z i).coe_nonneg)

/-- The geometric mean is less than or equal to the arithmetic mean, weighted version
for two `nnreal` numbers. -/
theorem geom_mean_le_arith_mean2_weighted (w₁ w₂ p₁ p₂ : ℝ≥0) :
  w₁ + w₂ = 1 → p₁ ^ (w₁:ℝ) * p₂ ^ (w₂:ℝ) ≤ w₁ * p₁ + w₂ * p₂ :=
by simpa only [fin.prod_univ_succ, fin.sum_univ_succ, finset.prod_empty, finset.sum_empty,
  fintype.univ_of_is_empty, fin.cons_succ, fin.cons_zero, add_zero, mul_one]
using geom_mean_le_arith_mean_weighted univ ![w₁, w₂] ![p₁, p₂]

theorem geom_mean_le_arith_mean3_weighted (w₁ w₂ w₃ p₁ p₂ p₃ : ℝ≥0) :
  w₁ + w₂ + w₃ = 1 → p₁ ^ (w₁:ℝ) * p₂ ^ (w₂:ℝ) * p₃ ^ (w₃:ℝ) ≤ w₁ * p₁ + w₂ * p₂ + w₃ * p₃ :=
by simpa only  [fin.prod_univ_succ, fin.sum_univ_succ, finset.prod_empty, finset.sum_empty,
  fintype.univ_of_is_empty, fin.cons_succ, fin.cons_zero, add_zero, mul_one, ← add_assoc, mul_assoc]
using geom_mean_le_arith_mean_weighted univ ![w₁, w₂, w₃] ![p₁, p₂, p₃]

theorem geom_mean_le_arith_mean4_weighted (w₁ w₂ w₃ w₄ p₁ p₂ p₃ p₄ : ℝ≥0) :
  w₁ + w₂ + w₃ + w₄ = 1 → p₁ ^ (w₁:ℝ) * p₂ ^ (w₂:ℝ) * p₃ ^ (w₃:ℝ)* p₄ ^ (w₄:ℝ) ≤
    w₁ * p₁ + w₂ * p₂ + w₃ * p₃ + w₄ * p₄ :=
by simpa only  [fin.prod_univ_succ, fin.sum_univ_succ, finset.prod_empty, finset.sum_empty,
  fintype.univ_of_is_empty, fin.cons_succ, fin.cons_zero, add_zero, mul_one, ← add_assoc, mul_assoc]
using geom_mean_le_arith_mean_weighted univ ![w₁, w₂, w₃, w₄] ![p₁, p₂, p₃, p₄]

end nnreal

namespace real

theorem geom_mean_le_arith_mean2_weighted {w₁ w₂ p₁ p₂ : ℝ} (hw₁ : 0 ≤ w₁) (hw₂ : 0 ≤ w₂)
  (hp₁ : 0 ≤ p₁) (hp₂ : 0 ≤ p₂) (hw : w₁ + w₂ = 1) :
  p₁ ^ w₁ * p₂ ^ w₂ ≤ w₁ * p₁ + w₂ * p₂ :=
nnreal.geom_mean_le_arith_mean2_weighted ⟨w₁, hw₁⟩ ⟨w₂, hw₂⟩ ⟨p₁, hp₁⟩ ⟨p₂, hp₂⟩ $
  nnreal.coe_eq.1 $ by assumption

theorem geom_mean_le_arith_mean3_weighted {w₁ w₂ w₃ p₁ p₂ p₃ : ℝ} (hw₁ : 0 ≤ w₁) (hw₂ : 0 ≤ w₂)
  (hw₃ : 0 ≤ w₃) (hp₁ : 0 ≤ p₁) (hp₂ : 0 ≤ p₂) (hp₃ : 0 ≤ p₃) (hw : w₁ + w₂ + w₃ = 1) :
  p₁ ^ w₁ * p₂ ^ w₂ * p₃ ^ w₃ ≤ w₁ * p₁ + w₂ * p₂ + w₃ * p₃ :=
nnreal.geom_mean_le_arith_mean3_weighted
  ⟨w₁, hw₁⟩ ⟨w₂, hw₂⟩ ⟨w₃, hw₃⟩ ⟨p₁, hp₁⟩ ⟨p₂, hp₂⟩ ⟨p₃, hp₃⟩ $ nnreal.coe_eq.1 hw

theorem geom_mean_le_arith_mean4_weighted {w₁ w₂ w₃ w₄ p₁ p₂ p₃ p₄ : ℝ} (hw₁ : 0 ≤ w₁)
  (hw₂ : 0 ≤ w₂) (hw₃ : 0 ≤ w₃) (hw₄ : 0 ≤ w₄) (hp₁ : 0 ≤ p₁) (hp₂ : 0 ≤ p₂) (hp₃ : 0 ≤ p₃)
  (hp₄ : 0 ≤ p₄) (hw : w₁ + w₂ + w₃ + w₄ = 1) :
  p₁ ^ w₁ * p₂ ^ w₂ * p₃ ^ w₃ * p₄ ^ w₄ ≤ w₁ * p₁ + w₂ * p₂ + w₃ * p₃ + w₄ * p₄ :=
nnreal.geom_mean_le_arith_mean4_weighted ⟨w₁, hw₁⟩ ⟨w₂, hw₂⟩ ⟨w₃, hw₃⟩ ⟨w₄, hw₄⟩
  ⟨p₁, hp₁⟩ ⟨p₂, hp₂⟩ ⟨p₃, hp₃⟩ ⟨p₄, hp₄⟩ $ nnreal.coe_eq.1 $ by assumption

end real

end geom_mean_le_arith_mean

section young

/-! ### Young's inequality -/

namespace real

/-- Young's inequality, a version for nonnegative real numbers. -/
theorem young_inequality_of_nonneg {a b p q : ℝ} (ha : 0 ≤ a) (hb : 0 ≤ b)
  (hpq : p.is_conjugate_exponent q) :
  a * b ≤ a^p / p + b^q / q :=
by simpa [← rpow_mul, ha, hb, hpq.ne_zero, hpq.symm.ne_zero, div_eq_inv_mul]
  using geom_mean_le_arith_mean2_weighted hpq.one_div_nonneg hpq.symm.one_div_nonneg
    (rpow_nonneg_of_nonneg ha p) (rpow_nonneg_of_nonneg hb q) hpq.inv_add_inv_conj

/-- Young's inequality, a version for arbitrary real numbers. -/
theorem young_inequality (a b : ℝ) {p q : ℝ} (hpq : p.is_conjugate_exponent q) :
  a * b ≤ |a|^p / p + |b|^q / q :=
calc a * b ≤ |a * b|                   : le_abs_self (a * b)
       ... = |a| * |b|                 : abs_mul a b
       ... ≤ |a|^p / p + |b|^q / q :
  real.young_inequality_of_nonneg (abs_nonneg a) (abs_nonneg b) hpq

end real

namespace nnreal

/-- Young's inequality, `ℝ≥0` version. We use `{p q : ℝ≥0}` in order to avoid constructing
witnesses of `0 ≤ p` and `0 ≤ q` for the denominators.  -/
theorem young_inequality (a b : ℝ≥0) {p q : ℝ≥0} (hp : 1 < p) (hpq : 1 / p + 1 / q = 1) :
  a * b ≤ a^(p:ℝ) / p + b^(q:ℝ) / q :=
real.young_inequality_of_nonneg a.coe_nonneg b.coe_nonneg ⟨hp, nnreal.coe_eq.2 hpq⟩

/-- Young's inequality, `ℝ≥0` version with real conjugate exponents. -/
theorem young_inequality_real (a b : ℝ≥0) {p q : ℝ} (hpq : p.is_conjugate_exponent q) :
  a * b ≤ a ^ p / real.to_nnreal p + b ^ q / real.to_nnreal q :=
begin
  nth_rewrite 0 ← real.coe_to_nnreal p hpq.nonneg,
  nth_rewrite 0 ← real.coe_to_nnreal q hpq.symm.nonneg,
  exact young_inequality a b hpq.one_lt_nnreal hpq.inv_add_inv_conj_nnreal,
end

end nnreal

namespace ennreal

/-- Young's inequality, `ℝ≥0∞` version with real conjugate exponents. -/
theorem young_inequality (a b : ℝ≥0∞) {p q : ℝ} (hpq : p.is_conjugate_exponent q) :
  a * b ≤ a ^ p / ennreal.of_real p + b ^ q / ennreal.of_real q :=
begin
  by_cases h : a = ⊤ ∨ b = ⊤,
  { refine le_trans le_top (le_of_eq _),
    repeat { rw div_eq_mul_inv },
    cases h; rw h; simp [h, hpq.pos, hpq.symm.pos], },
  push_neg at h, -- if a ≠ ⊤ and b ≠ ⊤, use the nnreal version: nnreal.young_inequality_real
  rw [←coe_to_nnreal h.left, ←coe_to_nnreal h.right, ←coe_mul,
    coe_rpow_of_nonneg _ hpq.nonneg, coe_rpow_of_nonneg _ hpq.symm.nonneg, ennreal.of_real,
    ennreal.of_real, ←@coe_div (real.to_nnreal p) _ (by simp [hpq.pos]),
    ←@coe_div (real.to_nnreal q) _ (by simp [hpq.symm.pos]), ←coe_add, coe_le_coe],
  exact nnreal.young_inequality_real a.to_nnreal b.to_nnreal hpq,
end

end ennreal

end young

section holder_minkowski

/-! ### Hölder's and Minkowski's inequalities -/

namespace nnreal

private lemma inner_le_Lp_mul_Lp_of_norm_le_one (f g : ι → ℝ≥0) {p q : ℝ}
  (hpq : p.is_conjugate_exponent q) (hf : ∑ i in s, (f i) ^ p ≤ 1) (hg : ∑ i in s, (g i) ^ q ≤ 1) :
  ∑ i in s, f i * g i ≤ 1 :=
begin
  have hp_ne_zero : real.to_nnreal p ≠ 0, from (zero_lt_one.trans hpq.one_lt_nnreal).ne.symm,
  have hq_ne_zero : real.to_nnreal q ≠ 0, from (zero_lt_one.trans hpq.symm.one_lt_nnreal).ne.symm,
  calc ∑ i in s, f i * g i
      ≤ ∑ i in s, ((f i) ^ p / real.to_nnreal p + (g i) ^ q / real.to_nnreal q) :
    finset.sum_le_sum (λ i his, young_inequality_real (f i) (g i) hpq)
  ... = (∑ i in s, (f i) ^ p) / real.to_nnreal p + (∑ i in s, (g i) ^ q) / real.to_nnreal q :
    by rw [sum_add_distrib, sum_div, sum_div]
  ... ≤ 1 / real.to_nnreal p + 1 / real.to_nnreal q :
    by { refine add_le_add _ _,
      { rwa [div_le_iff hp_ne_zero, div_mul_cancel _ hp_ne_zero], },
      { rwa [div_le_iff hq_ne_zero, div_mul_cancel _ hq_ne_zero], }, }
  ... = 1 : hpq.inv_add_inv_conj_nnreal,
end

private lemma inner_le_Lp_mul_Lp_of_norm_eq_zero (f g : ι → ℝ≥0) {p q : ℝ}
  (hpq : p.is_conjugate_exponent q) (hf : ∑ i in s, (f i) ^ p = 0) :
  ∑ i in s, f i * g i ≤ (∑ i in s, (f i) ^ p) ^ (1 / p) * (∑ i in s, (g i) ^ q) ^ (1 / q) :=
begin
  simp only [hf, hpq.ne_zero, one_div, sum_eq_zero_iff, zero_rpow, zero_mul, inv_eq_zero,
    ne.def, not_false_iff, le_zero_iff, mul_eq_zero],
  intros i his,
  left,
  rw sum_eq_zero_iff at hf,
  exact (rpow_eq_zero_iff.mp (hf i his)).left,
end

/-- Hölder inequality: the scalar product of two functions is bounded by the product of their
`L^p` and `L^q` norms when `p` and `q` are conjugate exponents. Version for sums over finite sets,
with `ℝ≥0`-valued functions. -/
theorem inner_le_Lp_mul_Lq (f g : ι → ℝ≥0) {p q : ℝ}
  (hpq : p.is_conjugate_exponent q) :
  ∑ i in s, f i * g i ≤ (∑ i in s, (f i) ^ p) ^ (1 / p) * (∑ i in s, (g i) ^ q) ^ (1 / q) :=
begin
  by_cases hF_zero : ∑ i in s, (f i) ^ p = 0,
  { exact inner_le_Lp_mul_Lp_of_norm_eq_zero s f g hpq hF_zero, },
  by_cases hG_zero : ∑ i in s, (g i) ^ q = 0,
  { calc ∑ i in s, f i * g i
        = ∑ i in s, g i * f i : by { congr' with i, rw mul_comm, }
    ... ≤ (∑ i in s, (g i) ^ q) ^ (1 / q) * (∑ i in s, (f i) ^ p) ^ (1 / p) :
      inner_le_Lp_mul_Lp_of_norm_eq_zero s g f hpq.symm hG_zero
    ... = (∑ i in s, (f i) ^ p) ^ (1 / p) * (∑ i in s, (g i) ^ q) ^ (1 / q) : mul_comm _ _, },
  let f' := λ i, (f i) / (∑ i in s, (f i) ^ p) ^ (1 / p),
  let g' := λ i, (g i) / (∑ i in s, (g i) ^ q) ^ (1 / q),
  suffices : ∑ i in s, f' i * g' i ≤ 1,
  { simp_rw [f', g', div_mul_div_comm, ← sum_div] at this,
    rwa [div_le_iff, one_mul] at this,
    refine mul_ne_zero _ _,
    { rw [ne.def, rpow_eq_zero_iff, not_and_distrib], exact or.inl hF_zero, },
    { rw [ne.def, rpow_eq_zero_iff, not_and_distrib], exact or.inl hG_zero, }, },
  refine inner_le_Lp_mul_Lp_of_norm_le_one s f' g' hpq (le_of_eq _) (le_of_eq _),
  { simp_rw [f', div_rpow, ← sum_div, ← rpow_mul, one_div, inv_mul_cancel hpq.ne_zero, rpow_one,
      div_self hF_zero], },
  { simp_rw [g', div_rpow, ← sum_div, ← rpow_mul, one_div, inv_mul_cancel hpq.symm.ne_zero,
    rpow_one, div_self hG_zero], },
end

/-- Hölder inequality: the scalar product of two functions is bounded by the product of their
`L^p` and `L^q` norms when `p` and `q` are conjugate exponents. A version for `nnreal`-valued
functions. For an alternative version, convenient if the infinite sums are already expressed as
`p`-th powers, see `inner_le_Lp_mul_Lq_has_sum`. -/
theorem inner_le_Lp_mul_Lq_tsum {f g : ι → ℝ≥0} {p q : ℝ} (hpq : p.is_conjugate_exponent q)
  (hf : summable (λ i, (f i) ^ p)) (hg : summable (λ i, (g i) ^ q)) :
  summable (λ i, f i * g i) ∧
  ∑' i, f i * g i ≤ (∑' i, (f i) ^ p) ^ (1 / p) * (∑' i, (g i) ^ q) ^ (1 / q) :=
begin
  have H₁ : ∀ s : finset ι, ∑ i in s, f i * g i
    ≤ (∑' i, (f i) ^ p) ^ (1 / p) * (∑' i, (g i) ^ q) ^ (1 / q),
  { intros s,
    refine le_trans (inner_le_Lp_mul_Lq s f g hpq) (mul_le_mul _ _ bot_le bot_le),
    { rw nnreal.rpow_le_rpow_iff (one_div_pos.mpr hpq.pos),
      exact sum_le_tsum _ (λ _ _, zero_le _) hf },
    { rw nnreal.rpow_le_rpow_iff (one_div_pos.mpr hpq.symm.pos),
      exact sum_le_tsum _ (λ _ _, zero_le _) hg } },
  have bdd : bdd_above (set.range (λ s, ∑ i in s, f i * g i)),
  { refine ⟨(∑' i, (f i) ^ p) ^ (1 / p) * (∑' i, (g i) ^ q) ^ (1 / q), _⟩,
    rintros a ⟨s, rfl⟩,
    exact H₁ s },
  have H₂ : summable _ := (has_sum_of_is_lub _ (is_lub_csupr bdd)).summable,
  exact ⟨H₂, tsum_le_of_sum_le H₂ H₁⟩,
end

theorem summable_mul_of_Lp_Lq {f g : ι → ℝ≥0} {p q : ℝ} (hpq : p.is_conjugate_exponent q)
  (hf : summable (λ i, (f i) ^ p)) (hg : summable (λ i, (g i) ^ q)) :
  summable (λ i, f i * g i) :=
(inner_le_Lp_mul_Lq_tsum hpq hf hg).1

theorem inner_le_Lp_mul_Lq_tsum' {f g : ι → ℝ≥0} {p q : ℝ} (hpq : p.is_conjugate_exponent q)
  (hf : summable (λ i, (f i) ^ p)) (hg : summable (λ i, (g i) ^ q)) :
  ∑' i, f i * g i ≤ (∑' i, (f i) ^ p) ^ (1 / p) * (∑' i, (g i) ^ q) ^ (1 / q)  :=
(inner_le_Lp_mul_Lq_tsum hpq hf hg).2

/-- Hölder inequality: the scalar product of two functions is bounded by the product of their
`L^p` and `L^q` norms when `p` and `q` are conjugate exponents. A version for `nnreal`-valued
functions. For an alternative version, convenient if the infinite sums are not already expressed as
`p`-th powers, see `inner_le_Lp_mul_Lq_tsum`.  -/
theorem inner_le_Lp_mul_Lq_has_sum {f g : ι → ℝ≥0} {A B : ℝ≥0} {p q : ℝ}
  (hpq : p.is_conjugate_exponent q) (hf : has_sum (λ i, (f i) ^ p) (A ^ p))
  (hg : has_sum (λ i, (g i) ^ q) (B ^ q)) :
  ∃ C, C ≤ A * B ∧ has_sum (λ i, f i * g i) C :=
begin
  obtain ⟨H₁, H₂⟩ := inner_le_Lp_mul_Lq_tsum hpq hf.summable hg.summable,
  have hA : A = (∑' (i : ι), f i ^ p) ^ (1 / p),
  { rw [hf.tsum_eq, rpow_inv_rpow_self hpq.ne_zero] },
  have hB : B = (∑' (i : ι), g i ^ q) ^ (1 / q),
  { rw [hg.tsum_eq, rpow_inv_rpow_self hpq.symm.ne_zero] },
  refine ⟨∑' i, f i * g i, _, _⟩,
  { simpa [hA, hB] using H₂ },
  { simpa only [rpow_self_rpow_inv hpq.ne_zero] using H₁.has_sum }
end

/-- For `1 ≤ p`, the `p`-th power of the sum of `f i` is bounded above by a constant times the
sum of the `p`-th powers of `f i`. Version for sums over finite sets, with `ℝ≥0`-valued functions.
-/
theorem rpow_sum_le_const_mul_sum_rpow (f : ι → ℝ≥0) {p : ℝ} (hp : 1 ≤ p) :
  (∑ i in s, f i) ^ p ≤ (card s) ^ (p - 1) * ∑ i in s, (f i) ^ p :=
begin
  cases eq_or_lt_of_le hp with hp hp,
  { simp [← hp] },
  let q : ℝ := p / (p - 1),
  have hpq : p.is_conjugate_exponent q,
  { rw real.is_conjugate_exponent_iff hp },
  have hp₁ : 1 / p * p = 1 := one_div_mul_cancel hpq.ne_zero,
  have hq : 1 / q * p = (p - 1),
  { rw [← hpq.div_conj_eq_sub_one],
    ring },
  simpa only [nnreal.mul_rpow, ← nnreal.rpow_mul, hp₁, hq, one_mul, one_rpow, rpow_one,
    pi.one_apply, sum_const, nat.smul_one_eq_coe]
    using nnreal.rpow_le_rpow (inner_le_Lp_mul_Lq s 1 f hpq.symm) hpq.nonneg,
end

/-- The `L_p` seminorm of a vector `f` is the greatest value of the inner product
`∑ i in s, f i * g i` over functions `g` of `L_q` seminorm less than or equal to one. -/
theorem is_greatest_Lp (f : ι → ℝ≥0) {p q : ℝ} (hpq : p.is_conjugate_exponent q) :
  is_greatest ((λ g : ι → ℝ≥0, ∑ i in s, f i * g i) ''
    {g | ∑ i in s, (g i)^q ≤ 1}) ((∑ i in s, (f i)^p) ^ (1 / p)) :=
begin
  split,
  { use λ i, ((f i) ^ p / f i / (∑ i in s, (f i) ^ p) ^ (1 / q)),
    by_cases hf : ∑ i in s, (f i)^p = 0,
    { simp [hf, hpq.ne_zero, hpq.symm.ne_zero] },
    { have A : p + q - q ≠ 0, by simp [hpq.ne_zero],
      have B : ∀ y : ℝ≥0, y * y^p / y = y^p,
      { refine λ y, mul_div_cancel_left_of_imp (λ h, _),
        simpa [h, hpq.ne_zero] },
      simp only [set.mem_set_of_eq, div_rpow, ← sum_div, ← rpow_mul,
        div_mul_cancel _ hpq.symm.ne_zero, rpow_one, div_le_iff hf, one_mul, hpq.mul_eq_add,
        ← rpow_sub' _ A, _root_.add_sub_cancel, le_refl, true_and, ← mul_div_assoc, B],
      rw [div_eq_iff, ← rpow_add hf, hpq.inv_add_inv_conj, rpow_one],
      simpa [hpq.symm.ne_zero] using hf } },
  { rintros _ ⟨g, hg, rfl⟩,
    apply le_trans (inner_le_Lp_mul_Lq s f g hpq),
    simpa only [mul_one] using mul_le_mul_left'
      (nnreal.rpow_le_one hg (le_of_lt hpq.symm.one_div_pos)) _ }
end

/-- Minkowski inequality: the `L_p` seminorm of the sum of two vectors is less than or equal
to the sum of the `L_p`-seminorms of the summands. A version for `nnreal`-valued functions. -/
theorem Lp_add_le (f g : ι → ℝ≥0) {p : ℝ} (hp : 1 ≤ p) :
  (∑ i in s, (f i + g i) ^ p) ^ (1 / p) ≤
    (∑ i in s, (f i) ^ p) ^ (1 / p) + (∑ i in s, (g i) ^ p) ^ (1 / p) :=
begin
  -- The result is trivial when `p = 1`, so we can assume `1 < p`.
  rcases eq_or_lt_of_le hp with rfl|hp, { simp [finset.sum_add_distrib] },
  have hpq := real.is_conjugate_exponent_conjugate_exponent hp,
  have := is_greatest_Lp s (f + g) hpq,
  simp only [pi.add_apply, add_mul, sum_add_distrib] at this,
  rcases this.1 with ⟨φ, hφ, H⟩,
  rw ← H,
  exact add_le_add ((is_greatest_Lp s f hpq).2 ⟨φ, hφ, rfl⟩)
    ((is_greatest_Lp s g hpq).2 ⟨φ, hφ, rfl⟩)
end

/-- Minkowski inequality: the `L_p` seminorm of the infinite sum of two vectors is less than or
equal to the infinite sum of the `L_p`-seminorms of the summands, if these infinite sums both
exist. A version for `nnreal`-valued functions. For an alternative version, convenient if the
infinite sums are already expressed as `p`-th powers, see `Lp_add_le_has_sum_of_nonneg`. -/
theorem Lp_add_le_tsum {f g : ι → ℝ≥0} {p : ℝ} (hp : 1 ≤ p) (hf : summable (λ i, (f i) ^ p))
  (hg : summable (λ i, (g i) ^ p)) :
  summable (λ i, (f i + g i) ^ p) ∧
  (∑' i, (f i + g i) ^ p) ^ (1 / p) ≤ (∑' i, (f i) ^ p) ^ (1 / p) + (∑' i, (g i) ^ p) ^ (1 / p) :=
begin
  have pos : 0 < p := lt_of_lt_of_le zero_lt_one hp,
  have H₁ : ∀ s : finset ι, ∑ i in s, (f i + g i) ^ p
    ≤ ((∑' i, (f i)^p) ^ (1/p) + (∑' i, (g i)^p) ^ (1/p)) ^ p,
  { intros s,
    rw ← nnreal.rpow_one_div_le_iff pos,
    refine le_trans (Lp_add_le s f g hp) (add_le_add _ _);
    rw nnreal.rpow_le_rpow_iff (one_div_pos.mpr pos);
    refine sum_le_tsum _ (λ _ _, zero_le _) _,
    exacts [hf, hg] },
  have bdd : bdd_above (set.range (λ s, ∑ i in s, (f i + g i) ^ p)),
  { refine ⟨((∑' i, (f i)^p) ^ (1/p) + (∑' i, (g i)^p) ^ (1/p)) ^ p, _⟩,
    rintros a ⟨s, rfl⟩,
    exact H₁ s },
  have H₂ : summable _ := (has_sum_of_is_lub _ (is_lub_csupr bdd)).summable,
  refine ⟨H₂, _⟩,
  rw nnreal.rpow_one_div_le_iff pos,
  refine tsum_le_of_sum_le H₂ H₁,
end

theorem summable_Lp_add {f g : ι → ℝ≥0} {p : ℝ} (hp : 1 ≤ p) (hf : summable (λ i, (f i) ^ p))
  (hg : summable (λ i, (g i) ^ p)) :
  summable (λ i, (f i + g i) ^ p) :=
(Lp_add_le_tsum hp hf hg).1

theorem Lp_add_le_tsum' {f g : ι → ℝ≥0} {p : ℝ} (hp : 1 ≤ p) (hf : summable (λ i, (f i) ^ p))
  (hg : summable (λ i, (g i) ^ p)) :
  (∑' i, (f i + g i) ^ p) ^ (1 / p) ≤ (∑' i, (f i) ^ p) ^ (1 / p) + (∑' i, (g i) ^ p) ^ (1 / p) :=
(Lp_add_le_tsum hp hf hg).2

/-- Minkowski inequality: the `L_p` seminorm of the infinite sum of two vectors is less than or
equal to the infinite sum of the `L_p`-seminorms of the summands, if these infinite sums both
exist. A version for `nnreal`-valued functions. For an alternative version, convenient if the
infinite sums are not already expressed as `p`-th powers, see `Lp_add_le_tsum_of_nonneg`.  -/
theorem Lp_add_le_has_sum {f g : ι → ℝ≥0} {A B : ℝ≥0} {p : ℝ} (hp : 1 ≤ p)
  (hf : has_sum (λ i, (f i) ^ p) (A ^ p)) (hg : has_sum (λ i, (g i) ^ p) (B ^ p)) :
  ∃ C, C ≤ A + B ∧ has_sum (λ i, (f i + g i) ^ p) (C ^ p) :=
begin
  have hp' : p ≠ 0 := (lt_of_lt_of_le zero_lt_one hp).ne',
  obtain ⟨H₁, H₂⟩ := Lp_add_le_tsum hp hf.summable hg.summable,
  have hA : A = (∑' (i : ι), f i ^ p) ^ (1 / p) := by rw [hf.tsum_eq, rpow_inv_rpow_self hp'],
  have hB : B = (∑' (i : ι), g i ^ p) ^ (1 / p) := by rw [hg.tsum_eq, rpow_inv_rpow_self hp'],
  refine ⟨(∑' i, (f i + g i) ^ p) ^ (1 / p), _, _⟩,
  { simpa [hA, hB] using H₂ },
  { simpa only [rpow_self_rpow_inv hp'] using H₁.has_sum }
end

end nnreal

namespace real

variables (f g : ι → ℝ)  {p q : ℝ}

/-- Hölder inequality: the scalar product of two functions is bounded by the product of their
`L^p` and `L^q` norms when `p` and `q` are conjugate exponents. Version for sums over finite sets,
with real-valued functions. -/
theorem inner_le_Lp_mul_Lq (hpq : is_conjugate_exponent p q) :
  ∑ i in s, f i * g i ≤ (∑ i in s, |f i| ^ p) ^ (1 / p) * (∑ i in s, |g i| ^ q) ^ (1 / q) :=
begin
  have := nnreal.coe_le_coe.2 (nnreal.inner_le_Lp_mul_Lq s (λ i, ⟨_, abs_nonneg (f i)⟩)
    (λ i, ⟨_, abs_nonneg (g i)⟩) hpq),
  push_cast at this,
  refine le_trans (sum_le_sum $ λ i hi, _) this,
  simp only [← abs_mul, le_abs_self]
end

/-- For `1 ≤ p`, the `p`-th power of the sum of `f i` is bounded above by a constant times the
sum of the `p`-th powers of `f i`. Version for sums over finite sets, with `ℝ`-valued functions. -/
theorem rpow_sum_le_const_mul_sum_rpow (hp : 1 ≤ p) :
  (∑ i in s, |f i|) ^ p ≤ (card s) ^ (p - 1) * ∑ i in s, |f i| ^ p :=
begin
  have := nnreal.coe_le_coe.2
    (nnreal.rpow_sum_le_const_mul_sum_rpow s (λ i, ⟨_, abs_nonneg (f i)⟩) hp),
  push_cast at this,
  exact this, -- for some reason `exact_mod_cast` can't replace this argument
end

/-- Minkowski inequality: the `L_p` seminorm of the sum of two vectors is less than or equal
to the sum of the `L_p`-seminorms of the summands. A version for `real`-valued functions. -/
theorem Lp_add_le (hp : 1 ≤ p) :
  (∑ i in s, |f i + g i| ^ p) ^ (1 / p) ≤
    (∑ i in s, |f i| ^ p) ^ (1 / p) + (∑ i in s, |g i| ^ p) ^ (1 / p) :=
begin
  have := nnreal.coe_le_coe.2 (nnreal.Lp_add_le s (λ i, ⟨_, abs_nonneg (f i)⟩)
    (λ i, ⟨_, abs_nonneg (g i)⟩) hp),
  push_cast at this,
  refine le_trans (rpow_le_rpow _ (sum_le_sum $ λ i hi, _) _) this;
    simp [sum_nonneg, rpow_nonneg_of_nonneg, abs_nonneg, le_trans zero_le_one hp, abs_add,
      rpow_le_rpow]
end

variables {f g}

/-- Hölder inequality: the scalar product of two functions is bounded by the product of their
`L^p` and `L^q` norms when `p` and `q` are conjugate exponents. Version for sums over finite sets,
with real-valued nonnegative functions. -/
theorem inner_le_Lp_mul_Lq_of_nonneg (hpq : is_conjugate_exponent p q)
  (hf : ∀ i ∈ s, 0 ≤ f i) (hg : ∀ i ∈ s, 0 ≤ g i) :
  ∑ i in s, f i * g i ≤ (∑ i in s, (f i)^p) ^ (1 / p) * (∑ i in s, (g i)^q) ^ (1 / q) :=
by convert inner_le_Lp_mul_Lq s f g hpq using 3; apply sum_congr rfl; intros i hi;
  simp only [abs_of_nonneg, hf i hi, hg i hi]

/-- Hölder inequality: the scalar product of two functions is bounded by the product of their
`L^p` and `L^q` norms when `p` and `q` are conjugate exponents. A version for `ℝ`-valued functions.
For an alternative version, convenient if the infinite sums are already expressed as `p`-th powers,
see `inner_le_Lp_mul_Lq_has_sum_of_nonneg`. -/
theorem inner_le_Lp_mul_Lq_tsum_of_nonneg (hpq : p.is_conjugate_exponent q) (hf : ∀ i, 0 ≤ f i)
  (hg : ∀ i, 0 ≤ g i) (hf_sum : summable (λ i, (f i) ^ p)) (hg_sum : summable (λ i, (g i) ^ q)) :
  summable (λ i, f i * g i) ∧
  ∑' i, f i * g i ≤ (∑' i, (f i) ^ p) ^ (1 / p) * (∑' i, (g i) ^ q) ^ (1 / q) :=
begin
  lift f to (ι → ℝ≥0) using hf,
  lift g to (ι → ℝ≥0) using hg,
  norm_cast at *,
  exact nnreal.inner_le_Lp_mul_Lq_tsum hpq hf_sum hg_sum,
end

theorem summable_mul_of_Lp_Lq_of_nonneg (hpq : p.is_conjugate_exponent q) (hf : ∀ i, 0 ≤ f i)
  (hg : ∀ i, 0 ≤ g i) (hf_sum : summable (λ i, (f i) ^ p)) (hg_sum : summable (λ i, (g i) ^ q)) :
  summable (λ i, f i * g i) :=
(inner_le_Lp_mul_Lq_tsum_of_nonneg hpq hf hg hf_sum hg_sum).1

theorem inner_le_Lp_mul_Lq_tsum_of_nonneg' (hpq : p.is_conjugate_exponent q) (hf : ∀ i, 0 ≤ f i)
  (hg : ∀ i, 0 ≤ g i) (hf_sum : summable (λ i, (f i) ^ p)) (hg_sum : summable (λ i, (g i) ^ q)) :
  ∑' i, f i * g i ≤ (∑' i, (f i) ^ p) ^ (1 / p) * (∑' i, (g i) ^ q) ^ (1 / q) :=
(inner_le_Lp_mul_Lq_tsum_of_nonneg hpq hf hg hf_sum hg_sum).2

/-- Hölder inequality: the scalar product of two functions is bounded by the product of their
`L^p` and `L^q` norms when `p` and `q` are conjugate exponents. A version for `nnreal`-valued
functions. For an alternative version, convenient if the infinite sums are not already expressed as
`p`-th powers, see `inner_le_Lp_mul_Lq_tsum_of_nonneg`.  -/
theorem inner_le_Lp_mul_Lq_has_sum_of_nonneg (hpq : p.is_conjugate_exponent q) {A B : ℝ}
  (hA : 0 ≤ A) (hB : 0 ≤ B) (hf : ∀ i, 0 ≤ f i) (hg : ∀ i, 0 ≤ g i)
  (hf_sum : has_sum (λ i, (f i) ^ p) (A ^ p)) (hg_sum : has_sum (λ i, (g i) ^ q) (B ^ q)) :
  ∃ C : ℝ, 0 ≤ C ∧ C ≤ A * B ∧ has_sum (λ i, f i * g i) C :=
begin
  lift f to (ι → ℝ≥0) using hf,
  lift g to (ι → ℝ≥0) using hg,
  lift A to ℝ≥0 using hA,
  lift B to ℝ≥0 using hB,
  norm_cast at hf_sum hg_sum,
  obtain ⟨C, hC, H⟩ := nnreal.inner_le_Lp_mul_Lq_has_sum hpq hf_sum hg_sum,
  refine ⟨C, C.prop, hC, _⟩,
  norm_cast,
  exact H
end

/-- For `1 ≤ p`, the `p`-th power of the sum of `f i` is bounded above by a constant times the
sum of the `p`-th powers of `f i`. Version for sums over finite sets, with nonnegative `ℝ`-valued
functions. -/
theorem rpow_sum_le_const_mul_sum_rpow_of_nonneg (hp : 1 ≤ p) (hf : ∀ i ∈ s, 0 ≤ f i) :
  (∑ i in s, f i) ^ p ≤ (card s) ^ (p - 1) * ∑ i in s, f i ^ p :=
by convert rpow_sum_le_const_mul_sum_rpow s f hp using 2; apply sum_congr rfl; intros i hi;
  simp only [abs_of_nonneg, hf i hi]

/-- Minkowski inequality: the `L_p` seminorm of the sum of two vectors is less than or equal
to the sum of the `L_p`-seminorms of the summands. A version for `ℝ`-valued nonnegative
functions. -/
theorem Lp_add_le_of_nonneg (hp : 1 ≤ p) (hf : ∀ i ∈ s, 0 ≤ f i) (hg : ∀ i ∈ s, 0 ≤ g i) :
  (∑ i in s, (f i + g i) ^ p) ^ (1 / p) ≤
    (∑ i in s, (f i) ^ p) ^ (1 / p) + (∑ i in s, (g i) ^ p) ^ (1 / p) :=
by convert Lp_add_le s f g hp using 2 ; [skip, congr' 1, congr' 1];
  apply sum_congr rfl; intros i hi; simp only [abs_of_nonneg, hf i hi, hg i hi, add_nonneg]

/-- Minkowski inequality: the `L_p` seminorm of the infinite sum of two vectors is less than or
equal to the infinite sum of the `L_p`-seminorms of the summands, if these infinite sums both
exist. A version for `ℝ`-valued functions. For an alternative version, convenient if the infinite
sums are already expressed as `p`-th powers, see `Lp_add_le_has_sum_of_nonneg`. -/
theorem Lp_add_le_tsum_of_nonneg (hp : 1 ≤ p) (hf : ∀ i, 0 ≤ f i) (hg : ∀ i, 0 ≤ g i)
  (hf_sum : summable (λ i, (f i) ^ p)) (hg_sum : summable (λ i, (g i) ^ p)) :
  summable (λ i, (f i + g i) ^ p) ∧
  (∑' i, (f i + g i) ^ p) ^ (1 / p) ≤ (∑' i, (f i) ^ p) ^ (1 / p) + (∑' i, (g i) ^ p) ^ (1 / p) :=
begin
  lift f to (ι → ℝ≥0) using hf,
  lift g to (ι → ℝ≥0) using hg,
  norm_cast at *,
  exact nnreal.Lp_add_le_tsum hp hf_sum hg_sum,
end

theorem summable_Lp_add_of_nonneg (hp : 1 ≤ p) (hf : ∀ i, 0 ≤ f i) (hg : ∀ i, 0 ≤ g i)
  (hf_sum : summable (λ i, (f i) ^ p)) (hg_sum : summable (λ i, (g i) ^ p)) :
  summable (λ i, (f i + g i) ^ p) :=
(Lp_add_le_tsum_of_nonneg hp hf hg hf_sum hg_sum).1

theorem Lp_add_le_tsum_of_nonneg' (hp : 1 ≤ p) (hf : ∀ i, 0 ≤ f i) (hg : ∀ i, 0 ≤ g i)
  (hf_sum : summable (λ i, (f i) ^ p)) (hg_sum : summable (λ i, (g i) ^ p)) :
  (∑' i, (f i + g i) ^ p) ^ (1 / p) ≤ (∑' i, (f i) ^ p) ^ (1 / p) + (∑' i, (g i) ^ p) ^ (1 / p) :=
(Lp_add_le_tsum_of_nonneg hp hf hg hf_sum hg_sum).2

/-- Minkowski inequality: the `L_p` seminorm of the infinite sum of two vectors is less than or
equal to the infinite sum of the `L_p`-seminorms of the summands, if these infinite sums both
exist. A version for `ℝ`-valued functions. For an alternative version, convenient if the infinite
sums are not already expressed as `p`-th powers, see `Lp_add_le_tsum_of_nonneg`. -/
theorem Lp_add_le_has_sum_of_nonneg (hp : 1 ≤ p) (hf : ∀ i, 0 ≤ f i) (hg : ∀ i, 0 ≤ g i) {A B : ℝ}
  (hA : 0 ≤ A) (hB : 0 ≤ B) (hfA : has_sum (λ i, (f i) ^ p) (A ^ p))
  (hgB : has_sum (λ i, (g i) ^ p) (B ^ p)) :
  ∃ C, 0 ≤ C ∧ C ≤ A + B ∧ has_sum (λ i, (f i + g i) ^ p) (C ^ p) :=
begin
  lift f to (ι → ℝ≥0) using hf,
  lift g to (ι → ℝ≥0) using hg,
  lift A to ℝ≥0 using hA,
  lift B to ℝ≥0 using hB,
  norm_cast at hfA hgB,
  obtain ⟨C, hC₁, hC₂⟩ := nnreal.Lp_add_le_has_sum hp hfA hgB,
  use C,
  norm_cast,
  exact ⟨zero_le _, hC₁, hC₂⟩,
end

end real

namespace ennreal

variables (f g : ι → ℝ≥0∞)  {p q : ℝ}

/-- Hölder inequality: the scalar product of two functions is bounded by the product of their
`L^p` and `L^q` norms when `p` and `q` are conjugate exponents. Version for sums over finite sets,
with `ℝ≥0∞`-valued functions. -/
theorem inner_le_Lp_mul_Lq (hpq : p.is_conjugate_exponent q) :
  (∑ i in s, f i * g i) ≤ (∑ i in s, (f i)^p) ^ (1/p) * (∑ i in s, (g i)^q) ^ (1/q) :=
begin
  by_cases H : (∑ i in s, (f i)^p) ^ (1/p) = 0 ∨ (∑ i in s, (g i)^q) ^ (1/q) = 0,
  { replace H : (∀ i ∈ s, f i = 0) ∨ (∀ i ∈ s, g i = 0),
      by simpa [ennreal.rpow_eq_zero_iff, hpq.pos, hpq.symm.pos, asymm hpq.pos, asymm hpq.symm.pos,
                sum_eq_zero_iff_of_nonneg] using H,
    have : ∀ i ∈ s, f i * g i = 0 := λ i hi, by cases H; simp [H i hi],
    have : (∑ i in s, f i * g i) = (∑ i in s, 0) := sum_congr rfl this,
    simp [this] },
  push_neg at H,
  by_cases H' : (∑ i in s, (f i)^p) ^ (1/p) = ⊤ ∨ (∑ i in s, (g i)^q) ^ (1/q) = ⊤,
  { cases H'; simp [H', -one_div, H] },
  replace H' : (∀ i ∈ s, f i ≠ ⊤) ∧ (∀ i ∈ s, g i ≠ ⊤),
    by simpa [ennreal.rpow_eq_top_iff, asymm hpq.pos, asymm hpq.symm.pos, hpq.pos, hpq.symm.pos,
              ennreal.sum_eq_top_iff, not_or_distrib] using H',
  have := ennreal.coe_le_coe.2 (@nnreal.inner_le_Lp_mul_Lq _ s (λ i, ennreal.to_nnreal (f i))
              (λ i, ennreal.to_nnreal (g i)) _ _ hpq),
  simp [← ennreal.coe_rpow_of_nonneg, le_of_lt (hpq.pos), le_of_lt (hpq.one_div_pos),
             le_of_lt (hpq.symm.pos), le_of_lt (hpq.symm.one_div_pos)] at this,
  convert this using 1;
  [skip, congr' 2];
  [skip, skip, simp, skip, simp];
  { apply finset.sum_congr rfl (λ i hi, _), simp [H'.1 i hi, H'.2 i hi, -with_zero.coe_mul,
    with_top.coe_mul.symm] },
end

/-- For `1 ≤ p`, the `p`-th power of the sum of `f i` is bounded above by a constant times the
sum of the `p`-th powers of `f i`. Version for sums over finite sets, with `ℝ≥0∞`-valued functions.
-/
theorem rpow_sum_le_const_mul_sum_rpow (hp : 1 ≤ p) :
  (∑ i in s, f i) ^ p ≤ (card s) ^ (p - 1) * ∑ i in s, (f i) ^ p :=
begin
  cases eq_or_lt_of_le hp with hp hp,
  { simp [← hp] },
  let q : ℝ := p / (p - 1),
  have hpq : p.is_conjugate_exponent q,
  { rw real.is_conjugate_exponent_iff hp },
  have hp₁ : 1 / p * p = 1 := one_div_mul_cancel hpq.ne_zero,
  have hq : 1 / q * p = (p - 1),
  { rw [← hpq.div_conj_eq_sub_one],
    ring },
  simpa only [ennreal.mul_rpow_of_nonneg _ _ hpq.nonneg, ← ennreal.rpow_mul, hp₁, hq, coe_one,
    one_mul, one_rpow, rpow_one, pi.one_apply, sum_const, nat.smul_one_eq_coe]
    using ennreal.rpow_le_rpow (inner_le_Lp_mul_Lq s 1 f hpq.symm) hpq.nonneg,
end

/-- Minkowski inequality: the `L_p` seminorm of the sum of two vectors is less than or equal
to the sum of the `L_p`-seminorms of the summands. A version for `ℝ≥0∞` valued nonnegative
functions. -/
theorem Lp_add_le (hp : 1 ≤ p) :
  (∑ i in s, (f i + g i) ^ p)^(1/p) ≤ (∑ i in s, (f i)^p) ^ (1/p) + (∑ i in s, (g i)^p) ^ (1/p) :=
begin
  by_cases H' : (∑ i in s, (f i)^p) ^ (1/p) = ⊤ ∨ (∑ i in s, (g i)^p) ^ (1/p) = ⊤,
  { cases H'; simp [H', -one_div] },
  have pos : 0 < p := lt_of_lt_of_le zero_lt_one hp,
  replace H' : (∀ i ∈ s, f i ≠ ⊤) ∧ (∀ i ∈ s, g i ≠ ⊤),
    by simpa [ennreal.rpow_eq_top_iff, asymm pos, pos, ennreal.sum_eq_top_iff,
              not_or_distrib] using H',
  have := ennreal.coe_le_coe.2 (@nnreal.Lp_add_le _ s (λ i, ennreal.to_nnreal (f i))
              (λ i, ennreal.to_nnreal (g i)) _  hp),
  push_cast [← ennreal.coe_rpow_of_nonneg, le_of_lt (pos), le_of_lt (one_div_pos.2 pos)] at this,
  convert this using 2;
  [skip, congr' 1, congr' 1];
  { apply finset.sum_congr rfl (λ i hi, _), simp [H'.1 i hi, H'.2 i hi] }
end

end ennreal

end holder_minkowski


import data.real.basic algebra.group_power tactic.ring

example (x : ℝ) : 2 * (x ^ 2 + 3) = 6 + 2 * x ^ 2 := by ring
example (x : ℝ) : (2 * x) ^ 2 = 4 * x ^ 2 := by ring

variable {x : ℝ}
def f : ℝ → ℝ := λ x, x^2 + 3
def g : ℝ → ℝ := λ x, 2*x

def h1 : ℝ → ℝ := g ∘ f
theorem Q1005i : h1 x = 2*x^2 + 6 :=
begin
  dsimp [h1, f, g],
  rw [mul_add],
  refl
end

def h2 : ℝ → ℝ := f ∘ g
theorem Q1005ii : h2 x = 4*x^2 + 3 :=
begin
  dsimp [h2, f, g],
  rw [mul_pow],
  refl
end

def h3 : ℝ → ℝ := λ x, f x * g x
theorem Q1005iii : h3 x = 2*x^3 + 6*x :=
begin
dsimp [h3, f, g],
ring,
end

def h4 : ℝ → ℝ := λ x, f x + g x
theorem Q1005iv : h4 x = x^2 + 2*x + 3 :=
begin
dsimp [h4, f, g],
ring,
end

def h5 : ℝ → ℝ := λ x, f (g x)
theorem Q1005v : h5 x = h2 x :=
begin
refl,
end


/-
1. Try defining other operations on the natural numbers, such as multiplication, the predecessor function (with pred 0 = 0), truncated subtraction (with n - m = 0 when m is greater than or equal to n), and exponentiation. Then try proving some of their basic properties, building on the theorems we have already proved.

Since many of these are already defined in Lean’s core library, you should work within a namespace named hide, or something like that, in order to avoid name clashes.
-/
namespace hidden
  namespace nat
    def mul (m n : nat) : nat :=
      nat.rec_on n 0 (λ n mul_m_n, m + mul_m_n)
    #reduce mul 3 6

    def pred (n : nat) : nat :=
      nat.rec_on n 0 (λ n pred_n, n)
    #reduce pred 10

    def sub (m n : nat) : nat :=
      nat.rec_on n m (λ n sub_m_n, pred sub_m_n)
    #reduce sub 5 2
    #reduce sub 2 5

    def exp (m n : nat) : nat :=
      nat.rec_on n 1 (λ n exp_m_n, mul m exp_m_n)
    #reduce exp 2 4

    theorem mul_zero (n : nat) : mul n 0 = 0 := rfl
    theorem zero_mul (n : nat) : mul 0 n = 0 :=
    nat.rec_on n
    (
      show mul 0 0 = 0, from rfl
    )
    (
      assume n,
      assume ih : mul 0 n = 0,
      show mul 0 (nat.succ n) = 0, from
        calc
          mul 0 (nat.succ n) = 0 + (mul 0 n):  rfl
                         ... = 0 + 0 : by rw ih
                         ... = 0 : rfl
    )

    theorem mul_one (n : nat) : mul n 1 = n := rfl
    theorem one_mul (n : nat) : mul 1 n = n :=
    nat.rec_on n
    (
      show mul 1 0 = 0, from rfl
    )
    (
      assume n,
      assume ih : mul 1 n = n,
      show mul 1 (nat.succ n) = nat.succ n, from
        calc
          mul 1 (nat.succ n) = 1 + (mul 1 n) : rfl
                         ... = 1 + n : by rw ih
                         ... = n + 1 : by rw nat.add_comm
                         ... = nat.succ n : rfl
    )

    theorem pred_succ (n : nat) : pred (nat.succ n) = n := rfl

    theorem zero_sub (n : nat) : sub 0 n = 0 :=
    nat.rec_on n
    (
      show sub 0 0 = 0, from rfl
    )
    (
      assume n,
      assume ih : sub 0 n = 0,
      show sub 0 (nat.succ n) = 0, from congr_arg pred ih
    )

    theorem exp_zero (n : nat) : exp n 0 = 1 := rfl
  end nat
end hidden


/-
Copyright (c) 2022 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import tactic -- imports all the Lean tactics

/-!

# Sets in Lean, sheet 5 : subset (`⊆`), union (`∪`) and intersection (`∩`)

In this sheet we learn how to manipulate `⊆`, `∪` and `∩` in Lean.

Here are some mathematical facts:

`A ⊆ B` is equivalent to `∀ x, x ∈ A → x ∈ B`;
`x ∈ A ∪ B` is equivalent to `x ∈ A ∨ x ∈ B`;
`x ∈ A ∩ B` is equivalent to `x ∈ A ∧ x ∈ B`.

All of these things are true *by definition* in Lean, which means
that you can switch from one to the other with `change`, or you
can just treat something on the left hand side as if it said
what it said on the right hand side.

For example if your goal is `⊢ x ∈ A ∩ B` then you could write
`change x ∈ A ∧ x ∈ B,` to change the goal to `⊢ x ∈ A ∧ x ∈ B`, but you can
also use the `split,` tactic directly, and this will immediately turn the goal
into two goals `⊢ x ∈ A` and `⊢ x ∈ B`.

## New tactics you will need

You don't need to know any new tactics to solve this sheet. I've mentioned
the `change` tactic. You don't have to use it, and if you use it your
proofs will get longer. So in return I'll tell you about two other
tactics, `rcases` and `rintro`, which you don't have to use either
but if you use them they'll make your proofs shorter.

### The `rcases` tactic

`rcases` is a souped-up version of `cases`. It has slightly different
syntax. If you have a hypothesis `h : P ∧ Q` then `cases h with hP hQ,`
and `rcases h with ⟨hP, hQ⟩,` do the same thing. However, if you
have a hypothesis `h : P ∧ Q ∧ R` then Lean interprets it as `P ∧ (Q ∧ R)`
so if you want to destruct it with `cases` you have to do

```
cases h with hP hQR,
cases hQR with hQ hR
```

You can do this all in one go with `rcases h with ⟨hP, hQ, hR⟩,`. The
name `rcases` stands for "recursive cases".

`rcases` can also be used for `or` hypotheses too; here the syntax is that if
we have
```
h : P ∨ Q
```
then `rcases h with (hP | hQ),` will turn our goal into two goals, one with
`hP : P` and the other with `hQ : Q`.

Even better, `rcases` works on `h : false`. Here there are no cases at all!
So `rcases h with ⟨⟩,` solves the goal.

### The `rintro` tactic

It's quite common to find yourself doing `intro` then `cases` or,
more generally, `intro` then `rcases`. The `rintro` tactic does
these both at once! So for example if your goal is

```
⊢ (P ∧ Q) → R
```

then `rintro ⟨hP, hQ⟩,` leaves you at

```
hP : P
hQ : Q
⊢ R
```

i.e. the same as `intro h, cases h with hP hQ,`

You can introduce more than one hypothesis at once -- `rintro` generalises
`intros` as well. For example if your goal is

```
⊢ P → Q ∧ R → S
```

then `rintro hP ⟨hQ, hR⟩,` turns it into

```
hP : P
hQ : Q
hR : R
⊢ S
```

-/

open set

variables
  (X : Type) -- Everything will be a subset of `X`
  (A B C D E : set X) -- A,B,C,D,E are subsets of `X`
  (x y z : X) -- x,y,z are elements of `X` or, more precisely, terms of type `X`

example : A ⊆ A :=
begin
  sorry,
end

example : ∅ ⊆ A :=
begin
  sorry,
end

example : A ⊆ univ :=
begin
  sorry,
end

example : A ⊆ B → B ⊆ C → A ⊆ C :=
begin
  sorry,
end

example : A ⊆ A ∪ B :=
begin
  sorry,
end

example : A ∩ B ⊆ A :=
begin
  sorry,
end

example : A ⊆ B → A ⊆ C → A ⊆ (B ∩ C) :=
begin
  sorry,
end

example : B ⊆ A → C ⊆ A → B ∪ C ⊆ A :=
begin
  sorry,
end

example : A ⊆ B → C ⊆ D → A ∪ C ⊆ B ∪ D :=
begin
  sorry,
end

example : A ⊆ B → C ⊆ D → A ∩ C ⊆ B ∩ D :=
begin
  sorry,
end


/- LoVe Homework 6: Monads -/

import .lovelib

namespace LoVe

/- Question 2 **optional**: Monadic Structure on Lists -/

/- `list` can be seen as a monad, similar to `option` but with several possible
outcomes. It is also similar to `set`, but the results are ordered and finite.
The code below sets `list` up as a monad. -/

namespace list

protected def bind {α β : Type} : list α → (α → list β) → list β
| []        f := []
| (a :: as) f := f a ++ bind as f

protected def pure {α : Type} (a : α) : list α :=
[a]

lemma pure_eq_singleton {α : Type} (a : α) :
  pure a = [a] :=
by refl

instance : monad list :=
{ pure := @list.pure,
  bind := @list.bind }

/- 2.1 **optional**. Prove the following properties of `bind` under the empty
list (`[]`), the list constructor (`::`), and `++`. -/

@[simp] lemma bind_nil {α β : Type} (f : α → list β) :
  [] >>= f = [] :=
by refl

@[simp] lemma bind_cons {α β : Type} (f : α → list β) (a : α) (as : list α) :
  list.cons a as >>= f = f a ++ (as >>= f) :=
by refl

@[simp] lemma bind_append {α β : Type} (f : α → list β) :
  ∀as as' : list α, (as ++ as') >>= f = (as >>= f) ++ (as' >>= f)
| []        as' := by refl
| (a :: as) as' := by simp [bind_append as as']

/- 2.2 **optional**. Prove the monadic laws for `list`.

Hint: The simplifier cannot see through the type class definition of `pure`. You
can use `pure_eq_singleton` to unfold the definition or `show` to state the
lemma statement using `bind` and `[…]`. -/

lemma pure_bind {α β : Type} (a : α) (f : α → list β) :
  (pure a >>= f) = f a :=
show ([a] >>= f) = f a,
  by simp

lemma bind_pure {α : Type} :
  ∀as : list α, as >>= pure = as
| []       := by refl
| (a :: l) := by simp [pure_eq_singleton, bind_pure l]

lemma bind_assoc {α β γ : Type} (f : α → list β) (g : β → list γ) :
  ∀as : list α, (as >>= f) >>= g = as >>= (λa, f a >>= g)
| []        := by refl
| (a :: as) := by simp [bind_append, bind_assoc as]

lemma bind_pure_comp_eq_map {α β : Type} {f : α → β} :
  ∀as : list α, as >>= (pure ∘ f) = list.map f as
| []        := by refl
| (a :: as) := by simp [bind_pure_comp_eq_map as, pure_eq_singleton]

end list

end LoVe


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Mario Carneiro
-/
import algebra.group.pi
import algebra.group_power

/-!
# The group of permutations (self-equivalences) of a type `α`

This file defines the `group` structure on `equiv.perm α`.
-/
universes u v

namespace equiv

variables {α : Type u}

namespace perm

instance perm_group : group (perm α) :=
{ mul := λ f g, equiv.trans g f,
  one := equiv.refl α,
  inv := equiv.symm,
  mul_assoc := λ f g h, (trans_assoc _ _ _).symm,
  one_mul := trans_refl,
  mul_one := refl_trans,
  mul_left_inv := trans_symm }

theorem mul_apply (f g : perm α) (x) : (f * g) x = f (g x) :=
equiv.trans_apply _ _ _

theorem one_apply (x) : (1 : perm α) x = x := rfl

@[simp] lemma inv_apply_self (f : perm α) (x) : f⁻¹ (f x) = x := f.symm_apply_apply x

@[simp] lemma apply_inv_self (f : perm α) (x) : f (f⁻¹ x) = x := f.apply_symm_apply x

lemma one_def : (1 : perm α) = equiv.refl α := rfl

lemma mul_def (f g : perm α) : f * g = g.trans f := rfl

lemma inv_def (f : perm α) : f⁻¹ = f.symm := rfl

@[simp] lemma coe_mul (f g : perm α) : ⇑(f * g) = f ∘ g := rfl

@[simp] lemma coe_one : ⇑(1 : perm α) = id := rfl

lemma eq_inv_iff_eq {f : perm α} {x y : α} : x = f⁻¹ y ↔ f x = y := f.eq_symm_apply

lemma inv_eq_iff_eq {f : perm α} {x y : α} : f⁻¹ x = y ↔ x = f y := f.symm_apply_eq

lemma gpow_apply_comm {α : Type*} (σ : equiv.perm α) (m n : ℤ) {x : α} :
  (σ ^ m) ((σ ^ n) x) = (σ ^ n) ((σ ^ m) x) :=
by rw [←equiv.perm.mul_apply, ←equiv.perm.mul_apply, gpow_mul_comm]

/-! Lemmas about mixing `perm` with `equiv`. Because we have multiple ways to express
`equiv.refl`, `equiv.symm`, and `equiv.trans`, we want simp lemmas for every combination.
The assumption made here is that if you're using the group structure, you want to preserve it after
simp. -/

@[simp] lemma trans_one {α : Sort*} {β : Type*} (e : α ≃ β) : e.trans (1 : perm β) = e :=
equiv.trans_refl e

@[simp] lemma mul_refl (e : perm α) : e * equiv.refl α = e := equiv.trans_refl e

@[simp] lemma one_symm : (1 : perm α).symm = 1 := equiv.refl_symm

@[simp] lemma refl_inv : (equiv.refl α : perm α)⁻¹ = 1 := equiv.refl_symm

@[simp] lemma one_trans {α : Type*} {β : Sort*} (e : α ≃ β) : (1 : perm α).trans e = e :=
equiv.refl_trans e

@[simp] lemma refl_mul (e : perm α) : equiv.refl α * e = e := equiv.refl_trans e

@[simp] lemma inv_trans (e : perm α) : e⁻¹.trans e = 1 := equiv.symm_trans e

@[simp] lemma mul_symm (e : perm α) : e * e.symm = 1 := equiv.symm_trans e

@[simp] lemma trans_inv (e : perm α) : e.trans e⁻¹ = 1 := equiv.trans_symm e

@[simp] lemma symm_mul (e : perm α) : e.symm * e = 1 := equiv.trans_symm e

/-! Lemmas about `equiv.perm.sum_congr` re-expressed via the group structure. -/

@[simp] lemma sum_congr_mul {α β : Type*} (e : perm α) (f : perm β) (g : perm α) (h : perm β) :
  sum_congr e f * sum_congr g h = sum_congr (e * g) (f * h) :=
sum_congr_trans g h e f

@[simp] lemma sum_congr_inv {α β : Type*} (e : perm α) (f : perm β) :
  (sum_congr e f)⁻¹ = sum_congr e⁻¹ f⁻¹ :=
sum_congr_symm e f

@[simp] lemma sum_congr_one {α β : Type*} :
  sum_congr (1 : perm α) (1 : perm β) = 1 :=
sum_congr_refl

/-- `equiv.perm.sum_congr` as a `monoid_hom`, with its two arguments bundled into a single `prod`.

This is particularly useful for its `monoid_hom.range` projection, which is the subgroup of
permutations which do not exchange elements between `α` and `β`. -/
@[simps]
def sum_congr_hom (α β : Type*) :
  perm α × perm β →* perm (α ⊕ β) :=
{ to_fun := λ a, sum_congr a.1 a.2,
  map_one' := sum_congr_one,
  map_mul' := λ a b, (sum_congr_mul _ _ _ _).symm}

lemma sum_congr_hom_injective {α β : Type*} :
  function.injective (sum_congr_hom α β) :=
begin
  rintros ⟨⟩ ⟨⟩ h,
  rw prod.mk.inj_iff,
  split; ext i,
  { simpa using equiv.congr_fun h (sum.inl i), },
  { simpa using equiv.congr_fun h (sum.inr i), },
end

@[simp] lemma sum_congr_swap_one {α β : Type*} [decidable_eq α] [decidable_eq β] (i j : α) :
  sum_congr (equiv.swap i j) (1 : perm β) = equiv.swap (sum.inl i) (sum.inl j) :=
sum_congr_swap_refl i j

@[simp] lemma sum_congr_one_swap {α β : Type*} [decidable_eq α] [decidable_eq β] (i j : β) :
  sum_congr (1 : perm α) (equiv.swap i j) = equiv.swap (sum.inr i) (sum.inr j) :=
sum_congr_refl_swap i j

/-! Lemmas about `equiv.perm.sigma_congr_right` re-expressed via the group structure. -/

@[simp] lemma sigma_congr_right_mul {α : Type*} {β : α → Type*}
  (F : Π a, perm (β a)) (G : Π a, perm (β a)) :
  sigma_congr_right F * sigma_congr_right G = sigma_congr_right (F * G) :=
sigma_congr_right_trans G F

@[simp] lemma sigma_congr_right_inv {α : Type*} {β : α → Type*} (F : Π a, perm (β a)) :
  (sigma_congr_right F)⁻¹ = sigma_congr_right (λ a, (F a)⁻¹) :=
sigma_congr_right_symm F

@[simp] lemma sigma_congr_right_one {α : Type*} {β : α → Type*} :
  (sigma_congr_right (1 : Π a, equiv.perm $ β a)) = 1 :=
sigma_congr_right_refl

/-- `equiv.perm.sigma_congr_right` as a `monoid_hom`.

This is particularly useful for its `monoid_hom.range` projection, which is the subgroup of
permutations which do not exchange elements between fibers. -/
@[simps]
def sigma_congr_right_hom {α : Type*} (β : α → Type*) :
  (Π a, perm (β a)) →* perm (Σ a, β a) :=
{ to_fun := sigma_congr_right,
  map_one' := sigma_congr_right_one,
  map_mul' := λ a b, (sigma_congr_right_mul _ _).symm }

lemma sigma_congr_right_hom_injective {α : Type*} {β : α → Type*} :
  function.injective (sigma_congr_right_hom β) :=
begin
  intros x y h,
  ext a b,
  simpa using equiv.congr_fun h ⟨a, b⟩,
end

/-- `equiv.perm.subtype_congr` as a `monoid_hom`. -/
@[simps] def subtype_congr_hom (p : α → Prop) [decidable_pred p] :
  (perm {a // p a}) × (perm {a // ¬ p a}) →* perm α :=
{ to_fun := λ pair, perm.subtype_congr pair.fst pair.snd,
  map_one' := perm.subtype_congr.refl,
  map_mul' := λ _ _, (perm.subtype_congr.trans _ _ _ _).symm }

lemma subtype_congr_hom_injective (p : α → Prop) [decidable_pred p] :
  function.injective (subtype_congr_hom p) :=
begin
  rintros ⟨⟩ ⟨⟩ h,
  rw prod.mk.inj_iff,
  split;
  ext i;
  simpa using equiv.congr_fun h i
end

/-- If `e` is also a permutation, we can write `perm_congr`
completely in terms of the group structure. -/
@[simp] lemma perm_congr_eq_mul (e p : perm α) :
  e.perm_congr p = e * p * e⁻¹ := rfl

section extend_domain

/-! Lemmas about `equiv.perm.extend_domain` re-expressed via the group structure. -/

variables {β : Type*} (e : perm α) {p : β → Prop} [decidable_pred p] (f : α ≃ subtype p)

@[simp] lemma extend_domain_one : extend_domain 1 f = 1 :=
extend_domain_refl f

@[simp] lemma extend_domain_inv : (e.extend_domain f)⁻¹ = e⁻¹.extend_domain f := rfl

@[simp] lemma extend_domain_mul (e e' : perm α) :
  (e.extend_domain f) * (e'.extend_domain f) = (e * e').extend_domain f :=
extend_domain_trans _ _ _

end extend_domain

/-- If the permutation `f` fixes the subtype `{x // p x}`, then this returns the permutation
  on `{x // p x}` induced by `f`. -/
def subtype_perm (f : perm α) {p : α → Prop} (h : ∀ x, p x ↔ p (f x)) : perm {x // p x} :=
⟨λ x, ⟨f x, (h _).1 x.2⟩, λ x, ⟨f⁻¹ x, (h (f⁻¹ x)).2 $ by simpa using x.2⟩,
  λ _, by simp only [perm.inv_apply_self, subtype.coe_eta, subtype.coe_mk],
  λ _, by simp only [perm.apply_inv_self, subtype.coe_eta, subtype.coe_mk]⟩

@[simp] lemma subtype_perm_apply (f : perm α) {p : α → Prop} (h : ∀ x, p x ↔ p (f x))
  (x : {x // p x}) : subtype_perm f h x = ⟨f x, (h _).1 x.2⟩ := rfl

@[simp] lemma subtype_perm_one (p : α → Prop) (h : ∀ x, p x ↔ p ((1 : perm α) x)) :
  @subtype_perm α 1 p h = 1 :=
equiv.ext $ λ ⟨_, _⟩, rfl

/-- The inclusion map of permutations on a subtype of `α` into permutations of `α`,
  fixing the other points. -/
def of_subtype {p : α → Prop} [decidable_pred p] : perm (subtype p) →* perm α :=
{ to_fun := λ f,
  ⟨λ x, if h : p x then f ⟨x, h⟩ else x, λ x, if h : p x then f⁻¹ ⟨x, h⟩ else x,
  λ x, have h : ∀ h : p x, p (f ⟨x, h⟩), from λ h, (f ⟨x, h⟩).2,
    by { simp only [], split_ifs at *;
         simp only [perm.inv_apply_self, subtype.coe_eta, subtype.coe_mk, not_true, *] at * },
  λ x, have h : ∀ h : p x, p (f⁻¹ ⟨x, h⟩), from λ h, (f⁻¹ ⟨x, h⟩).2,
    by { simp only [], split_ifs at *;
         simp only [perm.apply_inv_self, subtype.coe_eta, subtype.coe_mk, not_true, *] at * }⟩,
  map_one' := begin ext, dsimp, split_ifs; refl, end,
  map_mul' := λ f g, equiv.ext $ λ x, begin
  by_cases h : p x,
  { have h₁ : p (f (g ⟨x, h⟩)), from (f (g ⟨x, h⟩)).2,
    have h₂ : p (g ⟨x, h⟩), from (g ⟨x, h⟩).2,
    simp only [h, h₂, coe_fn_mk, perm.mul_apply, dif_pos, subtype.coe_eta] },
  { simp only [h, coe_fn_mk, perm.mul_apply, dif_neg, not_false_iff] }
end }

lemma of_subtype_subtype_perm {f : perm α} {p : α → Prop} [decidable_pred p]
  (h₁ : ∀ x, p x ↔ p (f x)) (h₂ : ∀ x, f x ≠ x → p x) :
  of_subtype (subtype_perm f h₁) = f :=
equiv.ext $ λ x, begin
  rw [of_subtype, subtype_perm],
  by_cases hx : p x,
  { simp only [hx, coe_fn_mk, dif_pos, monoid_hom.coe_mk, subtype.coe_mk]},
  { haveI := classical.prop_decidable,
    simp only [hx, not_not.mp (mt (h₂ x) hx), coe_fn_mk, dif_neg, not_false_iff,
      monoid_hom.coe_mk] }
end

lemma of_subtype_apply_of_not_mem {p : α → Prop} [decidable_pred p]
  (f : perm (subtype p)) {x : α} (hx : ¬ p x) :
  of_subtype f x = x :=
dif_neg hx

lemma mem_iff_of_subtype_apply_mem {p : α → Prop} [decidable_pred p]
  (f : perm (subtype p)) (x : α) :
  p x ↔ p ((of_subtype f : α → α) x) :=
if h : p x then by simpa only [of_subtype, h, coe_fn_mk, dif_pos, true_iff, monoid_hom.coe_mk]
  using (f ⟨x, h⟩).2
else by simp [h, of_subtype_apply_of_not_mem f h]

@[simp] lemma subtype_perm_of_subtype {p : α → Prop} [decidable_pred p] (f : perm (subtype p)) :
  subtype_perm (of_subtype f) (mem_iff_of_subtype_apply_mem f) = f :=
equiv.ext $ λ ⟨x, hx⟩, by { dsimp [subtype_perm, of_subtype],
  simp only [show p x, from hx, dif_pos, subtype.coe_eta] }

instance perm_unique {n : Type*} [unique n] : unique (equiv.perm n) :=
{ default := 1,
  uniq := λ σ, equiv.ext (λ i, subsingleton.elim _ _) }

@[simp] lemma default_perm {n : Type*} : default (equiv.perm n) = 1 := rfl

end perm

section swap
variables [decidable_eq α]

@[simp] lemma swap_inv (x y : α) : (swap x y)⁻¹ = swap x y := rfl

@[simp] lemma swap_mul_self (i j : α) : swap i j * swap i j = 1 := swap_swap i j

lemma swap_mul_eq_mul_swap (f : perm α) (x y : α) : swap x y * f = f * swap (f⁻¹ x) (f⁻¹ y) :=
equiv.ext $ λ z, begin
  simp only [perm.mul_apply, swap_apply_def],
  split_ifs;
  simp only [perm.apply_inv_self, *, perm.eq_inv_iff_eq, eq_self_iff_true, not_true] at *
end

lemma mul_swap_eq_swap_mul (f : perm α) (x y : α) : f * swap x y = swap (f x) (f y) * f :=
by rw [swap_mul_eq_mul_swap, perm.inv_apply_self, perm.inv_apply_self]

lemma swap_apply_apply (f : perm α) (x y : α) : swap (f x) (f y) = f * swap x y * f⁻¹ :=
by rw [mul_swap_eq_swap_mul, mul_inv_cancel_right]

/-- Left-multiplying a permutation with `swap i j` twice gives the original permutation.

  This specialization of `swap_mul_self` is useful when using cosets of permutations.
-/
@[simp]
lemma swap_mul_self_mul (i j : α) (σ : perm α) : equiv.swap i j * (equiv.swap i j * σ) = σ :=
by rw [←mul_assoc, swap_mul_self, one_mul]

/-- Right-multiplying a permutation with `swap i j` twice gives the original permutation.

  This specialization of `swap_mul_self` is useful when using cosets of permutations.
-/
@[simp]
lemma mul_swap_mul_self (i j : α) (σ : perm α) : (σ * equiv.swap i j) * equiv.swap i j = σ :=
by rw [mul_assoc, swap_mul_self, mul_one]

/-- A stronger version of `mul_right_injective` -/
@[simp]
lemma swap_mul_involutive (i j : α) : function.involutive ((*) (equiv.swap i j)) :=
swap_mul_self_mul i j

/-- A stronger version of `mul_left_injective` -/
@[simp]
lemma mul_swap_involutive (i j : α) : function.involutive (* (equiv.swap i j)) :=
mul_swap_mul_self i j

@[simp] lemma swap_eq_one_iff {i j : α} : swap i j = (1 : perm α) ↔ i = j :=
swap_eq_refl_iff

lemma swap_mul_eq_iff {i j : α} {σ : perm α} : swap i j * σ = σ ↔ i = j :=
⟨(assume h, have swap_id : swap i j = 1 := mul_right_cancel (trans h (one_mul σ).symm),
  by {rw [←swap_apply_right i j, swap_id], refl}),
(assume h, by erw [h, swap_self, one_mul])⟩

lemma mul_swap_eq_iff {i j : α} {σ : perm α} : σ * swap i j = σ ↔ i = j :=
⟨(assume h, have swap_id : swap i j = 1 := mul_left_cancel (trans h (one_mul σ).symm),
  by {rw [←swap_apply_right i j, swap_id], refl}),
(assume h, by erw [h, swap_self, mul_one])⟩

lemma swap_mul_swap_mul_swap {x y z : α} (hwz: x ≠ y) (hxz : x ≠ z) :
  swap y z * swap x y * swap y z = swap z x :=
equiv.ext $ λ n, by { simp only [swap_apply_def, perm.mul_apply], split_ifs; cc }

end swap

end equiv


import Mathlib.Tactic.Basic

/-!
## Forward Reasoning with Tactics

Many users, including most of the mathematicians that form the majority of Lean’s user community,
prefer the tactic mode. But even in tactic mode, it can be useful to reason in a forward fashion,
mixing forward and backward reasoning steps.

The structured proof commands `have`, `let`, and `calc` are also available as tactics,
making this possible.

The following example demonstrates the `have` and `let` tactics on a lemma we
have seen several times already:
-/
lemma prop_comp3 (a b c : Prop) (hab : a → b) (hbc : b → c) :
a → c := by
  intro ha
  have hb : b :=
  hab ha
  let c' := c
  have hc : c' :=
  hbc hb
  exact hc
/-!
**have**
```
have [[name :] proposition] :=
    proof
```
The `have` tactic lets us state and prove an intermediate lemma in tactic mode.
Afterwards, the lemma is available as a hypothesis in the goal state.

**let**
```
let name [: type] := term
```
The `let` tactic lets us introduce a local definition in tactic mode. Afterwards, the
defined symbol and its definition are available in the goal state.

**calc**

```lean
calc
  term₀ op₁ term₁ : proof1
  _     op₂ term₂ : proof₂
  ...
  _     opₙ termₙ : proofₙ
```

The `calc` tactic lets us enter a [calculational proof](./CalculationProofs.lean.md) in tactic mode.
The tactic has the same syntax as the structured proof command of the same name. We can regard
`apply calc . . . `, where `calc` is a tactic, as an alias for `apply (exact calc . . .)`,
where `calc` is the structured proof command described above.

-/


/-
Copyright (c) 2022 Julian Kuelshammer. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Julian Kuelshammer
-/

import easy_mode.sheet08

/-

# The other way round, a function from an equivalence relation

On the previous sheet we saw that given a (surjective) function `f : X → Y` we can produce
an equivalence relation `∼` on `X` such that `x ≈ x'` iff `f (x) = f (x')`. On this sheet
we will see that Lean can go the other way round. For every type `X` and any
equivalence relation `≈` there exists a type `Y` and

- a surjective function `q : X → Y` such that
- `x ≈ x'` iff `q (x) = q (x')`.

There are different ways to construct such a `Y`, depending on the situation some are
easier than others. Lean (and that seems to be special compared to other interactive
theorem provers) has an inbuilt construction `quotient s` for a setoid `s` (recall that
a setoid is just a fancy way of saying a set together with an equivalence relation on it).
What is important here is not how Lean's choice of implementation of such a `Y` and `g`
is, but the API connected to it is.
-/

/- Let's set notation for our model of the integers as the quotient of the setoid s
  we defined on sheet07. -/

notation `myint` := quotient s

-- `setoid` is a class, so `s` should not just be a definition, we should
-- make it an instance by tagging it with the `instance` attribute
attribute [instance] s

-- Now we can use the notation `≈` for the equivalence relations `R`
-- and `⟦x⟧` for the element of `myint` corresponding to the pair `(a,b)` in `ℕ²`.

-- For a type `X` and a setoid structure `s` on `X` there is a function
-- `quotient.mk : X → quotient s`, the function `q` we were after. The brackets ⟦ ⟧ we
-- were using before are just notation for this function, i.e. `quotient.mk x = ⟦x⟧`.
-- Let's see that this is true by definition.

example (x : ℕ × ℕ) : quotient.mk x = ⟦x⟧ :=
begin
  sorry
end

-- Furthermore, `≈` is just notation for `R`
-- (this is handy to know; let's give it a name so we can rewrite it)
lemma equiv_def (r s : ℕ × ℕ) : r ≈ s ↔ r.1 + s.2 = s.1 + r.2 :=
begin
  sorry
end

-- One of our demands was that the function `q` is surjective. Let's try to prove that.
lemma q_surj : function.surjective (λ (r : ℕ × ℕ), quotient.mk r) :=
begin
  sorry
end

-- The second property we were after, namely that `x ≈ x'` iff `q(x) = q(x')` is called `quotient.eq`.

example (r s : ℕ × ℕ) : ⟦r⟧ = ⟦s⟧ ↔ r ≈ s :=
begin
  sorry -- so `rw quotient.eq` is often useful
end

-- Both implications also have names

example (r s : ℕ × ℕ) : ⟦r⟧ = ⟦s⟧ → r ≈ s :=
begin
  sorry
end

example (r s : ℕ × ℕ) : r ≈ s → ⟦r⟧ = ⟦s⟧ :=
begin
  sorry
end


import data.real.basic
import algebra.pi_instances

set_option pp.beta true

/-
In this file, we'll learn about the ∀ quantifier, and the disjunction
operator ∨ (logical OR).

Let P be a predicate on a type X. This means for every mathematical
object x with type X, we get a mathematical statement P x.
In Lean, P x has type Prop.

Lean sees a proof h of `∀ x, P x` as a function sending any `x : X` to
a proof `h x` of `P x`.
This already explains the main way to use an assumption or lemma which
starts with a ∀.

In order to prove `∀ x, P x`, we use `intros x` to fix an arbitrary object
with type X, and call it x.

Note also we don't need to give the type of x in the expression `∀ x, P x`
as long as the type of P is clear to Lean, which can then infer the type of x.

Let's define two predicates to play with ∀.
-/

def even_fun (f : ℝ → ℝ) := ∀ x, f (-x) = f x

#check even_fun

def odd_fun (f : ℝ → ℝ) := ∀ x, f (-x) = -f x

#check odd_fun

/-
In the next proof, we also take the opportunity to introduce the
`unfold` tactic, which simply unfolds definitions. Here this is purely
for didactic reason, Lean doesn't need those `unfold` invocations.
We will also use `rfl` which is a term proving equalities that are true
by definition (in a very strong sense to be discussed later).
-/
example (f g : ℝ → ℝ) : even_fun f → even_fun g →  even_fun (f + g) :=
begin
  unfold even_fun,
  intros hf hg x,
  calc
  (f + g) (-x) = f (-x) + g (-x) : rfl
  ...          = f x + g x       : by rw [hf x, hg x],
end

example (f g : ℝ → ℝ) : even_fun f → even_fun g →  even_fun (f + g) :=
begin
  -- Assume f is even
  intros hf,
  -- which means ∀ x, f (-x) = f x
  unfold even_fun at hf,
  -- and the same for g
  intros hg,
  unfold even_fun at hg,
  -- We need to prove ∀ x, (f+g)(-x) = (f+g)(x)
  unfold even_fun,
  -- Let x be any real number
  intros x,
  -- and let's compute
  calc (f + g) (-x) = f (-x) + g (-x) : rfl
  ... = f x + g (-x) : by rw hf x
  ... = f x + g x : by rw hg x
  ... = (f + g) x : rfl
end

/-
In the preceding proof, all `unfold` lines are purely for
psychological comfort.

Sometimes unfolding is necessary because we want to apply a tactic
that operates purely on the syntactical level.
The main such tactic is `rw`.

The same property of `rw` explain why the first computation line
is necessary, although its proof is simply `rfl`.
Before that line, `rw hf x` won't find anything like `f (-x)` hence
will give up.
The last line is not necessary however, since it only proves
something that is true by definition, and is not followed by
a `rw`.

Also, Lean doesn't need to be told that hf should be specialized to
x before rewriting, exactly as in the first file 01_equality_rewriting.
We can also gather several rewrites using a list of expressions.

Hence we can compress the above proof to:
-/

example (f g : ℝ → ℝ) : even_fun f → even_fun g →  even_fun (f + g) :=
begin
  intros hf hg x,
  calc (f + g) (-x) = f (-x) + g (-x) : rfl
  ...               = f x + g x       : by rw [hf, hg]
end

/-
Note that the tactic state displays changes when we
move the cursor inside the list of expressions given to `rw`.

Now let's practice.
-/

-- 0023
example (f g : ℝ → ℝ) : even_fun f → even_fun (g ∘ f) :=
begin
  intros hf x,
  calc
  (g ∘ f) (-x) = g (f (-x)) : rfl
  ...          = g (f x)    : by rw hf,
end

-- 0024
example (f g : ℝ → ℝ) : odd_fun f → odd_fun g →  odd_fun (g ∘ f) :=
begin
  intros hf hg x,
  calc
  (g ∘ f) (-x) = g (f (-x)) : rfl
  ...          = -(g (f x)) : by rw [hf, hg],
end

/-
Let's have more quantifiers, and play with forward and backward reasoning.

In the next definitions, note how `∀ x₁, ∀ x₂` is abreviated to `∀ x₁ x₂`.
-/

def non_decreasing (f : ℝ → ℝ) := ∀ x₁ x₂, x₁ ≤ x₂ → f x₁ ≤ f x₂

def non_increasing (f : ℝ → ℝ) := ∀ x₁ x₂, x₁ ≤ x₂ → f x₁ ≥ f x₂

example (f g : ℝ → ℝ) (hf : non_decreasing f) (hg : non_decreasing g) :
  non_decreasing (g ∘ f) :=
assume x₁ x₂ h,
have f x₁ ≤ f x₂, from hf _ _ h,
show g (f x₁) ≤ g (f x₂), from hg _ _ this

/- Let's be very explicit and use forward reasonning first. -/
example (f g : ℝ → ℝ) (hf : non_decreasing f) (hg : non_decreasing g) : non_decreasing (g ∘ f) :=
begin
  -- Let x₁ and x₂ be real numbers such that x₁ ≤ x₂
  intros x₁ x₂ h,
  -- Since f is non-decreasing, f x₁ ≤ f x₂.
  have step₁ :  f x₁ ≤ f x₂,
    exact hf x₁ x₂ h,
  -- Since g is non-decreasing, we then get g (f x₁) ≤ g (f x₂).
  exact hg (f x₁) (f x₂) step₁,
end

/-
In the above proof, note how inconvenient it is to specify x₁ and x₂ in `hf x₁ x₂ h` since
they could be inferred from the type of h.
We could have written `hf _ _ h` and Lean would have filled the holes denoted by _.

Even better we could have written the definition
of `non_decreasing` as: ∀ {x₁ x₂}, x₁ ≤ x₂ → f x₁ ≤ f x₂, with curly braces to denote
implicit arguments.

But let's leave that aside for now. One possible variation on the above proof is to
use the `specialize` tactic to replace hf by its specialization to the relevant value.
 -/

example (f g : ℝ → ℝ) (hf : non_decreasing f) (hg : non_decreasing g) :
  non_decreasing (g ∘ f) :=
begin
  intros x₁ x₂ h,
  specialize hf _ _ h,
  exact hg _ _ hf,
end

example (f g : ℝ → ℝ) (hf : non_decreasing f) (hg : non_decreasing g) : non_decreasing (g ∘ f) :=
begin
  intros x₁ x₂ h,
  specialize hf x₁ x₂ h,
  exact hg (f x₁) (f x₂) hf,
end

/-
This `specialize` tactic is mostly useful for exploration, or in preparation for rewriting
in the assumption. One can very often replace its use by using more complicated expressions
directly involving the original assumption, as in the next variation:
-/
example (f g : ℝ → ℝ) (hf : non_decreasing f) (hg : non_decreasing g) : non_decreasing (g ∘ f) :=
begin
  intros x₁ x₂ h,
  exact hg (f x₁) (f x₂) (hf x₁ x₂ h),
end

/-
Since the above proof uses only `intros` and `exact`, we could very easily replace it by the
raw proof term:
-/
example (f g : ℝ → ℝ) (hf : non_decreasing f) (hg : non_decreasing g) : non_decreasing (g ∘ f) :=
λ _ _ h, hg (f _) (f _) (hf _ _ h)

/-
Of course the above proof is difficult to decipher. The principle in mathlib is to use
such a proof when the result is obvious and you don't want to read the proof anyway.

Instead of pursuing this style, let's see how backward reasoning would look like here.
As usual with this style, we use `apply` and enjoy Lean specializing assumptions for us
using unification.
-/

example (f g : ℝ → ℝ) (hf : non_decreasing f) (hg : non_decreasing g) :
  non_decreasing (g ∘ f) :=
begin
  intros _ _ _,
  apply hg,
  apply hf,
  assumption
end

example (f g : ℝ → ℝ) (hf : non_decreasing f) (hg : non_decreasing g) : non_decreasing (g ∘ f) :=
begin
  -- Let x₁ and x₂ be real numbers such that x₁ ≤ x₂
  intros x₁ x₂ h,
  -- We need to prove (g ∘ f) x₁ ≤ (g ∘ f) x₂.
  -- Since g is non-decreasing, it suffices to prove f x₁ ≤ f x₂
  apply hg,
  -- which follows from our assumption on f
  apply hf,
  -- and on x₁ and x₂
  exact h
end

-- 0025
example (f g : ℝ → ℝ) (hf : non_decreasing f) (hg : non_increasing g) : non_increasing (g ∘ f) :=
begin
  intros x₁ x₂ h,
  apply hg,
  apply hf,
  assumption,
end

example (f g : ℝ → ℝ) (hf : non_decreasing f) (hg : non_increasing g) : non_increasing (g ∘ f) :=
begin
  intros x₁ x₂ h,
  exact hg (f x₁) (f x₂) (hf x₁ x₂ h)
end

/-
Let's switch to disjunctions now. Lean denotes by ∨ the
logical OR operator.

In order to make use of an assumption
  hyp : P ∨ Q
we use the cases tactic:
  cases hyp with hP hQ
which creates two proof branches: one branch assuming hP : P,
and one branch assuming hQ : Q.

In order to directly prove a goal P ∨ Q,
we use either the `left` tactic and prove P or the `right`
tactic and prove Q.

In the next proof we use `ring` and `linarith` to get rid of
easy computations or inequalities, as well as one lemma:

  mul_eq_zero : a*b = 0 ↔ a = 0 ∨ b = 0
-/

example (a b : ℝ) : a = a*b → a = 0 ∨ b = 1 :=
begin
  intro h,
  have : a*(1 - b) = 0, by calc
    a*(1 - b) = a - a*b : by ring
    ...       = 0       : by linarith,
  rw mul_eq_zero at this,
  cases this with ha hb,
  { left, assumption },
  { right, linarith },
end

example (a b : ℝ) : a = a*b → a = 0 ∨ b = 1 :=
begin
  intro hyp,
  have H : a*(1 - b) = 0,
  { calc a*(1 - b) = a - a*b : by ring
               ... = 0       : by linarith, },
  rw mul_eq_zero at H,
  cases H with Ha Hb,
  { left,
    exact Ha, },
  { right,
    linarith, },
end

-- 0026
example (x y : ℝ) : x^2 = y^2 → x = y ∨ x = -y :=
begin
  intro h,
  have : (x - y) * (x + y) = 0, by calc
    (x - y) * (x + y) = x^2 - y^2 : by ring
    ...               = y^2 - y^2 : by rw h
    ...               = 0         : by ring,
  rw mul_eq_zero at this,
  cases this,
  { left, linarith },
  { right, linarith }
end

/-
In the next exercise, we can use:
  eq_or_lt_of_le : x ≤ y → x = y ∨ x < y
-/

-- 0027
example (f : ℝ → ℝ) : non_decreasing f ↔ ∀ x y, x < y → f x ≤ f y :=
begin
  split,
  { intros h₁ x y h₂,
    apply h₁,
    linarith },
  { intros h₁ x y h₂,
    cases eq_or_lt_of_le h₂,
    { rw h },
    { apply h₁, exact h } },
end

/-
In the next exercise, we can use:
  le_total x y : x ≤ y ∨ y ≤ x
-/

-- 0028
example (f : ℝ → ℝ) (h : non_decreasing f) (h' : ∀ x, f (f x) = x) : ∀ x, f x = x :=
begin
  intro x,
  have : f (f x) = x, by rw h',
  have : f x ≤ x ∨ x ≤ f x, from le_total _ _,
  cases this with hx hx;
  { specialize h _ _ hx,
    rw h' at h, linarith },
end

-- 0028
example (f : ℝ → ℝ) (h : non_decreasing f) (h' : ∀ x, f (f x) = x) : ∀ x, f x = x :=
begin
  -- sorry
  intro x,
  have : f (f x) = x,
  { rw h' },
  have : (f x ≤ x) ∨ (x ≤ f x),
  { exact le_total (f x) x },
  cases this with hx hx,
  { have f1: f (f x) ≤ f x,
    { exact h (f x) x hx, },
    rw h' at f1,
    linarith, },
  { have f1: f x ≤ f (f x),
    { exact h x (f x) hx, },
    rw h' x at f1,
    linarith, },
  -- sorry
end


import data.real.basic
import algebra.pi_instances

set_option pp.beta true

/-
In this file, we'll learn about the ∀ quantifier, and the disjunction
operator ∨ (logical OR).

Let P be a predicate on a type X. This means for every mathematical
object x with type X, we get a mathematical statement P x.
In Lean, P x has type Prop.

Lean sees a proof h of `∀ x, P x` as a function sending any `x : X` to
a proof `h x` of `P x`.
This already explains the main way to use an assumption or lemma which
starts with a ∀.

In order to prove `∀ x, P x`, we use `intros x` to fix an arbitrary object
with type X, and call it x.

Note also we don't need to give the type of x in the expression `∀ x, P x`
as long as the type of P is clear to Lean, which can then infer the type of x.

Let's define two predicates to play with ∀.
-/

def even_fun (f : ℝ → ℝ) := ∀ x, f (-x) = f x

def odd_fun (f : ℝ → ℝ) := ∀ x, f (-x) = -f x

/-
In the next proof, we also take the opportunity to introduce the
`unfold` tactic, which simply unfolds definitions. Here this is purely
for didactic reason, Lean doesn't need those `unfold` invocations.
We will also use `rfl` which is a term proving equalities that are true
by definition (in a very strong sense to be discussed later).
-/

example (f g : ℝ → ℝ) : even_fun f → even_fun g →  even_fun (f + g) :=
begin
  -- Assume f is even
  intros hf,
  -- which means ∀ x, f (-x) = f x
  unfold even_fun at hf,
  -- and the same for g
  intros hg,
  unfold even_fun at hg,
  -- We need to prove ∀ x, (f+g)(-x) = (f+g)(x)
  unfold even_fun,
  -- Let x be any real number
  intros x,
  -- and let's compute
  calc (f + g) (-x) = f (-x) + g (-x) : rfl
  ... = f x + g (-x) : by rw hf x
  ... = f x + g x : by rw hg x
  ... = (f + g) x : rfl
end

/-
In the preceding proof, all `unfold` lines are purely for
psychological comfort.

Sometimes unfolding is necessary because we want to apply a tactic
that operates purely on the syntactical level.
The main such tactic is `rw`.

The same property of `rw` explain why the first computation line
is necessary, although its proof is simply `rfl`.
Before that line, `rw hf x` won't find anything like `f (-x)` hence
will give up.
The last line is not necessary however, since it only proves
something that is true by definition, and is not followed by
a `rw`.

Also, Lean doesn't need to be told that hf should be specialized to
x before rewriting, exactly as in the first file 01_equality_rewriting.
We can also gather several rewrites using a list of expressions.

Hence we can compress the above proof to:
-/

example (f g : ℝ → ℝ) : even_fun f → even_fun g →  even_fun (f + g) :=
begin
  intros hf hg x,
  calc (f + g) (-x) = f (-x) + g (-x) : rfl
  ... = f x + g x : by rw [hf, hg]
end

/-
Note that the tactic state displays changes when we
move the cursor inside the list of expressions given to `rw`.

Now let's practice.
-/

-- 0023
example (f g : ℝ → ℝ) : even_fun f → even_fun (g ∘ f) :=
begin
  intros hf x,
  calc (g ∘ f) (-x) = g (f (-x)) : rfl
       ...          = g (f x)    : by rw hf,
end

-- 0024
example (f g : ℝ → ℝ) : odd_fun f → odd_fun g →  odd_fun (g ∘ f) :=
begin
  intros hf hg x,
  calc (g ∘ f) (-x) = g (f (-x)) : rfl
       ...          = -(g ∘ f) x : by rw [hf, hg],
end

/-
Let's have more quantifiers, and play with forward and backward reasoning.

In the next definitions, note how `∀ x₁, ∀ x₂` is abreviated to `∀ x₁ x₂`.
-/

def non_decreasing (f : ℝ → ℝ) := ∀ x₁ x₂, x₁ ≤ x₂ → f x₁ ≤ f x₂

def non_increasing (f : ℝ → ℝ) := ∀ x₁ x₂, x₁ ≤ x₂ → f x₁ ≥ f x₂

/- Let's be very explicit and use forward reasonning first. -/
example (f g : ℝ → ℝ) (hf : non_decreasing f) (hg : non_decreasing g) : non_decreasing (g ∘ f) :=
begin
  -- Let x₁ and x₂ be real numbers such that x₁ ≤ x₂
  intros x₁ x₂ h,
  -- Since f is non-decreasing, f x₁ ≤ f x₂.
  have step₁ :  f x₁ ≤ f x₂,
    exact hf x₁ x₂ h,
  -- Since g is non-decreasing, we then get g (f x₁) ≤ g (f x₂).
  exact hg (f x₁) (f x₂) step₁,
end

/-
In the above proof, note how inconvenient it is to specify x₁ and x₂ in `hf x₁ x₂ h` since
they could be inferred from the type of h.
We could have written `hf _ _ h` and Lean would have filled the holes denoted by _.

Even better we could have written the definition
of `non_decreasing` as: ∀ {x₁ x₂}, x₁ ≤ x₂ → f x₁ ≤ f x₂, with curly braces to denote
implicit arguments.

But let's leave that aside for now. One possible variation on the above proof is to
use the `specialize` tactic to replace hf by its specialization to the relevant value.
 -/

example (f g : ℝ → ℝ) (hf : non_decreasing f) (hg : non_decreasing g) : non_decreasing (g ∘ f) :=
begin
  intros x₁ x₂ h,
  specialize hf x₁ x₂ h,
  exact hg (f x₁) (f x₂) hf,
end

/-
This `specialize` tactic is mostly useful for exploration, or in preparation for rewriting
in the assumption. One can very often replace its use by using more complicated expressions
directly involving the original assumption, as in the next variation:
-/
example (f g : ℝ → ℝ) (hf : non_decreasing f) (hg : non_decreasing g) : non_decreasing (g ∘ f) :=
begin
  intros x₁ x₂ h,
  exact hg (f x₁) (f x₂) (hf x₁ x₂ h),
end

/-
Since the above proof uses only `intros` and `exact`, we could very easily replace it by the
raw proof term:
-/
example (f g : ℝ → ℝ) (hf : non_decreasing f) (hg : non_decreasing g) : non_decreasing (g ∘ f) :=
λ x₁ x₂ h, hg (f x₁) (f x₂) (hf x₁ x₂ h)

/-
Of course the above proof is difficult to decipher. The principle in mathlib is to use
such a proof when the result is obvious and you don't want to read the proof anyway.

Instead of pursuing this style, let's see how backward reasoning would look like here.
As usual with this style, we use `apply` and enjoy Lean specializing assumptions for us
using unification.
-/

example (f g : ℝ → ℝ) (hf : non_decreasing f) (hg : non_decreasing g) : non_decreasing (g ∘ f) :=
begin
  -- Let x₁ and x₂ be real numbers such that x₁ ≤ x₂
  intros x₁ x₂ h,
  -- We need to prove (g ∘ f) x₁ ≤ (g ∘ f) x₂.
  -- Since g is non-decreasing, it suffices to prove f x₁ ≤ f x₂
  apply hg,
  -- which follows from our assumption on f
  apply hf,
  -- and on x₁ and x₂
  exact h
end

-- 0025
example (f g : ℝ → ℝ) (hf : non_decreasing f) (hg : non_increasing g) : non_increasing (g ∘ f) :=
begin
  intros x₁ x₂ h,
  apply hg,
  exact hf x₁ x₂ h,
end

/-
Let's switch to disjunctions now. Lean denotes by ∨ the
logical OR operator.

In order to make use of an assumption
  hyp : P ∨ Q
we use the cases tactic:
  cases hyp with hP hQ
which creates two proof branches: one branch assuming hP : P,
and one branch assuming hQ : Q.

In order to directly prove a goal P ∨ Q,
we use either the `left` tactic and prove P or the `right`
tactic and prove Q.

In the next proof we use `ring` and `linarith` to get rid of
easy computations or inequalities, as well as one lemma:

  mul_eq_zero : a*b = 0 ↔ a = 0 ∨ b = 0
-/

example (a b : ℝ) : a = a*b → a = 0 ∨ b = 1 :=
begin
  intro hyp,
  have H : a*(1 - b) = 0,
  { calc a*(1 - b) = a - a*b : by ring
               ... = 0       : by linarith, },
  rw mul_eq_zero at H,
  cases H with Ha Hb,
  { left,
    exact Ha, },
  { right,
    linarith, },
end

-- 0026
example (x y : ℝ) : x^2 = y^2 → x = y ∨ x = -y :=
begin
  intro h,
  replace h : (x-y) * (x+y) = 0,
    calc (x-y) * (x+y) = x^2 - y^2 : by ring
         ...           = y^2 - y^2 : by rw h
         ...           = 0         : by ring,
  cases mul_eq_zero.mp h with h₁ h₂,
    left, linarith,
  right, linarith,
end

/-
In the next exercise, we can use:
  eq_or_lt_of_le : x ≤ y → x = y ∨ x < y
-/

-- 0027
example (f : ℝ → ℝ) : non_decreasing f ↔ ∀ x y, x < y → f x ≤ f y :=
begin
  split,
    intros hf x y hxy,
    apply hf,
    linarith,
  intros hf x y hxy,
  cases eq_or_lt_of_le hxy,
    subst h,
  exact hf x y h,
end

/-
In the next exercise, we can use:
  le_total x y : x ≤ y ∨ y ≤ x
-/

-- 0028
example (f : ℝ → ℝ) (h : non_decreasing f) (h' : ∀ x, f (f x) = x) : ∀ x, f x = x :=
begin
  intro x,
  have hff : f (f x) = x, exact h' x,
  cases le_total (f (f x)) (f x) with h'' h'',
  repeat {
    have, exact h _ _ h'',
    rw hff at this,
    linarith,
  },
end


import tactic
import data.nat.basic
import data.finset.basic
import algebra.big_operators
open_locale big_operators

open nat finset

/- If we want to talk about finite sums then we need to use `finsets`

If `n : ℕ` then `range n` is the finset consisting of {0,1,..,n-1}`
So in particular `range n.succ = {0,1,...,n}`
-/

/-
Division (and subtraction) over ℕ can be painful in Lean.
Clearing denominators can be be very helpful. -/

lemma clear_denom {n k m: ℕ} (hnz : 0 < m): m * n = k → n = k / m :=
begin
  intro h,
  rw ←h ,
  rw mul_div_right n hnz,
end

lemma sum1 (n : ℕ) :  ∑ i in range n.succ, i  = (n * (n+1))/2:=
begin
  apply clear_denom (by norm_num :0 < 2),
  induction n with n hn,
  {
    refl,
  },
  {
   rw [sum_range_succ, mul_add, hn,succ_eq_add_one],
   ring,
  },
end

lemma sum2 (n : ℕ ) : ∑ i in range n.succ, i^2  = (n * (n+1)*(2*n+1))/6:=
begin
  apply clear_denom (by norm_num : 0 < 6),
   induction n with n hn,
  {
    refl,
  },
  {
   rw [sum_range_succ, mul_add, hn,succ_eq_add_one],
   ring,
  },
end

lemma sum3 (n : ℕ ) : ∑ i in range n.succ, i^3  = ((n * (n+1))^2)/4:=
begin
  apply clear_denom (by norm_num : 0 < 4),
   induction n with n hn,
  {
    refl,
  },
  {
   rw [sum_range_succ, mul_add, hn,succ_eq_add_one],
   ring,
  },
end

-- Unfortunately as soon as subtraction enters the picture things are more complicated
lemma sum4 (n : ℕ ) : ∑ i in range n.succ, i^4  = (n*(n + 1)*(2*n + 1)*(3*n^2 + 3*n - 1))/30:=
begin
  apply clear_denom (by norm_num : 0 < 30),
  induction n with n hn,
  {
    refl,
  },
  {
    cases n with n hn,
    refl,
    -- this next intermediate result will allow us to remove all subtraction
    have h3: ∀(m:ℕ),3 *m.succ - 1 = 3 * m + 2,
    { intro m, rw mul_succ, refl,},
    rw [sum_range_succ, mul_add, hn, succ_eq_add_one,succ_eq_add_one],
    -- the next line banishes all subtraction
    rw [nat.add_sub_assoc, nat.add_sub_assoc, h3,h3],
    -- no more subtraction!
    ring, -- solves the main goal
    --leaving us to justify the two uses of nat.add_sub_assoc
    rw [mul_succ], linarith,
    rw [mul_succ], linarith,
  },
end

/-
# Coercions and casts
Lean understands the type ℚ and allows us to coerce naturals into rationals
Once we coerce the LHS of an equality Lean automatically coerces the RHS
since only terms of the same type can be compared with `=` so there is no other option.

You will see `↑0`,`↑n` etc in the Infoview during the next proof.

These are the results of coercing 0 and n respectively, from ℕ to ℚ,

Lean knows that `↑0` is just `0` in ℚ  but you need to tell it to use this fact
with  `cast_zero` -/

lemma sum4Q (n : ℕ ) : ∑ i in range n.succ, (i^4 : ℚ)  = (n*(n + 1)*(2*n + 1)*(3*n^2 + 3*n - 1))/30:=
begin
  induction n with n hn,
  {
    rw [range_one,sum_singleton,cast_zero,zero_mul,zero_mul,
        zero_mul,zero_div,zero_pow zero_lt_four],
  },
  {
    rw [sum_range_succ, hn ],
    field_simp, ring,
  },
end

lemma sum6Q (n : ℕ ) : (∑ i in range n.succ, i^6 : ℚ)  = (n*(n + 1)*(2*n + 1)*(3*n^4 + 6*n^3 - 3*n + 1))/42:=
begin
  induction n with n hn,
  {
    rw [range_one,sum_singleton,cast_zero,zero_mul,zero_mul,
        zero_mul,zero_div,zero_pow],
    norm_num,
  },
  {
    rw [sum_range_succ, hn],
    field_simp, ring,
  },
end


import data.real.basic
import data.int.parity

/-
In this file, we learn how to handle the ∃ quantifier.

In order to prove `∃ x, P x`, we give some x₀ using tactic `use x₀` and
then prove `P x₀`. This x₀ can be an object from the local context
or a more complicated expression.
-/
example : ∃ n : ℕ, 8 = 2*n :=
begin
  use 4,
  refl,  -- this is the tactic analogue of the rfl proof term
end

/-
In order to use `h : ∃ x, P x`, we use the `cases` tactic to fix
one x₀ that works.

Again h can come straight from the local context or can be a more
complicated expression.
-/
example (n : ℕ) (h : ∃ k : ℕ, n = k + 1) : n > 0 :=
begin
  -- Let's fix k₀ such that n = k₀ + 1.
  cases h with k₀ hk₀,
  -- It now suffices to prove k₀ + 1 > 0.
  rw hk₀,
  -- and we have a lemma about this
  exact nat.succ_pos k₀,
end

/-
The next exercises use divisibility in ℤ (beware the ∣ symbol which is
not ASCII).

By definition, a ∣ b ↔ ∃ k, b = a*k, so you can prove a ∣ b using the
`use` tactic.
-/

-- Until the end of this file, a, b and c will denote integers, unless
-- explicitly stated otherwise
variables (a b c : ℤ)

-- 0029
example (h₁ : a ∣ b) (h₂ : b ∣ c) : a ∣ c :=
begin
  sorry
end

/-
A very common pattern is to have an assumption or lemma asserting
  h : ∃ x, y = ...
and this is used through the combo:
  cases h with x hx,
  rw hx at ...
The tactic `rcases` allows us to do recursive `cases`, as indicated by its name,
and also simplifies the above combo when the name hx is replaced by the special
name `rfl`, as in the following example.
It uses the anonymous constructor angle brackets syntax.
-/

example (h1 : a ∣ b) (h2 : a ∣ c) : a ∣ b+c :=
begin
  rcases h1 with ⟨k, rfl⟩,
  rcases h2 with ⟨l, rfl⟩,
  use k+l,
  ring,
end

/-
You can use the same `rfl` trick with the `rintros` tactic.
-/

example : a ∣ b → a ∣ c → a ∣ b+c :=
begin
  rintros ⟨k, rfl⟩ ⟨l, rfl⟩,
  use k+l,
  ring,
end

-- 0030
example : 0 ∣ a ↔ a = 0 :=
begin
  sorry
end

/-
We can now start combining quantifiers, using the definition

  surjective (f : X → Y) := ∀ y, ∃ x, f x = y

-/
open function

-- In the remaining of this file, f and g will denote functions from
-- ℝ to ℝ.
variables (f g : ℝ → ℝ)

-- 0031
example (h : surjective (g ∘ f)) : surjective g :=
begin
  sorry
end

/-
The above exercise can be done in three lines. Try to do the
next exercise in four lines.
-/

-- 0032
example (hf : surjective f) (hg : surjective g) : surjective (g ∘ f) :=
begin
  sorry
end


import .lovelib

/-! # LoVe Homework 5: Inductive Predicates

Homework must be done individually. -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Question 1 (3 points + 1 bonus point): A Type of λ-Terms

Recall the type of λ-terms from question 3 of exercise 4: -/

inductive term : Type
| var : string → term
| lam : string → term → term
| app : term → term → term

/-! 1.1 (1 point). Define an inductive predicate `is_lam` that returns `true` if
its argument is of the form `term.lam …` and that returns false otherwise. -/

-- enter your definition here

/-! 1.2 (2 points). Validate your answer to question 1.1 by proving the following
lemmas: -/

lemma is_lam_lam (s : string) (t : term) :
  is_lam (term.lam s t) :=
sorry

lemma not_is_lam_var (s : string) :
  ¬ is_lam (term.var s) :=
sorry

lemma not_is_lam_app (t u : term) :
  ¬ is_lam (term.app t u) :=
sorry

/-! 1.3 (1 bounus point). Define an inductive predicate `is_βnf` that determines
whether a λ-term is in β-normal form. A λ-term is in β-normal form if it
contains no subterm of the form `(λx, t) u`, i.e., a λ-expression applied to an
argument. Another way to characterize the β-normal form is to say that no
β-reduction is possible in the term.

Hint: Use `is_lam` somewhere. -/

-- enter your definition here

/-! ## Question 2 (6 points): Transitive Closure

In mathematics, the transitive closure `R⁺` of a binary relation `R` over a
set `A` can be defined as the smallest solution satisfying the following rules:

    (base) for all `a, b ∈ A`, if `a R b`, then `a R⁺ b`;
    (step) for all `a, b, c ∈ A`, if `a R b` and `b R⁺ c`, then `a R⁺ c`.

In Lean, we can define this notion as follows, by identifying the set `A` with
the type `α`: -/

inductive tc_v1 {α : Type} (r : α → α → Prop) : α → α → Prop
| base {a b : α}   : r a b → tc_v1 a b
| step {a b c : α} : r a b → tc_v1 b c → tc_v1 a c

/-! 2.1 (1 point). Rule `(step)` makes it convenient to extend transitive chains
by adding links to the left. Another way to define the transitive closure `R⁺`
would use replace `(step)` with the following right-leaning rule:

    (pets) for all `a, b, c ∈ A`, if `a R⁺ b` and `b R c`, then `a R⁺ c`.

Define a predicate `tc_v2` that embodies this alternative definition. -/

-- enter your definition here

/-! 2.2 (1 point). Yet another definition of the transitive closure `R⁺` would
use the following symmetric rule instead of `(step)` or `(pets)`:

    (trans) for all `a, b, c ∈ A`, if `a R⁺ b` and `b R⁺ c`, then `a R⁺ c`.

Define a predicate `tc_v3` that embodies this alternative definition. -/

-- enter your definition here

/-! 2.3 (1 point). Prove that `(step)` also holds as a lemma about `tc_v3`. -/

lemma tc_v3_step {α : Type} (r : α → α → Prop) (a b c : α) (rab : r a b)
    (tbc : tc_v3 r b c) :
  tc_v3 r a c :=
sorry

/-! 2.4 (1 point). Prove the following lemma by rule induction: -/

lemma tc_v1_pets {α : Type} (r : α → α → Prop) (c : α) :
  ∀a b, tc_v1 r a b → r b c → tc_v1 r a c :=
sorry

/-! 2.5 (2 points). Prove the same lemma again on "paper".

Guidelines for paper proofs:

We expect detailed, rigorous, mathematical proofs. You are welcome to use
standard mathematical notation or Lean structured commands (e.g., `assume`,
`have`, `show`, `calc`). You can also use tactical proofs (e.g., `intro`,
`apply`), but then please indicate some of the intermediate goals, so that we
can follow the chain of reasoning.

Major proof steps, including applications of induction and invocation of the
induction hypothesis, must be stated explicitly. For each case of a proof by
induction, you must list the inductive hypotheses assumed (if any) and the goal
to be proved. Minor proof steps corresponding to `refl`, `simp`, or `linarith`
need not be justified if you think they are obvious (to humans), but you should
say which key lemmas they depend on. You should be explicit whenever you use a
function definition or an introduction rule for an inductive predicate. -/

-- enter your paper proof here

end LoVe


-- Suma_de_no_negativos.lean
-- Suma de no negativos.
-- José A. Alonso Jiménez
-- Sevilla, 22 de agosto de 2020
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Ejercicio 1. Demostrar si a y b son números reales no negativos,
-- entonces a + b es no negativo.
-- ----------------------------------------------------------------------

import data.real.basic

variables (a b : ℝ)

-- 1ª demostración
-- ===============

example
  (ha : 0 ≤ a)
  (hb : 0 ≤ b)
  : 0 ≤ a + b :=
begin
  calc 0 ≤ a     : ha
     ... ≤ a + b : le_add_of_nonneg_right hb,
end

-- 2ª demostración
-- ===============

example
  (ha : 0 ≤ a)
  (hb : 0 ≤ b)
  : 0 ≤ a + b :=
add_nonneg ha hb

-- Comentario: Se usa el lema
-- + add_nonneg : 0 ≤ a → 0 ≤ b → 0 ≤ a + b

-- 3ª demostración
-- ===============

example
  (ha : 0 ≤ a)
  (hb : 0 ≤ b)
  : 0 ≤ a + b :=
by linarith


/- INFERENCE RULES FOR ∃ PROPOSITIONS

There are two inference rules for ∃ propositions:
one introduction, one elimination. In Lean they are
called exists.intro and exists.elim. We will usually
use the cases tactic to apply the elimintion rule and
clean up the results. We generally apply the intro
rule directly.
-/

/- Introduction Rule for ∃

Let's start with introduction. We give several proofs
of the proposition that "there exists n even number."
To construct such proof, one applies the introduction
rule to two arguments: a particular number, n, and a
proof that *that* number is even. As you can see in the
next three examples, it doesn't matter what number you
give as a first argument, as long as you can give a proof
that it's even as it's second argument. This works for
the first argument values of 6 and 8 (because there are
easy proofs that they're even) but not for 7 (because
it's not even).
-/

def isEven (n) := n%2 = 0

example : ∃ (n : ℕ), isEven n :=
  exists.intro 6 rfl           -- 6 is good witness

example : ∃ (n : ℕ), isEven n :=
  exists.intro 7 rfl           -- no proof 7 is even

example : ∃ (n : ℕ), isEven n :=
  exists.intro 8 rfl           -- 8 is good, etc.

/-
In summary, to prove ∃ (x : T), P x, apply exists.intro
to a particular value, (t : T), and to a proof of (P t),
that that particular value, t, has the property (e.g.,
of being even) specified by the predicate, P.
-/

/- Elimination rule for ∃

Now for the elimination rule. What can we deduce or derive
from a given proof of ∃ (x : T), P x? Simply put, we can
deduce that, for some particular but otherwise unspecified
value, w : T, there is also a proof of P w, that w has the
property in question.
-/

/-
Here's a trivial example, where we will assume we have a proof
of an existentially quantified proposition, just to see what we
can do with it.
-/
example : (∃ (n : ℕ), isEven n) → true :=
begin
assume h,
cases h with w pf,
-- that illustrates the point we wanted to make
-- look at the context: you deduced that there is
-- a "w" for which there's also a proof of isEven w.
end

/-
Here's a more interesting example. We prove that
"if there's a ball that's both blue and round then
there is a ball that's blue."

How would you prove this in English? Well, from
the assumption that there's a ball that has both
properties, we can deduce there's some specific
ball, w, for which there is a also proof of the
proposition, isBlue w ∧ isRound w, *about that
specific ball*.

We can "eliminate" the ∧ to obtain separate
proofs of isBlue w and isRound w. Then we can
finish the proof by applying exist.intro to that
same ball, w, and to a proof that it's blue. That
proves that there exists a blue ball, which is
what we wanted to prove. QED.
-/

-- Here's exact that argument formally
example
  (Ball : Type)                             -- There is a type of object, Ball
  (isBlue : Ball → Prop)                    -- a predicate on objects of this type
  (isRound : Ball → Prop) :                 -- a second predicate on objects of this type
  (∃ (b : Ball), isBlue b ∧ isRound b) →    -- if there's a ball that satisfies both
  (∃ (b : Ball), isBlue b) :=               -- then there's a ball that satisfies one
begin
  assume h,                                 -- assume there's a ball that's blue and round
  cases h with b br,                        -- derive a specific ball, w, and a proof, br
  cases br with blue round,                 -- split the proof of the conjunction into parts
  exact exists.intro b blue,                -- construct a proof that there's a blue ball
end

/-
Here are (our local versions of) the intro and elim
inference rules for ∃. Before each one we use #check
to display Lean's "native" version.
-/

-- ∃ introduction

#check @exists.intro      -- Think of "Sort u" as just Type

def exists_intro :=
  ∀ {X : Type}            -- for any type, X
    {P : X → Prop}        -- for any predicate on values of this type
    (w : X),                -- if you give a witness w
    P w →                   -- then if you give a proof that w satisfies P
    (∃ (x : X), P x)        -- you get a proof there exists an x that satisfes P

-- ∃ elimination

#check @exists.elim

def exists_elim :=
  ∀ {X : Type}              -- for any type, X
    {P : X → Prop}          -- for any predicate on values of this type
    {Y : Prop},             -- for any "concluding" proposition, Y
    (∃ (x : X), P x) →      -- if we're given a proof that there's an x satisfying P
    (∀ (x : X), P x → Y) →  -- then if for every x that satisfies P Y is true
    Y                       -- then Y is true

#check @exists.elim
/- Compare Lean's definition with ours
  ∀ {α : Sort u_1}
    {p : α → Prop}
    {b : Prop},
    (∃ (x : α), p x) →
    (∀ (a : α), p a → b) →
    b
-/

/-
We can of course prove that our version of the rule
is valid, because it is. Here it goes.
-/
example : exists_elim :=
begin
unfold exists_elim,
assume X,   -- some type
assume P,   -- some property of values of that type
assume Y,   -- a goal to be proved from an "exists" proof
assume exists_x_with_P,           -- an exists proof
assume if_any_x_has_P_then_Y,     -- that any x with P implies Y
cases exists_x_with_P with w Pw,  -- eliminate ∃ to get witness and proof
exact (if_any_x_has_P_then_Y w Pw), -- use them to finish proof
end

/-
Question: Would the preceding proposition be true
if you just dropped the condition, (∃ (x : X), P x)?
The answer is no, but why? There's an edge case that
the existence proof eliminates. What's the edge case?
Answer: That there are no x's with property P. (You
should be sure to understand this point!)
-/

/-
Example: Let's formalize and prove the proposition
that if there's someone everyone loves, then everyone
loves someone.
-/
example
  (Person : Type)                     -- people
  (Loves : Person → Person → Prop)    -- loves relation
  :
  -- formalized version of the informal proposition
  (∃ (p : Person), ∀ (q : Person), Loves q p) →
  (∀ (p : Person), ∃ (q : Person), Loves p q)
  :=
begin
  assume h,
  cases h with lenny everyone_loves_lenny,
  assume bruce,
  apply exists.intro lenny _,
  apply everyone_loves_lenny bruce,
end

/-
Proof: Assume there's someone everyone
loves. By exists elimination let's call that
person lenny and deduce that everone loves
lenny. Now pick an arbitrary person, let's
call him or her bruce. We have to show that
there's someone bruce loves. But everyone
loves lenny, so bruce loves lenny (∀ elim).
QED.
-/


import data.real.basic

lemma div_le_div_of_le_right {a b c : ℝ}
(h : a ≤ b) (hc : c ≥ 0) : a / c ≤ b / c :=
begin
  rw [←sub_nonneg, ←sub_div],
  rw [←sub_nonneg] at h,
  apply div_nonneg,
  all_goals {assumption},
end

lemma ge_sub_abs (a b : ℝ) :
a ≥ b - |a - b| :=
begin
  simp only [ge_iff_le],
  rw [←sub_nonneg, sub_sub_eq_add_sub, add_sub_right_comm, add_comm],
  rw [←neg_sub, abs_neg, ←sub_eq_add_neg, sub_nonneg],
  simp only [le_abs_self],
end

lemma le_add_abs (a b : ℝ) :
a ≤ b + |a - b| :=
begin
  rw [←sub_nonneg, add_sub_right_comm, ←neg_sub],
  rw [←sub_eq_neg_add, sub_nonneg],
  simp only [le_abs_self],
end

lemma dividend_pos {a b : ℝ} :
a / b > 0 → b ≥ 0 → a > 0 :=
begin
  intros h₁ h₂,
  simp only [gt_iff_lt, div_pos_iff] at h₁,
  cases h₁,
  all_goals {linarith},
end

lemma double_pos {a : ℝ} (h : a > 0) : 2 * a > 0 :=
begin
  simp only [gt_iff_lt, zero_lt_mul_left, zero_lt_bit0, zero_lt_one],
  exact h,
end

lemma double_ne_zero {a : ℝ} (h : a ≠ 0) : 2 * a ≠ 0 :=
begin
  simp only [mul_ne_zero_iff],
  simp only [ne.def, bit0_eq_zero, one_ne_zero, not_false_iff, true_and],
  exact h,
end