import analysis.calculus.bump_function_inner
import topology.metric_space.hausdorff_distance

import to_mathlib.topology.misc
import to_mathlib.topology.nhds_set
import to_mathlib.topology.hausdorff_distance
import to_mathlib.linear_algebra.basic

import notations

/-! # Spaces of 1-jets and their sections

For real normed spaces `E` and `F`, this file defines the space `one_jet_sec E F` of 1-jets
of maps from `E` to `F` as `E × F × (E →L[ℝ] F)`.

A section `𝓕 : jet_sec E F` of this space is a map `(𝓕.f, 𝓕.φ) : E → F × (E →L[ℝ] F)`.

It is holonomic at `x`, spelled `𝓕.is_holonomic_at x` if the differential of `𝓕.f` at `x`
is `𝓕.φ x`.

We then introduced parametrized families of sections, and especially homotopies of sections,
with type `htpy_jet_sec E F` and their concatenation operation `htpy_jet_sec.comp`.

Implementation note: the time parameter `t` for homotopies is any real number, but all the
homotopies we will construct will be constant for `t ≤ 0` and `t ≥ 1`. It looks like this imposes
more smoothness constraints at `t = 0` and `t = 1` (requiring flat functions), but this is needed
for smooth concatenations anyway.
 -/

noncomputable theory

open set function real filter
open_locale unit_interval topology

variables (E : Type*) [normed_add_comm_group E] [normed_space ℝ E]
variables (F : Type*) [normed_add_comm_group F] [normed_space ℝ F]
variables (P : Type*) [normed_add_comm_group P] [normed_space ℝ P]

/-! ## Spaces of 1-jets -/

/-- The space of 1-jets of maps from `E` to `F`. -/
@[derive metric_space]
def one_jet := E × F × (E →L[ℝ] F)

/-- A smooth section of J¹(E, F) → E. -/
@[ext] structure jet_sec :=
(f : E → F)
(f_diff : 𝒞 ∞ f)
(φ : E → E →L[ℝ] F)
(φ_diff : 𝒞 ∞ φ)

namespace jet_sec

variables {E F}

instance : has_coe_to_fun (jet_sec E F) (λ S, E → F × (E →L[ℝ] F)) :=
⟨λ 𝓕, λ x, (𝓕.f x, 𝓕.φ x)⟩

lemma coe_apply (𝓕 : jet_sec E F) (x : E) : 𝓕 x = (𝓕.f x, 𝓕.φ x) := rfl

