/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Johannes Hölzl, Scott Morrison, Jens Wagemaker
-/
import algebra.hom.iterate
import data.polynomial.eval

/-!
# The derivative map on polynomials

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

## Main definitions
 * `polynomial.derivative`: The formal derivative of polynomials, expressed as a linear map.

-/

noncomputable theory

open finset
open_locale big_operators classical polynomial

namespace polynomial
universes u v w y z
variables {R : Type u} {S : Type v} {T : Type w} {ι : Type y} {A : Type z} {a b : R} {n : ℕ}

section derivative

section semiring
variables [semiring R]

/-- `derivative p` is the formal derivative of the polynomial `p` -/
def derivative : R[X] →ₗ[R] R[X] :=
{ to_fun := λ p, p.sum (λ n a, C (a * n) * X^(n-1)),
  map_add' := λ p q, by rw sum_add_index;
    simp only [add_mul, forall_const, ring_hom.map_add,
      eq_self_iff_true, zero_mul, ring_hom.map_zero],
  map_smul' := λ a p, by dsimp; rw sum_smul_index;
    simp only [mul_sum, ← C_mul', mul_assoc, coeff_C_mul, ring_hom.map_mul, forall_const,
      zero_mul, ring_hom.map_zero, sum] }

lemma derivative_apply (p : R[X]) :
  derivative p = p.sum (λn a, C (a * n) * X^(n - 1)) := rfl

lemma coeff_derivative (p : R[X]) (n : ℕ) :
  coeff (derivative p) n = coeff p (n + 1) * (n + 1) :=
begin
  rw [derivative_apply],
  simp only [coeff_X_pow, coeff_sum, coeff_C_mul],
  rw [sum, finset.sum_eq_single (n + 1)],
  simp only [nat.add_succ_sub_one, add_zero, mul_one, if_true, eq_self_iff_true], norm_cast,
  { assume b, cases b,
    { intros, rw [nat.cast_zero, mul_zero, zero_mul], },
    { intros _ H, rw [nat.succ_sub_one b, if_neg (mt (congr_arg nat.succ) H.symm), mul_zero] } },
  { rw [if_pos (add_tsub_cancel_right n 1).symm, mul_one, nat.cast_add, nat.cast_one,
      mem_support_iff],
    intro h, push_neg at h, simp [h], },
end

@[simp]
lemma derivative_zero : derivative (0 : R[X]) = 0 :=
derivative.map_zero

@[simp]
lemma iterate_derivative_zero {k : ℕ} : derivative^[k] (0 : R[X]) = 0 :=
begin
  induction k with k ih,
  { simp, },
  { simp [ih], },
end

@[simp]
lemma derivative_monomial (a : R) (n : ℕ) : derivative (monomial n a) = monomial (n - 1) (a * n) :=
by { rw [derivative_apply, sum_monomial_index, C_mul_X_pow_eq_monomial], simp }

lemma derivative_C_mul_X (a : R) : derivative (C a * X) = C a :=
by simpa only [C_mul_X_eq_monomial, derivative_monomial, nat.cast_one, mul_one]

lemma derivative_C_mul_X_pow (a : R) (n : ℕ) : derivative (C a * X ^ n) = C (a * n) * X ^ (n - 1) :=
by rw [C_mul_X_pow_eq_monomial, C_mul_X_pow_eq_monomial, derivative_monomial]

lemma derivative_C_mul_X_sq (a : R) : derivative (C a * X ^ 2) = C (a * 2) * X :=
by rw [derivative_C_mul_X_pow, nat.cast_two, pow_one]

@[simp] lemma derivative_X_pow (n : ℕ) : derivative (X ^ n : R[X]) = C ↑n * X ^ (n - 1) :=
by convert derivative_C_mul_X_pow (1 : R) n; simp

@[simp] lemma derivative_X_sq : derivative (X ^ 2 : R[X]) = C 2 * X :=
by rw [derivative_X_pow, nat.cast_two, pow_one]

@[simp] lemma derivative_C {a : R} : derivative (C a) = 0 :=
by simp [derivative_apply]

lemma derivative_of_nat_degree_zero {p : R[X]} (hp : p.nat_degree = 0) : p.derivative = 0 :=
by rw [eq_C_of_nat_degree_eq_zero hp, derivative_C]

@[simp] lemma derivative_X : derivative (X : R[X]) = 1 :=
(derivative_monomial _ _).trans $ by simp

@[simp] lemma derivative_one : derivative (1 : R[X]) = 0 :=
derivative_C

@[simp] lemma derivative_bit0 {a : R[X]} : derivative (bit0 a) = bit0 (derivative a) :=
by simp [bit0]

@[simp] lemma derivative_bit1 {a : R[X]} : derivative (bit1 a) = bit0 (derivative a) :=
by simp [bit1]

@[simp] lemma derivative_add {f g : R[X]} : derivative (f + g) = derivative f + derivative g :=
derivative.map_add f g

@[simp] lemma derivative_X_add_C (c : R) : (X + C c).derivative = 1 :=
by rw [derivative_add, derivative_X, derivative_C, add_zero]

@[simp] lemma iterate_derivative_add {f g : R[X]} {k : ℕ} :
  derivative^[k] (f + g) = (derivative^[k] f) + (derivative^[k] g) :=
derivative.to_add_monoid_hom.iterate_map_add _ _ _

@[simp] lemma derivative_sum {s : finset ι} {f : ι → R[X]} :
  derivative (∑ b in s, f b) = ∑ b in s, derivative (f b) :=
derivative.map_sum

@[simp] lemma derivative_smul {S : Type*} [monoid S]
  [distrib_mul_action S R] [is_scalar_tower S R R]
  (s : S) (p : R[X]) : derivative (s • p) = s • derivative p :=
derivative.map_smul_of_tower s p

@[simp] lemma iterate_derivative_smul {S : Type*} [monoid S]
  [distrib_mul_action S R] [is_scalar_tower S R R]
  (s : S) (p : R[X]) (k : ℕ) :
  derivative^[k] (s • p) = s • (derivative^[k] p) :=
begin
  induction k with k ih generalizing p,
  { simp, },
  { simp [ih], },
end

@[simp]
lemma iterate_derivative_C_mul (a : R) (p : R[X]) (k : ℕ) :
  derivative^[k] (C a * p) = C a * (derivative^[k] p) :=
by simp_rw [← smul_eq_C_mul, iterate_derivative_smul]

theorem of_mem_support_derivative {p : R[X]} {n : ℕ} (h : n ∈ p.derivative.support) :
  n + 1 ∈ p.support :=
mem_support_iff.2 $ λ (h1 : p.coeff (n+1) = 0), mem_support_iff.1 h $
show p.derivative.coeff n = 0, by rw [coeff_derivative, h1, zero_mul]

theorem degree_derivative_lt {p : R[X]} (hp : p ≠ 0) : p.derivative.degree < p.degree :=
(finset.sup_lt_iff $ bot_lt_iff_ne_bot.2 $ mt degree_eq_bot.1 hp).2 $ λ n hp, lt_of_lt_of_le
(with_bot.some_lt_some.2 n.lt_succ_self) $ finset.le_sup $ of_mem_support_derivative hp

theorem degree_derivative_le {p : R[X]} : p.derivative.degree ≤ p.degree :=
if H : p = 0 then le_of_eq $ by rw [H, derivative_zero] else (degree_derivative_lt H).le

theorem nat_degree_derivative_lt {p : R[X]} (hp : p.nat_degree ≠ 0) :
  p.derivative.nat_degree < p.nat_degree :=
