/-
Copyright (c) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Tim Baumann, Stephen Morgan, Scott Morrison, Floris van Doorn
Ported by: Scott Morrison

! This file was ported from Lean 3 source module category_theory.natural_transformation
! leanprover-community/mathlib commit 8350c34a64b9bc3fc64335df8006bffcadc7baa6
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.Functor.Basic

/-!
# Natural transformations

Defines natural transformations between functors.

A natural transformation `α : NatTrans F G` consists of morphisms `α.app X : F.obj X ⟶ G.obj X`,
and the naturality squares `α.naturality f : F.map f ≫ α.app Y = α.app X ≫ G.map f`,
where `f : X ⟶ Y`.

Note that we make `NatTrans.naturality` a simp lemma, with the preferred simp normal form
pushing components of natural transformations to the left.

See also `CategoryTheory.FunctorCat`, where we provide the category structure on
functors and natural transformations.

Introduces notations
* `τ.app X` for the components of natural transformations,
* `F ⟶ G` for the type of natural transformations between functors `F` and `G`
  (this and the next require `CategoryTheory.FunctorCat`),
* `σ ≫ τ` for vertical compositions, and
* `σ ◫ τ` for horizontal compositions.

-/

namespace CategoryTheory

-- declare the `v`'s first; see note [CategoryTheory universes].
universe v₁ v₂ v₃ v₄ u₁ u₂ u₃ u₄

variable {C : Type u₁} [Category.{v₁} C] {D : Type u₂} [Category.{v₂} D]

/-- `NatTrans F G` represents a natural transformation between functors `F` and `G`.

The field `app` provides the components of the natural transformation.

Naturality is expressed by `α.naturality`.
-/
@[ext]
structure NatTrans (F G : C ⥤ D) : Type max u₁ v₂ where
  /-- The component of a natural transformation. -/
  app : ∀ X : C, F.obj X ⟶ G.obj X
  /-- The naturality square for a given morphism. -/
  naturality : ∀ ⦃X Y : C⦄ (f : X ⟶ Y), F.map f ≫ app Y = app X ≫ G.map f := by aesop_cat
#align category_theory.nat_trans CategoryTheory.NatTrans
#align category_theory.nat_trans.naturality CategoryTheory.NatTrans.naturality
#align category_theory.nat_trans.ext_iff CategoryTheory.NatTrans.ext_iff
#align category_theory.nat_trans.ext CategoryTheory.NatTrans.ext

/--
This unexpander will pretty print `η.app X` properly.
Without this, we would have `NatTrans.app η X`.
-/
@[app_unexpander NatTrans.app] def
  unexpandNatTransApp : Lean.PrettyPrinter.Unexpander
  | `($_ $η $(X)*)  => set_option hygiene false in `($(η).app $(X)*)
  | _            => throw ()

-- TODO Perhaps we should just turn on `ext` in aesop?
attribute [aesop safe apply (rule_sets [CategoryTheory])] NatTrans.ext

-- Rather arbitrarily, we say that the 'simpler' form is
-- components of natural transfomations moving earlier.
attribute [reassoc (attr := simp)] NatTrans.naturality
#align category_theory.nat_trans.naturality_assoc CategoryTheory.NatTrans.naturality_assoc

theorem congr_app {F G : C ⥤ D} {α β : NatTrans F G} (h : α = β) (X : C) : α.app X = β.app X := by
  aesop_cat
#align category_theory.congr_app CategoryTheory.congr_app

namespace NatTrans

/-- `NatTrans.id F` is the identity natural transformation on a functor `F`. -/
protected def id (F : C ⥤ D) : NatTrans F F where app X := 𝟙 (F.obj X)
#align category_theory.nat_trans.id CategoryTheory.NatTrans.id

@[simp]
theorem id_app' (F : C ⥤ D) (X : C) : (NatTrans.id F).app X = 𝟙 (F.obj X) := rfl
#align category_theory.nat_trans.id_app' CategoryTheory.NatTrans.id_app'

instance (F : C ⥤ D) : Inhabited (NatTrans F F) := ⟨NatTrans.id F⟩

open Category

open CategoryTheory.Functor

section

variable {F G H I : C ⥤ D}

/-- `vcomp α β` is the vertical compositions of natural transformations. -/
def vcomp (α : NatTrans F G) (β : NatTrans G H) : NatTrans F H where
  app X := α.app X ≫ β.app X
#align category_theory.nat_trans.vcomp CategoryTheory.NatTrans.vcomp

-- functor_category will rewrite (vcomp α β) to (α ≫ β), so this is not a
-- suitable simp lemma.  We will declare the variant vcomp_app' there.
theorem vcomp_app (α : NatTrans F G) (β : NatTrans G H) (X : C) :
    (vcomp α β).app X = α.app X ≫ β.app X := rfl
#align category_theory.nat_trans.vcomp_app CategoryTheory.NatTrans.vcomp_app

end

/-- The diagram
    F(f)      F(g)      F(h)
F X ----> F Y ----> F U ----> F U
 |         |         |         |
 | α(X)    | α(Y)    | α(U)    | α(V)
 v         v         v         v
G X ----> G Y ----> G U ----> G V
    G(f)      G(g)      G(h)
commutes.
-/
example {F G : C ⥤ D} (α : NatTrans F G) {X Y U V : C} (f : X ⟶ Y) (g : Y ⟶ U) (h : U ⟶ V) :
    α.app X ≫ G.map f ≫ G.map g ≫ G.map h = F.map f ≫ F.map g ≫ F.map h ≫ α.app V := by
  simp

end NatTrans

end CategoryTheory


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Mario Carneiro, Johan Commelin, Amelia Livingston, Anne Baanen

! This file was ported from Lean 3 source module ring_theory.localization.submodule
! leanprover-community/mathlib commit 1ebb20602a8caef435ce47f6373e1aa40851a177
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.RingTheory.Localization.FractionRing
import Mathbin.RingTheory.Localization.Ideal
import Mathbin.RingTheory.PrincipalIdealDomain

/-!
# Submodules in localizations of commutative rings

## Implementation notes

See `src/ring_theory/localization/basic.lean` for a design overview.

## Tags
localization, ring localization, commutative ring localization, characteristic predicate,
commutative ring, field of fractions
-/

variable {R : Type _} [CommRing R] (M : Submonoid R) (S : Type _) [CommRing S]

variable [Algebra R S] {P : Type _} [CommRing P]

namespace IsLocalization

-- This was previously a `has_coe` instance, but if `S = R` then this will loop.
-- It could be a `has_coe_t` instance, but we keep it explicit here to avoid slowing down
-- the rest of the library.
/-- Map from ideals of `R` to submodules of `S` induced by `f`. -/
def coeSubmodule (I : Ideal R) : Submodule R S :=
  Submodule.map (Algebra.linearMap R S) I
#align is_localization.coe_submodule IsLocalization.coeSubmodule

theorem mem_coeSubmodule (I : Ideal R) {x : S} :
    x ∈ coeSubmodule S I ↔ ∃ y : R, y ∈ I ∧ algebraMap R S y = x :=
  Iff.rfl
#align is_localization.mem_coe_submodule IsLocalization.mem_coeSubmodule

theorem coeSubmodule_mono {I J : Ideal R} (h : I ≤ J) : coeSubmodule S I ≤ coeSubmodule S J :=
  Submodule.map_mono h
#align is_localization.coe_submodule_mono IsLocalization.coeSubmodule_mono

@[simp]
theorem coeSubmodule_bot : coeSubmodule S (⊥ : Ideal R) = ⊥ := by
  rw [coe_submodule, Submodule.map_bot]
#align is_localization.coe_submodule_bot IsLocalization.coeSubmodule_bot

@[simp]
theorem coeSubmodule_top : coeSubmodule S (⊤ : Ideal R) = 1 := by
  rw [coe_submodule, Submodule.map_top, Submodule.one_eq_range]
#align is_localization.coe_submodule_top IsLocalization.coeSubmodule_top

@[simp]
theorem coeSubmodule_sup (I J : Ideal R) :
    coeSubmodule S (I ⊔ J) = coeSubmodule S I ⊔ coeSubmodule S J :=
  Submodule.map_sup _ _ _
#align is_localization.coe_submodule_sup IsLocalization.coeSubmodule_sup

@[simp]
theorem coeSubmodule_mul (I J : Ideal R) :
    coeSubmodule S (I * J) = coeSubmodule S I * coeSubmodule S J :=
  Submodule.map_mul _ _ (Algebra.ofId R S)
#align is_localization.coe_submodule_mul IsLocalization.coeSubmodule_mul

theorem coeSubmodule_fg (hS : Function.Injective (algebraMap R S)) (I : Ideal R) :
    Submodule.Fg (coeSubmodule S I) ↔ Submodule.Fg I :=
  ⟨Submodule.fg_of_fg_map _ (LinearMap.ker_eq_bot.mpr hS), Submodule.Fg.map _⟩
#align is_localization.coe_submodule_fg IsLocalization.coeSubmodule_fg

@[simp]
theorem coeSubmodule_span (s : Set R) :
    coeSubmodule S (Ideal.span s) = Submodule.span R (algebraMap R S '' s) :=
  by
  rw [IsLocalization.coeSubmodule, Ideal.span, Submodule.map_span]
  rfl
#align is_localization.coe_submodule_span IsLocalization.coeSubmodule_span

@[simp]
theorem coeSubmodule_span_singleton (x : R) :
    coeSubmodule S (Ideal.span {x}) = Submodule.span R {(algebraMap R S) x} := by
  rw [coe_submodule_span, Set.image_singleton]
#align is_localization.coe_submodule_span_singleton IsLocalization.coeSubmodule_span_singleton

variable {g : R →+* P}

variable {T : Submonoid P} (hy : M ≤ T.comap g) {Q : Type _} [CommRing Q]

variable [Algebra P Q] [IsLocalization T Q]

variable [IsLocalization M S]

section

include M

theorem isNoetherianRing (h : IsNoetherianRing R) : IsNoetherianRing S :=
  by
  rw [isNoetherianRing_iff, isNoetherian_iff_wellFounded] at h⊢
  exact OrderEmbedding.wellFounded (IsLocalization.orderEmbedding M S).dual h
#align is_localization.is_noetherian_ring IsLocalization.isNoetherianRing

end

variable {S Q M}

@[mono]
theorem coeSubmodule_le_coeSubmodule (h : M ≤ nonZeroDivisors R) {I J : Ideal R} :
    coeSubmodule S I ≤ coeSubmodule S J ↔ I ≤ J :=
  Submodule.map_le_map_iff_of_injective (IsLocalization.injective _ h) _ _
#align is_localization.coe_submodule_le_coe_submodule IsLocalization.coeSubmodule_le_coeSubmodule

@[mono]
theorem coeSubmodule_strictMono (h : M ≤ nonZeroDivisors R) :
    StrictMono (coeSubmodule S : Ideal R → Submodule R S) :=
  strictMono_of_le_iff_le fun _ _ => (coeSubmodule_le_coeSubmodule h).symm
#align is_localization.coe_submodule_strict_mono IsLocalization.coeSubmodule_strictMono

variable (S) {Q M}

