/-
Copyright (c) 2019 Joe Cool. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Hoang Le Truong.

-/
import   algebra.module    data.pfun

universes u v w

variables {α : Type u} {β : Type v} {γ : Type w}

local attribute [instance] classical.prop_decidable

namespace map

protected def has_zero [has_zero β] : has_zero (α → β) := ⟨λ x, 0⟩
lemma zero_def [has_zero β] (x:α) : @has_zero.zero _ map.has_zero  x = 0 := rfl

protected def has_one [has_one β] : has_one (α → β )  := ⟨λ x, (1:β)   ⟩
lemma one_def [has_one β] (x:α) : @has_one.one _ map.has_one x = 1 := rfl

protected def has_mul [has_mul β] : has_mul (α → β ) := ⟨λ x y, λ z,  x z * y z⟩
lemma mul_def [has_mul β] (x y : α→ β) (z:α) : @has_mul.mul _ map.has_mul x y z=  (x z) * (y z) := rfl

protected def has_add [has_add β] : has_add(α → β ) := ⟨λ f g, λ z,  f z + g z⟩
lemma add_def [has_add β] (x y : α→ β) (z:α) :  @has_add.add _ map.has_add x y z = x z +  y z := rfl

protected def has_inv [has_inv β] : has_inv (α → β ) := ⟨λ x, λ y,  (x y )⁻¹⟩
lemma inv_def [has_inv β] (x : α → β ) (y: α) : @has_inv.inv _ map.has_inv x y = (x y)⁻¹ := rfl

protected def has_neg [has_neg β] : has_neg (α → β ) := ⟨λ x, λ y, -x y⟩
lemma neg_def [has_neg β] (x : α → β ) (y:α) : @has_neg.neg _ map.has_neg x y = - x y := rfl

protected def has_scalar [has_scalar γ β] : has_scalar γ (α → β ) := ⟨λ a x , λ y, a • x y⟩
lemma smul_def [has_scalar γ β] (a:γ) (x : α → β ) (y:α) : @has_scalar.smul _ _ map.has_scalar a x y =  a • x y := rfl

protected def semigroup [semigroup β] : semigroup (α → β) :=
{ mul_assoc := by simp [mul_def, mul_assoc],
  ..map.has_mul }

protected def comm_semigroup [comm_semigroup β] : comm_semigroup (α → β )  :=
{ mul_comm := by { repeat{intro}, ext1, simp [mul_def, mul_comm]}
  ..map.semigroup }

protected def monoid [monoid β] : monoid (α → β )  :=
{ monoid.
   mul := map.has_mul.mul,
   mul_assoc := by simp [mul_def, mul_assoc],
   one := λ x:α, (1:β),
  one_mul := by {intro, ext1, simp [mul_def, map.one_def]},
  mul_one := by {intro, ext1, simp [mul_def, map.one_def]}
  }

protected def comm_monoid [comm_monoid β] : comm_monoid (α→ β) :=
{ ..map.comm_semigroup,
  ..map.monoid  }

protected def group [group β] : group (α→ β ) :=
{ group.
  mul := map.has_mul.mul,
   mul_assoc := by simp [mul_def, mul_assoc],
   one := λ x:α, (1:β),
  one_mul := by {intro, ext1, simp [mul_def, map.one_def]},
  mul_one := by {intro, ext1, simp [mul_def, map.one_def]},
  mul_left_inv := by {intro, ext1, simp [mul_def, inv_def,map.one_def]},
  ..map.has_inv }

protected def comm_group [comm_group β] : comm_group (α→ β ) :=
{ ..map.group,
  ..map.comm_semigroup }

protected def add_semigroup [add_semigroup β] : add_semigroup (α → β ) :=
@additive.add_semigroup _ (@map.semigroup _ _  multiplicative.semigroup)

protected def add_comm_semigroup [add_comm_semigroup β] : add_comm_semigroup (α → β ) :=
@additive.add_comm_semigroup _ (@map.comm_semigroup _ _  multiplicative.comm_semigroup)

protected def add_monoid [add_monoid β] : add_monoid (α → β ) :=
@additive.add_monoid _ (@map.monoid _ _  multiplicative.monoid)

protected def add_comm_monoid [add_comm_monoid β] : add_comm_monoid (α → β) :=
@additive.add_comm_monoid _ (@map.comm_monoid _ _ multiplicative.comm_monoid)

protected def add_group [add_group β] : add_group (α → β ) :=
@additive.add_group _ (@map.group _ _  multiplicative.group)

protected def add_comm_group [add_comm_group β] : add_comm_group (α → β ) :=
@additive.add_comm_group _ (@map.comm_group _ _  multiplicative.comm_group)

protected def semiring [semiring β] : semiring (α → β) :=
{    mul := map.has_mul.mul,
   mul_assoc := by simp [mul_def, mul_assoc],
   one := λ x:α, (1:β),
   zero := λ x:α, (0:β),
  one_mul := by {intro, ext1, simp [mul_def, map.one_def]},
  mul_one := by {intro, ext1, simp [mul_def, map.one_def]},
   right_distrib := by {repeat{intro}, ext1, simp [mul_def, add_def, add_mul]},
  left_distrib := by {repeat{intro}, ext1, simp [mul_def, add_def, mul_add]},
  zero_mul := by {repeat{intro}, ext1, simp [mul_def, zero_def]},
  mul_zero := by {repeat{intro}, ext1, simp [mul_def, zero_def]},
  ..map.has_mul ,
  ..map.has_add ,
  ..map.add_comm_monoid  }

protected def comm_semiring [comm_semiring β] : comm_semiring (α → β )  :=
{ ..map.semiring,
  ..map.comm_monoid  }

protected def ring [ring β] : ring (α → β )  :=
{ ..map.semiring,
  ..map.add_comm_group  }

protected def comm_ring [comm_ring β] : comm_ring (α→ β ) :=
{ ..map.comm_monoid ,
  ..map.ring  }

protected def mul_action [monoid γ][mul_action γ β] :mul_action γ (α →β ):=
{ one_smul := by {repeat{intro}, simp[smul_def] },
  mul_smul := by {repeat{intro},ext1, simp[smul_def,mul_smul] },
  ..map.has_scalar
}

instance  add_monoid'[add_monoid β] : add_monoid (α → β) := map.add_monoid

protected def distrib_mul_action [monoid γ] [add_monoid β]   [distrib_mul_action γ β] : distrib_mul_action γ (α → β):=
{ smul_add := by {repeat{intro}, ext1,simp[smul_def,add_def,smul_add ]},
  smul_zero := by {repeat{intro}, ext1,simp only [smul_def], by library_search
 },
 ..map.mul_action
}

instance  add_comm_monoid'[add_comm_monoid β] : add_comm_monoid(α → β) := map.add_comm_monoid

protected def semimodule [semiring γ] [add_comm_monoid β] [semimodule γ β ]: semimodule γ (α → β):=
{  add_smul := by {repeat{intro}, ext1,simp[smul_def,add_def,add_smul ]},
   zero_smul := by {repeat{intro}, ext1,simp only [smul_def], by library_search},
  ..map.distrib_mul_action}

instance  add_comm_group'[add_comm_group β] : add_comm_group(α → β) := map.add_comm_group

protected def module  [ring γ][add_comm_group β ] [module γ β] : module γ (α→ β ) :=
{..map.semimodule}

protected def vector_space  [discrete_field γ][add_comm_group β ] [vector_space γ β] : vector_space γ (α→ β ) :=
{..map.semimodule}

end map

section const

noncomputable theory
variable [has_zero α]
def ext_by_zero   (f : β    →. α )   (z:β   ): α  := if  h:z ∈  f.dom    then f.fn z h else 0

def const_fun (c:α) : β   →. α  :=  pfun.lift (λ x, c)

lemma const_def (c:α) (y:β  ) :  const_fun c y = some c:= rfl

lemma ext_const (c:α):ext_by_zero (@const_fun  α β _ c)= (λ x, c):=
by{ ext1,
have h:= @const_def α β _ c x,
rw[ext_by_zero],
simp[pfun.mem_dom,pfun.fn,h]
}

def zero_fun : β  →. α :=  pfun.lift (λ x, 0)

lemma ext_zero:ext_by_zero (@zero_fun α β _ )= (λ x, 0):=
ext_const 0

def one_fun [has_one α]: β  →. α :=  pfun.lift (λ x, 1)

lemma ext_one [has_one α]:ext_by_zero (@one_fun α β _ _)= (λ x, 1):=
ext_const 1

lemma const_incl_dom  (c:α) (z:β ):  z ∈ (pfun.dom (@const_fun α β _ c )) :=
by{ rw[pfun.dom_eq],simp[ const_def],}

end const


import singular

/- This file shows that a σ-finite measure can be decomposed disjointly. -/

noncomputable theory
open_locale classical big_operators nnreal ennreal

variables {α β : Type*} [measurable_space α]

open measure_theory

def diff_le (S : ℕ → set α) : ℕ → set α
| 0       := S 0
| (n + 1) := S (n + 1) \ ⋃ k ≤ n, S k

lemma mem_zero_diff_le_iff (S : ℕ → set α) {x : α} :
  x ∈ diff_le S 0 ↔ x ∈ S 0 := iff.rfl

lemma mem_succ_diff_le_iff (S : ℕ → set α) {x : α} {n : ℕ} :
  x ∈ diff_le S n.succ ↔ x ∈ S n.succ ∧ ∀ k ≤ n, x ∉ S k :=
begin
  split;
  { rintro ⟨hx₁, hx₂⟩,
    exact ⟨hx₁, by simpa using hx₂⟩ },
end

lemma mem_diff_le (S : ℕ → set α) {x : α} {n : ℕ} (hx : x ∈ diff_le S n) :
  x ∈ S n :=
begin
  cases n,
  exact (mem_zero_diff_le_iff S).1 hx,
  exact ((mem_succ_diff_le_iff S).1 hx).1,
end

lemma diff_le_pairwsie_disjoint (S : ℕ → set α) :
  pairwise (disjoint on diff_le S) :=
