/-
Copyright (c) 2019 Minchao Wu. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Minchao Wu, Chris Hughes, Mantas Bakšys
-/
import data.list.basic

/-!
# Minimum and maximum of lists

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

## Main definitions

The main definitions are `argmax`, `argmin`, `minimum` and `maximum` for lists.

`argmax f l` returns `some a`, where `a` of `l` that maximises `f a`. If there are `a b` such that
  `f a = f b`, it returns whichever of `a` or `b` comes first in the list.
  `argmax f []` = none`

`minimum l` returns an `with_top α`, the smallest element of `l` for nonempty lists, and `⊤` for
`[]`
-/

namespace list

variables {α β : Type*}

section arg_aux
variables (r : α → α → Prop) [decidable_rel r] {l : list α} {o : option α} {a m : α}

/-- Auxiliary definition for `argmax` and `argmin`. -/
def arg_aux (a : option α) (b : α) : option α :=
option.cases_on a (some b) $ λ c, if r b c then some b else some c

@[simp] lemma foldl_arg_aux_eq_none :
  l.foldl (arg_aux r) o = none ↔ l = [] ∧ o = none :=
list.reverse_rec_on l (by simp) $
  (assume tl hd, by simp [arg_aux];
    cases foldl (arg_aux r) o tl; simp; try {split_ifs}; simp)

private lemma foldl_arg_aux_mem (l) : Π (a m : α),
  m ∈ foldl (arg_aux r) (some a) l → m ∈ a :: l :=
list.reverse_rec_on l (by simp [eq_comm])
  begin
    assume tl hd ih a m,
    simp only [foldl_append, foldl_cons, foldl_nil, arg_aux],
    cases hf : foldl (arg_aux r) (some a) tl,
    { simp {contextual := tt} },
    { dsimp only, split_ifs,
      { simp {contextual := tt} },
      { -- `finish [ih _ _ hf]` closes this goal
        rcases ih _ _ hf with rfl | H,
        { simp only [mem_cons_iff, mem_append, mem_singleton, option.mem_def], tauto },
        { apply λ hm, or.inr (list.mem_append.mpr $ or.inl _),
          exact (option.mem_some_iff.mp hm ▸ H)} } }
  end

@[simp] lemma arg_aux_self (hr₀ : irreflexive r) (a : α) : arg_aux r (some a) a = a :=
if_neg $ hr₀ _

lemma not_of_mem_foldl_arg_aux (hr₀ : irreflexive r) (hr₁ : transitive r) :
  Π {a m : α} {o : option α}, a ∈ l → m ∈ foldl (arg_aux r) o l → ¬ r a m :=
begin
  induction l using list.reverse_rec_on with tl a ih,
  { exact λ _ _ _ h, absurd h $ not_mem_nil _ },
  intros b m o hb ho,
  rw [foldl_append, foldl_cons, foldl_nil, arg_aux] at ho,
  cases hf : foldl (arg_aux r) o tl with c,
  { rw [hf] at ho,
    rw [foldl_arg_aux_eq_none] at hf,
    simp [hf.1, hf.2, *, hr₀ _] at * },
  rw [hf, option.mem_def] at ho,
  dsimp only at ho,
  split_ifs at ho with hac hac; cases mem_append.1 hb with h h; subst ho,
  { exact λ hba, ih h hf (hr₁ hba hac) },
  { simp [*, hr₀ _] at * },
  { exact ih h hf },
  { simp * at * }
end

end arg_aux

section preorder
variables [preorder β] [@decidable_rel β (<)] {f : α → β} {l : list α} {o : option α} {a m : α}

/-- `argmax f l` returns `some a`, where `f a` is maximal among the elements of `l`, in the sense
that there is no `b ∈ l` with `f a < f b`. If `a`, `b` are such that `f a = f b`, it returns
whichever of `a` or `b` comes first in the list. `argmax f []` = none`. -/
def argmax (f : α → β) (l : list α) : option α := l.foldl (arg_aux $ λ b c, f c < f b) none