theorem coeSubmodule_injective (h : M ≤ nonZeroDivisors R) :
    Function.Injective (coeSubmodule S : Ideal R → Submodule R S) :=
  injective_of_le_imp_le _ fun _ _ => (coeSubmodule_le_coeSubmodule h).mp
#align is_localization.coe_submodule_injective IsLocalization.coeSubmodule_injective

theorem coeSubmodule_isPrincipal {I : Ideal R} (h : M ≤ nonZeroDivisors R) :
    (coeSubmodule S I).IsPrincipal ↔ I.IsPrincipal :=
  by
  constructor <;> rintro ⟨⟨x, hx⟩⟩
  · have x_mem : x ∈ coe_submodule S I := hx.symm ▸ Submodule.mem_span_singleton_self x
    obtain ⟨x, x_mem, rfl⟩ := (mem_coe_submodule _ _).mp x_mem
    refine' ⟨⟨x, coe_submodule_injective S h _⟩⟩
    rw [Ideal.submodule_span_eq, hx, coe_submodule_span_singleton]
  · refine' ⟨⟨algebraMap R S x, _⟩⟩
    rw [hx, Ideal.submodule_span_eq, coe_submodule_span_singleton]
#align is_localization.coe_submodule_is_principal IsLocalization.coeSubmodule_isPrincipal

variable {S} (M)