begin
  rintro i j hij x ⟨hx₁, hx₂⟩,
  cases i; cases j,
  { exact hij rfl },
  { rw mem_succ_diff_le_iff at hx₂,
    exact hx₂.2 0 (zero_le _) hx₁ },
  { rw mem_succ_diff_le_iff at hx₁,
    exact hx₁.2 0 (zero_le _) hx₂ },
  { wlog h : i ≤ j,
    rw mem_succ_diff_le_iff at hx₂,
    by_cases h' : i.succ ≤ j,
    { exact hx₂.2 _ h' (mem_diff_le S hx₁) },
    { rw [not_le, nat.lt_succ_iff] at h',
      rw antisymm h h' at hij,
      exact hij rfl } }
end

lemma Union_diff_le_eq (S : ℕ → set α) : (⋃ n, diff_le S n) = ⋃ n, S n :=
begin
  ext x,
  rw [set.mem_Union, set.mem_Union],
  split,
  { rintro ⟨i, hx⟩,
    exact ⟨i, mem_diff_le S hx⟩ },
  { intro hx,
    by_cases hn : nat.find hx = 0,
    { exact ⟨0, (mem_zero_diff_le_iff S).2 (hn ▸ nat.find_spec hx)⟩ },
    { obtain ⟨n, hn⟩ := nat.exists_eq_succ_of_ne_zero hn,
      refine ⟨n.succ, (mem_succ_diff_le_iff S).2 ⟨hn ▸ nat.find_spec hx,
        λ k hk, nat.find_min hx _⟩⟩, -- stupid triangle won't work in refine
      exact hn.symm ▸ nat.lt_succ_iff.mpr hk } }
end

lemma diff_le_subset (S : ℕ → set α) (n : ℕ) : diff_le S n ⊆ S n :=
begin
  cases n,
  { exact set.subset.refl _ },
  { intros x hx,
    exact hx.1 }
end

lemma exists_disjoint_finite_spanning_sets_in (μ : measure α) [sigma_finite μ] :
  ∃ S : μ.finite_spanning_sets_in {s | measurable_set s},
    pairwise (disjoint on S.set) :=
begin
  set T := μ.to_finite_spanning_sets_in with hT,
  refine ⟨⟨diff_le T.set, _, _, T.spanning ▸ Union_diff_le_eq _⟩,
           diff_le_pairwsie_disjoint _⟩,
  { intros n, cases n,
    { exact T.set_mem 0 },
    { exact measurable_set.diff (T.set_mem _) (measurable_set.Union
        (λ _, measurable_set.Union_Prop (λ _, T.set_mem _))) } },
  { intro n,
    exact lt_of_le_of_lt (measure_mono (diff_le_subset T.set n)) (T.finite _) }
end

lemma exists_eq_finite_spanning_sets_in
  (μ ν : measure α) [sigma_finite μ] [sigma_finite ν] :
  ∃ (S : μ.finite_spanning_sets_in {s | measurable_set s})
    (T : ν.finite_spanning_sets_in {s | measurable_set s}), S.set = T.set :=
begin
  sorry
end

lemma exists_eq_disjoint_finite_spanning_sets_in
  (μ ν : measure α) [sigma_finite μ] [sigma_finite ν] :
  ∃ (S : μ.finite_spanning_sets_in {s | measurable_set s})
    (T : ν.finite_spanning_sets_in {s | measurable_set s}),
    S.set = T.set ∧ pairwise (disjoint on S.set) ∧ pairwise (disjoint on T.set) :=
begin
  obtain ⟨S, T, hST⟩ := exists_eq_finite_spanning_sets_in μ ν,
  refine ⟨⟨diff_le S.set, _, _, S.spanning ▸ Union_diff_le_eq _⟩,
          ⟨diff_le T.set, _, _, T.spanning ▸ Union_diff_le_eq _⟩,
           _, diff_le_pairwsie_disjoint _, diff_le_pairwsie_disjoint _⟩,
  { intros n, cases n,
    { exact S.set_mem 0 },
    { exact measurable_set.diff (S.set_mem _) (measurable_set.Union
        (λ _, measurable_set.Union_Prop (λ _, S.set_mem _))) } },
  { intro n,
    exact lt_of_le_of_lt (measure_mono (diff_le_subset S.set n)) (S.finite _) },
  { intros n, cases n,
    { exact T.set_mem 0 },
    { exact measurable_set.diff (T.set_mem _) (measurable_set.Union
        (λ _, measurable_set.Union_Prop (λ _, T.set_mem _))) } },
  { intro n,
    exact lt_of_le_of_lt (measure_mono (diff_le_subset T.set n)) (T.finite _) },
  { simp [hST] },
end


/-
Copyright (c) 2022 Alex J. Best. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Alex J. Best, Yaël Dillies
-/
import algebra.order.hom.ring
import algebra.order.pointwise
import analysis.special_functions.pow

/-!
# Conditionally complete linear ordered fields

This file shows that the reals are unique, or, more formally, given a type satisfying the common
axioms of the reals (field, conditionally complete, linearly ordered) that there is an isomorphism
preserving these properties to the reals. This is `rat.induced_order_ring_iso`. Moreover this
isomorphism is unique.

We introduce definitions of conditionally complete linear ordered fields, and show all such are
archimedean. We also construct the natural map from a `linear_ordered_field` to such a field.

## Main definitions

* `conditionally_complete_linear_ordered_field`: A field satisfying the standard axiomatization of
  the real numbers, being a Dedekind complete and linear ordered field.
* `linear_ordered_field.induced_map`: A (unique) map from any archimedean linear ordered field to a
  conditionally complete linear ordered field. Various bundlings are available.

## Main results

* `unique.order_ring_hom` : Uniqueness of `order_ring_hom`s from an archimedean linear ordered field
  to a conditionally complete linear ordered field.
* `unique.order_ring_iso` : Uniqueness of `order_ring_iso`s between two
  conditionally complete linearly ordered fields.

## References

* https://mathoverflow.net/questions/362991/
  who-first-characterized-the-real-numbers-as-the-unique-complete-ordered-field

## Tags

reals, conditionally complete, ordered field, uniqueness
-/

variables {F α β γ : Type*}

noncomputable theory

open function rat real set
open_locale classical pointwise

set_option old_structure_cmd true

/-- A field which is both linearly ordered and conditionally complete with respect to the order.
This axiomatizes the reals. -/
@[protect_proj, ancestor linear_ordered_field conditionally_complete_linear_order]
class conditionally_complete_linear_ordered_field (α : Type*)
  extends linear_ordered_field α renaming max → sup min → inf, conditionally_complete_linear_order α

/-- Any conditionally complete linearly ordered field is archimedean. -/
@[priority 100] -- see Note [lower instance priority]
instance conditionally_complete_linear_ordered_field.to_archimedean
  [conditionally_complete_linear_ordered_field α] : archimedean α :=
archimedean_iff_nat_lt.2 begin
  by_contra' h,
  obtain ⟨x, h⟩ := h,
  have := cSup_le (range_nonempty (coe : ℕ → α)) (forall_range_iff.2 $ λ n, le_sub_iff_add_le.2 $
    le_cSup ⟨x, forall_range_iff.2 h⟩ ⟨n + 1, nat.cast_succ n⟩),
  linarith,
end

/-- The reals are a conditionally complete linearly ordered field. -/
instance : conditionally_complete_linear_ordered_field ℝ :=
{ ..real.linear_ordered_field, ..real.conditionally_complete_linear_order }

namespace linear_ordered_field

/-!
### Rational cut map

The idea is that a conditionally complete linear ordered field is fully characterized by its copy of
the rationals. Hence we define `rat.cut_map β : α → set β` which sends `a : α` to the "rationals in
`β`" that are less than `a`.
-/

section cut_map
variables [linear_ordered_field α]

section division_ring
variables (β) [division_ring β] {a a₁ a₂ : α} {b : β} {q : ℚ}

/-- The lower cut of rationals inside a linear ordered field that are less than a given element of
another linear ordered field. -/
def cut_map (a : α) : set β := (coe : ℚ → β) '' {t | ↑t < a}

lemma cut_map_mono (h : a₁ ≤ a₂) : cut_map β a₁ ⊆ cut_map β a₂ := image_subset _ $ λ _, h.trans_lt'

variables {β}

@[simp] lemma mem_cut_map_iff : b ∈ cut_map β a ↔ ∃ q : ℚ, (q : α) < a ∧ (q : β) = b := iff.rfl

@[simp] lemma coe_mem_cut_map_iff [char_zero β] : (q : β) ∈ cut_map β a ↔ (q : α) < a :=
rat.cast_injective.mem_set_image

lemma cut_map_self (a : α) : cut_map α a = Iio a ∩ range (coe : ℚ → α) :=
begin
  ext,
  split,
  { rintro ⟨q, h, rfl⟩,
    exact ⟨h, q, rfl⟩ },
  { rintro ⟨h, q, rfl⟩,
    exact ⟨q, h, rfl⟩ }
end

end division_ring

variables (β) [linear_ordered_field β] {a a₁ a₂ : α} {b : β} {q : ℚ}

lemma cut_map_coe (q : ℚ) : cut_map β (q : α) = coe '' {r : ℚ | (r : β) < q} :=
by simp_rw [cut_map, rat.cast_lt]

variables [archimedean α]

lemma cut_map_nonempty (a : α) : (cut_map β a).nonempty :=  nonempty.image _ $ exists_rat_lt a

lemma cut_map_bdd_above (a : α) : bdd_above (cut_map β a) :=
begin
  obtain ⟨q, hq⟩ := exists_rat_gt a,
  exact ⟨q, ball_image_iff.2 $ λ r hr, by exact_mod_cast (hq.trans' hr).le⟩,
end

lemma cut_map_add (a b : α) : cut_map β (a + b) = cut_map β a + cut_map β b :=
begin
  refine (image_subset_iff.2 $ λ q hq, _).antisymm _,
  { rw [mem_set_of_eq, ←sub_lt_iff_lt_add] at hq,
    obtain ⟨q₁, hq₁q, hq₁ab⟩ := exists_rat_btwn hq,
    refine ⟨q₁, q - q₁, _, _, add_sub_cancel'_right _ _⟩; try {norm_cast}; rwa coe_mem_cut_map_iff,
    exact_mod_cast sub_lt_comm.mp hq₁q },
  { rintro _ ⟨_, _, ⟨qa, ha, rfl⟩, ⟨qb, hb, rfl⟩, rfl⟩,
    refine ⟨qa + qb, _, by norm_cast⟩,
    rw [mem_set_of_eq, cast_add],
    exact add_lt_add ha hb }
end

end cut_map

/-!
### Induced map

`rat.cut_map` spits out a `set β`. To get something in `β`, we now take the supremum.
-/

section induced_map
variables (α β γ) [linear_ordered_field α] [conditionally_complete_linear_ordered_field β]
  [conditionally_complete_linear_ordered_field γ]

/-- The induced order preserving function from a linear ordered field to a conditionally complete
linear ordered field, defined by taking the Sup in the codomain of all the rationals less than the
input. -/
def induced_map (x : α) : β := Sup $ cut_map β x

variables [archimedean α]

lemma induced_map_mono : monotone (induced_map α β) :=
λ a b h, cSup_le_cSup (cut_map_bdd_above β _) (cut_map_nonempty β _) (cut_map_mono β h)

lemma induced_map_rat (q : ℚ) : induced_map α β (q : α) = q :=
begin
  refine cSup_eq_of_forall_le_of_forall_lt_exists_gt (cut_map_nonempty β q) (λ x h, _) (λ w h, _),
  { rw cut_map_coe at h,
    obtain ⟨r, h, rfl⟩ := h,
    exact le_of_lt h },
  { obtain ⟨q', hwq, hq⟩ := exists_rat_btwn h,
    rw cut_map_coe,
    exact ⟨q', ⟨_, hq, rfl⟩, hwq⟩ }
end

@[simp] lemma induced_map_zero : induced_map α β 0 = 0 := by exact_mod_cast induced_map_rat α β 0
@[simp] lemma induced_map_one : induced_map α β 1 = 1 := by exact_mod_cast induced_map_rat α β 1

variables {α β} {a : α} {b : β} {q : ℚ}

lemma induced_map_nonneg (ha : 0 ≤ a) : 0 ≤ induced_map α β a :=
(induced_map_zero α _).ge.trans $ induced_map_mono _ _ ha

lemma coe_lt_induced_map_iff : (q : β) < induced_map α β a ↔ (q : α) < a :=
begin
  refine ⟨λ h, _, λ hq, _⟩,
  { rw ←induced_map_rat α at h,
    exact (induced_map_mono α β).reflect_lt h },
  { obtain ⟨q', hq, hqa⟩ := exists_rat_btwn hq,
    apply lt_cSup_of_lt (cut_map_bdd_above β a) (coe_mem_cut_map_iff.mpr hqa),
    exact_mod_cast hq }
end

lemma lt_induced_map_iff : b < induced_map α β a ↔ ∃ q : ℚ, b < q ∧ (q : α) < a :=
⟨λ h, (exists_rat_btwn h).imp $ λ q, and.imp_right coe_lt_induced_map_iff.1,
  λ ⟨q, hbq, hqa⟩, hbq.trans $ by rwa coe_lt_induced_map_iff⟩

@[simp] lemma induced_map_self (b : β) : induced_map β β b = b :=
eq_of_forall_rat_lt_iff_lt $ λ q, coe_lt_induced_map_iff

variables (α β)

@[simp] lemma induced_map_induced_map (a : α) :
  induced_map β γ (induced_map α β a) = induced_map α γ a :=
eq_of_forall_rat_lt_iff_lt $ λ q,
  by rw [coe_lt_induced_map_iff, coe_lt_induced_map_iff, iff.comm, coe_lt_induced_map_iff]

@[simp]

lemma induced_map_add (x y : α) : induced_map α β (x + y) = induced_map α β x + induced_map α β y :=
begin
  rw [induced_map, cut_map_add],
  exact cSup_add (cut_map_nonempty β x) (cut_map_bdd_above β x) (cut_map_nonempty β y)
    (cut_map_bdd_above β y),
end

variables {α β}

/-- Preparatory lemma for `induced_ring_hom`. -/
lemma le_induced_map_mul_self_of_mem_cut_map (ha : 0 < a) (b : β) (hb : b ∈ cut_map β (a * a)) :
  b ≤ induced_map α β a * induced_map α β a :=
begin
  obtain ⟨q, hb, rfl⟩ := hb,
  obtain ⟨q', hq', hqq', hqa⟩ := exists_rat_pow_btwn two_ne_zero hb (mul_self_pos.2 ha.ne'),
  transitivity (q' : β)^2,
  exact_mod_cast hqq'.le,
  rw pow_two at ⊢ hqa,
  exact mul_self_le_mul_self (by exact_mod_cast hq'.le) (le_cSup (cut_map_bdd_above β a) $
    coe_mem_cut_map_iff.2 $ lt_of_mul_self_lt_mul_self ha.le hqa),
end

/-- Preparatory lemma for `induced_ring_hom`. -/
lemma exists_mem_cut_map_mul_self_of_lt_induced_map_mul_self (ha : 0 < a) (b : β)
  (hba : b < induced_map α β a * induced_map α β a) :
  ∃ c ∈ cut_map β (a * a), b < c :=
begin
  obtain hb | hb := lt_or_le b 0,
  { refine ⟨0, _, hb⟩,
    rw [←rat.cast_zero, coe_mem_cut_map_iff, rat.cast_zero],
    exact mul_self_pos.2 ha.ne' },
  obtain ⟨q, hq, hbq, hqa⟩ := exists_rat_pow_btwn two_ne_zero hba (hb.trans_lt hba),
  rw ←cast_pow at hbq,
  refine ⟨(q^2 : ℚ), coe_mem_cut_map_iff.2 _, hbq⟩,
  rw pow_two at ⊢ hqa,
  push_cast,
  obtain ⟨q', hq', hqa'⟩ := lt_induced_map_iff.1 (lt_of_mul_self_lt_mul_self _ hqa),
  exact mul_self_lt_mul_self (by exact_mod_cast hq.le) (hqa'.trans' $ by assumption_mod_cast),
  exact induced_map_nonneg ha.le,
end

variables (α β)

/-- `induced_map` as an additive homomorphism. -/
def induced_add_hom : α →+ β := ⟨induced_map α β, induced_map_zero α β, induced_map_add α β⟩

/-- `induced_map` as an `order_ring_hom`. -/
@[simps] def induced_order_ring_hom : α →+*o β :=
{ monotone' := induced_map_mono _ _,
  ..(induced_add_hom α β).mk_ring_hom_of_mul_self_of_two_ne_zero  -- reduce to the case of x = y
    begin
      -- reduce to the case of 0 < x
      suffices : ∀ x, 0 < x →
        induced_add_hom α β (x * x) = induced_add_hom α β x * induced_add_hom α β x,
      { rintro x,
        obtain h | rfl | h := lt_trichotomy x 0,
        { convert this (-x) (neg_pos.2 h) using 1,
          { rw [neg_mul, mul_neg, neg_neg] },
          { simp_rw [add_monoid_hom.map_neg, neg_mul, mul_neg, neg_neg] } },
        { simp only [mul_zero, add_monoid_hom.map_zero] },
        { exact this x h } },
      -- prove that the (Sup of rationals less than x) ^ 2 is the Sup of the set of rationals less
      -- than (x ^ 2) by showing it is an upper bound and any smaller number is not an upper bound
      refine λ x hx, cSup_eq_of_forall_le_of_forall_lt_exists_gt (cut_map_nonempty β _) _ _,
      exact le_induced_map_mul_self_of_mem_cut_map hx,
      exact exists_mem_cut_map_mul_self_of_lt_induced_map_mul_self hx,
    end two_ne_zero (induced_map_one _ _) }

/-- The isomorphism of ordered rings between two conditionally complete linearly ordered fields. -/
def induced_order_ring_iso : β ≃+*o γ :=
{ inv_fun := induced_map γ β,
  left_inv := induced_map_inv_self _ _,
  right_inv := induced_map_inv_self _ _,
  map_le_map_iff' := λ x y, begin
    refine ⟨λ h, _, λ h, induced_map_mono _ _ h⟩,
    simpa [induced_order_ring_hom, add_monoid_hom.mk_ring_hom_of_mul_self_of_two_ne_zero,
      induced_add_hom] using induced_map_mono γ β h,
  end,
  ..induced_order_ring_hom β γ }

@[simp] lemma coe_induced_order_ring_iso : ⇑(induced_order_ring_iso β γ) = induced_map β γ := rfl

@[simp] lemma induced_order_ring_iso_symm :
  (induced_order_ring_iso β γ).symm = induced_order_ring_iso γ β := rfl

@[simp] lemma induced_order_ring_iso_self : induced_order_ring_iso β β = order_ring_iso.refl β :=
order_ring_iso.ext induced_map_self

open order_ring_iso

/-- There is a unique ordered ring homomorphism from an archimedean linear ordered field to a
conditionally complete linear ordered field. -/
instance : unique (α →+*o β) := unique_of_subsingleton $ induced_order_ring_hom α β

/-- There is a unique ordered ring isomorphism between two conditionally complete linear ordered
fields. -/
instance : unique (β ≃+*o γ) := unique_of_subsingleton $ induced_order_ring_iso β γ

end induced_map
end linear_ordered_field

section real

variables {R S : Type*} [ordered_ring R] [linear_ordered_ring S]

lemma ring_hom_monotone (hR : ∀ r : R, 0 ≤ r → ∃ s : R, s^2 = r) (f : R →+* S) : monotone f :=
(monotone_iff_map_nonneg f).2 $ λ r h, by { obtain ⟨s, rfl⟩ := hR r h, rw map_pow, apply sq_nonneg }

/-- There exists no nontrivial ring homomorphism `ℝ →+* ℝ`. -/
instance real.ring_hom.unique : unique (ℝ →+* ℝ) :=
{ default := ring_hom.id ℝ,
  uniq := λ f, congr_arg order_ring_hom.to_ring_hom
    (subsingleton.elim ⟨f, ring_hom_monotone (λ r hr, ⟨real.sqrt r, sq_sqrt hr⟩) f⟩ default), }

end real


/-
Copyright (c) 2020 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Buzzard
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.ring_theory.principal_ideal_domain
import Mathlib.order.conditionally_complete_lattice
import Mathlib.ring_theory.multiplicity
import Mathlib.ring_theory.valuation.basic
import Mathlib.PostPort

universes u l u_1

namespace Mathlib

/-!
# Discrete valuation rings

This file defines discrete valuation rings (DVRs) and develops a basic interface
for them.

## Important definitions

There are various definitions of a DVR in the literature; we define a DVR to be a local PID
which is not a field (the first definition in Wikipedia) and prove that this is equivalent
to being a PID with a unique non-zero prime ideal (the definition in Serre's
book "Local Fields").

Let R be an integral domain, assumed to be a principal ideal ring and a local ring.

* `discrete_valuation_ring R` : a predicate expressing that R is a DVR

### Definitions

* `add_val R : R → ℕ` : the additive valuation on a DVR (sending 0 to 0 rather than the
     mathematically correct +∞).
TODO -- the multiplicative valuation, taking values in something
  like `with_zero (multiplicative ℤ)`?

## Implementation notes

It's a theorem that an element of a DVR is a uniformizer if and only if it's irreducible.
We do not hence define `uniformizer` at all, because we can use `irreducible` instead.

## Tags

discrete valuation ring
-/

/-- An integral domain is a *discrete valuation ring* (DVR) if it's a local PID which
  is not a field. -/
class discrete_valuation_ring (R : Type u) [integral_domain R]
extends is_principal_ideal_ring R, local_ring R
where
  not_a_field' : local_ring.maximal_ideal R ≠ ⊥

namespace discrete_valuation_ring

theorem not_a_field (R : Type u) [integral_domain R] [discrete_valuation_ring R] : local_ring.maximal_ideal R ≠ ⊥ :=
  not_a_field'

/-- An element of a DVR is irreducible iff it is a uniformizer, that is, generates the
  maximal ideal of R -/
theorem irreducible_iff_uniformizer {R : Type u} [integral_domain R] [discrete_valuation_ring R] (ϖ : R) : irreducible ϖ ↔ local_ring.maximal_ideal R = ideal.span (singleton ϖ) := sorry

/-- Uniformisers exist in a DVR -/
theorem exists_irreducible (R : Type u) [integral_domain R] [discrete_valuation_ring R] : ∃ (ϖ : R), irreducible ϖ := sorry

/-- an integral domain is a DVR iff it's a PID with a unique non-zero prime ideal -/
theorem iff_pid_with_one_nonzero_prime (R : Type u) [integral_domain R] : discrete_valuation_ring R ↔ is_principal_ideal_ring R ∧ exists_unique fun (P : ideal R) => P ≠ ⊥ ∧ ideal.is_prime P := sorry

theorem associated_of_irreducible (R : Type u) [integral_domain R] [discrete_valuation_ring R] {a : R} {b : R} (ha : irreducible a) (hb : irreducible b) : associated a b := sorry

end discrete_valuation_ring

namespace discrete_valuation_ring

/-- Alternative characterisation of discrete valuation rings. -/
def has_unit_mul_pow_irreducible_factorization (R : Type u_1) [integral_domain R] :=
  ∃ (p : R), irreducible p ∧ ∀ {x : R}, x ≠ 0 → ∃ (n : ℕ), associated (p ^ n) x

namespace has_unit_mul_pow_irreducible_factorization

theorem unique_irreducible {R : Type u_1} [integral_domain R] (hR : has_unit_mul_pow_irreducible_factorization R) {p : R} {q : R} (hp : irreducible p) (hq : irreducible q) : associated p q := sorry

/-- An integral domain in which there is an irreducible element `p`
such that every nonzero element is associated to a power of `p` is a unique factorization domain.
See `discrete_valuation_ring.of_has_unit_mul_pow_irreducible_factorization`. -/
theorem to_unique_factorization_monoid {R : Type u_1} [integral_domain R] (hR : has_unit_mul_pow_irreducible_factorization R) : unique_factorization_monoid R := sorry

theorem of_ufd_of_unique_irreducible {R : Type u_1} [integral_domain R] [unique_factorization_monoid R] (h₁ : ∃ (p : R), irreducible p) (h₂ : ∀ {p q : R}, irreducible p → irreducible q → associated p q) : has_unit_mul_pow_irreducible_factorization R := sorry

end has_unit_mul_pow_irreducible_factorization

theorem aux_pid_of_ufd_of_unique_irreducible (R : Type u) [integral_domain R] [unique_factorization_monoid R] (h₁ : ∃ (p : R), irreducible p) (h₂ : ∀ {p q : R}, irreducible p → irreducible q → associated p q) : is_principal_ideal_ring R := sorry

/--
A unique factorization domain with at least one irreducible element
in which all irreducible elements are associated
is a discrete valuation ring.
-/
theorem of_ufd_of_unique_irreducible {R : Type u} [integral_domain R] [unique_factorization_monoid R] (h₁ : ∃ (p : R), irreducible p) (h₂ : ∀ {p q : R}, irreducible p → irreducible q → associated p q) : discrete_valuation_ring R := sorry

/--
An integral domain in which there is an irreducible element `p`
such that every nonzero element is associated to a power of `p`
is a discrete valuation ring.
-/
theorem of_has_unit_mul_pow_irreducible_factorization {R : Type u} [integral_domain R] (hR : has_unit_mul_pow_irreducible_factorization R) : discrete_valuation_ring R := sorry

theorem associated_pow_irreducible {R : Type u_1} [integral_domain R] [discrete_valuation_ring R] {x : R} (hx : x ≠ 0) {ϖ : R} (hirr : irreducible ϖ) : ∃ (n : ℕ), associated x (ϖ ^ n) := sorry

theorem eq_unit_mul_pow_irreducible {R : Type u_1} [integral_domain R] [discrete_valuation_ring R] {x : R} (hx : x ≠ 0) {ϖ : R} (hirr : irreducible ϖ) : ∃ (n : ℕ), ∃ (u : units R), x = ↑u * ϖ ^ n := sorry

theorem ideal_eq_span_pow_irreducible {R : Type u_1} [integral_domain R] [discrete_valuation_ring R] {s : ideal R} (hs : s ≠ ⊥) {ϖ : R} (hirr : irreducible ϖ) : ∃ (n : ℕ), s = ideal.span (singleton (ϖ ^ n)) := sorry

theorem unit_mul_pow_congr_pow {R : Type u_1} [integral_domain R] [discrete_valuation_ring R] {p : R} {q : R} (hp : irreducible p) (hq : irreducible q) (u : units R) (v : units R) (m : ℕ) (n : ℕ) (h : ↑u * p ^ m = ↑v * q ^ n) : m = n := sorry

theorem unit_mul_pow_congr_unit {R : Type u_1} [integral_domain R] [discrete_valuation_ring R] {ϖ : R} (hirr : irreducible ϖ) (u : units R) (v : units R) (m : ℕ) (n : ℕ) (h : ↑u * ϖ ^ m = ↑v * ϖ ^ n) : u = v := sorry

/-!
## The additive valuation on a DVR
-/

/-- The `ℕ`-valued additive valuation on a DVR (returns junk at `0` rather than `+∞`) -/
def add_val (R : Type u) [integral_domain R] [discrete_valuation_ring R] : R → ℕ :=
  fun (r : R) => dite (r = 0) (fun (hr : r = 0) => 0) fun (hr : ¬r = 0) => classical.some sorry

theorem add_val_spec {R : Type u_1} [integral_domain R] [discrete_valuation_ring R] {r : R} (hr : r ≠ 0) : let ϖ : R := classical.some (exists_irreducible R);
let n : ℕ := classical.some (associated_pow_irreducible hr (classical.some_spec (exists_irreducible R)));
associated r (ϖ ^ n) :=
  classical.some_spec (associated_pow_irreducible hr (classical.some_spec (exists_irreducible R)))

theorem add_val_def {R : Type u_1} [integral_domain R] [discrete_valuation_ring R] (r : R) (u : units R) {ϖ : R} (hϖ : irreducible ϖ) (n : ℕ) (hr : r = ↑u * ϖ ^ n) : add_val R r = n := sorry

theorem add_val_def' {R : Type u_1} [integral_domain R] [discrete_valuation_ring R] (u : units R) {ϖ : R} (hϖ : irreducible ϖ) (n : ℕ) : add_val R (↑u * ϖ ^ n) = n :=
  add_val_def (↑u * ϖ ^ n) u hϖ n rfl

@[simp] theorem add_val_zero {R : Type u_1} [integral_domain R] [discrete_valuation_ring R] : add_val R 0 = 0 :=
  dif_pos rfl

@[simp] theorem add_val_one {R : Type u_1} [integral_domain R] [discrete_valuation_ring R] : add_val R 1 = 0 := sorry

@[simp] theorem add_val_uniformizer {R : Type u_1} [integral_domain R] [discrete_valuation_ring R] {ϖ : R} (hϖ : irreducible ϖ) : add_val R ϖ = 1 := sorry

@[simp] theorem add_val_mul {R : Type u_1} [integral_domain R] [discrete_valuation_ring R] {a : R} {b : R} (ha : a ≠ 0) (hb : b ≠ 0) : add_val R (a * b) = add_val R a + add_val R b := sorry

theorem add_val_pow {R : Type u_1} [integral_domain R] [discrete_valuation_ring R] (a : R) (n : ℕ) : add_val R (a ^ n) = n * add_val R a := sorry

theorem add_val_le_iff_dvd {R : Type u_1} [integral_domain R] [discrete_valuation_ring R] {a : R} {b : R} (ha : a ≠ 0) (hb : b ≠ 0) : add_val R a ≤ add_val R b ↔ a ∣ b := sorry

theorem add_val_add {R : Type u_1} [integral_domain R] [discrete_valuation_ring R] {a : R} {b : R} (ha : a ≠ 0) (hb : b ≠ 0) (hab : a + b ≠ 0) : min (add_val R a) (add_val R b) ≤ add_val R (a + b) := sorry


import data.mv_polynomial ring_theory.noetherian ring_theory.polynomial

section division_ring

variables {α : Type*} [decidable_eq α] [division_ring α]

lemma submodule_ne_zero {s : submodule α α} (h : ¬ ↑s = ({0} : set α)) : (1 : α) ∈ s :=
begin
    have : ¬ ∀ x ∈ s, x = (0 : α) := λ H, h (begin
        ext x,
        refine ⟨by simpa using H x, λ hx, by simp at hx; simp [hx]⟩,
    end),

    letI := classical.dec,
    simp [not_forall, not_imp] at this,
    rcases this with ⟨x, hx₁, hx₂⟩,
    simpa [hx₂] using s.smul x⁻¹ hx₁,
end

instance division_ring_is_noetherian : is_noetherian_ring α := {
    noetherian := λ s, begin
        letI := classical.dec,
        unfold submodule.fg,
        by_cases s = ⊥,
        {refine ⟨{0}, by simp [h, submodule.span_eq_bot]⟩},
        {
            refine ⟨{1}, _⟩,
            ext y,
            refine ⟨λ _, by simp [submodule.ext'_iff.symm] at h; simpa using s.smul y (submodule_ne_zero h),
            λ _, by simp [submodule.mem_span]; from λ p hp, by simpa using p.smul _ hp⟩,
        }
    end
}

end division_ring

open finsupp
namespace mv_polynomial
variables {σ : Type*} {α : Type*} [decidable_eq σ] [decidable_eq α]
variables [fintype σ] [comm_ring α] [is_noetherian_ring α]

lemma ideal_wf : well_founded ((>) : ideal (mv_polynomial σ α) → ideal (mv_polynomial σ α) → Prop)
    := is_noetherian_iff_well_founded.1 is_noetherian_ring_mv_polynomial_of_fintype

end mv_polynomial


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Mario Carneiro

Cofinality on ordinals, regular cardinals.
-/
import set_theory.ordinal
noncomputable theory

open function cardinal
local attribute [instance] classical.prop_decidable

universes u v w
variables {α : Type*} {r : α → α → Prop}

/-- Cofinality of a reflexive order `≼`. This is the smallest cardinality
  of a subset `S : set α` such that `∀ a, ∃ b ∈ S, a ≼ b`. -/
def order.cof (r : α → α → Prop) [is_refl α r] : cardinal :=
@cardinal.min {S : set α // ∀ a, ∃ b ∈ S, r a b}
  ⟨⟨set.univ, λ a, ⟨a, ⟨⟩, refl _⟩⟩⟩
  (λ S, mk S)

theorem order_iso.cof.aux {α : Type u} {β : Type v} {r s}
  [is_refl α r] [is_refl β s] (f : r ≃o s) :
  cardinal.lift.{u (max u v)} (order.cof r) ≤
  cardinal.lift.{v (max u v)} (order.cof s) :=
begin
  rw [order.cof, order.cof, lift_min, lift_min, cardinal.le_min],
  intro S, cases S with S H, simp [(∘)],
  refine le_trans (min_le _ _) _,
  { exact ⟨f ⁻¹' S, λ a,
    let ⟨b, bS, h⟩ := H (f a) in ⟨f.symm b, by simp [bS, f.ord', h,
      -coe_fn_coe_base, -coe_fn_coe_trans, principal_seg.coe_coe_fn', initial_seg.coe_coe_fn]⟩⟩ },
  { exact lift_mk_le.{u v (max u v)}.2
    ⟨⟨λ ⟨x, h⟩, ⟨f x, h⟩, λ ⟨x, h₁⟩ ⟨y, h₂⟩ h₃,
      by congr; injection h₃ with h'; exact f.to_equiv.bijective.1 h'⟩⟩ }
end

theorem order_iso.cof {α : Type u} {β : Type v} {r s}
  [is_refl α r] [is_refl β s] (f : r ≃o s) :
  cardinal.lift.{u (max u v)} (order.cof r) =
  cardinal.lift.{v (max u v)} (order.cof s) :=
le_antisymm (order_iso.cof.aux f) (order_iso.cof.aux f.symm)

namespace ordinal

/-- Cofinality of an ordinal. This is the smallest cardinal of a
  subset `S` of the ordinal which is unbounded, in the sense
  `∀ a, ∃ b ∈ S, a ≤ b`. It is defined for all ordinals, but
  `cof 0 = 0` and `cof (succ o) = 1`, so it is only really
  interesting on limit ordinals (when it is an infinite cardinal). -/
def cof (o : ordinal.{u}) : cardinal.{u} :=
quot.lift_on o (λ ⟨α, r, _⟩,
  @order.cof α (λ x y, ¬ r y x) ⟨λ a, by resetI; apply irrefl⟩) $
λ ⟨α, r, _⟩ ⟨β, s, _⟩ ⟨⟨f, hf⟩⟩, begin
  show @order.cof α (λ x y, ¬ r y x) ⟨_⟩ = @order.cof β (λ x y, ¬ s y x) ⟨_⟩,
  refine cardinal.lift_inj.1 (@order_iso.cof _ _ _ _ ⟨_⟩ ⟨_⟩ _),
  exact ⟨f, λ a b, not_congr hf⟩,
end

theorem le_cof_type [is_well_order α r] {c} : c ≤ cof (type r) ↔
  ∀ S : set α, (∀ a, ∃ b ∈ S, ¬ r b a) → c ≤ mk S :=
by dsimp [cof, order.cof, type, quotient.mk, quot.lift_on];
   rw [cardinal.le_min, subtype.forall]; refl

theorem cof_type_le [is_well_order α r] (S : set α) (h : ∀ a, ∃ b ∈ S, ¬ r b a) :
  cof (type r) ≤ mk S :=
le_cof_type.1 (le_refl _) S h

theorem lt_cof_type [is_well_order α r] (S : set α) (hl : mk S < cof (type r)) :
  ∃ a, ∀ b ∈ S, r b a :=
not_forall_not.1 $ λ h, not_le_of_lt hl $ cof_type_le S (λ a, not_ball.1 (h a))

theorem cof_eq (r : α → α → Prop) [is_well_order α r] :
  ∃ S : set α, (∀ a, ∃ b ∈ S, ¬ r b a) ∧ mk S = cof (type r) :=
begin
  have : ∃ i, cof (type r) = _,
  { dsimp [cof, order.cof, type, quotient.mk, quot.lift_on],
    apply cardinal.min_eq },
  exact let ⟨⟨S, hl⟩, e⟩ := this in ⟨S, hl, e.symm⟩,
end

theorem ord_cof_eq (r : α → α → Prop) [is_well_order α r] :
  ∃ S : set α, (∀ a, ∃ b ∈ S, ¬ r b a) ∧ type (subrel r S) = (cof (type r)).ord :=
let ⟨S, hS, e⟩ := cof_eq r, ⟨s, _, e'⟩ := cardinal.ord_eq S,
    T : set α := {a | ∃ aS : a ∈ S, ∀ b : S, s b ⟨_, aS⟩ → r b a} in
begin
  resetI, suffices,
  { refine ⟨T, this,
      le_antisymm _ (cardinal.ord_le.2 $ cof_type_le T this)⟩,
    rw [← e, e'],
    refine type_le'.2 ⟨order_embedding.of_monotone
      (λ a, ⟨a, let ⟨aS, _⟩ := a.2 in aS⟩) (λ a b h, _)⟩,
    rcases a with ⟨a, aS, ha⟩, rcases b with ⟨b, bS, hb⟩,
    change s ⟨a, _⟩ ⟨b, _⟩,
    refine ((trichotomous_of s _ _).resolve_left (λ hn, _)).resolve_left _,
    { exact asymm h (ha _ hn) },
    { intro e, injection e with e, subst b,
      exact irrefl _ h } },
  { intro a,
    have : {b : S | ¬ r b a} ≠ ∅ := let ⟨b, bS, ba⟩ := hS a in
      @set.ne_empty_of_mem S {b | ¬ r b a} ⟨b, bS⟩ ba,
    let b := (is_well_order.wf s).min _ this,
    have ba : ¬r b a := (is_well_order.wf s).min_mem _ this,
    refine ⟨b, ⟨b.2, λ c, not_imp_not.1 $ λ h, _⟩, ba⟩,
    rw [show ∀b:S, (⟨b, b.2⟩:S) = b, by intro b; cases b; refl],
    exact (is_well_order.wf s).not_lt_min _ this
      (is_order_connected.neg_trans h ba) }
end

theorem lift_cof (o) : (cof o).lift = cof o.lift :=
induction_on o $ begin introsI α r _,
  cases lift_type r with _ e, rw e,
  apply le_antisymm,
  { refine le_cof_type.2 (λ S H, _),
    have : (mk (ulift.up ⁻¹' S)).lift ≤ mk S :=
     ⟨⟨λ ⟨⟨x, h⟩⟩, ⟨⟨x⟩, h⟩,
       λ ⟨⟨x, h₁⟩⟩ ⟨⟨y, h₂⟩⟩ e, by simp at e; congr; injection e⟩⟩,
    refine le_trans (cardinal.lift_le.2 $ cof_type_le _ _) this,
    exact λ a, let ⟨⟨b⟩, bs, br⟩ := H ⟨a⟩ in ⟨b, bs, br⟩ },
  { rcases cof_eq r with ⟨S, H, e'⟩,
    have : mk (ulift.down ⁻¹' S) ≤ (mk S).lift :=
     ⟨⟨λ ⟨⟨x⟩, h⟩, ⟨⟨x, h⟩⟩,
       λ ⟨⟨x⟩, h₁⟩ ⟨⟨y⟩, h₂⟩ e, by simp at e; congr; injections⟩⟩,
    rw e' at this,
    refine le_trans (cof_type_le _ _) this,
    exact λ ⟨a⟩, let ⟨b, bs, br⟩ := H a in ⟨⟨b⟩, bs, br⟩ }
end

theorem cof_le_card (o) : cof o ≤ card o :=
induction_on o $ λ α r _, begin
  resetI,
  have : mk (@set.univ α) = card (type r) :=
    quotient.sound ⟨equiv.set.univ _⟩,
  rw ← this, exact cof_type_le set.univ (λ a, ⟨a, ⟨⟩, irrefl a⟩)
end

theorem cof_ord_le (c : cardinal) : cof c.ord ≤ c :=
by simpa using cof_le_card c.ord

@[simp] theorem cof_zero : cof 0 = 0 :=
le_antisymm (by simpa using cof_le_card 0) (cardinal.zero_le _)

@[simp] theorem cof_eq_zero {o} : cof o = 0 ↔ o = 0 :=
⟨induction_on o $ λ α r _ z, by exactI
  let ⟨S, hl, e⟩ := cof_eq r in type_eq_zero_iff_empty.2 $
  λ ⟨a⟩, let ⟨b, h, _⟩ := hl a in
  ne_zero_iff_nonempty.2 (by exact ⟨⟨_, h⟩⟩) (e.trans z),
λ e, by simp [e]⟩

@[simp] theorem cof_succ (o) : cof (succ o) = 1 :=
begin
  apply le_antisymm,
  { refine induction_on o (λ α r _, _),
    change cof (type _) ≤ _,
    rw [← (_ : mk _ = 1)], apply cof_type_le,
    { refine λ a, ⟨sum.inr punit.star, set.mem_singleton _, _⟩,
      rcases a with a|⟨⟨⟨⟩⟩⟩; simp [empty_relation] },
    { rw [cardinal.fintype_card, set.card_singleton], simp } },
  { rw [← cardinal.succ_zero, cardinal.succ_le],
    simpa [lt_iff_le_and_ne, cardinal.zero_le] using
      λ h, succ_ne_zero o (cof_eq_zero.1 (eq.symm h)) }
end

@[simp] theorem cof_eq_one_iff_is_succ {o} : cof.{u} o = 1 ↔ ∃ a, o = succ a :=
⟨induction_on o $ λ α r _ z, begin
  resetI,
  rcases cof_eq r with ⟨S, hl, e⟩, rw z at e,
  cases ne_zero_iff_nonempty.1 (by rw e; exact one_ne_zero) with a,
  refine ⟨typein r a, eq.symm $ quotient.sound
    ⟨order_iso.of_surjective (order_embedding.of_monotone _
      (λ x y, _)) (λ x, _)⟩⟩,
  { apply sum.rec; [exact subtype.val, exact λ _, a] },
  { rcases x with x|⟨⟨⟨⟩⟩⟩; rcases y with y|⟨⟨⟨⟩⟩⟩;
      simp [subrel, order.preimage, empty_relation],
    exact x.2 },
  { suffices : r x a ∨ ∃ (b : punit), ↑a = x, {simpa},
    rcases trichotomous_of r x a with h|h|h,
    { exact or.inl h },
    { exact or.inr ⟨punit.star, h.symm⟩ },
    { rcases hl x with ⟨a', aS, hn⟩,
      rw (_ : ↑a = a') at h, {exact absurd h hn},
      refine congr_arg subtype.val (_ : a = ⟨a', aS⟩),
      haveI := le_one_iff_subsingleton.1 (le_of_eq e),
      apply subsingleton.elim } }
end, λ ⟨a, e⟩, by simp [e]⟩

@[simp] theorem cof_add (a b : ordinal) : b ≠ 0 → cof (a + b) = cof b :=
induction_on a $ λ α r _, induction_on b $ λ β s _ b0, begin
  resetI,
  change cof (type _) = _,
  refine eq_of_forall_le_iff (λ c, _),
  rw [le_cof_type, le_cof_type],
  split; intros H S hS,
  { refine le_trans (H {a | sum.rec_on a (∅:set α) S} (λ a, _)) ⟨⟨_, _⟩⟩,
    { cases a with a b,
      { cases type_ne_zero_iff_nonempty.1 b0 with b,
        rcases hS b with ⟨b', bs, _⟩,
        exact ⟨sum.inr b', bs, by simp⟩ },
      { rcases hS b with ⟨b', bs, h⟩,
        exact ⟨sum.inr b', bs, by simp [h]⟩ } },
    { exact λ a, match a with ⟨sum.inr b, h⟩ := ⟨b, h⟩ end },
    { exact λ a b, match a, b with
        ⟨sum.inr a, h₁⟩, ⟨sum.inr b, h₂⟩, h := by congr; injection h
      end } },
  { refine le_trans (H (sum.inr ⁻¹' S) (λ a, _)) ⟨⟨_, _⟩⟩,
    { rcases hS (sum.inr a) with ⟨a'|b', bs, h⟩; simp at h,
      { cases h }, { exact ⟨b', bs, h⟩ } },
    { exact λ ⟨a, h⟩, ⟨_, h⟩ },
    { exact λ ⟨a, h₁⟩ ⟨b, h₂⟩ h,
        by injection h with h; congr; injection h } }
end

@[simp] theorem cof_cof (o : ordinal) : cof (cof o).ord = cof o :=
le_antisymm (le_trans (cof_le_card _) (by simp)) $
induction_on o $ λ α r _, by exactI
let ⟨S, hS, e₁⟩ := ord_cof_eq r,
    ⟨T, hT, e₂⟩ := cof_eq (subrel r S) in begin
  rw e₁ at e₂, rw ← e₂,
  refine le_trans (cof_type_le {a | ∃ h, (subtype.mk a h : S) ∈ T} (λ a, _)) ⟨⟨_, _⟩⟩,
  { rcases hS a with ⟨b, bS, br⟩,
    rcases hT ⟨b, bS⟩ with ⟨⟨c, cS⟩, cT, cs⟩,
    exact ⟨c, ⟨cS, cT⟩, is_order_connected.neg_trans cs br⟩ },
  { exact λ ⟨a, h⟩, ⟨⟨a, h.fst⟩, h.snd⟩ },
  { exact λ ⟨a, ha⟩ ⟨b, hb⟩ h,
      by injection h with h; congr; injection h },
end

theorem omega_le_cof {o} : cardinal.omega ≤ cof o ↔ is_limit o :=
begin
  rcases zero_or_succ_or_limit o with rfl|⟨o,rfl⟩|l,
  { simp [not_zero_is_limit, cardinal.omega_ne_zero] },
  { simp [not_succ_is_limit, cardinal.one_lt_omega] },
  { simp [l], refine le_of_not_lt (λ h, _),
    cases cardinal.lt_omega.1 h with n e,
    have := cof_cof o,
    rw [e, ord_nat] at this,
    cases n,
    { simp at e, simpa [e, not_zero_is_limit] using l },
    { rw [← nat_cast_succ, cof_succ] at this,
      rw [← this, cof_eq_one_iff_is_succ] at e,
      rcases e with ⟨a, rfl⟩,
      exact not_succ_is_limit _ l } }
end

@[simp] theorem cof_omega : cof omega = cardinal.omega :=
le_antisymm
  (by rw ← card_omega; apply cof_le_card)
  (omega_le_cof.2 omega_is_limit)

theorem cof_eq' (r : α → α → Prop) [is_well_order α r] (h : is_limit (type r)) :
  ∃ S : set α, (∀ a, ∃ b ∈ S, r a b) ∧ mk S = cof (type r) :=
let ⟨S, H, e⟩ := cof_eq r in
⟨S, λ a,
  let a' := enum r _ (h.2 _ (typein_lt_type r a)) in
  let ⟨b, h, ab⟩ := H a' in
  ⟨b, h, (is_order_connected.conn a b a' $ (typein_lt_typein r).1
    (by rw typein_enum; apply ordinal.lt_succ_self)).resolve_right ab⟩,
e⟩

theorem cof_sup_le_lift {ι} (f : ι → ordinal) (H : ∀ i, f i < sup f) :
  cof (sup f) ≤ (mk ι).lift :=
begin
  generalize e : sup f = o,
  refine ordinal.induction_on o _ e, introsI α r _ e',
  rw e' at H,
  refine le_trans (cof_type_le (set.range (λ i, enum r _ (H i))) _)
    ⟨embedding.of_surjective _⟩,
  { intro a, by_contra h,
    apply not_le_of_lt (typein_lt_type r a),
    rw [← e', sup_le],
    intro i,
    simp [set.range] at h,
    simpa using le_of_lt ((typein_lt_typein r).2 (h _ i rfl)) },
  { exact λ i, ⟨_, set.mem_range_self i.1⟩ },
  { intro a, rcases a with ⟨_, i, rfl⟩, exact ⟨⟨i⟩, by simp⟩ }
end

theorem cof_sup_le {ι} (f : ι → ordinal) (H : ∀ i, f i < sup.{u u} f) :
  cof (sup.{u u} f) ≤ mk ι :=
by simpa using cof_sup_le_lift.{u u} f H

theorem cof_bsup_le_lift {o : ordinal} : ∀ (f : Π a < o, ordinal), (∀ i h, f i h < bsup o f) →
  cof (bsup o f) ≤ o.card.lift :=
induction_on o $ λ α r _ f H,
by rw bsup_type; refine cof_sup_le_lift _ _;
   rw ← bsup_type; intro a; apply H

theorem cof_bsup_le {o : ordinal} : ∀ (f : Π a < o, ordinal), (∀ i h, f i h < bsup.{u u} o f) →
  cof (bsup.{u u} o f) ≤ o.card :=
induction_on o $ λ α r _ f H,
by simpa using cof_bsup_le_lift.{u u} f H

@[simp] theorem cof_univ : cof univ.{u v} = cardinal.univ :=
le_antisymm (cof_le_card _) begin
  refine le_of_forall_lt (λ c h, _),
  rcases lt_univ'.1 h with ⟨c, rfl⟩,
  rcases @cof_eq ordinal.{u} (<) _ with ⟨S, H, Se⟩,
  rw [univ, ← lift_cof, ← cardinal.lift_lift, cardinal.lift_lt, ← Se],
  refine lt_of_not_ge (λ h, _),
  cases cardinal.lift_down h with a e,
  refine quotient.induction_on a (λ α e, _) e,
  cases quotient.exact e with f,
  have f := equiv.ulift.symm.trans f,
  let g := λ a, (f a).1,
  let o := succ (sup.{u u} g),
  rcases H o with ⟨b, h, l⟩,
  refine l (lt_succ.2 _),
  rw ← show g (f.symm ⟨b, h⟩) = b, by dsimp [g]; simp,
  apply le_sup
end

end ordinal

namespace cardinal
open ordinal

local infixr ^ := @pow cardinal.{u} cardinal cardinal.has_pow

/-- A cardinal is a limit if it is not zero or a successor
  cardinal. Note that `ω` is a limit cardinal by this definition. -/
def is_limit (c : cardinal) : Prop :=
c ≠ 0 ∧ ∀ x < c, succ x < c

/-- A cardinal is a strong limit if it is not zero and it is
  closed under powersets. Note that `ω` is a strong limit by this definition. -/
def is_strong_limit (c : cardinal) : Prop :=
c ≠ 0 ∧ ∀ x < c, 2 ^ x < c

theorem is_strong_limit.is_limit {c} (H : is_strong_limit c) : is_limit c :=
⟨H.1, λ x h, lt_of_le_of_lt (succ_le.2 $ cantor _) (H.2 _ h)⟩

/-- A cardinal is regular if it is infinite and it equals its own cofinality. -/
def is_regular (c : cardinal) : Prop :=
omega ≤ c ∧ c.ord.cof = c

theorem cof_is_regular {o : ordinal} (h : o.is_limit) : is_regular o.cof :=
⟨omega_le_cof.2 h, cof_cof _⟩

theorem omega_is_regular : is_regular omega :=
⟨le_refl _, by simp⟩

theorem succ_is_regular {c : cardinal.{u}} (h : omega ≤ c) : is_regular (succ c) :=
⟨le_trans h (le_of_lt $ lt_succ_self _), begin
  refine le_antisymm (cof_ord_le _) (succ_le.2 _),
  cases quotient.exists_rep (succ c) with α αe, simp at αe,
  rcases ord_eq α with ⟨r, wo, re⟩, resetI,
  have := ord_is_limit (le_trans h $ le_of_lt $ lt_succ_self _),
  rw [← αe, re] at this ⊢,
  rcases cof_eq' r this with ⟨S, H, Se⟩,
  rw [← Se],
  apply le_imp_le_iff_lt_imp_lt.1 (mul_le_mul_right c),
  rw [mul_eq_self h, ← succ_le, ← αe, ← sum_const],
  refine le_trans _ (sum_le_sum (λ x:S, card (typein r x)) _ _),
  { simp [typein, sum_mk (λ x:S, {a//r a x})],
    refine ⟨embedding.of_surjective _⟩,
    { exact λ x, x.2.1 },
    { exact λ a, let ⟨b, h, ab⟩ := H a in ⟨⟨⟨_, h⟩, _, ab⟩, rfl⟩ } },
  { intro i,
    rw [← lt_succ, ← lt_ord, ← αe, re],
    apply typein_lt_type }
end⟩

theorem sup_lt_of_is_regular {ι} (f : ι → cardinal)
  {c} (hc : is_regular c) (H1 : cardinal.mk ι < c)
  (H2 : ∀ i, f i < c) : sup.{u u} f < c :=
begin
  refine lt_of_le_of_ne (sup_le.2 (λ i, le_of_lt $ H2 i)) _,
  rintro rfl, apply not_le_of_lt H1,
  simpa [sup_ord, H2, hc.2] using cof_sup_le.{u} (λ i, (f i).ord)
end

theorem sum_lt_of_is_regular {ι} (f : ι → cardinal)
  {c} (hc : is_regular c) (H1 : cardinal.mk ι < c)
  (H2 : ∀ i, f i < c) : sum.{u u} f < c :=
lt_of_le_of_lt (sum_le_sup _) $ mul_lt_of_lt hc.1 H1 $
sup_lt_of_is_regular f hc H1 H2

/-- A cardinal is inaccessible if it is an
  uncountable regular strong limit cardinal. -/
def is_inaccessible (c : cardinal) :=
omega < c ∧ is_regular c ∧ is_strong_limit c

theorem is_inaccessible.mk {c}
 (h₁ : omega < c) (h₂ : c ≤ c.ord.cof) (h₃ : ∀ x < c, 2 ^ x < c) :
 is_inaccessible c :=
⟨h₁, ⟨le_of_lt h₁, le_antisymm (cof_ord_le _) h₂⟩,
  ne_of_gt (lt_trans omega_pos h₁), h₃⟩

/- Lean's foundations prove the existence of ω many inaccessible
   cardinals -/
theorem univ_inaccessible : is_inaccessible (univ.{u v}) :=
is_inaccessible.mk
  (by simpa using lift_lt_univ' omega)
  (by simp)
  (λ c h, begin
    rcases lt_univ'.1 h with ⟨c, rfl⟩,
    rw ← lift_two_power.{u (max (u+1) v)},
    apply lift_lt_univ'
  end)

theorem lt_power_cof {c : cardinal.{u}} : omega ≤ c → c < c ^ cof c.ord :=
quotient.induction_on c $ λ α h, begin
  rcases ord_eq α with ⟨r, wo, re⟩, resetI,
  have := ord_is_limit h,
  rw [mk_def, re] at this ⊢,
  rcases cof_eq' r this with ⟨S, H, Se⟩,
  have := sum_lt_prod (λ a:S, mk {x // r x a}) (λ _, mk α) (λ i, _),
  { simp [Se.symm] at this ⊢,
    refine lt_of_le_of_lt _ this,
    refine ⟨embedding.of_surjective _⟩,
    { exact λ x, x.2.1 },
    { exact λ a, let ⟨b, h, ab⟩ := H a in ⟨⟨⟨_, h⟩, _, ab⟩, rfl⟩ } },
  { have := typein_lt_type r i,
    rwa [← re, lt_ord] at this }
end

theorem lt_cof_power {a b : cardinal} (ha : omega ≤ a) (b1 : 1 < b) :
  a < cof (b ^ a).ord :=
begin
  have b0 : b ≠ 0 := ne_of_gt (lt_trans zero_lt_one b1),
  apply le_imp_le_iff_lt_imp_lt.1 (power_le_power_left $ power_ne_zero a b0),
  rw [power_mul, mul_eq_self ha],
  exact lt_power_cof (le_trans ha $ le_of_lt $ cantor' _ b1),
end

end cardinal


import data.nat.gcd
import algebra.big_operators

import data.zmod.basic

def divides (d n: ℤ):=  ∃l:ℤ, n = d*l
def is_congruent_mod_n (a b n: ℤ) := divides n (b-a)
def relatively_prime(a b:ℤ) := ∀l:ℤ,
l≥ 2 → (divides l a) → ¬(divides l b)

theorem relatively_prime_sum_to_one (a b : ℤ) (h : relatively_prime a b) :
∃ m n: ℤ, m* a + n * b = 1 :=
begin
  sorry,
end

--helper theorem that is not true :(--
-- the iff is not true, but I can't use it without it--
theorem divides_in_product (a c: ℤ): (∃ b:ℤ , a*b = c) ↔ divides a c:=
begin
  split,
  {
    intros,
    rw divides,
    cases a_1 with ell,
    --by library_search,
    exact Exists.intro ell (eq.symm a_1_h),
  },
  {
    intros,
    cases a_1 with ell,
    --by library_search,
    exact Exists.intro ell (eq.symm a_1_h),
  },
end

--Generalized Euclid Lemma --
theorem divides_product_coprime_and_not_coprime (a b n:ℤ) (c: divides n (a*b))
(d: relatively_prime a n):
divides n b:=
begin
  -- cases breaks down existential qualifiers
  cases c with l k,
  cases relatively_prime_sum_to_one a n d with m h,
  cases h with q manb_eq_one,

  -- multiplies both sides by b
  have := congr_arg (has_mul.mul b) manb_eq_one, -- does not work if I covert to naturals
  rw [mul_one] at this,
  -- this : b * (m * a + q * n) = b

  -- order-changing
  rw [mul_add] at this,
  rw [mul_comm] at this,
  rw [mul_assoc] at this,
  rw k at this,
  rw [mul_comm] at this,
  rw [mul_assoc] at this,
  rw [add_comm] at this,
  rw [mul_comm] at this,
  rw [mul_assoc] at this,
  rw [mul_left_comm] at this,
  rw <- mul_add at this,

  rw divides,
  --by library_search,
  exact Exists.intro (q * b + l * m) (eq.symm this),
--  rw divides_in_product n (q*b+l*m) b at this, -- can use "apply" instead and get rid of iff

end

lemma xyz : ∀ x y z:ℤ, x*y*z = y*x*z:=
begin
  intros,
  have xy: x*y = y*x,
  {
    rw mul_comm,
  },
  rw xy,
end

theorem cancel_out_mod_n (a b c n: ℤ) (p: is_congruent_mod_n (a*b) (a*c) n)
(q: relatively_prime a n) : is_congruent_mod_n b c n :=
-- need a!=0; n≥ 2...!!!
begin
  cases p with j k,
  rw <-mul_sub at k,  --does not work if I convert to naturals
  rw eq_comm at k,

  rw is_congruent_mod_n,
  rw divides,

  have mExists : ∃ m:ℤ , a*m=j,
  {
    have bezout : ∃ u v :ℤ, u*a + v*n =1,
    {
      --by library_search,
      exact relatively_prime_sum_to_one a n q,
    },
    cases bezout with u vv,
    cases vv with v bezout,

    use u  * j + v * (c - b)   ,

    have rw1: a * (u * j + v * (c - b)) = a * (u * j) + a * (v * (c - b)),
    {
      --by library_search,
      exact mul_add a (u * j) (v * (c - b)),
    },
    rw rw1,
    clear rw1,

    have rw2: a * (u * j) + a * (v * (c - b)) =
    a * (u * j) + a *  v * (c - b),
    {
      --by library_search,
      sorry,
    },
    rw rw2,

    sorry,
/-
    have timesJ : (u * a  + v * n)*j = 1*j,
    {
      --by library_search,
      exact congr_fun (congr_arg has_mul.mul bezout) j,
    },

    have rw11: (u * a + v * n) * j = u * a *j + v * n * j ,
    {
      --by library_search,
      exact add_mul (u * a) (v * n) j,
    },

    have rw2: u * a * j + v * n * j = 1*j,
    {
      --by library_search,
      exact (eq.congr rfl timesJ).mp (eq.symm rw1),
    },

    have rw3: u * a * j + v * n * j = j,
    {
--      by library_search,
      sorry,
    },

    sorry,
--    m=
-/
  },
  cases mExists,

  rw eq_comm at mExists_h,

  rw mExists_h at k,

  rw ← mul_assoc at k,

  use mExists_w,

  have rw1: n * a * mExists_w
  =
  a* n * mExists_w ,
  {
    exact xyz n a mExists_w,
  },
  rw rw1 at k,
  symmetry,

  sorry,
/-
  rw divides_in_product n j (a*(c-b)) at k,  -- cannot use "apply" and get rid of iff
  apply divides_product_coprime_and_not_coprime a (c-b) n,
  {
    apply k,
  },
  {
    apply q,
  },
-/
end

--bad definition
def rsc (n: nat) := {k: nat| k<n ∧ k.coprime n}

-- Zulip definition for residue class --
example (n : ℕ+) : units (zmod n) ≃ {x : zmod n // nat.coprime x.val n} :=
zmod.units_equiv_coprime


import data.real.cardinality

-- The Non-Denumerability of the Continuum

open set

lemma t022 : ¬ countable (set.univ : set ℝ) := cardinal.not_countable_real


import analysis.topology.topological_space
import analysis.topology.continuity
import data.set.basic
import logic.basic
import Topology.Material.connected_spaces
import Topology.Material.Path_Homotopy_29_07
import Topology.Material.path_connectedness

open set filter lattice classical
local attribute [instance] prop_decidable

universe u
variables {α : Type u} {β : Type u}

-- Locally connected / path connected spaces

open path

lemma exists_from_path [topological_space α] {x y : α} (H : path x y) : ∃ f : I01 → α, is_path x y f :=
exists.intro H.1 ⟨H.2,H.3,H.4⟩

def is_loc_con_at [topological_space α] (x : α) : Prop :=
∀ U : set α, x ∈ U → is_open U → (∃ V : set α, is_connected V ∧ is_open V ∧ x ∈ V ∧ V ⊂ U)

lemma is_loc_con_lemma [topological_space α] {x : α} {U : set α} (H1 : x ∈ U) (H2 : is_open U)
(H3 : is_loc_con_at x) : ∃ V : set α, is_connected V ∧ is_open V ∧ x ∈ V ∧ V ⊂ U := H3 U H1 H2

class locally_connected_space α extends topological_space α :=
  (forall_loc_con_at : ∀ x : α, is_loc_con_at x)

def is_loc_pcon_at [topological_space α] (x : α) : Prop :=
∀ U : set α, x ∈ U → is_open U → (∃ V : set α, is_path_connected V ∧ is_open V ∧ x ∈ V ∧ V ⊂ U)

lemma is_loc_pcon_lemma [topological_space α] {x : α} {U : set α} (H1 : x ∈ U) (H2 : is_open U)
(H3 : is_loc_pcon_at x) : ∃ V : set α, is_path_connected V ∧ is_open V ∧ x ∈ V ∧ V ⊂ U := H3 U H1 H2

class locally_path_connected_space α extends topological_space α :=
  (forall_loc_con_at : ∀ x : α, is_loc_pcon_at x)

def set_of_pcon_to_point [topological_space α] (x : α) : set α := {y : α | ∃ f : I01 → α, is_path x y f}

lemma self_mem_set_of_pcon [topological_space α] {x : α} : x ∈ set_of_pcon_to_point x :=
by {unfold set_of_pcon_to_point, rw [mem_set_of_eq], exact exists_id_path x}

lemma set_of_pcon_nempty [topological_space α] {x : α} : set_of_pcon_to_point x ≠ ∅ :=
ne_empty_of_mem self_mem_set_of_pcon

-- Fix these

lemma subpath_left [topological_space α] {x y : α} (H1 : path x y) (r : I01) :
path x (H1.1 r) := sorry

lemma subpath_right [topological_space α] {x y : α} (H1 : path x y) (r : I01) :
path (H1.1 r) y := sorry

lemma exists_subpath_left [topological_space α] {x y : α} {f : I01 → α} (H1 : is_path x y f)
(r : I01) : ∃ f' : I01 → α, is_path x (f r) f' := sorry

lemma exists_subpath_right [topological_space α] {x y : α} {f : I01 → α} (H1 : is_path x y f)
(r : I01) : ∃ f' : I01 → α, is_path (f r) y f' := sorry

lemma set_of_pcon_is_pcon [topological_space α] : ∀ x : α, is_path_connected (set_of_pcon_to_point x) :=
begin
  intros z x y hx hy, rw set_of_pcon_to_point at hx hy, simp at hx hy,
  cases hx with fx Hzx, cases hy with fy Hzy,
  cases (exists_from_path (comp_of_path (inv_of_path (to_path fx Hzx)) (to_path fy Hzy))) with f Hxy,
  have H2 : ∀ r : I01, f r ∈ set_of_pcon_to_point z,
    {intro r,
    cases (exists_subpath_left (Hxy) r) with f' Hxfr,
    have H4 : ∃ f'' : I01 → α, is_path z (f r) f'' :=
      exists_from_path (comp_of_path (to_path fx Hzx) (to_path f' Hxfr)),
    rw set_of_pcon_to_point, simp, assumption},
  exact exists.intro f ⟨Hxy,H2⟩,
end

lemma exists_open_pcon [topological_space α] {x : α} (H : is_loc_pcon_at x) :
∃ V : set α, is_open V ∧ is_path_connected V :=
begin
  unfold is_loc_pcon_at at H, admit
end

theorem loc_pcon_and_con_imp_pcon [connected_space α] (H1 : ∀ x : α, is_loc_pcon_at x)
{t : α} : path_connected_space α :=
begin
  let S : α → set α := set_of_pcon_to_point,
  suffices h1 : ∀ x : α, is_clopen (S x),
    have h2 : ∀ x : α, S x = univ :=
      (assume x, or.elim ((assume x, connected_space.clopen_trivial (S x) (h1 x)) x)
      (by simp) (assume a1, by exact absurd a1 set_of_pcon_nempty)),
    have h3 : ∀ x : α, ∃ y : α, y ∈ S x := (assume x, exists_mem_of_ne_empty set_of_pcon_nempty),
    have h4 : ∀ x : α, is_path_connected univ,
      {intro x, rw [←h2], exact set_of_pcon_is_pcon x},
    exact path_connected_space.mk ((is_pcon_univ_iff_pcon _ ).mpr (h4 t)),

  intro x, split,

  have g1 : ∀ U : set α, is_open U → x ∈ U → (∀ u ∈ U, ∃ )
/-
  have g1 : ∃ U : set α, is_open U ∧ is_path_connected U,
    {}

  have g2 := (H1 x) (S x) self_mem_set_of_pcon,
  --self_mem_set_of_pcon
  -/
end


/-
Copyright (c) 2022 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel

! This file was ported from Lean 3 source module analysis.calculus.monotone
! 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.MeasureTheory.Measure.Lebesgue
import Mathbin.Analysis.Calculus.Deriv
import Mathbin.MeasureTheory.Covering.OneDim
import Mathbin.Order.Monotone.Extension

/-!
# Differentiability of monotone functions

We show that a monotone function `f : ℝ → ℝ` is differentiable almost everywhere, in
`monotone.ae_differentiable_at`. (We also give a version for a function monotone on a set, in
`monotone_on.ae_differentiable_within_at`.)

If the function `f` is continuous, this follows directly from general differentiation of measure
theorems. Let `μ` be the Stieltjes measure associated to `f`. Then, almost everywhere,
`μ [x, y] / Leb [x, y]` (resp. `μ [y, x] / Leb [y, x]`) converges to the Radon-Nikodym derivative
of `μ` with respect to Lebesgue when `y` tends to `x` in `(x, +∞)` (resp. `(-∞, x)`), by
`vitali_family.ae_tendsto_rn_deriv`. As `μ [x, y] = f y - f x` and `Leb [x, y] = y - x`, this
gives differentiability right away.

When `f` is only monotone, the same argument works up to small adjustments, as the associated
Stieltjes measure satisfies `μ [x, y] = f (y^+) - f (x^-)` (the right and left limits of `f` at `y`
and `x` respectively). One argues that `f (x^-) = f x` almost everywhere (in fact away from a
countable set), and moreover `f ((y - (y-x)^2)^+) ≤ f y ≤ f (y^+)`. This is enough to deduce the
limit of `(f y - f x) / (y - x)` by a lower and upper approximation argument from the known
behavior of `μ [x, y]`.
-/

open Set Filter Function Metric MeasureTheory MeasureTheory.Measure IsDoublingMeasure

open Topology

/-- If `(f y - f x) / (y - x)` converges to a limit as `y` tends to `x`, then the same goes if
`y` is shifted a little bit, i.e., `f (y + (y-x)^2) - f x) / (y - x)` converges to the same limit.
This lemma contains a slightly more general version of this statement (where one considers
convergence along some subfilter, typically `𝓝[<] x` or `𝓝[>] x`) tailored to the application
to almost everywhere differentiability of monotone functions. -/
theorem tendsto_apply_add_mul_sq_div_sub {f : ℝ → ℝ} {x a c d : ℝ} {l : Filter ℝ} (hl : l ≤ 𝓝[≠] x)
    (hf : Tendsto (fun y => (f y - d) / (y - x)) l (𝓝 a))
    (h' : Tendsto (fun y => y + c * (y - x) ^ 2) l l) :
    Tendsto (fun y => (f (y + c * (y - x) ^ 2) - d) / (y - x)) l (𝓝 a) :=
  by
  have L : tendsto (fun y => (y + c * (y - x) ^ 2 - x) / (y - x)) l (𝓝 1) :=
    by
    have : tendsto (fun y => 1 + c * (y - x)) l (𝓝 (1 + c * (x - x))) :=
      by
      apply tendsto.mono_left _ (hl.trans nhdsWithin_le_nhds)
      exact ((tendsto_id.sub_const x).const_mul c).const_add 1
    simp only [_root_.sub_self, add_zero, MulZeroClass.mul_zero] at this
    apply tendsto.congr' (eventually.filter_mono hl _) this
    filter_upwards [self_mem_nhdsWithin]with y hy
    field_simp [sub_ne_zero.2 hy]
    ring
  have Z := (hf.comp h').mul L
  rw [mul_one] at Z
  apply tendsto.congr' _ Z
  have : ∀ᶠ y in l, y + c * (y - x) ^ 2 ≠ x := by apply tendsto.mono_right h' hl self_mem_nhdsWithin
  filter_upwards [this]with y hy
  field_simp [sub_ne_zero.2 hy]
#align tendsto_apply_add_mul_sq_div_sub tendsto_apply_add_mul_sq_div_sub

/-- A Stieltjes function is almost everywhere differentiable, with derivative equal to the
Radon-Nikodym derivative of the associated Stieltjes measure with respect to Lebesgue. -/
theorem StieltjesFunction.ae_hasDerivAt (f : StieltjesFunction) :
    ∀ᵐ x, HasDerivAt f (rnDeriv f.Measure volume x).toReal x :=
  by
  /- Denote by `μ` the Stieltjes measure associated to `f`.
    The general theorem `vitali_family.ae_tendsto_rn_deriv` ensures that `μ [x, y] / (y - x)` tends
    to the Radon-Nikodym derivative as `y` tends to `x` from the right. As `μ [x, y] = f y - f (x^-)`
    and `f (x^-) = f x` almost everywhere, this gives differentiability on the right.
    On the left, `μ [y, x] / (x - y)` again tends to the Radon-Nikodym derivative.
    As `μ [y, x] = f x - f (y^-)`, this is not exactly the right result, so one uses a sandwiching
    argument to deduce the convergence for `(f x - f y) / (x - y)`. -/
  filter_upwards [VitaliFamily.ae_tendsto_rnDeriv (VitaliFamily (volume : Measure ℝ) 1) f.measure,
    rn_deriv_lt_top f.measure volume, f.countable_left_lim_ne.ae_not_mem volume]with x hx h'x h''x
  -- Limit on the right, following from differentiation of measures
  have L1 :
    tendsto (fun y => (f y - f x) / (y - x)) (𝓝[>] x) (𝓝 (rn_deriv f.measure volume x).toReal) :=
    by
    apply
      tendsto.congr' _
        ((ENNReal.tendsto_toReal h'x.ne).comp (hx.comp (Real.tendsto_Icc_vitaliFamily_right x)))
    filter_upwards [self_mem_nhdsWithin]
    rintro y (hxy : x < y)
    simp only [comp_app, StieltjesFunction.measure_Icc, Real.volume_Icc, Classical.not_not.1 h''x]
    rw [← ENNReal.ofReal_div_of_pos (sub_pos.2 hxy), ENNReal.toReal_ofReal]
    exact div_nonneg (sub_nonneg.2 (f.mono hxy.le)) (sub_pos.2 hxy).le
  -- Limit on the left, following from differentiation of measures. Its form is not exactly the one
  -- we need, due to the appearance of a left limit.
  have L2 :
    tendsto (fun y => (left_lim f y - f x) / (y - x)) (𝓝[<] x)
      (𝓝 (rn_deriv f.measure volume x).toReal) :=
    by
    apply
      tendsto.congr' _
        ((ENNReal.tendsto_toReal h'x.ne).comp (hx.comp (Real.tendsto_Icc_vitaliFamily_left x)))
    filter_upwards [self_mem_nhdsWithin]
    rintro y (hxy : y < x)
    simp only [comp_app, StieltjesFunction.measure_Icc, Real.volume_Icc]
    rw [← ENNReal.ofReal_div_of_pos (sub_pos.2 hxy), ENNReal.toReal_ofReal, ← neg_neg (y - x),
      div_neg, neg_div', neg_sub, neg_sub]
    exact div_nonneg (sub_nonneg.2 (f.mono.left_lim_le hxy.le)) (sub_pos.2 hxy).le
  -- Shifting a little bit the limit on the left, by `(y - x)^2`.
  have L3 :
    tendsto (fun y => (left_lim f (y + 1 * (y - x) ^ 2) - f x) / (y - x)) (𝓝[<] x)
      (𝓝 (rn_deriv f.measure volume x).toReal) :=
    by
    apply tendsto_apply_add_mul_sq_div_sub (nhds_left'_le_nhds_ne x) L2
    apply tendsto_nhdsWithin_of_tendsto_nhds_of_eventually_within
    · apply tendsto.mono_left _ nhdsWithin_le_nhds
      have : tendsto (fun y : ℝ => y + 1 * (y - x) ^ 2) (𝓝 x) (𝓝 (x + 1 * (x - x) ^ 2)) :=
        tendsto_id.add (((tendsto_id.sub_const x).pow 2).const_mul 1)
      simpa using this
    · have : Ioo (x - 1) x ∈ 𝓝[<] x :=
        by
        apply Ioo_mem_nhdsWithin_Iio
        exact ⟨by linarith, le_refl _⟩
      filter_upwards [this]
      rintro y ⟨hy : x - 1 < y, h'y : y < x⟩
      rw [mem_Iio]
      nlinarith
  -- Deduce the correct limit on the left, by sandwiching.
  have L4 :
    tendsto (fun y => (f y - f x) / (y - x)) (𝓝[<] x) (𝓝 (rn_deriv f.measure volume x).toReal) :=
    by
    apply tendsto_of_tendsto_of_tendsto_of_le_of_le' L3 L2
    · filter_upwards [self_mem_nhdsWithin]
      rintro y (hy : y < x)
      refine' div_le_div_of_nonpos_of_le (by linarith) ((sub_le_sub_iff_right _).2 _)
      apply f.mono.le_left_lim
      have : 0 < (x - y) ^ 2 := sq_pos_of_pos (sub_pos.2 hy)
      linarith
    · filter_upwards [self_mem_nhdsWithin]
      rintro y (hy : y < x)
      refine' div_le_div_of_nonpos_of_le (by linarith) _
      simpa only [sub_le_sub_iff_right] using f.mono.left_lim_le (le_refl y)
  -- prove the result by splitting into left and right limits.
  rw [hasDerivAt_iff_tendsto_slope, slope_fun_def_field, ← nhds_left'_sup_nhds_right', tendsto_sup]
  exact ⟨L4, L1⟩
#align stieltjes_function.ae_has_deriv_at StieltjesFunction.ae_hasDerivAt

/-- A monotone function is almost everywhere differentiable, with derivative equal to the
Radon-Nikodym derivative of the associated Stieltjes measure with respect to Lebesgue. -/
theorem Monotone.ae_hasDerivAt {f : ℝ → ℝ} (hf : Monotone f) :
    ∀ᵐ x, HasDerivAt f (rnDeriv hf.StieltjesFunction.Measure volume x).toReal x :=
  by
  /- We already know that the Stieltjes function associated to `f` (i.e., `g : x ↦ f (x^+)`) is
    differentiable almost everywhere. We reduce to this statement by sandwiching values of `f` with
    values of `g`, by shifting with `(y - x)^2` (which has no influence on the relevant
    scale `y - x`.)-/
  filter_upwards [hf.stieltjes_function.ae_has_deriv_at,
    hf.countable_not_continuous_at.ae_not_mem volume]with x hx h'x
  have A : hf.stieltjes_function x = f x :=
    by
    rw [Classical.not_not, hf.continuous_at_iff_left_lim_eq_right_lim] at h'x
    apply le_antisymm _ (hf.le_right_lim (le_refl _))
    rw [← h'x]
    exact hf.left_lim_le (le_refl _)
  rw [hasDerivAt_iff_tendsto_slope, (nhds_left'_sup_nhds_right' x).symm, tendsto_sup,
    slope_fun_def_field, A] at hx
  -- prove differentiability on the right, by sandwiching with values of `g`
  have L1 :
    tendsto (fun y => (f y - f x) / (y - x)) (𝓝[>] x)
      (𝓝 (rn_deriv hf.stieltjes_function.measure volume x).toReal) :=
    by
    -- limit of a helper function, with a small shift compared to `g`
    have :
      tendsto (fun y => (hf.stieltjes_function (y + -1 * (y - x) ^ 2) - f x) / (y - x)) (𝓝[>] x)
        (𝓝 (rn_deriv hf.stieltjes_function.measure volume x).toReal) :=
      by
      apply tendsto_apply_add_mul_sq_div_sub (nhds_right'_le_nhds_ne x) hx.2
      apply tendsto_nhdsWithin_of_tendsto_nhds_of_eventually_within
      · apply tendsto.mono_left _ nhdsWithin_le_nhds
        have : tendsto (fun y : ℝ => y + -1 * (y - x) ^ 2) (𝓝 x) (𝓝 (x + -1 * (x - x) ^ 2)) :=
          tendsto_id.add (((tendsto_id.sub_const x).pow 2).const_mul (-1))
        simpa using this
      · have : Ioo x (x + 1) ∈ 𝓝[>] x :=
          by
          apply Ioo_mem_nhdsWithin_Ioi
          exact ⟨le_refl _, by linarith⟩
        filter_upwards [this]
        rintro y ⟨hy : x < y, h'y : y < x + 1⟩
        rw [mem_Ioi]
        nlinarith
    -- apply the sandwiching argument, with the helper function and `g`
    apply tendsto_of_tendsto_of_tendsto_of_le_of_le' this hx.2
    · filter_upwards [self_mem_nhdsWithin]
      rintro y (hy : x < y)
      have : 0 < (y - x) ^ 2 := sq_pos_of_pos (sub_pos.2 hy)
      apply div_le_div_of_le_of_nonneg _ (sub_pos.2 hy).le
      exact (sub_le_sub_iff_right _).2 (hf.right_lim_le (by linarith))
    · filter_upwards [self_mem_nhdsWithin]
      rintro y (hy : x < y)
      apply div_le_div_of_le_of_nonneg _ (sub_pos.2 hy).le
      exact (sub_le_sub_iff_right _).2 (hf.le_right_lim (le_refl y))
  -- prove differentiability on the left, by sandwiching with values of `g`
  have L2 :
    tendsto (fun y => (f y - f x) / (y - x)) (𝓝[<] x)
      (𝓝 (rn_deriv hf.stieltjes_function.measure volume x).toReal) :=
    by
    -- limit of a helper function, with a small shift compared to `g`
    have :
      tendsto (fun y => (hf.stieltjes_function (y + -1 * (y - x) ^ 2) - f x) / (y - x)) (𝓝[<] x)
        (𝓝 (rn_deriv hf.stieltjes_function.measure volume x).toReal) :=
      by
      apply tendsto_apply_add_mul_sq_div_sub (nhds_left'_le_nhds_ne x) hx.1
      apply tendsto_nhdsWithin_of_tendsto_nhds_of_eventually_within
      · apply tendsto.mono_left _ nhdsWithin_le_nhds
        have : tendsto (fun y : ℝ => y + -1 * (y - x) ^ 2) (𝓝 x) (𝓝 (x + -1 * (x - x) ^ 2)) :=
          tendsto_id.add (((tendsto_id.sub_const x).pow 2).const_mul (-1))
        simpa using this
      · have : Ioo (x - 1) x ∈ 𝓝[<] x :=
          by
          apply Ioo_mem_nhdsWithin_Iio
          exact ⟨by linarith, le_refl _⟩
        filter_upwards [this]
        rintro y ⟨hy : x - 1 < y, h'y : y < x⟩
        rw [mem_Iio]
        nlinarith
    -- apply the sandwiching argument, with `g` and the helper function
    apply tendsto_of_tendsto_of_tendsto_of_le_of_le' hx.1 this
    · filter_upwards [self_mem_nhdsWithin]
      rintro y (hy : y < x)
      apply div_le_div_of_nonpos_of_le (sub_neg.2 hy).le
      exact (sub_le_sub_iff_right _).2 (hf.le_right_lim (le_refl _))
    · filter_upwards [self_mem_nhdsWithin]
      rintro y (hy : y < x)
      have : 0 < (y - x) ^ 2 := sq_pos_of_neg (sub_neg.2 hy)
      apply div_le_div_of_nonpos_of_le (sub_neg.2 hy).le
      exact (sub_le_sub_iff_right _).2 (hf.right_lim_le (by linarith))
  -- conclude global differentiability
  rw [hasDerivAt_iff_tendsto_slope, slope_fun_def_field, (nhds_left'_sup_nhds_right' x).symm,
    tendsto_sup]
  exact ⟨L2, L1⟩
#align monotone.ae_has_deriv_at Monotone.ae_hasDerivAt

/-- A monotone real function is differentiable Lebesgue-almost everywhere. -/
theorem Monotone.ae_differentiableAt {f : ℝ → ℝ} (hf : Monotone f) : ∀ᵐ x, DifferentiableAt ℝ f x :=
  by filter_upwards [hf.ae_has_deriv_at]with x hx using hx.differentiable_at
#align monotone.ae_differentiable_at Monotone.ae_differentiableAt

/-- A real function which is monotone on a set is differentiable Lebesgue-almost everywhere on
this set. This version does not assume that `s` is measurable. For a formulation with
`volume.restrict s` assuming that `s` is measurable, see `monotone_on.ae_differentiable_within_at`.
-/
theorem MonotoneOn.ae_differentiableWithinAt_of_mem {f : ℝ → ℝ} {s : Set ℝ} (hf : MonotoneOn f s) :
    ∀ᵐ x, x ∈ s → DifferentiableWithinAt ℝ f s x :=
  by
  /- We use a global monotone extension of `f`, and argue that this extension is differentiable
    almost everywhere. Such an extension need not exist (think of `1/x` on `(0, +∞)`), but it exists
    if one restricts first the function to a compact interval `[a, b]`. -/
  apply ae_of_mem_of_ae_of_mem_inter_Ioo
  intro a b as bs hab
  obtain ⟨g, hg, gf⟩ : ∃ g : ℝ → ℝ, Monotone g ∧ eq_on f g (s ∩ Icc a b) :=
    (hf.mono (inter_subset_left s (Icc a b))).exists_monotone_extension
      (hf.map_bdd_below (inter_subset_left _ _) ⟨a, fun x hx => hx.2.1, as⟩)
      (hf.map_bdd_above (inter_subset_left _ _) ⟨b, fun x hx => hx.2.2, bs⟩)
  filter_upwards [hg.ae_differentiable_at]with x hx
  intro h'x
  apply hx.differentiable_within_at.congr_of_eventually_eq _ (gf ⟨h'x.1, h'x.2.1.le, h'x.2.2.le⟩)
  have : Ioo a b ∈ 𝓝[s] x := nhdsWithin_le_nhds (Ioo_mem_nhds h'x.2.1 h'x.2.2)
  filter_upwards [self_mem_nhdsWithin, this]with y hy h'y
  exact gf ⟨hy, h'y.1.le, h'y.2.le⟩
#align monotone_on.ae_differentiable_within_at_of_mem MonotoneOn.ae_differentiableWithinAt_of_mem

/-- A real function which is monotone on a set is differentiable Lebesgue-almost everywhere on
this set. This version assumes that `s` is measurable and uses `volume.restrict s`.
For a formulation without measurability assumption,
see `monotone_on.ae_differentiable_within_at_of_mem`. -/
theorem MonotoneOn.ae_differentiableWithinAt {f : ℝ → ℝ} {s : Set ℝ} (hf : MonotoneOn f s)
    (hs : MeasurableSet s) : ∀ᵐ x ∂volume.restrict s, DifferentiableWithinAt ℝ f s x :=
  by
  rw [ae_restrict_iff' hs]
  exact hf.ae_differentiable_within_at_of_mem
#align monotone_on.ae_differentiable_within_at MonotoneOn.ae_differentiableWithinAt


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

Define the p-adic valuation on ℤ and ℚ, and the p-adic norm on ℚ
-/

import data.rat data.int.gcd algebra.field_power
import tactic.wlog tactic.ring

universe u
open nat

private lemma exi_div (p : ℕ) (n : ℤ) : ∃ k : ℕ, k ≤ n.nat_abs ∧ ↑(p ^ k) ∣ n :=
⟨0, nat.zero_le _, by simp⟩

private lemma bound {p : ℕ} (hp : p > 1) {n : ℤ} (hn : n ≠ 0) :
        ∀ k : ℕ, k > n.nat_abs → ¬ (↑(p ^ k) ∣ n) :=
assume k (hkn : k > n.nat_abs),
have n.nat_abs < p^k, from lt.trans (lt_pow_self hp _) (pow_lt_pow_of_lt_right hp hkn),
assume hdvd : ↑(p ^ k) ∣ n,
have hdvd' : (p ^ k) ∣ n.nat_abs, from int.dvd_nat_abs_of_of_nat_dvd hdvd,
let hle := le_of_dvd (int.nat_abs_pos_of_ne_zero hn) hdvd' in
not_le_of_gt this hle

def padic_val (p : ℕ) (n : ℤ) : ℕ :=
if hn : n = 0 then 0
else if hp : p > 1 then nat.find_greatest (λ k, ↑(p ^ k) ∣ n) n.nat_abs --(exi_div p n)
else 0

namespace padic_val

lemma spec {p : ℕ} (hp : p > 1) {n : ℤ} (hn : n ≠ 0) : ↑(p ^ padic_val p n) ∣ n :=
let ha := nat.find_greatest_spec (exi_div p n) in
by simpa [padic_val, hp, hn] using ha

lemma is_greatest {p : ℕ} (hp : p > 1) {n : ℤ} (hn : n ≠ 0) (m : ℕ) (hm : m > padic_val p n) :
      ¬ ↑(p ^ m) ∣ n :=
let ha := nat.find_greatest_is_greatest (exi_div p n) in
if hmb : m ≤ n.nat_abs then
  have hfg : nat.find_greatest (λ (m : ℕ), ↑(p ^ m) ∣ n) (int.nat_abs n) < m,
    by simpa [padic_val, hn, hp] using hm,
  ha _ ⟨hfg, hmb⟩
else bound hp hn _ $ lt_of_not_ge hmb

lemma unique {p : ℕ} (hp : p > 1) {n : ℤ} (hn : n ≠ 0) {k : ℕ} (hk : ↑(p^k) ∣ n)
      (hall : ∀ m : ℕ, m > k → ¬ ↑(p^m) ∣ n) : k = padic_val p n :=
have hle : k ≤ padic_val p n, from le_of_not_gt $ λ h, is_greatest hp hn _ h hk,
have hge : k ≥ padic_val p n, from le_of_not_gt $ λ h, hall _ h (spec hp hn),
le_antisymm hle hge

@[simp] protected lemma neg {p : ℕ} (hp : p > 1) (n : ℤ) : padic_val p (-n) = padic_val p n :=
if hn : n = 0 then by simp [hn] else
have hnn : -n ≠ 0, by simp [hn],
unique hp hn
  (have ↑(p ^ padic_val p (-n)) ∣ (-n), from spec hp hnn, dvd_of_dvd_neg this)
  (assume m hm (hdiv : (↑(p^m) ∣ n)),
   have ↑(p^m) ∣ (-n), from dvd_neg_of_dvd hdiv,
   is_greatest hp  hnn _ hm this)

lemma le_padic_val_of_pow_div {p k : ℕ} (hp : p > 1) {n : ℤ} (hn : n ≠ 0) (h : ↑(p^k) ∣ n) :
      k ≤ padic_val p n :=
le_of_not_gt $
  assume : k > padic_val p n,
  is_greatest hp hn _ this h

section
variables {p : ℕ} (hp : p > 1)

@[simp] protected lemma zero : padic_val p 0 = 0 := by simp [padic_val]

include hp
@[simp] protected lemma one : padic_val p 1 = 0 :=
begin
  symmetry,
  apply unique,
  repeat { norm_num },
  { assumption },
  { intros k hk,
    have h1k : 1 ^ k < p ^ k, from pow_lt_pow_of_lt_left hp hk,
    rw nat.one_pow at h1k,
    intro hdvd,
    apply not_le_of_gt h1k,
    apply le_of_dvd zero_lt_one,
    apply int.coe_nat_dvd.1,
    simpa }
end

@[simp] lemma padic_val_self : padic_val p p = 1 :=
have h : p ≠ 0, by intro h'; subst h'; exact absurd hp dec_trivial,
begin
  symmetry, apply unique; simp *,
  intros k hk hdvd,
  apply not_pos_pow_dvd hp hk,
  rw ← int.coe_nat_dvd, simpa
end

end

section padic_val
parameters {p : ℕ} (p_prime : prime p)

private lemma hpp : p > 1 := prime.gt_one p_prime

protected lemma mul {m n : ℤ} (hm : m ≠ 0) (hn : n ≠ 0) :
      padic_val p m + padic_val p n = padic_val p (m*n) :=
have m*n ≠ 0, from mul_ne_zero hm hn,
have hdivm : ↑(p ^ padic_val p m) ∣ m, from spec hpp hm,
have hdivn : ↑(p ^ padic_val p n) ∣ n, from spec hpp hn,
have hdiv : ↑(p ^ (padic_val p m + padic_val p n)) ∣ m*n, from
  have hpoweq : (↑(p ^ (padic_val p m + padic_val p n)) : ℤ) =
                 (↑(p ^ padic_val p m * p ^ padic_val p n) : ℤ),
    by simp [nat.pow_add],
  begin
    rw [hpoweq, int.coe_nat_mul],
    apply mul_dvd_mul,
    repeat {assumption}
  end,
have hall : ∀ k : ℕ, k > padic_val p m + padic_val p n → ¬ ↑(p ^ k) ∣ m*n, from
  assume (k : ℕ) (hkgt : k > padic_val p m + padic_val p n) (hdiv : ↑(p ^ k) ∣ m*n),
  have hpsucc : ↑(p ^ (padic_val p m + padic_val p n + 1)) ∣ m*n, from
    int.pow_div_of_le_of_pow_div_int hkgt hdiv,
  let hsd := int.succ_dvd_or_succ_dvd_of_succ_sum_dvd_mul p_prime hdivm hdivn hpsucc in
  or.elim hsd
    (assume : ↑(p ^ (padic_val p m + 1)) ∣ m,
      is_greatest hpp hm _ (lt_succ_self _) this)
    (assume : ↑(p ^ (padic_val p n + 1)) ∣ n,
      is_greatest hpp hn _ (lt_succ_self _) this),
have habs : m.nat_abs * n.nat_abs = (m*n).nat_abs, by simp [int.nat_abs_mul],
begin
  simp only [habs] at *,
  apply unique,
  { exact hpp p_prime },
  repeat {assumption}
 end

end padic_val

section
variables {p : ℕ} (hp : p > 1)
include hp

lemma min_le_padic_val_add {m n : ℤ} (hmnz : m + n ≠ 0) :
      min (padic_val p m) (padic_val p n) ≤ padic_val p (m + n) :=
if hmz : m = 0 then by simp [hmz, nat.zero_le]
else if hnz : n = 0 then by simp [hnz, nat.zero_le]
else
  begin
    wlog hle := le_total (padic_val p m) (padic_val p n) using [n m],
    have hm : ∃ km, m = ↑(p ^ padic_val p m) * km, from spec hp hmz,
    have hn : ∃ kn, n = ↑(p ^ padic_val p n) * kn, from spec hp hnz,
    cases hm with km hkm,
    cases hn with kn hkn,
    have hmn : m + n = ↑(p ^ padic_val p m) * km + ↑(p ^ padic_val p n) * kn, by cc,
    have hmn' : m + n = ↑(p ^ padic_val p m) * (km + ↑(p ^ (padic_val p n - padic_val p m)) * kn),
    { rw [left_distrib, hmn, ←nat.pow_eq_mul_pow_sub _ hle], simp [mul_assoc] },
    have hpp : ↑(p ^ padic_val p m) ∣ (m + n),
    { rw hmn', apply dvd_mul_of_dvd_left, apply dvd_refl },
    have hpvle : padic_val p m ≤ padic_val p (m+n), from
      le_padic_val_of_pow_div hp hmnz hpp,
    transitivity,
    { apply min_le_left },
    { apply hpvle }
  end

end
end padic_val

local infix `/.`:70 := rat.mk

def padic_val_rat (p : ℕ) (q : ℚ) : ℤ :=
(padic_val p q.num : ℤ) - (padic_val p q.denom : ℤ)

namespace padic_val_rat

section padic_val_rat
variables {p : ℕ} (hp : p > 1)
include hp

@[simp] protected lemma neg (q : ℚ) : padic_val_rat p (-q) = padic_val_rat p q :=
begin
  simp [padic_val_rat, hp]
end

@[simp] protected lemma one : padic_val_rat p 1 = 0 :=
have (1 : ℚ).num = 1, from rfl,
have (1 : ℚ).denom = 1, from rfl,
by simp [padic_val_rat, *]

@[simp] lemma padic_val_rat_self : padic_val_rat p p = 1 :=
by simp [padic_val_rat, hp]

end padic_val_rat

section padic_val_rat
open padic_val
variables {p : ℕ} (p_prime : prime p)
include p_prime

protected lemma defn {q : ℚ} {n d : ℤ} (hqz : q ≠ 0) (qdf : q = n /. d) :
      padic_val_rat p q =
        (padic_val p n : ℤ) - padic_val p d :=
have hn : n ≠ 0, from rat.mk_num_ne_zero_of_ne_zero hqz qdf,
have hd : d ≠ 0, from rat.mk_denom_ne_zero_of_ne_zero hqz qdf,
have h : ∃ c : ℤ, n = c * q.num ∧ d = c * q.denom, from rat.num_denom_mk hn hd qdf,
have hqn : q.num ≠ 0, from rat.num_ne_zero_of_ne_zero hqz,
have hqd : (↑q.denom : ℤ) ≠ 0, by simp [rat.denom_ne_zero],
begin
  rcases h with ⟨c, ⟨hc1, hc2⟩⟩,
  have hcz : c ≠ 0,
    { intro hc,
      subst hc,
      apply hn, simpa using hc1 },
  unfold padic_val_rat,
  rw [hc1, hc2, ←padic_val.mul p_prime hcz hqn, ←padic_val.mul p_prime hcz hqd],
  simp [p_prime.gt_one], ring
end

protected lemma mul {q r : ℚ} (hq : q ≠ 0) (hr : r ≠ 0) :
        padic_val_rat p (q*r) =
          padic_val_rat p q + padic_val_rat p r :=
have q*r = (q.num * r.num) /. (↑q.denom * ↑r.denom), by simp [rat.mul_num_denom],
begin
  rw padic_val_rat.defn p_prime (mul_ne_zero hq hr) this,
  unfold padic_val_rat,
  rw [←padic_val.mul p_prime, ←padic_val.mul p_prime],
    {simp},
    repeat {apply int.coe_nat_ne_zero.2, apply ne_of_gt, apply rat.pos},
    repeat {apply rat.num_ne_zero_of_ne_zero, assumption}
end

theorem min_le_padic_val_rat_add {q r : ℚ} (hq : q ≠ 0) (hr : r ≠ 0) (hqr : q + r ≠ 0) :
        min (padic_val_rat p q) (padic_val_rat p r) ≤
          padic_val_rat p (q + r) :=
have hqn : q.num ≠ 0, from rat.num_ne_zero_of_ne_zero hq,
have hqd : q.denom ≠ 0, from rat.denom_ne_zero _,
have hrn : r.num ≠ 0, from rat.num_ne_zero_of_ne_zero hr,
have hrd : r.denom ≠ 0, from rat.denom_ne_zero _,
have hqdv : q.num /. q.denom ≠ 0, from rat.mk_ne_zero_of_ne_zero hqn (by simpa),
have hrdv : r.num /. r.denom ≠ 0, from rat.mk_ne_zero_of_ne_zero hrn (by simpa),
have hqreq : q + r = (((q.num * r.denom + q.denom * r.num : ℤ)) /. (↑q.denom * ↑r.denom : ℤ)),
  from calc
  q + r = (q.num /. q.denom + r.num /. r.denom) : by rw [←rat.num_denom q, ←rat.num_denom r]
    ... = (↑q.num : ℚ) / ↑q.denom + ((↑r.num : ℚ) / ↑r.denom) : by simp [rat.mk_eq_div]
    ... = (q.num * r.denom + q.denom * r.num) / (↑q.denom * ↑r.denom) :
      by rw div_add_div _ _ (show (q.denom : ℚ) ≠ 0, by simpa) (show (r.denom : ℚ) ≠ 0, by simpa)
    ... = ((q.num * r.denom + q.denom * r.num : ℤ)) /. (↑q.denom * ↑r.denom : ℤ) :
      by simp [rat.mk_eq_div],
have hsnz : q.num*r.denom + q.denom*r.num ≠ 0, from
  assume heq,
  have q + r = 0 /. (q.denom * r.denom), by rwa [heq] at hqreq,
  hqr (by simpa),
have hge  : (padic_val p (q.num * r.denom + q.denom * r.num) : ℤ) ≥
       min ((padic_val p (q.num*r.denom)) : ℤ)
           (padic_val p (q.denom*r.num)),
    from calc
    min ((padic_val p (q.num*r.denom)) : ℤ)
           (padic_val p (q.denom*r.num)) =
    (min (padic_val p (q.num*r.denom))
           (padic_val p (q.denom*r.num)) : ℤ) :
       by simp
     ... ≤ (padic_val p (q.num * r.denom + q.denom * r.num) : ℤ) :
       begin
         apply min_le_iff.2,
         simp only [int.coe_nat_le],
         apply min_le_iff.1,
         apply min_le_padic_val_add,
         exact p_prime.gt_one,
         assumption
       end,
calc
  padic_val_rat p (q + r)
         = padic_val_rat p
                         (((q.num * r.denom + q.denom * r.num : ℤ)) /. (↑q.denom * ↑r.denom : ℤ)) :
            by rw hqreq
     ... = padic_val p
                     (q.num * r.denom + q.denom * r.num) -
            padic_val p (↑q.denom * ↑r.denom) :
       begin apply padic_val_rat.defn p_prime, cc, reflexivity end
     ... ≥ min (padic_val p (q.num*r.denom))
               (padic_val p (q.denom*r.num)) -
            padic_val p (↑q.denom * ↑r.denom) :
       sub_le_sub hge (le_refl _)
     ... = min (padic_val p q.num +
                 padic_val p r.denom)
               (padic_val p q.denom +
                 padic_val p r.num) -
            (padic_val p q.denom +
              padic_val p r.denom) :
       begin rw [←padic_val.mul, ←padic_val.mul, ←padic_val.mul], reflexivity,repeat {simpa <|> assumption} end
     ... = min (padic_val p q.num +
                 padic_val p r.denom -
                 (padic_val p q.denom +
                   padic_val p r.denom))
               (padic_val p q.denom +
                 padic_val p r.num -
                 (padic_val p q.denom +
                   padic_val p r.denom)) :
       by apply min_sub
     ... = min (padic_val p q.num -
                 padic_val p q.denom)
               (padic_val p r.num -
                 padic_val p r.denom) :
       by simp
     ... = min (padic_val_rat p (q.num /. ↑q.denom))
               (padic_val_rat p (r.num /. ↑r.denom)) :
       by rw [padic_val_rat.defn p_prime, padic_val_rat.defn p_prime]; simp *
     ... = min (padic_val_rat p q)
               (padic_val_rat p r) :
       by rw [←rat.num_denom q, ←rat.num_denom r]
end padic_val_rat
end padic_val_rat

def padic_norm {p : ℕ} (hp : prime p) (q : ℚ) : ℚ :=
if q = 0 then 0
else fpow (↑p : ℚ) (-(padic_val_rat p q))

namespace padic_norm

section padic_norm
open padic_val_rat
variables {p : ℕ} (hp : prime p)

@[simp] protected lemma zero : padic_norm hp 0 = 0 := by simp [padic_norm]

@[simp] protected lemma nonzero {q : ℚ} (hq : q ≠ 0) :
        padic_norm hp q = fpow p (-(padic_val_rat p q)) :=
by simp [hq, padic_norm]

@[simp] protected lemma neg (q : ℚ) : padic_norm hp (-q) = padic_norm hp q :=
if hq : q = 0 then by simp [hq]
else by simp [padic_norm, hq, hp.gt_one]

lemma zero_of_padic_norm_eq_zero {q : ℚ} (h : padic_norm hp q = 0) : q = 0 :=
by_contradiction $
  assume hq : q ≠ 0,
  have padic_norm hp q = fpow p (-(padic_val_rat p q)), by simp [hq],
  fpow_ne_zero_of_ne_zero
    (show (↑p : ℚ) ≠ 0, by simp [prime.ne_zero hp])
    (-(padic_val_rat p q)) (by rw [←this, h])

protected lemma nonneg (q : ℚ) : padic_norm hp q ≥ 0 :=
if hq : q = 0 then by simp [hq]
else
  begin
    unfold padic_norm; split_ifs,
    apply fpow_nonneg_of_nonneg,
    apply nat.cast_nonneg
  end

protected theorem mul (q r : ℚ) : padic_norm hp (q*r) = padic_norm hp q * padic_norm hp r :=
if hq : q = 0 then
  by simp [hq]
else if hr : r = 0 then
  by simp [hr]
else
  have q*r ≠ 0, from mul_ne_zero hq hr,
  have (↑p : ℚ) ≠ 0, by simp [prime.ne_zero hp],
  by simp [padic_norm, *, padic_val_rat.mul, fpow_add this]

theorem triangle_ineq (q r : ℚ) : padic_norm hp (q + r) ≤ padic_norm hp q + padic_norm hp r :=
if hq : q = 0 then
  by simp [hq]
else if hr : r = 0 then
  by simp [hr]
else if hqr : q + r = 0 then
  begin simp [hqr], apply add_nonneg; apply padic_norm.nonneg end
else
  have hminle : min (padic_val_rat p q) (padic_val_rat p r) ≤
                 (padic_val_rat p (q + r)),
    by apply min_le_padic_val_rat_add; assumption,
  have hpge1 : (↑p : ℚ) ≥ ↑(1 : ℕ), from nat.cast_le.2 $ le_of_lt $ prime.gt_one hp,
  calc
    padic_norm hp (q + r) = fpow p (-(padic_val_rat p (q + r))) :
                       by simp [padic_norm, *]
                      ... ≤ max (fpow p (-(padic_val_rat p q)))
                                ((fpow p (-(padic_val_rat p r)))) :
                       pow_le_max_of_min_le hpge1 hminle
                      ... = max (padic_norm hp q) (padic_norm hp r) : by simp [padic_norm, *]
                      ... ≤ padic_norm hp q + padic_norm hp r :
                       by apply max_le_add_of_nonneg; apply padic_norm.nonneg

private lemma nonarchimedean_aux {q r : ℚ}
        (h : padic_val_rat p q ≤ padic_val_rat p r) :
        padic_norm hp (q + r) ≤ max (padic_norm hp q) (padic_norm hp r) :=
have hnqp : padic_norm hp q ≥ 0, from padic_norm.nonneg _ _,
have hnrp : padic_norm hp r ≥ 0, from padic_norm.nonneg _ _,
if hq : q = 0 then
  by simp [hq, max_eq_right hnrp]
else if hr : r = 0 then
  by simp [hr, max_eq_left hnqp]
else if hqr : q + r = 0 then
  le_trans (by simpa [hqr] using padic_norm.nonneg hp) (le_max_left _ _)
else
  begin
    unfold padic_norm, split_ifs,
    apply le_max_iff.2,
    left,
    have hpge1 : (↑p : ℚ) ≥ ↑(1 : ℕ), from (nat.cast_le.2 $ le_of_lt $ prime.gt_one hp),
    apply fpow_le_of_le hpge1,
    apply neg_le_neg,
    have : padic_val_rat p q =
            min (padic_val_rat p q) (padic_val_rat p r),
      from (min_eq_left h).symm,
    rw this,
    apply min_le_padic_val_rat_add; assumption
  end

protected theorem nonarchimedean {q r : ℚ} :
        padic_norm hp (q + r) ≤ max (padic_norm hp q) (padic_norm hp r) :=
if h : padic_val_rat p q ≤ padic_val_rat p r then
  nonarchimedean_aux hp h
else
  have h' : padic_val_rat p r ≤ padic_val_rat p q,
    from le_of_lt $ lt_of_not_ge h,
  let h'' := nonarchimedean_aux hp h' in
  by rwa [add_comm, max_comm] at h''

lemma add_eq_max_of_ne {q r : ℚ} (hne : padic_norm hp q ≠ padic_norm hp r) :
      padic_norm hp (q + r) = max (padic_norm hp q) (padic_norm hp r) :=
begin
  wlog hle := le_total (padic_norm hp r) (padic_norm hp q) using [q r],
  have hlt : padic_norm hp r < padic_norm hp q, from lt_of_le_of_ne hle hne.symm,
  have : padic_norm hp q ≤ max (padic_norm hp (q + r)) (padic_norm hp r), from calc
   padic_norm hp q = padic_norm hp (q + r - r) : by congr; ring
               ... ≤ max (padic_norm hp (q + r)) (padic_norm hp (-r)) : padic_norm.nonarchimedean hp
               ... = max (padic_norm hp (q + r)) (padic_norm hp r) : by simp,
  have hnge : padic_norm hp r ≤ padic_norm hp (q + r),
  { apply le_of_not_gt,
    intro hgt,
    rw max_eq_right_of_lt hgt at this,
    apply not_lt_of_ge this,
    assumption },
  have : padic_norm hp q ≤ padic_norm hp (q + r), by rwa [max_eq_left hnge] at this,
  apply _root_.le_antisymm,
  { apply padic_norm.nonarchimedean hp },
  { rw max_eq_left_of_lt hlt,
    assumption }
end

protected theorem image {q : ℚ} (hq : q ≠ 0) : ∃ n : ℤ, padic_norm hp q = fpow p (-n) :=
⟨ (padic_val_rat p q), by simp [padic_norm, hq] ⟩

instance : is_absolute_value (padic_norm hp) :=
{ abv_nonneg := padic_norm.nonneg hp,
  abv_eq_zero :=
    begin
      intros,
      constructor; intro,
      { apply zero_of_padic_norm_eq_zero hp, assumption },
      { simp [*] }
    end,
  abv_add := padic_norm.triangle_ineq hp,
  abv_mul := padic_norm.mul hp }

end padic_norm
end padic_norm


/-
Copyright (c) 2020 Aaron Anderson, Jalex Stark. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson, Jalex Stark

! This file was ported from Lean 3 source module linear_algebra.matrix.charpoly.coeff
! leanprover-community/mathlib commit 9745b093210e9dac443af24da9dba0f9e2b6c912
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Polynomial.Expand
import Mathbin.LinearAlgebra.Matrix.Charpoly.Basic

/-!
# Characteristic polynomials

We give methods for computing coefficients of the characteristic polynomial.

## Main definitions

- `matrix.charpoly_degree_eq_dim` proves that the degree of the characteristic polynomial
  over a nonzero ring is the dimension of the matrix
- `matrix.det_eq_sign_charpoly_coeff` proves that the determinant is the constant term of the
  characteristic polynomial, up to sign.
- `matrix.trace_eq_neg_charpoly_coeff` proves that the trace is the negative of the (d-1)th
  coefficient of the characteristic polynomial, where d is the dimension of the matrix.
  For a nonzero ring, this is the second-highest coefficient.

-/

noncomputable section

universe u v w z

open Polynomial Matrix

open BigOperators Polynomial

variable {R : Type u} [CommRing R]

variable {n G : Type v} [DecidableEq n] [Fintype n]

variable {α β : Type v} [DecidableEq α]

open Finset

variable {M : Matrix n n R}

theorem charmatrix_apply_natDegree [Nontrivial R] (i j : n) :
    (charmatrix M i j).natDegree = ite (i = j) 1 0 := by
  by_cases i = j <;> simp [h, ← degree_eq_iff_nat_degree_eq_of_pos (Nat.succ_pos 0)]
#align charmatrix_apply_nat_degree charmatrix_apply_natDegree

theorem charmatrix_apply_natDegree_le (i j : n) : (charmatrix M i j).natDegree ≤ ite (i = j) 1 0 :=
  by split_ifs <;> simp [h, nat_degree_X_sub_C_le]
#align charmatrix_apply_nat_degree_le charmatrix_apply_natDegree_le

namespace Matrix

variable (M)

theorem charpoly_sub_diagonal_degree_lt :
    (M.charpoly - ∏ i : n, X - C (M i i)).degree < ↑(Fintype.card n - 1) :=
  by
  rw [charpoly, det_apply', ← insert_erase (mem_univ (Equiv.refl n)),
    sum_insert (not_mem_erase (Equiv.refl n) univ), add_comm]
  simp only [charmatrix_apply_eq, one_mul, Equiv.Perm.sign_refl, id.def, Int.cast_one,
    Units.val_one, add_sub_cancel, Equiv.coe_refl]
  rw [← mem_degree_lt]; apply Submodule.sum_mem (degree_lt R (Fintype.card n - 1))
  intro c hc; rw [← C_eq_int_cast, C_mul']
  apply Submodule.smul_mem (degree_lt R (Fintype.card n - 1)) ↑↑(Equiv.Perm.sign c)
  rw [mem_degree_lt]; apply lt_of_le_of_lt degree_le_nat_degree _; rw [WithBot.coe_lt_coe]
  apply lt_of_le_of_lt _ (Equiv.Perm.fixed_point_card_lt_of_ne_one (ne_of_mem_erase hc))
  apply le_trans (Polynomial.natDegree_prod_le univ fun i : n => charmatrix M (c i) i) _
  rw [card_eq_sum_ones]; rw [sum_filter]; apply sum_le_sum
  intros ; apply charmatrix_apply_natDegree_le
#align matrix.charpoly_sub_diagonal_degree_lt Matrix.charpoly_sub_diagonal_degree_lt

theorem charpoly_coeff_eq_prod_coeff_of_le {k : ℕ} (h : Fintype.card n - 1 ≤ k) :
    M.charpoly.coeff k = (∏ i : n, X - C (M i i)).coeff k :=
  by
  apply eq_of_sub_eq_zero; rw [← coeff_sub]; apply Polynomial.coeff_eq_zero_of_degree_lt
  apply lt_of_lt_of_le (charpoly_sub_diagonal_degree_lt M) _; rw [WithBot.coe_le_coe]; apply h
#align matrix.charpoly_coeff_eq_prod_coeff_of_le Matrix.charpoly_coeff_eq_prod_coeff_of_le

theorem det_of_card_zero (h : Fintype.card n = 0) (M : Matrix n n R) : M.det = 1 :=
  by
  rw [Fintype.card_eq_zero_iff] at h
  suffices M = 1 by simp [this]
  ext i
  exact h.elim i
#align matrix.det_of_card_zero Matrix.det_of_card_zero

theorem charpoly_degree_eq_dim [Nontrivial R] (M : Matrix n n R) :
    M.charpoly.degree = Fintype.card n :=
  by
  by_cases Fintype.card n = 0
  · rw [h]
    unfold charpoly
    rw [det_of_card_zero]
    · simp
    · assumption
  rw [← sub_add_cancel M.charpoly (∏ i : n, X - C (M i i))]
  have h1 : (∏ i : n, X - C (M i i)).degree = Fintype.card n :=
    by
    rw [degree_eq_iff_nat_degree_eq_of_pos]
    swap
    apply Nat.pos_of_ne_zero h
    rw [nat_degree_prod']
    simp_rw [nat_degree_X_sub_C]
    unfold Fintype.card
    simp
    simp_rw [(monic_X_sub_C _).leadingCoeff]
    simp
  rw [degree_add_eq_right_of_degree_lt]
  exact h1
  rw [h1]
  apply lt_trans (charpoly_sub_diagonal_degree_lt M)
  rw [WithBot.coe_lt_coe]
  rw [← Nat.pred_eq_sub_one]
  apply Nat.pred_lt
  apply h
#align matrix.charpoly_degree_eq_dim Matrix.charpoly_degree_eq_dim

theorem charpoly_natDegree_eq_dim [Nontrivial R] (M : Matrix n n R) :
    M.charpoly.natDegree = Fintype.card n :=
  natDegree_eq_of_degree_eq_some (charpoly_degree_eq_dim M)
#align matrix.charpoly_nat_degree_eq_dim Matrix.charpoly_natDegree_eq_dim

theorem charpoly_monic (M : Matrix n n R) : M.charpoly.Monic :=
  by
  nontriviality
  by_cases Fintype.card n = 0
  · rw [charpoly, det_of_card_zero h]
    apply monic_one
  have mon : (∏ i : n, X - C (M i i)).Monic :=
    by
    apply monic_prod_of_monic univ fun i : n => X - C (M i i)
    simp [monic_X_sub_C]
  rw [← sub_add_cancel (∏ i : n, X - C (M i i)) M.charpoly] at mon
  rw [monic] at *
  rw [leading_coeff_add_of_degree_lt] at mon
  rw [← mon]
  rw [charpoly_degree_eq_dim]
  rw [← neg_sub]
  rw [degree_neg]
  apply lt_trans (charpoly_sub_diagonal_degree_lt M)
  rw [WithBot.coe_lt_coe]
  rw [← Nat.pred_eq_sub_one]
  apply Nat.pred_lt
  apply h
#align matrix.charpoly_monic Matrix.charpoly_monic

theorem trace_eq_neg_charpoly_coeff [Nonempty n] (M : Matrix n n R) :
    trace M = -M.charpoly.coeff (Fintype.card n - 1) :=
  by
  rw [charpoly_coeff_eq_prod_coeff_of_le]; swap; rfl
  rw [Fintype.card, prod_X_sub_C_coeff_card_pred univ (fun i : n => M i i) Fintype.card_pos,
    neg_neg, trace]
  rfl
#align matrix.trace_eq_neg_charpoly_coeff Matrix.trace_eq_neg_charpoly_coeff

-- I feel like this should use polynomial.alg_hom_eval₂_algebra_map
theorem matPolyEquiv_eval (M : Matrix n n R[X]) (r : R) (i j : n) :
    (matPolyEquiv M).eval ((scalar n) r) i j = (M i j).eval r :=
  by
  unfold Polynomial.eval; unfold eval₂
  trans Polynomial.sum (matPolyEquiv M) fun (e : ℕ) (a : Matrix n n R) => (a * (scalar n) r ^ e) i j
  · unfold Polynomial.sum
    rw [sum_apply]
    dsimp
    rfl
  · simp_rw [← RingHom.map_pow, ← (scalar.commute _ _).Eq]
    simp only [coe_scalar, Matrix.one_mul, RingHom.id_apply, Pi.smul_apply, smul_eq_mul, mul_eq_mul,
      Algebra.smul_mul_assoc]
    have h : ∀ x : ℕ, (fun (e : ℕ) (a : R) => r ^ e * a) x 0 = 0 := by simp
    simp only [Polynomial.sum, matPolyEquiv_coeff_apply, mul_comm]
    apply (Finset.sum_subset (support_subset_support_matPolyEquiv _ _ _) _).symm
    intro n hn h'n
    rw [not_mem_support_iff] at h'n
    simp only [h'n, MulZeroClass.zero_mul]
#align matrix.mat_poly_equiv_eval Matrix.matPolyEquiv_eval

theorem eval_det (M : Matrix n n R[X]) (r : R) :
    Polynomial.eval r M.det = (Polynomial.eval (scalar n r) (matPolyEquiv M)).det :=
  by
  rw [Polynomial.eval, ← coe_eval₂_ring_hom, RingHom.map_det]
  apply congr_arg det; ext; symm; convert mat_poly_equiv_eval _ _ _ _
#align matrix.eval_det Matrix.eval_det

theorem det_eq_sign_charpoly_coeff (M : Matrix n n R) :
    M.det = (-1) ^ Fintype.card n * M.charpoly.coeff 0 :=
  by
  rw [coeff_zero_eq_eval_zero, charpoly, eval_det, matPolyEquiv_charmatrix, ← det_smul]
  simp
#align matrix.det_eq_sign_charpoly_coeff Matrix.det_eq_sign_charpoly_coeff

end Matrix

variable {p : ℕ} [Fact p.Prime]

theorem matPolyEquiv_eq_x_pow_sub_c {K : Type _} (k : ℕ) [Field K] (M : Matrix n n K) :
    matPolyEquiv ((expand K k : K[X] →+* K[X]).mapMatrix (charmatrix (M ^ k))) =
      X ^ k - C (M ^ k) :=
  by
  ext m
  rw [coeff_sub, coeff_C, matPolyEquiv_coeff_apply, RingHom.mapMatrix_apply, Matrix.map_apply,
    AlgHom.coe_toRingHom, DMatrix.sub_apply, coeff_X_pow]
  by_cases hij : i = j
  · rw [hij, charmatrix_apply_eq, AlgHom.map_sub, expand_C, expand_X, coeff_sub, coeff_X_pow,
      coeff_C]
    split_ifs with mp m0 <;> simp only [Matrix.one_apply_eq, DMatrix.zero_apply]
  · rw [charmatrix_apply_ne _ _ _ hij, AlgHom.map_neg, expand_C, coeff_neg, coeff_C]
    split_ifs with m0 mp <;>
      simp only [hij, zero_sub, DMatrix.zero_apply, sub_zero, neg_zero, Matrix.one_apply_ne, Ne.def,
        not_false_iff]
#align mat_poly_equiv_eq_X_pow_sub_C matPolyEquiv_eq_x_pow_sub_c

namespace Matrix

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

/-- Any matrix power can be computed as the sum of matrix powers less than `fintype.card n`.

TODO: add the statement for negative powers phrased with `zpow`. -/
theorem pow_eq_aeval_mod_charpoly (M : Matrix n n R) (k : ℕ) :
    M ^ k = aeval M (X ^ k %ₘ M.charpoly) := by rw [← aeval_eq_aeval_mod_charpoly, map_pow, aeval_X]
#align matrix.pow_eq_aeval_mod_charpoly Matrix.pow_eq_aeval_mod_charpoly

end Matrix

section Ideal

theorem coeff_charpoly_mem_ideal_pow {I : Ideal R} (h : ∀ i j, M i j ∈ I) (k : ℕ) :
    M.charpoly.coeff k ∈ I ^ (Fintype.card n - k) :=
  by
  delta charpoly
  rw [Matrix.det_apply, finset_sum_coeff]
  apply sum_mem
  rintro c -
  rw [coeff_smul, Submodule.smul_mem_iff']
  have : (∑ x : n, 1) = Fintype.card n := by rw [Finset.sum_const, card_univ, smul_eq_mul, mul_one]
  rw [← this]
  apply coeff_prod_mem_ideal_pow_tsub
  rintro i - (_ | k)
  · rw [tsub_zero, pow_one, charmatrix_apply, coeff_sub, coeff_X_mul_zero, coeff_C_zero, zero_sub,
      neg_mem_iff]
    exact h (c i) i
  · rw [Nat.succ_eq_one_add, tsub_self_add, pow_zero, Ideal.one_eq_top]
    exact Submodule.mem_top
#align coeff_charpoly_mem_ideal_pow coeff_charpoly_mem_ideal_pow

end Ideal