/-- `argmin f l` returns `some a`, where `f a` is minimal among the elements of `l`, in the sense
that there is no `b ∈ l` with `f b < f a`. If `a`, `b` are such that `f a = f b`, it returns
whichever of `a` or `b` comes first in the list. `argmin f []` = none`. -/
def argmin (f : α → β) (l : list α) := l.foldl (arg_aux $ λ b c, f b < f c) none

@[simp] lemma argmax_nil (f : α → β) : argmax f [] = none := rfl
@[simp] lemma argmin_nil (f : α → β) : argmin f [] = none := rfl

@[simp] lemma argmax_singleton {f : α → β} {a : α} : argmax f [a] = a := rfl
@[simp] lemma argmin_singleton {f : α → β} {a : α} : argmin f [a] = a := rfl

lemma not_lt_of_mem_argmax : a ∈ l → m ∈ argmax f l → ¬ f m < f a :=
not_of_mem_foldl_arg_aux _ (λ _ , lt_irrefl _) $ λ _ _ _, gt_trans

lemma not_lt_of_mem_argmin : a ∈ l → m ∈ argmin f l → ¬ f a < f m :=
not_of_mem_foldl_arg_aux _ (λ _ , lt_irrefl _) $ λ _ _ _, lt_trans

theorem argmax_concat (f : α → β) (a : α) (l : list α) : argmax f (l ++ [a]) =
  option.cases_on (argmax f l) (some a) (λ c, if f c < f a then some a else some c) :=
by rw [argmax, argmax]; simp [arg_aux]

theorem argmin_concat (f : α → β) (a : α) (l : list α) : argmin f (l ++ [a]) =
  option.cases_on (argmin f l) (some a) (λ c, if f a < f c then some a else some c) :=
@argmax_concat _ βᵒᵈ _ _ _ _ _

theorem argmax_mem : Π {l : list α} {m : α}, m ∈ argmax f l → m ∈ l
| [] m       := by simp
| (hd::tl) m := by simpa [argmax, arg_aux] using foldl_arg_aux_mem _ tl hd m

theorem argmin_mem : Π {l : list α} {m : α}, m ∈ argmin f l → m ∈ l := @argmax_mem _ βᵒᵈ _ _ _

@[simp] theorem argmax_eq_none : l.argmax f = none ↔ l = [] := by simp [argmax]
@[simp] theorem argmin_eq_none : l.argmin f = none ↔ l = [] := @argmax_eq_none _ βᵒᵈ _ _ _ _

end preorder

section linear_order
variables [linear_order β] {f : α → β} {l : list α} {o : option α} {a m : α}

theorem le_of_mem_argmax : a ∈ l → m ∈ argmax f l → f a ≤ f m :=
λ ha hm, le_of_not_lt $ not_lt_of_mem_argmax ha hm

theorem le_of_mem_argmin : a ∈ l → m ∈ argmin f l → f m ≤ f a := @le_of_mem_argmax _ βᵒᵈ _ _ _ _ _

theorem argmax_cons (f : α → β) (a : α) (l : list α) : argmax f (a :: l) =
  option.cases_on (argmax f l) (some a) (λ c, if f a < f c then some c else some a) :=
list.reverse_rec_on l rfl $ λ hd tl ih, begin
    rw [← cons_append, argmax_concat, ih, argmax_concat],
    cases h : argmax f hd with m,
    { simp [h] },
    dsimp,
    rw [←apply_ite, ←apply_ite],
    dsimp,
    split_ifs; try { refl },
    { exact absurd (lt_trans ‹f a < f m› ‹_›) ‹_› },
    { cases (‹f a < f tl›.lt_or_lt _).elim ‹_› ‹_› }
  end

theorem argmin_cons (f : α → β) (a : α) (l : list α) : argmin f (a :: l) =
  option.cases_on (argmin f l) (some a) (λ c, if f c < f a then some c else some a) :=
by convert @argmax_cons _ βᵒᵈ _ _ _ _

variables [decidable_eq α]

theorem index_of_argmax : Π {l : list α} {m : α}, m ∈ argmax f l →
  ∀ {a}, a ∈ l → f m ≤ f a → l.index_of m ≤ l.index_of a
| []       m _  _ _  _   := by simp
| (hd::tl) m hm a ha ham := begin
  simp only [index_of_cons, argmax_cons, option.mem_def] at ⊢ hm,
  cases h : argmax f tl,
  { rw h at hm,
    simp * at * },
  rw h at hm,
  dsimp only at hm,
  obtain rfl | ha := ha; split_ifs at hm; subst hm,
  { cases not_le_of_lt ‹_› ‹_› },
  { rw [if_neg, if_neg],
    exact nat.succ_le_succ (index_of_argmax h ha ham),
    { exact ne_of_apply_ne f (lt_of_lt_of_le ‹_› ‹_›).ne' },
    { exact ne_of_apply_ne _ ‹f hd < f val›.ne' } },
  { rw if_pos rfl,
    exact bot_le }
end

theorem index_of_argmin : Π {l : list α} {m : α}, m ∈ argmin f l →
  ∀ {a}, a ∈ l → f a ≤ f m → l.index_of m ≤ l.index_of a :=
@index_of_argmax _ βᵒᵈ _ _ _

theorem mem_argmax_iff :
  m ∈ argmax f l ↔ m ∈ l ∧ (∀ a ∈ l, f a ≤ f m) ∧
    ∀ a ∈ l, f m ≤ f a → l.index_of m ≤ l.index_of a :=
⟨λ hm, ⟨argmax_mem hm, λ a ha, le_of_mem_argmax ha hm, λ _, index_of_argmax hm⟩,
  begin
    rintros ⟨hml, ham, hma⟩,
    cases harg : argmax f l with n,
    { simp * at * },
    { have := le_antisymm (hma n (argmax_mem harg) (le_of_mem_argmax hml harg))
        (index_of_argmax harg hml (ham _ (argmax_mem harg))),
      rw [(index_of_inj hml (argmax_mem harg)).1 this, option.mem_def] }
  end⟩

theorem argmax_eq_some_iff :
  argmax f l = some m ↔ m ∈ l ∧ (∀ a ∈ l, f a ≤ f m) ∧
    ∀ a ∈ l, f m ≤ f a → l.index_of m ≤ l.index_of a := mem_argmax_iff

theorem mem_argmin_iff :
  m ∈ argmin f l ↔ m ∈ l ∧ (∀ a ∈ l, f m ≤ f a) ∧
    ∀ a ∈ l, f a ≤ f m → l.index_of m ≤ l.index_of a :=
@mem_argmax_iff _ βᵒᵈ _ _ _ _ _

theorem argmin_eq_some_iff :
  argmin f l = some m ↔ m ∈ l ∧ (∀ a ∈ l, f m ≤ f a) ∧
    ∀ a ∈ l, f a ≤ f m → l.index_of m ≤ l.index_of a := mem_argmin_iff

end linear_order

section maximum_minimum
section preorder
variables [preorder α] [@decidable_rel α (<)] {l : list α} {a m : α}

/-- `maximum l` returns an `with_bot α`, the largest element of `l` for nonempty lists, and `⊥` for
`[]`  -/
def maximum (l : list α) : with_bot α := argmax id l

/-- `minimum l` returns an `with_top α`, the smallest element of `l` for nonempty lists, and `⊤` for
`[]`  -/
def minimum (l : list α) : with_top α := argmin id l

@[simp] lemma maximum_nil : maximum ([] : list α) = ⊥ := rfl

@[simp] lemma minimum_nil : minimum ([] : list α) = ⊤ := rfl

@[simp] lemma maximum_singleton (a : α) : maximum [a] = a := rfl

@[simp] lemma minimum_singleton (a : α) : minimum [a] = a := rfl

theorem maximum_mem {l : list α} {m : α} : (maximum l : with_top α) = m → m ∈ l := argmax_mem

theorem minimum_mem {l : list α} {m : α} : (minimum l : with_bot α) = m → m ∈ l := argmin_mem

@[simp] theorem maximum_eq_none {l : list α} : l.maximum = none ↔ l = [] := argmax_eq_none

@[simp] theorem minimum_eq_none {l : list α} : l.minimum = none ↔ l = [] := argmin_eq_none

lemma not_lt_maximum_of_mem : a ∈ l → (maximum l : with_bot α) = m → ¬ m < a := not_lt_of_mem_argmax
lemma minimum_not_lt_of_mem : a ∈ l → (minimum l : with_top α) = m → ¬ a < m := not_lt_of_mem_argmin

theorem not_lt_maximum_of_mem' (ha : a ∈ l) : ¬ maximum l < (a : with_bot α) :=
begin
  cases h : l.maximum,
  { simp * at * },
  { simp_rw [with_bot.some_eq_coe, with_bot.coe_lt_coe, not_lt_maximum_of_mem ha h, not_false_iff] }
end

theorem not_lt_minimum_of_mem' (ha : a ∈ l) : ¬ (a : with_top α) < minimum l :=
@not_lt_maximum_of_mem' αᵒᵈ _ _ _ _ ha

end preorder

section linear_order
variables [linear_order α] {l : list α} {a m : α}

theorem maximum_concat (a : α) (l : list α) : maximum (l ++ [a]) = max (maximum l) a :=
begin
  simp only [maximum, argmax_concat, id],
  cases h : argmax id l,
  { exact (max_eq_right bot_le).symm },
  { simp [option.coe_def, max_def_lt], }
end

lemma le_maximum_of_mem' (ha : a ∈ l) : (a : with_bot α) ≤ maximum l :=
le_of_not_lt $ not_lt_maximum_of_mem' ha

lemma le_minimum_of_mem' (ha : a ∈ l) : minimum l ≤ (a : with_top α) :=
@le_maximum_of_mem' αᵒᵈ _ _ _ ha

theorem minimum_concat (a : α) (l : list α) : minimum (l ++ [a]) = min (minimum l) a :=
@maximum_concat αᵒᵈ _ _ _

theorem maximum_cons (a : α) (l : list α) : maximum (a :: l) = max a (maximum l) :=
list.reverse_rec_on l (by simp [@max_eq_left (with_bot α) _ _ _ bot_le])
  (λ tl hd ih, by rw [← cons_append, maximum_concat, ih, maximum_concat, max_assoc])

theorem minimum_cons (a : α) (l : list α) : minimum (a :: l) = min a (minimum l) :=
@maximum_cons αᵒᵈ _ _ _

lemma maximum_eq_coe_iff : maximum l = m ↔ m ∈ l ∧ ∀ a ∈ l, a ≤ m :=
begin
  unfold_coes,
  simp only [maximum, argmax_eq_some_iff, id],
  split,
  { simp only [true_and, forall_true_iff] {contextual := tt} },
  { simp only [true_and, forall_true_iff] {contextual := tt},
    intros h a hal hma,
    rw [le_antisymm hma (h.2 a hal)] }
end

lemma minimum_eq_coe_iff : minimum l = m ↔ m ∈ l ∧ ∀ a ∈ l, m ≤ a :=
@maximum_eq_coe_iff αᵒᵈ _ _ _

end linear_order
end maximum_minimum

section fold
variables [linear_order α]

section order_bot
variables [order_bot α] {l : list α}

@[simp] lemma foldr_max_of_ne_nil (h : l ≠ []) : ↑(l.foldr max ⊥) = l.maximum :=
begin
  induction l with hd tl IH,
  { contradiction },
  { rw [maximum_cons, foldr, with_bot.coe_max],
    by_cases h : tl = [],
    { simp [h] },
    { simp [IH h] } }
end

lemma max_le_of_forall_le (l : list α) (a : α) (h : ∀ x ∈ l, x ≤ a) : l.foldr max ⊥ ≤ a :=
begin
  induction l with y l IH,
  { simp },
  { simpa [h y (mem_cons_self _ _)] using IH (λ x hx, h x $ mem_cons_of_mem _ hx) }
end

lemma le_max_of_le {l : list α} {a x : α} (hx : x ∈ l) (h : a ≤ x) :
  a ≤ l.foldr max ⊥ :=
begin
  induction l with y l IH,
  { exact absurd hx (not_mem_nil _), },
  { obtain rfl | hl := hx,
    simp only [foldr, foldr_cons],
    { exact le_max_of_le_left h, },
    { exact le_max_of_le_right (IH hl) }}
end

end order_bot

section order_top
variables [order_top α] {l : list α}

@[simp] lemma foldr_min_of_ne_nil (h : l ≠ []) : ↑(l.foldr min ⊤) = l.minimum :=
@foldr_max_of_ne_nil αᵒᵈ _ _ _ h

lemma le_min_of_forall_le (l : list α) (a : α) (h : ∀ x ∈ l, a ≤ x) : a ≤ l.foldr min ⊤ :=
@max_le_of_forall_le αᵒᵈ _ _ _ _ h

lemma min_le_of_le (l : list α) (a : α) {x : α} (hx : x ∈ l) (h : x ≤ a) :
  l.foldr min ⊤ ≤ a :=
@le_max_of_le αᵒᵈ _ _ _ _ _ hx h

end order_top
end fold
end list


/-
Copyright (c) 2018 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon, Patrick Massot
-/
import algebra.big_operators.basic
import algebra.ring.pi

/-!
# Big operators for Pi Types

This file contains theorems relevant to big operators in binary and arbitrary product
of monoids and groups
-/

open_locale big_operators

namespace pi

@[to_additive]
lemma list_prod_apply {α : Type*} {β : α → Type*} [Πa, monoid (β a)] (a : α) (l : list (Πa, β a)) :
  l.prod a = (l.map (λf:Πa, β a, f a)).prod :=
(eval_monoid_hom β a).map_list_prod _

@[to_additive]
lemma multiset_prod_apply {α : Type*} {β : α → Type*} [∀a, comm_monoid (β a)] (a : α)
  (s : multiset (Πa, β a)) : s.prod a = (s.map (λf:Πa, β a, f a)).prod :=
(eval_monoid_hom β a).map_multiset_prod _

end pi

@[simp, to_additive]
lemma finset.prod_apply {α : Type*} {β : α → Type*} {γ} [∀a, comm_monoid (β a)] (a : α)
  (s : finset γ) (g : γ → Πa, β a) : (∏ c in s, g c) a = ∏ c in s, g c a :=
(pi.eval_monoid_hom β a).map_prod _ _

/-- An 'unapplied' analogue of `finset.prod_apply`. -/
@[to_additive "An 'unapplied' analogue of `finset.sum_apply`."]
lemma finset.prod_fn {α : Type*} {β : α → Type*} {γ} [∀a, comm_monoid (β a)]
  (s : finset γ) (g : γ → Πa, β a) : (∏ c in s, g c) = (λ a, ∏ c in s, g c a) :=
funext (λ a, finset.prod_apply _ _ _)

@[simp, to_additive]
lemma fintype.prod_apply {α : Type*} {β : α → Type*} {γ : Type*} [fintype γ]
  [∀a, comm_monoid (β a)] (a : α) (g : γ → Πa, β a) : (∏ c, g c) a = ∏ c, g c a :=
finset.prod_apply a finset.univ g

@[to_additive prod_mk_sum]
lemma prod_mk_prod {α β γ : Type*} [comm_monoid α] [comm_monoid β] (s : finset γ)
  (f : γ → α) (g : γ → β) : (∏ x in s, f x, ∏ x in s, g x) = ∏ x in s, (f x, g x) :=
by haveI := classical.dec_eq γ; exact
finset.induction_on s rfl (by simp [prod.ext_iff] {contextual := tt})

section single
variables {I : Type*} [decidable_eq I] {Z : I → Type*}
variables [Π i, add_comm_monoid (Z i)]

-- As we only defined `single` into `add_monoid`, we only prove the `finset.sum` version here.
lemma finset.univ_sum_single [fintype I] (f : Π i, Z i) :
  ∑ i, pi.single i (f i) = f :=
by { ext a, simp }

lemma add_monoid_hom.functions_ext [fintype I] (G : Type*)
  [add_comm_monoid G] (g h : (Π i, Z i) →+ G)
  (w : ∀ (i : I) (x : Z i), g (pi.single i x) = h (pi.single i x)) : g = h :=
begin
  ext k,
  rw [← finset.univ_sum_single k, g.map_sum, h.map_sum],
  simp only [w]
end

/-- This is used as the ext lemma instead of `add_monoid_hom.functions_ext` for reasons explained in
note [partially-applied ext lemmas]. -/
@[ext]
lemma add_monoid_hom.functions_ext' [fintype I] (M : Type*) [add_comm_monoid M]
  (g h : (Π i, Z i) →+ M)
  (H : ∀ i, g.comp (add_monoid_hom.single Z i) = h.comp (add_monoid_hom.single Z i)) :
  g = h :=
have _ := λ i, add_monoid_hom.congr_fun (H i), -- elab without an expected type
g.functions_ext M h this

end single

section ring_hom
open pi
variables {I : Type*} [decidable_eq I] {f : I → Type*}
variables [Π i, semiring (f i)]

@[ext] lemma ring_hom.functions_ext [fintype I] (G : Type*) [semiring G] (g h : (Π i, f i) →+* G)
  (w : ∀ (i : I) (x : f i), g (single i x) = h (single i x)) : g = h :=
ring_hom.coe_add_monoid_hom_injective $
 add_monoid_hom.functions_ext G (g : (Π i, f i) →+ G) h w

end ring_hom

namespace prod

variables {α β γ : Type*} [comm_monoid α] [comm_monoid β] {s : finset γ} {f : γ → α × β}

@[to_additive]
lemma fst_prod : (∏ c in s, f c).1 = ∏ c in s, (f c).1 :=
(monoid_hom.fst α β).map_prod f s

@[to_additive]
lemma snd_prod  : (∏ c in s, f c).2 = ∏ c in s, (f c).2 :=
(monoid_hom.snd α β).map_prod f s

end prod


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

! This file was ported from Lean 3 source module analysis.asymptotics.specific_asymptotics
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.Normed.Order.Basic
import Mathbin.Analysis.Asymptotics.Asymptotics

/-!
# A collection of specific asymptotic results

This file contains specific lemmas about asymptotics which don't have their place in the general
theory developped in `analysis.asymptotics.asymptotics`.
-/

open Filter Asymptotics

open Topology

section NormedField

/-- If `f : 𝕜 → E` is bounded in a punctured neighborhood of `a`, then `f(x) = o((x - a)⁻¹)` as
`x → a`, `x ≠ a`. -/
theorem Filter.IsBoundedUnder.isOCat_sub_self_inv {𝕜 E : Type _} [NormedField 𝕜] [Norm E] {a : 𝕜}
    {f : 𝕜 → E} (h : IsBoundedUnder (· ≤ ·) (𝓝[≠] a) (norm ∘ f)) :
    f =o[𝓝[≠] a] fun x => (x - a)⁻¹ :=
  by
  refine' (h.is_O_const (one_ne_zero' ℝ)).trans_isOCat (is_o_const_left.2 <| Or.inr _)
  simp only [(· ∘ ·), norm_inv]
  exact (tendsto_norm_sub_self_punctured_nhds a).inv_tendsto_zero
#align filter.is_bounded_under.is_o_sub_self_inv Filter.IsBoundedUnder.isOCat_sub_self_inv

end NormedField

section LinearOrderedField

variable {𝕜 : Type _} [LinearOrderedField 𝕜]

theorem pow_div_pow_eventuallyEq_atTop {p q : ℕ} :
    (fun x : 𝕜 => x ^ p / x ^ q) =ᶠ[atTop] fun x => x ^ ((p : ℤ) - q) :=
  by
  apply (eventually_gt_at_top (0 : 𝕜)).mono fun x hx => _
  simp [zpow_sub₀ hx.ne']
#align pow_div_pow_eventually_eq_at_top pow_div_pow_eventuallyEq_atTop

theorem pow_div_pow_eventuallyEq_atBot {p q : ℕ} :
    (fun x : 𝕜 => x ^ p / x ^ q) =ᶠ[atBot] fun x => x ^ ((p : ℤ) - q) :=
  by
  apply (eventually_lt_at_bot (0 : 𝕜)).mono fun x hx => _
  simp [zpow_sub₀ hx.ne]
#align pow_div_pow_eventually_eq_at_bot pow_div_pow_eventuallyEq_atBot

theorem tendsto_zpow_atTop_atTop {n : ℤ} (hn : 0 < n) : Tendsto (fun x : 𝕜 => x ^ n) atTop atTop :=
  by
  lift n to ℕ using hn.le
  simp only [zpow_ofNat]
  exact tendsto_pow_at_top (nat.cast_pos.mp hn).ne'
#align tendsto_zpow_at_top_at_top tendsto_zpow_atTop_atTop

theorem tendsto_pow_div_pow_atTop_atTop {p q : ℕ} (hpq : q < p) :
    Tendsto (fun x : 𝕜 => x ^ p / x ^ q) atTop atTop :=
  by
  rw [tendsto_congr' pow_div_pow_eventuallyEq_atTop]
  apply tendsto_zpow_atTop_atTop
  linarith
#align tendsto_pow_div_pow_at_top_at_top tendsto_pow_div_pow_atTop_atTop

theorem tendsto_pow_div_pow_atTop_zero [TopologicalSpace 𝕜] [OrderTopology 𝕜] {p q : ℕ}
    (hpq : p < q) : Tendsto (fun x : 𝕜 => x ^ p / x ^ q) atTop (𝓝 0) :=
  by
  rw [tendsto_congr' pow_div_pow_eventuallyEq_atTop]
  apply tendsto_zpow_atTop_zero
  linarith
#align tendsto_pow_div_pow_at_top_zero tendsto_pow_div_pow_atTop_zero

end LinearOrderedField

section NormedLinearOrderedField

variable {𝕜 : Type _} [NormedLinearOrderedField 𝕜]

theorem Asymptotics.isOCat_pow_pow_atTop_of_lt [OrderTopology 𝕜] {p q : ℕ} (hpq : p < q) :
    (fun x : 𝕜 => x ^ p) =o[atTop] fun x => x ^ q :=
  by
  refine' (is_o_iff_tendsto' _).mpr (tendsto_pow_div_pow_atTop_zero hpq)
  exact (eventually_gt_at_top 0).mono fun x hx hxq => (pow_ne_zero q hx.ne' hxq).elim
#align asymptotics.is_o_pow_pow_at_top_of_lt Asymptotics.isOCat_pow_pow_atTop_of_lt

theorem Asymptotics.IsO.trans_tendsto_norm_atTop {α : Type _} {u v : α → 𝕜} {l : Filter α}
    (huv : u =O[l] v) (hu : Tendsto (fun x => ‖u x‖) l atTop) : Tendsto (fun x => ‖v x‖) l atTop :=
  by
  rcases huv.exists_pos with ⟨c, hc, hcuv⟩
  rw [is_O_with] at hcuv
  convert tendsto.at_top_div_const hc (tendsto_at_top_mono' l hcuv hu)
  ext x
  rw [mul_div_cancel_left _ hc.ne.symm]
#align asymptotics.is_O.trans_tendsto_norm_at_top Asymptotics.IsO.trans_tendsto_norm_atTop

end NormedLinearOrderedField

section Real

open BigOperators

open Finset

theorem Asymptotics.IsOCat.sum_range {α : Type _} [NormedAddCommGroup α] {f : ℕ → α} {g : ℕ → ℝ}
    (h : f =o[atTop] g) (hg : 0 ≤ g) (h'g : Tendsto (fun n => ∑ i in range n, g i) atTop atTop) :
    (fun n => ∑ i in range n, f i) =o[atTop] fun n => ∑ i in range n, g i :=
  by
  have A : ∀ i, ‖g i‖ = g i := fun i => Real.norm_of_nonneg (hg i)
  have B : ∀ n, ‖∑ i in range n, g i‖ = ∑ i in range n, g i := fun n => by
    rwa [Real.norm_eq_abs, abs_sum_of_nonneg']
  apply is_o_iff.2 fun ε εpos => _
  obtain ⟨N, hN⟩ : ∃ N : ℕ, ∀ b : ℕ, N ≤ b → ‖f b‖ ≤ ε / 2 * g b := by
    simpa only [A, eventually_at_top] using is_o_iff.mp h (half_pos εpos)
  have : (fun n : ℕ => ∑ i in range N, f i) =o[at_top] fun n : ℕ => ∑ i in range n, g i :=
    by
    apply is_o_const_left.2
    exact Or.inr (h'g.congr fun n => (B n).symm)
  filter_upwards [is_o_iff.1 this (half_pos εpos), Ici_mem_at_top N]with n hn Nn
  calc
    ‖∑ i in range n, f i‖ = ‖(∑ i in range N, f i) + ∑ i in Ico N n, f i‖ := by
      rw [sum_range_add_sum_Ico _ Nn]
    _ ≤ ‖∑ i in range N, f i‖ + ‖∑ i in Ico N n, f i‖ := (norm_add_le _ _)
    _ ≤ ‖∑ i in range N, f i‖ + ∑ i in Ico N n, ε / 2 * g i :=
      (add_le_add le_rfl (norm_sum_le_of_le _ fun i hi => hN _ (mem_Ico.1 hi).1))
    _ ≤ ‖∑ i in range N, f i‖ + ∑ i in range n, ε / 2 * g i :=
      by
      refine' add_le_add le_rfl _
      apply sum_le_sum_of_subset_of_nonneg
      · rw [range_eq_Ico]
        exact Ico_subset_Ico (zero_le _) le_rfl
      · intro i hi hident
        exact mul_nonneg (half_pos εpos).le (hg i)
    _ ≤ ε / 2 * ‖∑ i in range n, g i‖ + ε / 2 * ∑ i in range n, g i :=
      by
      rw [← mul_sum]
      exact add_le_add hn (mul_le_mul_of_nonneg_left le_rfl (half_pos εpos).le)
    _ = ε * ‖∑ i in range n, g i‖ := by
      simp [B]
      ring

#align asymptotics.is_o.sum_range Asymptotics.IsOCat.sum_range

theorem Asymptotics.isOCat_sum_range_of_tendsto_zero {α : Type _} [NormedAddCommGroup α] {f : ℕ → α}
    (h : Tendsto f atTop (𝓝 0)) : (fun n => ∑ i in range n, f i) =o[atTop] fun n => (n : ℝ) :=
  by
  have := ((is_o_one_iff ℝ).2 h).sum_range fun i => zero_le_one
  simp only [sum_const, card_range, Nat.smul_one_eq_coe] at this
  exact this tendsto_nat_cast_atTop_atTop
#align asymptotics.is_o_sum_range_of_tendsto_zero Asymptotics.isOCat_sum_range_of_tendsto_zero

/-- The Cesaro average of a converging sequence converges to the same limit. -/
theorem Filter.Tendsto.cesaro_smul {E : Type _} [NormedAddCommGroup E] [NormedSpace ℝ E] {u : ℕ → E}
    {l : E} (h : Tendsto u atTop (𝓝 l)) :
    Tendsto (fun n : ℕ => (n⁻¹ : ℝ) • ∑ i in range n, u i) atTop (𝓝 l) :=
  by
  rw [← tendsto_sub_nhds_zero_iff, ← is_o_one_iff ℝ]
  have := Asymptotics.isOCat_sum_range_of_tendsto_zero (tendsto_sub_nhds_zero_iff.2 h)
  apply ((is_O_refl (fun n : ℕ => (n : ℝ)⁻¹) at_top).smul_isOCat this).congr' _ _
  · filter_upwards [Ici_mem_at_top 1]with n npos
    have nposℝ : (0 : ℝ) < n := Nat.cast_pos.2 npos
    simp only [smul_sub, sum_sub_distrib, sum_const, card_range, sub_right_inj]
    rw [nsmul_eq_smul_cast ℝ, smul_smul, inv_mul_cancel nposℝ.ne', one_smul]
  · filter_upwards [Ici_mem_at_top 1]with n npos
    have nposℝ : (0 : ℝ) < n := Nat.cast_pos.2 npos
    rw [Algebra.id.smul_eq_mul, inv_mul_cancel nposℝ.ne']
#align filter.tendsto.cesaro_smul Filter.Tendsto.cesaro_smul

/-- The Cesaro average of a converging sequence converges to the same limit. -/
theorem Filter.Tendsto.cesaro {u : ℕ → ℝ} {l : ℝ} (h : Tendsto u atTop (𝓝 l)) :
    Tendsto (fun n : ℕ => (n⁻¹ : ℝ) * ∑ i in range n, u i) atTop (𝓝 l) :=
  h.cesaro_smul
#align filter.tendsto.cesaro Filter.Tendsto.cesaro

end Real


import tactic
import ring_theory.ideal.basic
import ring_theory.ideal.operations
import .oka

variables {B: Type} [comm_ring B] (L M : ideal B)

def principal_ideal_set (A : Type) [comm_ring A]: set(ideal A) := {b: ideal A | ∃(a :A), b = ideal.span({a})}

def principal_ideal_set_mem (I : ideal B) : I ∈ (principal_ideal_set B) ↔ ∃(a :B), I = ideal.span({a}) :=
begin
  refl,
end

-- #check ⊤ ∈ principal_ideal_set B

-- #check (⊤ : ideal B)

lemma top_is_principal :
  (⊤ : ideal B) ∈ principal_ideal_set B :=
begin
  rw principal_ideal_set_mem,
  use 1,
  simp,
end

lemma eq_iff (I J : ideal B) : (∀(b : B), b ∈ I ↔ b ∈ J) ↔ I = J :=
begin
  exact set_like.ext_iff.symm,
end

#check ideal.span

-- lemma span_singleton_self (x : B): x ∈ (ideal.span {x}) :=

lemma prod_quot_subset (I J : ideal B) : J • I.colon J ≤ I :=
begin
  rw submodule.smul_le,
  intros r hyp_r n hyp_n,
  rw submodule.mem_colon at hyp_n,
  simp at hyp_n ⊢,
  rw mul_comm,
  apply hyp_n,
  exact hyp_r,
end

lemma ideal_antisymm (I J :ideal B) : I ≤ J ∧ J ≤ I ↔ I = J :=
begin
  exact antisymm_iff,
end

lemma subset (I J : ideal B) : I ≤ J ↔ ∀(a : B), a ∈ I → a ∈ J :=
begin
  exact set_like.le_def,
end

lemma prod_quot_ideal (I J : ideal B) (h_pri : J ∈ principal_ideal_set B) (h_less : I ≤ J) : I = J * (I.colon J) :=
begin
  rw ← eq_iff,
  intro b,
  split,
  {
    intro hyp,
    rw (principal_ideal_set_mem J) at h_pri,
    cases h_pri with x hx,
    rw element_comparison at h_less,
    have hyp_j := h_less b hyp,
    rw hx,
    rw [hx, ideal.mem_span_singleton] at hyp_j,
    unfold has_dvd.dvd at hyp_j,
    cases hyp_j with c,
    rw mul_comm at hyp_j_h,
    rw hyp_j_h at hyp,
    rw hyp_j_h,
    rw mul_comm,
    rw ← ideal.mem_colon_singleton at hyp,
    have trivial_fact : x ∈ ideal.span {x},
    {
      rw ideal.mem_span_singleton,
    },
    have goal := submodule.smul_mem_smul trivial_fact hyp,
    exact goal,
  }, {
    intro hyp,
    rw (principal_ideal_set_mem J) at h_pri,
    cases h_pri with x hx,
    rw hx at hyp,
    rw ideal.mem_span_singleton_mul at hyp,
    rcases hyp with ⟨z, H, hyp⟩,
    rw ideal.mem_colon_singleton at H,
    rw mul_comm at H,
    rw hyp at H,
    exact H,
  }
end

-- lemma prod_computation (I : ideal B) : I * I = I * I :=
-- begin
-- end

lemma ideal_colon_element_leq (I : ideal B) (a : B) : I ≤ (ideal.span(insert a ↑I)) :=
begin
  rw subset,
  intros b hyp,
  apply ideal.subset_span,
  finish,
end

lemma colon_colon (a : B) (I: ideal B) : I.colon (ideal.span(insert a ↑I)) = I.colon (ideal.span{a}) :=
begin
  ext,
  rw ideal.mem_colon_singleton,
  split,
  {
    rw submodule.mem_colon,
    intro hyp,
    specialize hyp a,
    apply hyp,
    apply ideal.subset_span,
    apply set.mem_insert,
  }, {
    intro hyp,
    rw submodule.mem_colon,
    intro p,
    rw ideal.mem_span_insert,
    intro hyp,
    rcases hyp with ⟨l,c,H,rwp⟩,
    rw ideal.span_eq at H,
    rw rwp,
    simp,
    rw ring.left_distrib,
    apply ideal.add_mem,
    {
      rw ← mul_assoc,
      rw mul_comm x,
      rw mul_assoc,
      apply ideal.mul_mem_left,
      exact hyp,
    }, {
      apply ideal.mul_mem_left,
      exact H,
    }
  }
end

lemma principal_oka_condition : (∀ (I : ideal B),
     (∃ (a : B),
        ideal.span (insert a ↑I)∈ principal_ideal_set B ∧ I.colon (ideal.span{a}) ∈ principal_ideal_set B) →
     I ∈ principal_ideal_set B) :=
begin
  intros I hyp,
  cases hyp with a hyp,
  cases hyp with hyp1 hyp2,
  have triv_contains := ideal_colon_element_leq I a,
  rw prod_quot_ideal I (ideal.span(insert a ↑I)) hyp1 triv_contains,
  rw principal_ideal_set_mem at hyp2,
  cases hyp2 with c,
  rw colon_colon,
  rw hyp2_h,
  rw principal_ideal_set_mem at hyp1,
  cases hyp1 with d,
  rw hyp1_h,
  rw ideal.span_singleton_mul_span_singleton,
  rw principal_ideal_set_mem,
  use d * c,
end

def principal_oka_family {A : Type} [comm_ring A]: oka_family A :=
{
  carrier := principal_ideal_set A,
  contains_ring' := top_is_principal,
  oka_condition' := principal_oka_condition,
}

#check principal_oka_family


import set_theory.cardinal.cofinality

universe u

namespace ordinal
open cardinal
open_locale ordinal cardinal

/--
The first uncountable ordinal in type universe `u`.
You can use the notation `ω₁`.
-/
noncomputable def omega_1 : ordinal.{u} := (aleph 1).ord

localized "notation (name := ordinal.omega_1) `ω₁` := ordinal.omega_1" in ordinal

@[simp]
theorem card_omega_1 : card ω₁ = aleph 1 := card_ord _

lemma omega_lt_omega_1 :
  ω < ω₁ :=
begin
  have := (ord_lt_ord.mpr (aleph_0_lt_aleph_one)),
  rw ord_aleph_0 at this,
  exact this
end

lemma is_limit_omega_1 : omega_1.is_limit := ord_is_limit (aleph_0_le_aleph 1)

end ordinal
-- up to this point, only `import set_theory.cardinal.ordinal` is needed.

namespace ordinal
open cardinal
open_locale ordinal cardinal

lemma sup_sequence_lt_omega_1 (o : ℕ → ordinal.{u}) (ho : ∀ n, o n < ω₁):
  sup o < ω₁ :=
begin
  apply sup_lt_ord_lift _ ho,
  simp only [mk_denumerable,lift_aleph_0],
  unfold omega_1,
  rw [cardinal.is_regular_aleph_one.cof_eq],
  exact aleph_0_lt_aleph_one,
end

-- NOTE: the following lemma is now out of the `borel_hierarchy` PR
/--
Denumerably many elements chosen from a nondecreasing `ω₁`-sequence of sets,
all lie in one of the sets.
-/
lemma bound_omega_1_of_increasing_of_sequence {β : Type*} {A : ordinal → set β}
  {hA : ∀ j k (hjk : j ≤ k), A j ⊆ A k} {f : ℕ → β} (hf : ∀ n, ∃ i, i < ω₁ ∧ f n ∈ A i) :
  ∃ i (hi : i < ω₁), ∀ n, f n ∈ A i :=
begin
  choose o ho using hf,
  use sup o,
  split,
  { finish [sup_sequence_lt_omega_1] },
  intro n,
  specialize ho n,
  specialize hA (o n) (sup o) (le_sup o n),
  tauto
end

end ordinal


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Johannes Hölzl, Scott Morrison, Jens Wagemaker, Johan Commelin
-/
import data.polynomial.algebra_map
import data.polynomial.degree.lemmas
import data.polynomial.div

/-!
# Theory of univariate polynomials

This file starts looking like the ring theory of $ R[X] $

-/

noncomputable theory
open_locale classical

open finset

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

section comm_ring
variables [comm_ring R] {p q : polynomial R}

variables [comm_ring S]

lemma nat_degree_pos_of_aeval_root [algebra R S] {p : polynomial R} (hp : p ≠ 0)
  {z : S} (hz : aeval z p = 0) (inj : ∀ (x : R), algebra_map R S x = 0 → x = 0) :
  0 < p.nat_degree :=
nat_degree_pos_of_eval₂_root hp (algebra_map R S) hz inj

lemma degree_pos_of_aeval_root [algebra R S] {p : polynomial R} (hp : p ≠ 0)
  {z : S} (hz : aeval z p = 0) (inj : ∀ (x : R), algebra_map R S x = 0 → x = 0) :
  0 < p.degree :=
nat_degree_pos_iff_degree_pos.mp (nat_degree_pos_of_aeval_root hp hz inj)

lemma aeval_mod_by_monic_eq_self_of_root [algebra R S]
  {p q : polynomial R} (hq : q.monic) {x : S} (hx : aeval x q = 0) :
  aeval x (p %ₘ q) = aeval x p :=
eval₂_mod_by_monic_eq_self_of_root hq hx

lemma mod_by_monic_eq_of_dvd_sub [nontrivial R] (hq : q.monic) {p₁ p₂ : polynomial R}
  (h : q ∣ (p₁ - p₂)) :
  p₁ %ₘ q = p₂ %ₘ q :=
begin
  obtain ⟨f, sub_eq⟩ := h,
  refine (div_mod_by_monic_unique (p₂ /ₘ q + f) _ hq
    ⟨_, degree_mod_by_monic_lt _ hq⟩).2,
  rw [sub_eq_iff_eq_add.mp sub_eq, mul_add, ← add_assoc, mod_by_monic_add_div _ hq, add_comm]
end

lemma add_mod_by_monic [nontrivial R] (hq : q.monic)
  (p₁ p₂ : polynomial R) : (p₁ + p₂) %ₘ q = p₁ %ₘ q + p₂ %ₘ q :=
(div_mod_by_monic_unique (p₁ /ₘ q + p₂ /ₘ q) _ hq
  ⟨by rw [mul_add, add_left_comm, add_assoc, mod_by_monic_add_div _ hq, ← add_assoc,
          add_comm (q * _), mod_by_monic_add_div _ hq],
    (degree_add_le _ _).trans_lt (max_lt (degree_mod_by_monic_lt _ hq)
      (degree_mod_by_monic_lt _ hq))⟩).2

lemma smul_mod_by_monic [nontrivial R] (hq : q.monic)
  (c : R) (p : polynomial R) : (c • p) %ₘ q = c • (p %ₘ q) :=
(div_mod_by_monic_unique (c • (p /ₘ q)) (c • (p %ₘ q)) hq
  ⟨by rw [mul_smul_comm, ← smul_add, mod_by_monic_add_div p hq],
   (degree_smul_le _ _).trans_lt (degree_mod_by_monic_lt _ hq)⟩).2

/--
`polynomial.mod_by_monic_hom (hq : monic (q : polynomial R))` is `_ %ₘ q` as a `R`-linear map.
-/
@[simps]
def mod_by_monic_hom [nontrivial R] (hq : q.monic) :
  polynomial R →ₗ[R] polynomial R :=
{ to_fun := λ p, p %ₘ q,
  map_add' := add_mod_by_monic hq,
  map_smul' := smul_mod_by_monic hq }

end comm_ring

section no_zero_divisors
variables [ring R] [no_zero_divisors R] {p q : polynomial R}

instance : no_zero_divisors (polynomial R) :=
{ eq_zero_or_eq_zero_of_mul_eq_zero := λ a b h, begin
    rw [← leading_coeff_eq_zero, ← leading_coeff_eq_zero],
    refine eq_zero_or_eq_zero_of_mul_eq_zero _,
    rw [← leading_coeff_zero, ← leading_coeff_mul, h],
  end }

lemma nat_degree_mul (hp : p ≠ 0) (hq : q ≠ 0) : nat_degree (p * q) =
  nat_degree p + nat_degree q :=
by rw [← with_bot.coe_eq_coe, ← degree_eq_nat_degree (mul_ne_zero hp hq),
    with_bot.coe_add, ← degree_eq_nat_degree hp,
    ← degree_eq_nat_degree hq, degree_mul]

@[simp] lemma nat_degree_pow (p : polynomial R) (n : ℕ) :
  nat_degree (p ^ n) = n * nat_degree p :=
if hp0 : p = 0
then if hn0 : n = 0 then by simp [hp0, hn0]
  else by rw [hp0, zero_pow (nat.pos_of_ne_zero hn0)]; simp
else nat_degree_pow'
  (by rw [← leading_coeff_pow, ne.def, leading_coeff_eq_zero]; exact pow_ne_zero _ hp0)

lemma degree_le_mul_left (p : polynomial R) (hq : q ≠ 0) : degree p ≤ degree (p * q) :=
if hp : p = 0 then by simp only [hp, zero_mul, le_refl]
else by rw [degree_mul, degree_eq_nat_degree hp,
    degree_eq_nat_degree hq];
  exact with_bot.coe_le_coe.2 (nat.le_add_right _ _)

theorem nat_degree_le_of_dvd {p q : polynomial R} (h1 : p ∣ q) (h2 : q ≠ 0) :
  p.nat_degree ≤ q.nat_degree :=
begin
  rcases h1 with ⟨q, rfl⟩, rw mul_ne_zero_iff at h2,
  rw [nat_degree_mul h2.1 h2.2], exact nat.le_add_right _ _
end

end no_zero_divisors

section no_zero_divisors
variables [comm_ring R] [no_zero_divisors R] {p q : polynomial R}

lemma root_mul : is_root (p * q) a ↔ is_root p a ∨ is_root q a :=
by simp_rw [is_root, eval_mul, mul_eq_zero]

lemma root_or_root_of_root_mul (h : is_root (p * q) a) : is_root p a ∨ is_root q a :=
root_mul.1 h

end no_zero_divisors

section ring
variables [ring R] [is_domain R] {p q : polynomial R}

instance : is_domain (polynomial R) :=
{ ..polynomial.no_zero_divisors,
  ..polynomial.nontrivial, }

lemma nat_trailing_degree_mul (hp : p ≠ 0) (hq : q ≠ 0) :
  (p * q).nat_trailing_degree = p.nat_trailing_degree + q.nat_trailing_degree :=
begin
  simp only [←tsub_eq_of_eq_add_rev (nat_degree_eq_reverse_nat_degree_add_nat_trailing_degree _)],
  rw [reverse_mul_of_domain, nat_degree_mul hp hq, nat_degree_mul (mt reverse_eq_zero.mp hp)
    (mt reverse_eq_zero.mp hq), reverse_nat_degree, reverse_nat_degree, tsub_add_eq_tsub_tsub,
    nat.add_comm, add_tsub_assoc_of_le (nat.sub_le _ _), add_comm,
    add_tsub_assoc_of_le (nat.sub_le _ _)],
end

end ring

section comm_ring
variables [comm_ring R] [is_domain R] {p q : polynomial R}

section roots

open multiset

lemma degree_eq_zero_of_is_unit (h : is_unit p) : degree p = 0 :=
let ⟨q, hq⟩ := is_unit_iff_dvd_one.1 h in
have hp0 : p ≠ 0, from λ hp0, by simpa [hp0] using hq,
have hq0 : q ≠ 0, from λ hp0, by simpa [hp0] using hq,
have nat_degree (1 : polynomial R) = nat_degree (p * q),
  from congr_arg _ hq,
by rw [nat_degree_one, nat_degree_mul hp0 hq0, eq_comm,
    _root_.add_eq_zero_iff, ← with_bot.coe_eq_coe,
    ← degree_eq_nat_degree hp0] at this;
  exact this.1

@[simp] lemma degree_coe_units (u : units (polynomial R)) :
  degree (u : polynomial R) = 0 :=
degree_eq_zero_of_is_unit ⟨u, rfl⟩

theorem prime_X_sub_C (r : R) : prime (X - C r) :=
⟨X_sub_C_ne_zero r, not_is_unit_X_sub_C r,
 λ _ _, by { simp_rw [dvd_iff_is_root, is_root.def, eval_mul, mul_eq_zero], exact id }⟩

theorem prime_X : prime (X : polynomial R) :=
by { convert (prime_X_sub_C (0 : R)), simp }

lemma monic.prime_of_degree_eq_one (hp1 : degree p = 1) (hm : monic p) :
  prime p :=
have p = X - C (- p.coeff 0),
  by simpa [hm.leading_coeff] using eq_X_add_C_of_degree_eq_one hp1,
this.symm ▸ prime_X_sub_C _

theorem irreducible_X_sub_C (r : R) : irreducible (X - C r) :=
(prime_X_sub_C r).irreducible

theorem irreducible_X : irreducible (X : polynomial R) :=
prime.irreducible prime_X

lemma monic.irreducible_of_degree_eq_one (hp1 : degree p = 1) (hm : monic p) :
  irreducible p :=
(hm.prime_of_degree_eq_one hp1).irreducible

theorem eq_of_monic_of_associated (hp : p.monic) (hq : q.monic) (hpq : associated p q) : p = q :=
begin
  obtain ⟨u, hu⟩ := hpq,
  unfold monic at hp hq,
  rw eq_C_of_degree_le_zero (le_of_eq $ degree_coe_units _) at hu,
  rw [← hu, leading_coeff_mul, hp, one_mul, leading_coeff_C] at hq,
  rwa [hq, C_1, mul_one] at hu,
  apply_instance,
end

lemma root_multiplicity_mul {p q : polynomial R} {x : R} (hpq : p * q ≠ 0) :
  root_multiplicity x (p * q) = root_multiplicity x p + root_multiplicity x q :=
begin
  have hp : p ≠ 0 := left_ne_zero_of_mul hpq,
  have hq : q ≠ 0 := right_ne_zero_of_mul hpq,
  rw [root_multiplicity_eq_multiplicity (p * q), dif_neg hpq,
      root_multiplicity_eq_multiplicity p, dif_neg hp,
      root_multiplicity_eq_multiplicity q, dif_neg hq,
      multiplicity.mul' (prime_X_sub_C x)],
end

lemma root_multiplicity_X_sub_C_self {x : R} :
  root_multiplicity x (X - C x) = 1 :=
by rw [root_multiplicity_eq_multiplicity, dif_neg (X_sub_C_ne_zero x),
       multiplicity.get_multiplicity_self]

lemma root_multiplicity_X_sub_C {x y : R} :
  root_multiplicity x (X - C y) = if x = y then 1 else 0 :=
begin
  split_ifs with hxy,
  { rw hxy,
    exact root_multiplicity_X_sub_C_self },
  exact root_multiplicity_eq_zero (mt root_X_sub_C.mp (ne.symm hxy))
end

/-- The multiplicity of `a` as root of `(X - a) ^ n` is `n`. -/
lemma root_multiplicity_X_sub_C_pow (a : R) (n : ℕ) : root_multiplicity a ((X - C a) ^ n) = n :=
begin
  induction n with n hn,
  { refine root_multiplicity_eq_zero _,
    simp only [eval_one, is_root.def, not_false_iff, one_ne_zero, pow_zero] },
  have hzero :=  (ne_zero_of_monic (monic_pow (monic_X_sub_C a) n.succ)),
  rw pow_succ (X - C a) n at hzero ⊢,
  simp only [root_multiplicity_mul hzero, root_multiplicity_X_sub_C_self, hn, nat.one_add]
end

/-- If `(X - a) ^ n` divides a polynomial `p` then the multiplicity of `a` as root of `p` is at
least `n`. -/
lemma root_multiplicity_of_dvd {p : polynomial R} {a : R} {n : ℕ}
  (hzero : p ≠ 0) (h : (X - C a) ^ n ∣ p) : n ≤ root_multiplicity a p :=
begin
  obtain ⟨q, hq⟩ := exists_eq_mul_right_of_dvd h,
  rw hq at hzero,
  simp only [hq, root_multiplicity_mul hzero, root_multiplicity_X_sub_C_pow,
             ge_iff_le, _root_.zero_le, le_add_iff_nonneg_right],
end

/-- The multiplicity of `p + q` is at least the minimum of the multiplicities. -/
lemma root_multiplicity_add {p q : polynomial R} (a : R) (hzero : p + q ≠ 0) :
  min (root_multiplicity a p) (root_multiplicity a q) ≤ root_multiplicity a (p + q) :=
begin
  refine root_multiplicity_of_dvd hzero _,
  have hdivp : (X - C a) ^ root_multiplicity a p ∣ p := pow_root_multiplicity_dvd p a,
  have hdivq : (X - C a) ^ root_multiplicity a q ∣ q := pow_root_multiplicity_dvd q a,
  exact min_pow_dvd_add hdivp hdivq
end

lemma exists_multiset_roots : ∀ {p : polynomial R} (hp : p ≠ 0),
  ∃ s : multiset R, (s.card : with_bot ℕ) ≤ degree p ∧ ∀ a, s.count a = root_multiplicity a p
| p := λ hp, by haveI := classical.prop_decidable (∃ x, is_root p x); exact
if h : ∃ x, is_root p x
then
  let ⟨x, hx⟩ := h in
  have hpd : 0 < degree p := degree_pos_of_root hp hx,
  have hd0 : p /ₘ (X - C x) ≠ 0 :=
    λ h, by rw [← mul_div_by_monic_eq_iff_is_root.2 hx, h, mul_zero] at hp; exact hp rfl,
  have wf : degree (p /ₘ _) < degree p :=
    degree_div_by_monic_lt _ (monic_X_sub_C x) hp
    ((degree_X_sub_C x).symm ▸ dec_trivial),
  let ⟨t, htd, htr⟩ := @exists_multiset_roots (p /ₘ (X - C x)) hd0 in
  have hdeg : degree (X - C x) ≤ degree p := begin
    rw [degree_X_sub_C, degree_eq_nat_degree hp],
    rw degree_eq_nat_degree hp at hpd,
    exact with_bot.coe_le_coe.2 (with_bot.coe_lt_coe.1 hpd)
  end,
  have hdiv0 : p /ₘ (X - C x) ≠ 0 := mt (div_by_monic_eq_zero_iff (monic_X_sub_C x)).1 $
    not_lt.2 hdeg,
  ⟨x ::ₘ t, calc (card (x ::ₘ t) : with_bot ℕ) = t.card + 1 :
      by exact_mod_cast card_cons _ _
    ... ≤ degree p :
      by rw [← degree_add_div_by_monic (monic_X_sub_C x) hdeg,
          degree_X_sub_C, add_comm];
        exact add_le_add (le_refl (1 : with_bot ℕ)) htd,
  begin
    assume a,
    conv_rhs { rw ← mul_div_by_monic_eq_iff_is_root.mpr hx },
    rw [root_multiplicity_mul (mul_ne_zero (X_sub_C_ne_zero x) hdiv0),
        root_multiplicity_X_sub_C, ← htr a],
    split_ifs with ha,
    { rw [ha, count_cons_self, nat.succ_eq_add_one, add_comm] },
    { rw [count_cons_of_ne ha, zero_add] },
  end⟩
else
  ⟨0, (degree_eq_nat_degree hp).symm ▸ with_bot.coe_le_coe.2 (nat.zero_le _),
    by { intro a, rw [count_zero, root_multiplicity_eq_zero (not_exists.mp h a)] }⟩
using_well_founded {dec_tac := tactic.assumption}

/-- `roots p` noncomputably gives a multiset containing all the roots of `p`,
including their multiplicities. -/
noncomputable def roots (p : polynomial R) : multiset R :=
if h : p = 0 then ∅ else classical.some (exists_multiset_roots h)

@[simp] lemma roots_zero : (0 : polynomial R).roots = 0 :=
dif_pos rfl

lemma card_roots (hp0 : p ≠ 0) : ((roots p).card : with_bot ℕ) ≤ degree p :=
begin
  unfold roots,
  rw dif_neg hp0,
  exact (classical.some_spec (exists_multiset_roots hp0)).1
end

lemma card_roots' {p : polynomial R} (hp0 : p ≠ 0) : p.roots.card ≤ nat_degree p :=
with_bot.coe_le_coe.1 (le_trans (card_roots hp0) (le_of_eq $ degree_eq_nat_degree hp0))

lemma card_roots_sub_C {p : polynomial R} {a : R} (hp0 : 0 < degree p) :
  ((p - C a).roots.card : with_bot ℕ) ≤ degree p :=
calc ((p - C a).roots.card : with_bot ℕ) ≤ degree (p - C a) :
  card_roots $ mt sub_eq_zero.1 $ λ h, not_le_of_gt hp0 $ h.symm ▸ degree_C_le
... = degree p : by rw [sub_eq_add_neg, ← C_neg]; exact degree_add_C hp0

lemma card_roots_sub_C' {p : polynomial R} {a : R} (hp0 : 0 < degree p) :
  (p - C a).roots.card ≤ nat_degree p :=
with_bot.coe_le_coe.1 (le_trans (card_roots_sub_C hp0) (le_of_eq $ degree_eq_nat_degree
  (λ h, by simp [*, lt_irrefl] at *)))

@[simp] lemma count_roots (hp : p ≠ 0) : p.roots.count a = root_multiplicity a p :=
by { rw [roots, dif_neg hp], exact (classical.some_spec (exists_multiset_roots hp)).2 a }

@[simp] lemma mem_roots (hp : p ≠ 0) : a ∈ p.roots ↔ is_root p a :=
by rw [← count_pos, count_roots hp, root_multiplicity_pos hp]

lemma eq_zero_of_infinite_is_root
  (p : polynomial R) (h : set.infinite {x | is_root p x}) : p = 0 :=
begin
  by_contradiction hp,
  apply h,
  convert p.roots.to_finset.finite_to_set using 1,
  ext1 r,
  simp only [mem_roots hp, multiset.mem_to_finset, set.mem_set_of_eq, finset.mem_coe]
end

lemma exists_max_root [linear_order R] (p : polynomial R) (hp : p ≠ 0) :
  ∃ x₀, ∀ x, p.is_root x → x ≤ x₀ :=
set.exists_upper_bound_image _ _ $ not_not.mp (mt (eq_zero_of_infinite_is_root p) hp)

lemma exists_min_root [linear_order R] (p : polynomial R) (hp : p ≠ 0) :
  ∃ x₀, ∀ x, p.is_root x → x₀ ≤ x :=
set.exists_lower_bound_image _ _ $ not_not.mp (mt (eq_zero_of_infinite_is_root p) hp)

lemma eq_of_infinite_eval_eq {R : Type*} [comm_ring R] [is_domain R]
  (p q : polynomial R) (h : set.infinite {x | eval x p = eval x q}) : p = q :=
begin
  rw [← sub_eq_zero],
  apply eq_zero_of_infinite_is_root,
  simpa only [is_root, eval_sub, sub_eq_zero]
end

lemma roots_mul {p q : polynomial R} (hpq : p * q ≠ 0) : (p * q).roots = p.roots + q.roots :=
multiset.ext.mpr $ λ r,
  by rw [count_add, count_roots hpq, count_roots (left_ne_zero_of_mul hpq),
         count_roots (right_ne_zero_of_mul hpq), root_multiplicity_mul hpq]

@[simp] lemma mem_roots_sub_C {p : polynomial R} {a x : R} (hp0 : 0 < degree p) :
  x ∈ (p - C a).roots ↔ p.eval x = a :=
(mem_roots (show p - C a ≠ 0, from mt sub_eq_zero.1 $ λ h,
    not_le_of_gt hp0 $ h.symm ▸ degree_C_le)).trans
  (by rw [is_root.def, eval_sub, eval_C, sub_eq_zero])

@[simp] lemma roots_X_sub_C (r : R) : roots (X - C r) = {r} :=
begin
  ext s,
  rw [count_roots (X_sub_C_ne_zero r), root_multiplicity_X_sub_C],
  split_ifs with h,
  { rw [h, count_singleton_self] },
  { rw [singleton_eq_cons, count_cons_of_ne h, count_zero] }
end

@[simp] lemma roots_C (x : R) : (C x).roots = 0 :=
if H : x = 0 then by rw [H, C_0, roots_zero] else multiset.ext.mpr $ λ r,
have h : C x ≠ 0, from λ h, H $ C_inj.1 $ h.symm ▸ C_0.symm,
have not_root : ¬ is_root (C x) r := mt (λ (h : eval r (C x) = 0), trans eval_C.symm h) H,
by rw [count_roots h, count_zero, root_multiplicity_eq_zero not_root]

@[simp] lemma roots_one : (1 : polynomial R).roots = ∅ :=
roots_C 1

lemma roots_list_prod (L : list (polynomial R)) :
  ((0 : polynomial R) ∉ L) → L.prod.roots = (L : multiset (polynomial R)).bind roots :=
list.rec_on L (λ _, roots_one) $ λ hd tl ih H,
begin
  rw [list.mem_cons_iff, not_or_distrib] at H,
  rw [list.prod_cons, roots_mul (mul_ne_zero (ne.symm H.1) $ list.prod_ne_zero H.2),
      ← multiset.cons_coe, multiset.cons_bind, ih H.2]
end

lemma roots_multiset_prod (m : multiset (polynomial R)) :
  (0 : polynomial R) ∉ m → m.prod.roots = m.bind roots :=
by { rcases m with ⟨L⟩, simpa only [coe_prod, quot_mk_to_coe''] using roots_list_prod L }

lemma roots_prod {ι : Type*} (f : ι → polynomial R) (s : finset ι) :
  s.prod f ≠ 0 → (s.prod f).roots = s.val.bind (λ i, roots (f i)) :=
begin
  rcases s with ⟨m, hm⟩,
  simpa [multiset.prod_eq_zero_iff, bind_map] using roots_multiset_prod (m.map f)
end

lemma roots_prod_X_sub_C (s : finset R) :
  (s.prod (λ a, X - C a)).roots = s.val :=
(roots_prod (λ a, X - C a) s (prod_ne_zero_iff.mpr (λ a _, X_sub_C_ne_zero a))).trans
  (by simp_rw [roots_X_sub_C, multiset.bind_singleton, multiset.map_id'])

lemma card_roots_X_pow_sub_C {n : ℕ} (hn : 0 < n) (a : R) :
  (roots ((X : polynomial R) ^ n - C a)).card ≤ n :=
with_bot.coe_le_coe.1 $
calc ((roots ((X : polynomial R) ^ n - C a)).card : with_bot ℕ)
      ≤ degree ((X : polynomial R) ^ n - C a) : card_roots (X_pow_sub_C_ne_zero hn a)
  ... = n : degree_X_pow_sub_C hn a

section nth_roots

/-- `nth_roots n a` noncomputably returns the solutions to `x ^ n = a`-/
def nth_roots (n : ℕ) (a : R) : multiset R :=
roots ((X : polynomial R) ^ n - C a)

@[simp] lemma mem_nth_roots {n : ℕ} (hn : 0 < n) {a x : R} :
  x ∈ nth_roots n a ↔ x ^ n = a :=
by rw [nth_roots, mem_roots (X_pow_sub_C_ne_zero hn a),
  is_root.def, eval_sub, eval_C, eval_pow, eval_X, sub_eq_zero]

@[simp] lemma nth_roots_zero (r : R) : nth_roots 0 r = 0 :=
by simp only [empty_eq_zero, pow_zero, nth_roots, ← C_1, ← C_sub, roots_C]

lemma card_nth_roots (n : ℕ) (a : R) :
  (nth_roots n a).card ≤ n :=
if hn : n = 0
then if h : (X : polynomial R) ^ n - C a = 0
  then by simp only [nat.zero_le, nth_roots, roots, h, dif_pos rfl, empty_eq_zero, card_zero]
  else with_bot.coe_le_coe.1 (le_trans (card_roots h)
   (by { rw [hn, pow_zero, ← C_1, ← ring_hom.map_sub ],
         exact degree_C_le }))
else by rw [← with_bot.coe_le_coe, ← degree_X_pow_sub_C (nat.pos_of_ne_zero hn) a];
  exact card_roots (X_pow_sub_C_ne_zero (nat.pos_of_ne_zero hn) a)

/-- The multiset `nth_roots ↑n (1 : R)` as a finset. -/
def nth_roots_finset (n : ℕ) (R : Type*) [comm_ring R] [is_domain R] : finset R :=
multiset.to_finset (nth_roots n (1 : R))

@[simp] lemma mem_nth_roots_finset {n : ℕ} (h : 0 < n) {x : R} :
  x ∈ nth_roots_finset n R ↔ x ^ (n : ℕ) = 1 :=
by rw [nth_roots_finset, mem_to_finset, mem_nth_roots h]

end nth_roots

lemma coeff_comp_degree_mul_degree (hqd0 : nat_degree q ≠ 0) :
  coeff (p.comp q) (nat_degree p * nat_degree q) =
  leading_coeff p * leading_coeff q ^ nat_degree p :=
if hp0 : p = 0 then by simp [hp0] else
calc coeff (p.comp q) (nat_degree p * nat_degree q)
  = p.sum (λ n a, coeff (C a * q ^ n) (nat_degree p * nat_degree q)) :
    by rw [comp, eval₂, coeff_sum]
... = coeff (C (leading_coeff p) * q ^ nat_degree p) (nat_degree p * nat_degree q) :
  finset.sum_eq_single _
  begin
    assume b hbs hbp,
    have hq0 : q ≠ 0, from λ hq0, hqd0 (by rw [hq0, nat_degree_zero]),
    have : coeff p b ≠ 0, by rwa mem_support_iff at hbs,
    refine coeff_eq_zero_of_degree_lt _,
    erw [degree_mul, degree_C this, degree_pow, zero_add, degree_eq_nat_degree hq0,
      ← with_bot.coe_nsmul, nsmul_eq_mul, with_bot.coe_lt_coe, nat.cast_id,
      mul_lt_mul_right (pos_iff_ne_zero.mpr hqd0)],
    exact lt_of_le_of_ne (le_nat_degree_of_ne_zero this) hbp,
  end
  begin
    intro h, contrapose! hp0,
    rw mem_support_iff at h, push_neg at h,
    rwa ← leading_coeff_eq_zero,
  end
... = _ :
  have coeff (q ^ nat_degree p) (nat_degree p * nat_degree q) = leading_coeff (q ^ nat_degree p),
    by rw [leading_coeff, nat_degree_pow],
  by rw [coeff_C_mul, this, leading_coeff_pow]

lemma nat_degree_comp : nat_degree (p.comp q) = nat_degree p * nat_degree q :=
le_antisymm nat_degree_comp_le
  (if hp0 : p = 0 then by rw [hp0, zero_comp, nat_degree_zero, zero_mul]
  else if hqd0 : nat_degree q = 0
  then have degree q ≤ 0, by rw [← with_bot.coe_zero, ← hqd0]; exact degree_le_nat_degree,
    by rw [eq_C_of_degree_le_zero this]; simp
  else le_nat_degree_of_ne_zero $
    have hq0 : q ≠ 0, from λ hq0, hqd0 $ by rw [hq0, nat_degree_zero],
    calc coeff (p.comp q) (nat_degree p * nat_degree q)
        = leading_coeff p * leading_coeff q ^ nat_degree p :
      coeff_comp_degree_mul_degree hqd0
    ... ≠ 0 : mul_ne_zero (mt leading_coeff_eq_zero.1 hp0)
      (pow_ne_zero _ (mt leading_coeff_eq_zero.1 hq0)))

lemma leading_coeff_comp (hq : nat_degree q ≠ 0) : leading_coeff (p.comp q) =
  leading_coeff p * leading_coeff q ^ nat_degree p :=
by rw [← coeff_comp_degree_mul_degree hq, ← nat_degree_comp]; refl

@[simp] lemma nat_degree_coe_units (u : units (polynomial R)) :
  nat_degree (u : polynomial R) = 0 :=
nat_degree_eq_of_degree_eq_some (degree_coe_units u)

lemma comp_eq_zero_iff :
  p.comp q = 0 ↔ p = 0 ∨ (p.eval (q.coeff 0) = 0 ∧ q = C (q.coeff 0)) :=
begin
  split,
  { intro h,
    have key : p.nat_degree = 0 ∨ q.nat_degree = 0,
    { rw [←mul_eq_zero, ←nat_degree_comp, h, nat_degree_zero] },
    replace key := or.imp eq_C_of_nat_degree_eq_zero eq_C_of_nat_degree_eq_zero key,
    cases key,
    { rw [key, C_comp] at h,
      exact or.inl (key.trans h) },
    { rw [key, comp_C, C_eq_zero] at h,
      exact or.inr ⟨h, key⟩ }, },
  { exact λ h, or.rec (λ h, by rw [h, zero_comp]) (λ h, by rw [h.2, comp_C, h.1, C_0]) h },
end

lemma zero_of_eval_zero [infinite R] (p : polynomial R) (h : ∀ x, p.eval x = 0) : p = 0 :=
by classical; by_contradiction hp; exact
fintype.false ⟨p.roots.to_finset, λ x, multiset.mem_to_finset.mpr ((mem_roots hp).mpr (h _))⟩

lemma funext [infinite R] {p q : polynomial R} (ext : ∀ r : R, p.eval r = q.eval r) : p = q :=
begin
  rw ← sub_eq_zero,
  apply zero_of_eval_zero,
  intro x,
  rw [eval_sub, sub_eq_zero, ext],
end

variables [comm_ring T]

/-- The set of distinct roots of `p` in `E`.

If you have a non-separable polynomial, use `polynomial.roots` for the multiset
where multiple roots have the appropriate multiplicity. -/
def root_set (p : polynomial T) (S) [comm_ring S] [is_domain S] [algebra T S] : set S :=
(p.map (algebra_map T S)).roots.to_finset

lemma root_set_def (p : polynomial T) (S) [comm_ring S] [is_domain S] [algebra T S] :
  p.root_set S = (p.map (algebra_map T S)).roots.to_finset :=
rfl

@[simp] lemma root_set_zero (S) [comm_ring S] [is_domain S] [algebra T S] :
  (0 : polynomial T).root_set S = ∅ :=
by rw [root_set_def, polynomial.map_zero, roots_zero, to_finset_zero, finset.coe_empty]

@[simp] lemma root_set_C [comm_ring S] [is_domain S] [algebra T S] (a : T) :
  (C a).root_set S = ∅ :=
by rw [root_set_def, map_C, roots_C, multiset.to_finset_zero, finset.coe_empty]

instance root_set_fintype (p : polynomial T)
  (S : Type*) [comm_ring S] [is_domain S] [algebra T S] : fintype (p.root_set S) :=
finset_coe.fintype _

lemma root_set_finite (p : polynomial T)
  (S : Type*) [comm_ring S] [is_domain S] [algebra T S] : (p.root_set S).finite :=
⟨polynomial.root_set_fintype p S⟩

end roots

theorem is_unit_iff {f : polynomial R} : is_unit f ↔ ∃ r : R, is_unit r ∧ C r = f :=
⟨λ hf, ⟨f.coeff 0,
  is_unit_C.1 $ eq_C_of_degree_eq_zero (degree_eq_zero_of_is_unit hf) ▸ hf,
  (eq_C_of_degree_eq_zero (degree_eq_zero_of_is_unit hf)).symm⟩,
λ ⟨r, hr, hrf⟩, hrf ▸ is_unit_C.2 hr⟩

lemma coeff_coe_units_zero_ne_zero (u : units (polynomial R)) :
  coeff (u : polynomial R) 0 ≠ 0 :=
begin
  conv in (0) { rw [← nat_degree_coe_units u] },
  rw [← leading_coeff, ne.def, leading_coeff_eq_zero],
  exact units.ne_zero _
end

lemma degree_eq_degree_of_associated (h : associated p q) : degree p = degree q :=
let ⟨u, hu⟩ := h in by simp [hu.symm]

lemma degree_eq_one_of_irreducible_of_root (hi : irreducible p) {x : R} (hx : is_root p x) :
  degree p = 1 :=
let ⟨g, hg⟩ := dvd_iff_is_root.2 hx in
have is_unit (X - C x) ∨ is_unit g, from hi.is_unit_or_is_unit hg,
this.elim
  (λ h, have h₁ : degree (X - C x) = 1, from degree_X_sub_C x,
    have h₂ : degree (X - C x) = 0, from degree_eq_zero_of_is_unit h,
    by rw h₁ at h₂; exact absurd h₂ dec_trivial)
  (λ hgu, by rw [hg, degree_mul, degree_X_sub_C, degree_eq_zero_of_is_unit hgu, add_zero])

/-- Division by a monic polynomial doesn't change the leading coefficient. -/
lemma leading_coeff_div_by_monic_of_monic {R : Type u} [comm_ring R] [is_domain R]
  {p q : polynomial R} (hmonic : q.monic) (hdegree : q.degree ≤ p.degree) :
  (p /ₘ q).leading_coeff = p.leading_coeff :=
begin
  have hp := mod_by_monic_add_div p hmonic,
  have hzero : (p /ₘ q) ≠ 0,
  { intro h,
    exact not_lt_of_le hdegree ((div_by_monic_eq_zero_iff hmonic).1 h) },
  have deglt : (p %ₘ q).degree < (q * (p /ₘ q)).degree,
  { rw degree_mul,
    refine lt_of_lt_of_le (degree_mod_by_monic_lt p hmonic) _,
    rw [degree_eq_nat_degree (monic.ne_zero hmonic), degree_eq_nat_degree hzero],
    norm_cast,
    simp only [zero_le, le_add_iff_nonneg_right] },
  have hrew := (leading_coeff_add_of_degree_lt deglt),
  rw leading_coeff_mul q (p /ₘ q) at hrew,
  simp only [hmonic, one_mul, monic.leading_coeff] at hrew,
  nth_rewrite 1 ← hp,
  exact hrew.symm
end

lemma eq_of_monic_of_dvd_of_nat_degree_le (hp : p.monic) (hq : q.monic) (hdiv : p ∣ q)
  (hdeg : q.nat_degree ≤ p.nat_degree) : q = p :=
begin
  obtain ⟨r, hr⟩ := hdiv,
  have rzero : r ≠ 0,
  { intro h,
    simpa [h, monic.ne_zero hq] using hr },
  rw [hr, nat_degree_mul (monic.ne_zero hp) rzero] at hdeg,
  have hdegeq : p.nat_degree + r.nat_degree = p.nat_degree,
  { suffices hdegle : p.nat_degree ≤ p.nat_degree + r.nat_degree,
    { exact le_antisymm hdeg hdegle },
    exact nat.le.intro rfl },
  replace hdegeq := eq_C_of_nat_degree_eq_zero (((@add_right_inj _ _ p.nat_degree) _ 0).1 hdegeq),
  suffices hlead : 1 = r.leading_coeff,
  { have hcoeff := leading_coeff_C (r.coeff 0),
    rw [← hdegeq, ← hlead] at hcoeff,
    rw [← hcoeff, C_1] at hdegeq,
    rwa [hdegeq, mul_one] at hr },
  have hprod : q.leading_coeff = p.leading_coeff * r.leading_coeff,
  { simp only [hr, leading_coeff_mul] },
  rwa [monic.leading_coeff hp, monic.leading_coeff hq, one_mul] at hprod
end

end comm_ring

section

variables [semiring R] [comm_ring S] [is_domain S] (φ : R →+* S)

lemma is_unit_of_is_unit_leading_coeff_of_is_unit_map
  (f : polynomial R) (hf : is_unit (leading_coeff f)) (H : is_unit (map φ f)) :
  is_unit f :=
begin
  have dz := degree_eq_zero_of_is_unit H,
  rw degree_map_eq_of_leading_coeff_ne_zero at dz,
  { rw eq_C_of_degree_eq_zero dz,
    refine is_unit.map (C.to_monoid_hom : R →* polynomial R) _,
    convert hf,
    rw (degree_eq_iff_nat_degree_eq _).1 dz,
    rintro rfl,
    simpa using H, },
  { intro h,
    have u : is_unit (φ f.leading_coeff) := is_unit.map φ.to_monoid_hom hf,
    rw h at u,
    simpa using u, }
end

end

section
variables [comm_ring R] [is_domain R] [comm_ring S] [is_domain S] (φ : R →+* S)
/--
A polynomial over an integral domain `R` is irreducible if it is monic and
  irreducible after mapping into an integral domain `S`.

A special case of this lemma is that a polynomial over `ℤ` is irreducible if
  it is monic and irreducible over `ℤ/pℤ` for some prime `p`.
-/
lemma monic.irreducible_of_irreducible_map (f : polynomial R)
  (h_mon : monic f) (h_irr : irreducible (map φ f)) :
  irreducible f :=
begin
  fsplit,
  { intro h,
    exact h_irr.not_unit (is_unit.map (map_ring_hom φ).to_monoid_hom h), },
  { intros a b h,

    have q := (leading_coeff_mul a b).symm,
    rw ←h at q,
    dsimp [monic] at h_mon,
    rw h_mon at q,
    have au : is_unit a.leading_coeff := is_unit_of_mul_eq_one _ _ q,
    rw mul_comm at q,
    have bu : is_unit b.leading_coeff := is_unit_of_mul_eq_one _ _ q,
    clear q h_mon,

    have h' := congr_arg (map φ) h,
    simp only [map_mul] at h',
    cases h_irr.is_unit_or_is_unit h' with w w,
    { left,
      exact is_unit_of_is_unit_leading_coeff_of_is_unit_map _ _ au w, },
    { right,
      exact is_unit_of_is_unit_leading_coeff_of_is_unit_map _ _ bu w, }, }
end

end

end polynomial


import category_theory.category
import category_theory.functor
import category_theory.types
import help_functions

import tactic.tidy

universes v u

namespace Sum
open category_theory
     set
     classical
     function
     help_functions
     sum

local notation f ` ⊚ `:80 g:80 := category_struct.comp g f
/- Sum -/
/--
predicate to determine if S along with e₁ and e₂ is a Sum in category theory definition
-/
def is_sum  {X : Type v} [category X]
            {A B : X}
            (S: X)
            (e₁ : A ⟶ S)
            (e₂ : B ⟶ S) :Prop
            := Π (Q : X)
                (q₁ : A ⟶ Q)
                (q₂ : B ⟶ Q),
                ∃! s : S ⟶ Q,
                q₁ = s ⊚ e₁ ∧ q₂ = s ⊚ e₂

lemma jointly_epi_cat {X : Type v} [category X]
    {A B S Q : X} (e₁ : A ⟶ S) (e₂ : B ⟶ S)
    (is_sm : is_sum S e₁ e₂)
        (f g: S ⟶ Q)
        (h1 : f ⊚ e₁ = g ⊚ e₁)
        (h2 : f ⊚ e₂ = g ⊚ e₂)
    : f = g :=
    begin
        have ex : _ := is_sm Q (f ⊚ e₁) (f ⊚ e₂),
        cases ex with s spec_s,
        have g_s : g = s := spec_s.2 g ⟨h1, h2⟩,
        rw g_s,
        exact spec_s.2 f ⟨rfl, rfl⟩
    end

lemma jointly_epi  {A B Q : Type u}
                    (s s₁: (A ⊕ B) → Q)
                    (h1 : s₁ ∘ inl = s ∘ inl)
                    (h2 : s₁ ∘ inr = s ∘ inr)
    : s₁ = s :=
    begin
        have all_ab : ∀ ab : (A ⊕ B) , s₁ ab = s ab :=
            begin
                intro ab,
                induction ab,
                case inl :
                    {
                    have s0 : (s₁ ∘ inl) ab = (s ∘ inl) ab
                        := by rw h1,
                    exact s0
                    },
                case inr :
                    begin
                        have s0 : (s₁ ∘ inr) ab = (s ∘ inr) ab
                            := by rw h2,
                        exact s0
                    end,
            end,
        exact funext all_ab
    end

variables   {A B C: Type u}
/--
A proof that the disjoint union, which is defined inductively (inl : A → sum, inr : B → sum) in lean
is a sum in the category theory definition.
-/
lemma disjoint_union_is_sum :
    is_sum  (A ⊕ B)
            inl
            inr :=
    begin
        intros Q q₁ q₂,         -- competitor with 2 morphisms
        show ∃! s : (A ⊕ B) ⟶ Q, (q₁ = s ∘ inl ∧ q₂ = s ∘ inr)
                , from
        let s : (A ⊕ B) ⟶ Q :=      --defining the unique morphism s : sum → Q inductively
            begin
                intro ab,
                induction ab,
                case inl :
                    begin
                        exact q₁ ab
                    end,
                case inr :
                    begin
                        exact q₂ ab
                    end,
            end in

        have commut_A : q₁ = s ∘ inl := rfl,
        have commut_B : q₂ = s ∘ inr := rfl,
        have unique : ∀ s₁ ,
                        (q₁ = s₁ ∘ inl ∧ q₂ = s₁ ∘ inr) →
                        s₁ = s :=
            assume s₁ h₁,
                jointly_epi s s₁
                    (by rw [← h₁.1 ,commut_A ])
                    (by rw [← h₁.2 ,commut_B ]),

        exists_unique.intro s
            ⟨commut_A , commut_B⟩ unique
    end

end Sum


/-
Copyright (c) 2021 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import topology.continuous_function.bounded
import topology.uniform_space.compact
import topology.compact_open
import topology.sets.compacts

/-!
# Continuous functions on a compact space

Continuous functions `C(α, β)` from a compact space `α` to a metric space `β`
are automatically bounded, and so acquire various structures inherited from `α →ᵇ β`.

This file transfers these structures, and restates some lemmas
characterising these structures.

If you need a lemma which is proved about `α →ᵇ β` but not for `C(α, β)` when `α` is compact,
you should restate it here. You can also use
`bounded_continuous_function.equiv_continuous_map_of_compact` to move functions back and forth.

-/

noncomputable theory
open_locale topology classical nnreal bounded_continuous_function big_operators

open set filter metric

open bounded_continuous_function

namespace continuous_map

variables {α β E : Type*} [topological_space α] [compact_space α] [metric_space β]
  [normed_add_comm_group E]

section

variables (α β)

/--
When `α` is compact, the bounded continuous maps `α →ᵇ β` are
equivalent to `C(α, β)`.
-/
@[simps { fully_applied := ff }]
def equiv_bounded_of_compact : C(α, β) ≃ (α →ᵇ β) :=
⟨mk_of_compact, bounded_continuous_function.to_continuous_map,
 λ f, by { ext, refl, }, λ f, by { ext, refl, }⟩

lemma uniform_inducing_equiv_bounded_of_compact :
  uniform_inducing (equiv_bounded_of_compact α β) :=
uniform_inducing.mk'
begin
  simp only [has_basis_compact_convergence_uniformity.mem_iff, uniformity_basis_dist_le.mem_iff],
  exact λ s, ⟨λ ⟨⟨a, b⟩, ⟨ha, ⟨ε, hε, hb⟩⟩, hs⟩, ⟨{p | ∀ x, (p.1 x, p.2 x) ∈ b},
    ⟨ε, hε, λ _ h x, hb (by exact (dist_le hε.le).mp h x)⟩, λ f g h, hs (by exact λ x hx, h x)⟩,
    λ ⟨t, ⟨ε, hε, ht⟩, hs⟩, ⟨⟨set.univ, {p | dist p.1 p.2 ≤ ε}⟩,
      ⟨is_compact_univ, ⟨ε, hε, λ _ h, h⟩⟩,
      λ ⟨f, g⟩ h, hs _ _ (ht (by exact (dist_le hε.le).mpr (λ x, h x (mem_univ x))))⟩⟩,
end

lemma uniform_embedding_equiv_bounded_of_compact :
  uniform_embedding (equiv_bounded_of_compact α β) :=
{ inj := (equiv_bounded_of_compact α β).injective,
  .. uniform_inducing_equiv_bounded_of_compact α β }

/--
When `α` is compact, the bounded continuous maps `α →ᵇ 𝕜` are
additively equivalent to `C(α, 𝕜)`.
-/
@[simps apply symm_apply { fully_applied := ff }]
def add_equiv_bounded_of_compact [add_monoid β] [has_lipschitz_add β] :
  C(α, β) ≃+ (α →ᵇ β) :=
({ .. to_continuous_map_add_hom α β,
   .. (equiv_bounded_of_compact α β).symm, } : (α →ᵇ β) ≃+ C(α, β)).symm

instance : metric_space C(α, β) :=
(uniform_embedding_equiv_bounded_of_compact α β).comap_metric_space _

/--
When `α` is compact, and `β` is a metric space, the bounded continuous maps `α →ᵇ β` are
isometric to `C(α, β)`.
-/
@[simps to_equiv apply symm_apply { fully_applied := ff }]
def isometry_equiv_bounded_of_compact :
  C(α, β) ≃ᵢ (α →ᵇ β) :=
{ isometry_to_fun := λ x y, rfl,
  to_equiv := equiv_bounded_of_compact α β }

end

@[simp] lemma _root_.bounded_continuous_function.dist_mk_of_compact (f g : C(α, β)) :
  dist (mk_of_compact f) (mk_of_compact g) = dist f g := rfl

@[simp] lemma _root_.bounded_continuous_function.dist_to_continuous_map (f g : α →ᵇ β) :
  dist (f.to_continuous_map) (g.to_continuous_map) = dist f g := rfl

open bounded_continuous_function

section
variables {α β} {f g : C(α, β)} {C : ℝ}

/-- The pointwise distance is controlled by the distance between functions, by definition. -/
lemma dist_apply_le_dist (x : α) : dist (f x) (g x) ≤ dist f g :=
by simp only [← dist_mk_of_compact, dist_coe_le_dist, ← mk_of_compact_apply]

/-- The distance between two functions is controlled by the supremum of the pointwise distances -/
lemma dist_le (C0 : (0 : ℝ) ≤ C) : dist f g ≤ C ↔ ∀x:α, dist (f x) (g x) ≤ C :=
by simp only [← dist_mk_of_compact, dist_le C0, mk_of_compact_apply]

lemma dist_le_iff_of_nonempty [nonempty α] :
  dist f g ≤ C ↔ ∀ x, dist (f x) (g x) ≤ C :=
by simp only [← dist_mk_of_compact, dist_le_iff_of_nonempty, mk_of_compact_apply]

lemma dist_lt_iff_of_nonempty [nonempty α] :
  dist f g < C ↔ ∀x:α, dist (f x) (g x) < C :=
by simp only [← dist_mk_of_compact, dist_lt_iff_of_nonempty_compact, mk_of_compact_apply]

lemma dist_lt_of_nonempty [nonempty α] (w : ∀x:α, dist (f x) (g x) < C) : dist f g < C :=
(dist_lt_iff_of_nonempty).2 w

lemma dist_lt_iff (C0 : (0 : ℝ) < C) :
  dist f g < C ↔ ∀x:α, dist (f x) (g x) < C :=
by simp only [← dist_mk_of_compact, dist_lt_iff_of_compact C0, mk_of_compact_apply]

end

instance [complete_space β] : complete_space (C(α, β)) :=
(isometry_equiv_bounded_of_compact α β).complete_space

/-- See also `continuous_map.continuous_eval'` -/
@[continuity] lemma continuous_eval : continuous (λ p : C(α, β) × α, p.1 p.2) :=
continuous_eval.comp ((isometry_equiv_bounded_of_compact α β).continuous.prod_map continuous_id)