begin
  cases eq_or_ne p.derivative 0 with hp' hp',
  { rw [hp', polynomial.nat_degree_zero],
    exact hp.bot_lt },
  { rw nat_degree_lt_nat_degree_iff hp',
    exact degree_derivative_lt (λ h, hp (h.symm ▸ nat_degree_zero)) }
end

lemma nat_degree_derivative_le (p : R[X]) : p.derivative.nat_degree ≤ p.nat_degree - 1 :=
begin
  by_cases p0 : p.nat_degree = 0,
  { simp [p0, derivative_of_nat_degree_zero] },
  { exact nat.le_pred_of_lt (nat_degree_derivative_lt p0) }
end

@[simp] lemma derivative_nat_cast {n : ℕ} : derivative (n : R[X]) = 0 :=
begin
  rw ← map_nat_cast C n,
  exact derivative_C,
end

lemma iterate_derivative_eq_zero {p : R[X]} {x : ℕ} (hx : p.nat_degree < x) :
  polynomial.derivative^[x] p = 0 :=
begin
  induction h : p.nat_degree using nat.strong_induction_on with _ ih generalizing p x,
  subst h,
  obtain ⟨t, rfl⟩ := nat.exists_eq_succ_of_ne_zero (pos_of_gt hx).ne',
  rw [function.iterate_succ_apply],
  by_cases hp : p.nat_degree = 0,
  { rw [derivative_of_nat_degree_zero hp, iterate_derivative_zero] },
  have := nat_degree_derivative_lt hp,
  exact ih _ this (this.trans_le $ nat.le_of_lt_succ hx) rfl
end

@[simp] lemma iterate_derivative_C {k} (h : 0 < k) : (derivative^[k] (C a : R[X])) = 0 :=
iterate_derivative_eq_zero $ (nat_degree_C _).trans_lt h

@[simp] lemma iterate_derivative_one {k} (h : 0 < k) : (derivative^[k] (1 : R[X])) = 0 :=
iterate_derivative_C h

@[simp] lemma iterate_derivative_X {k} (h : 1 < k) : (derivative^[k] (X : R[X])) = 0 :=
iterate_derivative_eq_zero $ nat_degree_X_le.trans_lt h

theorem nat_degree_eq_zero_of_derivative_eq_zero [no_zero_smul_divisors ℕ R] {f : R[X]}
  (h : f.derivative = 0) : f.nat_degree = 0 :=
begin
  rcases eq_or_ne f 0 with rfl | hf,
  { exact nat_degree_zero },
  rw nat_degree_eq_zero_iff_degree_le_zero,
  by_contra' f_nat_degree_pos,
  rw [←nat_degree_pos_iff_degree_pos] at f_nat_degree_pos,
  let m := f.nat_degree - 1,
  have hm : m + 1 = f.nat_degree := tsub_add_cancel_of_le f_nat_degree_pos,
  have h2 := coeff_derivative f m,
  rw polynomial.ext_iff at h,
  rw [h m, coeff_zero, ← nat.cast_add_one, ← nsmul_eq_mul', eq_comm, smul_eq_zero] at h2,
  replace h2 := h2.resolve_left m.succ_ne_zero,
  rw [hm, ←leading_coeff, leading_coeff_eq_zero] at h2,
  exact hf h2
end

theorem eq_C_of_derivative_eq_zero [no_zero_smul_divisors ℕ R] {f : R[X]} (h : f.derivative = 0) :
  f = C (f.coeff 0) :=
eq_C_of_nat_degree_eq_zero $ nat_degree_eq_zero_of_derivative_eq_zero h

@[simp] lemma derivative_mul {f g : R[X]} :
  derivative (f * g) = derivative f * g + f * derivative g :=
calc derivative (f * g) = f.sum (λ n a, g.sum (λ m b, (n + m) • (C (a * b) * X ^ ((n + m) - 1)))) :
  begin
    rw mul_eq_sum_sum,
    transitivity, exact derivative_sum,
    transitivity, { apply finset.sum_congr rfl, assume x hx, exact derivative_sum },
    apply finset.sum_congr rfl, assume n hn, apply finset.sum_congr rfl, assume m hm,
    transitivity,
    { exact congr_arg _ C_mul_X_pow_eq_monomial.symm },
    dsimp, rw [← smul_mul_assoc, smul_C, nsmul_eq_mul'], exact derivative_C_mul_X_pow _ _
  end
  ... = f.sum (λn a, g.sum (λm b,
      (n • (C a * X^(n - 1))) * (C b * X^m) + (C a * X^n) * (m • (C b * X^(m - 1))))) :
    sum_congr rfl $ assume n hn, sum_congr rfl $ assume m hm,
      by cases n; cases m; simp_rw [add_smul, mul_smul_comm, smul_mul_assoc,
        X_pow_mul_assoc, ← mul_assoc, ← C_mul, mul_assoc, ← pow_add];
        simp only [nat.add_succ, nat.succ_add, nat.succ_sub_one, zero_smul, add_comm]
  ... = derivative f * g + f * derivative g :
    begin
      conv { to_rhs, congr,
        { rw [← sum_C_mul_X_pow_eq g] },
        { rw [← sum_C_mul_X_pow_eq f] } },
      simp only [sum, sum_add_distrib, finset.mul_sum, finset.sum_mul, derivative_apply],
      simp_rw [← smul_mul_assoc, smul_C, nsmul_eq_mul'],
    end

lemma derivative_eval (p : R[X]) (x : R) :
  p.derivative.eval x = p.sum (λ n a, (a * n) * x ^ (n-1)) :=
by simp_rw [derivative_apply, eval_sum, eval_mul_X_pow, eval_C]

@[simp]
theorem derivative_map [semiring S] (p : R[X]) (f : R →+* S) :
  (p.map f).derivative = p.derivative.map f :=
begin
  let n := max p.nat_degree ((map f p).nat_degree),
  rw [derivative_apply, derivative_apply],
  rw [sum_over_range' _ _ (n + 1) ((le_max_left _ _).trans_lt (lt_add_one _))],
  rw [sum_over_range' _ _ (n + 1) ((le_max_right _ _).trans_lt (lt_add_one _))],
  simp only [polynomial.map_sum, polynomial.map_mul, polynomial.map_C, map_mul, coeff_map,
    map_nat_cast, polynomial.map_nat_cast, polynomial.map_pow, map_X],
  all_goals { intro n, rw [zero_mul, C_0, zero_mul], }
end

@[simp]
theorem iterate_derivative_map [semiring S] (p : R[X]) (f : R →+* S) (k : ℕ):
  polynomial.derivative^[k] (p.map f) = (polynomial.derivative^[k] p).map f :=
begin
  induction k with k ih generalizing p,
  { simp, },
  { simp only [ih, function.iterate_succ, polynomial.derivative_map, function.comp_app], },
end

lemma derivative_nat_cast_mul {n : ℕ} {f : R[X]} :
  (↑n * f).derivative = n * f.derivative :=
by simp

@[simp] lemma iterate_derivative_nat_cast_mul {n k : ℕ} {f : R[X]} :
  derivative^[k] (n * f) = n * (derivative^[k] f) :=
by induction k with k ih generalizing f; simp*

lemma mem_support_derivative [no_zero_smul_divisors ℕ R]
  (p : R[X]) (n : ℕ) :
  n ∈ (derivative p).support ↔ n + 1 ∈ p.support :=
suffices ¬p.coeff (n + 1) * (n + 1 : ℕ) = 0 ↔ coeff p (n + 1) ≠ 0,
  by simpa only [mem_support_iff, coeff_derivative, ne.def, nat.cast_succ],
by { rw [← nsmul_eq_mul', smul_eq_zero], simp only [nat.succ_ne_zero, false_or] }

@[simp] lemma degree_derivative_eq [no_zero_smul_divisors ℕ R]
  (p : R[X]) (hp : 0 < nat_degree p) :
  degree (derivative p) = (nat_degree p - 1 : ℕ) :=
begin
  have h0 : p ≠ 0,
  { contrapose! hp,
    simp [hp] },
  apply le_antisymm,
  { rw derivative_apply,
    apply le_trans (degree_sum_le _ _) (finset.sup_le (λ n hn, _)),
    apply le_trans (degree_C_mul_X_pow_le _ _) (with_bot.coe_le_coe.2 (tsub_le_tsub_right _ _)),
    apply le_nat_degree_of_mem_supp _ hn },
  { refine le_sup _,
    rw [mem_support_derivative, tsub_add_cancel_of_le, mem_support_iff],
    { show ¬ leading_coeff p = 0,
      rw [leading_coeff_eq_zero],
      assume h, rw [h, nat_degree_zero] at hp,
      exact lt_irrefl 0 (lt_of_le_of_lt (zero_le _) hp), },
    exact hp }
end

lemma coeff_iterate_derivative_as_prod_Ico {k} (p : R[X]) :
  ∀ m : ℕ, (derivative^[k] p).coeff m = (∏ i in Ico m.succ (m + k.succ), i) • (p.coeff (m + k)) :=
begin
  induction k with k ih,
  { simp only [add_zero, forall_const, one_smul, Ico_self, eq_self_iff_true,
      function.iterate_zero_apply, prod_empty] },
  { intro m, rw [function.iterate_succ_apply', coeff_derivative, ih (m+1), ← nat.cast_add_one,
      ← nsmul_eq_mul', smul_smul, mul_comm],
    apply congr_arg2,
    { have set_eq : (Ico m.succ (m + k.succ.succ)) = (Ico (m + 1).succ (m + 1 + k.succ)) ∪ {m+1},
      { simp_rw [← nat.Ico_succ_singleton, union_comm, nat.succ_eq_add_one, add_comm (k + 1),
          add_assoc],
        rw [Ico_union_Ico_eq_Ico]; simp_rw [add_le_add_iff_left, le_add_self], },
      rw [set_eq, prod_union, prod_singleton],
      { rw [disjoint_singleton_right, mem_Ico],
        exact λ h, (nat.lt_succ_self _).not_le h.1 } },
    { exact congr_arg _ (nat.succ_add m k) } },
end

lemma coeff_iterate_derivative_as_prod_range {k} (p : R[X]) :
  ∀ m : ℕ, (derivative^[k] p).coeff m = (∏ i in range k, (m + k - i)) • p.coeff (m + k) :=
begin
  induction k with k ih,
  { simp },
  intro m,
  calc (derivative^[k + 1] p).coeff m
      = (∏ i in range k, (m + k.succ - i)) • p.coeff (m + k.succ) * (m + 1) :
    by rw [function.iterate_succ_apply', coeff_derivative, ih m.succ, nat.succ_add, nat.add_succ]
  ... = ((∏ i in range k, (m + k.succ - i)) * (m + 1)) • p.coeff (m + k.succ) :
    by rw [← nat.cast_add_one, ← nsmul_eq_mul', smul_smul, mul_comm]
  ... = (∏ i in range k.succ, (m + k.succ - i)) • p.coeff (m + k.succ) :
    by rw [prod_range_succ, add_tsub_assoc_of_le k.le_succ, nat.succ_sub le_rfl, tsub_self]
end

lemma iterate_derivative_mul {n} (p q : R[X]) :
  derivative^[n] (p * q) =
  ∑ k in range n.succ,
    n.choose k • ((derivative^[n - k] p) * (derivative^[k] q)) :=
begin
  induction n with n IH,
  { simp },

  calc derivative^[n + 1] (p * q)
      = (∑ (k : ℕ) in range n.succ,
          (n.choose k) • ((derivative^[n - k] p) * (derivative^[k] q))).derivative :
    by rw [function.iterate_succ_apply', IH]
  ... = ∑ (k : ℕ) in range n.succ,
          (n.choose k) • ((derivative^[n - k + 1] p) * (derivative^[k] q)) +
        ∑ (k : ℕ) in range n.succ,
          (n.choose k) • ((derivative^[n - k] p) * (derivative^[k + 1] q)) :
    by simp_rw [derivative_sum, derivative_smul, derivative_mul, function.iterate_succ_apply',
      smul_add, sum_add_distrib]
  ... = (∑ (k : ℕ) in range n.succ,
            (n.choose k.succ) • ((derivative^[n - k] p) * (derivative^[k + 1] q)) +
          1 • ((derivative^[n + 1] p) * (derivative^[0] q))) +
        ∑ (k : ℕ) in range n.succ,
          (n.choose k) • ((derivative^[n - k] p) * (derivative^[k + 1] q)) : _
  ... = ∑ (k : ℕ) in range n.succ,
          (n.choose k) • ((derivative^[n - k] p) * (derivative^[k + 1] q)) +
        ∑ (k : ℕ) in range n.succ,
            (n.choose k.succ) • ((derivative^[n - k] p) * (derivative^[k + 1] q)) +
        1 • ((derivative^[n + 1] p) * (derivative^[0] q)) :
    by rw [add_comm, add_assoc]
  ... = ∑ (i : ℕ) in range n.succ,
          ((n+1).choose (i+1)) • ((derivative^[n + 1 - (i + 1)] p) * (derivative^[i + 1] q)) +
        1 • ((derivative^[n + 1] p) * (derivative^[0] q)) :
    by simp_rw [nat.choose_succ_succ, nat.succ_sub_succ, add_smul, sum_add_distrib]
  ... = ∑ (k : ℕ) in range n.succ.succ,
          (n.succ.choose k) • (derivative^[n.succ - k] p * (derivative^[k] q)) :
    by rw [sum_range_succ' _ n.succ, nat.choose_zero_right, tsub_zero],

  congr,
  refine (sum_range_succ' _ _).trans (congr_arg2 (+) _ _),
  { rw [sum_range_succ, nat.choose_succ_self, zero_smul, add_zero],
    refine sum_congr rfl (λ k hk, _),
    rw mem_range at hk,
    congr,
    rw [tsub_add_eq_add_tsub (nat.succ_le_of_lt hk), nat.succ_sub_succ] },
  { rw [nat.choose_zero_right, tsub_zero] },
end

end semiring

section comm_semiring
variables [comm_semiring R]

theorem derivative_pow_succ (p : R[X]) (n : ℕ) :
  (p ^ (n + 1)).derivative = C ↑(n + 1) * (p ^ n) * p.derivative :=
nat.rec_on n (by rw [pow_one, nat.cast_one, C_1, one_mul, pow_zero, one_mul]) $ λ n ih,
by rw [pow_succ', derivative_mul, ih, nat.add_one, mul_right_comm, nat.cast_add n.succ, C_add,
       add_mul, add_mul, pow_succ', ← mul_assoc, nat.cast_one, C_1, one_mul]

theorem derivative_pow (p : R[X]) (n : ℕ) :
  (p ^ n).derivative = C ↑n * (p ^ (n - 1)) * p.derivative :=
nat.cases_on n (by rw [pow_zero, derivative_one, nat.cast_zero, C_0, zero_mul, zero_mul]) $ λ n,
by rw [p.derivative_pow_succ n, n.succ_sub_one, n.cast_succ]

theorem derivative_sq (p : R[X]) : (p ^ 2).derivative = C 2 * p * p.derivative :=
by rw [derivative_pow_succ, nat.cast_two, pow_one]

theorem dvd_iterate_derivative_pow (f : R[X]) (n : ℕ) {m : ℕ} (c : R) (hm : m ≠ 0) :
  (n : R) ∣ eval c (derivative^[m] (f ^ n)) :=
begin
  obtain ⟨m, rfl⟩ := nat.exists_eq_succ_of_ne_zero hm,
  rw [function.iterate_succ_apply, derivative_pow, mul_assoc, C_eq_nat_cast,
      iterate_derivative_nat_cast_mul, eval_mul, eval_nat_cast],
  exact dvd_mul_right _ _,
end

lemma iterate_derivative_X_pow_eq_nat_cast_mul (n k : ℕ) :
  (derivative^[k] (X ^ n : R[X])) = ↑(nat.desc_factorial n k) * X ^ (n - k) :=
begin
  induction k with k ih,
  { rw [function.iterate_zero_apply, tsub_zero, nat.desc_factorial_zero, nat.cast_one, one_mul] },
  { rw [function.iterate_succ_apply', ih, derivative_nat_cast_mul, derivative_X_pow, C_eq_nat_cast,
      nat.succ_eq_add_one, nat.desc_factorial_succ, nat.sub_sub, nat.cast_mul, ←mul_assoc,
      mul_comm ↑(nat.desc_factorial _ _)] },
end

lemma iterate_derivative_X_pow_eq_C_mul (n k : ℕ) :
  (derivative^[k] (X ^ n : R[X])) = C ↑(nat.desc_factorial n k) * X ^ (n - k) :=
by rw [iterate_derivative_X_pow_eq_nat_cast_mul n k, C_eq_nat_cast]

lemma iterate_derivative_X_pow_eq_smul (n : ℕ) (k : ℕ) :
  (derivative^[k] (X ^ n : R[X])) = (nat.desc_factorial n k : R) • X ^ (n - k) :=
by rw [iterate_derivative_X_pow_eq_C_mul n k, smul_eq_C_mul]

lemma derivative_X_add_C_pow (c : R) (m : ℕ) :
  ((X + C c) ^ m).derivative = C ↑m * (X + C c) ^ (m - 1) :=
by rw [derivative_pow, derivative_X_add_C, mul_one]

lemma derivative_X_add_C_sq (c : R) : ((X + C c) ^ 2).derivative = C 2 * (X + C c) :=
by rw [derivative_sq, derivative_X_add_C, mul_one]

lemma iterate_derivative_X_add_pow (n k : ℕ) (c : R) : derivative^[k] ((X + C c) ^ n) =
  ↑(∏ i in finset.range k, (n - i)) * (X + C c) ^ (n - k) :=
begin
  induction k with k IH,
  { rw [function.iterate_zero_apply, finset.range_zero, finset.prod_empty, nat.cast_one, one_mul,
      tsub_zero] },
  { simp only [function.iterate_succ_apply', IH, derivative_mul, zero_mul, derivative_nat_cast,
      zero_add, finset.prod_range_succ, C_eq_nat_cast, nat.sub_sub, ←mul_assoc,
      derivative_X_add_C_pow, nat.succ_eq_add_one, nat.cast_mul] },
end

lemma derivative_comp (p q : R[X]) : (p.comp q).derivative = q.derivative * p.derivative.comp q :=
begin
  apply polynomial.induction_on' p,
  { intros p₁ p₂ h₁ h₂, simp [h₁, h₂, mul_add], },
  { intros n r,
    simp only [derivative_pow, derivative_mul, monomial_comp, derivative_monomial, derivative_C,
      zero_mul, C_eq_nat_cast, zero_add, ring_hom.map_mul],
    -- is there a tactic for this? (a multiplicative `abel`):
    rw [mul_comm (derivative q)],
    simp only [mul_assoc], }
end

/-- Chain rule for formal derivative of polynomials. -/
theorem derivative_eval₂_C (p q : R[X]) :
  (p.eval₂ C q).derivative = p.derivative.eval₂ C q * q.derivative :=
polynomial.induction_on p
  (λ r, by rw [eval₂_C, derivative_C, eval₂_zero, zero_mul])
  (λ p₁ p₂ ih₁ ih₂, by rw [eval₂_add, derivative_add, ih₁, ih₂, derivative_add, eval₂_add, add_mul])
  (λ n r ih, by rw [pow_succ', ← mul_assoc, eval₂_mul, eval₂_X, derivative_mul, ih,
      @derivative_mul _ _ _ X, derivative_X, mul_one, eval₂_add, @eval₂_mul _ _ _ _ X, eval₂_X,
      add_mul, mul_right_comm])

theorem derivative_prod {s : multiset ι} {f : ι → R[X]} :
  (multiset.map f s).prod.derivative =
  (multiset.map (λ i, (multiset.map f (s.erase i)).prod * (f i).derivative) s).sum :=
begin
  refine multiset.induction_on s (by simp) (λ i s h, _),
  rw [multiset.map_cons, multiset.prod_cons, derivative_mul, multiset.map_cons _ i s,
    multiset.sum_cons, multiset.erase_cons_head, mul_comm (f i).derivative],
  congr,
  rw [h, ← add_monoid_hom.coe_mul_left, (add_monoid_hom.mul_left (f i)).map_multiset_sum _,
    add_monoid_hom.coe_mul_left],
  simp only [function.comp_app, multiset.map_map],
  refine congr_arg _ (multiset.map_congr rfl (λ j hj, _)),
  rw [← mul_assoc, ← multiset.prod_cons, ← multiset.map_cons],
  by_cases hij : i = j,
  { simp [hij, ← multiset.prod_cons, ← multiset.map_cons, multiset.cons_erase hj] },
  { simp [hij] }
end

end comm_semiring

section ring

variables [ring R]

@[simp] lemma derivative_neg (f : R[X]) : derivative (-f) = - derivative f :=
linear_map.map_neg derivative f

@[simp] lemma iterate_derivative_neg {f : R[X]} {k : ℕ} :
  derivative^[k] (-f) = - (derivative^[k] f) :=
(@derivative R _).to_add_monoid_hom.iterate_map_neg _ _

@[simp] lemma derivative_sub {f g : R[X]} : derivative (f - g) = derivative f - derivative g :=
linear_map.map_sub derivative f g

@[simp] lemma derivative_X_sub_C (c : R) : (X - C c).derivative = 1 :=
by rw [derivative_sub, derivative_X, derivative_C, sub_zero]

@[simp] lemma iterate_derivative_sub {k : ℕ} {f g : R[X]} :
  derivative^[k] (f - g) = (derivative^[k] f) - (derivative^[k] g) :=
by induction k with k ih generalizing f g; simp*

@[simp] lemma derivative_int_cast {n : ℤ} : derivative (n : R[X]) = 0 :=
begin
  rw ← C_eq_int_cast n,
  exact derivative_C,
end

lemma derivative_int_cast_mul {n : ℤ} {f : R[X]} :
  (↑n * f).derivative = n * f.derivative :=
by simp

@[simp] lemma iterate_derivative_int_cast_mul {n : ℤ} {k : ℕ} {f : R[X]} :
  derivative^[k] (↑n * f) = n * (derivative^[k] f) :=
by induction k with k ih generalizing f; simp*

end ring

section comm_ring
variables [comm_ring R]

lemma derivative_comp_one_sub_X (p : R[X]) :
  (p.comp (1 - X)).derivative = -p.derivative.comp (1 - X) :=
by simp [derivative_comp]

@[simp]
lemma iterate_derivative_comp_one_sub_X (p : R[X]) (k : ℕ) :
  derivative^[k] (p.comp (1 - X)) = (-1) ^ k * (derivative^[k] p).comp (1 - X) :=
begin
  induction k with k ih generalizing p,
  { simp, },
  { simp [ih p.derivative, iterate_derivative_neg, derivative_comp, pow_succ], },
end

lemma derivative_X_sub_C_pow (c : R) (m : ℕ) :
  ((X - C c) ^ m).derivative = C ↑m * (X - C c) ^ (m - 1) :=
by rw [derivative_pow, derivative_X_sub_C, mul_one]

lemma derivative_X_sub_C_sq (c : R) : ((X - C c) ^ 2).derivative = C 2 * (X - C c) :=
by rw [derivative_sq, derivative_X_sub_C, mul_one]

lemma iterate_derivative_X_sub_pow (n k : ℕ) (c : R) :
  (derivative^[k] ((X - C c) ^ n)) = (↑(∏ i in finset.range k, (n - i))) * (X - C c) ^ (n - k) :=
by simp_rw [sub_eq_add_neg, ←C_neg, iterate_derivative_X_add_pow]

end comm_ring

end derivative

end polynomial


/-
Copyright (c) 2022 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
prelude
import Init.Data.Nat.Linear
import Init.Data.List.BasicAux

namespace Nat.SOM

open Linear (Var hugeFuel Context Var.denote)

inductive Expr where
  | num (i : Nat)
  | var (v : Var)
  | add (a b : Expr)
  | mul (a b : Expr)
  deriving Inhabited

def Expr.denote (ctx : Context) : Expr → Nat
  | num n   => n
  | var v   => v.denote ctx
  | add a b => Nat.add (a.denote ctx) (b.denote ctx)
  | mul a b => Nat.mul (a.denote ctx) (b.denote ctx)

abbrev Mon := List Var

def Mon.denote (ctx : Context) : Mon → Nat
  | [] => 1
  | v::vs => Nat.mul (v.denote ctx) (denote ctx vs)

def Mon.mul (m₁ m₂ : Mon) : Mon :=
  go hugeFuel m₁ m₂
where
  go (fuel : Nat) (m₁ m₂ : Mon) : Mon :=
    match fuel with
    | 0 => m₁ ++ m₂
    | fuel + 1 =>
      match m₁, m₂ with
      | m₁, [] => m₁
      | [], m₂ => m₂
      | v₁ :: m₁, v₂ :: m₂ =>
        bif Nat.blt v₁ v₂ then
          v₁ :: go fuel m₁ (v₂ :: m₂)
        else bif Nat.blt v₂ v₁ then
          v₂ :: go fuel (v₁ :: m₁) m₂
        else
          v₁ :: v₂ :: go fuel m₁ m₂

abbrev Poly := List (Nat × Mon)

def Poly.denote (ctx : Context) : Poly → Nat
  | [] => 0
  | (k, m) :: p => Nat.add (Nat.mul k (m.denote ctx)) (denote ctx p)

def Poly.add (p₁ p₂ : Poly) : Poly :=
  go hugeFuel p₁ p₂
where
  go (fuel : Nat) (p₁ p₂ : Poly) : Poly :=
    match fuel with
    | 0 => p₁ ++ p₂
    | fuel + 1 =>
      match p₁, p₂ with
      | p₁, [] => p₁
      | [], p₂ => p₂
      | (k₁, m₁) :: p₁, (k₂, m₂) :: p₂ =>
        bif m₁ < m₂ then
          (k₁, m₁) :: go fuel p₁ ((k₂, m₂) :: p₂)
        else bif m₂ < m₁ then
          (k₂, m₂) :: go fuel ((k₁, m₁) :: p₁) p₂
        else bif k₁ + k₂ == 0 then
          go fuel p₁ p₂
        else
          (k₁ + k₂, m₁) :: go fuel p₁ p₂

def Poly.insertSorted (k : Nat) (m : Mon) (p : Poly) : Poly :=
  match p with
  | [] => [(k, m)]
  | (k', m') :: p => bif m < m' then (k, m) :: (k', m') :: p else (k', m') :: insertSorted k m p

def Poly.mulMon (p : Poly) (k : Nat) (m : Mon) : Poly :=
  go p []
where
  go (p : Poly) (acc : Poly) : Poly :=
    match p with
    | [] => acc
    | (k', m') :: p => go p (acc.insertSorted (k*k') (m.mul m'))

def Poly.mul (p₁ : Poly) (p₂ : Poly) : Poly :=
  go p₁ []
where
  go (p₁ : Poly) (acc : Poly) : Poly :=
    match p₁ with
    | [] => acc
    | (k, m) :: p₁ => go p₁ (acc.add (p₂.mulMon k m))

def Expr.toPoly : Expr → Poly
  | num k   => bif k == 0 then [] else [(k, [])]
  | var v   => [(1, [v])]
  | add a b => a.toPoly.add b.toPoly
  | mul a b => a.toPoly.mul b.toPoly

theorem Mon.append_denote (ctx : Context) (m₁ m₂ : Mon) : (m₁ ++ m₂).denote ctx = m₁.denote ctx * m₂.denote ctx := by
  match m₁ with
  | [] => simp! [Nat.one_mul]
  | v :: m₁ => simp! [append_denote ctx m₁ m₂, Nat.mul_assoc]

theorem Mon.mul_denote (ctx : Context) (m₁ m₂ : Mon) : (m₁.mul m₂).denote ctx = m₁.denote ctx * m₂.denote ctx :=
  go hugeFuel m₁ m₂
where
  go (fuel : Nat) (m₁ m₂ : Mon) : (Mon.mul.go fuel m₁ m₂).denote ctx = m₁.denote ctx * m₂.denote ctx := by
    induction fuel generalizing m₁ m₂ with
    | zero => simp! [append_denote]
    | succ _ ih =>
      simp!
      split <;> simp!
      next v₁ m₁ v₂ m₂ =>
        by_cases hlt : Nat.blt v₁ v₂ <;> simp! [hlt, Nat.mul_assoc, ih]
        by_cases hgt : Nat.blt v₂ v₁ <;> simp! [hgt, Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm, ih]

theorem Poly.append_denote (ctx : Context) (p₁ p₂ : Poly) : (p₁ ++ p₂).denote ctx = p₁.denote ctx + p₂.denote ctx := by
  match p₁ with
  | [] => simp!
  | v :: p₁ => simp! [append_denote _ p₁ p₂, Nat.add_assoc]

theorem Poly.add_denote (ctx : Context) (p₁ p₂ : Poly) : (p₁.add p₂).denote ctx = p₁.denote ctx + p₂.denote ctx :=
  go hugeFuel p₁ p₂
where
  go (fuel : Nat) (p₁ p₂ : Poly) : (Poly.add.go fuel p₁ p₂).denote ctx = p₁.denote ctx + p₂.denote ctx := by
    induction fuel generalizing p₁ p₂ with
    | zero => simp! [append_denote]
    | succ _ ih =>
      simp!
      split <;> simp!
      next k₁ m₁ p₁ k₂ m₂ p₂ =>
        by_cases hlt : m₁ < m₂ <;> simp! [hlt, Nat.add_assoc, ih]
        by_cases hgt : m₂ < m₁ <;> simp! [hgt, Nat.add_assoc, Nat.add_comm, Nat.add_left_comm, ih]
        have : m₁ = m₂ := List.le_antisymm hgt hlt
        subst m₂
        by_cases heq : k₁ + k₂ == 0 <;> simp! [heq, ih]
        · simp [← Nat.add_assoc, ← Nat.right_distrib, eq_of_beq heq]
        · simp [Nat.right_distrib, Nat.add_assoc, Nat.add_comm, Nat.add_left_comm]

theorem Poly.denote_insertSorted (ctx : Context) (k : Nat) (m : Mon) (p : Poly) : (p.insertSorted k m).denote ctx = p.denote ctx + k * m.denote ctx := by
  match p with
  | [] => simp!
  | (k', m') :: p =>
    by_cases h : m < m' <;> simp! [h, denote_insertSorted ctx k m p, Nat.add_assoc, Nat.add_comm, Nat.add_left_comm]

theorem Poly.mulMon_denote (ctx : Context) (p : Poly) (k : Nat) (m : Mon) : (p.mulMon k m).denote ctx = p.denote ctx * k * m.denote ctx := by
  simp [mulMon, go]; simp!
where
  go (p : Poly) (acc : Poly) : (mulMon.go k m p acc).denote ctx = acc.denote ctx + p.denote ctx * k * m.denote ctx := by
   match p with
   | [] => simp!
   | (k', m') :: p =>
     simp! [go p, Nat.left_distrib, denote_insertSorted, Mon.mul_denote, Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm, Nat.add_assoc]

theorem Poly.mul_denote (ctx : Context) (p₁ p₂ : Poly) : (p₁.mul p₂).denote ctx = p₁.denote ctx * p₂.denote ctx := by
  simp [mul, go]; simp!
where
  go (p₁ : Poly) (acc : Poly) : (mul.go p₂ p₁ acc).denote ctx = acc.denote ctx + p₁.denote ctx * p₂.denote ctx := by
    match p₁ with
    | [] => simp!
    | (k, m) :: p₁ =>
      simp! [go p₁, Nat.left_distrib, add_denote, mulMon_denote,
             Nat.add_assoc, Nat.add_comm, Nat.add_left_comm,
             Nat.mul_assoc, Nat.mul_comm, Nat.mul_left_comm]

theorem Expr.toPoly_denote (ctx : Context) (e : Expr) : e.toPoly.denote ctx = e.denote ctx := by
  induction e with
  | num k =>
    simp!; by_cases h : k == 0 <;> simp! [*]
    simp [eq_of_beq h]
  | var v => simp!
  | add a b => simp! [Poly.add_denote, *]
  | mul a b => simp! [Poly.mul_denote, *]

theorem Expr.eq_of_toPoly_eq (ctx : Context) (a b : Expr) (h : a.toPoly == b.toPoly) : a.denote ctx = b.denote ctx := by
  have h := congrArg (Poly.denote ctx) (eq_of_beq h)
  simp [toPoly_denote] at h
  assumption

end Nat.SOM


-- vim: ts=2 sw=0 sts=-1 et ai tw=70

import .mynat.parity
import .mynat.sum

-- This file is specifically for statements of famous theorems.
-- It is a useful and fun thing to state these, but they're better off
-- in a different file because they tend to use sorry

open hidden.mynat
open hidden

-- Landau's Problems about prime numbers
-- https://en.wikipedia.org/wiki/Landau%27s_problems
theorem goldbachs_conjecture {m : mynat} :
even m → ∃ p q: mynat, prime p → prime q → p + q = m := sorry

theorem twin_prime_conjecture:
infinitely_many (λ p, prime p ∧ prime (p+2)) := sorry

theorem legendres_conjecture {m : mynat} :
∃ p, m*m ≤ p ∧ p ≤ (m+1)*(m+1) ∧ prime p := sorry

theorem landau4:
infinitely_many (λ n, prime (n*n + 1)) := sorry

-- instructive exercise in disproof by counterexample
theorem fermats_penultimate_theorem:
¬ ∀ a b c n: mynat, a^n + b^n = c^n → n = 2 :=
begin
  assume hflt,
  have h := hflt 1 1 2 1 rfl,
  cases h,
end

theorem fermats_last_theorem (a b c n: mynat):
a ≠ 0 → b ≠ 0 → a ^ n + b ^ n = c ^ n → n = 1 ∨ n = 2 := sorry

def collatz_sequence : mynat → sequence mynat
| m zero     := m
| m (succ n) :=
begin
  have prev := collatz_sequence m n,
  exact
  if even prev then
    sorry -- Need division
  else
    3 * prev + 1,
end

-- "Mathematics may not be ready for such problems"
theorem collatz_conjecture:
∀ m, ∃ n, collatz_sequence m n = 1 := sorry


/-
Copyright (c) 2021 Gabriel Moise. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Gabriel Moise.
-/

import data.complex.basic
import data.complex.module
import data.fintype.basic
import data.real.basic
import linear_algebra.matrix

/-!
# Symmetric Matrices

This module defines symmetric matrices, together with key properties about their eigenvalues & eigenvectors.
It uses a more restrictive definition of eigenvalues & eigenvectors, together with helping lemmas for vector-matrix
operations and tools for complex numbers/vectors.

TODO : make the eigen-definitions consistent with the ones already defined in linear_algebra.eigenspace

## Main definitions

* `vec_conj x` - the complex conjugate of a complex vector `x`
* `vec_re x` - the vector containing the real parts of elements from x
* `vec_im x` - the vector containing the imaginary parts of elements from x

* `has_eigenpair M μ x` - matrix `M` has non-zero eigenvector `x` with corresponding eigenvalue `μ`
* `has_eigenvector M x` - matrix `M` has non-zero eigenvector `x`
* `has_eigenvalue M μ`  - matrix `M` has eigenvalue `μ`

* `symm_matrix M` - `M` is a symmetric matrix

## Main statements

1. If x is an eigenvector of matrix M, then a • x is an eigenvector of M, for any non-zero a : ℂ.
2. If there are two eigenvectors of M that have the same correspoding eigenvalue, then any linear combination of them
is also an eigenvector of M with the same eigenvalue μ.
3. All eigenvalues of a symmetric real matrix M are real.
4. For every real eigenvalue of a symmetric matrix M, there exists a corresponding real-valued eigenvector.
5. If v and w are eigenvectors of a symmetric matrix M with different eigenvalues, then v and w are orthogonal.

## References

<https://www.doc.ic.ac.uk/~ae/papers/lecture05.pdf>
<https://sharmaeklavya2.github.io/theoremdep/nodes/linear-algebra/eigenvectors/real-matrix-with-real-eigenvalue-has-real-eigenvectors.html>
-/

open_locale matrix big_operators
open fintype finset matrix complex

universes u
variables {α : Type u}
variables {m n : Type*} [fintype m] [fintype n]

lemma vec_eq_unfold (x y : n → α) : (λ i : n, x i) = (λ i : n, y i) ↔ ∀ i : n, x i = y i :=
begin
  split,
  { intros hyp i, exact congr_fun hyp i },
  { intro hyp, ext, apply hyp }
end

-- ## Coercions
instance : has_coe (n → ℝ) (n → ℂ) := ⟨λ x, (λ i, ⟨x i, 0⟩)⟩
instance : has_coe (matrix m n ℝ) (matrix m n ℂ) := ⟨λ M, (λ i j, ⟨M i j, 0⟩)⟩

-- ## Lemmas on ℂ

lemma conj_of_zero_im {μ : ℂ} (H_im : μ.im = 0) : conj μ = μ :=
by { ext; simp only [conj_re, conj_im, H_im, neg_zero] }

lemma sum_complex_re {x : n → ℂ} : (∑ i : n, x i).re = ∑ i : n, (x i).re := by exact complex.re_lm.map_sum

lemma sum_complex_im {x : n → ℂ} : (∑ i : n, x i).im = ∑ i : n, (x i).im := by exact complex.im_lm.map_sum

-- The real and complex parts of a complex vector
def vec_re (x : n → ℂ) : n → ℝ := λ i : n, (x i).re
def vec_im (x : n → ℂ) : n → ℝ := λ i : n, (x i).im

-- Defining the complex conjugate of a complex vector
section vec_conj

def vec_conj (x : n → ℂ) : n → ℂ := λ i : n, conj (x i)

-- (μ • x)* = μ* • x*
lemma vec_conj_smul (μ : ℂ) (x : n → ℂ) :
  vec_conj (μ • x) = (conj μ) • (vec_conj x) :=
by { ext ; simp only [vec_conj, algebra.id.smul_eq_mul, pi.smul_apply, ring_hom.map_mul] }

-- ↑A i j = ↑(A i j)
lemma coe_matrix_coe_elem (i : m) (j : n) (A : matrix m n ℝ) : (A : matrix m n ℂ) i j = ↑(A i j) := by exact rfl

-- (A ⬝ x)* = A ⬝ x*
lemma vec_conj_mul_vec [decidable_eq n] [nonempty n] (A : matrix m n ℝ) (x : n → ℂ) :
  vec_conj ((A : matrix m n ℂ).mul_vec x) = (A : matrix m n ℂ).mul_vec (vec_conj x) :=
begin
  ext,
  simp only [vec_conj, mul_vec, dot_product, conj_re, coe_matrix_coe_elem, sum_complex_re, mul_re, of_real_im, zero_mul],
  simp only [vec_conj, mul_vec, dot_product, conj_im, coe_matrix_coe_elem, sum_complex_im, mul_im, add_zero, of_real_im,
    zero_mul, sum_neg_distrib, mul_neg_eq_neg_mul_symm]
end

lemma vec_norm_sq_zero {x : n → ℂ} (H_dot : dot_product (vec_conj x) x = 0) : x = 0 :=
begin
  unfold dot_product at H_dot,
  simp only [vec_conj, mul_comm, mul_conj, complex.ext_iff, sum_complex_re, zero_re, of_real_re] at H_dot,
  cases H_dot with H_re H_im,
  have key : ∑ i in (univ : finset n), norm_sq (x i) = 0 ↔ ∀ i ∈ (univ : finset n), norm_sq(x i) = 0,
  { apply sum_eq_zero_iff_of_nonneg, intros i h_univ, exact norm_sq_nonneg (x i) },
  simp only [forall_prop_of_true, mem_univ, monoid_with_zero_hom.map_eq_zero] at key,
  rw key at H_re,
  ext i;
  { specialize H_re i, simp only [H_re, pi.zero_apply] }
end

lemma coe_vec_re (x : n → ℂ) {i : n} : (vec_re x : n → ℂ) i = ((x i).re : ℂ) :=
by simpa only [vec_re]

lemma vec_add_conj_eq_two_re (x : n → ℂ) : x + vec_conj x = (2 : ℂ) • (vec_re x : n → ℂ) :=
begin
  ext,
  { simp [vec_conj, coe_vec_re x], linarith },
  { simp [vec_conj, coe_vec_re x] }
end

lemma vec_conj_add_zero {x : n → ℂ} (H : x + vec_conj x = 0) : vec_re x = 0 :=
begin
  rw [vec_add_conj_eq_two_re, smul_eq_zero] at H,
  cases H with H_20 H_x,
  { exfalso, simp at H_20, assumption }, -- 2 = 0
  { rw function.funext_iff at H_x,
    ext i,
    specialize H_x i,
    rw coe_vec_re at H_x,
    simp only [of_real_eq_zero, pi.zero_apply] at H_x,
    simp only [vec_re, H_x, pi.zero_apply] }
end

end vec_conj

namespace matrix

variables (M : matrix n n ℝ)

def Coe (M : matrix m n ℝ) := (M : matrix m n ℂ)

/--
## Matrix definitions
Let `M` be a square real matrix. An `eigenvector` of `M` is a complex vector `x` with `M ⬝ x = μ • x`
for some `μ ∈ ℂ`, which is called the `eigenvalue` of `M` corresponding to the `eigenvector x`.
-/
def has_eigenpair (μ : ℂ) (x : n → ℂ) : Prop :=
  x ≠ 0 ∧ (mul_vec M.Coe x = μ • x)

def has_eigenvector (x : n → ℂ) : Prop :=
  ∃ μ : ℂ, M.has_eigenpair μ x

def has_eigenvalue (μ : ℂ) : Prop :=
  ∃ x : n → ℂ, M.has_eigenpair μ x

def symm_matrix : Prop := M = Mᵀ

-- ## Matrix : Helping lemmas

-- (↑M)ᵀ = ↑Mᵀ
lemma coe_transpose_matrix : (M.Coe)ᵀ = (Mᵀ).Coe := by { unfold Coe, ext, tidy }

-- ↑M i j = ↑(M i j)
lemma coe_matrix_coe_elem (i j : n) : (M.Coe) i j = ↑(M i j) := by exact rfl

-- (M x)* = M x*
lemma vec_conj_mul_vec_re (x : n → ℂ) :
  vec_conj (mul_vec M.Coe x) = mul_vec (M.Coe) (vec_conj x) :=
begin
  ext ;
  simp only [vec_conj, mul_vec, dot_product, coe_matrix_coe_elem],
  { simp only [sum_complex_re, of_real_im, zero_mul, conj_re, mul_re] },
  { simp only [sum_complex_im, add_zero, of_real_im, zero_mul,
               sum_neg_distrib, conj_im, mul_neg_eq_neg_mul_symm, mul_im] },
end

lemma symm_matrix_coe (H_symm : symm_matrix M) : (M.Coe) = (M.Coe)ᵀ :=
begin
  unfold symm_matrix at H_symm,
  rw [coe_transpose_matrix, ← H_symm]
end

-- vᵀ (M w) = (vᵀ M)ᵀ w
lemma dot_product_mul_vec_vec_mul (v w : n → ℂ) :
  dot_product v (mul_vec M.Coe w) = dot_product (vec_mul v M.Coe) w :=
begin
  have key : vec_mul v M.Coe = λ j, dot_product v (λ i, M.Coe i j),
  { ext ; unfold vec_mul },
  rw [key, dot_product_assoc v M.Coe w],
  ext ; simp only [dot_product, mul_vec],
end

-- 1. If x is an eigenvector of M, then a • x is an eigenvector of M, for any non-zero a : ℂ.
theorem has_eigenvector_smul (a : ℂ) (x : n → ℂ) (H_na : a ≠ 0) (H_eigenvector : has_eigenvector M x) :
  has_eigenvector M (a • x) :=
begin
  rcases H_eigenvector with ⟨μ, ⟨H_nx, H_mul⟩⟩,
  use μ, -- corresponding eigenvalue μ
  split,
  { intro hyp, rw smul_eq_zero at hyp, tauto }, -- a • x ≠ 0
  calc (M.Coe).mul_vec (a • x)
      = a • M.Coe.mul_vec x : -- M ⬝ (a • x) = a • (M ⬝ x)
  by { rw mul_vec_smul_assoc }
  ... = a • (μ • x) :                 -- ... = a • (μ • x)
  by { rw H_mul }
  ... = μ • (a • x) :                 -- ... = μ • (a • x)
  by { simp only [smul_smul, mul_comm] }
end

-- 2. If there are two eigenvectors that have the same correspoding eigenvalue μ,
-- then any non-zero linear combination of them is also an eigenvector with the same eigenvalue μ.
theorem has_eigenpair_linear (a b : ℂ) (v w : n → ℂ) (μ : ℂ) (H_ne : a • v + b • w ≠ 0)
(H₁ : has_eigenpair M μ v) (H₂ : has_eigenpair M μ w) : has_eigenpair M μ (a • v + b • w) :=
begin
  rcases H₁ with ⟨H₁₁, H₁₂⟩,
  rcases H₂ with ⟨H₂₁, H₂₂⟩,
  use H_ne, -- a • v + b • w ≠ 0
  calc M.Coe.mul_vec (a • v + b • w) -- M ⬝ (a • v + b • w) = M ⬝ (a • v) + M ⬝ (b • w)
      = M.Coe.mul_vec(a • v) + M.Coe.mul_vec(b • w) :
  by { ext ; simp only [mul_vec, pi.add_apply, dot_product_add] }
  ... = a • M.Coe.mul_vec v + b • M.Coe.mul_vec w :  -- ... = a • (M ⬝ v) + b • (M ⬝ w)
  by { ext ; simp only [mul_vec, algebra.id.smul_eq_mul,
                        dot_product_smul, pi.add_apply, pi.smul_apply] }
  ... = a • (μ • v) + b • (μ • w) :                  -- ... = a • (μ • v) + b • (μ • w)
  by { rw [H₁₂, H₂₂] }
  ... = μ • (a • v + b • w) :                        -- ... = μ • (a • v + b • w)
  by { simp only [smul_smul, mul_comm, smul_add] }
end

-- 3. All eigenvalues of a symmetric real matrix M are real.
theorem symm_matrix_real_eigenvalues (H_symm : symm_matrix M) :
  ∀ (μ : ℂ), has_eigenvalue M μ → μ.im = 0 :=
begin
  -- (1) M ⬝ x = μ • x
  rintro μ ⟨x, ⟨H_x, H_eq₁⟩⟩,
  -- (2) M ⬝ x* = μ* • x*
  have H_eq₂ : mul_vec M.Coe (vec_conj x) = (conj μ) • (vec_conj x),
  { rw [← vec_conj_smul μ x, ← M.vec_conj_mul_vec_re x, H_eq₁] },
  -- (3) μ ((x*)ᵀ x) = μ* ((x*)ᵀ x)
  have H_eq₃ : μ * (dot_product (vec_conj x) x) = conj μ * dot_product (vec_conj x) x,

  calc μ * dot_product (vec_conj x) x
      = dot_product (vec_conj x) (μ • x) :    -- μ ((x*)ᵀ x) = (x*)ᵀ (μ x)
  by { rw ← smul_dot_product μ (vec_conj x) x,
       simp [dot_product, vec_conj, ← mul_assoc, mul_comm] }
  ... = dot_product (vec_conj x) (M.Coe.mul_vec x) :  -- ... = (x*)ᵀ (M x)
  by { rw ← H_eq₁ }
  ... = dot_product (M.Coe.vec_mul (vec_conj x)) x :  -- ... = ((x*)ᵀ M) x
  by { exact (dot_product_assoc (vec_conj x) M.Coe x).symm }
  ... = dot_product (M.Coeᵀ.mul_vec (vec_conj x)) x : -- ... = (Mᵀ x*)ᵀ x
  by { rw ← mul_vec_transpose M.Coe (vec_conj x) }
  ... = dot_product (M.Coe.mul_vec (vec_conj x)) x :  -- ... = (M x*)ᵀ x
  by { have H : M.Coe = M.Coeᵀ, { unfold Coe, tidy }, rw ← H }
  ... = dot_product (conj μ • vec_conj x) x :         -- ... = (μ* x*)ᵀ x
  by { rw H_eq₂ }
  ... = conj μ * dot_product (vec_conj x) x :         -- ... = μ* ((x*)ᵀ x)
  by { rw ← smul_dot_product (conj μ) (vec_conj x) x },

  -- (4) (μ - μ*) ((x*)ᵀ x) = 0
  have H_eq₄ : (μ - conj μ) * dot_product (vec_conj x) x = 0,
  { rw sub_mul, simp only [H_eq₃, sub_self] },
  -- μ - μ* = 0 ∨ (x*)ᵀ x = 0
  rw mul_eq_zero at H_eq₄,
  cases H_eq₄ with H_μ H_prod,
  { rw [sub_eq_zero, eq_comm, eq_conj_iff_real] at H_μ,
    cases H_μ with r H_r,
    rw [H_r, of_real_im] }, -- μ - μ* = 0
  { exfalso,
    exact H_x (vec_norm_sq_zero H_prod) }, -- (x*)ᵀ x = 0
end

-- 4. For every real eigenvalue of a symmetric matrix M, there exists a corresponding real-valued eigenvector.
theorem symm_matrix_real_eigenvectors (H_symm : symm_matrix M) (μ : ℂ) (H_eigenvalue : has_eigenvalue M μ) :
  ∃ x : n → ℂ, has_eigenpair M μ x ∧ vec_im x = 0 :=
begin
  -- We know that μ ∈ ℝ from before.
  have H_μ : μ.im = 0,
  { apply M.symm_matrix_real_eigenvalues H_symm μ H_eigenvalue },
  rcases H_eigenvalue with ⟨x, ⟨H_nx, H_mul⟩⟩,
  by_cases H_re : vec_re x = 0,
  -- 1) I • x will be used
  { use (I • x),
    split,
    -- 1.1) I • x is an eigenvector
    { split,
      -- 1.1.1) I • x ≠ 0
      { intro hyp, rw smul_eq_zero at hyp,
        have H_nI : I ≠ 0, { exact I_ne_zero },
        tauto },
      -- 1.1.2) M (I • x) = μ • (I • x)
      { simp only [mul_vec_smul_assoc, H_mul, smul_smul, mul_comm] } },
    -- 1.2) I • x ∈ ℝⁿ
    { ext i,
      simp only [vec_re, vec_eq_unfold] at H_re,
      simp only [vec_im, algebra.id.smul_eq_mul, I_re, one_mul,
                 I_im, zero_mul, mul_im, zero_add, pi.smul_apply],
      exact H_re i } },
  -- 2) x + x* will be used
  { use (x + vec_conj x),
    split,
    -- 2.1) x + x* is an eigenvector
    { split,
      -- 2.1.1) x + x* ≠ 0
      { intro hyp, exact H_re (vec_conj_add_zero hyp) },
      -- 2.1.2) M (x + x*) = μ • (x + x*)
      { calc M.Coe.mul_vec (x + vec_conj x)
            = M.Coe.mul_vec x + M.Coe.mul_vec (vec_conj x) :
        by { apply mul_vec_add } -- M (x + x*) = M x + M x*
        ... = M.Coe.mul_vec x + vec_conj (M.Coe.mul_vec x) :
        by { rw ← M.vec_conj_mul_vec_re x }     -- ... = M x + (M x)*
        ... = μ • x + vec_conj (μ • x) :
        by { rw H_mul }                         -- ... = μ • x + (μ • x)*
        ... = μ • x + (conj μ) • (vec_conj x) :
        by { rw vec_conj_smul }                 -- ... = μ • x + μ* • x*
        ... = μ • x + μ • (vec_conj x) :
        by { rw conj_of_zero_im H_μ }           -- ... = μ • x + μ • x*
        ... = μ • (x + vec_conj x) :
        by { simp only [smul_add] } } },        -- ... = μ • (x + x*)
    -- 2.2) x + x* ∈ ℝⁿ
    { ext, simp [vec_add_conj_eq_two_re, vec_im, coe_vec_re] } }
end

-- 5. If v and w are eigenvectors of a symmetric matrix M with different eigenvalues, then v and w are orthogonal.
theorem dot_product_neq_eigenvalue_zero (H_symm : symm_matrix M) (v w : n → ℂ) (μ μ' : ℂ)
(H_ne : μ ≠ μ') (H₁ : has_eigenpair M μ v) (H₂ : has_eigenpair M μ' w) : dot_product v w = 0 :=
begin
  have key : (μ - μ') * dot_product v w = 0,
  calc (μ - μ') * dot_product v w
      = μ * dot_product v w - μ' * dot_product v w :
  by { apply mul_sub_right_distrib }-- (μ - μ')vᵀ w = μ(vᵀ w) - μ'(vᵀ w)
  ... = dot_product (μ • v) w - dot_product v (μ' • w) :
  by { simp only [dot_product_smul,
       smul_dot_product] }                   -- ... = (μ • v)ᵀw - vᵀ(μ' • w)
  ... = dot_product (M.Coe.mul_vec v) w - dot_product v (M.Coe.mul_vec w) :
  by { rw [H₁.2, H₂.2] }                     -- ... = (M v)ᵀw - vᵀ(M w)
  ... = dot_product (M.Coe.mul_vec v) w - dot_product (vec_mul v M.Coe) w :
  by { rw M.dot_product_mul_vec_vec_mul v w }-- ... = (M v)ᵀw - (vᵀ M)ᵀw
  ... = dot_product (M.Coe.mul_vec v) w - dot_product (vec_mul v M.Coeᵀ) w:
  by { rw ← symm_matrix_coe M H_symm }  -- ... = (M v)ᵀw - (vᵀ Mᵀ)ᵀw
  ... = dot_product (M.Coe.mul_vec v) w - dot_product (mul_vec M.Coe v) w :
  by { rw ← vec_mul_transpose M.Coe v }       -- ... = (M v)ᵀw - (M v)ᵀw
  ... = 0 :
  by { simp only [sub_self] },               -- ... = 0
  rw mul_eq_zero at key,
  cases key with H_μ H_dot,
  { exfalso, rw sub_eq_zero at H_μ, exact H_ne H_μ }, -- μ - μ' = 0
  { exact H_dot } -- vᵀ w = 0
end

-- TODOs :
-- 1. positive semidefinite matrices
-- 2. eigenvalues = roots of characteristic polynomial (char_poly)
-- 3. eigendecomposition of a diagonalizable matrix

end matrix


import data.nat.prime
import tactic.field_simp
import tactic.linarith

open nat

theorem sqrt_2_irr : ∀ q : ℚ, q^2 ≠ 2 :=
begin
  intros q q_sqrd_eq_2,

  have h₁ : q.num.nat_abs^2 = 2 * q.denom^2 :=
  begin
    rw rat.eq_iff_mul_eq_mul at q_sqrd_eq_2,
    norm_cast at q_sqrd_eq_2,
    rw [mul_one, cast_mul, int.coe_nat_bit0, cast_one] at q_sqrd_eq_2,
    rw ← int.coe_nat_eq_coe_nat_iff,
    field_simp,
    simp only [sq] at *,
    rw [rat.mul_self_num, rat.mul_self_denom] at q_sqrd_eq_2,
    exact q_sqrd_eq_2,
  end,

  have h₂ : 2 ∣ q.num.nat_abs :=
  begin
    have h := dvd_mul_right 2 (q.denom ^ 2),
    rw ←h₁ at h,
    cases (prime.dvd_mul prime_two).1 h with h_1,
    exact h_1,
    rw [nat.add, npow_rec, npow_rec, mul_one] at h_1,
    exact h_1,
  end,

  have h₃ : 2 ∣ q.denom :=
    begin
      have h : 2*2 ∣ q.num.nat_abs ^ 2 := pow_dvd_pow_of_dvd h₂ _,
      rw h₁ at h,
      have h' : 2 ∣ q.denom ^ 2 := dvd_of_mul_dvd_mul_left succ_pos' h,
      cases (prime.dvd_mul prime_two).1 h',
      exact h_1,
      rw [nat.add, npow_rec, npow_rec, mul_one] at h_1,
      exact h_1,
    end,

  have h₄ : gcd q.num.nat_abs q.denom ≥ 2 :=
    begin
      apply exists.elim h₂,
      intros c_num q_num_eq_2_c_num,
      apply exists.elim h₃,
      intros c_denom q_denom_eq_c_denom,
      have c_denom_ge_1 : c_denom ≥ 1 :=
        by linarith [q.pos],
      rw [q_num_eq_2_c_num, q_denom_eq_c_denom, gcd_mul_left],
      linarith [nat.gcd_pos_of_pos_right c_num c_denom_ge_1],
    end,

  have h₅ : gcd q.num.nat_abs q.denom = 1 := q.cop,

  linarith,
end

theorem sqrt_not_ps_irr :
  ∀ n : ℕ, ¬ (∃ m : ℕ, n = m^2) →
    ∀ q : ℚ, q^2 ≠ n :=
begin
  intros n n_not_perfect_square q q_sqrd_eq_n,

  have h₁ : q.num.nat_abs^2 = n * q.denom^2 :=
    begin
      rw rat.eq_iff_mul_eq_mul at q_sqrd_eq_n,
      norm_cast at q_sqrd_eq_n,
      rw [mul_one, cast_mul] at q_sqrd_eq_n,
      rw ← int.coe_nat_eq_coe_nat_iff,
      field_simp,
      simp only [sq] at *,
      rw [rat.mul_self_num, rat.mul_self_denom] at q_sqrd_eq_n,
      exact q_sqrd_eq_n,
    end,

  by_cases q.denom = 1,
  {
    rw [h, one_pow, mul_one] at h₁,
    apply n_not_perfect_square,
    use q.num.nat_abs,
    exact eq.symm h₁,
  },
  {
    have h₂ : q.denom ∣ q.num.nat_abs :=
      begin
        repeat {rw sq at h₁},
        apply nat.coprime.dvd_of_dvd_mul_left q.cop.symm,
        use (n * q.denom),
        rw h₁,
        ring,
      end,

    have q_cop := q.cop,
    unfold coprime at q_cop,
    rw nat.gcd_eq_right_iff_dvd.1 h₂ at q_cop,
    exact h q_cop,
  },
end


import number_theory.sum_two_squares

-- All Primes (1 mod 4) Equal the Sum of Two Squares

lemma t020 {p : ℕ} : p.prime → p % 4 = 1
→ ∃ a b : ℕ, a ^ 2 + b ^ 2 = p
:= nat.prime.sum_two_squares

#print t020


/-
Copyright (c) 2018 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import algebra.linear_ordered_comm_group_with_zero
import algebra.big_operators.ring
import data.real.basic
import data.indicator_function
import algebra.algebra.basic

/-!
# Nonnegative real numbers

In this file we define `nnreal` (notation: `ℝ≥0`) to be the type of non-negative real numbers,
a.k.a. the interval `[0, ∞)`. We also define the following operations and structures on `ℝ≥0`:

* the order on `ℝ≥0` is the restriction of the order on `ℝ`; these relations define a conditionally
  complete linear order with a bottom element, `conditionally_complete_linear_order_bot`;

* `a + b` and `a * b` are the restrictions of addition and multiplication of real numbers to `ℝ≥0`;
  these operations together with `0 = ⟨0, _⟩` and `1 = ⟨1, _⟩` turn `ℝ≥0` into a linear ordered
  archimedean commutative semifield; we have no typeclass for this in `mathlib` yet, so we define
  the following instances instead:

  - `linear_ordered_semiring ℝ≥0`;
  - `comm_semiring ℝ≥0`;
  - `canonically_ordered_comm_semiring ℝ≥0`;
  - `linear_ordered_comm_group_with_zero ℝ≥0`;
  - `archimedean ℝ≥0`.

* `nnreal.of_real x` is defined as `⟨max x 0, _⟩`, i.e. `↑(nnreal.of_real x) = x` when `0 ≤ x` and
  `↑(nnreal.of_real x) = 0` otherwise.

We also define an instance `can_lift ℝ ℝ≥0`. This instance can be used by the `lift` tactic to
replace `x : ℝ` and `hx : 0 ≤ x` in the proof context with `x : ℝ≥0` while replacing all occurences
of `x` with `↑x`. This tactic also works for a function `f : α → ℝ` with a hypothesis
`hf : ∀ x, 0 ≤ f x`.

## Notations

This file defines `ℝ≥0` as a localized notation for `nnreal`.
-/

noncomputable theory

open_locale classical big_operators

/-- Nonnegative real numbers. -/
def nnreal := {r : ℝ // 0 ≤ r}
localized "notation ` ℝ≥0 ` := nnreal" in nnreal

namespace nnreal

instance : has_coe ℝ≥0 ℝ := ⟨subtype.val⟩

/- Simp lemma to put back `n.val` into the normal form given by the coercion. -/
@[simp] lemma val_eq_coe (n : ℝ≥0) : n.val = n := rfl

instance : can_lift ℝ ℝ≥0 :=
{ coe := coe,
  cond := λ r, 0 ≤ r,
  prf := λ x hx, ⟨⟨x, hx⟩, rfl⟩ }

protected lemma eq {n m : ℝ≥0} : (n : ℝ) = (m : ℝ) → n = m := subtype.eq

protected lemma eq_iff {n m : ℝ≥0} : (n : ℝ) = (m : ℝ) ↔ n = m :=
iff.intro nnreal.eq (congr_arg coe)

lemma ne_iff {x y : ℝ≥0} : (x : ℝ) ≠ (y : ℝ) ↔ x ≠ y :=
not_iff_not_of_iff $ nnreal.eq_iff

/-- Reinterpret a real number `r` as a non-negative real number. Returns `0` if `r < 0`. -/
protected def of_real (r : ℝ) : ℝ≥0 := ⟨max r 0, le_max_right _ _⟩

lemma coe_of_real (r : ℝ) (hr : 0 ≤ r) : (nnreal.of_real r : ℝ) = r :=
max_eq_left hr

lemma le_coe_of_real (r : ℝ) : r ≤ nnreal.of_real r :=
le_max_left r 0

lemma coe_nonneg (r : ℝ≥0) : (0 : ℝ) ≤ r := r.2
@[norm_cast]
theorem coe_mk (a : ℝ) (ha) : ((⟨a, ha⟩ : ℝ≥0) : ℝ) = a := rfl

instance : has_zero ℝ≥0  := ⟨⟨0, le_refl 0⟩⟩
instance : has_one ℝ≥0   := ⟨⟨1, zero_le_one⟩⟩
instance : has_add ℝ≥0   := ⟨λa b, ⟨a + b, add_nonneg a.2 b.2⟩⟩
instance : has_sub ℝ≥0   := ⟨λa b, nnreal.of_real (a - b)⟩
instance : has_mul ℝ≥0   := ⟨λa b, ⟨a * b, mul_nonneg a.2 b.2⟩⟩
instance : has_inv ℝ≥0   := ⟨λa, ⟨(a.1)⁻¹, inv_nonneg.2 a.2⟩⟩
instance : has_div ℝ≥0   := ⟨λa b, ⟨a / b, div_nonneg a.2 b.2⟩⟩
instance : has_le ℝ≥0    := ⟨λ r s, (r:ℝ) ≤ s⟩
instance : has_bot ℝ≥0   := ⟨0⟩
instance : inhabited ℝ≥0 := ⟨0⟩

protected lemma coe_injective : function.injective (coe : ℝ≥0 → ℝ) := subtype.coe_injective
@[simp, norm_cast] protected lemma coe_eq {r₁ r₂ : ℝ≥0} : (r₁ : ℝ) = r₂ ↔ r₁ = r₂ :=
nnreal.coe_injective.eq_iff
@[simp, norm_cast] protected lemma coe_zero : ((0 : ℝ≥0) : ℝ) = 0 := rfl
@[simp, norm_cast] protected lemma coe_one  : ((1 : ℝ≥0) : ℝ) = 1 := rfl
@[simp, norm_cast] protected lemma coe_add (r₁ r₂ : ℝ≥0) : ((r₁ + r₂ : ℝ≥0) : ℝ) = r₁ + r₂ := rfl
@[simp, norm_cast] protected lemma coe_mul (r₁ r₂ : ℝ≥0) : ((r₁ * r₂ : ℝ≥0) : ℝ) = r₁ * r₂ := rfl
@[simp, norm_cast] protected lemma coe_inv (r : ℝ≥0) : ((r⁻¹ : ℝ≥0) : ℝ) = r⁻¹ := rfl
@[simp, norm_cast] protected lemma coe_div (r₁ r₂ : ℝ≥0) : ((r₁ / r₂ : ℝ≥0) : ℝ) = r₁ / r₂ := rfl
@[simp, norm_cast] protected

@[simp, norm_cast] protected lemma coe_sub {r₁ r₂ : ℝ≥0} (h : r₂ ≤ r₁) :
  ((r₁ - r₂ : ℝ≥0) : ℝ) = r₁ - r₂ :=
max_eq_left $ le_sub.2 $ by simp [show (r₂ : ℝ) ≤ r₁, from h]

-- TODO: setup semifield!
@[simp] protected lemma coe_eq_zero (r : ℝ≥0) : ↑r = (0 : ℝ) ↔ r = 0 := by norm_cast
lemma coe_ne_zero {r : ℝ≥0} : (r : ℝ) ≠ 0 ↔ r ≠ 0 := by norm_cast

instance : comm_semiring ℝ≥0 :=
{ zero := 0,
  add := (+),
  one := 1,
  mul := (*),
  .. nnreal.coe_injective.comm_semiring _ rfl rfl (λ _ _, rfl) (λ _ _, rfl) }

/-- Coercion `ℝ≥0 → ℝ` as a `ring_hom`. -/
def to_real_hom : ℝ≥0 →+* ℝ :=
⟨coe, nnreal.coe_one, nnreal.coe_mul, nnreal.coe_zero, nnreal.coe_add⟩

/-- The real numbers are an algebra over the non-negative reals. -/
instance : algebra ℝ≥0 ℝ := to_real_hom.to_algebra

@[simp] lemma coe_to_real_hom : ⇑to_real_hom = coe := rfl

instance : comm_group_with_zero ℝ≥0 :=
{ zero := 0,
  mul := (*),
  one := 1,
  inv := has_inv.inv,
  div := (/),
  .. nnreal.coe_injective.comm_group_with_zero _ rfl rfl (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) }

@[simp, norm_cast] lemma coe_indicator {α} (s : set α) (f : α → ℝ≥0) (a : α) :
  ((s.indicator f a : ℝ≥0) : ℝ) = s.indicator (λ x, f x) a :=
(to_real_hom : ℝ≥0 →+ ℝ).map_indicator _ _ _

@[simp, norm_cast] lemma coe_pow (r : ℝ≥0) (n : ℕ) : ((r^n : ℝ≥0) : ℝ) = r^n :=
to_real_hom.map_pow r n

@[norm_cast] lemma coe_list_sum (l : list ℝ≥0) :
  ((l.sum : ℝ≥0) : ℝ) = (l.map coe).sum :=
to_real_hom.map_list_sum l

@[norm_cast] lemma coe_list_prod (l : list ℝ≥0) :
  ((l.prod : ℝ≥0) : ℝ) = (l.map coe).prod :=
to_real_hom.map_list_prod l

@[norm_cast] lemma coe_multiset_sum (s : multiset ℝ≥0) :
  ((s.sum : ℝ≥0) : ℝ) = (s.map coe).sum :=
to_real_hom.map_multiset_sum s

@[norm_cast] lemma coe_multiset_prod (s : multiset ℝ≥0) :
  ((s.prod : ℝ≥0) : ℝ) = (s.map coe).prod :=
to_real_hom.map_multiset_prod s

@[norm_cast] lemma coe_sum {α} {s : finset α} {f : α → ℝ≥0} :
  ↑(∑ a in s, f a) = ∑ a in s, (f a : ℝ) :=
to_real_hom.map_sum _ _

lemma of_real_sum_of_nonneg {α} {s : finset α} {f : α → ℝ} (hf : ∀ a, a ∈ s → 0 ≤ f a) :
  nnreal.of_real (∑ a in s, f a) = ∑ a in s, nnreal.of_real (f a) :=
begin
  rw [←nnreal.coe_eq, nnreal.coe_sum, nnreal.coe_of_real _ (finset.sum_nonneg hf)],
  exact finset.sum_congr rfl (λ x hxs, by rw nnreal.coe_of_real _ (hf x hxs)),
end

@[norm_cast] lemma coe_prod {α} {s : finset α} {f : α → ℝ≥0} :
  ↑(∏ a in s, f a) = ∏ a in s, (f a : ℝ) :=
to_real_hom.map_prod _ _

lemma of_real_prod_of_nonneg {α} {s : finset α} {f : α → ℝ} (hf : ∀ a, a ∈ s → 0 ≤ f a) :
  nnreal.of_real (∏ a in s, f a) = ∏ a in s, nnreal.of_real (f a) :=
begin
  rw [←nnreal.coe_eq, nnreal.coe_prod, nnreal.coe_of_real _ (finset.prod_nonneg hf)],
  exact finset.prod_congr rfl (λ x hxs, by rw nnreal.coe_of_real _ (hf x hxs)),
end

@[norm_cast] lemma nsmul_coe (r : ℝ≥0) (n : ℕ) : ↑(n • r) = n • (r:ℝ) :=
to_real_hom.to_add_monoid_hom.map_nsmul _ _

@[simp, norm_cast] protected lemma coe_nat_cast (n : ℕ) : (↑(↑n : ℝ≥0) : ℝ) = n :=
to_real_hom.map_nat_cast n

instance : linear_order ℝ≥0 :=
linear_order.lift (coe : ℝ≥0 → ℝ) nnreal.coe_injective

@[simp, norm_cast] protected lemma coe_le_coe {r₁ r₂ : ℝ≥0} : (r₁ : ℝ) ≤ r₂ ↔ r₁ ≤ r₂ := iff.rfl
@[simp, norm_cast] protected lemma coe_lt_coe {r₁ r₂ : ℝ≥0} : (r₁ : ℝ) < r₂ ↔ r₁ < r₂ := iff.rfl
@[simp, norm_cast] protected lemma coe_pos {r : ℝ≥0} : (0 : ℝ) < r ↔ 0 < r := iff.rfl

protected lemma coe_mono : monotone (coe : ℝ≥0 → ℝ) := λ _ _, nnreal.coe_le_coe.2

protected lemma of_real_mono : monotone nnreal.of_real :=
λ x y h, max_le_max h (le_refl 0)

@[simp] lemma of_real_coe {r : ℝ≥0} : nnreal.of_real r = r :=
nnreal.eq $ max_eq_left r.2

@[simp] lemma mk_coe_nat (n : ℕ) : @eq ℝ≥0 (⟨(n : ℝ), n.cast_nonneg⟩ : ℝ≥0) n :=
nnreal.eq (nnreal.coe_nat_cast n).symm

@[simp] lemma of_real_coe_nat (n : ℕ) : nnreal.of_real n = n :=
nnreal.eq $ by simp [coe_of_real]

/-- `nnreal.of_real` and `coe : ℝ≥0 → ℝ` form a Galois insertion. -/
protected def gi : galois_insertion nnreal.of_real coe :=
galois_insertion.monotone_intro nnreal.coe_mono nnreal.of_real_mono
  le_coe_of_real (λ _, of_real_coe)

instance : order_bot ℝ≥0 :=
{ bot := ⊥, bot_le := assume ⟨a, h⟩, h, .. nnreal.linear_order }

instance : canonically_linear_ordered_add_monoid ℝ≥0 :=
{ add_le_add_left       := assume a b h c, @add_le_add_left ℝ _ a b h c,
  lt_of_add_lt_add_left := assume a b c, @lt_of_add_lt_add_left ℝ _ a b c,
  le_iff_exists_add     := assume ⟨a, ha⟩ ⟨b, hb⟩,
    iff.intro
      (assume h : a ≤ b,
        ⟨⟨b - a, le_sub_iff_add_le.2 $ by simp [h]⟩,
          nnreal.eq $ show b = a + (b - a), by rw [add_sub_cancel'_right]⟩)
      (assume ⟨⟨c, hc⟩, eq⟩, eq.symm ▸ show a ≤ a + c, from (le_add_iff_nonneg_right a).2 hc),
  ..nnreal.comm_semiring,
  ..nnreal.order_bot,
  ..nnreal.linear_order }

instance : distrib_lattice ℝ≥0 := by apply_instance

instance : semilattice_inf_bot ℝ≥0 :=
{ .. nnreal.order_bot, .. nnreal.distrib_lattice }

instance : semilattice_sup_bot ℝ≥0 :=
{ .. nnreal.order_bot, .. nnreal.distrib_lattice }

instance : linear_ordered_semiring ℝ≥0 :=
{ add_left_cancel            := assume a b c h, nnreal.eq $
    @add_left_cancel ℝ _ a b c (nnreal.eq_iff.2 h),
  le_of_add_le_add_left      := assume a b c, @le_of_add_le_add_left ℝ _ a b c,
  mul_lt_mul_of_pos_left     := assume a b c, @mul_lt_mul_of_pos_left ℝ _ a b c,
  mul_lt_mul_of_pos_right    := assume a b c, @mul_lt_mul_of_pos_right ℝ _ a b c,
  zero_le_one                := @zero_le_one ℝ _,
  exists_pair_ne             := ⟨0, 1, ne_of_lt (@zero_lt_one ℝ _ _)⟩,
  .. nnreal.canonically_linear_ordered_add_monoid,
  .. nnreal.comm_semiring, }

instance : linear_ordered_comm_group_with_zero ℝ≥0 :=
{ mul_le_mul_left := assume a b h c, mul_le_mul (le_refl c) h (zero_le a) (zero_le c),
  zero_le_one := zero_le 1,
  .. nnreal.linear_ordered_semiring,
  .. nnreal.comm_group_with_zero }

instance : canonically_ordered_comm_semiring ℝ≥0 :=
{ .. nnreal.canonically_linear_ordered_add_monoid,
  .. nnreal.comm_semiring,
  .. (show no_zero_divisors ℝ≥0, by apply_instance),
  .. nnreal.comm_group_with_zero }

instance : densely_ordered ℝ≥0 :=
⟨assume a b (h : (a : ℝ) < b), let ⟨c, hac, hcb⟩ := exists_between h in
  ⟨⟨c, le_trans a.property $ le_of_lt $ hac⟩, hac, hcb⟩⟩

instance : no_top_order ℝ≥0 :=
⟨assume a, let ⟨b, hb⟩ := no_top (a:ℝ) in ⟨⟨b, le_trans a.property $ le_of_lt $ hb⟩, hb⟩⟩

lemma bdd_above_coe {s : set ℝ≥0} : bdd_above ((coe : ℝ≥0 → ℝ) '' s) ↔ bdd_above s :=
iff.intro
  (assume ⟨b, hb⟩, ⟨nnreal.of_real b, assume ⟨y, hy⟩ hys, show y ≤ max b 0, from
    le_max_left_of_le $ hb $ set.mem_image_of_mem _ hys⟩)
  (assume ⟨b, hb⟩, ⟨b, assume y ⟨x, hx, eq⟩, eq ▸ hb hx⟩)

lemma bdd_below_coe (s : set ℝ≥0) : bdd_below ((coe : ℝ≥0 → ℝ) '' s) :=
⟨0, assume r ⟨q, _, eq⟩, eq ▸ q.2⟩

instance : has_Sup ℝ≥0 :=
⟨λs, ⟨Sup ((coe : ℝ≥0 → ℝ) '' s),
  begin
    cases s.eq_empty_or_nonempty with h h,
    { simp [h, set.image_empty, real.Sup_empty] },
    rcases h with ⟨⟨b, hb⟩, hbs⟩,
    by_cases h' : bdd_above s,
    { exact le_cSup_of_le (bdd_above_coe.2 h') (set.mem_image_of_mem _ hbs) hb },
    { rw [real.Sup_of_not_bdd_above], rwa [bdd_above_coe] }
  end⟩⟩

instance : has_Inf ℝ≥0 :=
⟨λs, ⟨Inf ((coe : ℝ≥0 → ℝ) '' s),
  begin
    cases s.eq_empty_or_nonempty with h h,
    { simp [h, set.image_empty, real.Inf_empty] },
    exact le_cInf (h.image _) (assume r ⟨q, _, eq⟩, eq ▸ q.2)
  end⟩⟩

lemma coe_Sup (s : set ℝ≥0) : (↑(Sup s) : ℝ) = Sup ((coe : ℝ≥0 → ℝ) '' s) := rfl
lemma coe_Inf (s : set ℝ≥0) : (↑(Inf s) : ℝ) = Inf ((coe : ℝ≥0 → ℝ) '' s) := rfl

instance : conditionally_complete_linear_order_bot ℝ≥0 :=
{ Sup     := Sup,
  Inf     := Inf,
  le_cSup := assume s a hs ha, le_cSup (bdd_above_coe.2 hs) (set.mem_image_of_mem _ ha),
  cSup_le := assume s a hs h,show Sup ((coe : ℝ≥0 → ℝ) '' s) ≤ a, from
    cSup_le (by simp [hs]) $ assume r ⟨b, hb, eq⟩, eq ▸ h hb,
  cInf_le := assume s a _ has, cInf_le (bdd_below_coe s) (set.mem_image_of_mem _ has),
  le_cInf := assume s a hs h, show (↑a : ℝ) ≤ Inf ((coe : ℝ≥0 → ℝ) '' s), from
    le_cInf (by simp [hs]) $ assume r ⟨b, hb, eq⟩, eq ▸ h hb,
  cSup_empty := nnreal.eq $ by simp [coe_Sup, real.Sup_empty]; refl,
  decidable_le := begin assume x y, apply classical.dec end,
  .. nnreal.linear_ordered_semiring, .. lattice_of_linear_order,
  .. nnreal.order_bot }

instance : archimedean ℝ≥0 :=
⟨ assume x y pos_y,
  let ⟨n, hr⟩ := archimedean.arch (x:ℝ) (pos_y : (0 : ℝ) < y) in
  ⟨n, show (x:ℝ) ≤ (n • y : ℝ≥0), by simp [*, -nsmul_eq_mul, nsmul_coe]⟩ ⟩

lemma le_of_forall_pos_le_add {a b : ℝ≥0} (h : ∀ε, 0 < ε → a ≤ b + ε) : a ≤ b :=
le_of_forall_le_of_dense $ assume x hxb,
begin
  rcases le_iff_exists_add.1 (le_of_lt hxb) with ⟨ε, rfl⟩,
  exact h _ ((lt_add_iff_pos_right b).1 hxb)
end

-- TODO: generalize to some ordered add_monoids, based on #6145
lemma le_of_add_le_left {a b c : ℝ≥0} (h : a + b ≤ c) : a ≤ c :=
by { refine le_trans _ h, simp }

lemma le_of_add_le_right {a b c : ℝ≥0} (h : a + b ≤ c) : b ≤ c :=
by { refine le_trans _ h, simp }

lemma lt_iff_exists_rat_btwn (a b : ℝ≥0) :
  a < b ↔ (∃q:ℚ, 0 ≤ q ∧ a < nnreal.of_real q ∧ nnreal.of_real q < b) :=
iff.intro
  (assume (h : (↑a:ℝ) < (↑b:ℝ)),
    let ⟨q, haq, hqb⟩ := exists_rat_btwn h in
    have 0 ≤ (q : ℝ), from le_trans a.2 $ le_of_lt haq,
    ⟨q, rat.cast_nonneg.1 this, by simp [coe_of_real _ this, nnreal.coe_lt_coe.symm, haq, hqb]⟩)
  (assume ⟨q, _, haq, hqb⟩, lt_trans haq hqb)

lemma bot_eq_zero : (⊥ : ℝ≥0) = 0 := rfl

lemma mul_sup (a b c : ℝ≥0) : a * (b ⊔ c) = (a * b) ⊔ (a * c) :=
begin
  cases le_total b c with h h,
  { simp [sup_eq_max, max_eq_right h, max_eq_right (mul_le_mul_of_nonneg_left h (zero_le a))] },
  { simp [sup_eq_max, max_eq_left h, max_eq_left (mul_le_mul_of_nonneg_left h (zero_le a))] },
end

lemma mul_finset_sup {α} {f : α → ℝ≥0} {s : finset α} (r : ℝ≥0) :
  r * s.sup f = s.sup (λa, r * f a) :=
begin
  refine s.induction_on _ _,
  { simp [bot_eq_zero] },
  { assume a s has ih, simp [has, ih, mul_sup], }
end

@[simp, norm_cast] lemma coe_max (x y : ℝ≥0) :
  ((max x y : ℝ≥0) : ℝ) = max (x : ℝ) (y : ℝ) :=
by { delta max, split_ifs; refl }

@[simp, norm_cast] lemma coe_min (x y : ℝ≥0) :
  ((min x y : ℝ≥0) : ℝ) = min (x : ℝ) (y : ℝ) :=
by { delta min, split_ifs; refl }

section of_real

@[simp] lemma zero_le_coe {q : ℝ≥0} : 0 ≤ (q : ℝ) := q.2

@[simp] lemma of_real_zero : nnreal.of_real 0 = 0 :=
by simp [nnreal.of_real]; refl

@[simp] lemma of_real_one : nnreal.of_real 1 = 1 :=
by simp [nnreal.of_real, max_eq_left (zero_le_one : (0 :ℝ) ≤ 1)]; refl

@[simp] lemma of_real_pos {r : ℝ} : 0 < nnreal.of_real r ↔ 0 < r :=
by simp [nnreal.of_real, nnreal.coe_lt_coe.symm, lt_irrefl]

@[simp] lemma of_real_eq_zero {r : ℝ} : nnreal.of_real r = 0 ↔ r ≤ 0 :=
by simpa [-of_real_pos] using (not_iff_not.2 (@of_real_pos r))

lemma of_real_of_nonpos {r : ℝ} : r ≤ 0 → nnreal.of_real r = 0 :=
of_real_eq_zero.2

@[simp] lemma of_real_le_of_real_iff {r p : ℝ} (hp : 0 ≤ p) :
  nnreal.of_real r ≤ nnreal.of_real p ↔ r ≤ p :=
by simp [nnreal.coe_le_coe.symm, nnreal.of_real, hp]

@[simp] lemma of_real_lt_of_real_iff' {r p : ℝ} :
  nnreal.of_real r < nnreal.of_real p ↔ r < p ∧ 0 < p :=
by simp [nnreal.coe_lt_coe.symm, nnreal.of_real, lt_irrefl]

lemma of_real_lt_of_real_iff {r p : ℝ} (h : 0 < p) :
  nnreal.of_real r < nnreal.of_real p ↔ r < p :=
of_real_lt_of_real_iff'.trans (and_iff_left h)

lemma of_real_lt_of_real_iff_of_nonneg {r p : ℝ} (hr : 0 ≤ r) :
  nnreal.of_real r < nnreal.of_real p ↔ r < p :=
of_real_lt_of_real_iff'.trans ⟨and.left, λ h, ⟨h, lt_of_le_of_lt hr h⟩⟩

@[simp] lemma of_real_add {r p : ℝ} (hr : 0 ≤ r) (hp : 0 ≤ p) :
  nnreal.of_real (r + p) = nnreal.of_real r + nnreal.of_real p :=
nnreal.eq $ by simp [nnreal.of_real, hr, hp, add_nonneg]

lemma of_real_add_of_real {r p : ℝ} (hr : 0 ≤ r) (hp : 0 ≤ p) :
  nnreal.of_real r + nnreal.of_real p = nnreal.of_real (r + p) :=
(of_real_add hr hp).symm

lemma of_real_le_of_real {r p : ℝ} (h : r ≤ p) : nnreal.of_real r ≤ nnreal.of_real p :=
nnreal.of_real_mono h

lemma of_real_add_le {r p : ℝ} : nnreal.of_real (r + p) ≤ nnreal.of_real r + nnreal.of_real p :=
nnreal.coe_le_coe.1 $ max_le (add_le_add (le_max_left _ _) (le_max_left _ _)) nnreal.zero_le_coe

lemma of_real_le_iff_le_coe {r : ℝ} {p : ℝ≥0} : nnreal.of_real r ≤ p ↔ r ≤ ↑p :=
nnreal.gi.gc r p

lemma le_of_real_iff_coe_le {r : ℝ≥0} {p : ℝ} (hp : 0 ≤ p) : r ≤ nnreal.of_real p ↔ ↑r ≤ p :=
by rw [← nnreal.coe_le_coe, nnreal.coe_of_real p hp]

lemma le_of_real_iff_coe_le' {r : ℝ≥0} {p : ℝ} (hr : 0 < r) : r ≤ nnreal.of_real p ↔ ↑r ≤ p :=
(le_or_lt 0 p).elim le_of_real_iff_coe_le $ λ hp,
  by simp only [(hp.trans_le r.coe_nonneg).not_le, of_real_eq_zero.2 hp.le, hr.not_le]

lemma of_real_lt_iff_lt_coe {r : ℝ} {p : ℝ≥0} (ha : 0 ≤ r) : nnreal.of_real r < p ↔ r < ↑p :=
by rw [← nnreal.coe_lt_coe, nnreal.coe_of_real r ha]

lemma lt_of_real_iff_coe_lt {r : ℝ≥0} {p : ℝ} : r < nnreal.of_real p ↔ ↑r < p :=
begin
  cases le_total 0 p,
  { rw [← nnreal.coe_lt_coe, nnreal.coe_of_real p h] },
  { rw [of_real_eq_zero.2 h], split,
    intro, have := not_lt_of_le (zero_le r), contradiction,
    intro rp, have : ¬(p ≤ 0) := not_le_of_lt (lt_of_le_of_lt (coe_nonneg _) rp), contradiction }
end

@[simp] lemma of_real_bit0 {r : ℝ} (hr : 0 ≤ r) :
  nnreal.of_real (bit0 r) = bit0 (nnreal.of_real r) :=
of_real_add hr hr

@[simp] lemma of_real_bit1 {r : ℝ} (hr : 0 ≤ r) :
  nnreal.of_real (bit1 r) = bit1 (nnreal.of_real r) :=
(of_real_add (by simp [hr]) zero_le_one).trans (by simp [of_real_one, bit1, hr])

end of_real

section mul

lemma mul_eq_mul_left {a b c : ℝ≥0} (h : a ≠ 0) : (a * b = a * c ↔ b = c) :=
begin
  rw [← nnreal.eq_iff, ← nnreal.eq_iff, nnreal.coe_mul, nnreal.coe_mul], split,
  { exact mul_left_cancel' (mt (@nnreal.eq_iff a 0).1 h) },
  { assume h, rw [h] }
end

lemma of_real_mul {p q : ℝ} (hp : 0 ≤ p) :
  nnreal.of_real (p * q) = nnreal.of_real p * nnreal.of_real q :=
begin
  cases le_total 0 q with hq hq,
  { apply nnreal.eq,
    simp [nnreal.of_real, hp, hq, max_eq_left, mul_nonneg] },
  { have hpq := mul_nonpos_of_nonneg_of_nonpos hp hq,
    rw [of_real_eq_zero.2 hq, of_real_eq_zero.2 hpq, mul_zero] }
end

end mul

section sub

lemma sub_def {r p : ℝ≥0} : r - p = nnreal.of_real (r - p) := rfl

lemma sub_eq_zero {r p : ℝ≥0} (h : r ≤ p) : r - p = 0 :=
nnreal.eq $ max_eq_right $ sub_le_iff_le_add.2 $ by simpa [nnreal.coe_le_coe] using h

@[simp] lemma sub_self {r : ℝ≥0} : r - r = 0 := sub_eq_zero $ le_refl r

@[simp] lemma sub_zero {r : ℝ≥0} : r - 0 = r :=
by rw [sub_def, nnreal.coe_zero, sub_zero, nnreal.of_real_coe]

lemma sub_pos {r p : ℝ≥0} : 0 < r - p ↔ p < r :=
of_real_pos.trans $ sub_pos.trans $ nnreal.coe_lt_coe

protected lemma sub_lt_self {r p : ℝ≥0} : 0 < r → 0 < p → r - p < r :=
assume hr hp,
begin
  cases le_total r p,
  { rwa [sub_eq_zero h] },
  { rw [← nnreal.coe_lt_coe, nnreal.coe_sub h], exact sub_lt_self _ hp }
end

@[simp] lemma sub_le_iff_le_add {r p q : ℝ≥0} : r - p ≤ q ↔ r ≤ q + p :=
match le_total p r with
| or.inl h := by rw [← nnreal.coe_le_coe, ← nnreal.coe_le_coe, nnreal.coe_sub h, nnreal.coe_add,
    sub_le_iff_le_add]
| or.inr h :=
  have r ≤ p + q, from le_add_right h,
  by simpa [nnreal.coe_le_coe, nnreal.coe_le_coe, sub_eq_zero h, add_comm]
end

@[simp] lemma sub_le_self {r p : ℝ≥0} : r - p ≤ r :=
sub_le_iff_le_add.2 $ le_add_right $ le_refl r

lemma add_sub_cancel {r p : ℝ≥0} : (p + r) - r = p :=
nnreal.eq $ by rw [nnreal.coe_sub, nnreal.coe_add, add_sub_cancel]; exact le_add_left (le_refl _)

lemma add_sub_cancel' {r p : ℝ≥0} : (r + p) - r = p :=
by rw [add_comm, add_sub_cancel]

lemma sub_add_eq_max {r p : ℝ≥0} : (r - p) + p = max r p :=
nnreal.eq $ by rw [sub_def, nnreal.coe_add, coe_max, nnreal.of_real, coe_mk,
  ← max_add_add_right, zero_add, sub_add_cancel]

lemma add_sub_eq_max {r p : ℝ≥0} : p + (r - p) = max p r :=
by rw [add_comm, sub_add_eq_max, max_comm]

@[simp] lemma sub_add_cancel_of_le {a b : ℝ≥0} (h : b ≤ a) : (a - b) + b = a :=
by rw [sub_add_eq_max, max_eq_left h]

lemma sub_sub_cancel_of_le {r p : ℝ≥0} (h : r ≤ p) : p - (p - r) = r :=
by rw [nnreal.sub_def, nnreal.sub_def, nnreal.coe_of_real _ $ sub_nonneg.2 h,
  sub_sub_cancel, nnreal.of_real_coe]

lemma lt_sub_iff_add_lt {p q r : ℝ≥0} : p < q - r ↔ p + r < q :=
begin
  split,
  { assume H,
    have : (((q - r) : ℝ≥0) : ℝ) = (q : ℝ) - (r : ℝ) :=
      nnreal.coe_sub (le_of_lt (sub_pos.1 (lt_of_le_of_lt (zero_le _) H))),
    rwa [← nnreal.coe_lt_coe, this, lt_sub_iff_add_lt, ← nnreal.coe_add] at H },
  { assume H,
    have : r ≤ q := le_trans (le_add_left (le_refl _)) (le_of_lt H),
    rwa [← nnreal.coe_lt_coe, nnreal.coe_sub this, lt_sub_iff_add_lt, ← nnreal.coe_add] }
end

lemma sub_lt_iff_lt_add {a b c : ℝ≥0} (h : b ≤ a) : a - b < c ↔ a < b + c :=
by simp only [←nnreal.coe_lt_coe, nnreal.coe_sub h, nnreal.coe_add, sub_lt_iff_lt_add']

lemma sub_eq_iff_eq_add {a b c : ℝ≥0} (h : b ≤ a) : a - b = c ↔ a = c + b :=
by rw [←nnreal.eq_iff, nnreal.coe_sub h, ←nnreal.eq_iff, nnreal.coe_add, sub_eq_iff_eq_add]

end sub

section inv

lemma sum_div {ι} (s : finset ι) (f : ι → ℝ≥0) (b : ℝ≥0) :
  (∑ i in s, f i) / b = ∑ i in s, (f i / b) :=
by simp only [div_eq_mul_inv, finset.sum_mul]

@[simp] lemma inv_pos {r : ℝ≥0} : 0 < r⁻¹ ↔ 0 < r :=
by simp [pos_iff_ne_zero]

lemma div_pos {r p : ℝ≥0} (hr : 0 < r) (hp : 0 < p) : 0 < r / p :=
by simpa only [div_eq_mul_inv] using mul_pos hr (inv_pos.2 hp)

protected lemma mul_inv {r p : ℝ≥0} : (r * p)⁻¹ = p⁻¹ * r⁻¹ := nnreal.eq $ mul_inv_rev' _ _

lemma div_self_le (r : ℝ≥0) : r / r ≤ 1 :=
if h : r = 0 then by simp [h] else by rw [div_self h]

@[simp] lemma inv_le {r p : ℝ≥0} (h : r ≠ 0) : r⁻¹ ≤ p ↔ 1 ≤ r * p :=
by rw [← mul_le_mul_left (pos_iff_ne_zero.2 h), mul_inv_cancel h]

lemma inv_le_of_le_mul {r p : ℝ≥0} (h : 1 ≤ r * p) : r⁻¹ ≤ p :=
by by_cases r = 0; simp [*, inv_le]

@[simp] lemma le_inv_iff_mul_le {r p : ℝ≥0} (h : p ≠ 0) : (r ≤ p⁻¹ ↔ r * p ≤ 1) :=
by rw [← mul_le_mul_left (pos_iff_ne_zero.2 h), mul_inv_cancel h, mul_comm]

@[simp] lemma lt_inv_iff_mul_lt {r p : ℝ≥0} (h : p ≠ 0) : (r < p⁻¹ ↔ r * p < 1) :=
by rw [← mul_lt_mul_left (pos_iff_ne_zero.2 h), mul_inv_cancel h, mul_comm]

lemma mul_le_iff_le_inv {a b r : ℝ≥0} (hr : r ≠ 0) : r * a ≤ b ↔ a ≤ r⁻¹ * b :=
have 0 < r, from lt_of_le_of_ne (zero_le r) hr.symm,
by rw [← @mul_le_mul_left _ _ a _ r this, ← mul_assoc, mul_inv_cancel hr, one_mul]

lemma le_div_iff_mul_le {a b r : ℝ≥0} (hr : r ≠ 0) : a ≤ b / r ↔ a * r ≤ b :=
by rw [div_eq_inv_mul, ← mul_le_iff_le_inv hr, mul_comm]

lemma div_le_iff {a b r : ℝ≥0} (hr : r ≠ 0) : a / r ≤ b ↔ a ≤ b * r :=
@div_le_iff ℝ _ a r b $ pos_iff_ne_zero.2 hr

lemma lt_div_iff {a b r : ℝ≥0} (hr : r ≠ 0) : a < b / r ↔ a * r < b :=
lt_iff_lt_of_le_iff_le (div_le_iff hr)

lemma mul_lt_of_lt_div {a b r : ℝ≥0} (h : a < b / r) : a * r < b :=
begin
  refine (lt_div_iff $ λ hr, false.elim _).1 h,
  subst r,
  simpa using h
end

lemma le_of_forall_lt_one_mul_le {x y : ℝ≥0} (h : ∀a<1, a * x ≤ y) : x ≤ y :=
le_of_forall_ge_of_dense $ assume a ha,
  have hx : x ≠ 0 := pos_iff_ne_zero.1 (lt_of_le_of_lt (zero_le _) ha),
  have hx' : x⁻¹ ≠ 0, by rwa [(≠), inv_eq_zero],
  have a * x⁻¹ < 1, by rwa [← lt_inv_iff_mul_lt hx', inv_inv'],
  have (a * x⁻¹) * x ≤ y, from h _ this,
  by rwa [mul_assoc, inv_mul_cancel hx, mul_one] at this

lemma div_add_div_same (a b c : ℝ≥0) : a / c + b / c = (a + b) / c :=
eq.symm $ right_distrib a b (c⁻¹)

lemma half_pos {a : ℝ≥0} (h : 0 < a) : 0 < a / 2 := div_pos h zero_lt_two

lemma add_halves (a : ℝ≥0) : a / 2 + a / 2 = a := nnreal.eq (add_halves a)

lemma half_lt_self {a : ℝ≥0} (h : a ≠ 0) : a / 2 < a :=
by rw [← nnreal.coe_lt_coe, nnreal.coe_div]; exact
half_lt_self (bot_lt_iff_ne_bot.2 h)

lemma two_inv_lt_one : (2⁻¹:ℝ≥0) < 1 :=
by simpa using half_lt_self zero_ne_one.symm

lemma div_lt_iff {a b c : ℝ≥0} (hc : c ≠ 0) : b / c < a ↔ b < a * c :=
lt_iff_lt_of_le_iff_le $ nnreal.le_div_iff_mul_le hc

lemma div_lt_one_of_lt {a b : ℝ≥0} (h : a < b) : a / b < 1 :=
begin
  rwa [div_lt_iff, one_mul],
  exact ne_of_gt (lt_of_le_of_lt (zero_le _) h)
end

@[field_simps] lemma div_add_div (a : ℝ≥0) {b : ℝ≥0} (c : ℝ≥0) {d : ℝ≥0}
  (hb : b ≠ 0) (hd : d ≠ 0) : a / b + c / d = (a * d + b * c) / (b * d) :=
begin
  rw ← nnreal.eq_iff,
  simp only [nnreal.coe_add, nnreal.coe_div, nnreal.coe_mul],
  exact div_add_div _ _ (coe_ne_zero.2 hb) (coe_ne_zero.2 hd)
end

@[field_simps] lemma add_div' (a b c : ℝ≥0) (hc : c ≠ 0) :
  b + a / c = (b * c + a) / c :=
by simpa using div_add_div b a one_ne_zero hc

@[field_simps] lemma div_add' (a b c : ℝ≥0) (hc : c ≠ 0) :
  a / c + b = (a + b * c) / c :=
by rwa [add_comm, add_div', add_comm]

lemma of_real_inv {x : ℝ} :
  nnreal.of_real x⁻¹ = (nnreal.of_real x)⁻¹ :=
begin
  by_cases hx : 0 ≤ x,
  { nth_rewrite 0 ← coe_of_real x hx,
    rw [←nnreal.coe_inv, of_real_coe], },
  { have hx' := le_of_not_ge hx,
    rw [of_real_eq_zero.mpr hx', inv_zero, of_real_eq_zero.mpr (inv_nonpos.mpr hx')], },
end

lemma of_real_div {x y : ℝ} (hx : 0 ≤ x) :
  nnreal.of_real (x / y) = nnreal.of_real x / nnreal.of_real y :=
by rw [div_eq_mul_inv, div_eq_mul_inv, ←of_real_inv, ←of_real_mul hx]

lemma of_real_div' {x y : ℝ} (hy : 0 ≤ y) :
  nnreal.of_real (x / y) = nnreal.of_real x / nnreal.of_real y :=
by rw [div_eq_inv_mul, div_eq_inv_mul, of_real_mul (inv_nonneg.2 hy), of_real_inv]

end inv

@[simp] lemma abs_eq (x : ℝ≥0) : abs (x : ℝ) = x :=
abs_of_nonneg x.property

end nnreal

/-- The absolute value on `ℝ` as a map to `ℝ≥0`. -/
@[pp_nodot] def real.nnabs (x : ℝ) : ℝ≥0 := ⟨abs x, abs_nonneg x⟩

@[norm_cast, simp] lemma nnreal.coe_nnabs (x : ℝ) : (real.nnabs x : ℝ) = abs x :=
by simp [real.nnabs]


/-
Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import analysis.convex.function
import analysis.convex.strict_convex_space
import measure_theory.function.ae_eq_of_integral
import measure_theory.integral.average

/-!
# Jensen's inequality for integrals

In this file we prove several forms of Jensen's inequality for integrals.

- for convex sets: `convex.average_mem`, `convex.set_average_mem`, `convex.integral_mem`;

- for convex functions: `convex.on.average_mem_epigraph`, `convex_on.map_average_le`,
  `convex_on.set_average_mem_epigraph`, `convex_on.map_set_average_le`, `convex_on.map_integral_le`;

- for strictly convex sets: `strict_convex.ae_eq_const_or_average_mem_interior`;

- for a closed ball in a strictly convex normed space:
  `ae_eq_const_or_norm_integral_lt_of_norm_le_const`;

- for strictly convex functions: `strict_convex_on.ae_eq_const_or_map_average_lt`.

## TODO

- Use a typeclass for strict convexity of a closed ball.

## Tags

convex, integral, center mass, average value, Jensen's inequality
-/

open measure_theory measure_theory.measure metric set filter topological_space function
open_locale topological_space big_operators ennreal convex

variables {α E F : Type*} {m0 : measurable_space α}
  [normed_group E] [normed_space ℝ E] [complete_space E]
  [normed_group F] [normed_space ℝ F] [complete_space F]
  {μ : measure α} {s : set E}

/-!
### Non-strict Jensen's inequality
-/

/-- If `μ` is a probability measure on `α`, `s` is a convex closed set in `E`, and `f` is an
integrable function sending `μ`-a.e. points to `s`, then the expected value of `f` belongs to `s`:
`∫ x, f x ∂μ ∈ s`. See also `convex.sum_mem` for a finite sum version of this lemma. -/
lemma convex.integral_mem [is_probability_measure μ] {s : set E} (hs : convex ℝ s)
  (hsc : is_closed s) {f : α → E} (hf : ∀ᵐ x ∂μ, f x ∈ s) (hfi : integrable f μ) :
  ∫ x, f x ∂μ ∈ s :=
begin
  borelize E,
  rcases hfi.ae_strongly_measurable with ⟨g, hgm, hfg⟩,
  haveI : separable_space (range g ∩ s : set E) :=
    (hgm.is_separable_range.mono (inter_subset_left _ _)).separable_space,
  obtain ⟨y₀, h₀⟩ : (range g ∩ s).nonempty,
  { rcases (hf.and hfg).exists with ⟨x₀, h₀⟩,
    exact ⟨f x₀, by simp only [h₀.2, mem_range_self], h₀.1⟩ },
  rw [integral_congr_ae hfg], rw [integrable_congr hfg] at hfi,
  have hg : ∀ᵐ x ∂μ, g x ∈ closure (range g ∩ s),
  { filter_upwards [hfg.rw (λ x y, y ∈ s) hf] with x hx,
    apply subset_closure,
    exact ⟨mem_range_self _, hx⟩ },
  set G : ℕ → simple_func α E := simple_func.approx_on _ hgm.measurable (range g ∩ s) y₀ h₀,
  have : tendsto (λ n, (G n).integral μ) at_top (𝓝 $ ∫ x, g x ∂μ),
    from tendsto_integral_approx_on_of_measurable hfi _ hg _ (integrable_const _),
  refine hsc.mem_of_tendsto this (eventually_of_forall $ λ n, hs.sum_mem _ _ _),
  { exact λ _ _, ennreal.to_real_nonneg },
  { rw [← ennreal.to_real_sum, (G n).sum_range_measure_preimage_singleton, measure_univ,
      ennreal.one_to_real],
    exact λ _ _, measure_ne_top _ _ },
  { simp only [simple_func.mem_range, forall_range_iff],
    assume x,
    apply inter_subset_right (range g),
    exact simple_func.approx_on_mem hgm.measurable _ _ _ },
end

/-- If `μ` is a non-zero finite measure on `α`, `s` is a convex closed set in `E`, and `f` is an
integrable function sending `μ`-a.e. points to `s`, then the average value of `f` belongs to `s`:
`⨍ x, f x ∂μ ∈ s`. See also `convex.center_mass_mem` for a finite sum version of this lemma. -/
lemma convex.average_mem [is_finite_measure μ] {s : set E} (hs : convex ℝ s) (hsc : is_closed s)
  (hμ : μ ≠ 0) {f : α → E} (hfs : ∀ᵐ x ∂μ, f x ∈ s) (hfi : integrable f μ) :
  ⨍ x, f x ∂μ ∈ s :=
begin
  haveI : is_probability_measure ((μ univ)⁻¹ • μ),
    from is_probability_measure_smul hμ,
  refine hs.integral_mem hsc (ae_mono' _ hfs) hfi.to_average,
  exact absolutely_continuous.smul (refl _) _
end

/-- If `μ` is a non-zero finite measure on `α`, `s` is a convex closed set in `E`, and `f` is an
integrable function sending `μ`-a.e. points to `s`, then the average value of `f` belongs to `s`:
`⨍ x, f x ∂μ ∈ s`. See also `convex.center_mass_mem` for a finite sum version of this lemma. -/
lemma convex.set_average_mem {t : set α} {s : set E} (hs : convex ℝ s) (hsc : is_closed s)
  (h0 : μ t ≠ 0) (ht : μ t ≠ ∞) {f : α → E} (hfs : ∀ᵐ x ∂μ.restrict t, f x ∈ s)
  (hfi : integrable_on f t μ) :
  ⨍ x in t, f x ∂μ ∈ s :=
begin
  haveI : fact (μ t < ∞) := ⟨ht.lt_top⟩,
  refine hs.average_mem hsc _ hfs hfi,
  rwa [ne.def, restrict_eq_zero]
end

lemma convex_on.average_mem_epigraph [is_finite_measure μ] {s : set E} {g : E → ℝ}
  (hg : convex_on ℝ s g) (hgc : continuous_on g s) (hsc : is_closed s) (hμ : μ ≠ 0) {f : α → E}
  (hfs : ∀ᵐ x ∂μ, f x ∈ s) (hfi : integrable f μ) (hgi : integrable (g ∘ f) μ) :
  (⨍ x, f x ∂μ, ⨍ x, g (f x) ∂μ) ∈ {p : E × ℝ | p.1 ∈ s ∧ g p.1 ≤ p.2} :=
have ht_mem : ∀ᵐ x ∂μ, (f x, g (f x)) ∈ {p : E × ℝ | p.1 ∈ s ∧ g p.1 ≤ p.2},
  from hfs.mono (λ x hx, ⟨hx, le_rfl⟩),
by simpa only [average_pair hfi hgi]
  using hg.convex_epigraph.average_mem (hsc.epigraph hgc) hμ ht_mem (hfi.prod_mk hgi)

lemma concave_on.average_mem_hypograph [is_finite_measure μ] {s : set E} {g : E → ℝ}
  (hg : concave_on ℝ s g) (hgc : continuous_on g s) (hsc : is_closed s) (hμ : μ ≠ 0) {f : α → E}
  (hfs : ∀ᵐ x ∂μ, f x ∈ s) (hfi : integrable f μ) (hgi : integrable (g ∘ f) μ) :
  (⨍ x, f x ∂μ, ⨍ x, g (f x) ∂μ) ∈ {p : E × ℝ | p.1 ∈ s ∧ p.2 ≤ g p.1} :=
by simpa only [mem_set_of_eq, pi.neg_apply, average_neg, neg_le_neg_iff]
  using hg.neg.average_mem_epigraph hgc.neg hsc hμ hfs hfi hgi.neg

/-- **Jensen's inequality**: if a function `g : E → ℝ` is convex and continuous on a convex closed
set `s`, `μ` is a finite non-zero measure on `α`, and `f : α → E` is a function sending
`μ`-a.e. points to `s`, then the value of `g` at the average value of `f` is less than or equal to
the average value of `g ∘ f` provided that both `f` and `g ∘ f` are integrable. See also
`convex_on.map_center_mass_le` for a finite sum version of this lemma. -/
lemma convex_on.map_average_le [is_finite_measure μ] {s : set E} {g : E → ℝ}
  (hg : convex_on ℝ s g) (hgc : continuous_on g s) (hsc : is_closed s) (hμ : μ ≠ 0) {f : α → E}
  (hfs : ∀ᵐ x ∂μ, f x ∈ s) (hfi : integrable f μ) (hgi : integrable (g ∘ f) μ) :
  g (⨍ x, f x ∂μ) ≤ ⨍ x, g (f x) ∂μ :=
(hg.average_mem_epigraph hgc hsc hμ hfs hfi hgi).2

/-- **Jensen's inequality**: if a function `g : E → ℝ` is concave and continuous on a convex closed
set `s`, `μ` is a finite non-zero measure on `α`, and `f : α → E` is a function sending
`μ`-a.e. points to `s`, then the average value of `g ∘ f` is less than or equal to the value of `g`
at the average value of `f` provided that both `f` and `g ∘ f` are integrable. See also
`concave_on.le_map_center_mass` for a finite sum version of this lemma. -/
lemma concave_on.le_map_average [is_finite_measure μ] {s : set E} {g : E → ℝ}
  (hg : concave_on ℝ s g) (hgc : continuous_on g s) (hsc : is_closed s) (hμ : μ ≠ 0) {f : α → E}
  (hfs : ∀ᵐ x ∂μ, f x ∈ s) (hfi : integrable f μ) (hgi : integrable (g ∘ f) μ) :
  ⨍ x, g (f x) ∂μ ≤ g (⨍ x, f x ∂μ) :=
(hg.average_mem_hypograph hgc hsc hμ hfs hfi hgi).2

/-- **Jensen's inequality**: if a function `g : E → ℝ` is convex and continuous on a convex closed
set `s`, `μ` is a finite non-zero measure on `α`, and `f : α → E` is a function sending
`μ`-a.e. points of a set `t` to `s`, then the value of `g` at the average value of `f` over `t` is
less than or equal to the average value of `g ∘ f` over `t` provided that both `f` and `g ∘ f` are
integrable. -/
lemma convex_on.set_average_mem_epigraph {s : set E} {g : E → ℝ} (hg : convex_on ℝ s g)
  (hgc : continuous_on g s) (hsc : is_closed s) {t : set α} (h0 : μ t ≠ 0)
  (ht : μ t ≠ ∞) {f : α → E} (hfs : ∀ᵐ x ∂μ.restrict t, f x ∈ s) (hfi : integrable_on f t μ)
  (hgi : integrable_on (g ∘ f) t μ) :
  (⨍ x in t, f x ∂μ, ⨍ x in t, g (f x) ∂μ) ∈ {p : E × ℝ | p.1 ∈ s ∧ g p.1 ≤ p.2} :=
begin
  haveI : fact (μ t < ∞) := ⟨ht.lt_top⟩,
  refine hg.average_mem_epigraph hgc hsc _ hfs hfi hgi,
  rwa [ne.def, restrict_eq_zero]
end

/-- **Jensen's inequality**: if a function `g : E → ℝ` is concave and continuous on a convex closed
set `s`, `μ` is a finite non-zero measure on `α`, and `f : α → E` is a function sending
`μ`-a.e. points of a set `t` to `s`, then the average value of `g ∘ f` over `t` is less than or
equal to the value of `g` at the average value of `f` over `t` provided that both `f` and `g ∘ f`
are integrable. -/
lemma concave_on.set_average_mem_hypograph {s : set E} {g : E → ℝ} (hg : concave_on ℝ s g)
  (hgc : continuous_on g s) (hsc : is_closed s) {t : set α} (h0 : μ t ≠ 0)
  (ht : μ t ≠ ∞) {f : α → E} (hfs : ∀ᵐ x ∂μ.restrict t, f x ∈ s) (hfi : integrable_on f t μ)
  (hgi : integrable_on (g ∘ f) t μ) :
  (⨍ x in t, f x ∂μ, ⨍ x in t, g (f x) ∂μ) ∈ {p : E × ℝ | p.1 ∈ s ∧ p.2 ≤ g p.1} :=
by simpa only [mem_set_of_eq, pi.neg_apply, average_neg, neg_le_neg_iff]
  using hg.neg.set_average_mem_epigraph hgc.neg hsc h0 ht hfs hfi hgi.neg

/-- **Jensen's inequality**: if a function `g : E → ℝ` is convex and continuous on a convex closed
set `s`, `μ` is a finite non-zero measure on `α`, and `f : α → E` is a function sending
`μ`-a.e. points of a set `t` to `s`, then the value of `g` at the average value of `f` over `t` is
less than or equal to the average value of `g ∘ f` over `t` provided that both `f` and `g ∘ f` are
integrable. -/
lemma convex_on.map_set_average_le {s : set E} {g : E → ℝ} (hg : convex_on ℝ s g)
  (hgc : continuous_on g s) (hsc : is_closed s) {t : set α} (h0 : μ t ≠ 0)
  (ht : μ t ≠ ∞) {f : α → E} (hfs : ∀ᵐ x ∂μ.restrict t, f x ∈ s) (hfi : integrable_on f t μ)
  (hgi : integrable_on (g ∘ f) t μ) :
  g (⨍ x in t, f x ∂μ) ≤ ⨍ x in t, g (f x) ∂μ :=
(hg.set_average_mem_epigraph hgc hsc h0 ht hfs hfi hgi).2

/-- **Jensen's inequality**: if a function `g : E → ℝ` is concave and continuous on a convex closed
set `s`, `μ` is a finite non-zero measure on `α`, and `f : α → E` is a function sending
`μ`-a.e. points of a set `t` to `s`, then the average value of `g ∘ f` over `t` is less than or
equal to the value of `g` at the average value of `f` over `t` provided that both `f` and `g ∘ f`
are integrable. -/
lemma concave_on.le_map_set_average {s : set E} {g : E → ℝ} (hg : concave_on ℝ s g)
  (hgc : continuous_on g s) (hsc : is_closed s) {t : set α} (h0 : μ t ≠ 0)
  (ht : μ t ≠ ∞) {f : α → E} (hfs : ∀ᵐ x ∂μ.restrict t, f x ∈ s) (hfi : integrable_on f t μ)
  (hgi : integrable_on (g ∘ f) t μ) :
  ⨍ x in t, g (f x) ∂μ ≤ g (⨍ x in t, f x ∂μ) :=
(hg.set_average_mem_hypograph hgc hsc h0 ht hfs hfi hgi).2

/-- **Jensen's inequality**: if a function `g : E → ℝ` is convex and continuous on a convex closed
set `s`, `μ` is a probability measure on `α`, and `f : α → E` is a function sending `μ`-a.e.  points
to `s`, then the value of `g` at the expected value of `f` is less than or equal to the expected
value of `g ∘ f` provided that both `f` and `g ∘ f` are integrable. See also
`convex_on.map_center_mass_le` for a finite sum version of this lemma. -/
lemma convex_on.map_integral_le [is_probability_measure μ] {s : set E} {g : E → ℝ}
  (hg : convex_on ℝ s g) (hgc : continuous_on g s) (hsc : is_closed s) {f : α → E}
  (hfs : ∀ᵐ x ∂μ, f x ∈ s) (hfi : integrable f μ) (hgi : integrable (g ∘ f) μ) :
  g (∫ x, f x ∂μ) ≤ ∫ x, g (f x) ∂μ :=
by simpa only [average_eq_integral]
  using hg.map_average_le hgc hsc (is_probability_measure.ne_zero μ) hfs hfi hgi

/-- **Jensen's inequality**: if a function `g : E → ℝ` is concave and continuous on a convex closed
set `s`, `μ` is a probability measure on `α`, and `f : α → E` is a function sending `μ`-a.e.  points
to `s`, then the expected value of `g ∘ f` is less than or equal to the value of `g` at the expected
value of `f` provided that both `f` and `g ∘ f` are integrable. -/
lemma concave_on.le_map_integral [is_probability_measure μ] {s : set E} {g : E → ℝ}
  (hg : concave_on ℝ s g) (hgc : continuous_on g s) (hsc : is_closed s) {f : α → E}
  (hfs : ∀ᵐ x ∂μ, f x ∈ s) (hfi : integrable f μ) (hgi : integrable (g ∘ f) μ) :
  ∫ x, g (f x) ∂μ ≤ g (∫ x, f x ∂μ) :=
by simpa only [average_eq_integral]
  using hg.le_map_average hgc hsc (is_probability_measure.ne_zero μ) hfs hfi hgi

/-!
### Strict Jensen's inequality
-/

/-- If `f : α → E` is an integrable function, then either it is a.e. equal to the constant
`⨍ x, f x ∂μ` or there exists a measurable set such that `μ s ≠ 0`, `μ sᶜ ≠ 0`, and the average
values of `f` over `s` and `sᶜ` are different. -/
lemma measure_theory.integrable.ae_eq_const_or_exists_average_ne_compl [is_finite_measure μ]
  {f : α → E} (hfi : integrable f μ) :
  (f =ᵐ[μ] const α (⨍ x, f x ∂μ)) ∨ ∃ s, measurable_set s ∧ μ s ≠ 0 ∧ μ sᶜ ≠ 0 ∧
    ⨍ x in s, f x ∂μ ≠ ⨍ x in sᶜ, f x ∂μ :=
begin
  refine or_iff_not_imp_right.mpr (λ H, _), push_neg at H,
  refine hfi.ae_eq_of_forall_set_integral_eq _ _ (integrable_const _) (λ s hs hs', _), clear hs',
  simp only [const_apply, set_integral_const],
  by_cases h₀ : μ s = 0,
  { rw [restrict_eq_zero.2 h₀, integral_zero_measure, h₀, ennreal.zero_to_real, zero_smul] },
  by_cases h₀' : μ sᶜ = 0,
  { rw ← ae_eq_univ at h₀',
    rw [restrict_congr_set h₀', restrict_univ, measure_congr h₀', measure_smul_average] },
  have := average_mem_open_segment_compl_self hs.null_measurable_set h₀ h₀' hfi,
  rw [← H s hs h₀ h₀', open_segment_same, mem_singleton_iff] at this,
  rw [this, measure_smul_set_average _ (measure_ne_top μ _)]
end

/-- If an integrable function `f : α → E` takes values in a convex closed set `s` and for some set
`t` of positive measure, the average value of `f` over `t` belongs to the interior of `s`, then the
average of `f` over the whole space belongs to the interior of `s`. -/
lemma convex.average_mem_interior_of_set [is_finite_measure μ] {t : set α} {s : set E}
  (hs : convex ℝ s) (hsc : is_closed s) (h0 : μ t ≠ 0) {f : α → E} (hfs : ∀ᵐ x ∂μ, f x ∈ s)
  (hfi : integrable f μ) (ht : ⨍ x in t, f x ∂μ ∈ interior s) :
  ⨍ x, f x ∂μ ∈ interior s :=
begin
  rw ← measure_to_measurable at h0, rw ← restrict_to_measurable (measure_ne_top μ t) at ht,
  by_cases h0' : μ (to_measurable μ t)ᶜ = 0,
  { rw ← ae_eq_univ at h0',
    rwa [restrict_congr_set h0', restrict_univ] at ht },
  exact hs.open_segment_subset_interior_left ht
    (hs.set_average_mem hsc h0' (measure_ne_top _ _) (ae_restrict_of_ae hfs) hfi.integrable_on)
    (average_mem_open_segment_compl_self (measurable_set_to_measurable μ t).null_measurable_set
      h0 h0' hfi)
end

/-- If an integrable function `f : α → E` takes values in a strictly convex closed set `s`, then
either it is a.e. equal to its average value, or its average value belongs to the interior of
`s`. -/
lemma strict_convex.ae_eq_const_or_average_mem_interior [is_finite_measure μ] {s : set E}
  (hs : strict_convex ℝ s) (hsc : is_closed s) {f : α → E} (hfs : ∀ᵐ x ∂μ, f x ∈ s)
  (hfi : integrable f μ) :
  f =ᵐ[μ] const α (⨍ x, f x ∂μ) ∨ ⨍ x, f x ∂μ ∈ interior s :=
begin
  have : ∀ {t}, μ t ≠ 0 → ⨍ x in t, f x ∂μ ∈ s,
    from λ t ht, hs.convex.set_average_mem hsc ht (measure_ne_top _ _) (ae_restrict_of_ae hfs)
      hfi.integrable_on,
  refine hfi.ae_eq_const_or_exists_average_ne_compl.imp_right _,
  rintro ⟨t, hm, h₀, h₀', hne⟩,
  exact hs.open_segment_subset (this h₀) (this h₀') hne
    (average_mem_open_segment_compl_self hm.null_measurable_set h₀ h₀' hfi)
end

/-- **Jensen's inequality**, strict version: if an integrable function `f : α → E` takes values in a
convex closed set `s`, and `g : E → ℝ` is continuous and strictly convex on `s`, then
either `f` is a.e. equal to its average value, or `g (⨍ x, f x ∂μ) < ⨍ x, g (f x) ∂μ`. -/
lemma strict_convex_on.ae_eq_const_or_map_average_lt [is_finite_measure μ] {s : set E} {g : E → ℝ}
  (hg : strict_convex_on ℝ s g) (hgc : continuous_on g s) (hsc : is_closed s) {f : α → E}
  (hfs : ∀ᵐ x ∂μ, f x ∈ s) (hfi : integrable f μ) (hgi : integrable (g ∘ f) μ) :
  f =ᵐ[μ] const α (⨍ x, f x ∂μ) ∨ g (⨍ x, f x ∂μ) < ⨍ x, g (f x) ∂μ :=
begin
  have : ∀ {t}, μ t ≠ 0 → ⨍ x in t, f x ∂μ ∈ s ∧ g (⨍ x in t, f x ∂μ) ≤ ⨍ x in t, g (f x) ∂μ,
    from λ t ht, hg.convex_on.set_average_mem_epigraph hgc hsc ht (measure_ne_top _ _)
      (ae_restrict_of_ae hfs) hfi.integrable_on hgi.integrable_on,
  refine hfi.ae_eq_const_or_exists_average_ne_compl.imp_right _,
  rintro ⟨t, hm, h₀, h₀', hne⟩,
  rcases average_mem_open_segment_compl_self hm.null_measurable_set h₀ h₀' (hfi.prod_mk hgi)
    with ⟨a, b, ha, hb, hab, h_avg⟩,
  simp only [average_pair hfi hgi, average_pair hfi.integrable_on hgi.integrable_on, prod.smul_mk,
    prod.mk_add_mk, prod.mk.inj_iff, (∘)] at h_avg,
  rw [← h_avg.1, ← h_avg.2],
  calc g (a • ⨍ x in t, f x ∂μ + b • ⨍ x in tᶜ, f x ∂μ)
      < a * g (⨍ x in t, f x ∂μ) + b * g (⨍ x in tᶜ, f x ∂μ) :
    hg.2 (this h₀).1 (this h₀').1 hne ha hb hab
  ... ≤ a * ⨍ x in t, g (f x) ∂μ + b * ⨍ x in tᶜ, g (f x) ∂μ :
    add_le_add (mul_le_mul_of_nonneg_left (this h₀).2 ha.le)
      (mul_le_mul_of_nonneg_left (this h₀').2 hb.le)
end

/-- **Jensen's inequality**, strict version: if an integrable function `f : α → E` takes values in a
convex closed set `s`, and `g : E → ℝ` is continuous and strictly concave on `s`, then
either `f` is a.e. equal to its average value, or `⨍ x, g (f x) ∂μ < g (⨍ x, f x ∂μ)`. -/
lemma strict_concave_on.ae_eq_const_or_lt_map_average [is_finite_measure μ] {s : set E} {g : E → ℝ}
  (hg : strict_concave_on ℝ s g) (hgc : continuous_on g s) (hsc : is_closed s) {f : α → E}
  (hfs : ∀ᵐ x ∂μ, f x ∈ s) (hfi : integrable f μ) (hgi : integrable (g ∘ f) μ) :
  f =ᵐ[μ] const α (⨍ x, f x ∂μ) ∨ ⨍ x, g (f x) ∂μ < g (⨍ x, f x ∂μ) :=
by simpa only [pi.neg_apply, average_neg, neg_lt_neg_iff]
  using hg.neg.ae_eq_const_or_map_average_lt hgc.neg hsc hfs hfi hgi.neg

/-- If `E` is a strictly normed space and `f : α → E` is a function such that `∥f x∥ ≤ C` a.e., then
either either this function is a.e. equal to its average value, or the norm of its integral is
strictly less than `(μ univ).to_real * C`. -/
lemma ae_eq_const_or_norm_integral_lt_of_norm_le_const [strict_convex_space ℝ E]
  [is_finite_measure μ] {f : α → E} {C : ℝ} (h_le : ∀ᵐ x ∂μ, ∥f x∥ ≤ C) :
  (f =ᵐ[μ] const α ⨍ x, f x ∂μ) ∨ ∥∫ x, f x ∂μ∥ < (μ univ).to_real * C :=
begin
  cases le_or_lt C 0 with hC0 hC0,
  { have : f =ᵐ[μ] 0, from h_le.mono (λ x hx, norm_le_zero_iff.1 (hx.trans hC0)),
    simp only [average_congr this, pi.zero_apply, average_zero],
    exact or.inl this },
  cases eq_or_ne μ 0 with hμ hμ,
  { rw hμ, exact or.inl rfl },
  by_cases hfi : integrable f μ, swap,
  { right,
    simpa [integral_undef hfi, hC0, measure_lt_top, ennreal.to_real_pos_iff, pos_iff_ne_zero]
      using hμ },
  replace h_le : ∀ᵐ x ∂μ, f x ∈ closed_ball (0 : E) C, by simpa only [mem_closed_ball_zero_iff],
  have hμ' : 0 < (μ univ).to_real,
    from ennreal.to_real_pos (mt measure_univ_eq_zero.1 hμ) (measure_ne_top _ _),
  simpa only [interior_closed_ball _ hC0.ne', mem_ball_zero_iff, average_def', norm_smul,
    real.norm_eq_abs, abs_inv, abs_of_pos hμ', ← div_eq_inv_mul, div_lt_iff' hμ']
    using (strict_convex_closed_ball ℝ (0 : E) C).ae_eq_const_or_average_mem_interior
      is_closed_ball h_le hfi
end


/- Structuring proofs (cont.) -/

example : p ∧ (q ∨ r) → (p ∧ q) ∨ (p ∧ r) := by
  intro h
  have hp : p := h.left
  have hqr : q ∨ r := h.right
  show (p ∧ q) ∨ (p ∧ r)
  cases hqr with
  | inl hq => exact Or.inl ⟨hp, hq⟩
  | inr hr => exact Or.inr ⟨hp, hr⟩

example : p ∧ (q ∨ r) → (p ∧ q) ∨ (p ∧ r) := by
  intro ⟨hp, hqr⟩
  cases hqr with
  | inl hq =>
    have := And.intro hp hq
    apply Or.inl; exact this
  | inr hr =>
    have := And.intro hp hr
    apply Or.inr; exact this