lemma eq_iff {𝓕 𝓕' : jet_sec E F} {x : E} :
  𝓕 x = 𝓕' x ↔ 𝓕.f x = 𝓕'.f x ∧ 𝓕.φ x = 𝓕'.φ x :=
begin
  split,
  { intro h,
    exact ⟨congr_arg prod.fst h, congr_arg prod.snd h⟩ },
  { rintros ⟨h, h'⟩,
    ext1,
    exacts [h, h'] }
end

lemma ext' {𝓕 𝓕' : jet_sec E F} (h : ∀ x, 𝓕 x = 𝓕' x) : 𝓕 = 𝓕' :=
begin
  ext : 2,
  { exact congr_arg prod.fst (h x) },
  { ext1 x, exact congr_arg prod.snd (h x) },
end

/-! ## Holonomic sections-/

/-- A jet section `𝓕` is holonomic if its linear map part at `x`
is the derivative of its function part at `x`. -/
def is_holonomic_at (𝓕 : jet_sec E F) (x : E) : Prop := D 𝓕.f x = 𝓕.φ x

lemma is_holonomic_at.congr {𝓕 𝓕' : jet_sec E F} {x} (h : is_holonomic_at 𝓕 x)
  (h' : 𝓕 =ᶠ[𝓝 x] 𝓕') : is_holonomic_at 𝓕' x :=
begin
  have h'' : 𝓕.f =ᶠ[𝓝 x] 𝓕'.f,
  { apply h'.mono,
    dsimp only,
    simp_rw eq_iff,
    tauto },
  unfold jet_sec.is_holonomic_at,
  rwa [h''.symm.fderiv_eq, ← (eq_iff.mp h'.self_of_nhds).2]
end

/-- A formal solution `𝓕` of `R` is partially holonomic in the direction of some subspace `E'`
if its linear map part at `x` is the derivative of its function part at `x` in restriction to
`E'`. -/
def is_part_holonomic_at (𝓕 : jet_sec E F) (E' : submodule ℝ E) (x : E) :=
∀ v ∈ E', D 𝓕.f x v = 𝓕.φ x v

lemma _root_.filter.eventually.is_part_holonomic_at_congr {𝓕 𝓕' : jet_sec E F} {s : set E}
  (h : ∀ᶠ x near s, 𝓕 x = 𝓕' x) (E' : submodule ℝ E) :
  ∀ᶠ x near s, 𝓕.is_part_holonomic_at E' x ↔ 𝓕'.is_part_holonomic_at E' x :=
begin
  apply h.eventually_nhds_set.mono,
  intros x hx,
  have hf : 𝓕.f =ᶠ[𝓝 x] 𝓕'.f,
  { apply hx.mono,
    dsimp only,
    simp_rw eq_iff,
    tauto },
  unfold jet_sec.is_part_holonomic_at,
  rw [hf.fderiv_eq, (eq_iff.mp hx.self_of_nhds).2]
end

lemma is_part_holonomic_at.sup (𝓕 : jet_sec E F) {E' E'' : submodule ℝ E} {x : E}
  (h' : 𝓕.is_part_holonomic_at E' x) (h'' : 𝓕.is_part_holonomic_at E'' x) :
  𝓕.is_part_holonomic_at (E' ⊔ E'') x :=
λ v : E, linear_map.eq_on_sup h' h''

lemma is_part_holonomic_top {𝓕 : jet_sec E F} {x : E} :
  is_part_holonomic_at 𝓕 ⊤ x ↔ is_holonomic_at 𝓕 x :=
begin
  simp only [is_part_holonomic_at, submodule.mem_top, forall_true_left, is_holonomic_at],
  rw [← funext_iff, continuous_linear_map.coe_fn_injective.eq_iff]
end

@[simp] lemma is_part_holonomic_bot (𝓕 : jet_sec E F) :
  is_part_holonomic_at 𝓕 ⊥ = λ x, true :=
begin
  ext x,
  simp only [is_part_holonomic_at, submodule.mem_bot, forall_eq, map_zero, eq_self_iff_true]
end

end jet_sec

/-! ## Homotopies of sections -/

section htpy_jet_sec

/-- A parametrized family of sections of J¹(E, F). -/
structure family_jet_sec :=
(f : P → E → F)
(f_diff : 𝒞 ∞ ↿f)
(φ : P → E → E →L[ℝ] F)
(φ_diff : 𝒞 ∞ ↿φ)

/-- A homotopy of sections of J¹(E, F). -/
@[reducible] def htpy_jet_sec := family_jet_sec E F ℝ

variables  {E F P}

instance : has_coe_to_fun (family_jet_sec E F P) (λ S, P → jet_sec E F) :=
⟨λ S t,
 { f := S.f t,
   f_diff := S.f_diff.comp (cont_diff_const.prod cont_diff_id),
   φ := S.φ t,
   φ_diff := S.φ_diff.comp (cont_diff_const.prod cont_diff_id) }⟩

namespace family_jet_sec

lemma cont_diff_f (𝓕 : family_jet_sec E F P) {n : ℕ∞} : 𝒞 n ↿𝓕.f :=
𝓕.f_diff.of_le le_top

lemma cont_diff_φ (𝓕 : family_jet_sec E F P) {n : ℕ∞} : 𝒞 n ↿𝓕.φ :=
𝓕.φ_diff.of_le le_top

end family_jet_sec

/-- The constant homotopy of formal solutions at a given formal solution. It will be used
as junk value for constructions of formal homotopies that need additional assumptions and also
for trivial induction initialization. -/
def jet_sec.const_htpy (𝓕 : jet_sec E F) : htpy_jet_sec E F :=
{ f := λ t, 𝓕.f,
  f_diff := 𝓕.f_diff.snd',
  φ := λ t, 𝓕.φ,
  φ_diff := 𝓕.φ_diff.snd' }

@[simp] lemma jet_sec.const_htpy_apply (𝓕 : jet_sec E F) :
  ∀ t, 𝓕.const_htpy t = 𝓕 :=
λ t, by ext x ; refl

/-! ## Concatenation of homotopies of sections

In this part of the file we build a concatenation operation for homotopies of 1-jet sections.
We first need to introduce a smooth step function on `ℝ`. There is already a version
of this in mathlib called `smooth_transition` but that version is not locally constant
near `0` and `1`, which is not convenient enough for gluing purposes.
-/

/-- A smooth step function on `ℝ`. -/
def smooth_step : ℝ → ℝ := λ t, smooth_transition (2 * t - 1/2)

lemma smooth_step.smooth : 𝒞 ∞ smooth_step :=
smooth_transition.cont_diff.comp $ (cont_diff_id.const_smul (2 : ℝ)).sub cont_diff_const

@[simp]
lemma smooth_step.zero : smooth_step 0 = 0 :=
begin
  apply smooth_transition.zero_of_nonpos,
  norm_num
end

@[simp]
lemma smooth_step.one : smooth_step 1 = 1 :=
begin
  apply smooth_transition.one_of_one_le,
  norm_num
end

lemma smooth_step.mem (t : ℝ) : smooth_step t ∈ I :=
⟨smooth_transition.nonneg _, smooth_transition.le_one _⟩

lemma smooth_step.abs_le (t : ℝ) : |smooth_step t| ≤ 1 :=
abs_le.mpr ⟨by linarith [(smooth_step.mem t).1], smooth_transition.le_one _⟩

lemma smooth_step.of_lt {t : ℝ} (h : t < 1/4) : smooth_step t = 0 :=
begin
  apply smooth_transition.zero_of_nonpos,
  linarith
end

-- unused
lemma smooth_step.pos_of_gt {t : ℝ} (h : 1/4 < t) : 0 < smooth_step t :=
begin
  apply smooth_transition.pos_of_pos,
  linarith
end

lemma smooth_step.of_gt {t : ℝ} (h : 3/4 < t) : smooth_step t = 1 :=
begin
  apply smooth_transition.one_of_one_le,
  linarith
end

lemma htpy_jet_sec_comp_aux {f g : ℝ → E → F} (hf : 𝒞 ∞ ↿f) (hg : 𝒞 ∞ ↿g)
  (hfg : f 1 = g 0) :
  𝒞 ∞ ↿(λ t x, if t ≤ 1/2 then f (smooth_step $ 2*t) x else g (smooth_step $ 2*t - 1) x : ℝ → E → F) :=
begin
  have s₁ : 𝒞 ∞ (λ p : ℝ × E, (smooth_step $ 2*p.1, p.2)),
  { change 𝒞 ∞ ((prod.map smooth_step id) ∘ (λ p : ℝ × E, (2*p.1, p.2))),
    apply (smooth_step.smooth.prod_map cont_diff_id).comp,
    apply cont_diff.prod,
    apply cont_diff_const.mul cont_diff_fst,
    apply cont_diff_snd },
  replace hf := hf.comp s₁,
  have s₂ : 𝒞 ∞ (λ p : ℝ × E, (smooth_step $ 2*p.1 - 1, p.2)),
  { change 𝒞 ∞ ((prod.map smooth_step id) ∘ (λ p : ℝ × E, (2*p.1 - 1, p.2))),
    apply (smooth_step.smooth.prod_map cont_diff_id).comp,
    apply cont_diff.prod,
    apply cont_diff.sub,
    apply cont_diff_const.mul cont_diff_fst,
    apply cont_diff_const,
    apply cont_diff_snd },
  replace hg := hg.comp s₂,
  rw cont_diff_iff_cont_diff_at at *,
  rintros ⟨t₀ , x₀⟩,
  rcases lt_trichotomy t₀ (1/2) with ht|rfl|ht,
  { apply (hf (t₀, x₀)).congr_of_eventually_eq,
    have : (Iio (1/2) : set ℝ) ×ˢ univ ∈ 𝓝 (t₀, x₀),
      from prod_mem_nhds_iff.mpr ⟨Iio_mem_nhds ht, univ_mem⟩,
    filter_upwards [this] with p hp,
    cases p with t x,
    replace hp : t < 1/2 := (prod_mk_mem_set_prod_eq.mp hp).1,
    change ite (t ≤ 1 / 2) (f (smooth_step (2 * t)) x) (g (smooth_step (2 * t - 1)) x) = _,
    rw if_pos hp.le,
    refl },
  { apply (hf (1/2, x₀)).congr_of_eventually_eq,
    have : (Ioo (3/8) (5/8) : set ℝ) ×ˢ univ ∈ 𝓝 (1/(2 : ℝ), x₀),
    { refine prod_mem_nhds_iff.mpr ⟨Ioo_mem_nhds _ _, univ_mem⟩ ; norm_num },
    filter_upwards [this] with p hp,
    cases p with t x,
    cases (prod_mk_mem_set_prod_eq.mp hp).1 with lt_t t_lt,
    change ite (t ≤ 1 / 2) (f (smooth_step (2 * t)) x) (g (smooth_step (2 * t - 1)) x) = _,
    split_ifs,
    { refl },
    { change g _ x = f (smooth_step $ 2*t) x,
      apply congr_fun,
      rw [show smooth_step (2 * t - 1) = 0, by { apply smooth_step.of_lt, linarith },
          show smooth_step (2 * t) = 1, by { apply smooth_step.of_gt, linarith }, hfg] }, },
  { apply (hg (t₀, x₀)).congr_of_eventually_eq,
    have : (Ioi (1/2) : set ℝ) ×ˢ univ ∈ 𝓝 (t₀, x₀),
      from prod_mem_nhds_iff.mpr ⟨Ioi_mem_nhds ht, univ_mem⟩,
    filter_upwards [this] with p hp,
    cases p with t x,
    replace hp : ¬ (t ≤ 1/2) := by push_neg ; exact (prod_mk_mem_set_prod_eq.mp hp).1,
    change ite (t ≤ 1 / 2) (f (smooth_step (2 * t)) x) (g (smooth_step (2 * t - 1)) x) = _,
    rw if_neg hp,
    refl }
end

/-- Concatenation of homotopies of formal solution. The result depend on our choice of
a smooth step function in order to keep smoothness with respect to the time parameter. -/
def htpy_jet_sec.comp (𝓕 𝓖 : htpy_jet_sec E F) (h : 𝓕 1 = 𝓖 0) : htpy_jet_sec E F :=
{ f := λ t x, if t ≤ 1/2 then 𝓕.f (smooth_step $ 2*t) x else 𝓖.f (smooth_step $ 2*t - 1) x,
  f_diff :=
  htpy_jet_sec_comp_aux 𝓕.f_diff 𝓖.f_diff (show (𝓕 1).f = (𝓖 0).f, by rw h),
  φ := λ t x, if t ≤ 1/2 then 𝓕.φ (smooth_step $ 2*t) x else  𝓖.φ (smooth_step $ 2*t - 1) x,
  φ_diff :=
  htpy_jet_sec_comp_aux 𝓕.φ_diff 𝓖.φ_diff (show (𝓕 1).φ = (𝓖 0).φ, by rw h) }

@[simp]
lemma htpy_jet_sec.comp_of_le (𝓕 𝓖 : htpy_jet_sec E F) (h) {t : ℝ} (ht : t ≤ 1/2) :
  𝓕.comp 𝓖 h t = 𝓕 (smooth_step $ 2*t) :=
begin
  dsimp [htpy_jet_sec.comp],
  ext x,
  change (if t ≤ 1/2 then _ else  _) = _,
  rw if_pos ht,
  refl,
  ext1 x,
  change (if t ≤ 1 / 2 then _ else _) = (𝓕 _).φ x,
  rw if_pos ht,
  refl
end

lemma htpy_jet_sec.comp_le_0 (𝓕 𝓖 : htpy_jet_sec E F) (h) : ∀ᶠ t near Iic 0, 𝓕.comp 𝓖 h t = 𝓕 0 :=
begin
  have : Iio (1/8 : ℝ) ∈ 𝓝ˢ (Iic (0 : ℝ)),
  { apply mem_nhds_set_iff_forall.mpr (λ (x : ℝ) (hx : x ≤ 0), Iio_mem_nhds _),
    linarith },
  apply mem_of_superset this,
  rintros t (ht : t <1/8),
  have ht' : t ≤ 1/2,
  { linarith },
  change 𝓕.comp 𝓖 h t = 𝓕 0,
  rw htpy_jet_sec.comp_of_le _ _ h ht',
  have ht'' : 2*t < 1/4,
  { linarith },
  rw smooth_step.of_lt ht''
end

-- unused
@[simp]
lemma htpy_jet_sec.comp_0 (𝓕 𝓖 : htpy_jet_sec E F) (h) : 𝓕.comp 𝓖 h 0 = 𝓕 0 :=
(𝓕.comp_le_0 𝓖 h).on_set 0 right_mem_Iic

@[simp]
lemma htpy_jet_sec.comp_of_not_le (𝓕 𝓖 : htpy_jet_sec E F) (h) {t : ℝ} (ht : ¬ t ≤ 1/2) :
  𝓕.comp 𝓖 h t = 𝓖 (smooth_step $ 2*t - 1) :=
begin
  dsimp [htpy_jet_sec.comp],
  ext x,
  change (if t ≤ 1/2 then _ else  _) = _,
  rw if_neg ht,
  refl,
  ext1 x,
  change (if t ≤ 1 / 2 then _ else _) = (𝓖 _).φ x,
  rw if_neg ht,
  refl
end

lemma htpy_jet_sec.comp_ge_1 (𝓕 𝓖 : htpy_jet_sec E F) (h) : ∀ᶠ t near Ici 1, 𝓕.comp 𝓖 h t = 𝓖 1 :=
begin
  have : Ioi (7/8 : ℝ) ∈ 𝓝ˢ (Ici (1 : ℝ)),
  { apply mem_nhds_set_iff_forall.mpr (λ (x : ℝ) (hx : 1 ≤ x), Ioi_mem_nhds _),
    linarith },
  apply mem_of_superset this,
  rintros t (ht : 7/8 < t),
  have ht' : ¬ t ≤ 1/2,
  { linarith },
  change 𝓕.comp 𝓖 h t = 𝓖 1,
  rw htpy_jet_sec.comp_of_not_le _ _ h ht',
  have ht'' : 3/4 < 2*t - 1,
  { linarith },
  rw smooth_step.of_gt ht''
end

@[simp]
lemma htpy_jet_sec.comp_1 (𝓕 𝓖 : htpy_jet_sec E F) (h) : 𝓕.comp 𝓖 h 1 = 𝓖 1 :=
(𝓕.comp_ge_1 𝓖 h).on_set 1 left_mem_Ici

end htpy_jet_sec


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel, Scott Morrison
-/
import category_theory.limits.shapes.zero
import category_theory.limits.shapes.kernels
import category_theory.abelian.basic

/-!
# Simple objects

We define simple objects in any category with zero morphisms.
A simple object is an object `Y` such that any monomorphism `f : X ⟶ Y`
is either an isomorphism or zero (but not both).

This is formalized as a `Prop` valued typeclass `simple X`.

If a morphism `f` out of a simple object is nonzero and has a kernel, then that kernel is zero.
(We state this as `kernel.ι f = 0`, but should add `kernel f ≅ 0`.)

When the category is abelian, being simple is the same as being cosimple (although we do not
state a separate typeclass for this).
As a consequence, any nonzero epimorphism out of a simple object is an isomorphism,
and any nonzero morphism into a simple object has trivial cokernel.
-/

noncomputable theory

open category_theory.limits

namespace category_theory

universes v u
variables {C : Type u} [category.{v} C]

section
variables [has_zero_morphisms C]

/-- An object is simple if monomorphisms into it are (exclusively) either isomorphisms or zero. -/
class simple (X : C) : Prop :=
(mono_is_iso_iff_nonzero : ∀ {Y : C} (f : Y ⟶ X) [mono f], is_iso f ↔ (f ≠ 0))

/-- A nonzero monomorphism to a simple object is an isomorphism. -/
lemma is_iso_of_mono_of_nonzero {X Y : C} [simple Y] {f : X ⟶ Y} [mono f] (w : f ≠ 0) :
  is_iso f :=
(simple.mono_is_iso_iff_nonzero f).mpr w

lemma kernel_zero_of_nonzero_from_simple
  {X Y : C} [simple X] {f : X ⟶ Y} [has_kernel f] (w : f ≠ 0) :
  kernel.ι f = 0 :=
begin
  classical,
  by_contradiction h,
  haveI := is_iso_of_mono_of_nonzero h,
  exact w (eq_zero_of_epi_kernel f),
end

lemma mono_to_simple_zero_of_not_iso
  {X Y : C} [simple Y] {f : X ⟶ Y} [mono f] (w : is_iso f → false) : f = 0 :=
begin
  classical,
  by_contradiction h,
  apply w,
  exact is_iso_of_mono_of_nonzero h,
end

lemma id_nonzero (X : C) [simple.{v} X] : 𝟙 X ≠ 0 :=
(simple.mono_is_iso_iff_nonzero (𝟙 X)).mp (by apply_instance)

instance (X : C) [simple.{v} X] : nontrivial (End X) :=
nontrivial_of_ne 1 0 (id_nonzero X)

section
variable [has_zero_object C]
local attribute [instance] has_zero_object.has_zero

/-- We don't want the definition of 'simple' to include the zero object, so we check that here. -/
lemma zero_not_simple [simple (0 : C)] : false :=
(simple.mono_is_iso_iff_nonzero (0 : (0 : C) ⟶ (0 : C))).mp ⟨⟨0, by tidy⟩⟩ rfl

end
end

-- We next make the dual arguments, but for this we must be in an abelian category.
section abelian
variables [abelian C]

/-- In an abelian category, an object satisfying the dual of the definition of a simple object is
    simple. -/
lemma simple_of_cosimple (X : C) (h : ∀ {Z : C} (f : X ⟶ Z) [epi f], is_iso f ↔ (f ≠ 0)) :
  simple X :=
⟨λ Y f I,
 begin
  classical,
  fsplit,
  { introsI,
    have hx := cokernel.π_of_epi f,
    by_contradiction h,
    push_neg at h,
    substI h,
    exact (h _).mp (cokernel.π_of_zero _ _) hx },
  { intro hf,
    suffices : epi f,
    { resetI, apply abelian.is_iso_of_mono_of_epi },
    apply preadditive.epi_of_cokernel_zero,
    by_contradiction h',
    exact cokernel_not_iso_of_nonzero hf ((h _).mpr h') }
 end⟩

/-- A nonzero epimorphism from a simple object is an isomorphism. -/
lemma is_iso_of_epi_of_nonzero {X Y : C} [simple X] {f : X ⟶ Y} [epi f] (w : f ≠ 0) :
  is_iso f :=
begin
  -- `f ≠ 0` means that `kernel.ι f` is not an iso, and hence zero, and hence `f` is a mono.
  haveI : mono f :=
    preadditive.mono_of_kernel_zero (mono_to_simple_zero_of_not_iso (kernel_not_iso_of_nonzero w)),
  exact abelian.is_iso_of_mono_of_epi f,
end

lemma cokernel_zero_of_nonzero_to_simple
  {X Y : C} [simple Y] {f : X ⟶ Y} [has_cokernel f] (w : f ≠ 0) :
  cokernel.π f = 0 :=
begin
  classical,
  by_contradiction h,
  haveI := is_iso_of_epi_of_nonzero h,
  exact w (eq_zero_of_mono_cokernel f),
end

lemma epi_from_simple_zero_of_not_iso
  {X Y : C} [simple X] {f : X ⟶ Y} [epi f] (w : is_iso f → false) : f = 0 :=
begin
  classical,
  by_contradiction h,
  apply w,
  exact is_iso_of_epi_of_nonzero h,
end

end abelian

end category_theory


import Monads.Functor
import Monads.Applicative
import Monads.Monad

namespace Monads
  inductive List (α : Type u) where
  | nil : List α
  | cons : α → List α → List α
    deriving Repr

  namespace List
    section Functor
      def map {α β : Type u} : (α → β) → (List α) → (List β)
      | f, nil => nil
      | f, (cons x xs) => cons (f x) (map f xs)

      #eval map (Nat.add 2) (cons 1 (cons 2 nil))

      theorem map_nil (f : α → β) : map f nil = nil := by rfl
      theorem map_cons (f : α → β) (x : α) (xs : List α) : map f (cons x xs) = cons (f x) (map f xs) := by rfl
      theorem map_id_eq_id {xs : List α} : map id xs = xs := by
        induction xs with
        | nil =>
          rw [map_nil]
        | cons x xs ih =>
          rw [map_cons]
          rw [ih]
          rw [id_eq]

      instance : Functor List where
        fmap := map

      theorem fmap_def (f : α → β) (xs : List α) : f <$> xs = map f xs := by rfl

      instance : LawfulFunctor List where
        fmap_id := by
          intro α xs
          induction xs with
          | nil =>
            rw [fmap_def, map_nil]
          | cons y ys ih =>
            rw [fmap_def, map_cons]
            rw [id_eq]
            rw [←fmap_def]
            rw [ih]
        fmap_comp := by
          intro α β γ g h xs
          induction xs with
          | nil =>
            rw [fmap_def, map_nil]
            rw [fmap_def g nil, map_nil]
            rw [fmap_def, map_nil]
          | cons y ys ih =>
            rw [fmap_def, map_cons]
            rw [fmap_def g, map_cons]
            rw [fmap_def, map_cons]
            rw [←fmap_def, ←fmap_def, ←fmap_def]
            rw [ih]
         map_const_behaved := by
           -- Still the default definition so the proof is automated
           intro α β x y
           simp only [Functor.map_const, Functor.fmap]
    end Functor

    section Applicative
      def append : List α → List α → List α
      | nil, ys => ys
      | (cons x xs), ys => cons x (append xs ys)

      instance {α : Type u} : Append (List α) where
        append := append

      #eval (cons 1 (cons 2 nil)) ++ (cons 3 (cons 4 nil))

      theorem nil_append (ys : List α) : nil ++ ys = ys := by rfl
      theorem cons_append (x : α) (xs : List α) (ys : List α) : (cons x xs) ++ ys = (cons x (xs ++ ys)) := by rfl
      theorem append_nil (xs : List α) : xs ++ nil = xs := by
        induction xs with
        | nil => rfl
        | cons x xs ih =>
          rw [cons_append]
          rw [ih]

      theorem append_assoc {xs ys zs : List α} : xs ++ ys ++ zs = xs ++ (ys ++ zs) := by
        induction xs with
        | nil =>
          rw [nil_append]
          rw [nil_append]
        | cons x xs ih =>
          rw [cons_append]
          rw [cons_append]
          rw [cons_append]
          rw [ih]

      theorem append_eq_of_suffix (as bs cs : List α) : (as = bs)  → (as ++ cs = bs ++ cs) := by
        intro h
        rw [h]

      def apply { α β : Type u} : List (α → β) → List α → List β
      | (cons f fs), xs => (f <$> xs) ++ (apply fs xs)
      | _, _ => nil

      instance : Applicative List where
        pure := λ x => (cons x nil)
        apply := apply

      theorem pure_def (x : α) : pure x = (cons x nil) := by rfl
      theorem apply_def {α β : Type u} (fs : List (α → β)) (xs : List α) : fs <*> xs = apply fs xs := by rfl
      theorem cons_apply {α β : Type u} (f : α → β) (fs : List (α → β)) (xs : List α) : (cons f fs) <*> xs = (f <$> xs) ++ (fs <*> xs) := by rfl
      theorem apply_nil {α β : Type u} (fs : List (α → β)) : fs <*> nil = nil := by
        induction fs with
        | nil => rfl
        | cons f fs ih =>
          rw [cons_apply]
          rw [ih]
          rw [append_nil]
          rw [fmap_def, map_nil]

      theorem nil_apply {α β: Type u} (xs : List α) : @nil (α → β) <*> xs = nil := by rfl

      #eval Nat.add <$> (cons 1 (cons 2 nil)) <*> (cons 3 (cons 4 nil))

      instance : LawfulApplicative List where
        apply_id := by
          intro α x
          rw [pure_def]
          rw [cons_apply]
          rw [nil_apply]
          rw [append_nil]
          rw [fmap_def, map_id_eq_id]
        apply_homomorphism := by
          intro α β x g
          rw [pure_def, pure_def, pure_def]
          rw [cons_apply]
          rw [nil_apply]
          rw [append_nil]
          rw [fmap_def, map_cons]
          rw [map_nil]
        apply_interchange := by
          intro α β x g
          rw [pure_def, pure_def]
          rw [cons_apply]
          rw [nil_apply]
          rw [append_nil]
          induction g with
          | nil =>
            rw [nil_apply]
            rw [fmap_def, map_nil]
          | cons g gs ih =>
            rw [cons_apply]
            rw [fmap_def, map_cons]
            rw [map_nil]
            rw [fmap_def, map_cons]
            rw [cons_append]
            rw [nil_append]
            rw [←fmap_def]
            rw [ih]
        apply_comp := sorry
        lifta2_behaved := by
          -- Definition wasn't changed -> auto proof
          intro α β γ g x y
          simp only [Applicative.liftA2, Applicative.apply]
        seq_right_behaved := by
          -- Definition wasn't changed -> auto proof
          intro α β a1 a2
          simp only [Applicative.seq_right, Applicative.apply]
        seq_left_behaved := by
          -- Definition wasn't changed -> auto proof
          intro α β a1 a2
          simp only [Applicative.seq_left, Applicative.liftA2]
        fmap_eq_pure_apply := by
          intro α β g x
          rw [pure_def]
          rw [cons_apply]
          rw [nil_apply]
          rw [append_nil]
    end Applicative

    section Monad
      def flatten : List (List α) → List α
      | nil => nil
      | (cons xs xss) => xs ++ flatten xss

      theorem flatten_nil : flatten nil = @nil α := by rfl
      theorem flatten_cons (xs : List α) (xss : List (List α)) : flatten (cons xs xss) = xs ++ flatten xss := by rfl

      def flat_map : List α → (α → List β) → List β
      | xs, f => flatten $ map f xs

      theorem flat_map_def (xs : List α) (f : α → List β) : flat_map xs f = (flatten $ map f xs) := by rfl
      theorem flat_map_nil (f : α → List β) : flat_map nil f = nil := by rfl
      theorem flat_map_cons (x : α) (xs : List α) (f : α → List β) : flat_map (cons x xs) f = (f x) ++ flat_map xs f := by
        rw [flat_map_def]
        rw [map_cons]
        rw [flatten_cons]
        rw [←flat_map_def]

      theorem flat_map_distrib_append {xs ys : List α} {f : α → List β} : flat_map (xs ++ ys) f = flat_map xs f ++ flat_map ys f := by
        induction xs with
        | nil =>
          rw [nil_append]
          rw [flat_map_nil]
          rw [nil_append]
        | cons x xs ih =>
          rw [cons_append]
          rw [flat_map_cons]
          rw [flat_map_cons]
          rw [ih]
          rw [append_assoc]
      theorem map_eq_constant_flat_map {α β : Type u} (f : α → β) (as : List α) : (map f as) = (flat_map as fun a => cons (f a) nil) := by
        induction as with
        | nil =>
          rw [map_nil]
          rw [flat_map_nil]
        | cons a as ih =>
          rw [map_cons]
          rw [flat_map_cons]
          rw [cons_append]
          rw [nil_append]
          rw [ih]

      instance : Monad List where
        ret := λ x => (cons x nil)
        bind := flat_map

      theorem ret_def (x : α) : ret x = cons x nil := by rfl
      theorem bind_def (xs : List α) (f : α → List β) : xs >>= f = flat_map xs f := by rfl

      #eval (cons 1 (cons 2 nil)) >>= (λ x => (cons x (cons x nil)))

      instance : LawfulMonad List where
        ret_left_id := by
          intro α β a h
          rw [ret_def]
          rw [bind_def, flat_map_def]
          rw [map_cons]
          rw [map_nil]
          rw [flatten_cons]
          rw [flatten_nil, append_nil]
        ret_right_id := by
          intro α as
          rw [bind_def]
          induction as with
          | nil =>
            rw [flat_map_nil]
          | cons a as ih =>
            rw [flat_map_cons]
            rw [ih]
            rw [ret_def]
            rw [cons_append]
            rw [nil_append]
        bind_assoc := by
          intro α β γ as g h
          induction as with
          | nil =>
            rw [bind_def nil, flat_map_nil]
            rw [bind_def nil, flat_map_nil]
            rw [bind_def nil, flat_map_nil]
          | cons x xs ih =>
            rw [bind_def (cons x xs), flat_map_cons]
            rw [bind_def (cons x xs), flat_map_cons]
            rw [←bind_def]
            rw [←bind_def]
            rw [←ih]
            rw [bind_def _ h]
            rw [flat_map_distrib_append]
            rw [←bind_def]
            rw [←bind_def]
        pure_behaved := by
          intro α a
          rw [pure_def, ret_def]
        apply_behaved := by
          intro α β mf ma
          induction mf with
          | nil =>
            rw [nil_apply]
            rw [bind_def, flat_map_nil]
          | cons f fs fih =>
            rw [cons_apply]
            rw [bind_def, flat_map_cons]
            rw [←bind_def]
            induction ma with
            | nil =>
              rw [fmap_def, map_nil]
              rw [nil_append]
              rw [apply_nil]
              rw [bind_def, flat_map_nil]
              rw [nil_append]
              rw [←fih]
              rw [apply_nil]
            | cons a as aih =>
              rw [←fih]
              rw [bind_def, flat_map_cons]
              rw [ret_def]
              rw [cons_append]
              rw [nil_append]
              rw [fmap_def, map_cons]
              rw [map_eq_constant_flat_map]
              -- we have to rewrite inside a function which is easier with simp only
              simp only [ret_def]
        and_then_behaved := by
          intro α β a1 a2
          simp only [Monad.and_then, Applicative.seq_right]
          induction a1 with
          | nil =>
            simp only [Functor.map_const]
            simp only [Function.comp]
            rw [map_nil]
            rw [←apply_def, nil_apply]
            rw [flat_map_nil]
          | cons x xs xih =>
            rw [flat_map_cons]
            simp only [Function.const]
            simp only [Functor.map_const]
            simp only [Function.comp]
            rw [map_cons]
            simp only [Function.const]
            rw [←apply_def, cons_apply]
            rw [fmap_def, map_id_eq_id]
            rw [←xih]
            simp only [Functor.map_const]
            simp only [Function.comp]
            simp only [Function.const]
            rw [←apply_def]
    end Monad
  end List
end Monads


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import algebra.group.inj_surj
import algebra.group_with_zero.defs

/-!
# Lifting groups with zero along injective/surjective maps

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

open function

variables {M₀ G₀ M₀' G₀' : Type*}

section mul_zero_class

variables [mul_zero_class M₀] {a b : M₀}

/-- Pullback a `mul_zero_class` instance along an injective function.
See note [reducible non-instances]. -/
@[reducible]
protected def function.injective.mul_zero_class [has_mul M₀'] [has_zero M₀'] (f : M₀' → M₀)
  (hf : injective f) (zero : f 0 = 0) (mul : ∀ a b, f (a * b) = f a * f b) :
  mul_zero_class M₀' :=
{ mul := (*),
  zero := 0,
  zero_mul := λ a, hf $ by simp only [mul, zero, zero_mul],
  mul_zero := λ a, hf $ by simp only [mul, zero, mul_zero] }

/-- Pushforward a `mul_zero_class` instance along an surjective function.
See note [reducible non-instances]. -/
@[reducible]
protected def function.surjective.mul_zero_class [has_mul M₀'] [has_zero M₀'] (f : M₀ → M₀')
  (hf : surjective f) (zero : f 0 = 0) (mul : ∀ a b, f (a * b) = f a * f b) :
  mul_zero_class M₀' :=
{ mul := (*),
  zero := 0,
  mul_zero := hf.forall.2 $ λ x, by simp only [← zero, ← mul, mul_zero],
  zero_mul := hf.forall.2 $ λ x, by simp only [← zero, ← mul, zero_mul] }

end mul_zero_class

section no_zero_divisors

/-- Pushforward a `no_zero_divisors` instance along an injective function. -/
protected lemma function.injective.no_zero_divisors [has_mul M₀] [has_zero M₀]
  [has_mul M₀'] [has_zero M₀'] [no_zero_divisors M₀']
  (f : M₀ → M₀') (hf : injective f) (zero : f 0 = 0) (mul : ∀ x y, f (x * y) = f x * f y) :
  no_zero_divisors M₀ :=
{ eq_zero_or_eq_zero_of_mul_eq_zero := λ x y H,
  have f x * f y = 0, by rw [← mul, H, zero],
  (eq_zero_or_eq_zero_of_mul_eq_zero this).imp (λ H, hf $ by rwa zero)  (λ H, hf $ by rwa zero) }

end no_zero_divisors

section mul_zero_one_class

variables [mul_zero_one_class M₀]

/-- Pullback a `mul_zero_one_class` instance along an injective function.
See note [reducible non-instances]. -/
@[reducible]
protected def function.injective.mul_zero_one_class [has_mul M₀'] [has_zero M₀'] [has_one M₀']
  (f : M₀' → M₀)
  (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1) (mul : ∀ a b, f (a * b) = f a * f b) :
  mul_zero_one_class M₀' :=
{ ..hf.mul_zero_class f zero mul, ..hf.mul_one_class f one mul }

/-- Pushforward a `mul_zero_one_class` instance along an surjective function.
See note [reducible non-instances]. -/
@[reducible]
protected def function.surjective.mul_zero_one_class [has_mul M₀'] [has_zero M₀'] [has_one M₀']
  (f : M₀ → M₀')
  (hf : surjective f) (zero : f 0 = 0) (one : f 1 = 1) (mul : ∀ a b, f (a * b) = f a * f b) :
  mul_zero_one_class M₀' :=
{ ..hf.mul_zero_class f zero mul, ..hf.mul_one_class f one mul }

end mul_zero_one_class

section semigroup_with_zero

/-- Pullback a `semigroup_with_zero` class along an injective function.
See note [reducible non-instances]. -/
@[reducible]
protected def function.injective.semigroup_with_zero
  [has_zero M₀'] [has_mul M₀'] [semigroup_with_zero M₀] (f : M₀' → M₀) (hf : injective f)
  (zero : f 0 = 0) (mul : ∀ x y, f (x * y) = f x * f y) :
  semigroup_with_zero M₀' :=
{ .. hf.mul_zero_class f zero mul,
  .. ‹has_zero M₀'›,
  .. hf.semigroup f mul }

/-- Pushforward a `semigroup_with_zero` class along an surjective function.
See note [reducible non-instances]. -/
@[reducible]
protected def function.surjective.semigroup_with_zero
  [semigroup_with_zero M₀] [has_zero M₀'] [has_mul M₀'] (f : M₀ → M₀') (hf : surjective f)
  (zero : f 0 = 0) (mul : ∀ x y, f (x * y) = f x * f y) :
  semigroup_with_zero M₀' :=
{ .. hf.mul_zero_class f zero mul,
  .. ‹has_zero M₀'›,
  .. hf.semigroup f mul }

end semigroup_with_zero

section monoid_with_zero

/-- Pullback a `monoid_with_zero` class along an injective function.
See note [reducible non-instances]. -/
@[reducible]
protected def function.injective.monoid_with_zero [has_zero M₀'] [has_mul M₀'] [has_one M₀']
  [has_pow M₀' ℕ] [monoid_with_zero M₀]
  (f : M₀' → M₀) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1)
  (mul : ∀ x y, f (x * y) = f x * f y) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) :
  monoid_with_zero M₀' :=
{ .. hf.monoid f one mul npow, .. hf.mul_zero_class f zero mul }

/-- Pushforward a `monoid_with_zero` class along a surjective function.
See note [reducible non-instances]. -/
@[reducible]
protected def function.surjective.monoid_with_zero [has_zero M₀'] [has_mul M₀'] [has_one M₀']
  [has_pow M₀' ℕ] [monoid_with_zero M₀]
  (f : M₀ → M₀') (hf : surjective f) (zero : f 0 = 0) (one : f 1 = 1)
  (mul : ∀ x y, f (x * y) = f x * f y) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) :
  monoid_with_zero M₀' :=
{ .. hf.monoid f one mul npow, .. hf.mul_zero_class f zero mul }

/-- Pullback a `monoid_with_zero` class along an injective function.
See note [reducible non-instances]. -/
@[reducible]
protected def function.injective.comm_monoid_with_zero [has_zero M₀'] [has_mul M₀'] [has_one M₀']
  [has_pow M₀' ℕ] [comm_monoid_with_zero M₀]
  (f : M₀' → M₀) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1)
  (mul : ∀ x y, f (x * y) = f x * f y) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) :
  comm_monoid_with_zero M₀' :=
{ .. hf.comm_monoid f one mul npow, .. hf.mul_zero_class f zero mul }

/-- Pushforward a `monoid_with_zero` class along a surjective function.
See note [reducible non-instances]. -/
@[reducible]
protected def function.surjective.comm_monoid_with_zero [has_zero M₀'] [has_mul M₀'] [has_one M₀']
  [has_pow M₀' ℕ] [comm_monoid_with_zero M₀]
  (f : M₀ → M₀') (hf : surjective f) (zero : f 0 = 0) (one : f 1 = 1)
  (mul : ∀ x y, f (x * y) = f x * f y) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) :
  comm_monoid_with_zero M₀' :=
{ .. hf.comm_monoid f one mul npow, .. hf.mul_zero_class f zero mul }

end monoid_with_zero

section cancel_monoid_with_zero

variables [cancel_monoid_with_zero M₀] {a b c : M₀}

/-- Pullback a `monoid_with_zero` class along an injective function.
See note [reducible non-instances]. -/
@[reducible]
protected def function.injective.cancel_monoid_with_zero [has_zero M₀'] [has_mul M₀'] [has_one M₀']
  [has_pow M₀' ℕ] (f : M₀' → M₀) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1)
  (mul : ∀ x y, f (x * y) = f x * f y) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) :
  cancel_monoid_with_zero M₀' :=
{ mul_left_cancel_of_ne_zero := λ x y z hx H, hf $ mul_left_cancel₀ ((hf.ne_iff' zero).2 hx) $
    by erw [← mul, ← mul, H]; refl,
  mul_right_cancel_of_ne_zero := λ x y z hx H, hf $ mul_right_cancel₀ ((hf.ne_iff' zero).2 hx) $
    by erw [← mul, ← mul, H]; refl,
  .. hf.monoid f one mul npow, .. hf.mul_zero_class f zero mul }

end cancel_monoid_with_zero

section cancel_comm_monoid_with_zero

variables [cancel_comm_monoid_with_zero M₀] {a b c : M₀}

/-- Pullback a `cancel_comm_monoid_with_zero` class along an injective function.
See note [reducible non-instances]. -/
@[reducible]
protected def function.injective.cancel_comm_monoid_with_zero
  [has_zero M₀'] [has_mul M₀'] [has_one M₀'] [has_pow M₀' ℕ]
  (f : M₀' → M₀) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1)
  (mul : ∀ x y, f (x * y) = f x * f y) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) :
  cancel_comm_monoid_with_zero M₀' :=
{ .. hf.comm_monoid_with_zero f zero one mul npow,
  .. hf.cancel_monoid_with_zero f zero one mul npow }

end cancel_comm_monoid_with_zero

section group_with_zero
variables [group_with_zero G₀] {a b c g h x : G₀}

/-- Pullback a `group_with_zero` class along an injective function.
See note [reducible non-instances]. -/
@[reducible]
protected def function.injective.group_with_zero [has_zero G₀'] [has_mul G₀'] [has_one G₀']
  [has_inv G₀'] [has_div G₀'] [has_pow G₀' ℕ] [has_pow G₀' ℤ]
  (f : G₀' → G₀) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1)
  (mul : ∀ x y, f (x * y) = f x * f y) (inv : ∀ x, f x⁻¹ = (f x)⁻¹)
  (div : ∀ x y, f (x / y) = f x / f y) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n)
  (zpow : ∀ x (n : ℤ), f (x ^ n) = f x ^ n) :
  group_with_zero G₀' :=
{ inv_zero := hf $ by erw [inv, zero, inv_zero],
  mul_inv_cancel := λ x hx, hf $ by erw [one, mul, inv, mul_inv_cancel ((hf.ne_iff' zero).2 hx)],
  .. hf.monoid_with_zero f zero one mul npow,
  .. hf.div_inv_monoid f one mul inv div npow zpow,
  .. pullback_nonzero f zero one, }

/-- Pushforward a `group_with_zero` class along an surjective function.
See note [reducible non-instances]. -/
@[reducible]
protected def function.surjective.group_with_zero [has_zero G₀'] [has_mul G₀'] [has_one G₀']
  [has_inv G₀'] [has_div G₀'] [has_pow G₀' ℕ] [has_pow G₀' ℤ]
  (h01 : (0:G₀') ≠ 1) (f : G₀ → G₀') (hf : surjective f)
  (zero : f 0 = 0) (one : f 1 = 1) (mul : ∀ x y, f (x * y) = f x * f y)
  (inv : ∀ x, f x⁻¹ = (f x)⁻¹) (div : ∀ x y, f (x / y) = f x / f y)
  (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) (zpow : ∀ x (n : ℤ), f (x ^ n) = f x ^ n):
  group_with_zero G₀' :=
{ inv_zero := by erw [← zero, ← inv, inv_zero],
  mul_inv_cancel := hf.forall.2 $ λ x hx,
    by erw [← inv, ← mul, mul_inv_cancel (mt (congr_arg f) $ trans_rel_left ne hx zero.symm)];
      exact one,
  exists_pair_ne := ⟨0, 1, h01⟩,
  .. hf.monoid_with_zero f zero one mul npow,
  .. hf.div_inv_monoid f one mul inv div npow zpow }

end group_with_zero

section comm_group_with_zero
variables [comm_group_with_zero G₀] {a b c d : G₀}

/-- Pullback a `comm_group_with_zero` class along an injective function.
See note [reducible non-instances]. -/
@[reducible]
protected def function.injective.comm_group_with_zero [has_zero G₀'] [has_mul G₀'] [has_one G₀']
  [has_inv G₀'] [has_div G₀'] [has_pow G₀' ℕ] [has_pow G₀' ℤ]
  (f : G₀' → G₀) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1)
  (mul : ∀ x y, f (x * y) = f x * f y) (inv : ∀ x, f x⁻¹ = (f x)⁻¹)
  (div : ∀ x y, f (x / y) = f x / f y) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n)
  (zpow : ∀ x (n : ℤ), f (x ^ n) = f x ^ n) :
  comm_group_with_zero G₀' :=
{ .. hf.group_with_zero f zero one mul inv div npow zpow, .. hf.comm_semigroup f mul }

/-- Pushforward a `comm_group_with_zero` class along a surjective function. -/
protected def function.surjective.comm_group_with_zero [has_zero G₀'] [has_mul G₀']
  [has_one G₀'] [has_inv G₀'] [has_div G₀'] [has_pow G₀' ℕ] [has_pow G₀' ℤ]
  (h01 : (0:G₀') ≠ 1) (f : G₀ → G₀') (hf : surjective f)
  (zero : f 0 = 0) (one : f 1 = 1) (mul : ∀ x y, f (x * y) = f x * f y) (inv : ∀ x, f x⁻¹ = (f x)⁻¹)
  (div : ∀ x y, f (x / y) = f x / f y) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n)
  (zpow : ∀ x (n : ℤ), f (x ^ n) = f x ^ n) :
  comm_group_with_zero G₀' :=
{ .. hf.group_with_zero h01 f zero one mul inv div npow zpow, .. hf.comm_semigroup f mul }

end comm_group_with_zero


import order.filter.basic

namespace filter

lemma eventually.choice {α β : Type*} {r : α → β → Prop} {l : filter α}
  [l.ne_bot] (h : ∀ᶠ x in l, ∃ y, r x y) : ∃ f : α → β, ∀ᶠ x in l, r x (f x) :=
begin
  classical,
  use (λ x, if hx : ∃ y, r x y then classical.some hx
            else classical.some (classical.some_spec h.exists)),
  filter_upwards [h],
  intros x hx,
  rw dif_pos hx,
  exact classical.some_spec hx
end

end filter


import topology.basic
import topology.compact_open
import data.nat.prime
import data.real.basic
import data.real.irrational
import data.complex.basic
import data.fin.basic
import geometry.euclidean.basic
import analysis.inner_product_space.pi_L2
import algebra.group.defs
import algebra.field.basic
import combinatorics.configuration
import ring_theory.polynomial.basic
import group_theory.free_group
import combinatorics.simple_graph.basic
import ring_theory.integral_closure
import data.fintype.card
import category_theory.category.basic
import ring_theory.discrete_valuation_ring
import group_theory.torsion
import linear_algebra.matrix.charpoly.basic
import algebra.order.absolute_value
import analysis.convex.basic
import topology.uniform_space.uniform_convergence_topology
import topology.sequences
import analysis.normed.group.infinite_sum
import data.nat.choose.sum
import group_theory.specific_groups.cyclic
import group_theory.order_of_element
import analysis.mean_inequalities
import analysis.normed_space.banach
import topology.algebra.continuous_monoid_hom
import linear_algebra.matrix.symmetric
import analysis.inner_product_space.spectrum
import ring_theory.class_group
import ring_theory.dedekind_domain.basic
import ring_theory.principal_ideal_domain
import model_theory.satisfiability
import probability.integration
import ring_theory.simple_module
import category_theory.preadditive.schur
import representation_theory.maschke
import topology.paracompact
import combinatorics.simple_graph.coloring
--Prove that Schur's lemma in Lean mathlib

--OUTPUT 1
theorem schur : Π {α : Type u} [fintype α] [decidable_eq α] [add_comm_group α] [vector_space ℂ α] (x y : α),
  x ≠ y → (x - y) ∈ span ℂ {x, y} :=
begin
  intros,
  have h1 : x - y = (1 : ℂ) * x + (-1 : ℂ) * y,
  {
    rw [←add_neg_self x, add_assoc, sub_eq_add_neg, add_comm],
  },
  rw h1,
  apply span_two_mem,
  intro,
  rw [h, zero_add, neg_zero, add_zero] at h1,
  exact h h1,

--OUTPUT 2
theorem schur (α : Type) [decidable_eq α] [fintype α] [fintype β] [decidable_eq β] (M : α → β → ℂ) :
  (∀ x : α, ∀ y : β, M x y = 0) → linear_map α β M = 0 := sorry

--Prove that Schur's lemma in Lean mathlib
theorem schur' (α : Type) [decidable_eq α] [fintype α] [fintype β] [decidable_eq β] (M : α → β → ℂ) :
  (∀ x : α, ∀ y : β, M x y = 0) → linear_map α β M = 0 := sorry

--Prove that Schur's lemma in Lean mathlib
theorem schur'' (α : Type) [decidable_eq α] [fintype α] [fintype β] [decidable_eq β] (M : α → β → ℂ) :
  (∀ x : α, ∀ y : β, M x y = 0) → linear_map α β M = 0 := sorry

--Prove that Schur's lemma in Lean mathlib
theorem schur''' (α : Type) [decidable_eq α] [fintype α] [fintype β] [decidable_eq β] (M : α → β → ℂ) :
  (∀ x : α, ∀ y : β, M x y = 0) → linear_map α β M = 0 := sorry

--Prove that Schur's lemma in Lean mathlib
theorem schur'''' (α : Type) [decidable_eq α] [fintype α] [fintype β] [decidable_eq β] (M : α → β → ℂ) :
  (∀ x : α, ∀ y : β, M x y = 0) → linear_map α β M = 0 := sorry

--Prove that Schur's lemma in Lean mathlib
theorem schur''''' (α : Type) [decidable_eq α] [fintype α] [fintype β] [decidable_eq β] (M : α → β → ℂ) :
  (∀ x : α, ∀ y : β, M x y = 0) → linear_map α β M = 0 := sorry

--Prove that Schur's lemma in Lean mathlib
theorem schur'''''' (α : Type) [decidable_eq α] [fintype α] [fintype β] [decidable_eq β] (M : α → β → ℂ) :
  (∀ x : α, ∀ y : β, M x y = 0) → linear_map α β M = 0 := sorry

--Prove that Schur's lemma in Lean mathlib
theorem schur''''''' (α : Type) [decidable_eq α] [fintype α] [fintype β] [decidable_eq β] (M : α → β → ℂ) :
  (∀ x : α, ∀ y : β, M x y = 0) → linear_map α β M = 0 := sorry

--Prove that Schur's lemma in Lean mathlib
theorem schur'''''''' (α : Type) [decidable_eq α] [fintype α] [fintype β] [decidable_eq β] (M : α → β → ℂ) :
  (∀ x : α, ∀ y : β, M x y = 0) → linear_map α β M = 0 := sorry

--Prove that Schur's lemma in Lean mathlib
theorem schur''''''''' (α : Type) [decidable_eq α] [fintype α] [fintype β] [decidable_eq β] (M : α → β → ℂ) :
  (∀ x : α, ∀ y : β, M x y = 0) → linear_map α β M = 0 := sorry

--Prove that Schur's lemma in Lean mathlib
theorem schur'''''''''' (α : Type) [decidable_eq α] [fintype α] [fintype β] [decidable_eq β] (M : α → β → ℂ) :
  (∀ x : α, ∀ y : β, M x y = 0) → linear_map α β M = 0 := sorry

--Prove that Schur's lemma in Lean mathlib
theorem schur''''''''''' (α : Type) [decidable_eq α] [fintype α] [fintype β] [decidable_eq β] (M : α → β → ℂ) :
  (∀ x : α, ∀ y : β, M x y = 0) → linear_map α β M = 0 := sorry

--Prove that Schur's lemma in Lean mathlib
theorem schur'''''''''''' (α : Type) [decidable_eq α] [fintype α] [fintype β] [decidable_eq β] (M : α → β → ℂ) :
  (∀ x : α, ∀ y : β, M x y = 0) → linear_map α β M = 0 := sorry

--Prove that Schur's lemma in Lean mathlib
theorem schur''''''''''''' (α : Type) [decidable_eq α] [fintype α] [fintype β] [decidable_eq β] (M : α → β → ℂ) :
  (∀ x : α, ∀ y : β, M x y = 0) → linear_map α β M = 0 := sorry

--Prove that Schur's lemma in Lean mathlib
theorem schur'''''''''''''' (α : Type) [decidable_eq α] [fintype α] [fintype β] [decidable_eq β] (M : α → β → ℂ) :
  (∀ x : α, ∀ y : β, M x y = 0) → linear_map α β M = 0 := sorry

--Prove that Schur's lemma in Lean mathlib
theorem schur''''''''''''''' (α : Type) [decidable_eq α] [fintype α] [fintype β] [decidable_eq β] (M : α → β → ℂ) :
  (∀ x : α, ∀ y : β, M x y = 0) → linear_map α β M = 0 := sorry

--Prove that Schur's lemma in Lean mathlib
theorem schur'''''''''''''''' (α : Type) [decidable_eq α] [fintype α] [fintype β] [decidable_eq β] (M : α → β → ℂ) :
  (∀ x : α, ∀ y : β, M x y = 0) → linear_map α β M = 0 := sorry

--Prove that Schur's lemma in Lean mathlib
theorem schur''''''''''''''''' (α : Type) [decidable_eq α] [fintype α] [fintype β] [decidable_eq β] (M : α → β → ℂ) :
  (∀ x : α, ∀ y : β, M x y = 0) → linear_map α β M = 0 := sorry

--Prove that Schur's lemma in Lean mathlib
theorem schur'''''''''''''''''' (α : Type) [decidable_eq α] [fintype α] [fintype β] [decidable_eq β] (M : α → β → ℂ) :
  (∀ x : α, ∀ y : β, M x y = 0) → linear_map α β M = 0 := sorry

--Prove that Schur's lemma in Lean mathlib
theorem schur''''''''''''''''''' (α : Type) [decidable_eq α] [fintype α] [fintype β] [decidable_eq β] (M : α → β → ℂ) :
  (∀ x : α, ∀ y : β, M x y = 0) → linear_map α β M = 0 := sorry

--Prove that Schur's lemma in Lean mathlib
theorem schur'''''''''''''''''''' (α : Type) [decidable_eq α] [fintype α] [fintype β] [decidable_eq β] (M

--OUTPUT 3
theorem schur_lemma (V : Type*) [add_comm_group V] [vector_space ℂ V] [finite_dimensional ℂ V] :
  ∀ (f : V → V) [is_linear_map f], is_linear_map f → is_linear_map f →
    (∀ v : V, f v = v) ∨ (∀ v : V, f v = -v) :=
begin
  intros f Hf Hf₁ Hf₂,
  let W := {v : V | f v = v},
  have HW : submodule ℂ W,
  { apply submodule.submodule_of_linear Hf,
    intros v hv,
    rw ← Hf₁,
    exact hv },
  have HW' : submodule ℂ (W.comap f),
  { apply submodule.comap_submodule,
    exact HW },
  have HW'₁ : W.comap f = ⊤,
  { apply submodule.ext,
    intros v, split,
    { intro hv,
      use v,
      rw ← Hf₂,
      exact hv },
    { intro hv,
      rcases hv with ⟨w, hw₁, hw₂⟩,
      rw hw₂,
      exact hw₁ } },
  have HW'₂ : W.comap f = ⊥,
  { apply submodule.ext,
    intros v, split,
    { intro hv,
      use -v,
      rw ← Hf₂,
      exact hv },
    { intro hv,
      rcases hv with ⟨w, hw₁, hw₂⟩,
      rw hw₂,
      exact hw₁ } },
  have HW₁ : W = ⊤,
  { apply submodule.ext,
    intros v, split,
    { intro hv,
      use v,
      exact hv },
    { intro hv,
      rcases hv with ⟨w, hw₁, hw₂⟩,
      rw hw₂,
      exact hw₁ } },
  have HW₂ : W = ⊥,
  { apply submodule.ext,
    intros v, split,
    { intro hv,
      use -v,
      exact hv },
    { intro hv,
      rcases hv with ⟨w, hw₁, hw₂⟩,
      rw hw₂,
      exact hw₁ } },
  have H : W = ⊤ ∨ W = ⊥,
  { apply submodule.eq_top_or_eq_bot,
    exact HW },
  cases H with H₁ H₂,
  { left,
    rw H₁,
    intro v,
    exact submodule.mem_top v },
  { right,
    rw H₂,
    intro v,
    exact submodule.mem_bot (-v) }


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Johannes Hölzl, Scott Morrison, Jens Wagemaker
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.polynomial.ring_division
import Mathlib.data.polynomial.derivative
import Mathlib.algebra.gcd_monoid
import Mathlib.PostPort

universes u y v u_1

namespace Mathlib

/-!
# Theory of univariate polynomials

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

-/

namespace polynomial

protected instance normalization_monoid {R : Type u} [integral_domain R] [normalization_monoid R] : normalization_monoid (polynomial R) :=
  normalization_monoid.mk
    (fun (p : polynomial R) =>
      units.mk (coe_fn C ↑(norm_unit (leading_coeff p))) (coe_fn C ↑(norm_unit (leading_coeff p)⁻¹)) sorry sorry)
    sorry sorry sorry

@[simp] theorem coe_norm_unit {R : Type u} [integral_domain R] [normalization_monoid R] {p : polynomial R} : ↑(norm_unit p) = coe_fn C ↑(norm_unit (leading_coeff p)) := sorry

theorem leading_coeff_normalize {R : Type u} [integral_domain R] [normalization_monoid R] (p : polynomial R) : leading_coeff (coe_fn normalize p) = coe_fn normalize (leading_coeff p) := sorry

theorem is_unit_iff_degree_eq_zero {R : Type u} [field R] {p : polynomial R} : is_unit p ↔ degree p = 0 := sorry

theorem degree_pos_of_ne_zero_of_nonunit {R : Type u} [field R] {p : polynomial R} (hp0 : p ≠ 0) (hp : ¬is_unit p) : 0 < degree p := sorry

theorem monic_mul_leading_coeff_inv {R : Type u} [field R] {p : polynomial R} (h : p ≠ 0) : monic (p * coe_fn C (leading_coeff p⁻¹)) := sorry

theorem degree_mul_leading_coeff_inv {R : Type u} [field R] {q : polynomial R} (p : polynomial R) (h : q ≠ 0) : degree (p * coe_fn C (leading_coeff q⁻¹)) = degree p := sorry

theorem irreducible_of_monic {R : Type u} [field R] {p : polynomial R} (hp1 : monic p) (hp2 : p ≠ 1) : irreducible p ↔ ∀ (f g : polynomial R), monic f → monic g → f * g = p → f = 1 ∨ g = 1 := sorry

/-- Division of polynomials. See polynomial.div_by_monic for more details.-/
def div {R : Type u} [field R] (p : polynomial R) (q : polynomial R) : polynomial R :=
  coe_fn C (leading_coeff q⁻¹) * (p /ₘ (q * coe_fn C (leading_coeff q⁻¹)))

/-- Remainder of polynomial division, see the lemma `quotient_mul_add_remainder_eq_aux`.
See polynomial.mod_by_monic for more details. -/
def mod {R : Type u} [field R] (p : polynomial R) (q : polynomial R) : polynomial R :=
  p %ₘ (q * coe_fn C (leading_coeff q⁻¹))

protected instance has_div {R : Type u} [field R] : Div (polynomial R) :=
  { div := div }

protected instance has_mod {R : Type u} [field R] : Mod (polynomial R) :=
  { mod := mod }

theorem div_def {R : Type u} [field R] {p : polynomial R} {q : polynomial R} : p / q = coe_fn C (leading_coeff q⁻¹) * (p /ₘ (q * coe_fn C (leading_coeff q⁻¹))) :=
  rfl

theorem mod_def {R : Type u} [field R] {p : polynomial R} {q : polynomial R} : p % q = p %ₘ (q * coe_fn C (leading_coeff q⁻¹)) :=
  rfl

theorem mod_by_monic_eq_mod {R : Type u} [field R] {q : polynomial R} (p : polynomial R) (hq : monic q) : p %ₘ q = p % q := sorry

theorem div_by_monic_eq_div {R : Type u} [field R] {q : polynomial R} (p : polynomial R) (hq : monic q) : p /ₘ q = p / q := sorry

theorem mod_X_sub_C_eq_C_eval {R : Type u} [field R] (p : polynomial R) (a : R) : p % (X - coe_fn C a) = coe_fn C (eval a p) :=
  mod_by_monic_eq_mod p (monic_X_sub_C a) ▸ mod_by_monic_X_sub_C_eq_C_eval p a

theorem mul_div_eq_iff_is_root {R : Type u} {a : R} [field R] {p : polynomial R} : (X - coe_fn C a) * (p / (X - coe_fn C a)) = p ↔ is_root p a :=
  div_by_monic_eq_div p (monic_X_sub_C a) ▸ mul_div_by_monic_eq_iff_is_root

protected instance euclidean_domain {R : Type u} [field R] : euclidean_domain (polynomial R) :=
  euclidean_domain.mk comm_ring.add sorry comm_ring.zero sorry sorry comm_ring.neg comm_ring.sub sorry sorry comm_ring.mul
    sorry comm_ring.one sorry sorry sorry sorry sorry sorry Div.div sorry Mod.mod quotient_mul_add_remainder_eq_aux
    (fun (p q : polynomial R) => degree p < degree q) sorry sorry sorry

theorem mod_eq_self_iff {R : Type u} [field R] {p : polynomial R} {q : polynomial R} (hq0 : q ≠ 0) : p % q = p ↔ degree p < degree q := sorry

theorem div_eq_zero_iff {R : Type u} [field R] {p : polynomial R} {q : polynomial R} (hq0 : q ≠ 0) : p / q = 0 ↔ degree p < degree q := sorry

theorem degree_add_div {R : Type u} [field R] {p : polynomial R} {q : polynomial R} (hq0 : q ≠ 0) (hpq : degree q ≤ degree p) : degree q + degree (p / q) = degree p := sorry

theorem degree_div_le {R : Type u} [field R] (p : polynomial R) (q : polynomial R) : degree (p / q) ≤ degree p := sorry

theorem degree_div_lt {R : Type u} [field R] {p : polynomial R} {q : polynomial R} (hp : p ≠ 0) (hq : 0 < degree q) : degree (p / q) < degree p := sorry

@[simp] theorem degree_map {R : Type u} {k : Type y} [field R] [field k] (p : polynomial R) (f : R →+* k) : degree (map f p) = degree p :=
  degree_map_eq_of_injective (ring_hom.injective f) p

@[simp] theorem nat_degree_map {R : Type u} {k : Type y} [field R] {p : polynomial R} [field k] (f : R →+* k) : nat_degree (map f p) = nat_degree p :=
  nat_degree_eq_of_degree_eq (degree_map p f)

@[simp] theorem leading_coeff_map {R : Type u} {k : Type y} [field R] {p : polynomial R} [field k] (f : R →+* k) : leading_coeff (map f p) = coe_fn f (leading_coeff p) := sorry

theorem monic_map_iff {R : Type u} {k : Type y} [field R] [field k] {f : R →+* k} {p : polynomial R} : monic (map f p) ↔ monic p := sorry

theorem is_unit_map {R : Type u} {k : Type y} [field R] {p : polynomial R} [field k] (f : R →+* k) : is_unit (map f p) ↔ is_unit p := sorry

theorem map_div {R : Type u} {k : Type y} [field R] {p : polynomial R} {q : polynomial R} [field k] (f : R →+* k) : map f (p / q) = map f p / map f q := sorry

theorem map_mod {R : Type u} {k : Type y} [field R] {p : polynomial R} {q : polynomial R} [field k] (f : R →+* k) : map f (p % q) = map f p % map f q := sorry

theorem gcd_map {R : Type u} {k : Type y} [field R] {p : polynomial R} {q : polynomial R} [field k] (f : R →+* k) : euclidean_domain.gcd (map f p) (map f q) = map f (euclidean_domain.gcd p q) := sorry

theorem eval₂_gcd_eq_zero {R : Type u} {k : Type y} [field R] [comm_semiring k] {ϕ : R →+* k} {f : polynomial R} {g : polynomial R} {α : k} (hf : eval₂ ϕ α f = 0) (hg : eval₂ ϕ α g = 0) : eval₂ ϕ α (euclidean_domain.gcd f g) = 0 := sorry

theorem eval_gcd_eq_zero {R : Type u} [field R] {f : polynomial R} {g : polynomial R} {α : R} (hf : eval α f = 0) (hg : eval α g = 0) : eval α (euclidean_domain.gcd f g) = 0 :=
  eval₂_gcd_eq_zero hf hg

theorem root_left_of_root_gcd {R : Type u} {k : Type y} [field R] [comm_semiring k] {ϕ : R →+* k} {f : polynomial R} {g : polynomial R} {α : k} (hα : eval₂ ϕ α (euclidean_domain.gcd f g) = 0) : eval₂ ϕ α f = 0 := sorry

theorem root_right_of_root_gcd {R : Type u} {k : Type y} [field R] [comm_semiring k] {ϕ : R →+* k} {f : polynomial R} {g : polynomial R} {α : k} (hα : eval₂ ϕ α (euclidean_domain.gcd f g) = 0) : eval₂ ϕ α g = 0 := sorry

theorem root_gcd_iff_root_left_right {R : Type u} {k : Type y} [field R] [comm_semiring k] {ϕ : R →+* k} {f : polynomial R} {g : polynomial R} {α : k} : eval₂ ϕ α (euclidean_domain.gcd f g) = 0 ↔ eval₂ ϕ α f = 0 ∧ eval₂ ϕ α g = 0 := sorry

theorem is_root_gcd_iff_is_root_left_right {R : Type u} [field R] {f : polynomial R} {g : polynomial R} {α : R} : is_root (euclidean_domain.gcd f g) α ↔ is_root f α ∧ is_root g α :=
  root_gcd_iff_root_left_right

theorem is_coprime_map {R : Type u} {k : Type y} [field R] {p : polynomial R} {q : polynomial R} [field k] (f : R →+* k) : is_coprime (map f p) (map f q) ↔ is_coprime p q := sorry

@[simp] theorem map_eq_zero {R : Type u} {S : Type v} [field R] {p : polynomial R} [semiring S] [nontrivial S] (f : R →+* S) : map f p = 0 ↔ p = 0 := sorry

theorem map_ne_zero {R : Type u} {S : Type v} [field R] {p : polynomial R} [semiring S] [nontrivial S] {f : R →+* S} (hp : p ≠ 0) : map f p ≠ 0 :=
  mt (iff.mp (map_eq_zero f)) hp

theorem mem_roots_map {R : Type u} {k : Type y} [field R] {p : polynomial R} [field k] {f : R →+* k} {x : k} (hp : p ≠ 0) : x ∈ roots (map f p) ↔ eval₂ f x p = 0 := sorry

theorem exists_root_of_degree_eq_one {R : Type u} [field R] {p : polynomial R} (h : degree p = 1) : ∃ (x : R), is_root p x := sorry

theorem coeff_inv_units {R : Type u} [field R] (u : units (polynomial R)) (n : ℕ) : coeff (↑u) n⁻¹ = coeff (↑(u⁻¹)) n := sorry

theorem monic_normalize {R : Type u} [field R] {p : polynomial R} (hp0 : p ≠ 0) : monic (coe_fn normalize p) := sorry

theorem coe_norm_unit_of_ne_zero {R : Type u} [field R] {p : polynomial R} (hp : p ≠ 0) : ↑(norm_unit p) = coe_fn C (leading_coeff p⁻¹) := sorry

theorem normalize_monic {R : Type u} [field R] {p : polynomial R} (h : monic p) : coe_fn normalize p = p := sorry

theorem map_dvd_map' {R : Type u} {k : Type y} [field R] [field k] (f : R →+* k) {x : polynomial R} {y : polynomial R} : map f x ∣ map f y ↔ x ∣ y := sorry

theorem degree_normalize {R : Type u} [field R] {p : polynomial R} : degree (coe_fn normalize p) = degree p := sorry

theorem prime_of_degree_eq_one {R : Type u} [field R] {p : polynomial R} (hp1 : degree p = 1) : prime p := sorry

theorem irreducible_of_degree_eq_one {R : Type u} [field R] {p : polynomial R} (hp1 : degree p = 1) : irreducible p :=
  irreducible_of_prime (prime_of_degree_eq_one hp1)

theorem not_irreducible_C {R : Type u} [field R] (x : R) : ¬irreducible (coe_fn C x) := sorry

theorem degree_pos_of_irreducible {R : Type u} [field R] {p : polynomial R} (hp : irreducible p) : 0 < degree p :=
  lt_of_not_ge
    fun (hp0 : 0 ≥ degree p) =>
      (fun (this : p = coe_fn C (coeff p 0)) => not_irreducible_C (coeff p 0) (this ▸ hp)) (eq_C_of_degree_le_zero hp0)

theorem pairwise_coprime_X_sub {α : Type u} [field α] {I : Type v} {s : I → α} (H : function.injective s) : pairwise (is_coprime on fun (i : I) => X - coe_fn C (s i)) := sorry

/-- If `f` is a polynomial over a field, and `a : K` satisfies `f' a ≠ 0`,
then `f / (X - a)` is coprime with `X - a`.
Note that we do not assume `f a = 0`, because `f / (X - a) = (f - f a) / (X - a)`. -/
theorem is_coprime_of_is_root_of_eval_derivative_ne_zero {K : Type u_1} [field K] (f : polynomial K) (a : K) (hf' : eval a (coe_fn derivative f) ≠ 0) : is_coprime (X - coe_fn C a) (f /ₘ (X - coe_fn C a)) := sorry

theorem prod_multiset_root_eq_finset_root {R : Type u} [field R] {p : polynomial R} (hzero : p ≠ 0) : multiset.prod (multiset.map (fun (a : R) => X - coe_fn C a) (roots p)) =
  finset.prod (multiset.to_finset (roots p)) fun (a : R) => (fun (a : R) => (X - coe_fn C a) ^ root_multiplicity a p) a := sorry

/-- The product `∏ (X - a)` for `a` inside the multiset `p.roots` divides `p`. -/
theorem prod_multiset_X_sub_C_dvd {R : Type u} [field R] (p : polynomial R) : multiset.prod (multiset.map (fun (a : R) => X - coe_fn C a) (roots p)) ∣ p := sorry

theorem roots_C_mul {R : Type u} [field R] (p : polynomial R) {a : R} (hzero : a ≠ 0) : roots (coe_fn C a * p) = roots p := sorry

theorem roots_normalize {R : Type u} [field R] {p : polynomial R} : roots (coe_fn normalize p) = roots p := sorry