/-- See also `continuous_map.continuous_eval_const` -/
@[continuity] lemma continuous_eval_const (x : α) : continuous (λ f : C(α, β), f x) :=
continuous_eval.comp (continuous_id.prod_mk continuous_const)

/-- See also `continuous_map.continuous_coe'` -/
lemma continuous_coe : @continuous (C(α, β)) (α → β) _ _ coe_fn :=
continuous_pi continuous_eval_const

-- TODO at some point we will need lemmas characterising this norm!
-- At the moment the only way to reason about it is to transfer `f : C(α,E)` back to `α →ᵇ E`.
instance : has_norm C(α, E) :=
{ norm := λ x, dist x 0 }

@[simp] lemma _root_.bounded_continuous_function.norm_mk_of_compact (f : C(α, E)) :
  ‖mk_of_compact f‖ = ‖f‖ := rfl

@[simp] lemma _root_.bounded_continuous_function.norm_to_continuous_map_eq (f : α →ᵇ E) :
  ‖f.to_continuous_map‖ = ‖f‖ :=
rfl

open bounded_continuous_function

instance : normed_add_comm_group C(α, E) :=
{ dist_eq := λ x y, by
    rw [← norm_mk_of_compact, ← dist_mk_of_compact, dist_eq_norm, mk_of_compact_sub],
  dist := dist, norm := norm, .. continuous_map.metric_space _ _, .. continuous_map.add_comm_group }

