import .cone .colvec

section dual_cone

variables {k m n : nat} (a : ℝ) (x y z : colvec (fin n) ℝ) (A : set (colvec (fin n) ℝ))

def second_order_cone (n : nat): set (colvec (fin (n + 1)) ℝ ) :=
{ x | ∥ x.tail ∥ ≤ x.head }

lemma cone_second_order_cone :
cone (second_order_cone n) :=
begin
  intros x ha c hc,
  unfold second_order_cone at *,
  rw [set.mem_set_of_eq, colvec.tail_smul, colvec.head_smul,
    norm_smul, real.norm_eq_abs, abs_of_nonneg hc],
  exact mul_le_mul (le_refl c) ha (norm_nonneg _) hc
end

postfix `ᵀ` : 1500 := set.image matrix.transpose

lemma second_order_cone_self_dual :
  dual_cone (second_order_cone n) = second_order_cone n :=
begin
  have h_ltr: dual_cone (second_order_cone n) ⊆ second_order_cone n,
  { assume (y : colvec (fin (n + 1)) ℝ) (hy : y ∈ dual_cone (second_order_cone n)),
    by_cases h_cases : y.tail = 0,
    { have h : (0:ℝ) ≤ ⟪ colvec.cons 1 0, y ⟫,
      { apply hy (colvec.cons 1 0),
        simp [second_order_cone,zero_le_one] },
      have h : 0 ≤ y.head,
      { rw [←@colvec.mul_head_add_mul_tail n ℝ _ (colvec.cons 1 0) y] at h,
        simpa [matrix.mul_zero'] using h },
      show y ∈ second_order_cone n,
      { unfold second_order_cone,
        rwa [set.mem_set_of_eq, h_cases, norm_zero] }
    },
    { let y1 := y.head,
      let y2 := y.tail,
      have h : (0 : ℝ) ≤ real.sqrt ⟪ y2, y2 ⟫ * y1 + ⟪ - y2, y2 ⟫,
      { convert hy (colvec.cons (real.sqrt ⟪ y2, y2 ⟫) (- y2)) _,
        unfold has_inner.inner,
        convert @colvec.mul_head_add_mul_tail n ℝ _ _ _,
        { simp },
        { simp },
        simp [second_order_cone],
        refl
      },
      have h : ⟪ y2, y2 ⟫ ≤ real.sqrt ⟪ y2, y2 ⟫ * y1,
      {
        apply le_of_sub_nonneg,
        rw real_inner_product_space.inner_neg_left at h,
        rwa sub_eq_add_neg,
      },
      have h : real.sqrt ⟪ y2, y2 ⟫ * ⟪ y2, y2 ⟫ ≤ real.sqrt ⟪ y2, y2 ⟫ * (real.sqrt ⟪ y2, y2 ⟫ * y1),
        from mul_le_mul (le_refl _) h (real_inner_product_space.inner_self_nonneg _) (real.sqrt_nonneg _),
      have h : ⟪ y2, y2 ⟫ * real.sqrt ⟪ y2, y2 ⟫ ≤ ⟪ y2, y2 ⟫ * y1,
      {
        rw [←mul_assoc, mul_comm] at h,
        convert h,
        convert (@real.sqrt_mul ⟪ y2, y2 ⟫ (real_inner_product_space.inner_self_nonneg _) ⟪ y2, y2 ⟫),
        apply (real.sqrt_mul_self (real_inner_product_space.inner_self_nonneg _)).symm
      },
      show y ∈ second_order_cone n,
        from le_of_mul_le_mul_left h (real_inner_product_space.inner_self_pos h_cases),
    }
  },
  have h_rtl: second_order_cone n ⊆ dual_cone (second_order_cone n),
  begin
    assume (y : colvec (fin (n + 1)) ℝ),
    assume (hy : y ∈ second_order_cone n),
    assume (x : colvec (fin (n + 1)) ℝ) (hx : real.sqrt ⟪ x.tail, x.tail ⟫ ≤ x.head),
    have hx' : real.sqrt ⟪ - x.tail, - x.tail ⟫ ≤ x.head,
      by simpa,
    have h : ⟪ -x.tail, y.tail ⟫ ≤ x.head * y.head,
      calc ⟪ -x.tail, y.tail ⟫
            ≤ real.sqrt ⟪ -x.tail, -x.tail ⟫ * real.sqrt ⟪ y.tail, y.tail ⟫
              : real_inner_product_space.cauchy_schwartz' _ _
        ... ≤ x.head * y.head
              : mul_le_mul hx' hy (real.sqrt_nonneg _) (le_trans (real.sqrt_nonneg _) hx'),
    show 0 ≤ ⟪ x, y ⟫,
    {
      rw [←@colvec.mul_head_add_mul_tail n ℝ _ x y],
      rw [real_inner_product_space.inner_neg_left] at h,
      convert sub_nonneg_of_le h,
      simp
    }
  end,
  show dual_cone (second_order_cone n) = second_order_cone n,
    from set.subset.antisymm h_ltr h_rtl
end

end dual_cone


/-
Copyright (c) 2018 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Y. Lewis

Define the p-adic numbers (rationals) ℚ_p as the completion of ℚ wrt the p-adic norm.
Show that the p-adic norm extends to ℚ_p, that ℚ is embedded in ℚ_p, and that ℚ_p is complete
-/

import data.real.cau_seq_completion topology.metric_space.cau_seq_filter
import data.padics.padic_norm algebra.archimedean analysis.normed_space.basic
noncomputable theory
local attribute [instance, priority 1] classical.prop_decidable

open nat multiplicity padic_norm cau_seq cau_seq.completion metric

@[reducible] def padic_seq (p : ℕ) [p.prime] := cau_seq _ (padic_norm p)

namespace padic_seq

section
variables {p : ℕ} [nat.prime p]

lemma stationary {f : cau_seq ℚ (padic_norm p)} (hf : ¬ f ≈ 0) :
  ∃ N, ∀ m n, m ≥ N → n ≥ N → padic_norm p (f n) = padic_norm p (f m) :=
have ∃ ε > 0, ∃ N1, ∀ j ≥ N1, ε ≤ padic_norm p (f j),
  from cau_seq.abv_pos_of_not_lim_zero $ not_lim_zero_of_not_congr_zero hf,
let ⟨ε, hε, N1, hN1⟩ := this,
    ⟨N2, hN2⟩ := cau_seq.cauchy₂ f hε in
⟨ max N1 N2,
  λ n m hn hm,
  have padic_norm p (f n - f m) < ε, from hN2 _ _ (max_le_iff.1 hn).2 (max_le_iff.1 hm).2,
  have padic_norm p (f n - f m) < padic_norm p (f n),
    from lt_of_lt_of_le this $ hN1 _ (max_le_iff.1 hn).1,
  have  padic_norm p (f n - f m) < max (padic_norm p (f n)) (padic_norm p (f m)),
    from lt_max_iff.2 (or.inl this),
  begin
    by_contradiction hne,
    rw ←padic_norm.neg p (f m) at hne,
    have hnam := add_eq_max_of_ne p hne,
    rw [padic_norm.neg, max_comm] at hnam,
    rw ←hnam at this,
    apply _root_.lt_irrefl _ (by simp at this; exact this)
  end ⟩

def stationary_point {f : padic_seq p} (hf : ¬ f ≈ 0) : ℕ :=
classical.some $ stationary hf

lemma stationary_point_spec {f : padic_seq p} (hf : ¬ f ≈ 0) :
  ∀ {m n}, m ≥ stationary_point hf → n ≥ stationary_point hf →
    padic_norm p (f n) = padic_norm p (f m) :=
classical.some_spec $ stationary hf

def norm (f : padic_seq p) : ℚ :=
if hf : f ≈ 0 then 0 else padic_norm p (f (stationary_point hf))

lemma norm_zero_iff (f : padic_seq p) : f.norm = 0 ↔ f ≈ 0 :=
begin
  constructor,
  { intro h,
    by_contradiction hf,
    unfold norm at h, split_ifs at h,
    apply hf,
    intros ε hε,
    existsi stationary_point hf,
    intros j hj,
    have heq := stationary_point_spec hf (le_refl _) hj,
    simpa [h, heq] },
  { intro h,
    simp [norm, h] }
end

end

section embedding
open cau_seq
variables {p : ℕ} [nat.prime p]

lemma equiv_zero_of_val_eq_of_equiv_zero {f g : padic_seq p}
  (h : ∀ k, padic_norm p (f k) = padic_norm p (g k)) (hf : f ≈ 0) : g ≈ 0 :=
λ ε hε, let ⟨i, hi⟩ := hf _ hε in
⟨i, λ j hj, by simpa [h] using hi _ hj⟩

lemma norm_nonzero_of_not_equiv_zero {f : padic_seq p} (hf : ¬ f ≈ 0) :
  f.norm ≠ 0 :=
hf ∘ f.norm_zero_iff.1

lemma norm_eq_norm_app_of_nonzero {f : padic_seq p} (hf : ¬ f ≈ 0) :
  ∃ k, f.norm = padic_norm p k ∧ k ≠ 0 :=
have heq : f.norm = padic_norm p (f $ stationary_point hf), by simp [norm, hf],
⟨f $ stationary_point hf, heq,
  λ h, norm_nonzero_of_not_equiv_zero hf (by simpa [h] using heq)⟩

lemma not_lim_zero_const_of_nonzero {q : ℚ} (hq : q ≠ 0) : ¬ lim_zero (const (padic_norm p) q) :=
λ h', hq $ const_lim_zero.1 h'

lemma not_equiv_zero_const_of_nonzero {q : ℚ} (hq : q ≠ 0) : ¬ (const (padic_norm p) q) ≈ 0 :=
λ h : lim_zero (const (padic_norm p) q - 0), not_lim_zero_const_of_nonzero hq $ by simpa using h

lemma norm_nonneg (f : padic_seq p) : f.norm ≥ 0 :=
if hf : f ≈ 0 then by simp [hf, norm]
else by simp [norm, hf, padic_norm.nonneg]

lemma lift_index_left_left {f : padic_seq p} (hf : ¬ f ≈ 0) (v2 v3 : ℕ) :
  padic_norm p (f (stationary_point hf)) = padic_norm p (f (max (stationary_point hf) (max v2 v3))) :=
let i := max (stationary_point hf) (max v2 v3) in
begin
  apply stationary_point_spec hf,
  { apply le_max_left },
  { apply le_refl }
end

lemma lift_index_left {f : padic_seq p} (hf : ¬ f ≈ 0) (v1 v3 : ℕ) :
  padic_norm p (f (stationary_point hf)) = padic_norm p (f (max v1 (max (stationary_point hf) v3))) :=
let i := max v1 (max (stationary_point hf) v3) in
begin
  apply stationary_point_spec hf,
  { apply le_trans,
    { apply le_max_left _ v3 },
    { apply le_max_right } },
  { apply le_refl }
end

lemma lift_index_right {f : padic_seq p} (hf : ¬ f ≈ 0) (v1 v2 : ℕ) :
  padic_norm p (f (stationary_point hf)) = padic_norm p (f (max v1 (max v2 (stationary_point hf)))) :=
let i := max v1 (max v2 (stationary_point hf)) in
begin
  apply stationary_point_spec hf,
  { apply le_trans,
    { apply le_max_right v2 },
    { apply le_max_right } },
  { apply le_refl }
end

end embedding

end padic_seq

section
open padic_seq

meta def index_simp_core (hh hf hg : expr) (at_ : interactive.loc := interactive.loc.ns [none]) : tactic unit :=
do [v1, v2, v3] ← [hh, hf, hg].mmap
     (λ n, tactic.mk_app ``stationary_point [n] <|> return n),
   e1 ← tactic.mk_app ``lift_index_left_left [hh, v2, v3] <|> return `(true),
   e2 ← tactic.mk_app ``lift_index_left [hf, v1, v3] <|> return `(true),
   e3 ← tactic.mk_app ``lift_index_right [hg, v1, v2] <|> return `(true),
   sl ← [e1, e2, e3].mfoldl (λ s e, simp_lemmas.add s e) simp_lemmas.mk,
   when at_.include_goal (tactic.simp_target sl),
   hs ← at_.get_locals, hs.mmap' (tactic.simp_hyp sl [])

/--
  This is a special-purpose tactic that lifts padic_norm (f (stationary_point f)) to
  padic_norm (f (max _ _ _)).
-/
meta def tactic.interactive.padic_index_simp (l : interactive.parse interactive.types.pexpr_list)
  (at_ : interactive.parse interactive.types.location) : tactic unit :=
do [h, f, g] ← l.mmap tactic.i_to_expr,
   index_simp_core h f g at_
end

namespace padic_seq
section embedding

open cau_seq
variables {p : ℕ} [hp : nat.prime p]
include hp

lemma norm_mul (f g : padic_seq p) : (f * g).norm = f.norm * g.norm :=
if hf : f ≈ 0 then
  have hg : f * g ≈ 0, from mul_equiv_zero' _ hf,
  by simp [hf, hg, norm]
else if hg : g ≈ 0 then
  have hf : f * g ≈ 0, from mul_equiv_zero _ hg,
  by simp [hf, hg, norm]
else
  have hfg : ¬ f * g ≈ 0, by apply mul_not_equiv_zero; assumption,
  begin
    unfold norm,
    split_ifs,
    padic_index_simp [hfg, hf, hg],
    apply padic_norm.mul
  end

lemma eq_zero_iff_equiv_zero (f : padic_seq p) : mk f = 0 ↔ f ≈ 0 :=
mk_eq

lemma ne_zero_iff_nequiv_zero (f : padic_seq p) : mk f ≠ 0 ↔ ¬ f ≈ 0 :=
not_iff_not.2 (eq_zero_iff_equiv_zero _)

lemma norm_const (q : ℚ) : norm (const (padic_norm p) q) = padic_norm p q :=
if hq : q = 0 then
  have (const (padic_norm p) q) ≈ 0,
    by simp [hq]; apply setoid.refl (const (padic_norm p) 0),
  by subst hq; simp [norm, this]
else
  have ¬ (const (padic_norm p) q) ≈ 0, from not_equiv_zero_const_of_nonzero hq,
  by simp [norm, this]

lemma norm_image (a : padic_seq p) (ha : ¬ a ≈ 0) :
  (∃ (n : ℤ), a.norm = ↑p ^ (-n)) :=
let ⟨k, hk, hk'⟩ := norm_eq_norm_app_of_nonzero ha in
by simpa [hk] using padic_norm.image p hk'

lemma norm_one : norm (1 : padic_seq p) = 1 :=
have h1 : ¬ (1 : padic_seq p) ≈ 0, from one_not_equiv_zero _,
by simp [h1, norm, hp.gt_one]

private lemma norm_eq_of_equiv_aux {f g : padic_seq p} (hf : ¬ f ≈ 0) (hg : ¬ g ≈ 0) (hfg : f ≈ g)
  (h : padic_norm p (f (stationary_point hf)) ≠ padic_norm p (g (stationary_point hg)))
  (hgt : padic_norm p (f (stationary_point hf)) > padic_norm p (g (stationary_point hg))) :
  false :=
begin
  have hpn : padic_norm p (f (stationary_point hf)) - padic_norm p (g (stationary_point hg)) > 0,
    from sub_pos_of_lt hgt,
  cases hfg _ hpn with N hN,
  let i := max N (max (stationary_point hf) (stationary_point hg)),
  have hi : i ≥ N, from le_max_left _ _,
  have hN' := hN _ hi,
  padic_index_simp [N, hf, hg] at hN' h hgt,
  have hpne : padic_norm p (f i) ≠ padic_norm p (-(g i)),
    by rwa [ ←padic_norm.neg p (g i)] at h,
  let hpnem := add_eq_max_of_ne p hpne,
  have hpeq : padic_norm p ((f - g) i) = max (padic_norm p (f i)) (padic_norm p (g i)),
  { rwa padic_norm.neg at hpnem },
  rw [hpeq, max_eq_left_of_lt hgt] at hN',
  have : padic_norm p (f i) < padic_norm p (f i),
  { apply lt_of_lt_of_le hN', apply sub_le_self, apply padic_norm.nonneg },
  exact lt_irrefl _ this
end

private lemma norm_eq_of_equiv {f g : padic_seq p} (hf : ¬ f ≈ 0) (hg : ¬ g ≈ 0) (hfg : f ≈ g) :
  padic_norm p (f (stationary_point hf)) = padic_norm p (g (stationary_point hg)) :=
begin
  by_contradiction h,
  cases (decidable.em (padic_norm p (f (stationary_point hf)) >
          padic_norm p (g (stationary_point hg))))
      with hgt hngt,
  { exact norm_eq_of_equiv_aux hf hg hfg h hgt },
  { apply norm_eq_of_equiv_aux hg hf (setoid.symm hfg) (ne.symm h),
    apply lt_of_le_of_ne,
    apply le_of_not_gt hngt,
    apply h }
end

theorem norm_equiv {f g : padic_seq p} (hfg : f ≈ g) : f.norm = g.norm :=
if hf : f ≈ 0 then
  have hg : g ≈ 0, from setoid.trans (setoid.symm hfg) hf,
  by simp [norm, hf, hg]
else have hg : ¬ g ≈ 0, from hf ∘ setoid.trans hfg,
by unfold norm; split_ifs; exact norm_eq_of_equiv hf hg hfg

private lemma norm_nonarchimedean_aux {f g : padic_seq p}
  (hfg : ¬ f + g ≈ 0) (hf : ¬ f ≈ 0) (hg : ¬ g ≈ 0) : (f + g).norm ≤ max (f.norm) (g.norm) :=
begin
  unfold norm, split_ifs,
  padic_index_simp [hfg, hf, hg],
  apply padic_norm.nonarchimedean
end

theorem norm_nonarchimedean (f g : padic_seq p) : (f + g).norm ≤ max (f.norm) (g.norm) :=
if hfg : f + g ≈ 0 then
  have 0 ≤ max (f.norm) (g.norm), from le_max_left_of_le (norm_nonneg _),
  by simpa [hfg, norm]
else if hf : f ≈ 0 then
  have hfg' : f + g ≈ g,
  { change lim_zero (f - 0) at hf,
    show lim_zero (f + g - g), by simpa using hf },
  have hcfg : (f + g).norm = g.norm, from norm_equiv hfg',
  have hcl : f.norm = 0, from (norm_zero_iff f).2 hf,
  have max (f.norm) (g.norm) = g.norm,
    by rw hcl; exact max_eq_right (norm_nonneg _),
  by rw [this, hcfg]
else if hg : g ≈ 0 then
  have hfg' : f + g ≈ f,
  { change lim_zero (g - 0) at hg,
    show lim_zero (f + g - f), by  simpa [add_sub_cancel'] using hg },
  have hcfg : (f + g).norm = f.norm, from norm_equiv hfg',
  have hcl : g.norm = 0, from (norm_zero_iff g).2 hg,
  have max (f.norm) (g.norm) = f.norm,
    by rw hcl; exact max_eq_left (norm_nonneg _),
  by rw [this, hcfg]
else norm_nonarchimedean_aux hfg hf hg

lemma norm_eq {f g : padic_seq p} (h : ∀ k, padic_norm p (f k) = padic_norm p (g k)) :
  f.norm = g.norm :=
if hf : f ≈ 0 then
  have hg : g ≈ 0, from equiv_zero_of_val_eq_of_equiv_zero h hf,
  by simp [hf, hg, norm]
else
  have hg : ¬ g ≈ 0, from λ hg, hf $ equiv_zero_of_val_eq_of_equiv_zero (by simp [h]) hg,
  begin
    simp [hg, hf, norm],
    let i := max (stationary_point hf) (stationary_point hg),
    have hpf : padic_norm p (f (stationary_point hf)) = padic_norm p (f i),
    { apply stationary_point_spec, apply le_max_left, apply le_refl },
    have hpg : padic_norm p (g (stationary_point hg)) = padic_norm p (g i),
    { apply stationary_point_spec, apply le_max_right, apply le_refl },
    rw [hpf, hpg, h]
  end

lemma norm_neg (a : padic_seq p) : (-a).norm = a.norm :=
norm_eq $ by simp

lemma norm_eq_of_add_equiv_zero {f g : padic_seq p} (h : f + g ≈ 0) : f.norm = g.norm :=
have lim_zero (f + g - 0), from h,
have f ≈ -g, from show lim_zero (f - (-g)), by simpa,
have f.norm = (-g).norm, from norm_equiv this,
by simpa [norm_neg] using this

lemma add_eq_max_of_ne {f g : padic_seq p} (hfgne : f.norm ≠ g.norm) :
  (f + g).norm = max f.norm g.norm :=
have hfg : ¬f + g ≈ 0, from mt norm_eq_of_add_equiv_zero hfgne,
if hf : f ≈ 0 then
  have lim_zero (f - 0), from hf,
  have f + g ≈ g, from show lim_zero ((f + g) - g), by simpa,
  have h1 : (f+g).norm = g.norm, from norm_equiv this,
  have h2 : f.norm = 0, from (norm_zero_iff _).2 hf,
  by rw [h1, h2]; rw max_eq_right (norm_nonneg _)
else if hg : g ≈ 0 then
  have lim_zero (g - 0), from hg,
  have f + g ≈ f, from show lim_zero ((f + g) - f), by rw [add_sub_cancel']; simpa,
  have h1 : (f+g).norm = f.norm, from norm_equiv this,
  have h2 : g.norm = 0, from (norm_zero_iff _).2 hg,
  by rw [h1, h2]; rw max_eq_left (norm_nonneg _)
else
begin
  unfold norm at ⊢ hfgne, split_ifs at ⊢ hfgne,
  padic_index_simp [hfg, hf, hg] at ⊢ hfgne,
  apply padic_norm.add_eq_max_of_ne,
  simpa [hf, hg, norm] using hfgne
end

end embedding
end padic_seq

def padic (p : ℕ) [nat.prime p] := @cau_seq.completion.Cauchy _ _ _ _ (padic_norm p) _
notation `ℚ_[` p `]` := padic p

namespace padic

section completion
variables {p : ℕ} [nat.prime p]

instance discrete_field : discrete_field (ℚ_[p]) :=
cau_seq.completion.discrete_field

-- short circuits

instance : has_zero ℚ_[p] := by apply_instance
instance : has_one ℚ_[p] := by apply_instance
instance : has_add ℚ_[p] := by apply_instance
instance : has_mul ℚ_[p] := by apply_instance
instance : has_sub ℚ_[p] := by apply_instance
instance : has_neg ℚ_[p] := by apply_instance
instance : has_div ℚ_[p] := by apply_instance
instance : add_comm_group ℚ_[p] := by apply_instance
instance : comm_ring ℚ_[p] := by apply_instance

def mk : padic_seq p → ℚ_[p] := quotient.mk
end completion

section completion
variables (p : ℕ) [nat.prime p]

lemma mk_eq {f g : padic_seq p} : mk f = mk g ↔ f ≈ g := quotient.eq

def of_rat : ℚ → ℚ_[p] := cau_seq.completion.of_rat

@[simp] lemma of_rat_add : ∀ (x y : ℚ), of_rat p (x + y) = of_rat p x + of_rat p y :=
cau_seq.completion.of_rat_add

@[simp] lemma of_rat_neg : ∀ (x : ℚ), of_rat p (-x) = -of_rat p x :=
cau_seq.completion.of_rat_neg

@[simp] lemma of_rat_mul : ∀ (x y : ℚ), of_rat p (x * y) = of_rat p x * of_rat p y :=
cau_seq.completion.of_rat_mul

@[simp] lemma of_rat_sub : ∀ (x y : ℚ), of_rat p (x - y) = of_rat p x - of_rat p y :=
cau_seq.completion.of_rat_sub

@[simp] lemma of_rat_div : ∀ (x y : ℚ), of_rat p (x / y) = of_rat p x / of_rat p y :=
cau_seq.completion.of_rat_div

@[simp] lemma of_rat_one : of_rat p 1 = 1 := rfl

@[simp] lemma of_rat_zero : of_rat p 0 = 0 := rfl

@[simp] lemma cast_eq_of_rat_of_nat (n : ℕ) : (↑n : ℚ_[p]) = of_rat p n :=
begin
  induction n with n ih,
  { refl },
  { simpa using ih }
end

example {α} [discrete_field α] (n : ℤ) : α := n

-- without short circuits, this needs an increase of class.instance_max_depth
@[simp] lemma cast_eq_of_rat_of_int (n : ℤ) : ↑n = of_rat p n :=
by induction n; simp

lemma cast_eq_of_rat : ∀ (q : ℚ), (↑q : ℚ_[p]) = of_rat p q
| ⟨n, d, h1, h2⟩ :=
  show ↑n / ↑d = _, from
    have (⟨n, d, h1, h2⟩ : ℚ) = rat.mk n d, from rat.num_denom _,
    by simp [this, rat.mk_eq_div, of_rat_div]

lemma const_equiv {q r : ℚ} : const (padic_norm p) q ≈ const (padic_norm p) r ↔ q = r :=
⟨ λ heq : lim_zero (const (padic_norm p) (q - r)),
    eq_of_sub_eq_zero $ const_lim_zero.1 heq,
  λ heq, by rw heq; apply setoid.refl _ ⟩

lemma of_rat_eq {q r : ℚ} : of_rat p q = of_rat p r ↔ q = r :=
⟨(const_equiv p).1 ∘ quotient.eq.1, λ h, by rw h⟩

instance : char_zero ℚ_[p] :=
⟨ λ m n, suffices of_rat p ↑m = of_rat p ↑n ↔ m = n, by simpa using this,
    by simp [of_rat_eq] ⟩

end completion
end padic

def padic_norm_e {p : ℕ} [hp : nat.prime p] : ℚ_[p] → ℚ :=
quotient.lift padic_seq.norm $ @padic_seq.norm_equiv _ _

namespace padic_norm_e
section embedding
open padic_seq
variables {p : ℕ} [nat.prime p]

lemma defn (f : padic_seq p) {ε : ℚ} (hε : ε > 0) : ∃ N, ∀ i ≥ N, padic_norm_e (⟦f⟧ - f i) < ε :=
begin
  simp only [padic.cast_eq_of_rat],
  change ∃ N, ∀ i ≥ N, (f - const _ (f i)).norm < ε,
  by_contradiction h,
  cases cauchy₂ f hε with N hN,
  have : ∀ N, ∃ i ≥ N, (f - const _ (f i)).norm ≥ ε,
    by simpa [not_forall] using h,
  rcases this N with ⟨i, hi, hge⟩,
  have hne : ¬ (f - const (padic_norm p) (f i)) ≈ 0,
  { intro h, unfold padic_seq.norm at hge; split_ifs at hge, exact not_lt_of_ge hge hε },
  unfold padic_seq.norm at hge; split_ifs at hge,
  apply not_le_of_gt _ hge,
  cases decidable.em ((stationary_point hne) ≥ N) with hgen hngen,
  { apply hN; assumption },
  { have := stationary_point_spec hne (le_refl _) (le_of_not_le hngen),
    rw ←this,
    apply hN,
    apply le_refl, assumption }
end

protected lemma nonneg (q : ℚ_[p]) : padic_norm_e q ≥ 0 :=
quotient.induction_on q $ norm_nonneg

lemma zero_def : (0 : ℚ_[p]) = ⟦0⟧ := rfl

lemma zero_iff (q : ℚ_[p]) : padic_norm_e q = 0 ↔ q = 0 :=
quotient.induction_on q $
  by simpa only [zero_def, quotient.eq] using norm_zero_iff

@[simp] protected lemma zero : padic_norm_e (0 : ℚ_[p]) = 0 :=
(zero_iff _).2 rfl

@[simp] protected lemma one' : padic_norm_e (1 : ℚ_[p]) = 1 :=
norm_one

@[simp] protected lemma neg (q : ℚ_[p]) : padic_norm_e (-q) = padic_norm_e q :=
quotient.induction_on q $ norm_neg

theorem nonarchimedean' (q r : ℚ_[p]) :
  padic_norm_e (q + r) ≤ max (padic_norm_e q) (padic_norm_e r) :=
quotient.induction_on₂ q r $ norm_nonarchimedean

theorem add_eq_max_of_ne' {q r : ℚ_[p]} :
  padic_norm_e q ≠ padic_norm_e r → padic_norm_e (q + r) = max (padic_norm_e q) (padic_norm_e r) :=
quotient.induction_on₂ q r $ λ _ _, padic_seq.add_eq_max_of_ne

lemma triangle_ineq (x y z : ℚ_[p]) :
  padic_norm_e (x - z) ≤ padic_norm_e (x - y) + padic_norm_e (y - z) :=
calc padic_norm_e (x - z) = padic_norm_e ((x - y) + (y - z)) : by rw sub_add_sub_cancel
  ... ≤ max (padic_norm_e (x - y)) (padic_norm_e (y - z)) : padic_norm_e.nonarchimedean' _ _
  ... ≤ padic_norm_e (x - y) + padic_norm_e (y - z) :
    max_le_add_of_nonneg (padic_norm_e.nonneg _) (padic_norm_e.nonneg _)

protected lemma add (q r : ℚ_[p]) : padic_norm_e (q + r) ≤ (padic_norm_e q) + (padic_norm_e r) :=
calc
  padic_norm_e (q + r) ≤ max (padic_norm_e q) (padic_norm_e r) : nonarchimedean' _ _
                      ... ≤ (padic_norm_e q) + (padic_norm_e r) :
                              max_le_add_of_nonneg (padic_norm_e.nonneg _) (padic_norm_e.nonneg _)

protected lemma mul' (q r : ℚ_[p]) : padic_norm_e (q * r) = (padic_norm_e q) * (padic_norm_e r) :=
quotient.induction_on₂ q r $ norm_mul

instance : is_absolute_value (@padic_norm_e p _) :=
{ abv_nonneg := padic_norm_e.nonneg,
  abv_eq_zero := zero_iff,
  abv_add := padic_norm_e.add,
  abv_mul := padic_norm_e.mul' }

@[simp] lemma eq_padic_norm' (q : ℚ) : padic_norm_e (padic.of_rat p q) = padic_norm p q :=
norm_const _

protected theorem image' {q : ℚ_[p]} : q ≠ 0 → ∃ n : ℤ, padic_norm_e q = p ^ (-n) :=
quotient.induction_on q $ λ f hf,
  have ¬ f ≈ 0, from (ne_zero_iff_nequiv_zero f).1 hf,
  norm_image f this

lemma sub_rev (q r : ℚ_[p]) : padic_norm_e (q - r) = padic_norm_e (r - q) :=
by rw ←(padic_norm_e.neg); simp

end embedding
end padic_norm_e

namespace padic

section complete
open padic_seq padic

theorem rat_dense' {p : ℕ} [nat.prime p] (q : ℚ_[p]) {ε : ℚ} (hε : ε > 0) :
  ∃ r : ℚ, padic_norm_e (q - r) < ε :=
quotient.induction_on q $ λ q',
  have ∃ N, ∀ m n ≥ N, padic_norm p (q' m - q' n) < ε, from cauchy₂ _ hε,
  let ⟨N, hN⟩ := this in
  ⟨q' N,
    begin
      simp only [padic.cast_eq_of_rat],
      change padic_seq.norm (q' - const _ (q' N)) < ε,
      cases decidable.em ((q' - const (padic_norm p) (q' N)) ≈ 0) with heq hne',
      { simpa only [heq, padic_seq.norm, dif_pos] },
      { simp only [padic_seq.norm, dif_neg hne'],
        change padic_norm p (q' _ - q' _) < ε,
        have := stationary_point_spec hne',
        cases decidable.em (N ≥ stationary_point hne') with hle hle,
        { have := eq.symm (this (le_refl _) hle),
          simp at this, simpa [this] },
        { apply hN,
          apply le_of_lt, apply lt_of_not_ge, apply hle, apply le_refl }}
    end⟩

variables {p : ℕ} [nat.prime p] (f : cau_seq _ (@padic_norm_e p _))
open classical

private lemma cast_succ_nat_pos (n : ℕ) : (↑(n + 1) : ℚ) > 0 :=
nat.cast_pos.2 $ succ_pos _

private lemma div_nat_pos (n : ℕ) : (1 / ((n + 1): ℚ)) > 0 :=
div_pos zero_lt_one (cast_succ_nat_pos _)

def lim_seq : ℕ → ℚ := λ n, classical.some (rat_dense' (f n) (div_nat_pos n))

lemma exi_rat_seq_conv {ε : ℚ} (hε : 0 < ε) :
  ∃ N, ∀ i ≥ N, padic_norm_e (f i - of_rat p ((lim_seq f) i)) < ε :=
begin
  refine (exists_nat_gt (1/ε)).imp (λ N hN i hi, _),
  have h := classical.some_spec (rat_dense' (f i) (div_nat_pos i)),
  rw ← cast_eq_of_rat,
  refine lt_of_lt_of_le h (div_le_of_le_mul (cast_succ_nat_pos _) _),
  rw right_distrib,
  apply le_add_of_le_of_nonneg,
  { exact le_mul_of_div_le hε (le_trans (le_of_lt hN) (nat.cast_le.2 hi)) },
  { apply le_of_lt, simpa }
end

lemma exi_rat_seq_conv_cauchy : is_cau_seq (padic_norm p) (lim_seq f) :=
assume ε hε,
have hε3 : ε / 3 > 0, from div_pos hε (by norm_num),
let ⟨N, hN⟩ := exi_rat_seq_conv f hε3,
    ⟨N2, hN2⟩ := f.cauchy₂ hε3 in
begin
  existsi max N N2,
  intros j hj,
  rw [←padic_norm_e.eq_padic_norm', padic.of_rat_sub],
  suffices : padic_norm_e ((↑(lim_seq f j) - f (max N N2)) + (f (max N N2) - lim_seq f (max N N2))) < ε,
  { ring at this ⊢, simpa only [cast_eq_of_rat] },
  { apply lt_of_le_of_lt,
    { apply padic_norm_e.add },
    { have : (3 : ℚ) ≠ 0, by norm_num,
      have : ε = ε / 3 + ε / 3 + ε / 3,
      { apply eq_of_mul_eq_mul_left this, simp [left_distrib, mul_div_cancel' _ this ], ring },
      rw this,
      apply add_lt_add,
      { suffices : padic_norm_e ((↑(lim_seq f j) - f j) + (f j - f (max N N2))) < ε / 3 + ε / 3,
          by simpa,
        apply lt_of_le_of_lt,
        { apply padic_norm_e.add },
        { apply add_lt_add,
          { rw [padic_norm_e.sub_rev, cast_eq_of_rat], apply hN, apply le_of_max_le_left hj },
          { apply hN2, apply le_of_max_le_right hj, apply le_max_right } } },
      { rw cast_eq_of_rat, apply hN, apply le_max_left }}}
end

private def lim' : padic_seq p := ⟨_, exi_rat_seq_conv_cauchy f⟩

private def lim : ℚ_[p] := ⟦lim' f⟧

theorem complete' : ∃ q : ℚ_[p], ∀ ε > 0, ∃ N, ∀ i ≥ N, padic_norm_e (q - f i) < ε :=
⟨ lim f,
  λ ε hε,
  let ⟨N, hN⟩ := exi_rat_seq_conv f (show ε / 2 > 0, from div_pos hε (by norm_num)),
      ⟨N2, hN2⟩ := padic_norm_e.defn (lim' f) (show ε / 2 > 0, from div_pos hε (by norm_num)) in
  begin
    existsi max N N2,
    intros i hi,
    suffices : padic_norm_e ((lim f - lim' f i) + (lim' f i - f i)) < ε,
    { ring at this; exact this },
    { apply lt_of_le_of_lt,
      { apply padic_norm_e.add },
      { have : (2 : ℚ) ≠ 0, by norm_num,
        have : ε = ε / 2 + ε / 2, by rw ←(add_self_div_two ε); simp,
        rw this,
        apply add_lt_add,
        { apply hN2, apply le_of_max_le_right hi },
        { rw [padic_norm_e.sub_rev, cast_eq_of_rat], apply hN, apply le_of_max_le_left hi } } }
  end ⟩

end complete

section normed_space
variables (p : ℕ) [nat.prime p]

instance : has_dist ℚ_[p] := ⟨λ x y, padic_norm_e (x - y)⟩

instance : metric_space ℚ_[p] :=
{ dist_self := by simp [dist],
  dist_comm := λ x y, by unfold dist; rw ←padic_norm_e.neg (x - y); simp,
  dist_triangle :=
    begin
      intros, unfold dist,
      rw ←rat.cast_add,
      apply rat.cast_le.2,
      apply padic_norm_e.triangle_ineq
    end,
  eq_of_dist_eq_zero :=
    begin
      unfold dist, intros _ _ h,
      apply eq_of_sub_eq_zero,
      apply (padic_norm_e.zero_iff _).1,
      simpa using h
    end }

instance : has_norm ℚ_[p] := ⟨λ x, padic_norm_e x⟩

instance : normed_field ℚ_[p] :=
{ dist_eq := λ _ _, rfl,
  norm_mul := by simp [has_norm.norm, padic_norm_e.mul'] }

instance : is_absolute_value (λ a : ℚ_[p], ∥a∥) :=
{ abv_nonneg := norm_nonneg,
  abv_eq_zero := norm_eq_zero,
  abv_add := norm_triangle,
  abv_mul := by simp [has_norm.norm, padic_norm_e.mul'] }

theorem rat_dense {p : ℕ} {hp : p.prime} (q : ℚ_[p]) {ε : ℝ} (hε : ε > 0) :
        ∃ r : ℚ, ∥q - r∥ < ε :=
let ⟨ε', hε'l, hε'r⟩ := exists_rat_btwn hε,
    ⟨r, hr⟩ := rat_dense' q (by simpa using hε'l)  in
⟨r, lt.trans (by simpa [has_norm.norm] using hr) hε'r⟩

end normed_space
end padic

namespace padic_norm_e
section normed_space
variables {p : ℕ} [hp : p.prime]
include hp

@[simp] protected lemma mul (q r : ℚ_[p]) : ∥q * r∥ = ∥q∥ * ∥r∥ :=
by simp [has_norm.norm, padic_norm_e.mul']

protected lemma is_norm (q : ℚ_[p]) : ↑(padic_norm_e q) = ∥q∥ := rfl

theorem nonarchimedean (q r : ℚ_[p]) : ∥q + r∥ ≤ max (∥q∥) (∥r∥) :=
begin
  unfold has_norm.norm, rw ←rat.cast_max, apply rat.cast_le.2, apply nonarchimedean'
end

theorem add_eq_max_of_ne {q r : ℚ_[p]} (h : ∥q∥ ≠ ∥r∥) : ∥q+r∥ = max (∥q∥) (∥r∥) :=
begin
  unfold has_norm.norm,
  rw ←rat.cast_max,
  congr,
  apply add_eq_max_of_ne',
  intro h',
  apply h,
  unfold has_norm.norm,
  congr,
  apply h'
end

@[simp] lemma eq_padic_norm (q : ℚ) : ∥padic.of_rat p q∥ = padic_norm p q :=
by unfold has_norm.norm; congr; apply padic_seq.norm_const

protected theorem image {q : ℚ_[p]} : q ≠ 0 → ∃ n : ℤ, ∥q∥ = ↑((↑p : ℚ) ^ (-n)) :=
quotient.induction_on q $ λ f hf,
  have ¬ f ≈ 0, from (padic_seq.ne_zero_iff_nequiv_zero f).1 hf,
  let ⟨n, hn⟩ := padic_seq.norm_image f this in
  ⟨n, congr_arg rat.cast hn⟩

protected lemma is_rat (q : ℚ_[p]) : ∃ q' : ℚ, ∥q∥ = ↑q' :=
if h : q = 0 then ⟨0, by simp [h]⟩
else let ⟨n, hn⟩ := padic_norm_e.image h in ⟨_, hn⟩

def rat_norm (q : ℚ_[p]) : ℚ := classical.some (padic_norm_e.is_rat q)

lemma eq_rat_norm (q : ℚ_[p]) : ∥q∥ = rat_norm q := classical.some_spec (padic_norm_e.is_rat q)

theorem norm_rat_le_one : ∀ {q : ℚ} (hq : ¬ p ∣ q.denom), ∥(q : ℚ_[p])∥ ≤ 1
| ⟨n, d, hn, hd⟩ := λ hq : ¬ p ∣ d,
  if hnz : n = 0 then
    have (⟨n, d, hn, hd⟩ : ℚ) = 0, from rat.zero_of_num_zero hnz,
      by simp [this, padic.cast_eq_of_rat, zero_le_one]
  else
    have hnz' : {rat . num := n, denom := d, pos := hn, cop := hd} ≠ 0,
      from mt rat.zero_iff_num_zero.1 hnz,
    have (p : ℚ) ^ (-(multiplicity (p : ℤ) n).get
      (finite_int_iff.2 ⟨hp.ne_one, hnz⟩) : ℤ) ≤ 1,
      from fpow_le_one_of_nonpos
        (show (↑p : ℚ) ≥ ↑(1: ℕ), from le_of_lt (nat.cast_lt.2 hp.gt_one))
        (neg_nonpos_of_nonneg (int.coe_nat_nonneg _)),
    have (((p : ℚ) ^ (-(multiplicity (p : ℤ) n).get
        (finite_int_iff.2 ⟨hp.ne_one, hnz⟩) : ℤ) : ℚ) : ℝ) ≤ (1 : ℚ),
      from rat.cast_le.2 this,
    by simpa [padic.cast_eq_of_rat, hnz', padic_norm, padic_val_rat_def p hnz',
               multiplicity_eq_zero_of_not_dvd (mt int.coe_nat_dvd.1 hq)]

lemma eq_of_norm_add_lt_right {p : ℕ} {hp : p.prime} {z1 z2 : ℚ_[p]}
  (h : ∥z1 + z2∥ < ∥z2∥) : ∥z1∥ = ∥z2∥ :=
by_contradiction $ λ hne,
  not_lt_of_ge (by rw padic_norm_e.add_eq_max_of_ne hne; apply le_max_right) h

lemma eq_of_norm_add_lt_left {p : ℕ} {hp : p.prime} {z1 z2 : ℚ_[p]}
  (h : ∥z1 + z2∥ < ∥z1∥) : ∥z1∥ = ∥z2∥ :=
by_contradiction $ λ hne,
  not_lt_of_ge (by rw padic_norm_e.add_eq_max_of_ne hne; apply le_max_left) h

end normed_space
end padic_norm_e

namespace padic
variables {p : ℕ} [nat.prime p]

set_option eqn_compiler.zeta true
instance complete : cau_seq.is_complete ℚ_[p] norm :=
⟨λ f,
  let f' : cau_seq ℚ_[p] padic_norm_e :=
    ⟨λ n, f n, λ ε hε,
      let ⟨N, hN⟩ := is_cau f ↑ε (rat.cast_pos.2 hε) in ⟨N, λ j hj, rat.cast_lt.1 (hN _ hj)⟩⟩ in
  let ⟨q, hq⟩ := padic.complete' f' in
  ⟨ q, setoid.symm $ λ ε hε,
    let ⟨ε', hε'l, hε'r⟩ := exists_rat_btwn hε,
        ⟨N, hN⟩ := hq _ (by simpa using hε'l) in
    ⟨N, λ i hi, lt.trans (rat.cast_lt.2 (hN _ hi)) hε'r ⟩⟩⟩

lemma padic_norm_e_lim_le {f : cau_seq ℚ_[p] norm} {a : ℝ} (ha : a > 0)
      (hf : ∀ i, ∥f i∥ ≤ a) : ∥f.lim∥ ≤ a :=
let ⟨N, hN⟩ := setoid.symm (cau_seq.equiv_lim f) _ ha in
calc ∥f.lim∥ = ∥f.lim - f N + f N∥ : by simp
                ... ≤ max (∥f.lim - f N∥) (∥f N∥) : padic_norm_e.nonarchimedean _ _
                ... ≤ a : max_le (le_of_lt (hN _ (le_refl _))) (hf _)

end padic


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

! This file was ported from Lean 3 source module linear_algebra.charpoly.basic
! leanprover-community/mathlib commit d3e8e0a0237c10c2627bf52c246b15ff8e7df4c0
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.LinearAlgebra.FreeModule.Finite.Basic
import Mathbin.LinearAlgebra.Matrix.Charpoly.Coeff
import Mathbin.FieldTheory.Minpoly.Field

/-!

# Characteristic polynomial

We define the characteristic polynomial of `f : M →ₗ[R] M`, where `M` is a finite and
free `R`-module. The proof that `f.charpoly` is the characteristic polynomial of the matrix of `f`
in any basis is in `linear_algebra/charpoly/to_matrix`.

## Main definition

* `linear_map.charpoly f` : the characteristic polynomial of `f : M →ₗ[R] M`.

-/

universe u v w

variable {R : Type u} {M : Type v} [CommRing R] [Nontrivial R]

variable [AddCommGroup M] [Module R M] [Module.Free R M] [Module.Finite R M] (f : M →ₗ[R] M)

open Classical Matrix Polynomial

noncomputable section

open Module.Free Polynomial Matrix

namespace LinearMap

section Basic

/-- The characteristic polynomial of `f : M →ₗ[R] M`. -/
def charpoly : R[X] :=
  (toMatrix (chooseBasis R M) (chooseBasis R M) f).charpoly
#align linear_map.charpoly LinearMap.charpoly

theorem charpoly_def : f.charpoly = (toMatrix (chooseBasis R M) (chooseBasis R M) f).charpoly :=
  rfl
#align linear_map.charpoly_def LinearMap.charpoly_def

end Basic

section Coeff

theorem charpoly_monic : f.charpoly.Monic :=
  charpoly_monic _
#align linear_map.charpoly_monic LinearMap.charpoly_monic

end Coeff

section CayleyHamilton

/-- The **Cayley-Hamilton Theorem**, that the characteristic polynomial of a linear map, applied
to the linear map itself, is zero.

See `matrix.aeval_self_charpoly` for the equivalent statement about matrices. -/
theorem aeval_self_charpoly : aeval f f.charpoly = 0 :=
  by
  apply (LinearEquiv.map_eq_zero_iff (algEquivMatrix (choose_basis R M)).toLinearEquiv).1
  rw [AlgEquiv.toLinearEquiv_apply, ← AlgEquiv.coe_algHom, ← Polynomial.aeval_algHom_apply _ _ _,
    charpoly_def]
  exact aeval_self_charpoly _
#align linear_map.aeval_self_charpoly LinearMap.aeval_self_charpoly

theorem isIntegral : IsIntegral R f :=
  ⟨f.charpoly, ⟨charpoly_monic f, aeval_self_charpoly f⟩⟩
#align linear_map.is_integral LinearMap.isIntegral

theorem minpoly_dvd_charpoly {K : Type u} {M : Type v} [Field K] [AddCommGroup M] [Module K M]
    [FiniteDimensional K M] (f : M →ₗ[K] M) : minpoly K f ∣ f.charpoly :=
  minpoly.dvd _ _ (aeval_self_charpoly f)
#align linear_map.minpoly_dvd_charpoly LinearMap.minpoly_dvd_charpoly

/-- Any endomorphism polynomial `p` is equivalent under evaluation to `p %ₘ f.charpoly`; that is,
`p` is equivalent to a polynomial with degree less than the dimension of the module. -/
theorem aeval_eq_aeval_mod_charpoly (p : R[X]) : aeval f p = aeval f (p %ₘ f.charpoly) :=
  (aeval_modByMonic_eq_self_of_root f.charpoly_monic f.aeval_self_charpoly).symm
#align linear_map.aeval_eq_aeval_mod_charpoly LinearMap.aeval_eq_aeval_mod_charpoly

/-- Any endomorphism power can be computed as the sum of endomorphism powers less than the
dimension of the module. -/
theorem pow_eq_aeval_mod_charpoly (k : ℕ) : f ^ k = aeval f (X ^ k %ₘ f.charpoly) := by
  rw [← aeval_eq_aeval_mod_charpoly, map_pow, aeval_X]
#align linear_map.pow_eq_aeval_mod_charpoly LinearMap.pow_eq_aeval_mod_charpoly

variable {f}

theorem minpoly_coeff_zero_of_injective (hf : Function.Injective f) : (minpoly R f).coeff 0 ≠ 0 :=
  by
  intro h
  obtain ⟨P, hP⟩ := X_dvd_iff.2 h
  have hdegP : P.degree < (minpoly R f).degree :=
    by
    rw [hP, mul_comm]
    refine' degree_lt_degree_mul_X fun h => _
    rw [h, MulZeroClass.mul_zero] at hP
    exact minpoly.ne_zero (IsIntegral f) hP
  have hPmonic : P.monic :=
    by
    suffices (minpoly R f).Monic by
      rwa [monic.def, hP, mul_comm, leading_coeff_mul_X, ← monic.def] at this
    exact minpoly.monic (IsIntegral f)
  have hzero : aeval f (minpoly R f) = 0 := minpoly.aeval _ _
  simp only [hP, mul_eq_comp, ext_iff, hf, aeval_X, map_eq_zero_iff, coe_comp, AlgHom.map_mul,
    zero_apply] at hzero
  exact not_le.2 hdegP (minpoly.min _ _ hPmonic (ext hzero))
#align linear_map.minpoly_coeff_zero_of_injective LinearMap.minpoly_coeff_zero_of_injective

end CayleyHamilton

end LinearMap


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Alexander Bentkamp, Yury Kudryashov
-/
import analysis.convex.jensen
import analysis.normed.group.pointwise
import analysis.normed_space.finite_dimension
import analysis.normed_space.ray
import topology.path_connected
import topology.algebra.affine

/-!
# Topological and metric properties of convex sets

We prove the following facts:

* `convex.interior` : interior of a convex set is convex;
* `convex.closure` : closure of a convex set is convex;
* `set.finite.compact_convex_hull` : convex hull of a finite set is compact;
* `set.finite.is_closed_convex_hull` : convex hull of a finite set is closed;
* `convex_on_norm`, `convex_on_dist` : norm and distance to a fixed point is convex on any convex
  set;
* `convex_on_univ_norm`, `convex_on_univ_dist` : norm and distance to a fixed point is convex on
  the whole space;
* `convex_hull_ediam`, `convex_hull_diam` : convex hull of a set has the same (e)metric diameter
  as the original set;
* `bounded_convex_hull` : convex hull of a set is bounded if and only if the original set
  is bounded.
* `bounded_std_simplex`, `is_closed_std_simplex`, `compact_std_simplex`: topological properties
  of the standard simplex;
-/

variables {ι : Type*} {E : Type*}

open metric set
open_locale pointwise convex

lemma real.convex_iff_is_preconnected {s : set ℝ} : convex ℝ s ↔ is_preconnected s :=
convex_iff_ord_connected.trans is_preconnected_iff_ord_connected.symm

alias real.convex_iff_is_preconnected ↔ convex.is_preconnected is_preconnected.convex

/-! ### Standard simplex -/

section std_simplex

variables [fintype ι]

/-- Every vector in `std_simplex 𝕜 ι` has `max`-norm at most `1`. -/
lemma std_simplex_subset_closed_ball :
  std_simplex ℝ ι ⊆ metric.closed_ball 0 1 :=
begin
  assume f hf,
  rw [metric.mem_closed_ball, dist_zero_right],
  refine (nnreal.coe_one ▸ nnreal.coe_le_coe.2 $ finset.sup_le $ λ x hx, _),
  change |f x| ≤ 1,
  rw [abs_of_nonneg $ hf.1 x],
  exact (mem_Icc_of_mem_std_simplex hf x).2
end

variable (ι)

/-- `std_simplex ℝ ι` is bounded. -/
lemma bounded_std_simplex : metric.bounded (std_simplex ℝ ι) :=
(metric.bounded_iff_subset_ball 0).2 ⟨1, std_simplex_subset_closed_ball⟩

/-- `std_simplex ℝ ι` is closed. -/
lemma is_closed_std_simplex : is_closed (std_simplex ℝ ι) :=
(std_simplex_eq_inter ℝ ι).symm ▸ is_closed.inter
  (is_closed_Inter $ λ i, is_closed_le continuous_const (continuous_apply i))
  (is_closed_eq (continuous_finset_sum _ $ λ x _, continuous_apply x) continuous_const)

/-- `std_simplex ℝ ι` is compact. -/
lemma compact_std_simplex : is_compact (std_simplex ℝ ι) :=
metric.compact_iff_closed_bounded.2 ⟨is_closed_std_simplex ι, bounded_std_simplex ι⟩

end std_simplex

/-! ### Topological vector space -/

section has_continuous_const_smul

variables {𝕜 : Type*} [linear_ordered_field 𝕜] [add_comm_group E] [module 𝕜 E] [topological_space E]
  [topological_add_group E] [has_continuous_const_smul 𝕜 E]

/-- If `s` is a convex set, then `a • interior s + b • closure s ⊆ interior s` for all `0 < a`,
`0 ≤ b`, `a + b = 1`. See also `convex.combo_interior_self_subset_interior` for a weaker version. -/
lemma convex.combo_interior_closure_subset_interior {s : set E} (hs : convex 𝕜 s) {a b : 𝕜}
  (ha : 0 < a) (hb : 0 ≤ b) (hab : a + b = 1) :
  a • interior s + b • closure s ⊆ interior s :=
interior_smul₀ ha.ne' s ▸
  calc interior (a • s) + b • closure s ⊆ interior (a • s) + closure (b • s) :
    add_subset_add subset.rfl (smul_closure_subset b s)
  ... = interior (a • s) + b • s : by rw is_open_interior.add_closure (b • s)
  ... ⊆ interior (a • s + b • s) : subset_interior_add_left
  ... ⊆ interior s : interior_mono $ hs.set_combo_subset ha.le hb hab

/-- If `s` is a convex set, then `a • interior s + b • s ⊆ interior s` for all `0 < a`, `0 ≤ b`,
`a + b = 1`. See also `convex.combo_interior_closure_subset_interior` for a stronger version. -/
lemma convex.combo_interior_self_subset_interior {s : set E} (hs : convex 𝕜 s) {a b : 𝕜}
  (ha : 0 < a) (hb : 0 ≤ b) (hab : a + b = 1) :
  a • interior s + b • s ⊆ interior s :=
calc a • interior s + b • s ⊆ a • interior s + b • closure s :
  add_subset_add subset.rfl $ image_subset _ subset_closure
... ⊆ interior s : hs.combo_interior_closure_subset_interior ha hb hab

/-- If `s` is a convex set, then `a • closure s + b • interior s ⊆ interior s` for all `0 ≤ a`,
`0 < b`, `a + b = 1`. See also `convex.combo_self_interior_subset_interior` for a weaker version. -/
lemma convex.combo_closure_interior_subset_interior {s : set E} (hs : convex 𝕜 s) {a b : 𝕜}
  (ha : 0 ≤ a) (hb : 0 < b) (hab : a + b = 1) :
  a • closure s + b • interior s ⊆ interior s :=
by { rw add_comm, exact hs.combo_interior_closure_subset_interior hb ha (add_comm a b ▸ hab) }

/-- If `s` is a convex set, then `a • s + b • interior s ⊆ interior s` for all `0 ≤ a`, `0 < b`,
`a + b = 1`. See also `convex.combo_closure_interior_subset_interior` for a stronger version. -/
lemma convex.combo_self_interior_subset_interior {s : set E} (hs : convex 𝕜 s) {a b : 𝕜}
  (ha : 0 ≤ a) (hb : 0 < b) (hab : a + b = 1) :
  a • s + b • interior s ⊆ interior s :=
by { rw add_comm, exact hs.combo_interior_self_subset_interior hb ha (add_comm a b ▸ hab) }

lemma convex.combo_interior_closure_mem_interior {s : set E} (hs : convex 𝕜 s) {x y : E}
  (hx : x ∈ interior s) (hy : y ∈ closure s) {a b : 𝕜} (ha : 0 < a) (hb : 0 ≤ b) (hab : a + b = 1) :
  a • x + b • y ∈ interior s :=
hs.combo_interior_closure_subset_interior ha hb hab $
  add_mem_add (smul_mem_smul_set hx) (smul_mem_smul_set hy)

lemma convex.combo_interior_self_mem_interior {s : set E} (hs : convex 𝕜 s) {x y : E}
  (hx : x ∈ interior s) (hy : y ∈ s) {a b : 𝕜} (ha : 0 < a) (hb : 0 ≤ b) (hab : a + b = 1) :
  a • x + b • y ∈ interior s :=
hs.combo_interior_closure_mem_interior hx (subset_closure hy) ha hb hab

lemma convex.combo_closure_interior_mem_interior {s : set E} (hs : convex 𝕜 s) {x y : E}
  (hx : x ∈ closure s) (hy : y ∈ interior s) {a b : 𝕜} (ha : 0 ≤ a) (hb : 0 < b) (hab : a + b = 1) :
  a • x + b • y ∈ interior s :=
hs.combo_closure_interior_subset_interior ha hb hab $
  add_mem_add (smul_mem_smul_set hx) (smul_mem_smul_set hy)

lemma convex.combo_self_interior_mem_interior {s : set E} (hs : convex 𝕜 s) {x y : E}
  (hx : x ∈ s) (hy : y ∈ interior s) {a b : 𝕜} (ha : 0 ≤ a) (hb : 0 < b) (hab : a + b = 1) :
  a • x + b • y ∈ interior s :=
hs.combo_closure_interior_mem_interior (subset_closure hx) hy ha hb hab

lemma convex.open_segment_interior_closure_subset_interior {s : set E} (hs : convex 𝕜 s) {x y : E}
  (hx : x ∈ interior s) (hy : y ∈ closure s) : open_segment 𝕜 x y ⊆ interior s :=
begin
  rintro _ ⟨a, b, ha, hb, hab, rfl⟩,
  exact hs.combo_interior_closure_mem_interior hx hy ha hb.le hab
end

lemma convex.open_segment_interior_self_subset_interior {s : set E} (hs : convex 𝕜 s) {x y : E}
  (hx : x ∈ interior s) (hy : y ∈ s) : open_segment 𝕜 x y ⊆ interior s :=
hs.open_segment_interior_closure_subset_interior hx (subset_closure hy)

lemma convex.open_segment_closure_interior_subset_interior {s : set E} (hs : convex 𝕜 s) {x y : E}
  (hx : x ∈ closure s) (hy : y ∈ interior s) : open_segment 𝕜 x y ⊆ interior s :=
begin
  rintro _ ⟨a, b, ha, hb, hab, rfl⟩,
  exact hs.combo_closure_interior_mem_interior hx hy ha.le hb hab
end

lemma convex.open_segment_self_interior_subset_interior {s : set E} (hs : convex 𝕜 s) {x y : E}
  (hx : x ∈ s) (hy : y ∈ interior s) : open_segment 𝕜 x y ⊆ interior s :=
hs.open_segment_closure_interior_subset_interior (subset_closure hx) hy

/-- If `x ∈ closure s` and `y ∈ interior s`, then the segment `(x, y]` is included in `interior s`.
-/
lemma convex.add_smul_sub_mem_interior' {s : set E} (hs : convex 𝕜 s)
  {x y : E} (hx : x ∈ closure s) (hy : y ∈ interior s) {t : 𝕜} (ht : t ∈ Ioc (0 : 𝕜) 1) :
  x + t • (y - x) ∈ interior s :=
by simpa only [sub_smul, smul_sub, one_smul, add_sub, add_comm]
  using hs.combo_interior_closure_mem_interior hy hx ht.1 (sub_nonneg.mpr ht.2)
    (add_sub_cancel'_right _ _)

/-- If `x ∈ s` and `y ∈ interior s`, then the segment `(x, y]` is included in `interior s`. -/
lemma convex.add_smul_sub_mem_interior {s : set E} (hs : convex 𝕜 s)
  {x y : E} (hx : x ∈ s) (hy : y ∈ interior s) {t : 𝕜} (ht : t ∈ Ioc (0 : 𝕜) 1) :
  x + t • (y - x) ∈ interior s :=
hs.add_smul_sub_mem_interior' (subset_closure hx) hy ht

/-- If `x ∈ closure s` and `x + y ∈ interior s`, then `x + t y ∈ interior s` for `t ∈ (0, 1]`. -/
lemma convex.add_smul_mem_interior' {s : set E} (hs : convex 𝕜 s)
  {x y : E} (hx : x ∈ closure s) (hy : x + y ∈ interior s) {t : 𝕜} (ht : t ∈ Ioc (0 : 𝕜) 1) :
  x + t • y ∈ interior s :=
by simpa only [add_sub_cancel'] using hs.add_smul_sub_mem_interior' hx hy ht

/-- If `x ∈ s` and `x + y ∈ interior s`, then `x + t y ∈ interior s` for `t ∈ (0, 1]`. -/
lemma convex.add_smul_mem_interior {s : set E} (hs : convex 𝕜 s)
  {x y : E} (hx : x ∈ s) (hy : x + y ∈ interior s) {t : 𝕜} (ht : t ∈ Ioc (0 : 𝕜) 1) :
  x + t • y ∈ interior s :=
hs.add_smul_mem_interior' (subset_closure hx) hy ht

/-- In a topological vector space, the interior of a convex set is convex. -/
protected lemma convex.interior {s : set E} (hs : convex 𝕜 s) : convex 𝕜 (interior s) :=
convex_iff_open_segment_subset.mpr $ λ x y hx hy,
  hs.open_segment_closure_interior_subset_interior (interior_subset_closure hx) hy

/-- In a topological vector space, the closure of a convex set is convex. -/
protected lemma convex.closure {s : set E} (hs : convex 𝕜 s) : convex 𝕜 (closure s) :=
λ x y hx hy a b ha hb hab,
let f : E → E → E := λ x' y', a • x' + b • y' in
have hf : continuous (λ p : E × E, f p.1 p.2), from
  (continuous_fst.const_smul _).add (continuous_snd.const_smul _),
show f x y ∈ closure s, from
  mem_closure_of_continuous2 hf hx hy (λ x' hx' y' hy', subset_closure
  (hs hx' hy' ha hb hab))

end has_continuous_const_smul

section has_continuous_smul

variables [add_comm_group E] [module ℝ E] [topological_space E]
  [topological_add_group E] [has_continuous_smul ℝ E]

/-- Convex hull of a finite set is compact. -/
lemma set.finite.compact_convex_hull {s : set E} (hs : s.finite) :
  is_compact (convex_hull ℝ s) :=
begin
  rw [hs.convex_hull_eq_image],
  apply (compact_std_simplex _).image,
  haveI := hs.fintype,
  apply linear_map.continuous_on_pi
end

/-- Convex hull of a finite set is closed. -/
lemma set.finite.is_closed_convex_hull [t2_space E] {s : set E} (hs : s.finite) :
  is_closed (convex_hull ℝ s) :=
hs.compact_convex_hull.is_closed

open affine_map

/-- If we dilate the interior of a convex set about a point in its interior by a scale `t > 1`,
the result includes the closure of the original set.

TODO Generalise this from convex sets to sets that are balanced / star-shaped about `x`. -/
lemma convex.closure_subset_image_homothety_interior_of_one_lt {s : set E} (hs : convex ℝ s)
  {x : E} (hx : x ∈ interior s) (t : ℝ) (ht : 1 < t) :
  closure s ⊆ homothety x t '' interior s :=
begin
  intros y hy,
  have hne : t ≠ 0, from (one_pos.trans ht).ne',
  refine ⟨homothety x t⁻¹ y, hs.open_segment_interior_closure_subset_interior hx hy _,
    (affine_equiv.homothety_units_mul_hom x (units.mk0 t hne)).apply_symm_apply y⟩,
  rw [open_segment_eq_image_line_map, ← inv_one, ← inv_Ioi (@one_pos ℝ _ _), ← image_inv,
    image_image, homothety_eq_line_map],
  exact mem_image_of_mem _ ht
end

/-- If we dilate a convex set about a point in its interior by a scale `t > 1`, the interior of
the result includes the closure of the original set.

TODO Generalise this from convex sets to sets that are balanced / star-shaped about `x`. -/
lemma convex.closure_subset_interior_image_homothety_of_one_lt {s : set E} (hs : convex ℝ s)
  {x : E} (hx : x ∈ interior s) (t : ℝ) (ht : 1 < t) :
  closure s ⊆ interior (homothety x t '' s) :=
(hs.closure_subset_image_homothety_interior_of_one_lt hx t ht).trans $
  (homothety_is_open_map x t (one_pos.trans ht).ne').image_interior_subset _

/-- If we dilate a convex set about a point in its interior by a scale `t > 1`, the interior of
the result includes the closure of the original set.

TODO Generalise this from convex sets to sets that are balanced / star-shaped about `x`. -/
lemma convex.subset_interior_image_homothety_of_one_lt {s : set E} (hs : convex ℝ s)
  {x : E} (hx : x ∈ interior s) (t : ℝ) (ht : 1 < t) :
  s ⊆ interior (homothety x t '' s) :=
subset_closure.trans $ hs.closure_subset_interior_image_homothety_of_one_lt hx t ht

protected lemma convex.is_path_connected {s : set E} (hconv : convex ℝ s) (hne : s.nonempty) :
  is_path_connected s :=
begin
  refine is_path_connected_iff.mpr ⟨hne, _⟩,
  intros x x_in y y_in,
  have H := hconv.segment_subset x_in y_in,
  rw segment_eq_image_line_map at H,
  exact joined_in.of_line affine_map.line_map_continuous.continuous_on (line_map_apply_zero _ _)
    (line_map_apply_one _ _) H
end

/--
Every topological vector space over ℝ is path connected.

Not an instance, because it creates enormous TC subproblems (turn on `pp.all`).
-/
protected lemma topological_add_group.path_connected : path_connected_space E :=
path_connected_space_iff_univ.mpr $ convex_univ.is_path_connected ⟨(0 : E), trivial⟩

end has_continuous_smul

/-! ### Normed vector space -/

section normed_space
variables [semi_normed_group E] [normed_space ℝ E] {s t : set E}

/-- The norm on a real normed space is convex on any convex set. See also `seminorm.convex_on`
and `convex_on_univ_norm`. -/
lemma convex_on_norm (hs : convex ℝ s) : convex_on ℝ s norm :=
⟨hs, λ x y hx hy a b ha hb hab,
  calc ∥a • x + b • y∥ ≤ ∥a • x∥ + ∥b • y∥ : norm_add_le _ _
    ... = a * ∥x∥ + b * ∥y∥
        : by rw [norm_smul, norm_smul, real.norm_of_nonneg ha, real.norm_of_nonneg hb]⟩

/-- The norm on a real normed space is convex on the whole space. See also `seminorm.convex_on`
and `convex_on_norm`. -/
lemma convex_on_univ_norm : convex_on ℝ univ (norm : E → ℝ) := convex_on_norm convex_univ

lemma convex_on_dist (z : E) (hs : convex ℝ s) : convex_on ℝ s (λ z', dist z' z) :=
by simpa [dist_eq_norm, preimage_preimage]
  using (convex_on_norm (hs.translate (-z))).comp_affine_map
    (affine_map.id ℝ E - affine_map.const ℝ E z)

lemma convex_on_univ_dist (z : E) : convex_on ℝ univ (λz', dist z' z) :=
convex_on_dist z convex_univ

lemma convex_ball (a : E) (r : ℝ) : convex ℝ (metric.ball a r) :=
by simpa only [metric.ball, sep_univ] using (convex_on_univ_dist a).convex_lt r

lemma convex_closed_ball (a : E) (r : ℝ) : convex ℝ (metric.closed_ball a r) :=
by simpa only [metric.closed_ball, sep_univ] using (convex_on_univ_dist a).convex_le r

lemma convex.thickening (hs : convex ℝ s) (δ : ℝ) : convex ℝ (thickening δ s) :=
by { rw ←add_ball_zero, exact hs.add (convex_ball 0 _) }

lemma convex.cthickening (hs : convex ℝ s) (δ : ℝ) : convex ℝ (cthickening δ s) :=
begin
  obtain hδ | hδ := le_total 0 δ,
  { rw cthickening_eq_Inter_thickening hδ,
    exact convex_Inter₂ (λ _ _, hs.thickening _) },
  { rw cthickening_of_nonpos hδ,
    exact hs.closure }
end

/-- If `s`, `t` are disjoint convex sets, `s` is compact and `t` is closed then we can find open
disjoint convex sets containing them. -/
lemma disjoint.exists_open_convexes (disj : disjoint s t) (hs₁ : convex ℝ s) (hs₂ : is_compact s)
  (ht₁ : convex ℝ t) (ht₂ : is_closed t) :
  ∃ u v, is_open u ∧ is_open v ∧ convex ℝ u ∧ convex ℝ v ∧ s ⊆ u ∧ t ⊆ v ∧ disjoint u v :=
let ⟨δ, hδ, hst⟩ := disj.exists_thickenings hs₂ ht₂ in
  ⟨_, _, is_open_thickening, is_open_thickening, hs₁.thickening _, ht₁.thickening _,
    self_subset_thickening hδ _, self_subset_thickening hδ _, hst⟩

/-- Given a point `x` in the convex hull of `s` and a point `y`, there exists a point
of `s` at distance at least `dist x y` from `y`. -/
lemma convex_hull_exists_dist_ge {s : set E} {x : E} (hx : x ∈ convex_hull ℝ s) (y : E) :
  ∃ x' ∈ s, dist x y ≤ dist x' y :=
(convex_on_dist y (convex_convex_hull ℝ _)).exists_ge_of_mem_convex_hull hx

/-- Given a point `x` in the convex hull of `s` and a point `y` in the convex hull of `t`,
there exist points `x' ∈ s` and `y' ∈ t` at distance at least `dist x y`. -/
lemma convex_hull_exists_dist_ge2 {s t : set E} {x y : E}
  (hx : x ∈ convex_hull ℝ s) (hy : y ∈ convex_hull ℝ t) :
  ∃ (x' ∈ s) (y' ∈ t), dist x y ≤ dist x' y' :=
begin
  rcases convex_hull_exists_dist_ge hx y with ⟨x', hx', Hx'⟩,
  rcases convex_hull_exists_dist_ge hy x' with ⟨y', hy', Hy'⟩,
  use [x', hx', y', hy'],
  exact le_trans Hx' (dist_comm y x' ▸ dist_comm y' x' ▸ Hy')
end

/-- Emetric diameter of the convex hull of a set `s` equals the emetric diameter of `s. -/
@[simp] lemma convex_hull_ediam (s : set E) :
  emetric.diam (convex_hull ℝ s) = emetric.diam s :=
begin
  refine (emetric.diam_le $ λ x hx y hy, _).antisymm (emetric.diam_mono $ subset_convex_hull ℝ s),
  rcases convex_hull_exists_dist_ge2 hx hy with ⟨x', hx', y', hy', H⟩,
  rw edist_dist,
  apply le_trans (ennreal.of_real_le_of_real H),
  rw ← edist_dist,
  exact emetric.edist_le_diam_of_mem hx' hy'
end

/-- Diameter of the convex hull of a set `s` equals the emetric diameter of `s. -/
@[simp] lemma convex_hull_diam (s : set E) :
  metric.diam (convex_hull ℝ s) = metric.diam s :=
by simp only [metric.diam, convex_hull_ediam]

/-- Convex hull of `s` is bounded if and only if `s` is bounded. -/
@[simp] lemma bounded_convex_hull {s : set E} :
  metric.bounded (convex_hull ℝ s) ↔ metric.bounded s :=
by simp only [metric.bounded_iff_ediam_ne_top, convex_hull_ediam]

@[priority 100]
instance normed_space.path_connected : path_connected_space E :=
topological_add_group.path_connected

@[priority 100]
instance normed_space.loc_path_connected : loc_path_connected_space E :=
loc_path_connected_of_bases (λ x, metric.nhds_basis_ball)
  (λ x r r_pos, (convex_ball x r).is_path_connected $ by simp [r_pos])

lemma dist_add_dist_of_mem_segment {x y z : E} (h : y ∈ [x -[ℝ] z]) :
  dist x y + dist y z = dist x z :=
begin
  simp only [dist_eq_norm, mem_segment_iff_same_ray] at *,
  simpa only [sub_add_sub_cancel', norm_sub_rev] using h.norm_add.symm
end

end normed_space


-- Exercise 1
--
-- Prove the following identities, replacing the “sorry” placeholders with
-- actual proofs.
section
  variables p q r : Prop

  -- commutativity of ∧ and ∨
  example : p ∧ q ↔ q ∧ p :=
    iff.intro
      (assume hp : p ∧ q,
        show q ∧ p, from and.intro (and.right hp) (and.left hp))
      (assume hq : q ∧ p,
        show p ∧ q, from and.intro (and.right hq) (and.left hq))

  example : p ∨ q ↔ q ∨ p :=
    iff.intro
      (assume hp : p ∨ q,
        show q ∨ p, from or.elim hp (or.intro_right q) (or.intro_left p))
      (assume hq : q ∨ p,
        show p ∨ q, from or.elim hq (or.intro_right p) (or.intro_left q))

  -- associativity of ∧ and ∨
  example : (p ∧ q) ∧ r ↔ p ∧ (q ∧ r) :=
    iff.intro
      (assume h : (p ∧ q) ∧ r,
        show p ∧ (q ∧ r), from
          and.intro
            (and.left (and.left h))
            (and.intro
              (and.right (and.left h))
              (and.right h)))
      (assume h : p ∧ (q ∧ r),
        show (p ∧ q) ∧ r, from
          and.intro
            (and.intro
              (and.left h)
              (and.left (and.right h)))
            (and.right (and.right h)))

  example : (p ∨ q) ∨ r ↔ p ∨ (q ∨ r) :=
  begin
    split,

    -- (p ∨ q) ∨ r → p ∨ (q ∨ r)
    {
      assume h,

      have f : (p ∨ q) → p ∨ q ∨ r,
      assume pq : (p ∨ q),
      exact
        or.elim
        pq
        (λ hp : p, or.intro_left (q ∨ r) hp)
        (λ hq : q, or.intro_right p (or.intro_left r hq)),

      have g : r → p ∨ q ∨ r,
      assume hr : r,
      exact or.intro_right p (or.intro_right q hr),

      exact or.elim h f g,
    },

    -- p ∨ (q ∨ r) → (p ∨ q) ∨ r
    {
      assume h,

      have f : p → (p ∨ q) ∨ r,
      assume hp,
      exact or.intro_left r (or.intro_left q hp),

      have g : (q ∨ r) → (p ∨ q) ∨ r,
      assume qr,
      exact
        or.elim
        qr
        (λ hq : q, or.intro_left r (or.intro_right p hq))
        (λ hr : r, or.intro_right (p ∨ q) hr),

      exact or.elim h f g,
    },
  end

  -- distributivity
  example : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
  begin
    split,

    {
      assume h,

      have f : q → (p ∧ q) ∨ (p ∧ r),
      assume hq : q,
      exact or.intro_left (p ∧ r) (and.intro (and.left h) hq),

      have g : r → (p ∧ q) ∨ (p ∧ r),
      assume hr,
      exact or.intro_right (p ∧ q) (and.intro (and.left h) hr),

      exact or.elim (and.right h) f g,
    },

    {
      assume h,

      have f : p ∧ q → p ∧ (q ∨ r),
      assume pq : p ∧ q,
      exact and.intro (and.left pq) (or.intro_left r (and.right pq)),

      have g : p ∧ r → p ∧ (q ∨ r),
      assume pr : p ∧ r,
      exact and.intro (and.left pr) (or.intro_right q (and.right pr)),

      exact or.elim h f g,
    },
  end

  section
    variable hp : p

    #check and.intro (or.intro_left q hp)
  end

  example : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (p ∨ r) :=
  begin
    split,

    -- p ∨ (q ∧ r) → (p ∨ q) ∧ (p ∨ r)
    {
      assume h,

      have f : p → (p ∨ q) ∧ (p ∨ r),
      assume hp : p,
      exact
        and.intro
          (or.intro_left q hp)
          (or.intro_left r hp),

      have g : q ∧ r → (p ∨ q) ∧ (p ∨ r),
      assume qr,
      exact
        and.intro
          (or.intro_right p (and.left qr))
          (or.intro_right p (and.right qr)),

      exact or.elim h f g,
    },

    -- (p ∨ q) ∧ (p ∨ r) → p ∨ (q ∧ r)
    {
      assume h,
      have hpq : p ∨ q, from and.left h,
      have hpr : p ∨ r, from and.right h,

      have f : p → p ∨ (q ∧ r),
      assume hp,
      exact or.intro_left (q ∧ r) hp,

      have g : q → p ∨ (q ∧ r),
      assume hq,
      exact or.elim hpr f (λ hr : r, or.intro_right p (and.intro hq hr)),

      exact or.elim hpq f g,
    },
  end

  -- other properties
  --
  -- NOTE: Leaving these blank because I think I've got the hang of these kinds
  --       of derivations.
  example : (p → (q → r)) ↔ (p ∧ q → r) := sorry
  example : ((p ∨ q) → r) ↔ (p → r) ∧ (q → r) := sorry
  example : ¬(p ∨ q) ↔ ¬p ∧ ¬q := sorry
  example : ¬p ∨ ¬q → ¬(p ∧ q) := sorry
  example : ¬(p ∧ ¬p) := sorry
  example : p ∧ ¬q → ¬(p → q) := sorry
  example : ¬p → (p → q) := sorry
  example : (¬p ∨ q) → (p → q) := sorry
  example : p ∨ false ↔ p := sorry
  example : p ∧ false ↔ false := sorry
  example : ¬(p ↔ ¬p) := sorry
  example : (p → q) → (¬q → ¬p) := sorry
end

-- Exercise 2
--
-- Prove the following identities, replacing the “sorry” placeholders with
-- actual proofs. These require classical reasoning.
section
  open classical

  section
    #check by_cases
    #check not.intro
  end

  variables p q r s : Prop

  section
    variable f : p → q
    variable hnp : ¬p

    #check f hnp
  end

  example : (p → r ∨ s) → ((p → r) ∨ (p → s)) :=
  begin
    assume h,

    have hi_pos : p → (p → r) ∨ (p → s),
    {
      assume hp,
      have hrs : r ∨ s, from h hp,

      exact
        or.elim
          hrs
          (λ hr : r, or.intro_left (p → s) (λ hp' : p, hr))
          (λ hs : s, or.intro_right (p → r) (λ hp' : p, hs)),
    },

    have hi_neg : ¬p → (p → r) ∨ (p → s),
    {
      assume hnp,

      suffices hpr : p → r,
      exact or.intro_left (p → s) hpr,

      assume hp,
      exact absurd hp hnp,
    }

    by_cases hi_pos hi_neg,
  end

  example : ¬(p ∧ q) → ¬p ∨ ¬q :=
  begin
    assume h,

    have f : p → ¬p ∨ ¬q,
    {
      assume hp,

      have hq : ¬q,
      {
        assume hq' : q,
        exact h (and.intro hp hq'),
      },

      exact or.intro_right (¬p) hq,
    },

    have g : ¬p → ¬p ∨ ¬q,
    assume hp,
    exact or.intro_left (¬q) hp,

    exact by_cases f g,
  end

  example : ¬(p → q) → p ∧ ¬q :=
  begin
    assume h,

    have pos : q → p ∧ ¬q,
    {
      assume hq,
      exact false.elim (h (λ hp : p, hq)),
    },

    have neg : ¬q → p ∧ ¬q,
    {
      assume hnq,
      exact
        by_cases
          (λ hp : p, and.intro hp hnq)
          (λ hnp : ¬p,
            suffices hneg : p → q, from false.elim (h hneg),
            assume hp,
            absurd hp hnp),
    },

    exact by_cases pos neg,
  end

  example : (p → q) → (¬p ∨ q) :=
  begin
    assume h,

    have f : p → ¬p ∨ q,
    assume hp,
    exact or.inr (h hp),

    have g : ¬p → ¬p ∨ q,
    assume hnp,
    exact or.inl hnp,

    exact or.elim (em p) f g,
  end

  -- NOTE: Here I'm using `absurd` when we have ¬q, because we find a
  --       contradiction. Logically it's like saying that logical branch cannot
  --       exist?
  example : (¬q → ¬p) → (p → q) :=
  begin
    assume h,
    assume hp,

    exact by_cases
      (λ hq : q, hq)
      (λ hnq : ¬q, absurd hp (h hnq)),
  end

  example : p ∨ ¬p :=
  begin
    exact em p,
  end

  example : (((p → q) → p) → p) :=
  begin
    assume h,

    have pos : p → p, from id,

    have neg : ¬p → p,
    {
      assume hnp,

      have qpos : q → p,
      assume hq,
      exact h (λ hp : p, hq),

      have qneg : ¬q → p,
      assume hnq,

      suffices hneg : p → q, from h hneg,
      assume hp,
      exact absurd hp hnp,

      exact by_cases qpos qneg,
    },

    exact by_cases pos neg,
  end
end

-- Exercise 3
--
-- Prove ¬(p ↔ ¬p) without using classical logic.
section
  variables p : Prop

  example : ¬(p ↔ ¬p) :=
  begin
    assume hneg,

    exact
      classical.by_cases
        (λ hp : p, absurd hp (hneg.mp hp))
        (λ hnp : ¬p, absurd (hneg.mpr hnp) hnp),
  end

  example : ¬(p ↔ ¬p) :=
  begin
    assume hneg : (p ↔ ¬p),

    have hnp : ¬p,
    show p → false,
    assume hp : p,
    exact (hneg.mp hp) hp,

    exact absurd (hneg.mpr hnp) hnp,
  end
end


import MyNat.Definition
import MyNat.Inequality -- le_iff_exists_add
import Mathlib.Tactic.Use -- use tactic
import AdditionWorld.Level6 -- add_right_comm
import AdvancedAdditionWorld.Level1 --  succ_inj
namespace MyNat
open MyNat
/-!

# Inequality world.

## Level 12: `le_of_succ_le_succ`

## Lemma : le_of_succ_le_succ
For all naturals `a` and `b`, `succ a ≤ succ b ⟹ a ≤ b.`
-/
theorem le_of_succ_le_succ (a b : MyNat) : succ a ≤ succ b → a ≤ b := by
  intro h
  cases h with
  | _ c hc =>
    use c
    apply succ_inj
    rw [hc]
    exact succ_add a c

/-!
Next up [Level 13](./Level13.lean.md)
-/


import data.real.basic
open function

/-
# Chapter 6 : Functions

## Level 6

A classical result in composition of functions.
Now going the other way around.
-/

/- Lemma
If composition of $f$ and $g$ is surjective, then $g$ is injective.
-/
theorem composition_surjective
    (X Y Z : set ℝ) (f : X → Y) (g : Y → Z) : surjective (g ∘ f) → surjective g :=
begin
    intros sgf z,
    have hx := sgf z,
    cases hx with x gfxz,
    use f x,
    exact gfxz, done
end


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

/--
A group of $N$ students, where $N < 50$, is on a field trip.
If their teacher puts them in groups of 8, the last group has 5 students.
If their teacher instead puts them in groups of 6, the last group has 3 students.
What is the sum of all possible values of $N$?
Answer: $66$.
--/
theorem mathd_numbertheory_149 :
  ∑ k in (finset.filter (λ x, x % 8 = 5 ∧ x % 6 = 3) (finset.range 50)), k = 66 :=
begin
  congr',
end


import data.rat

open function

namespace mth1001

section composite

def q₁ (x : ℕ) : ℤ := x + 3
def q₂ (x : ℤ) : ℚ := 2 * x

/-
When a function `f` takes values from a type (or set) `α` and returns values in a type (or set) `β`,
we write that the *domain* of `f` is `α` and the *codomain* of `f` is `β`. This is denoted
`f : α → β`.
-/

/-
Given `f : α → β` and `g : β → γ`, the *composite* of `g` and `f`, denoted `g ∘ f` is the function
`g ∘ f : α → γ` with the property that `(g ∘ f) x = g (f x)`, for every `x : α`.
-/

-- With `q₁` and `q₂` as above, `q₁ : ℕ → ℤ` and `q₂ : Z → ℚ`. So `q₂ ∘ q₁ : ℕ → ℚ`.
#check q₁
#check q₂
#check q₂ ∘ q₁

-- We verify, that `(q₂ ∘ q₁) 5 = q₂ (q₁ 5)`.
#eval (q₂ ∘ q₁) 5
#eval q₂ (q₁ 5)

/-
With the above functions, `q₁ ∘ q₂` is *not defined* as the codomain of `q₂` differs from the
domain of `q₁`.
-/

/-
If all the domains and codomains of two functions, say `p₁` and `p₂` are equal, then it makes sense
to consider both composites. However, `p₂ ∘ p₁` will not (in general) be equal to `p₁ ∘ p₂`.
-/

def p₁ (x : ℤ) : ℤ := 3 * x
def p₂ (y : ℤ) : ℤ := y + 4

#eval (p₂ ∘ p₁) 6  -- `(p₂ ∘ p₁) 6 = p₂ (p₁ 6) = p₂ (3*6) = p₂ 18 = 18 + 4 = 22`, but
#eval (p₁ ∘ p₂) 6  -- `(p₁ ∘ p₂) 6 = p₁ (p₂ 6) = p₁ (6 + 4) = p₁ 10 = 3 * 10 = 30`.

/-
We'll prove that the composite of two injective functions is injective.
-/

variable {α : Type*}
variable {β : Type*}
variable {γ : Type*}

theorem injective_comp {f : α → β} {g : β → γ} (h₁ : injective f) (h₂ : injective g) :
  injective (g ∘ f) :=
begin
  unfold injective at *, -- We use the definition of injective.
  intros a₁ a₂ h, -- Assume `a₁ a₂ : α`. Assume `h : (g ∘ f) a₁ = (g ∘ f) a₂`.
  have h₄ : f a₁ = f a₂,
    from h₂ h, -- By injectivity of `g`, applied to `h`, we have `h₄ : f a₁ = f a₂`.
  show a₁ = a₂, from h₁ h₄, -- We show `a₁ = a₂` by injectivity of `f`, applied to `h₄`.
end

/-
We'll prove that the composite of two surjective functions is surjective. The proof is
more involved that the corresponding injectivity result.
-/
theorem surjective_comp {f : α → β} {g : β → γ} (h₁ : surjective f) (h₂ : surjective g) :
  surjective (g ∘ f) :=
begin
  unfold surjective at *, -- We use the definition of surjective.
  intro c, -- Assume `c : γ`. It suffices to show `∃ a : α, (g ∘ f) a = c`.
  sorry
end

-- Exercise 145:
-- From these two results, we have that the composite of two bijective functions is bijective.
theorem bijective_comp {f : α → β} {g : β → γ} (h₁ : bijective f) (h₂ : bijective g) :
  bijective (g ∘ f) :=
begin
  sorry
end

end composite

end mth1001


/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mitchell Rowett, Scott Morrison, Johan Commelin, Mario Carneiro
-/
import group_theory.submonoid
open set function

variables {α : Type*} {β : Type*} {a a₁ a₂ b c: α}

section group
variables [group α] [add_group β]

@[to_additive injective_add]
lemma injective_mul {a : α} : injective ((*) a) :=
assume a₁ a₂ h,
have a⁻¹ * a * a₁ = a⁻¹ * a * a₂, by rw [mul_assoc, mul_assoc, h],
by rwa [inv_mul_self, one_mul, one_mul] at this

/-- `s` is a subgroup: a set containing 1 and closed under multiplication and inverse. -/
class is_subgroup (s : set α) extends is_submonoid s : Prop :=
(inv_mem {a} : a ∈ s → a⁻¹ ∈ s)

/-- `s` is an additive subgroup: a set containing 0 and closed under addition and negation. -/
class is_add_subgroup (s : set β) extends is_add_submonoid s : Prop :=
(neg_mem {a} : a ∈ s → -a ∈ s)
attribute [to_additive is_add_subgroup] is_subgroup
attribute [to_additive is_add_subgroup.to_is_add_submonoid] is_subgroup.to_is_submonoid
attribute [to_additive is_add_subgroup.neg_mem] is_subgroup.inv_mem
attribute [to_additive is_add_subgroup.mk] is_subgroup.mk

instance additive.is_add_subgroup
  (s : set α) [is_subgroup s] : @is_add_subgroup (additive α) _ s :=
⟨@is_subgroup.inv_mem _ _ _ _⟩

theorem additive.is_add_subgroup_iff
  {s : set α} : @is_add_subgroup (additive α) _ s ↔ is_subgroup s :=
⟨by rintro ⟨⟨h₁, h₂⟩, h₃⟩; exact @is_subgroup.mk α _ _ ⟨h₁, @h₂⟩ @h₃,
  λ h, by resetI; apply_instance⟩

instance multiplicative.is_subgroup
  (s : set β) [is_add_subgroup s] : @is_subgroup (multiplicative β) _ s :=
⟨@is_add_subgroup.neg_mem _ _ _ _⟩

theorem multiplicative.is_subgroup_iff
  {s : set β} : @is_subgroup (multiplicative β) _ s ↔ is_add_subgroup s :=
⟨by rintro ⟨⟨h₁, h₂⟩, h₃⟩; exact @is_add_subgroup.mk β _ _ ⟨h₁, @h₂⟩ @h₃,
  λ h, by resetI; apply_instance⟩

instance subtype.group {s : set α} [is_subgroup s] : group s :=
by subtype_instance

instance subtype.add_group {s : set β} [is_add_subgroup s] : add_group s :=
by subtype_instance
attribute [to_additive subtype.add_group] subtype.group

theorem is_subgroup.of_div (s : set α)
  (one_mem : (1:α) ∈ s) (div_mem : ∀{a b:α}, a ∈ s → b ∈ s → a * b⁻¹ ∈ s):
  is_subgroup s :=
have inv_mem : ∀a, a ∈ s → a⁻¹ ∈ s, from
  assume a ha,
  have 1 * a⁻¹ ∈ s, from div_mem one_mem ha,
  by simpa,
{ inv_mem := inv_mem,
  mul_mem := assume a b ha hb,
    have a * b⁻¹⁻¹ ∈ s, from div_mem ha (inv_mem b hb),
    by simpa,
  one_mem := one_mem }

theorem is_add_subgroup.of_sub (s : set β)
  (zero_mem : (0:β) ∈ s) (sub_mem : ∀{a b:β}, a ∈ s → b ∈ s → a - b ∈ s):
  is_add_subgroup s :=
multiplicative.is_subgroup_iff.1 $
@is_subgroup.of_div (multiplicative β) _ _ zero_mem @sub_mem

def gpowers (x : α) : set α := {y | ∃i:ℤ, x^i = y}
def gmultiples (x : β) : set β := {y | ∃i:ℤ, gsmul i x = y}
attribute [to_additive gmultiples] gpowers

instance gpowers.is_subgroup (x : α) : is_subgroup (gpowers x) :=
{ one_mem := ⟨(0:ℤ), by simp⟩,
  mul_mem := assume x₁ x₂ ⟨i₁, h₁⟩ ⟨i₂, h₂⟩, ⟨i₁ + i₂, by simp [gpow_add, *]⟩,
  inv_mem := assume x₀ ⟨i, h⟩, ⟨-i, by simp [h.symm]⟩ }

instance gmultiples.is_add_subgroup (x : β) : is_add_subgroup (gmultiples x) :=
multiplicative.is_subgroup_iff.1 $ gpowers.is_subgroup _
attribute [to_additive gmultiples.is_add_subgroup] gpowers.is_subgroup

lemma is_subgroup.gpow_mem {a : α} {s : set α} [is_subgroup s] (h : a ∈ s) : ∀{i:ℤ}, a ^ i ∈ s
| (n : ℕ) := is_submonoid.pow_mem h
| -[1+ n] := is_subgroup.inv_mem (is_submonoid.pow_mem h)

lemma is_add_subgroup.gsmul_mem {a : β} {s : set β} [is_add_subgroup s] : a ∈ s → ∀{i:ℤ}, gsmul i a ∈ s :=
@is_subgroup.gpow_mem (multiplicative β) _ _ _ _

lemma mem_gpowers {a : α} : a ∈ gpowers a := ⟨1, by simp⟩
lemma mem_gmultiples {a : β} : a ∈ gmultiples a := ⟨1, by simp⟩
attribute [to_additive mem_gmultiples] mem_gpowers

end group

namespace is_subgroup
open is_submonoid
variables [group α] (s : set α) [is_subgroup s]

@[to_additive is_add_subgroup.neg_mem_iff]
lemma inv_mem_iff : a⁻¹ ∈ s ↔ a ∈ s :=
⟨λ h, by simpa using inv_mem h, inv_mem⟩

@[to_additive is_add_subgroup.add_mem_cancel_left]
lemma mul_mem_cancel_left (h : a ∈ s) : b * a ∈ s ↔ b ∈ s :=
⟨λ hba, by simpa using mul_mem hba (inv_mem h), λ hb, mul_mem hb h⟩

@[to_additive is_add_subgroup.add_mem_cancel_right]
lemma mul_mem_cancel_right (h : a ∈ s) : a * b ∈ s ↔ b ∈ s :=
⟨λ hab, by simpa using mul_mem (inv_mem h) hab, mul_mem h⟩

end is_subgroup

namespace group
open is_submonoid is_subgroup

variables [group α] {s : set α}

inductive in_closure (s : set α) : α → Prop
| basic {a : α} : a ∈ s → in_closure a
| one : in_closure 1
| inv {a : α} : in_closure a → in_closure a⁻¹
| mul {a b : α} : in_closure a → in_closure b → in_closure (a * b)

/-- `group.closure s` is the subgroup closed over `s`, i.e. the smallest subgroup containg s. -/
def closure (s : set α) : set α := {a | in_closure s a }

lemma mem_closure {a : α} : a ∈ s → a ∈ closure s := in_closure.basic

instance closure.is_subgroup (s : set α) : is_subgroup (closure s) :=
{ one_mem := in_closure.one s, mul_mem := assume a b, in_closure.mul, inv_mem := assume a, in_closure.inv }

theorem subset_closure {s : set α} : s ⊆ closure s := λ a, mem_closure

theorem closure_subset {s t : set α} [is_subgroup t] (h : s ⊆ t) : closure s ⊆ t :=
assume a ha, by induction ha; simp [h _, *, one_mem, mul_mem, inv_mem_iff]

theorem gpowers_eq_closure {a : α} : gpowers a = closure {a} :=
subset.antisymm
  (assume x h, match x, h with _, ⟨i, rfl⟩ := gpow_mem (mem_closure $ by simp) end)
  (closure_subset $ by  simp [mem_gpowers])

end group

namespace add_group
open is_add_submonoid is_add_subgroup

variables [add_group α] {s : set α}

/-- `add_group.closure s` is the additive subgroup closed over `s`, i.e. the smallest subgroup containg s. -/
def closure (s : set α) : set α := @group.closure (multiplicative α) _ s
attribute [to_additive add_group.closure] group.closure

lemma mem_closure {a : α} : a ∈ s → a ∈ closure s := group.mem_closure
attribute [to_additive add_group.mem_closure] group.mem_closure

instance closure.is_add_subgroup (s : set α) : is_add_subgroup (closure s) :=
multiplicative.is_subgroup_iff.1 $ group.closure.is_subgroup _
attribute [to_additive add_group.closure.is_add_subgroup] group.closure.is_subgroup

attribute [to_additive add_group.subset_closure] group.subset_closure

theorem closure_subset {s t : set α} [is_add_subgroup t] : s ⊆ t → closure s ⊆ t :=
group.closure_subset
attribute [to_additive add_group.closure_subset] group.closure_subset

theorem gmultiples_eq_closure {a : α} : gmultiples a = closure {a} :=
group.gpowers_eq_closure
attribute [to_additive add_group.gmultiples_eq_closure] group.gpowers_eq_closure

end add_group

class normal_subgroup [group α] (s : set α) extends is_subgroup s : Prop :=
(normal : ∀ n ∈ s, ∀ g : α, g * n * g⁻¹ ∈ s)
class normal_add_subgroup [add_group α] (s : set α) extends is_add_subgroup s : Prop :=
(normal : ∀ n ∈ s, ∀ g : α, g + n - g ∈ s)
attribute [to_additive normal_add_subgroup] normal_subgroup
attribute [to_additive normal_add_subgroup.to_is_add_subgroup] normal_subgroup.to_is_subgroup
attribute [to_additive normal_add_subgroup.normal] normal_subgroup.normal
attribute [to_additive normal_add_subgroup.mk] normal_subgroup.mk

@[to_additive normal_add_subgroup_of_add_comm_group]
lemma normal_subgroup_of_comm_group [comm_group α] (s : set α) [hs : is_subgroup s] :
  normal_subgroup s :=
{ normal := λ n hn g, by rwa [mul_right_comm, mul_right_inv, one_mul],
  ..hs }

instance additive.normal_add_subgroup [group α]
  (s : set α) [normal_subgroup s] : @normal_add_subgroup (additive α) _ s :=
⟨@normal_subgroup.normal _ _ _ _⟩

theorem additive.normal_add_subgroup_iff [group α]
  {s : set α} : @normal_add_subgroup (additive α) _ s ↔ normal_subgroup s :=
⟨by rintro ⟨h₁, h₂⟩; exact
    @normal_subgroup.mk α _ _ (additive.is_add_subgroup_iff.1 h₁) @h₂,
  λ h, by resetI; apply_instance⟩

instance multiplicative.normal_subgroup [add_group α]
  (s : set α) [normal_add_subgroup s] : @normal_subgroup (multiplicative α) _ s :=
⟨@normal_add_subgroup.normal _ _ _ _⟩

theorem multiplicative.normal_subgroup_iff [add_group α]
  {s : set α} : @normal_subgroup (multiplicative α) _ s ↔ normal_add_subgroup s :=
⟨by rintro ⟨h₁, h₂⟩; exact
    @normal_add_subgroup.mk α _ _ (multiplicative.is_subgroup_iff.1 h₁) @h₂,
  λ h, by resetI; apply_instance⟩

namespace is_subgroup
variable [group α]

-- Normal subgroup properties
lemma mem_norm_comm {s : set α} [normal_subgroup s] {a b : α} (hab : a * b ∈ s) : b * a ∈ s :=
have h : a⁻¹ * (a * b) * a⁻¹⁻¹ ∈ s, from normal_subgroup.normal (a * b) hab a⁻¹,
by simp at h; exact h

lemma mem_norm_comm_iff {s : set α} [normal_subgroup s] {a b : α} : a * b ∈ s ↔ b * a ∈ s :=
⟨mem_norm_comm, mem_norm_comm⟩

/-- The trivial subgroup -/
def trivial (α : Type*) [group α] : set α := {1}

@[simp] lemma mem_trivial [group α] {g : α} : g ∈ trivial α ↔ g = 1 :=
mem_singleton_iff

instance trivial_normal : normal_subgroup (trivial α) :=
by refine {..}; simp [trivial] {contextual := tt}

lemma trivial_eq_closure : trivial α = group.closure ∅ :=
subset.antisymm
  (by simp [set.subset_def, is_submonoid.one_mem])
  (group.closure_subset $ by simp)

instance univ_subgroup : normal_subgroup (@univ α) :=
by refine {..}; simp

def center (α : Type*) [group α] : set α := {z | ∀ g, g * z = z * g}

lemma mem_center {a : α} : a ∈ center α ↔ ∀g, g * a = a * g := iff.rfl

instance center_normal : normal_subgroup (center α) :=
{ one_mem := by simp [center],
  mul_mem := assume a b ha hb g,
    by rw [←mul_assoc, mem_center.2 ha g, mul_assoc, mem_center.2 hb g, ←mul_assoc],
  inv_mem := assume a ha g,
    calc
      g * a⁻¹ = a⁻¹ * (g * a) * a⁻¹ : by simp [ha g]
      ...     = a⁻¹ * g             : by rw [←mul_assoc, mul_assoc]; simp,
  normal := assume n ha g h,
    calc
      h * (g * n * g⁻¹) = h * n           : by simp [ha g, mul_assoc]
      ...               = g * g⁻¹ * n * h : by rw ha h; simp
      ...               = g * n * g⁻¹ * h : by rw [mul_assoc g, ha g⁻¹, ←mul_assoc] }

end is_subgroup

namespace is_add_subgroup
variable [add_group α]

attribute [to_additive is_add_subgroup.mem_norm_comm] is_subgroup.mem_norm_comm
attribute [to_additive is_add_subgroup.mem_norm_comm_iff] is_subgroup.mem_norm_comm_iff

/-- The trivial subgroup -/
def trivial (α : Type*) [add_group α] : set α := {0}
attribute [to_additive is_add_subgroup.trivial] is_subgroup.trivial

attribute [to_additive is_add_subgroup.mem_trivial] is_subgroup.mem_trivial

instance trivial_normal : normal_add_subgroup (trivial α) :=
multiplicative.normal_subgroup_iff.1 is_subgroup.trivial_normal
attribute [to_additive is_add_subgroup.trivial_normal] is_subgroup.trivial_normal

attribute [to_additive is_add_subgroup.trivial_eq_closure] is_subgroup.trivial_eq_closure

instance univ_add_subgroup : normal_add_subgroup (@univ α) :=
multiplicative.normal_subgroup_iff.1 is_subgroup.univ_subgroup
attribute [to_additive is_add_subgroup.univ_add_subgroup] is_subgroup.univ_subgroup

def center (α : Type*) [add_group α] : set α := {z | ∀ g, g + z = z + g}
attribute [to_additive is_add_subgroup.center] is_subgroup.center

attribute [to_additive is_add_subgroup.mem_center] is_subgroup.mem_center

instance center_normal : normal_add_subgroup (center α) :=
multiplicative.normal_subgroup_iff.1 is_subgroup.center_normal

end is_add_subgroup

-- Homomorphism subgroups
namespace is_group_hom
open is_submonoid is_subgroup
variables [group α] [group β]

@[to_additive is_add_group_hom.ker]
def ker (f : α → β) [is_group_hom f] : set α := preimage f (trivial β)
attribute [to_additive is_add_group_hom.ker.equations._eqn_1] ker.equations._eqn_1

@[to_additive is_add_group_hom.mem_ker]
lemma mem_ker (f : α → β) [is_group_hom f] {x : α} : x ∈ ker f ↔ f x = 1 :=
mem_trivial

@[to_additive is_add_group_hom.zero_ker_neg]
lemma one_ker_inv (f : α → β) [is_group_hom f] {a b : α} (h : f (a * b⁻¹) = 1) : f a = f b :=
begin
  rw [mul f, inv f] at h,
  rw [←inv_inv (f b), eq_inv_of_mul_eq_one h]
end

@[to_additive is_add_group_hom.neg_ker_zero]
lemma inv_ker_one (f : α → β) [is_group_hom f] {a b : α} (h : f a = f b) : f (a * b⁻¹) = 1 :=
have f a * (f b)⁻¹ = 1, by rw [h, mul_right_inv],
by rwa [←inv f, ←mul f] at this

@[to_additive is_add_group_hom.zero_iff_ker_neg]
lemma one_iff_ker_inv (f : α → β) [is_group_hom f] (a b : α) : f a = f b ↔ f (a * b⁻¹) = 1 :=
⟨inv_ker_one f, one_ker_inv f⟩

@[to_additive is_add_group_hom.neg_iff_ker]
lemma inv_iff_ker (f : α → β) [w : is_group_hom f] (a b : α) : f a = f b ↔ a * b⁻¹ ∈ ker f :=
by rw [mem_ker]; exact one_iff_ker_inv _ _ _

instance image_subgroup (f : α → β) [is_group_hom f] (s : set α) [is_subgroup s] :
  is_subgroup (f '' s) :=
{ mul_mem := assume a₁ a₂ ⟨b₁, hb₁, eq₁⟩ ⟨b₂, hb₂, eq₂⟩,
             ⟨b₁ * b₂, mul_mem hb₁ hb₂, by simp [eq₁, eq₂, mul f]⟩,
  one_mem := ⟨1, one_mem s, one f⟩,
  inv_mem := assume a ⟨b, hb, eq⟩, ⟨b⁻¹, inv_mem hb, by rw inv f; simp *⟩ }
attribute [to_additive is_add_group_hom.image_add_subgroup._match_1] is_group_hom.image_subgroup._match_1
attribute [to_additive is_add_group_hom.image_add_subgroup._match_2] is_group_hom.image_subgroup._match_2
attribute [to_additive is_add_group_hom.image_add_subgroup._match_3] is_group_hom.image_subgroup._match_3
attribute [to_additive is_add_group_hom.image_add_subgroup] is_group_hom.image_subgroup
attribute [to_additive is_add_group_hom.image_add_subgroup._match_1.equations._eqn_1] is_group_hom.image_subgroup._match_1.equations._eqn_1
attribute [to_additive is_add_group_hom.image_add_subgroup._match_2.equations._eqn_1] is_group_hom.image_subgroup._match_2.equations._eqn_1
attribute [to_additive is_add_group_hom.image_add_subgroup._match_3.equations._eqn_1] is_group_hom.image_subgroup._match_3.equations._eqn_1
attribute [to_additive is_add_group_hom.image_add_subgroup.equations._eqn_1] is_group_hom.image_subgroup.equations._eqn_1

instance range_subgroup (f : α → β) [is_group_hom f] : is_subgroup (set.range f) :=
@set.image_univ _ _ f ▸ is_group_hom.image_subgroup f set.univ
attribute [to_additive is_add_group_hom.range_add_subgroup] is_group_hom.range_subgroup
attribute [to_additive is_add_group_hom.range_add_subgroup.equations._eqn_1] is_group_hom.range_subgroup.equations._eqn_1

local attribute [simp] one_mem inv_mem mul_mem normal_subgroup.normal

instance preimage (f : α → β) [is_group_hom f] (s : set β) [is_subgroup s] :
  is_subgroup (f ⁻¹' s) :=
by refine {..}; simp [mul f, one f, inv f, @inv_mem β _ s] {contextual:=tt}
attribute [to_additive is_add_group_hom.preimage] is_group_hom.preimage
attribute [to_additive is_add_group_hom.preimage.equations._eqn_1] is_group_hom.preimage.equations._eqn_1

instance preimage_normal (f : α → β) [is_group_hom f] (s : set β) [normal_subgroup s] :
  normal_subgroup (f ⁻¹' s) :=
⟨by simp [mul f, inv f] {contextual:=tt}⟩
attribute [to_additive is_add_group_hom.preimage_normal] is_group_hom.preimage_normal
attribute [to_additive is_add_group_hom.preimage_normal.equations._eqn_1] is_group_hom.preimage_normal.equations._eqn_1

instance normal_subgroup_ker (f : α → β) [is_group_hom f] : normal_subgroup (ker f) :=
is_group_hom.preimage_normal f (trivial β)
attribute [to_additive is_add_group_hom.normal_subgroup_ker] is_group_hom.normal_subgroup_ker
attribute [to_additive is_add_group_hom.normal_subgroup_ker.equations._eqn_1] is_group_hom.normal_subgroup_ker.equations._eqn_1

lemma inj_of_trivial_ker (f : α → β) [is_group_hom f] (h : ker f = trivial α) :
  function.injective f :=
begin
  intros a₁ a₂ hfa,
  simp [ext_iff, ker, is_subgroup.trivial] at h,
  have ha : a₁ * a₂⁻¹ = 1, by rw ←h; exact inv_ker_one f hfa,
  rw [eq_inv_of_mul_eq_one ha, inv_inv a₂]
end

lemma trivial_ker_of_inj (f : α → β) [is_group_hom f] (h : function.injective f) :
  ker f = trivial α :=
set.ext $ assume x, iff.intro
  (assume hx,
    suffices f x = f 1, by simpa using h this,
    by simp [one f]; rwa [mem_ker] at hx)
  (by simp [mem_ker, is_group_hom.one f] {contextual := tt})

lemma inj_iff_trivial_ker (f : α → β) [is_group_hom f] :
  function.injective f ↔ ker f = trivial α :=
⟨trivial_ker_of_inj f, inj_of_trivial_ker f⟩

end is_group_hom


/-
Copyright (c) 2022 Moritz Doll. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Moritz Doll
-/

import analysis.calculus.iterated_deriv
import analysis.calculus.mean_value
import data.polynomial.basic
import data.polynomial.module

/-!
# Taylor's theorem

This file defines the Taylor polynomial of a real function `f : ℝ → E`,
where `E` is a normed vector space over `ℝ` and proves Taylor's theorem,
which states that if `f` is sufficiently smooth, then
`f` can be approximated by the Taylor polynomial up to an explicit error term.

## Main definitions

* `taylor_coeff_within`: the Taylor coefficient using `deriv_within`
* `taylor_within`: the Taylor polynomial using `deriv_within`

## Main statements

* `taylor_mean_remainder`: Taylor's theorem with the general form of the remainder term
* `taylor_mean_remainder_lagrange`: Taylor's theorem with the Lagrange remainder
* `taylor_mean_remainder_cauchy`: Taylor's theorem with the Cauchy remainder
* `exists_taylor_mean_remainder_bound`: Taylor's theorem for vector valued functions with a
polynomial bound on the remainder

## TODO

* the Peano form of the remainder
* the integral form of the remainder
* Generalization to higher dimensions

## Tags

Taylor polynomial, Taylor's theorem
-/

open_locale big_operators interval topology nat
open set

variables {𝕜 E F : Type*}
variables [normed_add_comm_group E] [normed_space ℝ E]

/-- The `k`th coefficient of the Taylor polynomial. -/
noncomputable
def taylor_coeff_within (f : ℝ → E) (k : ℕ) (s : set ℝ) (x₀ : ℝ) : E :=
(k! : ℝ)⁻¹ • (iterated_deriv_within k f s x₀)

/-- The Taylor polynomial with derivatives inside of a set `s`.

The Taylor polynomial is given by
$$∑_{k=0}^n \frac{(x - x₀)^k}{k!} f^{(k)}(x₀),$$
where $f^{(k)}(x₀)$ denotes the iterated derivative in the set `s`. -/
noncomputable
def taylor_within (f : ℝ → E) (n : ℕ) (s : set ℝ) (x₀ : ℝ) : polynomial_module ℝ E :=
(finset.range (n+1)).sum (λ k,
  polynomial_module.comp (polynomial.X - polynomial.C x₀)
  (polynomial_module.single ℝ k (taylor_coeff_within f k s x₀)))

/-- The Taylor polynomial with derivatives inside of a set `s` considered as a function `ℝ → E`-/
noncomputable
def taylor_within_eval (f : ℝ → E) (n : ℕ) (s : set ℝ) (x₀ x : ℝ) : E :=
polynomial_module.eval x (taylor_within f n s x₀)

lemma taylor_within_succ (f : ℝ → E) (n : ℕ) (s : set ℝ) (x₀ : ℝ) :
  taylor_within f (n+1) s x₀ = taylor_within f n s x₀
  + polynomial_module.comp (polynomial.X - polynomial.C x₀)
  (polynomial_module.single ℝ (n+1) (taylor_coeff_within f (n+1) s x₀)) :=
begin
  dunfold taylor_within,
  rw finset.sum_range_succ,
end

@[simp] lemma taylor_within_eval_succ (f : ℝ → E) (n : ℕ) (s : set ℝ) (x₀ x : ℝ) :
  taylor_within_eval f (n+1) s x₀ x = taylor_within_eval f n s x₀ x
  + (((n + 1 : ℝ) * n!)⁻¹ * (x - x₀)^(n+1)) • iterated_deriv_within (n + 1) f s x₀ :=
begin
  simp_rw [taylor_within_eval, taylor_within_succ, linear_map.map_add, polynomial_module.comp_eval],
  congr,
  simp only [polynomial.eval_sub, polynomial.eval_X, polynomial.eval_C,
    polynomial_module.eval_single, mul_inv_rev],
  dunfold taylor_coeff_within,
  rw [←mul_smul, mul_comm, nat.factorial_succ, nat.cast_mul, nat.cast_add, nat.cast_one,
    mul_inv_rev],
end

/-- The Taylor polynomial of order zero evaluates to `f x`. -/
@[simp] lemma taylor_within_zero_eval (f : ℝ → E) (s : set ℝ) (x₀ x : ℝ) :
  taylor_within_eval f 0 s x₀ x = f x₀ :=
begin
  dunfold taylor_within_eval,
  dunfold taylor_within,
  dunfold taylor_coeff_within,
  simp,
end

/-- Evaluating the Taylor polynomial at `x = x₀` yields `f x`. -/
@[simp] lemma taylor_within_eval_self (f : ℝ → E) (n : ℕ) (s : set ℝ) (x₀ : ℝ) :
  taylor_within_eval f n s x₀ x₀ = f x₀ :=
begin
  induction n with k hk,
  { exact taylor_within_zero_eval _ _ _ _},
  simp [hk]
end

lemma taylor_within_apply (f : ℝ → E) (n : ℕ) (s : set ℝ) (x₀ x : ℝ) :
  taylor_within_eval f n s x₀ x = ∑ k in finset.range (n+1),
    ((k! : ℝ)⁻¹ * (x - x₀)^k) • iterated_deriv_within k f s x₀ :=
begin
  induction n with k hk,
  { simp },
  rw [taylor_within_eval_succ, finset.sum_range_succ, hk],
  simp,
end

/-- If `f` is `n` times continuous differentiable on a set `s`, then the Taylor polynomial
  `taylor_within_eval f n s x₀ x` is continuous in `x₀`. -/
lemma continuous_on_taylor_within_eval {f : ℝ → E} {x : ℝ} {n : ℕ} {s : set ℝ}
  (hs : unique_diff_on ℝ s) (hf : cont_diff_on ℝ n f s) :
  continuous_on (λ t, taylor_within_eval f n s t x) s :=
begin
  simp_rw taylor_within_apply,
  refine continuous_on_finset_sum (finset.range (n+1)) (λ i hi, _),
  refine (continuous_on_const.mul ((continuous_on_const.sub continuous_on_id).pow _)).smul _,
  rw cont_diff_on_iff_continuous_on_differentiable_on_deriv hs at hf,
  cases hf,
  specialize hf_left i,
  simp only [finset.mem_range] at hi,
  refine (hf_left _),
  simp only [with_top.coe_le_coe],
  exact nat.lt_succ_iff.mp hi,
end

/-- Helper lemma for calculating the derivative of the monomial that appears in Taylor expansions.-/
lemma monomial_has_deriv_aux (t x : ℝ) (n : ℕ) :
  has_deriv_at (λ y, (x - y)^(n+1)) (-(n+1) * (x - t)^n) t :=
begin
  simp_rw sub_eq_neg_add,
  rw [←neg_one_mul, mul_comm (-1 : ℝ), mul_assoc, mul_comm (-1 : ℝ), ←mul_assoc],
  convert @has_deriv_at.pow _ _ _ _ _ (n+1) ((has_deriv_at_id t).neg.add_const x),
  simp only [nat.cast_add, nat.cast_one],
end

lemma has_deriv_within_at_taylor_coeff_within {f : ℝ → E} {x y : ℝ} {k : ℕ} {s s' : set ℝ}
  (hs'_unique : unique_diff_within_at ℝ s' y)
  (hs' : s' ∈ 𝓝[s] y) (hy : y ∈ s') (h : s' ⊆ s)
  (hf' : differentiable_on ℝ (iterated_deriv_within (k+1) f s) s') :
  has_deriv_within_at (λ t,
    (((k+1 : ℝ) * k!)⁻¹ * (x - t)^(k+1)) • iterated_deriv_within (k+1) f s t)
    ((((k+1 : ℝ) * k!)⁻¹ * (x - y)^(k+1)) • iterated_deriv_within (k+2) f s y -
    ((k! : ℝ)⁻¹ * (x - y)^k) • iterated_deriv_within (k+1) f s y) s' y :=
begin
  have hf'' : has_deriv_within_at (λ t, iterated_deriv_within (k+1) f s t)
    (iterated_deriv_within (k+2) f s y) s' y :=
  begin
    convert (hf' y hy).has_deriv_within_at,
    rw iterated_deriv_within_succ (hs'_unique.mono h),
    refine (deriv_within_subset h hs'_unique _).symm,
    exact (hf' y hy).antimono h hs',
  end,
  have : has_deriv_within_at (λ t, (((k+1 : ℝ) * k!)⁻¹ * (x - t)^(k+1)))
    (-((k! : ℝ)⁻¹ * (x - y)^k)) s' y :=
  begin
    -- Commuting the factors:
    have : (-((k! : ℝ)⁻¹ * (x - y)^k)) =
      (((k+1 : ℝ) * k!)⁻¹ * (-(k+1) *(x - y)^k)) :=
    by { field_simp [nat.cast_add_one_ne_zero k, nat.factorial_ne_zero k], ring_nf },
    rw this,
    exact (monomial_has_deriv_aux y x _).has_deriv_within_at.const_mul _,
  end,
  convert this.smul hf'',
  field_simp [nat.cast_add_one_ne_zero k, nat.factorial_ne_zero k],
  rw [neg_div, neg_smul, sub_eq_add_neg],
end

/-- Calculate the derivative of the Taylor polynomial with respect to `x₀`.

Version for arbitrary sets -/
lemma has_deriv_within_at_taylor_within_eval {f : ℝ → E} {x y : ℝ} {n : ℕ} {s s' : set ℝ}
  (hs'_unique : unique_diff_within_at ℝ s' y) (hs_unique : unique_diff_on ℝ s)
  (hs' : s' ∈ 𝓝[s] y) (hy : y ∈ s') (h : s' ⊆ s)
  (hf : cont_diff_on ℝ n f s)
  (hf' : differentiable_on ℝ (iterated_deriv_within n f s) s') :
  has_deriv_within_at (λ t, taylor_within_eval f n s t x)
    (((n! : ℝ)⁻¹ * (x - y)^n) • (iterated_deriv_within (n+1) f s y)) s' y :=
begin
  induction n with k hk,
  { simp only [taylor_within_zero_eval, nat.factorial_zero, nat.cast_one, inv_one, pow_zero,
      mul_one, zero_add, one_smul],
    simp only [iterated_deriv_within_zero] at hf',
    rw iterated_deriv_within_one hs_unique (h hy),
    refine has_deriv_within_at.mono _ h,
    refine differentiable_within_at.has_deriv_within_at _,
    exact (hf' y hy).antimono h hs' },
  simp_rw [nat.add_succ, taylor_within_eval_succ],
  simp only [add_zero, nat.factorial_succ, nat.cast_mul, nat.cast_add, nat.cast_one],
  have hdiff : differentiable_on ℝ (iterated_deriv_within k f s) s' :=
  begin
    have coe_lt_succ : (k : with_top ℕ) < k.succ :=
    by { rw [with_top.coe_lt_coe], exact lt_add_one k },
    refine differentiable_on.mono _ h,
    exact hf.differentiable_on_iterated_deriv_within coe_lt_succ hs_unique,
  end,
  specialize hk (cont_diff_on.of_succ hf) hdiff,
  convert hk.add (has_deriv_within_at_taylor_coeff_within hs'_unique hs' hy h hf'),
  exact (add_sub_cancel'_right _ _).symm,
end

/-- Calculate the derivative of the Taylor polynomial with respect to `x₀`.

Version for open intervals -/
lemma taylor_within_eval_has_deriv_at_Ioo {f : ℝ → E} {a b t : ℝ} (x : ℝ) {n : ℕ}
  (hx : a < b) (ht : t ∈ Ioo a b)
  (hf : cont_diff_on ℝ n f (Icc a b))
  (hf' : differentiable_on ℝ (iterated_deriv_within n f (Icc a b)) (Ioo a b)) :
  has_deriv_at (λ y, taylor_within_eval f n (Icc a b) y x)
    (((n! : ℝ)⁻¹ * (x - t)^n) • (iterated_deriv_within (n+1) f (Icc a b) t)) t :=
begin
  have h_nhds := is_open.mem_nhds is_open_Ioo ht,
  exact (has_deriv_within_at_taylor_within_eval (unique_diff_within_at_Ioo ht)
    (unique_diff_on_Icc hx) (nhds_within_le_nhds h_nhds) ht Ioo_subset_Icc_self hf hf')
    .has_deriv_at h_nhds,
end

/-- Calculate the derivative of the Taylor polynomial with respect to `x₀`.

Version for closed intervals -/
lemma has_deriv_within_taylor_within_eval_at_Icc {f : ℝ → E} {a b t : ℝ} (x : ℝ) {n : ℕ}
  (hx : a < b) (ht : t ∈ Icc a b) (hf : cont_diff_on ℝ n f (Icc a b))
  (hf' : differentiable_on ℝ (iterated_deriv_within n f (Icc a b)) (Icc a b)) :
  has_deriv_within_at (λ y, taylor_within_eval f n (Icc a b) y x)
    (((n! : ℝ)⁻¹ * (x - t)^n) • (iterated_deriv_within (n+1) f (Icc a b) t)) (Icc a b) t :=
has_deriv_within_at_taylor_within_eval (unique_diff_on_Icc hx t ht) (unique_diff_on_Icc hx)
  self_mem_nhds_within ht rfl.subset hf hf'

/-! ### Taylor's theorem with mean value type remainder estimate -/

/-- **Taylor's theorem** with the general mean value form of the remainder.

We assume that `f` is `n+1`-times continuously differentiable in the closed set `Icc x₀ x` and
`n+1`-times differentiable on the open set `Ioo x₀ x`, and `g` is a differentiable function on
`Ioo x₀ x` and continuous on `Icc x₀ x`. Then there exists a `x' ∈ Ioo x₀ x` such that
$$f(x) - (P_n f)(x₀, x) = \frac{(x - x')^n}{n!} \frac{g(x) - g(x₀)}{g' x'},$$
where $P_n f$ denotes the Taylor polynomial of degree $n$. -/
lemma taylor_mean_remainder {f : ℝ → ℝ} {g g' : ℝ → ℝ} {x x₀ : ℝ} {n : ℕ} (hx : x₀ < x)
  (hf : cont_diff_on ℝ n f (Icc x₀ x))
  (hf' : differentiable_on ℝ (iterated_deriv_within n f (Icc x₀ x)) (Ioo x₀ x))
  (gcont : continuous_on g (Icc x₀ x))
  (gdiff : ∀ (x_1 : ℝ), x_1 ∈ Ioo x₀ x → has_deriv_at g (g' x_1) x_1)
  (g'_ne : ∀ (x_1 : ℝ), x_1 ∈ Ioo x₀ x → g' x_1 ≠ 0) :
  ∃ (x' : ℝ) (hx' : x' ∈ Ioo x₀ x), f x - taylor_within_eval f n (Icc x₀ x) x₀ x =
  ((x - x')^n /n! * (g x - g x₀) / g' x') •
    (iterated_deriv_within (n+1) f (Icc x₀ x) x')
  :=
begin
  -- We apply the mean value theorem
  rcases exists_ratio_has_deriv_at_eq_ratio_slope (λ t, taylor_within_eval f n (Icc x₀ x) t x)
    (λ t, ((n! : ℝ)⁻¹ * (x - t)^n) • (iterated_deriv_within (n+1) f (Icc x₀ x) t)) hx
    (continuous_on_taylor_within_eval (unique_diff_on_Icc hx) hf)
    (λ _ hy, taylor_within_eval_has_deriv_at_Ioo x hx hy hf hf')
    g g' gcont gdiff with ⟨y, hy, h⟩,
  use [y, hy],
  -- The rest is simplifications and trivial calculations
  simp only [taylor_within_eval_self] at h,
  rw [mul_comm, ←div_left_inj' (g'_ne y hy), mul_div_cancel _ (g'_ne y hy)] at h,
  rw ←h,
  field_simp [g'_ne y hy, n.factorial_ne_zero],
  ring,
end

/-- **Taylor's theorem** with the Lagrange form of the remainder.

We assume that `f` is `n+1`-times continuously differentiable in the closed set `Icc x₀ x` and
`n+1`-times differentiable on the open set `Ioo x₀ x`. Then there exists a `x' ∈ Ioo x₀ x` such that
$$f(x) - (P_n f)(x₀, x) = \frac{f^{(n+1)}(x') (x - x₀)^{n+1}}{(n+1)!},$$
where $P_n f$ denotes the Taylor polynomial of degree $n$ and $f^{(n+1)}$ is the $n+1$-th iterated
derivative. -/
lemma taylor_mean_remainder_lagrange {f : ℝ → ℝ} {x x₀ : ℝ} {n : ℕ} (hx : x₀ < x)
  (hf : cont_diff_on ℝ n f (Icc x₀ x))
  (hf' : differentiable_on ℝ (iterated_deriv_within n f (Icc x₀ x)) (Ioo x₀ x)) :
  ∃ (x' : ℝ) (hx' : x' ∈ Ioo x₀ x), f x - taylor_within_eval f n (Icc x₀ x) x₀ x =
  (iterated_deriv_within (n+1) f (Icc x₀ x) x') * (x - x₀)^(n+1) /(n+1)! :=
begin
  have gcont : continuous_on (λ (t : ℝ), (x - t) ^ (n + 1)) (Icc x₀ x) :=
  by { refine continuous.continuous_on _, continuity },
  have xy_ne : ∀ (y : ℝ), y ∈ Ioo x₀ x → (x - y)^n ≠ 0 :=
  begin
    intros y hy,
    refine pow_ne_zero _ _,
    rw [mem_Ioo] at hy,
    rw sub_ne_zero,
    exact hy.2.ne.symm,
  end,
  have hg' : ∀ (y : ℝ), y ∈ Ioo x₀ x → -(↑n + 1) * (x - y) ^ n ≠ 0 :=
  λ y hy, mul_ne_zero (neg_ne_zero.mpr (nat.cast_add_one_ne_zero n)) (xy_ne y hy),
  -- We apply the general theorem with g(t) = (x - t)^(n+1)
  rcases taylor_mean_remainder hx hf hf' gcont (λ y _, monomial_has_deriv_aux y x _) hg'
    with ⟨y, hy, h⟩,
  use [y, hy],
  simp only [sub_self, zero_pow', ne.def, nat.succ_ne_zero, not_false_iff, zero_sub, mul_neg] at h,
  rw [h, neg_div, ←div_neg, neg_mul, neg_neg],
  field_simp [n.cast_add_one_ne_zero, n.factorial_ne_zero, xy_ne y hy],
  ring,
end

/-- **Taylor's theorem** with the Cauchy form of the remainder.

We assume that `f` is `n+1`-times continuously differentiable on the closed set `Icc x₀ x` and
`n+1`-times differentiable on the open set `Ioo x₀ x`. Then there exists a `x' ∈ Ioo x₀ x` such that
$$f(x) - (P_n f)(x₀, x) = \frac{f^{(n+1)}(x') (x - x')^n (x-x₀)}{n!},$$
where $P_n f$ denotes the Taylor polynomial of degree $n$ and $f^{(n+1)}$ is the $n+1$-th iterated
derivative. -/
lemma taylor_mean_remainder_cauchy {f : ℝ → ℝ} {x x₀ : ℝ} {n : ℕ} (hx : x₀ < x)
  (hf : cont_diff_on ℝ n f (Icc x₀ x))
  (hf' : differentiable_on ℝ (iterated_deriv_within n f (Icc x₀ x)) (Ioo x₀ x)) :
  ∃ (x' : ℝ) (hx' : x' ∈ Ioo x₀ x), f x - taylor_within_eval f n (Icc x₀ x) x₀ x =
  (iterated_deriv_within (n+1) f (Icc x₀ x) x') * (x - x')^n /n! * (x - x₀) :=
begin
  have gcont : continuous_on id (Icc x₀ x) := continuous.continuous_on (by continuity),
  have gdiff : (∀ (x_1 : ℝ), x_1 ∈ Ioo x₀ x → has_deriv_at id
    ((λ (t : ℝ), (1 : ℝ)) x_1) x_1) := λ _ _, has_deriv_at_id _,
  -- We apply the general theorem with g = id
  rcases taylor_mean_remainder hx hf hf' gcont gdiff (λ _ _, by simp) with ⟨y, hy, h⟩,
  use [y, hy],
  rw h,
  field_simp [n.factorial_ne_zero],
  ring,
end

/-- **Taylor's theorem** with a polynomial bound on the remainder

We assume that `f` is `n+1`-times continuously differentiable on the closed set `Icc a b`.
The difference of `f` and its `n`-th Taylor polynomial can be estimated by
`C * (x - a)^(n+1) / n!` where `C` is a bound for the `n+1`-th iterated derivative of `f`. -/
lemma taylor_mean_remainder_bound {f : ℝ → E} {a b C x : ℝ} {n : ℕ}
  (hab : a ≤ b) (hf : cont_diff_on ℝ (n+1) f (Icc a b)) (hx : x ∈ Icc a b)
  (hC : ∀ y ∈ Icc a b, ‖iterated_deriv_within (n + 1) f (Icc a b) y‖ ≤ C) :
  ‖f x - taylor_within_eval f n (Icc a b) a x‖ ≤ C * (x - a)^(n+1) / n! :=
begin
  rcases eq_or_lt_of_le hab with rfl|h,
  { rw [Icc_self, mem_singleton_iff] at hx,
    simp [hx] },
  -- The nth iterated derivative is differentiable
  have hf' : differentiable_on ℝ (iterated_deriv_within n f (Icc a b)) (Icc a b) :=
  hf.differentiable_on_iterated_deriv_within (with_top.coe_lt_coe.mpr n.lt_succ_self)
    (unique_diff_on_Icc h),
  -- We can uniformly bound the derivative of the Taylor polynomial
  have h' : ∀ (y : ℝ) (hy : y ∈ Ico a x),
    ‖((n! : ℝ)⁻¹ * (x - y) ^ n) • iterated_deriv_within (n + 1) f (Icc a b) y‖
    ≤ (n! : ℝ)⁻¹ * |(x - a)|^n * C,
  { rintro y ⟨hay, hyx⟩,
    rw [norm_smul, real.norm_eq_abs],
    -- Estimate the iterated derivative by `C`
    refine mul_le_mul _ (hC y ⟨hay, hyx.le.trans hx.2⟩) (by positivity) (by positivity),
    -- The rest is a trivial calculation
    rw [abs_mul, abs_pow, abs_inv, nat.abs_cast],
    mono* with [0 ≤ (n! : ℝ)⁻¹],
    any_goals { positivity },
    linarith [hx.1, hyx] },
  -- Apply the mean value theorem for vector valued functions:
  have A : ∀ t ∈ Icc a x, has_deriv_within_at (λ y, taylor_within_eval f n (Icc a b) y x)
    (((↑n!)⁻¹ * (x - t) ^ n) • iterated_deriv_within (n + 1) f (Icc a b) t) (Icc a x) t,
  { assume t ht,
    have I : Icc a x ⊆ Icc a b := Icc_subset_Icc_right hx.2,
    exact (has_deriv_within_taylor_within_eval_at_Icc x h (I ht) hf.of_succ hf').mono I },
  have := norm_image_sub_le_of_norm_deriv_le_segment' A h' x (right_mem_Icc.2 hx.1),
  simp only [taylor_within_eval_self] at this,
  refine this.trans_eq _,
  -- The rest is a trivial calculation
  rw [abs_of_nonneg (sub_nonneg.mpr hx.1)],
  ring_exp,
end

/-- **Taylor's theorem** with a polynomial bound on the remainder

We assume that `f` is `n+1`-times continuously differentiable on the closed set `Icc a b`.
There exists a constant `C` such that for all `x ∈ Icc a b` the difference of `f` and its `n`-th
Taylor polynomial can be estimated by `C * (x - a)^(n+1)`. -/
lemma exists_taylor_mean_remainder_bound {f : ℝ → E} {a b : ℝ} {n : ℕ}
  (hab : a ≤ b) (hf : cont_diff_on ℝ (n+1) f (Icc a b)) :
  ∃ C, ∀ x ∈ Icc a b, ‖f x - taylor_within_eval f n (Icc a b) a x‖ ≤ C * (x - a)^(n+1) :=
begin
  rcases eq_or_lt_of_le hab with rfl|h,
  { refine ⟨0, λ x hx, _⟩,
    have : a = x, by simpa [← le_antisymm_iff] using hx,
    simp [← this] },
  -- We estimate by the supremum of the norm of the iterated derivative
  let g : ℝ → ℝ := λ y, ‖iterated_deriv_within (n + 1) f (Icc a b) y‖,
  use [has_Sup.Sup (g '' Icc a b) / n!],
  intros x hx,
  rw div_mul_eq_mul_div₀,
  refine taylor_mean_remainder_bound hab hf hx (λ y, _),
  exact (hf.continuous_on_iterated_deriv_within rfl.le $ unique_diff_on_Icc h)
    .norm.le_Sup_image_Icc,
end