theorem mem_span_iff {N : Type _} [AddCommGroup N] [Module R N] [Module S N] [IsScalarTower R S N]
    {x : N} {a : Set N} :
    x ∈ Submodule.span S a ↔ ∃ y ∈ Submodule.span R a, ∃ z : M, x = mk' S 1 z • y :=
  by
  constructor; intro h
  · refine' Submodule.span_induction h _ _ _ _
    · rintro x hx
      exact ⟨x, Submodule.subset_span hx, 1, by rw [mk'_one, _root_.map_one, one_smul]⟩
    · exact ⟨0, Submodule.zero_mem _, 1, by rw [mk'_one, _root_.map_one, one_smul]⟩
    · rintro _ _ ⟨y, hy, z, rfl⟩ ⟨y', hy', z', rfl⟩
      refine'
        ⟨(z' : R) • y + (z : R) • y',
          Submodule.add_mem _ (Submodule.smul_mem _ _ hy) (Submodule.smul_mem _ _ hy'), z * z', _⟩
      rw [smul_add, ← IsScalarTower.algebraMap_smul S (z : R), ←
        IsScalarTower.algebraMap_smul S (z' : R), smul_smul, smul_smul]
      congr 1
      · rw [← mul_one (1 : R), mk'_mul, mul_assoc, mk'_spec, _root_.map_one, mul_one, mul_one]
      · rw [← mul_one (1 : R), mk'_mul, mul_right_comm, mk'_spec, _root_.map_one, mul_one, one_mul]
      all_goals infer_instance
    · rintro a _ ⟨y, hy, z, rfl⟩
      obtain ⟨y', z', rfl⟩ := mk'_surjective M a
      refine' ⟨y' • y, Submodule.smul_mem _ _ hy, z' * z, _⟩
      rw [← IsScalarTower.algebraMap_smul S y', smul_smul, ← mk'_mul, smul_smul,
        mul_comm (mk' S _ _), mul_mk'_eq_mk'_of_mul]
      all_goals infer_instance
  · rintro ⟨y, hy, z, rfl⟩
    exact Submodule.smul_mem _ _ (Submodule.span_subset_span R S _ hy)
#align is_localization.mem_span_iff IsLocalization.mem_span_iff

theorem mem_span_map {x : S} {a : Set R} :
    x ∈ Ideal.span (algebraMap R S '' a) ↔ ∃ y ∈ Ideal.span a, ∃ z : M, x = mk' S y z :=
  by
  refine' (mem_span_iff M).trans _
  constructor
  · rw [← coe_submodule_span]
    rintro ⟨_, ⟨y, hy, rfl⟩, z, hz⟩
    refine' ⟨y, hy, z, _⟩
    rw [hz, Algebra.linearMap_apply, smul_eq_mul, mul_comm, mul_mk'_eq_mk'_of_mul, mul_one]
  · rintro ⟨y, hy, z, hz⟩
    refine' ⟨algebraMap R S y, Submodule.map_mem_span_algebraMap_image _ _ hy, z, _⟩
    rw [hz, smul_eq_mul, mul_comm, mul_mk'_eq_mk'_of_mul, mul_one]
#align is_localization.mem_span_map IsLocalization.mem_span_map

end IsLocalization

namespace IsFractionRing

open IsLocalization

variable {R} {A K : Type _} [CommRing A]

section CommRing

variable [CommRing K] [Algebra R K] [IsFractionRing R K] [Algebra A K] [IsFractionRing A K]

@[simp, mono]
theorem coeSubmodule_le_coeSubmodule {I J : Ideal R} :
    coeSubmodule K I ≤ coeSubmodule K J ↔ I ≤ J :=
  IsLocalization.coeSubmodule_le_coeSubmodule le_rfl
#align is_fraction_ring.coe_submodule_le_coe_submodule IsFractionRing.coeSubmodule_le_coeSubmodule

@[mono]
theorem coeSubmodule_strictMono : StrictMono (coeSubmodule K : Ideal R → Submodule R K) :=
  strictMono_of_le_iff_le fun _ _ => coeSubmodule_le_coeSubmodule.symm
#align is_fraction_ring.coe_submodule_strict_mono IsFractionRing.coeSubmodule_strictMono

variable (R K)

theorem coeSubmodule_injective : Function.Injective (coeSubmodule K : Ideal R → Submodule R K) :=
  injective_of_le_imp_le _ fun _ _ => coeSubmodule_le_coeSubmodule.mp
#align is_fraction_ring.coe_submodule_injective IsFractionRing.coeSubmodule_injective

@[simp]
theorem coeSubmodule_isPrincipal {I : Ideal R} : (coeSubmodule K I).IsPrincipal ↔ I.IsPrincipal :=
  IsLocalization.coeSubmodule_isPrincipal _ le_rfl
#align is_fraction_ring.coe_submodule_is_principal IsFractionRing.coeSubmodule_isPrincipal

end CommRing

end IsFractionRing


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

/-!
# Squarefree elements of monoids

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.
An element of a monoid is squarefree when it is not divisible by any squares
except the squares of units.

Results about squarefree natural numbers are proved in `data/nat/squarefree`.

## Main Definitions
 - `squarefree r` indicates that `r` is only divisible by `x * x` if `x` is a unit.

## Main Results
 - `multiplicity.squarefree_iff_multiplicity_le_one`: `x` is `squarefree` iff for every `y`, either
  `multiplicity y x ≤ 1` or `is_unit y`.
 - `unique_factorization_monoid.squarefree_iff_nodup_factors`: A nonzero element `x` of a unique
 factorization monoid is squarefree iff `factors x` has no duplicate factors.

## Tags
squarefree, multiplicity

-/

variables {R : Type*}

/-- An element of a monoid is squarefree if the only squares that
  divide it are the squares of units. -/
def squarefree [monoid R] (r : R) : Prop := ∀ x : R, x * x ∣ r → is_unit x

@[simp]
lemma is_unit.squarefree [comm_monoid R] {x : R} (h : is_unit x) :
  squarefree x :=
λ y hdvd, is_unit_of_mul_is_unit_left (is_unit_of_dvd_unit hdvd h)

@[simp]
lemma squarefree_one [comm_monoid R] : squarefree (1 : R) :=
is_unit_one.squarefree

@[simp]
lemma not_squarefree_zero [monoid_with_zero R] [nontrivial R] : ¬ squarefree (0 : R) :=
begin
  erw [not_forall],
  exact ⟨0, by simp⟩,
end

lemma squarefree.ne_zero [monoid_with_zero R] [nontrivial R] {m : R}
  (hm : squarefree (m : R)) : m ≠ 0 :=
begin
  rintro rfl,
  exact not_squarefree_zero hm,
end

@[simp]
lemma irreducible.squarefree [comm_monoid R] {x : R} (h : irreducible x) :
  squarefree x :=
begin
  rintros y ⟨z, hz⟩,
  rw mul_assoc at hz,
  rcases h.is_unit_or_is_unit hz with hu | hu,
  { exact hu },
  { apply is_unit_of_mul_is_unit_left hu },
end

@[simp]
lemma prime.squarefree [cancel_comm_monoid_with_zero R] {x : R} (h : prime x) :
  squarefree x :=
h.irreducible.squarefree

lemma squarefree.of_mul_left [comm_monoid R] {m n : R} (hmn : squarefree (m * n)) : squarefree m :=
(λ p hp, hmn p (dvd_mul_of_dvd_left hp n))

lemma squarefree.of_mul_right [comm_monoid R] {m n : R} (hmn : squarefree (m * n)) : squarefree n :=
(λ p hp, hmn p (dvd_mul_of_dvd_right hp m))

lemma squarefree.squarefree_of_dvd [comm_monoid R]
  {x y : R} (hdvd : x ∣ y) (hsq : squarefree y) :
  squarefree x :=
λ a h, hsq _ (h.trans hdvd)

section squarefree_gcd_of_squarefree

variables {α : Type*} [cancel_comm_monoid_with_zero α] [gcd_monoid α]

lemma squarefree.gcd_right (a : α) {b : α} (hb : squarefree b) :
  squarefree (gcd a b) :=
hb.squarefree_of_dvd (gcd_dvd_right _ _)

lemma squarefree.gcd_left {a : α} (b : α) (ha : squarefree a) :
  squarefree (gcd a b) :=
ha.squarefree_of_dvd (gcd_dvd_left _ _)

end squarefree_gcd_of_squarefree

namespace multiplicity

section comm_monoid

variables [comm_monoid R] [decidable_rel (has_dvd.dvd : R → R → Prop)]

lemma squarefree_iff_multiplicity_le_one (r : R) :
  squarefree r ↔ ∀ x : R, multiplicity x r ≤ 1 ∨ is_unit x :=
begin
  refine forall_congr (λ a, _),
  rw [← sq, pow_dvd_iff_le_multiplicity, or_iff_not_imp_left, not_le, imp_congr _ iff.rfl],
  simpa using part_enat.add_one_le_iff_lt (part_enat.coe_ne_top 1)
end

end comm_monoid

section cancel_comm_monoid_with_zero

variables [cancel_comm_monoid_with_zero R] [wf_dvd_monoid R]

lemma finite_prime_left {a b : R} (ha : prime a) (hb : b ≠ 0) :
  multiplicity.finite a b :=
begin
  classical,
  revert hb,
  refine wf_dvd_monoid.induction_on_irreducible b (by contradiction) (λ u hu hu', _)
    (λ b p hb hp ih hpb, _),
  { rw [multiplicity.finite_iff_dom, multiplicity.is_unit_right ha.not_unit hu],
    exact part_enat.dom_coe 0, },
  { refine multiplicity.finite_mul ha
      (multiplicity.finite_iff_dom.mpr
        (part_enat.dom_of_le_coe (show multiplicity a p ≤ ↑1, from _))) (ih hb),
    norm_cast,
    exact (((multiplicity.squarefree_iff_multiplicity_le_one p).mp hp.squarefree a)
      .resolve_right ha.not_unit) }
end

end cancel_comm_monoid_with_zero

end multiplicity

section irreducible
variables [comm_monoid_with_zero R] [wf_dvd_monoid R]

lemma irreducible_sq_not_dvd_iff_eq_zero_and_no_irreducibles_or_squarefree (r : R) :
  (∀ x : R, irreducible x → ¬ x * x ∣ r) ↔ ((r = 0 ∧ ∀ x : R, ¬irreducible x) ∨ squarefree r) :=
begin
  symmetry,
  split,
  { rintro (⟨rfl, h⟩ | h),
    { simpa using h },
    intros x hx t,
    exact hx.not_unit (h x t) },
  intro h,
  rcases eq_or_ne r 0 with rfl | hr,
  { exact or.inl (by simpa using h) },
  right,
  intros x hx,
  by_contra i,
  have : x ≠ 0,
  { rintro rfl,
    apply hr,
    simpa only [zero_dvd_iff, mul_zero] using hx},
  obtain ⟨j, hj₁, hj₂⟩ := wf_dvd_monoid.exists_irreducible_factor i this,
  exact h _ hj₁ ((mul_dvd_mul hj₂ hj₂).trans hx),
end

lemma squarefree_iff_irreducible_sq_not_dvd_of_ne_zero {r : R} (hr : r ≠ 0) :
  squarefree r ↔ ∀ x : R, irreducible x → ¬ x * x ∣ r :=
by simpa [hr] using (irreducible_sq_not_dvd_iff_eq_zero_and_no_irreducibles_or_squarefree r).symm

lemma squarefree_iff_irreducible_sq_not_dvd_of_exists_irreducible
  {r : R} (hr : ∃ (x : R), irreducible x) :
  squarefree r ↔ ∀ x : R, irreducible x → ¬ x * x ∣ r :=
begin
  rw [irreducible_sq_not_dvd_iff_eq_zero_and_no_irreducibles_or_squarefree, ←not_exists],
  simp only [hr, not_true, false_or, and_false],
end

end irreducible

section is_radical

variables [cancel_comm_monoid_with_zero R]

theorem is_radical.squarefree {x : R} (h0 : x ≠ 0) (h : is_radical x) : squarefree x :=
begin
  rintro z ⟨w, rfl⟩,
  specialize h 2 (z * w) ⟨w, by simp_rw [pow_two, mul_left_comm, ← mul_assoc]⟩,
  rwa [← one_mul (z * w), mul_assoc, mul_dvd_mul_iff_right, ← is_unit_iff_dvd_one] at h,
  rw [mul_assoc, mul_ne_zero_iff] at h0, exact h0.2,
end

variable [gcd_monoid R]

theorem squarefree.is_radical {x : R} (hx : squarefree x) : is_radical x :=
(is_radical_iff_pow_one_lt 2 one_lt_two).2 $ λ y hy, and.right $ (dvd_gcd_iff x x y).1
begin
  by_cases gcd x y = 0, { rw h, apply dvd_zero },
  replace hy := ((dvd_gcd_iff x x _).2 ⟨dvd_rfl, hy⟩).trans gcd_pow_right_dvd_pow_gcd,
  obtain ⟨z, hz⟩ := gcd_dvd_left x y,
  nth_rewrite 0 hz at hy ⊢,
  rw [pow_two, mul_dvd_mul_iff_left h] at hy,
  obtain ⟨w, hw⟩ := hy,
  exact (hx z ⟨w, by rwa [mul_right_comm, ←hw]⟩).mul_right_dvd.2 dvd_rfl,
end

theorem is_radical_iff_squarefree_or_zero {x : R} : is_radical x ↔ squarefree x ∨ x = 0 :=
⟨λ hx, (em $ x = 0).elim or.inr (λ h, or.inl $ hx.squarefree h),
  or.rec squarefree.is_radical $ by { rintro rfl, rw zero_is_radical_iff, apply_instance }⟩

theorem is_radical_iff_squarefree_of_ne_zero {x : R} (h : x ≠ 0) : is_radical x ↔ squarefree x :=
⟨is_radical.squarefree h, squarefree.is_radical⟩

end is_radical

namespace unique_factorization_monoid
variables [cancel_comm_monoid_with_zero R] [unique_factorization_monoid R]

lemma squarefree_iff_nodup_normalized_factors [normalization_monoid R] [decidable_eq R] {x : R}
  (x0 : x ≠ 0) : squarefree x ↔ multiset.nodup (normalized_factors x) :=
begin
  have drel : decidable_rel (has_dvd.dvd : R → R → Prop),
  { classical,
    apply_instance, },
  haveI := drel,
  rw [multiplicity.squarefree_iff_multiplicity_le_one, multiset.nodup_iff_count_le_one],
  haveI := nontrivial_of_ne x 0 x0,
  split; intros h a,
  { by_cases hmem : a ∈ normalized_factors x,
    { have ha := irreducible_of_normalized_factor _ hmem,
      rcases h a with h | h,
      { rw ← normalize_normalized_factor _ hmem,
        rw [multiplicity_eq_count_normalized_factors ha x0] at h,
        assumption_mod_cast },
      { have := ha.1, contradiction, } },
    { simp [multiset.count_eq_zero_of_not_mem hmem] } },
  { rw or_iff_not_imp_right, intro hu,
    by_cases h0 : a = 0,
    { simp [h0, x0] },
    rcases wf_dvd_monoid.exists_irreducible_factor hu h0 with ⟨b, hib, hdvd⟩,
    apply le_trans (multiplicity.multiplicity_le_multiplicity_of_dvd_left hdvd),
    rw [multiplicity_eq_count_normalized_factors hib x0],
    specialize h (normalize b),
    assumption_mod_cast }
end

lemma dvd_pow_iff_dvd_of_squarefree {x y : R} {n : ℕ} (hsq : squarefree x) (h0 : n ≠ 0) :
  x ∣ y ^ n ↔ x ∣ y :=
begin
  classical,
  haveI := unique_factorization_monoid.to_gcd_monoid R,
  exact ⟨hsq.is_radical n y, λ h, h.pow h0⟩,
end

end unique_factorization_monoid


import linear_algebra.clifford_algebra.basic
import analysis.inner_product_space.basic
import geometric_algebra.from_mathlib.basic
/-!
# Conformal Geometric algebra

This files defines the conformalized vector space `conformalize V`, and its associated geometric algebra `CGA`.

A typical usage would use `CGA (euclidean_space ℝ 3)`.
-/

-- the real numbers are not computable
noncomputable theory

variables (V : Type*) [inner_product_space ℝ V]

/-! ## The conformalized space `conformalize V` -/
/-- A conformalized vector has additional $n_0$ and $n_\infty$ components -/
@[derive [add_comm_group, module ℝ]]
def conformalize : Type* := V × ℝ × ℝ

namespace conformalize

variables {V}
/-! Linear maps which extract the three components, with `c_` abbreviating
"coefficient of". -/
def v : conformalize V →ₗ[ℝ] V := linear_map.fst _ _ _
def c_n0 : conformalize V →ₗ[ℝ] ℝ := (linear_map.fst _ _ _).comp (linear_map.snd _ _ _)
def c_ni : conformalize V →ₗ[ℝ] ℝ := (linear_map.snd _ _ _).comp (linear_map.snd _ _ _)

/-! The embedding of directions from `V` into `conformalize V`, and the two
basis vectors. -/
def of_v : V →ₗ[ℝ] conformalize V := linear_map.inl _ _ _
def n0 : conformalize V := (0, 1, 0)
def ni : conformalize V := (0, 0, 1)

/-! Lemmas to train the simplifier about trivial compositions of the above. -/
@[simp] lemma v_of_v (x : V) : (of_v x).v = x := rfl
@[simp] lemma c_n0_of_v (x : V) : (of_v x).c_n0 = 0 := rfl
@[simp] lemma c_ni_of_v (x : V) : (of_v x).c_ni = 0 := rfl
@[simp] lemma v_n0 : (n0 : conformalize V).v = 0 := rfl
@[simp] lemma c_n0_n0 : (n0 : conformalize V).c_n0 = 1 := rfl
@[simp] lemma c_ni_n0 : (n0 : conformalize V).c_ni = 0 := rfl
@[simp] lemma v_ni : (ni : conformalize V).v = 0 := rfl
@[simp] lemma c_n0_ni : (ni : conformalize V).c_n0 = 0 := rfl
@[simp] lemma c_ni_ni : (ni : conformalize V).c_ni = 1 := rfl

/-- The embedding of points from `V` to `conformalize V`. -/
def up (x : V) : conformalize V :=
n0 + of_v x + (1 / 2 * ‖x‖^2 : ℝ) • ni

/-! ## The metric on the conformalized space -/

/-- The metric is the metric of V plus an extra term about n0 and ni. -/
def Q : quadratic_form ℝ (conformalize V) :=
(bilin_form_of_real_inner.comp v v).to_quadratic_form - (2 : ℝ) • quadratic_form.lin_mul_lin c_n0 c_ni

/-- Show the definition is what we expect. -/
@[simp] lemma Q_apply (x : conformalize V) : Q x = ‖x.v‖^2 - 2 * (x.c_n0 * x.c_ni) :=
by simp [Q, inner_self_eq_norm_sq_to_K]

@[simp] lemma Q_up (x : V) : Q (up x) = 0 :=
by simp [up, ←mul_assoc]

/-! Train the simplifier how to act on components -/
@[simp] lemma Q_polar_n0_of_v (x : V) : quadratic_form.polar Q n0 (of_v x) = 0 :=
by simp [quadratic_form.polar]
@[simp] lemma Q_polar_n0_n0 : quadratic_form.polar Q n0 (n0 : conformalize V) = 0 :=
by simp [quadratic_form.polar]
@[simp] lemma Q_polar_n0_ni : quadratic_form.polar Q n0 (ni : conformalize V) = -2 :=
by simp [quadratic_form.polar]
@[simp] lemma Q_polar_ni_of_v (x : V) : quadratic_form.polar Q ni (of_v x) = 0 :=
by simp [quadratic_form.polar]
@[simp] lemma Q_polar_ni_ni : quadratic_form.polar Q ni (n0 : conformalize V) = -2 :=
by simp [quadratic_form.polar]
@[simp] lemma Q_polar_ni_n0 : quadratic_form.polar Q ni (ni : conformalize V) = 0 :=
by simp [quadratic_form.polar]
@[simp] lemma Q_polar_of_v_ni (x : V) : quadratic_form.polar Q (of_v x) n0 = 0 :=
by simp [quadratic_form.polar]
@[simp] lemma Q_polar_of_v_n0 (x : V) : quadratic_form.polar Q (of_v x) ni = 0 :=
by simp [quadratic_form.polar]

-- this one is harder than the rest
@[simp] lemma Q_polar_of_v_of_v (x y : V) : quadratic_form.polar Q (of_v x) (of_v y) = 2 * inner x y :=
begin
  rw [quadratic_form.polar, Q_apply],
  suffices : ‖x + y‖ ^ 2 - ‖x‖ ^ 2 - ‖y‖ ^ 2 = 2 * inner x y,
  { simpa using this, },
  simp only [norm_sq_eq_inner, is_R_or_C.re_to_real],
  rw [inner_add_add_self, ←real_inner_comm y x, two_mul],
  abel,
end

/-- The c_n0 and c_ni terms cancel to give the (negated) distance -/
@[simp] lemma Q_polar_up (x y : V) : quadratic_form.polar Q (up x) (up y) = -dist x y ^ 2 :=
begin
  dunfold up,
  simp only [dist_eq_norm, norm_sq_eq_inner, is_R_or_C.re_to_real, inner_sub_sub_self, ←real_inner_comm y x],
  simp [mul_right_comm, two_mul],
  abel
end

/-! ## The geometric algebra over that space -/

variables (V)
/-- Define the Conformal Geometric Algebra over `V` . -/
abbreviation CGA := clifford_algebra (Q : quadratic_form ℝ $ conformalize V)
variables {V}

open clifford_algebra

lemma ι_up_mul_ι_up_add_swap (x y : V) :
  ι Q (up x) * ι Q (up y) + ι Q (up y) * ι Q (up x) = algebra_map _ _ (-dist x y ^ 2) :=
by rw [ι_mul_ι_add_swap, Q_polar_up]

end conformalize


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Yury Kudryashov
-/
import dynamics.ergodic.measure_preserving
import linear_algebra.determinant
import linear_algebra.matrix.diagonal
import linear_algebra.matrix.transvection
import measure_theory.constructions.pi
import measure_theory.measure.stieltjes

/-!
# Lebesgue measure on the real line and on `ℝⁿ`

We construct Lebesgue measure on the real line, as a particular case of Stieltjes measure associated
to the function `x ↦ x`. We obtain as a consequence Lebesgue measure on `ℝⁿ`. We prove that they
are translation invariant.

We show that, on `ℝⁿ`, a linear map acts on Lebesgue measure by rescaling it through the absolute
value of its determinant, in `real.map_linear_map_volume_pi_eq_smul_volume_pi`.

More properties of the Lebesgue measure are deduced from this in `haar_lebesgue.lean`, where they
are proved more generally for any additive Haar measure on a finite-dimensional real vector space.
-/

noncomputable theory
open classical set filter measure_theory measure_theory.measure
open ennreal (of_real)
open_locale big_operators ennreal nnreal topological_space

/-!
### Definition of the Lebesgue measure and lengths of intervals
-/

/-- Lebesgue measure on the Borel sigma algebra, giving measure `b - a` to the interval `[a, b]`. -/
instance real.measure_space : measure_space ℝ :=
⟨stieltjes_function.id.measure⟩

namespace real

variables {ι : Type*} [fintype ι]

open_locale topological_space

theorem volume_val (s) : volume s = stieltjes_function.id.measure s := rfl

@[simp] lemma volume_Ico {a b : ℝ} : volume (Ico a b) = of_real (b - a) :=
by simp [volume_val]

@[simp] lemma volume_Icc {a b : ℝ} : volume (Icc a b) = of_real (b - a) :=
by simp [volume_val]

@[simp] lemma volume_Ioo {a b : ℝ} : volume (Ioo a b) = of_real (b - a) :=
by simp [volume_val]

@[simp] lemma volume_Ioc {a b : ℝ} : volume (Ioc a b) = of_real (b - a) :=
by simp [volume_val]

@[simp] lemma volume_singleton {a : ℝ} : volume ({a} : set ℝ) = 0 :=
by simp [volume_val]

@[simp] lemma volume_univ : volume (univ : set ℝ) = ∞ :=
ennreal.eq_top_of_forall_nnreal_le $ λ r,
  calc (r : ℝ≥0∞) = volume (Icc (0 : ℝ) r) : by simp
              ... ≤ volume univ            : measure_mono (subset_univ _)

@[simp] lemma volume_ball (a r : ℝ) :
  volume (metric.ball a r) = of_real (2 * r) :=
by rw [ball_eq_Ioo, volume_Ioo, ← sub_add, add_sub_cancel', two_mul]

@[simp] lemma volume_closed_ball (a r : ℝ) :
  volume (metric.closed_ball a r) = of_real (2 * r) :=
by rw [closed_ball_eq_Icc, volume_Icc, ← sub_add, add_sub_cancel', two_mul]

@[simp] lemma volume_emetric_ball (a : ℝ) (r : ℝ≥0∞) :
  volume (emetric.ball a r) = 2 * r :=
begin
  rcases eq_or_ne r ∞ with rfl|hr,
  { rw [metric.emetric_ball_top, volume_univ, two_mul, ennreal.top_add] },
  { lift r to ℝ≥0 using hr,
    rw [metric.emetric_ball_nnreal, volume_ball, two_mul, ← nnreal.coe_add,
      ennreal.of_real_coe_nnreal, ennreal.coe_add, two_mul] }
end

@[simp] lemma volume_emetric_closed_ball (a : ℝ) (r : ℝ≥0∞) :
  volume (emetric.closed_ball a r) = 2 * r :=
begin
  rcases eq_or_ne r ∞ with rfl|hr,
  { rw [emetric.closed_ball_top, volume_univ, two_mul, ennreal.top_add] },
  { lift r to ℝ≥0 using hr,
    rw [metric.emetric_closed_ball_nnreal, volume_closed_ball, two_mul, ← nnreal.coe_add,
      ennreal.of_real_coe_nnreal, ennreal.coe_add, two_mul] }
end

instance has_no_atoms_volume : has_no_atoms (volume : measure ℝ) :=
⟨λ x, volume_singleton⟩

@[simp] lemma volume_interval {a b : ℝ} : volume (interval a b) = of_real (|b - a|) :=
by rw [interval, volume_Icc, max_sub_min_eq_abs]

@[simp] lemma volume_Ioi {a : ℝ} : volume (Ioi a) = ∞ :=
top_unique $ le_of_tendsto' ennreal.tendsto_nat_nhds_top $ λ n,
calc (n : ℝ≥0∞) = volume (Ioo a (a + n)) : by simp
... ≤ volume (Ioi a) : measure_mono Ioo_subset_Ioi_self

@[simp] lemma volume_Ici {a : ℝ} : volume (Ici a) = ∞ :=
by simp [← measure_congr Ioi_ae_eq_Ici]

@[simp] lemma volume_Iio {a : ℝ} : volume (Iio a) = ∞ :=
top_unique $ le_of_tendsto' ennreal.tendsto_nat_nhds_top $ λ n,
calc (n : ℝ≥0∞) = volume (Ioo (a - n) a) : by simp
... ≤ volume (Iio a) : measure_mono Ioo_subset_Iio_self

@[simp] lemma volume_Iic {a : ℝ} : volume (Iic a) = ∞ :=
by simp [← measure_congr Iio_ae_eq_Iic]

instance locally_finite_volume : is_locally_finite_measure (volume : measure ℝ) :=
⟨λ x, ⟨Ioo (x - 1) (x + 1),
  is_open.mem_nhds is_open_Ioo ⟨sub_lt_self _ zero_lt_one, lt_add_of_pos_right _ zero_lt_one⟩,
  by simp only [real.volume_Ioo, ennreal.of_real_lt_top]⟩⟩

instance is_finite_measure_restrict_Icc (x y : ℝ) : is_finite_measure (volume.restrict (Icc x y)) :=
⟨by simp⟩

instance is_finite_measure_restrict_Ico (x y : ℝ) : is_finite_measure (volume.restrict (Ico x y)) :=
⟨by simp⟩

instance is_finite_measure_restrict_Ioc (x y : ℝ) : is_finite_measure (volume.restrict (Ioc x y)) :=
 ⟨by simp⟩

instance is_finite_measure_restrict_Ioo (x y : ℝ) : is_finite_measure (volume.restrict (Ioo x y)) :=
⟨by simp⟩

/-!
### Volume of a box in `ℝⁿ`
-/

lemma volume_Icc_pi {a b : ι → ℝ} : volume (Icc a b) = ∏ i, ennreal.of_real (b i - a i) :=
begin
  rw [← pi_univ_Icc, volume_pi_pi],
  simp only [real.volume_Icc]
end

@[simp] lemma volume_Icc_pi_to_real {a b : ι → ℝ} (h : a ≤ b) :
  (volume (Icc a b)).to_real = ∏ i, (b i - a i) :=
by simp only [volume_Icc_pi, ennreal.to_real_prod, ennreal.to_real_of_real (sub_nonneg.2 (h _))]

lemma volume_pi_Ioo {a b : ι → ℝ} :
  volume (pi univ (λ i, Ioo (a i) (b i))) = ∏ i, ennreal.of_real (b i - a i) :=
(measure_congr measure.univ_pi_Ioo_ae_eq_Icc).trans volume_Icc_pi

@[simp] lemma volume_pi_Ioo_to_real {a b : ι → ℝ} (h : a ≤ b) :
  (volume (pi univ (λ i, Ioo (a i) (b i)))).to_real = ∏ i, (b i - a i) :=
by simp only [volume_pi_Ioo, ennreal.to_real_prod, ennreal.to_real_of_real (sub_nonneg.2 (h _))]

lemma volume_pi_Ioc {a b : ι → ℝ} :
  volume (pi univ (λ i, Ioc (a i) (b i))) = ∏ i, ennreal.of_real (b i - a i) :=
(measure_congr measure.univ_pi_Ioc_ae_eq_Icc).trans volume_Icc_pi

@[simp] lemma volume_pi_Ioc_to_real {a b : ι → ℝ} (h : a ≤ b) :
  (volume (pi univ (λ i, Ioc (a i) (b i)))).to_real = ∏ i, (b i - a i) :=
by simp only [volume_pi_Ioc, ennreal.to_real_prod, ennreal.to_real_of_real (sub_nonneg.2 (h _))]

lemma volume_pi_Ico {a b : ι → ℝ} :
  volume (pi univ (λ i, Ico (a i) (b i))) = ∏ i, ennreal.of_real (b i - a i) :=
(measure_congr measure.univ_pi_Ico_ae_eq_Icc).trans volume_Icc_pi

@[simp] lemma volume_pi_Ico_to_real {a b : ι → ℝ} (h : a ≤ b) :
  (volume (pi univ (λ i, Ico (a i) (b i)))).to_real = ∏ i, (b i - a i) :=
by simp only [volume_pi_Ico, ennreal.to_real_prod, ennreal.to_real_of_real (sub_nonneg.2 (h _))]

@[simp] lemma volume_pi_ball (a : ι → ℝ) {r : ℝ} (hr : 0 < r) :
  volume (metric.ball a r) = ennreal.of_real ((2 * r) ^ fintype.card ι) :=
begin
  simp only [volume_pi_ball a hr, volume_ball, finset.prod_const],
  exact (ennreal.of_real_pow (mul_nonneg zero_le_two hr.le) _).symm
end

@[simp] lemma volume_pi_closed_ball (a : ι → ℝ) {r : ℝ} (hr : 0 ≤ r) :
  volume (metric.closed_ball a r) = ennreal.of_real ((2 * r) ^ fintype.card ι) :=
begin
  simp only [volume_pi_closed_ball a hr, volume_closed_ball, finset.prod_const],
  exact (ennreal.of_real_pow (mul_nonneg zero_le_two hr) _).symm
end

lemma volume_le_diam (s : set ℝ) : volume s ≤ emetric.diam s :=
begin
  by_cases hs : metric.bounded s,
  { rw [real.ediam_eq hs, ← volume_Icc],
    exact volume.mono (real.subset_Icc_Inf_Sup_of_bounded hs) },
  { rw metric.ediam_of_unbounded hs, exact le_top }
end

lemma volume_pi_le_prod_diam (s : set (ι → ℝ)) :
  volume s ≤ ∏ i : ι, emetric.diam (function.eval i '' s) :=
calc volume s ≤ volume (pi univ (λ i, closure (function.eval i '' s))) :
  volume.mono $ subset.trans (subset_pi_eval_image univ s) $ pi_mono $ λ i hi, subset_closure
          ... = ∏ i, volume (closure $ function.eval i '' s) :
  volume_pi_pi _
          ... ≤ ∏ i : ι, emetric.diam (function.eval i '' s) :
  finset.prod_le_prod' $ λ i hi, (volume_le_diam _).trans_eq (emetric.diam_closure _)

lemma volume_pi_le_diam_pow (s : set (ι → ℝ)) :
  volume s ≤ emetric.diam s ^ fintype.card ι :=
calc volume s ≤ ∏ i : ι, emetric.diam (function.eval i '' s) : volume_pi_le_prod_diam s
          ... ≤ ∏ i : ι, (1 : ℝ≥0) * emetric.diam s                      :
  finset.prod_le_prod' $ λ i hi, (lipschitz_with.eval i).ediam_image_le s
          ... = emetric.diam s ^ fintype.card ι              :
  by simp only [ennreal.coe_one, one_mul, finset.prod_const, fintype.card]

/-!
### Images of the Lebesgue measure under translation/multiplication in ℝ
-/

instance is_add_left_invariant_real_volume :
  is_add_left_invariant (volume : measure ℝ) :=
⟨λ a, eq.symm $ real.measure_ext_Ioo_rat $ λ p q,
  by simp [measure.map_apply (measurable_const_add a) measurable_set_Ioo, sub_sub_sub_cancel_right]⟩

lemma smul_map_volume_mul_left {a : ℝ} (h : a ≠ 0) :
  ennreal.of_real (|a|) • measure.map ((*) a) volume = volume :=
begin
  refine (real.measure_ext_Ioo_rat $ λ p q, _).symm,
  cases lt_or_gt_of_ne h with h h,
  { simp only [real.volume_Ioo, measure.smul_apply, ← ennreal.of_real_mul (le_of_lt $ neg_pos.2 h),
      measure.map_apply (measurable_const_mul a) measurable_set_Ioo, neg_sub_neg,
      neg_mul, preimage_const_mul_Ioo_of_neg _ _ h, abs_of_neg h, mul_sub, smul_eq_mul,
      mul_div_cancel' _ (ne_of_lt h)] },
  { simp only [real.volume_Ioo, measure.smul_apply, ← ennreal.of_real_mul (le_of_lt h),
      measure.map_apply (measurable_const_mul a) measurable_set_Ioo, preimage_const_mul_Ioo _ _ h,
      abs_of_pos h, mul_sub, mul_div_cancel' _ (ne_of_gt h), smul_eq_mul] }
end

lemma map_volume_mul_left {a : ℝ} (h : a ≠ 0) :
  measure.map ((*) a) volume = ennreal.of_real (|a⁻¹|) • volume :=
by conv_rhs { rw [← real.smul_map_volume_mul_left h, smul_smul,
  ← ennreal.of_real_mul (abs_nonneg _), ← abs_mul, inv_mul_cancel h, abs_one, ennreal.of_real_one,
  one_smul] }

@[simp] lemma volume_preimage_mul_left {a : ℝ} (h : a ≠ 0) (s : set ℝ) :
  volume (((*) a) ⁻¹' s) = ennreal.of_real (abs a⁻¹) * volume s :=
calc volume (((*) a) ⁻¹' s) = measure.map ((*) a) volume s :
  ((homeomorph.mul_left₀ a h).to_measurable_equiv.map_apply s).symm
... = ennreal.of_real (abs a⁻¹) * volume s : by { rw map_volume_mul_left h, refl }

lemma smul_map_volume_mul_right {a : ℝ} (h : a ≠ 0) :
  ennreal.of_real (|a|) • measure.map (* a) volume = volume :=
by simpa only [mul_comm] using real.smul_map_volume_mul_left h

lemma map_volume_mul_right {a : ℝ} (h : a ≠ 0) :
  measure.map (* a) volume = ennreal.of_real (|a⁻¹|) • volume :=
by simpa only [mul_comm] using real.map_volume_mul_left h

@[simp] lemma volume_preimage_mul_right {a : ℝ} (h : a ≠ 0) (s : set ℝ) :
  volume ((* a) ⁻¹' s) = ennreal.of_real (abs a⁻¹) * volume s :=
calc volume ((* a) ⁻¹' s) = measure.map (* a) volume s :
  ((homeomorph.mul_right₀ a h).to_measurable_equiv.map_apply s).symm
... = ennreal.of_real (abs a⁻¹) * volume s : by { rw map_volume_mul_right h, refl }

instance : is_neg_invariant (volume : measure ℝ) :=
⟨eq.symm $ real.measure_ext_Ioo_rat $ λ p q, by simp [show volume.neg (Ioo (p : ℝ) q) = _,
  from measure.map_apply measurable_neg measurable_set_Ioo]⟩

/-!
### Images of the Lebesgue measure under translation/linear maps in ℝⁿ
-/

open matrix

/-- A diagonal matrix rescales Lebesgue according to its determinant. This is a special case of
`real.map_matrix_volume_pi_eq_smul_volume_pi`, that one should use instead (and whose proof
uses this particular case). -/
lemma smul_map_diagonal_volume_pi [decidable_eq ι] {D : ι → ℝ} (h : det (diagonal D) ≠ 0) :
  ennreal.of_real (abs (det (diagonal D))) • measure.map ((diagonal D).to_lin') volume = volume :=
begin
  refine (measure.pi_eq (λ s hs, _)).symm,
  simp only [det_diagonal, measure.coe_smul, algebra.id.smul_eq_mul, pi.smul_apply],
  rw [measure.map_apply _ (measurable_set.univ_pi_fintype hs)],
  swap, { exact continuous.measurable (linear_map.continuous_on_pi _) },
  have : (matrix.to_lin' (diagonal D)) ⁻¹' (set.pi set.univ (λ (i : ι), s i))
    = set.pi set.univ (λ (i : ι), ((*) (D i)) ⁻¹' (s i)),
  { ext f,
    simp only [linear_map.coe_proj, algebra.id.smul_eq_mul, linear_map.smul_apply, mem_univ_pi,
      mem_preimage, linear_map.pi_apply, diagonal_to_lin'] },
  have B : ∀ i, of_real (abs (D i)) * volume (has_mul.mul (D i) ⁻¹' s i) = volume (s i),
  { assume i,
    have A : D i ≠ 0,
    { simp only [det_diagonal, ne.def] at h,
      exact finset.prod_ne_zero_iff.1 h i (finset.mem_univ i) },
    rw [volume_preimage_mul_left A, ← mul_assoc, ← ennreal.of_real_mul (abs_nonneg _), ← abs_mul,
      mul_inv_cancel A, abs_one, ennreal.of_real_one, one_mul] },
  rw [this, volume_pi_pi, finset.abs_prod,
    ennreal.of_real_prod_of_nonneg (λ i hi, abs_nonneg (D i)), ← finset.prod_mul_distrib],
  simp only [B]
end

/-- A transvection preserves Lebesgue measure. -/
lemma map_transvection_volume_pi [decidable_eq ι] (t : transvection_struct ι ℝ) :
  measure.map (t.to_matrix.to_lin') volume = volume :=
begin
  /- We separate the coordinate along which there is a shearing from the other ones, and apply
  Fubini. Along this coordinate (and when all the other coordinates are fixed), it acts like a
  translation, and therefore preserves Lebesgue. -/
  suffices H : measure_preserving t.to_matrix.to_lin' volume volume, by exact H.2,
  let p : ι → Prop := λ i, i ≠ t.i,
  let α : Type* := {x // p x},
  let β : Type* := {x // ¬ (p x)},
  let g : (α → ℝ) → (β → ℝ) → (β → ℝ) := λ a b, (λ x, t.c * a ⟨t.j, t.hij.symm⟩) + b,
  let F : (α → ℝ) × (β → ℝ) → (α → ℝ) × (β → ℝ) :=
    λ p, (id p.1, g p.1 p.2),
  let e := equiv.pi_equiv_pi_subtype_prod p (λ (i : ι), ℝ),
  have : (t.to_matrix.to_lin' : (ι → ℝ) → (ι → ℝ)) = e.symm ∘ F ∘ e,
  { cases t,
    ext f k,
    simp only [linear_equiv.map_smul, dite_eq_ite, linear_map.id_coe, p, ite_not,
      algebra.id.smul_eq_mul, one_mul, dot_product, std_basis_matrix,
      equiv.pi_equiv_pi_subtype_prod_symm_apply, id.def, transvection,
      pi.add_apply, zero_mul, linear_map.smul_apply, function.comp_app,
      equiv.pi_equiv_pi_subtype_prod_apply, matrix.transvection_struct.to_matrix_mk,
      matrix.mul_vec, linear_equiv.map_add, ite_mul, e, matrix.to_lin'_apply,
      pi.smul_apply, subtype.coe_mk, g, linear_map.add_apply, finset.sum_congr, matrix.to_lin'_one],
    by_cases h : t_i = k,
    { simp only [h, true_and, finset.mem_univ, if_true, eq_self_iff_true, finset.sum_ite_eq,
        one_apply, boole_mul, add_comm], },
    { simp only [h, ne.symm h, add_zero, if_false, finset.sum_const_zero, false_and, mul_zero] } },
  rw this,
  have A : measure_preserving e volume volume :=
  ⟨ measurable_pi_equiv_pi_subtype_prod (λ i, ℝ) _,
    (measure.map_pi_equiv_pi_subtype_prod (λ i, (volume : measure ℝ)) p : _) ⟩,
  have B : measure_preserving F volume volume,
  { have g_meas : measurable (function.uncurry g),
    { have : measurable (λ (c : (α → ℝ)), c ⟨t.j, t.hij.symm⟩) :=
        measurable_pi_apply ⟨t.j, t.hij.symm⟩,
      refine measurable.add (measurable_pi_lambda _ (λ i, measurable.const_mul _ _)) measurable_snd,
      exact this.comp measurable_fst },
    exact measure_preserving.skew_product (measure_preserving.id _) g_meas
      (eventually_of_forall (λ a, map_add_left_eq_self _ _)) },
  have C : measure_preserving e.symm volume volume :=
  ⟨ (measurable_pi_equiv_pi_subtype_prod_symm (λ (i : ι), ℝ) p : _),
    (measure.map_pi_equiv_pi_subtype_prod_symm (λ (i : ι), volume) p : _) ⟩,
  exact (C.comp B).comp A,
end

/-- Any invertible matrix rescales Lebesgue measure through the absolute value of its
determinant. -/
lemma map_matrix_volume_pi_eq_smul_volume_pi [decidable_eq ι] {M : matrix ι ι ℝ} (hM : det M ≠ 0) :
  measure.map (M.to_lin') volume = ennreal.of_real (abs (det M)⁻¹) • volume :=
begin
  -- This follows from the cases we have already proved, of diagonal matrices and transvections,
  -- as these matrices generate all invertible matrices.
  apply diagonal_transvection_induction_of_det_ne_zero _ M hM (λ D hD, _) (λ t, _)
    (λ A B hA hB IHA IHB, _),
  { conv_rhs { rw [← smul_map_diagonal_volume_pi hD] },
    rw [smul_smul, ← ennreal.of_real_mul (abs_nonneg _), ← abs_mul, inv_mul_cancel hD, abs_one,
      ennreal.of_real_one, one_smul] },
  { simp only [matrix.transvection_struct.det, ennreal.of_real_one, map_transvection_volume_pi,
      one_smul, _root_.inv_one, abs_one] },
  { rw [to_lin'_mul, det_mul, linear_map.coe_comp, ← measure.map_map, IHB, measure.map_smul,
      IHA, smul_smul, ← ennreal.of_real_mul (abs_nonneg _), ← abs_mul, mul_comm, mul_inv₀],
    { apply continuous.measurable,
      apply linear_map.continuous_on_pi },
    { apply continuous.measurable,
      apply linear_map.continuous_on_pi } }
end

/-- Any invertible linear map rescales Lebesgue measure through the absolute value of its
determinant. -/
lemma map_linear_map_volume_pi_eq_smul_volume_pi {f : (ι → ℝ) →ₗ[ℝ] (ι → ℝ)} (hf : f.det ≠ 0) :
  measure.map f volume = ennreal.of_real (abs (f.det)⁻¹) • volume :=
begin
  -- this is deduced from the matrix case
  classical,
  let M := f.to_matrix',
  have A : f.det = det M, by simp only [linear_map.det_to_matrix'],
  have B : f = M.to_lin', by simp only [to_lin'_to_matrix'],
  rw [A, B],
  apply map_matrix_volume_pi_eq_smul_volume_pi,
  rwa A at hf
end

end real

open_locale topological_space

lemma filter.eventually.volume_pos_of_nhds_real {p : ℝ → Prop} {a : ℝ} (h : ∀ᶠ x in 𝓝 a, p x) :
  (0 : ℝ≥0∞) < volume {x | p x} :=
begin
  rcases h.exists_Ioo_subset with ⟨l, u, hx, hs⟩,
  refine lt_of_lt_of_le _ (measure_mono hs),
  simpa [-mem_Ioo] using hx.1.trans hx.2
end

section region_between

open_locale classical

variable {α : Type*}

/-- The region between two real-valued functions on an arbitrary set. -/
def region_between (f g : α → ℝ) (s : set α) : set (α × ℝ) :=
{p : α × ℝ | p.1 ∈ s ∧ p.2 ∈ Ioo (f p.1) (g p.1)}

lemma region_between_subset (f g : α → ℝ) (s : set α) :
  region_between f g s ⊆ s ×ˢ (univ : set ℝ) :=
by simpa only [prod_univ, region_between, set.preimage, set_of_subset_set_of] using λ a, and.left

variables [measurable_space α] {μ : measure α} {f g : α → ℝ} {s : set α}

/-- The region between two measurable functions on a measurable set is measurable. -/
lemma measurable_set_region_between
  (hf : measurable f) (hg : measurable g) (hs : measurable_set s) :
  measurable_set (region_between f g s) :=
begin
  dsimp only [region_between, Ioo, mem_set_of_eq, set_of_and],
  refine measurable_set.inter _ ((measurable_set_lt (hf.comp measurable_fst) measurable_snd).inter
    (measurable_set_lt measurable_snd (hg.comp measurable_fst))),
  exact measurable_fst hs
end

theorem volume_region_between_eq_lintegral'
  (hf : measurable f) (hg : measurable g) (hs : measurable_set s) :
  μ.prod volume (region_between f g s) = ∫⁻ y in s, ennreal.of_real ((g - f) y) ∂μ :=
begin
  rw measure.prod_apply,
  { have h : (λ x, volume {a | x ∈ s ∧ a ∈ Ioo (f x) (g x)})
            = s.indicator (λ x, ennreal.of_real (g x - f x)),
    { funext x,
      rw indicator_apply,
      split_ifs,
      { have hx : {a | x ∈ s ∧ a ∈ Ioo (f x) (g x)} = Ioo (f x) (g x) := by simp [h, Ioo],
        simp only [hx, real.volume_Ioo, sub_zero] },
      { have hx : {a | x ∈ s ∧ a ∈ Ioo (f x) (g x)} = ∅ := by simp [h],
        simp only [hx, measure_empty] } },
    dsimp only [region_between, preimage_set_of_eq],
    rw [h, lintegral_indicator];
    simp only [hs, pi.sub_apply] },
  { exact measurable_set_region_between hf hg hs },
end

/-- The volume of the region between two almost everywhere measurable functions on a measurable set
    can be represented as a Lebesgue integral. -/
theorem volume_region_between_eq_lintegral [sigma_finite μ]
  (hf : ae_measurable f (μ.restrict s)) (hg : ae_measurable g (μ.restrict s))
  (hs : measurable_set s) :
  μ.prod volume (region_between f g s) = ∫⁻ y in s, ennreal.of_real ((g - f) y) ∂μ :=
begin
  have h₁ : (λ y, ennreal.of_real ((g - f) y))
          =ᵐ[μ.restrict s]
              λ y, ennreal.of_real ((ae_measurable.mk g hg - ae_measurable.mk f hf) y) :=
    (hg.ae_eq_mk.sub hf.ae_eq_mk).fun_comp _,
  have h₂ : (μ.restrict s).prod volume (region_between f g s) =
    (μ.restrict s).prod volume (region_between (ae_measurable.mk f hf) (ae_measurable.mk g hg) s),
  { apply measure_congr,
    apply eventually_eq.rfl.inter,
    exact
      ((ae_eq_comp' measurable_fst hf.ae_eq_mk measure.prod_fst_absolutely_continuous).comp₂ _
        eventually_eq.rfl).inter
      (eventually_eq.rfl.comp₂ _
        (ae_eq_comp' measurable_fst hg.ae_eq_mk measure.prod_fst_absolutely_continuous)) },
  rw [lintegral_congr_ae h₁,
      ← volume_region_between_eq_lintegral' hf.measurable_mk hg.measurable_mk hs],
  convert h₂ using 1,
  { rw measure.restrict_prod_eq_prod_univ,
    exact (measure.restrict_eq_self _ (region_between_subset f g s)).symm, },
  { rw measure.restrict_prod_eq_prod_univ,
    exact (measure.restrict_eq_self _
      (region_between_subset (ae_measurable.mk f hf) (ae_measurable.mk g hg) s)).symm },
end

theorem volume_region_between_eq_integral' [sigma_finite μ]
  (f_int : integrable_on f s μ) (g_int : integrable_on g s μ)
  (hs : measurable_set s) (hfg : f ≤ᵐ[μ.restrict s] g ) :
  μ.prod volume (region_between f g s) = ennreal.of_real (∫ y in s, (g - f) y ∂μ) :=
begin
  have h : g - f =ᵐ[μ.restrict s] (λ x, real.to_nnreal (g x - f x)),
    from hfg.mono (λ x hx, (real.coe_to_nnreal _ $ sub_nonneg.2 hx).symm),
  rw [volume_region_between_eq_lintegral f_int.ae_measurable g_int.ae_measurable hs,
    integral_congr_ae h, lintegral_congr_ae,
    lintegral_coe_eq_integral _ ((integrable_congr h).mp (g_int.sub f_int))],
  simpa only,
end

/-- If two functions are integrable on a measurable set, and one function is less than
    or equal to the other on that set, then the volume of the region
    between the two functions can be represented as an integral. -/
theorem volume_region_between_eq_integral [sigma_finite μ]
  (f_int : integrable_on f s μ) (g_int : integrable_on g s μ)
  (hs : measurable_set s) (hfg : ∀ x ∈ s, f x ≤ g x) :
  μ.prod volume (region_between f g s) = ennreal.of_real (∫ y in s, (g - f) y ∂μ) :=
volume_region_between_eq_integral' f_int g_int hs
  ((ae_restrict_iff' hs).mpr (eventually_of_forall hfg))

end region_between


import tuto_lib
/-
This file continues the elementary study of limits of sequences.
It can be skipped if the previous file was too easy, it won't introduce
any new tactic or trick.

Remember useful lemmas:

abs_le (x y : ℝ) : |x| ≤ y ↔ -y ≤ x ∧ x ≤ y

abs_add (x y : ℝ) : |x + y| ≤ |x| + |y|

abs_sub (x y : ℝ) : |x - y| = |y - x|

ge_max_iff (p q r) : r ≥ max p q  ↔ r ≥ p ∧ r ≥ q

le_max_left p q : p ≤ max p q

le_max_right p q : q ≤ max p q

and the definition:

def seq_limit (u : ℕ → ℝ) (l : ℝ) : Prop :=
∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - l| ≤ ε

You can also use a property proved in the previous file:

unique_limit : seq_limit u l → seq_limit u l' → l = l'

def extraction (φ : ℕ → ℕ) := ∀ n m, n < m → φ n < φ m
-/

variable { φ : ℕ → ℕ}

/-
The next lemma is proved by an easy induction, but we haven't seen induction
in this tutorial. If you did the natural number game then you can delete
the proof below and try to reconstruct it.
-/
/-- An extraction is greater than id -/
lemma id_le_extraction' : extraction φ → ∀ n, n ≤ φ n :=
begin
  intros hyp n,
  induction n with n hn,
  { exact nat.zero_le _ },
  { exact nat.succ_le_of_lt (by linarith [hyp n (n+1) (by linarith)]) },
end

/-- Extractions take arbitrarily large values for arbitrarily large
inputs. -/
-- 0039
lemma extraction_ge : extraction φ → ∀ N N', ∃ n ≥ N', φ n ≥ N :=
begin
  intros h n n',
  generalize hm : max n n' = m,
  cases ge_max_iff.mp (ge_of_eq (eq.symm hm)) with hn hn',
  use m,
  split,
    exact hn',
  calc φ m ≥ m : id_le_extraction' h m
       ... ≥ n : hn,
end

/-- A real number `a` is a cluster point of a sequence `u`
if `u` has a subsequence converging to `a`.

def cluster_point (u : ℕ → ℝ) (a : ℝ) :=
∃ φ, extraction φ ∧ seq_limit (u ∘ φ) a
-/

variables {u : ℕ → ℝ} {a l : ℝ}

/-
In the exercise, we use `∃ n ≥ N, ...` which is the abbreviation of
`∃ n, n ≥ N ∧ ...`.
Lean can read this abbreviation, but displays it as the confusing:
`∃ (n : ℕ) (H : n ≥ N)`
One gets used to it. Alternatively, one can get rid of it using the lemma
  exists_prop {p q : Prop} : (∃ (h : p), q) ↔ p ∧ q
-/

/-- If `a` is a cluster point of `u` then there are values of
`u` arbitrarily close to `a` for arbitrarily large input. -/
-- 0040
lemma near_cluster :
  cluster_point u a → ∀ ε > 0, ∀ N, ∃ n ≥ N, |u n - a| ≤ ε :=
begin
  intros h ε ε_pos n,
  rcases h with ⟨φ, φ_ext, φ_lim⟩,
  cases φ_lim ε ε_pos with n₂ hn₂, clear φ_lim,
  rcases extraction_ge φ_ext n n₂ with ⟨n₃, hn₃, hφ₃⟩,
  exact ⟨φ n₃, hφ₃, hn₂ n₃ hn₃⟩,
end

/-
The above exercice can be done in five lines.
Hint: you can use the anonymous constructor syntax when proving
existential statements.
-/

/-- If `u` tends to `l` then its subsequences tend to `l`. -/
-- 0041
lemma subseq_tendsto_of_tendsto' (h : seq_limit u l) (hφ : extraction φ) :
seq_limit (u ∘ φ) l :=
begin
  intros ε ε_pos,
  cases h ε ε_pos with n hn, clear h,
  use n,
  intros n₂ hn₂,
  apply hn,
  calc φ n₂ ≥ n₂ : id_le_extraction' hφ n₂
       ...  ≥ n  : hn₂,
end

/-- If `u` tends to `l` all its cluster points are equal to `l`. -/
-- 0042
lemma cluster_limit (hl : seq_limit u l) (ha : cluster_point u a) : a = l :=
begin
  rcases ha with ⟨φ, φ_ext, φ_lim⟩,
  have φ_lim', exact subseq_tendsto_of_tendsto' hl φ_ext,
  exact unique_limit φ_lim φ_lim',
end

/-- Cauchy_sequence sequence -/
def cauchy_sequence (u : ℕ → ℝ) := ∀ ε > 0, ∃ N, ∀ p q, p ≥ N → q ≥ N → |u p - u q| ≤ ε

-- 0043
example : (∃ l, seq_limit u l) → cauchy_sequence u :=
begin
  rintro ⟨l, h⟩,
  intros ε ε_pos,
  cases h (ε/2) (by linarith) with n hn,
  use n,
  intros p q hp hq,
  replace hp, exact hn p hp,
  replace hq, exact hn q hq,
  calc |u p - u q| = |(u p - l) + (l - u q)| : by ring
       ...         ≤ |u p - l| + |l - u q|   : by apply abs_add
       ...         = |u p - l| + |u q - l|   : by rw abs_sub (u q)
       ...         ≤ ε                       : by linarith,
end

/-
In the next exercise, you can reuse
 near_cluster : cluster_point u a → ∀ ε > 0, ∀ N, ∃ n ≥ N, |u n - a| ≤ ε
-/
-- 0044
example (hu : cauchy_sequence u) (hl : cluster_point u l) : seq_limit u l :=
begin
  intros ε ε_pos,
  cases hu (ε/2) (by linarith) with n hn,
  rcases near_cluster hl (ε/2) (by linarith) n with ⟨p, hp₁, hp₂⟩,
  use n,
  intros q hq,
  specialize hn p q hp₁ hq,
  calc |u q - l| = |(u q - u p) + (u p - l)| : by ring
       ...       ≤ |u q - u p| + |u p - l|   : by apply abs_add
       ...       = |u p - u q| + |u p - l|   : by rw abs_sub (u q)
       ...       ≤ ε                         : by linarith,
end


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

! This file was ported from Lean 3 source module ring_theory.bezout
! leanprover-community/mathlib commit 6623e6af705e97002a9054c1c05a980180276fc1
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.RingTheory.PrincipalIdealDomain
import Mathbin.Algebra.GcdMonoid.IntegrallyClosed

/-!

# Bézout rings

A Bézout ring (Bezout ring) is a ring whose finitely generated ideals are principal.
Notible examples include principal ideal rings, valuation rings, and the ring of algebraic integers.

## Main results
- `is_bezout.iff_span_pair_is_principal`: It suffices to verify every `span {x, y}` is principal.
- `is_bezout.to_gcd_monoid`: Every Bézout domain is a GCD domain. This is not an instance.
- `is_bezout.tfae`: For a Bézout domain, noetherian ↔ PID ↔ UFD ↔ ACCP

-/

universe u v

variable (R : Type u) [CommRing R]

/-- A Bézout ring is a ring whose finitely generated ideals are principal. -/
class IsBezout : Prop where
  isPrincipal_of_fg : ∀ I : Ideal R, I.Fg → I.IsPrincipal
#align is_bezout IsBezout

namespace IsBezout

variable {R}

instance span_pair_isPrincipal [IsBezout R] (x y : R) : (Ideal.span {x, y} : Ideal R).IsPrincipal :=
  by classical exact is_principal_of_fg (Ideal.span {x, y}) ⟨{x, y}, by simp⟩
#align is_bezout.span_pair_is_principal IsBezout.span_pair_isPrincipal

theorem iff_span_pair_isPrincipal :
    IsBezout R ↔ ∀ x y : R, (Ideal.span {x, y} : Ideal R).IsPrincipal := by
  classical
    constructor
    · intro H x y
      infer_instance
    · intro H
      constructor
      apply Submodule.fg_induction
      · exact fun _ => ⟨⟨_, rfl⟩⟩
      · rintro _ _ ⟨⟨x, rfl⟩⟩ ⟨⟨y, rfl⟩⟩
        rw [← Submodule.span_insert]
        exact H _ _
#align is_bezout.iff_span_pair_is_principal IsBezout.iff_span_pair_isPrincipal

section Gcd

variable [IsBezout R]

/-- The gcd of two elements in a bezout domain. -/
noncomputable def gcd (x y : R) : R :=
  Submodule.IsPrincipal.generator (Ideal.span {x, y})
#align is_bezout.gcd IsBezout.gcd

theorem span_gcd (x y : R) : (Ideal.span {gcd x y} : Ideal R) = Ideal.span {x, y} :=
  Ideal.span_singleton_generator _
#align is_bezout.span_gcd IsBezout.span_gcd

theorem gcd_dvd_left (x y : R) : gcd x y ∣ x :=
  (Submodule.IsPrincipal.mem_iff_generator_dvd _).mp (Ideal.subset_span (by simp))
#align is_bezout.gcd_dvd_left IsBezout.gcd_dvd_left

theorem gcd_dvd_right (x y : R) : gcd x y ∣ y :=
  (Submodule.IsPrincipal.mem_iff_generator_dvd _).mp (Ideal.subset_span (by simp))
#align is_bezout.gcd_dvd_right IsBezout.gcd_dvd_right

theorem dvd_gcd {x y z : R} (hx : z ∣ x) (hy : z ∣ y) : z ∣ gcd x y :=
  by
  rw [← Ideal.span_singleton_le_span_singleton] at hx hy⊢
  rw [span_gcd, Ideal.span_insert, sup_le_iff]
  exact ⟨hx, hy⟩
#align is_bezout.dvd_gcd IsBezout.dvd_gcd

theorem gcd_eq_sum (x y : R) : ∃ a b : R, a * x + b * y = gcd x y :=
  Ideal.mem_span_pair.mp
    (by
      rw [← span_gcd]
      apply Ideal.subset_span
      simp)
#align is_bezout.gcd_eq_sum IsBezout.gcd_eq_sum

variable (R)

/-- Any bezout domain is a GCD domain. This is not an instance since `gcd_monoid` contains data,
and this might not be how we would like to construct it. -/
noncomputable def toGcdDomain [IsDomain R] [DecidableEq R] : GCDMonoid R :=
  gcdMonoidOfGCD gcd gcd_dvd_left gcd_dvd_right fun _ _ _ => dvd_gcd
#align is_bezout.to_gcd_domain IsBezout.toGcdDomain

end Gcd

attribute [local instance] to_gcd_domain

-- Note that the proof, despite being `infer_instance`, depends on the `local attribute [instance]`
-- lemma above, and is thus necessary to be restated.
instance (priority := 100) [IsDomain R] [IsBezout R] : IsIntegrallyClosed R := by
  classical exact GCDMonoid.toIsIntegrallyClosed

theorem Function.Surjective.isBezout {S : Type v} [CommRing S] (f : R →+* S)
    (hf : Function.Surjective f) [IsBezout R] : IsBezout S :=
  by
  rw [iff_span_pair_is_principal]
  intro x y
  obtain ⟨⟨x, rfl⟩, ⟨y, rfl⟩⟩ := hf x, hf y
  use f (gcd x y)
  trans Ideal.map f (Ideal.span {gcd x y})
  · rw [span_gcd, Ideal.map_span, Set.image_insert_eq, Set.image_singleton]
  · rw [Ideal.map_span, Set.image_singleton]
    rfl
#align function.surjective.is_bezout Function.Surjective.isBezout

instance (priority := 100) of_isPrincipalIdealRing [IsPrincipalIdealRing R] : IsBezout R :=
  ⟨fun I _ => IsPrincipalIdealRing.principal I⟩
#align is_bezout.of_is_principal_ideal_ring IsBezout.of_isPrincipalIdealRing

theorem tFAE [IsBezout R] [IsDomain R] :
    TFAE [IsNoetherianRing R, IsPrincipalIdealRing R, UniqueFactorizationMonoid R, WfDvdMonoid R] :=
  by
  classical
    tfae_have 1 → 2
    · intro H
      exact ⟨fun I => is_principal_of_fg _ (IsNoetherian.noetherian _)⟩
    tfae_have 2 → 3
    · intro
      infer_instance
    tfae_have 3 → 4
    · intro
      infer_instance
    tfae_have 4 → 1
    · rintro ⟨h⟩
      rw [isNoetherianRing_iff, isNoetherian_iff_fg_wellFounded]
      apply RelEmbedding.wellFounded _ h
      have : ∀ I : { J : Ideal R // J.Fg }, ∃ x : R, (I : Ideal R) = Ideal.span {x} :=
        fun ⟨I, hI⟩ => (IsBezout.isPrincipal_of_fg I hI).1
      choose f hf
      exact
        { toFun := f
          inj' := fun x y e => by
            ext1
            rw [hf, hf, e]
          map_rel_iff' := fun x y => by
            dsimp
            rw [← Ideal.span_singleton_lt_span_singleton, ← hf, ← hf]
            rfl }
    tfae_finish
#align is_bezout.tfae IsBezout.tFAE

end IsBezout


--
set_option autoImplicit false
universe u
variable {α : Type u}
variable {β : α → Type v}
infix:50 " ≅ " => HEq
theorem ex {p₁ p₂ : Sigma (fun a => β a)} (h₁ : p₁.1 = p₂.1) (h : p₁.2 ≅ p₂.2) : p₁ = p₂ :=
match p₁, p₂, h₁, h with
| ⟨_, _⟩, ⟨_, _⟩, rfl, HEq.refl _ => rfl


/-
Copyright 2020 Google LLC

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

      http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
 -/
import analysis.calculus.mean_value
import data.complex.exponential

import formal_ml.convex_optimization
--import formal_ml.analytic_function
import analysis.special_functions.exp_log
import formal_ml.nnreal

/-
  Note: after I proved this, I found that it already was in mathlib.
-/

--TODO: lift this until it doesn't depend upon has_derivative
lemma has_derivative_exp:has_derivative real.exp real.exp :=
begin
  unfold has_derivative,
  intro x,
  apply real.has_deriv_at_exp,
end

lemma exp_bound3 (x:real):0 ≤ real.exp x - (x + 1) :=
begin
  let f:=λ x,real.exp x - (x + 1),
  let f':=λ x,real.exp x - 1,
  let f'':=λ x,real.exp x,
  begin
    have f_def:f=λ x,real.exp x - (x + 1),
    {
      refl,
    },
    have f_def':f'=λ x,real.exp x - 1,
    {
      refl,
    },
    have f_def'':f''=λ x,real.exp x,
    {
      refl,
    },
    have A1:has_derivative f f',
    {
      rw f_def,
      rw f_def',
      apply has_derivative_sub real.exp real.exp  (λ x, (x + 1)) (1),
      {
        apply has_derivative_exp,
      },
      {
        apply has_derivative_add_const,
        apply has_derivative_id,
      },
    },
    have A2:has_derivative f' f'',
    {
      apply has_derivative_add_const,
      apply has_derivative_exp,
    },
    have A3:∀ y, f 0 ≤ f y,
    {
      intro y,
      apply is_minimum,
      {
        apply A1,
      },
      {
        apply A2,
      },
      {
        intro z,
        rw f_def'',
        apply le_of_lt,
        apply real.exp_pos,
      },
      have A3D:f' 0 = real.exp 0 - 1,
      {
        refl,
      },
      rw A3D,
      simp,
    },
    have A4:f 0 = 0,
    {
      rw f_def,
      simp,
    },
    rw A4 at A3,
    have A5:f x = real.exp x - (x + 1),
    {
      refl,
    },
    rw ← A5,
    apply A3,
  end
end

lemma exp_bound2 (x:real):1 - x ≤ real.exp(-x) :=
begin
  have A1:0 ≤ real.exp(-x) - ((-x) + 1),
  {
    apply exp_bound3,
  },
  have A2:((-x) + 1) ≤ real.exp(-x) := le_of_sub_nonneg A1,
  rw add_comm at A2,
  rw sub_eq_add_neg,
  exact A2,
end

--TODO: verify this is exactly what we need first.
lemma nnreal_exp_bound (x:nnreal):(1-x) ≤ nnreal.exp(-x) :=
begin
  apply nnreal.coe_le_coe.mp,
  rw nnreal_exp_eq,
  have A1:((x:real) ≤ 1) ∨ (1 ≤ (x:real)),
  {
    apply linear_order.le_total,
  },
  cases A1,
  {
    rw nnreal.coe_sub,
    apply exp_bound2 (↑x),
    apply A1,
  },
  {
    rw nnreal.sub_eq_zero,
    {
      apply le_of_lt,
      apply real.exp_pos,
    },
    {
      apply A1,
    }
  }
end

--This exact theorem is used for PAC bounds.
lemma nnreal_exp_bound2 (x:nnreal) (k:ℕ):(1 - x)^k ≤ nnreal.exp(-x * k) :=
begin
  have A1:(1-x) ≤ nnreal.exp(-x),
  {
    apply nnreal_exp_bound,
  },
  have A2:(1 - x)^k ≤ (nnreal.exp(-x))^k,
  {
    apply nnreal_pow_mono,
    exact A1,
  },
  have A3:nnreal.exp(-x)^k=nnreal.exp(-x * k),
  {
    symmetry,
    rw mul_comm,
    apply nnreal_exp_pow,
  },
  rw ← A3,
  apply A2,
end


open classical
variables {A B C : Prop}
-- Prove ¬ (A ∧ B) → ¬ A ∨ ¬ B by replacing the sorry's below
-- by proofs.

lemma step1 (h1 : ¬ (A ∧ B)) (h2 : A) : ¬ A ∨ ¬ B :=
have ¬ B, from (assume g1 : B, show false, from h1 (and.intro h2 g1)),
show ¬ A ∨ ¬ B, from or.inr this

lemma step2 (h1 : ¬ (A ∧ B)) (h2 : ¬ (¬ A ∨ ¬ B)) : false :=
have ¬ A, from
  assume : A,
  have ¬ A ∨ ¬ B, from step1 h1 ‹A›,
  show false, from h2 this,
show false, from h2 (or.inl this)

theorem step3 (h : ¬ (A ∧ B)) : ¬ A ∨ ¬ B :=
by_contradiction
  (assume h' : ¬ (¬ A ∨ ¬ B),
  show false, from step2 h h')

example (h : ¬ B → ¬ A) : A → B :=
assume ha : A,
by_contradiction
  (assume hnb : ¬ B,
    have hna : ¬ A, from h hnb,
    show false, from hna ha)

example (h : A → B) : ¬ A ∨ B :=
have t : A ∨ ¬ A, from em A,
or.elim t
  (assume ha : A,
    have hb : B, from h ha,
    show ¬ A ∨ B, from or.inr hb)
  (assume hna : ¬ A,  show ¬ A ∨ B, from or.inl hna)


import analysis.special_functions.trigonometric

namespace real

example : differentiable ℝ (λ (x : ℝ), exp x) :=
by simp

example : differentiable ℝ (λ (x : ℝ), exp ((sin x)^2) - exp (exp (cos (x - 3)))) :=
by simp

example (x : ℝ) : deriv (λ (x : ℝ), (cos x)^2 + 1 + (sin x)^2) x = 0 :=
by { simp, ring }

example (x : ℝ) : deriv (λ (x : ℝ), (1+x)^3 - x^3 - 3 * x^2 - 3 * x - 4) x = 0 :=
by { simp, ring }

example (x : ℝ) : deriv (λ x, cos (sin x) * exp x) x = (cos(sin(x))-sin(sin(x))*cos(x))*exp(x) :=
by { simp, ring }

example (x : ℝ) : differentiable_at ℝ (λ x, (cos x, x)) x := by simp

example (x : ℝ) (h : 1 + sin x ≠ 0) : deriv (λ x, exp (cos x) / (1 + sin x)) x =
  (-(exp (cos x) * sin x * (1 + sin x)) - exp (cos x) * cos x) / (1 + sin x) ^ 2 :=
by simp [h]

example (x : ℝ) : differentiable_at ℝ (λ x, (sin x) / (exp x)) x :=
by simp [exp_ne_zero]

example : differentiable ℝ (λ x, (sin x) / (exp x)) :=
by simp [exp_ne_zero]

example (x : ℝ) (h : x ≠ 0) : deriv (λ x, x * (log x - 1)) x = log x :=
by simp [h]

end real

namespace complex

example : differentiable ℂ  (λ (x : ℂ), exp x) :=
by simp

example : differentiable ℂ (λ (x : ℂ), exp ((sin x)^2) - exp (exp (cos (x - 3)))) :=
by simp

example (x : ℂ) : deriv (λ (x : ℂ), (cos x)^2 + I + (sin x)^2) x = 0 :=
by { simp, ring }

example (x : ℂ) : deriv (λ x, cos (sin x) * exp x) x = (cos(sin(x))-sin(sin(x))*cos(x))*exp(x) :=
by { simp, ring }

example (x : ℂ) : differentiable_at ℂ (λ x, (cos x, x)) x := by simp

example (x : ℂ) (h : 1 + sin x ≠ 0) : deriv (λ x, exp (cos x) / (1 + sin x)) x =
  (-(exp (cos x) * sin x * (1 + sin x)) - exp (cos x) * cos x) / (1 + sin x) ^ 2 :=
by simp [h]

example (x : ℂ) : differentiable_at ℂ (λ x, (sin x) / (exp x)) x :=
by simp [exp_ne_zero]

example : differentiable ℂ (λ x, (sin x) / (exp x)) :=
by simp [exp_ne_zero]

end complex

namespace polynomial

variables {R : Type*} [comm_semiring R]

example : (2 : polynomial R).derivative = 0 :=
by conv_lhs { simp }

example : (3 + X : polynomial R).derivative = 1 :=
by conv_lhs { simp }

example : (2 * X ^ 2 : polynomial R).derivative = 4 * X :=
by conv_lhs { simp, ring_nf, }

example : (X ^ 2 : polynomial R).derivative = 2 * X :=
by conv_lhs { simp }

example : ((C 2 * X ^ 3).derivative : polynomial R) = 6 * X ^ 2 :=
by conv_lhs { simp, ring_nf, }

end polynomial


/-
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
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.padics.padic_integers
import Mathlib.topology.metric_space.cau_seq_filter
import Mathlib.analysis.specific_limits
import Mathlib.data.polynomial.identities
import Mathlib.topology.algebra.polynomial
import Mathlib.PostPort

namespace Mathlib

/-!
# Hensel's lemma on ℤ_p

This file proves Hensel's lemma on ℤ_p, roughly following Keith Conrad's writeup:
<http://www.math.uconn.edu/~kconrad/blurbs/gradnumthy/hensel.pdf>

Hensel's lemma gives a simple condition for the existence of a root of a polynomial.

The proof and motivation are described in the paper
[R. Y. Lewis, *A formal proof of Hensel's lemma over the p-adic integers*][lewis2019].

## References

* <http://www.math.uconn.edu/~kconrad/blurbs/gradnumthy/hensel.pdf>
* [R. Y. Lewis, *A formal proof of Hensel's lemma over the p-adic integers*][lewis2019]
* <https://en.wikipedia.org/wiki/Hensel%27s_lemma>

## Tags

p-adic, p adic, padic, p-adic integer
-/

-- We begin with some general lemmas that are used below in the computation.

theorem padic_polynomial_dist {p : ℕ} [fact (nat.prime p)] (F : polynomial (padic_int p)) (x : padic_int p) (y : padic_int p) : norm (polynomial.eval x F - polynomial.eval y F) ≤ norm (x - y) := sorry

theorem limit_zero_of_norm_tendsto_zero {p : ℕ} [fact (nat.prime p)] {ncs : cau_seq (padic_int p) norm} {F : polynomial (padic_int p)} (hnorm : filter.tendsto (fun (i : ℕ) => norm (polynomial.eval (coe_fn ncs i) F)) filter.at_top (nhds 0)) : polynomial.eval (cau_seq.lim ncs) F = 0 :=
  tendsto_nhds_unique (comp_tendsto_lim ncs) (tendsto_zero_of_norm_tendsto_zero hnorm)

/-- `T` is an auxiliary value that is used to control the behavior of the polynomial `F`. -/
/-- We will construct a sequence of elements of ℤ_p satisfying successive values of `ih`. -/
/-- Given `z : ℤ_[p]` satisfying `ih n z`, construct `z' : ℤ_[p]` satisfying `ih (n+1) z'`. We need
the hypothesis `ih n z`, since otherwise `z'` is not necessarily an integer. -/
-- why doesn't "noncomputable theory" stick here?

theorem hensels_lemma {p : ℕ} [fact (nat.prime p)] {F : polynomial (padic_int p)} {a : padic_int p} (hnorm : norm (polynomial.eval a F) < norm (polynomial.eval a (coe_fn polynomial.derivative F)) ^ bit0 1) : ∃ (z : padic_int p),
  polynomial.eval z F = 0 ∧
    norm (z - a) < norm (polynomial.eval a (coe_fn polynomial.derivative F)) ∧
      norm (polynomial.eval z (coe_fn polynomial.derivative F)) =
          norm (polynomial.eval a (coe_fn polynomial.derivative F)) ∧
        ∀ (z' : padic_int p),
          polynomial.eval z' F = 0 → norm (z' - a) < norm (polynomial.eval a (coe_fn polynomial.derivative F)) → z' = z := sorry