instance [nonempty α] [has_one E] [norm_one_class E] : norm_one_class C(α, E) :=
{ norm_one := by simp only [←norm_mk_of_compact, mk_of_compact_one, norm_one] }

section
variables (f : C(α, E))
-- The corresponding lemmas for `bounded_continuous_function` are stated with `{f}`,
-- and so can not be used in dot notation.

lemma norm_coe_le_norm (x : α) : ‖f x‖ ≤ ‖f‖ :=
(mk_of_compact f).norm_coe_le_norm x

/-- Distance between the images of any two points is at most twice the norm of the function. -/
lemma dist_le_two_norm (x y : α) : dist (f x) (f y) ≤ 2 * ‖f‖ :=
(mk_of_compact f).dist_le_two_norm x y

/-- The norm of a function is controlled by the supremum of the pointwise norms -/
lemma norm_le {C : ℝ} (C0 : (0 : ℝ) ≤ C) : ‖f‖ ≤ C ↔ ∀x:α, ‖f x‖ ≤ C :=
@bounded_continuous_function.norm_le _ _ _ _
  (mk_of_compact f) _ C0

lemma norm_le_of_nonempty [nonempty α] {M : ℝ} : ‖f‖ ≤ M ↔ ∀ x, ‖f x‖ ≤ M :=
@bounded_continuous_function.norm_le_of_nonempty _ _ _ _ _ (mk_of_compact f) _

lemma norm_lt_iff {M : ℝ} (M0 : 0 < M) : ‖f‖ < M ↔ ∀ x, ‖f x‖ < M :=
@bounded_continuous_function.norm_lt_iff_of_compact _ _ _ _ _ (mk_of_compact f) _ M0

lemma norm_lt_iff_of_nonempty [nonempty α] {M : ℝ} :
  ‖f‖ < M ↔ ∀ x, ‖f x‖ < M :=
@bounded_continuous_function.norm_lt_iff_of_nonempty_compact _ _ _ _ _ _ (mk_of_compact f) _

lemma nnnorm_lt_iff_of_nonempty [nonempty α] {M : ℝ≥0} :
  ‖f‖₊ < M ↔ ∀ x, ‖f x‖₊ < M :=
f.norm_lt_iff_of_nonempty

lemma apply_le_norm (f : C(α, ℝ)) (x : α) : f x ≤ ‖f‖ :=
le_trans (le_abs.mpr (or.inl (le_refl (f x)))) (f.norm_coe_le_norm x)

lemma neg_norm_le_apply (f : C(α, ℝ)) (x : α) : -‖f‖ ≤ f x :=
le_trans (neg_le_neg (f.norm_coe_le_norm x)) (neg_le.mp (neg_le_abs_self (f x)))

lemma norm_eq_supr_norm : ‖f‖ = ⨆ x : α, ‖f x‖ :=
(mk_of_compact f).norm_eq_supr_norm

lemma norm_restrict_mono_set {X : Type*} [topological_space X]
  (f : C(X, E)) {K L : topological_space.compacts X} (hKL : K ≤ L) :
  ‖f.restrict K‖ ≤ ‖f.restrict L‖ :=
(norm_le _ (norm_nonneg _)).mpr (λ x, norm_coe_le_norm (f.restrict L) $ set.inclusion hKL x)

end

section
variables {R : Type*} [normed_ring R]

instance : normed_ring C(α,R) :=
{ norm_mul := λ f g, norm_mul_le (mk_of_compact f) (mk_of_compact g),
  ..(infer_instance : normed_add_comm_group C(α,R)),
  .. continuous_map.ring }

end

section
variables {𝕜 : Type*} [normed_field 𝕜] [normed_space 𝕜 E]

instance : normed_space 𝕜 C(α,E) :=
{ norm_smul_le := λ c f, (norm_smul_le c (mk_of_compact f) : _) }

section
variables (α 𝕜 E)

/--
When `α` is compact and `𝕜` is a normed field,
the `𝕜`-algebra of bounded continuous maps `α →ᵇ β` is
`𝕜`-linearly isometric to `C(α, β)`.
-/
def linear_isometry_bounded_of_compact :
  C(α, E) ≃ₗᵢ[𝕜] (α →ᵇ E) :=
{ map_smul' := λ c f, by { ext, simp, },
  norm_map' := λ f, rfl,
  .. add_equiv_bounded_of_compact α E }

variables {α E} -- to match bounded_continuous_function.eval_clm

/-- The evaluation at a point, as a continuous linear map from `C(α, 𝕜)` to `𝕜`. -/
def eval_clm (x : α) : C(α, E) →L[𝕜] E :=
  (eval_clm 𝕜 x).comp
  ((linear_isometry_bounded_of_compact α E 𝕜).to_linear_isometry).to_continuous_linear_map

end

-- this lemma and the next are the analogues of those autogenerated by `@[simps]` for
-- `equiv_bounded_of_compact`, `add_equiv_bounded_of_compact`
@[simp] lemma linear_isometry_bounded_of_compact_symm_apply (f : α →ᵇ E) :
  (linear_isometry_bounded_of_compact α E 𝕜).symm f = f.to_continuous_map :=
rfl

@[simp] lemma linear_isometry_bounded_of_compact_apply_apply (f : C(α, E)) (a : α) :
  (linear_isometry_bounded_of_compact α E 𝕜 f) a = f a :=
rfl

@[simp]
lemma linear_isometry_bounded_of_compact_to_isometry_equiv :
  (linear_isometry_bounded_of_compact α E 𝕜).to_isometry_equiv =
    (isometry_equiv_bounded_of_compact α E) :=
rfl

@[simp]
lemma linear_isometry_bounded_of_compact_to_add_equiv :
  (linear_isometry_bounded_of_compact α E 𝕜).to_linear_equiv.to_add_equiv =
    (add_equiv_bounded_of_compact α E) :=
rfl

@[simp]
lemma linear_isometry_bounded_of_compact_of_compact_to_equiv :
  (linear_isometry_bounded_of_compact α E 𝕜).to_linear_equiv.to_equiv =
    (equiv_bounded_of_compact α E) :=
rfl

end

section
variables {𝕜 : Type*} {γ : Type*} [normed_field 𝕜] [normed_ring γ] [normed_algebra 𝕜 γ]

instance : normed_algebra 𝕜 C(α, γ) :=
{ ..continuous_map.normed_space }

end

end continuous_map

namespace continuous_map

section uniform_continuity
variables {α β : Type*}
variables [metric_space α] [compact_space α] [metric_space β]

/-!
We now set up some declarations making it convenient to use uniform continuity.
-/

lemma uniform_continuity
  (f : C(α, β)) (ε : ℝ) (h : 0 < ε) :
  ∃ δ > 0, ∀ {x y}, dist x y < δ → dist (f x) (f y) < ε :=
metric.uniform_continuous_iff.mp
  (compact_space.uniform_continuous_of_continuous f.continuous) ε h

/--
An arbitrarily chosen modulus of uniform continuity for a given function `f` and `ε > 0`.
-/
-- This definition allows us to separate the choice of some `δ`,
-- and the corresponding use of `dist a b < δ → dist (f a) (f b) < ε`,
-- even across different declarations.
def modulus (f : C(α, β)) (ε : ℝ) (h : 0 < ε) : ℝ :=
classical.some (uniform_continuity f ε h)

lemma modulus_pos (f : C(α, β)) {ε : ℝ} {h : 0 < ε} : 0 < f.modulus ε h :=
(classical.some_spec (uniform_continuity f ε h)).fst

lemma dist_lt_of_dist_lt_modulus
  (f : C(α, β)) (ε : ℝ) (h : 0 < ε) {a b : α} (w : dist a b < f.modulus ε h) :
  dist (f a) (f b) < ε :=
(classical.some_spec (uniform_continuity f ε h)).snd w

end uniform_continuity

end continuous_map

section comp_left
variables (X : Type*) {𝕜 β γ : Type*} [topological_space X] [compact_space X]
  [nontrivially_normed_field 𝕜]
variables [normed_add_comm_group β] [normed_space 𝕜 β] [normed_add_comm_group γ] [normed_space 𝕜 γ]

open continuous_map

/--
Postcomposition of continuous functions into a normed module by a continuous linear map is a
continuous linear map.
Transferred version of `continuous_linear_map.comp_left_continuous_bounded`,
upgraded version of `continuous_linear_map.comp_left_continuous`,
similar to `linear_map.comp_left`. -/
protected def continuous_linear_map.comp_left_continuous_compact (g : β →L[𝕜] γ) :
  C(X, β) →L[𝕜] C(X, γ) :=
(linear_isometry_bounded_of_compact X γ 𝕜).symm.to_linear_isometry.to_continuous_linear_map.comp $
(g.comp_left_continuous_bounded X).comp $
(linear_isometry_bounded_of_compact X β 𝕜).to_linear_isometry.to_continuous_linear_map

@[simp] lemma continuous_linear_map.to_linear_comp_left_continuous_compact (g : β →L[𝕜] γ) :
  (g.comp_left_continuous_compact X : C(X, β) →ₗ[𝕜] C(X, γ)) = g.comp_left_continuous 𝕜 X :=
by { ext f, refl }

@[simp] lemma continuous_linear_map.comp_left_continuous_compact_apply (g : β →L[𝕜] γ)
  (f : C(X, β)) (x : X) :
  g.comp_left_continuous_compact X f x = g (f x) :=
rfl

end comp_left

namespace continuous_map
/-!
We now setup variations on `comp_right_* f`, where `f : C(X, Y)`
(that is, precomposition by a continuous map),
as a morphism `C(Y, T) → C(X, T)`, respecting various types of structure.

In particular:
* `comp_right_continuous_map`, the bundled continuous map (for this we need `X Y` compact).
* `comp_right_homeomorph`, when we precompose by a homeomorphism.
* `comp_right_alg_hom`, when `T = R` is a topological ring.
-/
section comp_right

/--
Precomposition by a continuous map is itself a continuous map between spaces of continuous maps.
-/
def comp_right_continuous_map {X Y : Type*} (T : Type*) [topological_space X] [compact_space X]
  [topological_space Y] [compact_space Y] [metric_space T]
  (f : C(X, Y)) : C(C(Y, T), C(X, T)) :=
{ to_fun := λ g, g.comp f,
  continuous_to_fun :=
  begin
    refine metric.continuous_iff.mpr _,
    intros g ε ε_pos,
    refine ⟨ε, ε_pos, λ g' h, _⟩,
    rw continuous_map.dist_lt_iff ε_pos at h ⊢,
    { exact λ x, h (f x), },
  end }

@[simp] lemma comp_right_continuous_map_apply {X Y : Type*} (T : Type*) [topological_space X]
  [compact_space X] [topological_space Y] [compact_space Y] [metric_space T]
  (f : C(X, Y)) (g : C(Y, T)) :
  (comp_right_continuous_map T f) g = g.comp f :=
rfl

/--
Precomposition by a homeomorphism is itself a homeomorphism between spaces of continuous maps.
-/
def comp_right_homeomorph {X Y : Type*} (T : Type*) [topological_space X] [compact_space X]
  [topological_space Y] [compact_space Y] [metric_space T]
  (f : X ≃ₜ Y) : C(Y, T) ≃ₜ C(X, T) :=
{ to_fun := comp_right_continuous_map T f.to_continuous_map,
  inv_fun := comp_right_continuous_map T f.symm.to_continuous_map,
  left_inv := λ g, ext $ λ _, congr_arg g (f.apply_symm_apply _),
  right_inv := λ g, ext $ λ _, congr_arg g (f.symm_apply_apply _) }

lemma comp_right_alg_hom_continuous {X Y : Type*} (R A : Type*)
  [topological_space X] [compact_space X] [topological_space Y] [compact_space Y] [comm_semiring R]
  [semiring A] [metric_space A] [topological_semiring A] [algebra R A] (f : C(X, Y)) :
  continuous (comp_right_alg_hom R A f) :=
map_continuous (comp_right_continuous_map A f)

end comp_right

section local_normal_convergence
/-! ### Local normal convergence

A sum of continuous functions (on a locally compact space) is "locally normally convergent" if the
sum of its sup-norms on any compact subset is summable. This implies convergence in the topology
of `C(X, E)` (i.e. locally uniform convergence). -/

open topological_space

variables {X : Type*} [topological_space X] [t2_space X] [locally_compact_space X]
variables {E : Type*} [normed_add_comm_group E] [complete_space E]

lemma summable_of_locally_summable_norm {ι : Type*} {F : ι → C(X, E)}
  (hF : ∀ K : compacts X, summable (λ i, ‖(F i).restrict K‖)) :
  summable F :=
begin
  refine (continuous_map.exists_tendsto_compact_open_iff_forall _).2 (λ K hK, _),
  lift K to compacts X using hK,
  have A : ∀ s : finset ι, restrict ↑K (∑ i in s, F i) = ∑ i in s, restrict K (F i),
  { intro s, ext1 x, simp },
  simpa only [has_sum, A] using summable_of_summable_norm (hF K)
end

end local_normal_convergence

/-!
### Star structures

In this section, if `β` is a normed ⋆-group, then so is the space of
continuous functions from `α` to `β`, by using the star operation pointwise.

Furthermore, if `α` is compact and `β` is a C⋆-ring, then `C(α, β)` is a C⋆-ring.  -/

section normed_space

variables {α : Type*} {β : Type*}
variables [topological_space α] [normed_add_comm_group β] [star_add_monoid β] [normed_star_group β]

lemma _root_.bounded_continuous_function.mk_of_compact_star [compact_space α] (f : C(α, β)) :
  mk_of_compact (star f) = star (mk_of_compact f) := rfl

instance [compact_space α] : normed_star_group C(α, β) :=
{ norm_star := λ f, by rw [←bounded_continuous_function.norm_mk_of_compact,
                          bounded_continuous_function.mk_of_compact_star, norm_star,
                          bounded_continuous_function.norm_mk_of_compact] }

end normed_space

section cstar_ring

variables {α : Type*} {β : Type*}
variables [topological_space α] [normed_ring β] [star_ring β]

instance [compact_space α] [cstar_ring β] : cstar_ring C(α, β) :=
{ norm_star_mul_self :=
  begin
    intros f,
    refine le_antisymm _ _,
    { rw [←sq, continuous_map.norm_le _ (sq_nonneg _)],
      intro x,
      simp only [continuous_map.coe_mul, coe_star, pi.mul_apply, pi.star_apply,
                 cstar_ring.norm_star_mul_self, ←sq],
      refine sq_le_sq' _ _,
      { linarith [norm_nonneg (f x), norm_nonneg f] },
      { exact continuous_map.norm_coe_le_norm f x }, },
    { rw [←sq, ←real.le_sqrt (norm_nonneg _) (norm_nonneg _),
          continuous_map.norm_le _ (real.sqrt_nonneg _)],
      intro x,
      rw [real.le_sqrt (norm_nonneg _) (norm_nonneg _), sq, ←cstar_ring.norm_star_mul_self],
      exact continuous_map.norm_coe_le_norm (star f * f) x },
  end }

end cstar_ring

end continuous_map