import for_mathlib.quotient_group

import valuation.localization

/-!
# The canonical valuation

The purpose of this file is to define a “canonical” valuation equivalent to
a given valuation. The whole raison d'etre for this is that there are set-theoretic
issues with the equivalence “relation” on valuations, because the target group Γ
can be arbitrary.

## Idea

The main idea is this. If v : R → Γ₀ is an arbitrary valuation,
then v extends to a valuation on K = Frac(R/supp(v)) and hence to a monoid
homomorphism K^* → units Γ₀, whose kernel is A^*, the units in the valuation ring
(or equivalently the things in K^* of norm at most 1). This embeds K^*/A^*
into Γ₀ and hence gives K^*/A^* the structure of a linearly ordered commutative group.
There is an induced map R → (K^*/A^*), and we call this the
_canonical valuation_ associated to v; this valuation is equivalent to v.
A technical advantage that this valuation has from the point of view
of Lean's type theory is that if R is in universe u₁ and Γ₀ in universe u₂,
then v : valuation R Γ₀ will be in universe `max u₁ u₂` but the canonical
valuation will just be in universe u₁. In particular, if v and v' are equivalent
then their associated canonical valuations are isomorphic and furthermore in the
same universe.

## Implementation details

All of the below names are in the `valuation` namespace.

The canonical valuation takes values in `value_monoid v`. Technically
this is not defined exactly in the way explained above.
So `value_monoid v` is not defined as `with_zero (K^* / A^*)`.
Instead, we take the equivalence relation on K^* given by A^*,
and extend it in the obvious way to K. The resulting quotient is naturally a monoid,
with an order and a zero element. Indeed, it is a linear_ordered_comm_group_with_zero.
Its unit group is canonically isomorphic to K^*/A^*. (Note that it is also
isomorphic to the subgroup of Γ₀ which Wedhorn calls the value group in [Wedhorn; 1.22]).

`value_monoid.to_Γ₀` is the monoid homomorphism to Γ₀.
`canonical_valuation v` is the canonical valuation.
`canonical_valuation.to_Γ₀ v` is the lemma that says that we can
recover v from `canonical_valuation v` using the monoid homomorphism
from (value_monoid v) to Γ₀.

-- TODO -- rewrite this when I've remembered what we proved.
We then prove some of Proposition-and-Definition 1.27 of Wedhorn,
where we note that we used (iii) for the definition, and
we're now using a different definition to Wedhorn for the value group
(because it's isomorphic so no mathematician will care, and
it's easier for us because it's in a smaller universe).

-/

local attribute [instance] classical.prop_decidable
local attribute [instance, priority 0] classical.DLO
noncomputable theory

universes u u₀ u₁ u₂ u₃

open linear_ordered_structure

variables {R : Type u₀} [comm_ring R]

/- TODO(jmc): Refactor this file to use valued_field,
instead of working explicitly with v.valuation_field. -/

namespace valuation

variables {Γ₀ : Type u} [linear_ordered_comm_group_with_zero Γ₀]
variables (v : valuation R Γ₀)

/-- The elements of `units (valuation_field v)` with norm 1. -/
definition valuation_field_norm_one :=
is_group_hom.ker (units.map (v.on_valuation_field : v.valuation_field →* Γ₀))

/-- `valuation_field_norm_one v is a normal subgroup of `units (valuation_field v)`. -/
instance (v : valuation R Γ₀) : normal_subgroup (valuation_field_norm_one v) :=
by unfold valuation_field_norm_one; apply_instance

namespace value_monoid

/-- The relation on a valuation field induced by the valuation:
a ≈ b if and only if there is a unit c of valuation 1 such that a * c = b.-/
def quotient_rel (a b : v.valuation_field) : Prop :=
∃ c : units v.valuation_field, c ∈ v.valuation_field_norm_one ∧ a * c = b

namespace quotient_rel

lemma refl (a : v.valuation_field) : quotient_rel v a a :=
⟨1, is_submonoid.one_mem _, mul_one a⟩

lemma symm (a b : v.valuation_field) : quotient_rel v a b → quotient_rel v b a :=
by { rintro ⟨c, hc, rfl⟩, exact ⟨c⁻¹, is_subgroup.inv_mem hc, c.mul_inv_cancel_right a⟩ }

lemma trans (a b c : v.valuation_field) :
  quotient_rel v a b → quotient_rel v b c → quotient_rel v a c :=
begin
  rintro ⟨c, hc, rfl⟩ ⟨c', hc', rfl⟩,
  exact ⟨c * c', is_submonoid.mul_mem hc hc', (mul_assoc _ _ _).symm⟩
end

end quotient_rel

/-- The setoid on a valuation field induced by the valuation:
a ≈ b if and only if there is a unit c of valuation 1 such that a * c = b.-/
def setoid : setoid (v.valuation_field) :=
{ r := quotient_rel v,
  iseqv := ⟨quotient_rel.refl v, quotient_rel.symm v, quotient_rel.trans v⟩ }

end value_monoid

/-- The value group of the canonical valuation.-/
def value_monoid (v : valuation R Γ₀) : Type u₀ :=
@quotient v.valuation_field (value_monoid.setoid v)

namespace value_monoid
open function

/-- The natural map from the canonical value monoid to Γ₀, for a valuation with values in Γ₀. -/
def to_Γ₀ : v.value_monoid → Γ₀ :=
λ x, quotient.lift_on' x v.on_valuation_field $
begin
  rintros a b ⟨c, hc, rfl⟩,
  replace hc : v.on_valuation_field c = 1 := units.ext_iff.mp (is_subgroup.mem_trivial.mp hc),
  rw [v.on_valuation_field.map_mul, hc, mul_one],
end

lemma to_Γ₀_inj : injective (to_Γ₀ v) :=
begin
  rintros ⟨a⟩ ⟨b⟩ h,
  change v.on_valuation_field a = v.on_valuation_field b at h,
  by_cases ha : a = 0,
  { subst a, rw [valuation.map_zero, eq_comm, valuation.zero_iff] at h, rw h },
  { have hb : b ≠ 0,
    { rintro rfl, rw [valuation.map_zero, valuation.zero_iff] at h, exact ha h },
    refine quotient.sound' ⟨(units.mk0 a ha)⁻¹ * (units.mk0 b hb),
      is_subgroup.mem_trivial.mpr _, (units.mk0 a ha).mul_inv_cancel_left _⟩,
    rw ← v.on_valuation_field.ne_zero_iff at hb,
    simp [units.ext_iff, h, hb] }
end

/--The linear order on the canonical value monoid associated with a valuation.-/
instance : linear_order (v.value_monoid) :=
linear_order.lift (to_Γ₀ v) (to_Γ₀_inj v) infer_instance

lemma to_Γ₀_strict_mono : strict_mono (to_Γ₀ v) := λ a b, id

@[simp] lemma triangle (a : v.valuation_field) :
  to_Γ₀ v (quotient.mk' a) = v.on_valuation_field a := rfl

/--The zero element of the canonical value monoid associated with a valuation.-/
instance : has_zero (v.value_monoid) := ⟨quotient.mk' 0⟩

/--The unit element of the canonical value monoid associated with a valuation.-/
instance : has_one  (v.value_monoid) := ⟨quotient.mk' 1⟩

/--The inversion function of the canonical value monoid associated with a valuation.-/
instance : has_inv  (v.value_monoid) :=
⟨λ x, quotient.lift_on' x (λ a, quotient.mk' a⁻¹)
begin
  rintros a b ⟨c, hc, rfl⟩,
  replace hc : v.on_valuation_field c = 1 := units.ext_iff.mp (is_subgroup.mem_trivial.mp hc),
  apply to_Γ₀_inj,
  simp [hc],
end⟩

/--The multiplication on the canonical value monoid associated with a valuation.-/
instance : has_mul  (v.value_monoid) :=
⟨λ x y, quotient.lift_on₂' x y (λ a b, quotient.mk' (a*b))
begin
  rintros a₁ b₁ a₂ b₂ ⟨c₁, hc₁, rfl⟩ ⟨c₂, hc₂, rfl⟩,
  replace hc₁ : v.on_valuation_field c₁ = 1 := units.ext_iff.mp (is_subgroup.mem_trivial.mp hc₁),
  replace hc₂ : v.on_valuation_field c₂ = 1 := units.ext_iff.mp (is_subgroup.mem_trivial.mp hc₂),
  apply to_Γ₀_inj,
  simp [hc₁, hc₂],
end⟩

@[simp] lemma to_Γ₀_zero : to_Γ₀ v 0 = 0 := v.on_valuation_field.map_zero

@[simp] lemma to_Γ₀_one  : to_Γ₀ v 1 = 1 := v.on_valuation_field.map_one

@[simp] lemma to_Γ₀_inv (a) : to_Γ₀ v a⁻¹ = (to_Γ₀ v a)⁻¹ :=
quotient.induction_on' a $ λ x, v.on_valuation_field.map_inv

@[simp] lemma to_Γ₀_mul (a b) : to_Γ₀ v (a*b) = (to_Γ₀ v a) * (to_Γ₀ v b) :=
quotient.induction_on₂' a b $ λ x y, v.on_valuation_field.map_mul x y

/--The canonical value monoid associated with a valuation is a group with zero.-/
instance : group_with_zero (v.value_monoid) :=
begin
  refine_struct {
  .. value_monoid.has_zero v,
  .. value_monoid.has_one v,
  .. value_monoid.has_inv v,
  .. value_monoid.has_mul v, },
  show decidable_eq (value_monoid v),
  { apply_instance },
  show (0 : v.value_monoid) ≠ 1,
  { assume this, replace := congr_arg (to_Γ₀ v) this, simpa using this, },
  all_goals { intros, apply to_Γ₀_inj, simp },
  { exact mul_assoc _ _ _ },
  { apply mul_inv_cancel', intro this, apply_assumption, apply to_Γ₀_inj, simpa }
end

/--The canonical value monoid associated with a valuation
is a linearly ordered commutative group with zero.-/
instance : linear_ordered_comm_group_with_zero (v.value_monoid) :=
{ mul_comm := λ a b, to_Γ₀_inj v $ by simpa using mul_comm _ _,
  mul_le_mul_left := λ a b h c,
  begin
    rw ← (to_Γ₀_strict_mono v).le_iff_le at h ⊢,
    simpa using linear_ordered_structure.mul_le_mul_left h _
  end,
  zero_le' := λ a, by { rw ← (to_Γ₀_strict_mono v).le_iff_le, simp },
  .. value_monoid.group_with_zero v,
  .. value_monoid.linear_order v }

/-- The natural quotient map from `units (valuation_field v)` to `value_monoid v`. -/
def mk (v : valuation R Γ₀) :
  valuation_field v →* value_monoid v :=
{ to_fun := quotient.mk',
  map_one' := rfl,
  map_mul' := λ a b, rfl, }

end value_monoid

/-- The canonical valuation on Frac(R/supp(v)), taking values in `value_monoid v`. -/
def valuation_field.canonical_valuation :
valuation (valuation_field v) (value_monoid v) :=
{ map_zero' := rfl,
  map_add' := λ a b,
  begin
    rw ← (value_monoid.to_Γ₀_strict_mono v).le_iff_le,
    rw (value_monoid.to_Γ₀_strict_mono v).monotone.map_max,
    exact v.on_valuation_field.map_add a b
  end,
  .. value_monoid.mk v }
-- ⟨valuation_field.canonical_valuation_v v, valuation_field.canonical_valuation_v.is_valuation v⟩

/-- The canonical valuation on R/supp(v), taking values in `value_monoid v`. -/
definition quotient.canonical_valuation :
  valuation (ideal.quotient (supp v)) (value_monoid v) :=
@comap _ _ _ _ _ _ (localization.of)
  (by apply_instance) (valuation_field.canonical_valuation v)

/-- The canonical valuation on R, taking values in `value_monoid v`. -/
definition canonical_valuation :
  valuation R (value_monoid v) :=
(quotient.canonical_valuation v).comap (ideal.quotient.mk (supp v))

/-- The relation between `v.canonical_valuation r` and `v r`. -/
lemma canonical_valuation_eq (r : R) :
  v.canonical_valuation r = value_monoid.mk v (v.valuation_field_mk r) := rfl

namespace canonical_valuation

-- This looks handy to know but we never actually use it.
/-- Every element of `value_monoid v` is a ratio of things in the image of `canonical_valuation v`.-/
lemma value_monoid.is_ratio (v : valuation R Γ₀) (g : value_monoid v) :
∃ r s : R, s ∉ v.supp ∧ v.canonical_valuation s * g = v.canonical_valuation r :=
begin
  apply quotient.induction_on' g, clear g,
  rintros ⟨⟨r⟩, ⟨s⟩, h⟩,
  change ideal.quotient.mk _ s ∈ _ at h,
  use [r, s],
  split,
  { show s ∉ supp v,
    assume mem_supp,
    erw [localization.fraction_ring.mem_non_zero_divisors_iff_ne_zero,
      (ideal.quotient.eq_zero_iff_mem).2 mem_supp] at h,
    contradiction },
  show value_monoid.mk v _ * value_monoid.mk v _ = value_monoid.mk v _,
  rw ← monoid_hom.map_mul,
  refine congr_arg _ _,
  let rq := ideal.quotient.mk (supp v) r,
  let sq := ideal.quotient.mk (supp v) s,
  show (localization.of sq : valuation_field v) * (localization.mk rq ⟨sq, h⟩) = localization.of rq,
  erw [localization.mk_eq, mul_comm, mul_assoc, units.inv_val _, mul_one],
  refl
end

/-- v can be reconstructed from `canonical_valuation v` by pushing forward along
the map `value_monoid v → Γ₀`. -/
lemma to_Γ₀ :
  (canonical_valuation v).map (monoid_hom.mk (value_monoid.to_Γ₀ v) (value_monoid.to_Γ₀_one v) (value_monoid.to_Γ₀_mul v))
  (value_monoid.to_Γ₀_zero v) (value_monoid.to_Γ₀_strict_mono v).monotone = v :=
ext $ λ r, show v r * (v 1)⁻¹ = v r, by simp

end canonical_valuation -- end of namespace

end valuation -- end of namespace

namespace valuation

variables {Γ₀ : Type u}   [linear_ordered_comm_group_with_zero Γ₀]
variables {Γ'₀ : Type u₁} [linear_ordered_comm_group_with_zero Γ'₀]
variables {Γ''₀ : Type u₂} [linear_ordered_comm_group_with_zero Γ''₀]
variables {Γ₀₃ : Type u₃} [linear_ordered_comm_group_with_zero Γ₀₃]

/-- A valuation is equivalent to its canonical valuation -/
lemma canonical_valuation_is_equiv (v : valuation R Γ₀) :
  v.canonical_valuation.is_equiv v :=
begin
  have h := is_equiv.of_eq (canonical_valuation.to_Γ₀ v),
  symmetry,
  refine h.symm.trans _,
  exact is_equiv_of_map_strict_mono _ _ _,
end

namespace is_equiv

-- Various lemmas about valuations being equivalent.

variables {v : valuation R Γ₀} {v₁ : valuation R Γ'₀} {v₂ : valuation R Γ''₀} {v₃ : valuation R Γ₀₃}

/-- If J ⊆ supp(v) then pulling back the induced valuation on R / J back to R gives a
valuation equivalent to v. -/
lemma on_quot_comap_self {J : ideal R} (hJ : J ≤ supp v) :
  is_equiv ((v.on_quot hJ).comap (ideal.quotient.mk J)) v :=
of_eq (on_quot_comap_eq _ _)

/-- Two valuations on R/J are equivalent iff their pullbacks to R are equivalent. -/
lemma comap_on_quot (J : ideal R) (v₁ : valuation J.quotient Γ'₀) (v₂ : valuation J.quotient Γ''₀) :
  (v₁.comap (ideal.quotient.mk J)).is_equiv (v₂.comap (ideal.quotient.mk J)) ↔ v₁.is_equiv v₂ :=
{ mp  := begin rintros h ⟨x⟩ ⟨y⟩, exact h x y end,
  mpr := λ h, comap _ h }

open localization

/-- If supp(v)=0 then v is equivalent to the pullback of the extension of v to Frac(R). -/
lemma on_frac_comap_self {R : Type u₀} [integral_domain R] (v : valuation R Γ₀) (hv : supp v = 0) :
  is_equiv ((v.on_frac hv).comap of) v :=
of_eq (on_frac_comap_eq v hv)

/-- If R is an ID then two valuations on R are equivalent iff their extensions to Frac(R) are
equivalent. -/
lemma comap_on_frac {R : Type u₀} [integral_domain R]
(v₁ : valuation (fraction_ring R) Γ'₀) (v₂ : valuation (fraction_ring R) Γ''₀) :
  (v₁.comap of).is_equiv (v₂.comap of) ↔ is_equiv v₁ v₂ :=
{ mp  := begin
    rintros h ⟨x⟩ ⟨y⟩,
    erw [← comap_on_frac_eq v₁, ← comap_on_frac_eq v₂],
    show _ * _ ≤ _ * _ ↔ _ * _ ≤ _ * _,
    erw div_le_div', erw div_le_div',
    { repeat {erw ← valuation.map_mul},
      exact h _ _ },
    all_goals { intro H,
      erw [← mem_supp_iff, comap_supp, (supp _).eq_bot_of_prime] at H,
      simp at H,
      replace H := fraction_ring.eq_zero_of _ H,
      refine fraction_ring.mem_non_zero_divisors_iff_ne_zero.mp _ H,
      apply subtype.val_prop _,
      apply_instance },
  end,
  mpr := λ h, h.comap _ }

/-- [Wed 1.27] (iii) -> first part of (ii). -/
lemma supp_eq (h : v₁.is_equiv v₂) : supp v₁ = supp v₂ :=
ideal.ext $ λ r,
calc r ∈ supp v₁ ↔ v₁ r = 0    : iff.rfl
             ... ↔ v₁ r ≤ v₁ 0 : by simp
             ... ↔ v₂ r ≤ v₂ 0 : h r 0
             ... ↔ v₂ r = 0    : by simp
             ... ↔ r ∈ supp v₂ : iff.rfl

/-- If v₁ and v₂ are equivalent then v₁(r)=1 → v₂(r)=1. -/
lemma v_eq_one_of_v_eq_one (h : v₁.is_equiv v₂) {r : R} : v₁ r = 1 → v₂ r = 1 :=
begin
  rw [←v₁.map_one, ←v₂.map_one],
  intro hr,
  exact le_antisymm ((h r 1).1 (le_of_eq hr)) ((h 1 r).1 (le_of_eq hr.symm)),
end

/-- If v₁ and v₂ are equivalent then v₁(r)=1 ↔ v₂(r)=1. -/
lemma v_eq_one (h : v₁.is_equiv v₂) (r : R) : v₁ r = 1 ↔ v₂ r = 1 :=
⟨v_eq_one_of_v_eq_one h,v_eq_one_of_v_eq_one h.symm⟩

/-- If v₁ and v₂ are equivalent then their canonical valuations are too. -/
lemma canonical_equiv_of_is_equiv (h : v₁.is_equiv v₂) :
  (canonical_valuation v₁).is_equiv (canonical_valuation v₂) :=
begin
  refine is_equiv.trans v₁.canonical_valuation_is_equiv _,
  refine is_equiv.trans h _,
  apply is_equiv.symm,
  exact v₂.canonical_valuation_is_equiv
end

end is_equiv -- end of namespace

/-- The supports of v and v.canonical_valuation are equal. -/
lemma canonical_valuation_supp (v : valuation R Γ₀) :
  supp (v.canonical_valuation) = supp v := (canonical_valuation_is_equiv v).supp_eq

/-- The canonical valuation of a valuation on a field is surjective. -/
lemma canonical_valuation.surjective {K : Type*} [discrete_field K] (v : valuation K Γ₀) :
  function.surjective (v.canonical_valuation) :=
begin
  rintro ⟨⟨⟨r⟩,⟨⟨s⟩,h⟩⟩⟩,
  refine ⟨s⁻¹ * r, _⟩,
  apply quotient.sound,
  refine ⟨1, is_submonoid.one_mem _, _⟩,
  rw [units.coe_one, mul_one],
  apply quotient.sound,
  refine ⟨_, h, _⟩,
  dsimp only [-sub_eq_add_neg],
  convert zero_mul _, rw [sub_eq_zero],
  dsimp, rw ← mul_assoc,
  congr, symmetry,
  show ideal.quotient.mk (supp v) _ * ideal.quotient.mk (supp v) _ = 1,
  rw ← is_ring_hom.map_mul (ideal.quotient.mk (supp v)),
  convert is_ring_hom.map_one (ideal.quotient.mk (supp v)),
  apply mul_inv_cancel,
  contrapose! h, subst s,
  refine (not_iff_not_of_iff localization.fraction_ring.mem_non_zero_divisors_iff_ne_zero).mpr _,
  exact not_not.mpr rfl
end

section Wedhorn1_27_equivalences

variables {v : valuation R Γ₀} {v₁ : valuation R Γ'₀} {v₂ : valuation R Γ''₀} {v₃ : valuation R Γ₀₃}

open is_group_hom quotient_group function

-- We now start on the equivalences of Wedhorn 1.27. The first one is easy.

/-- Wedhorn 1.27 (i) → (iii) : An ordered isomorphism of value groups which commutes with
canonical valuations implies that valuations are equivalent. -/
lemma of_inj_value_monoid (f : v₁.value_monoid →* v₂.value_monoid) (h₀ : f 0 = 0) (hf : strict_mono f)
(H : v₂.canonical_valuation = v₁.canonical_valuation.map f h₀ (hf.monotone)) :
  v₁.is_equiv v₂ :=
begin
  refine (v₁.canonical_valuation_is_equiv.symm).trans _,
  refine (is_equiv.trans _ (v₂.canonical_valuation_is_equiv)),
  rw H,
  symmetry,
  exact is_equiv_of_map_strict_mono _ _ _
end

-- These lemmas look slightly ridiculous to a mathematician but they are avoiding equality of
-- types and instead defining and reasoning about maps which mathematicians would call
-- "the identiy map".

/-- Natural map R/supp(v₁) → R/supp(v₂) induced by equality supp(v₁)=supp(v₂). -/
def quot_of_quot_of_eq_supp (h : supp v₁ = supp v₂) : valuation_ID v₁ → valuation_ID v₂ :=
ideal.quotient.lift _ (ideal.quotient.mk _)
(λ r hr, ideal.quotient.eq_zero_iff_mem.2 $ h ▸ hr)

lemma quot_of_quot_of_eq_supp.id (r : valuation_ID v) : quot_of_quot_of_eq_supp (rfl) r = r :=
by rcases r;refl

lemma quot_of_quot_of_eq_supp.comp (h12 : supp v₁ = supp v₂) (h23 : supp v₂ = supp v₃)
  (r : valuation_ID v₁) : quot_of_quot_of_eq_supp h23 (quot_of_quot_of_eq_supp h12 r) =
  quot_of_quot_of_eq_supp (h23 ▸ h12 : supp v₁ = supp v₃) r :=
by rcases r;refl

/-- If supp(v₁)=supp(v₂) then R/supp(v₁) is isomorphic to R/supp(v₂). -/
def valuation_ID.equiv (h : supp v₁ = supp v₂) : valuation_ID v₁ ≃ valuation_ID v₂ :=
{ to_fun := quot_of_quot_of_eq_supp h,
  inv_fun := quot_of_quot_of_eq_supp (h.symm),
  left_inv := λ r, by rw quot_of_quot_of_eq_supp.comp h h.symm; exact quot_of_quot_of_eq_supp.id r,
  right_inv := λ r, by rw quot_of_quot_of_eq_supp.comp h.symm h; exact quot_of_quot_of_eq_supp.id r
}

@[simp] lemma quot_of_quot_of_eq_supp_quotient_mk (h : supp v₁ = supp v₂) :
  quot_of_quot_of_eq_supp h ∘ ideal.quotient.mk _ = ideal.quotient.mk _ :=
funext $ λ x, ideal.quotient.lift_mk

lemma quot_of_quot_of_eq_supp_quotient_mk' (h : supp v₁ = supp v₂) (r : R) :
  quot_of_quot_of_eq_supp h (ideal.quotient.mk _ r) = ideal.quotient.mk _ r :=
by rw ←quot_of_quot_of_eq_supp_quotient_mk h

/-- If supp(v₁)=supp(v₂) then the identity map R/supp(v₁) → R/supp(v₂) is a ring homomorphism. -/
instance quot_of_quot_of_eq_supp.is_ring_hom (h : supp v₁ = supp v₂) :
  is_ring_hom (quot_of_quot_of_eq_supp h) :=
by delta quot_of_quot_of_eq_supp; apply_instance

/-- If supp(v₁)=supp(v₂) then R/supp(v₁) and R/supp(v₂) are isomorphic rings. -/
def quot_equiv_quot_of_eq_supp (h : supp v₁ = supp v₂) : valuation_ID v₁ ≃+* valuation_ID v₂ :=
{ .. ring_hom.of (quot_of_quot_of_eq_supp h),
  .. valuation_ID.equiv h }

/-- If supp(v₁)=supp(v₂) then the triangle R → R/supp(v₁) → R/supp(v₂) commutes. -/
lemma quot_equiv_quot_mk_eq_mk (h : supp v₁ = supp v₂) (r : R) :
  (quot_equiv_quot_of_eq_supp h).to_equiv (ideal.quotient.mk _ r) = ideal.quotient.mk _ r :=
quot_of_quot_of_eq_supp_quotient_mk' h r

lemma quot_of_quot_of_eq_supp_inj (h : supp v₁ = supp v₂) : injective (quot_of_quot_of_eq_supp h) :=
injective_of_left_inverse (quot_equiv_quot_of_eq_supp h).left_inv

lemma valuation_ID_le_of_le_of_equiv (h : v₁.is_equiv v₂) (a b : valuation_ID v₁) :
  (a ≤ b) ↔
  quot_of_quot_of_eq_supp (is_equiv.supp_eq h) a ≤ quot_of_quot_of_eq_supp (is_equiv.supp_eq h) b :=
by rcases a; rcases b; exact (h a b)

/-- If v₁ and v₂ are equivalent, then the associated preorders on
R/supp(v₁)=R/supp(v₂) are equivalent. -/
def valuation_ID.preorder_equiv (h : v₁.is_equiv v₂) :
  preorder_equiv (valuation_ID v₁) (valuation_ID v₂) :=
{ le_map := valuation_ID_le_of_le_of_equiv h,
  ..valuation_ID.equiv h.supp_eq
}

section valuation_field

open localization

/-- The natural map Frac(R/supp(v₁)) → Frac(R/supp(v₂)) if supp(v₁) = supp(v₂). -/
def valfield_of_valfield_of_eq_supp (h : supp v₁ = supp v₂) :
  valuation_field v₁ → valuation_field v₂ :=
fraction_ring.map (quot_of_quot_of_eq_supp h) (quot_of_quot_of_eq_supp_inj h)

/-- The triangle R → Frac(R/supp(v₁)) → Frac(R/supp(v₂)) commutes if supp(v₁)=supp(v₂). -/
lemma valfield_of_valfield_of_eq_supp_quotient_mk (h : supp v₁ = supp v₂) (r : R) :
  valfield_of_valfield_of_eq_supp h (of $ ideal.quotient.mk _ r) = of (ideal.quotient.mk _ r) :=
begin
  unfold valfield_of_valfield_of_eq_supp,
  rw fraction_ring.map_of,
  rw quot_of_quot_of_eq_supp_quotient_mk',
end

/-- If supp(v₁)=supp(v₂) then the natural map Frac(R/supp(v₁)) → Frac(R/supp(v₂)) is a
homomorphism of fields. -/
instance is_ring_hom_of_supp (h : supp v₁ = supp v₂) : is_ring_hom (valfield_of_valfield_of_eq_supp h) :=
by delta valfield_of_valfield_of_eq_supp; apply_instance

-- This should be possible using type class inference but there are max class
-- instance issues.
/-- If supp(v₁)=supp(v₂) then the natural map Frac(R/supp(v₁)) → Frac(R/supp(v₂)) is a
homomorphism of monoids. -/
instance (h : supp v₁ = supp v₂) : is_monoid_hom (valfield_of_valfield_of_eq_supp h) :=
is_semiring_hom.is_monoid_hom (valfield_of_valfield_of_eq_supp h)

/-- If supp(v₁)=supp(v₂) then the natural map Frac(R/supp(v₁)) → Frac(R/supp(v₂)) is an
isomorphism of rings. -/
def valfield_equiv_valfield_of_eq_supp (h : supp v₁ = supp v₂) :
  valuation_field v₁ ≃+* valuation_field v₂ :=
fraction_ring.equiv_of_equiv (quot_equiv_quot_of_eq_supp h)

lemma valfield_equiv_eq_valfield_of_valfield (h : supp v₁ = supp v₂) (q : valuation_field v₁) :
(valfield_equiv_valfield_of_eq_supp h).to_equiv q = valfield_of_valfield_of_eq_supp h q := rfl

lemma valfield_equiv_valfield_mk_eq_mk (h : supp v₁ = supp v₂) (r : R) :
  (valfield_equiv_valfield_of_eq_supp h).to_equiv (of $ ideal.quotient.mk _ r)
  = of (ideal.quotient.mk _ r) :=
valfield_of_valfield_of_eq_supp_quotient_mk h r

/-- If v₁ and v₂ are equivalent then the induced valuations on R/supp(v₁) and R/supp(v₂)
(pulled back to R/supp(v₁) are equivalent. -/
lemma is_equiv.comap_quot_of_quot (h : v₁.is_equiv v₂) :
  (v₁.on_quot (set.subset.refl _)).is_equiv
  ((v₂.on_quot (set.subset.refl _)).comap (quot_of_quot_of_eq_supp h.supp_eq)) :=
begin
  rw [← is_equiv.comap_on_quot, ← comap_comp],
  simp [h],
end

/-- If v₁ and v₂ are equivalent then the induced valuations on Frac(R/supp(v₁)) and
Frac(R/supp(v₂)) [pulled back] are equivalent. -/
lemma is_equiv.on_valuation_field_is_equiv (h : v₁.is_equiv v₂) :
  v₁.on_valuation_field.is_equiv
  (v₂.on_valuation_field.comap (valfield_of_valfield_of_eq_supp h.supp_eq)) :=
begin
  delta valfield_of_valfield_of_eq_supp, delta on_valuation_field,
  erw [← is_equiv.comap_on_frac, ← comap_comp, on_frac_comap_eq],
  simp [comap_comp, h.comap_quot_of_quot],
end

/-- The valuation rings of two equivalent valuations are isomorphic (as types). -/
def val_ring_equiv_of_is_equiv_aux (h : v₁.is_equiv v₂) :
v₁.valuation_ring ≃ v₂.valuation_ring :=
equiv.subtype_congr (valfield_equiv_valfield_of_eq_supp h.supp_eq).to_equiv $
begin
  intro x,
  show _ ≤ _ ↔ _ ≤ _,
  erw [← v₁.on_valuation_field.map_one, h.on_valuation_field_is_equiv],
  convert iff.refl _,
  symmetry,
  exact valuation.map_one _,
end

/-- The valuation rings of two equivalent valuations are isomorphic as rings. -/
def val_ring_equiv_of_is_equiv (h : v₁.is_equiv v₂) : v₁.valuation_ring ≃+* v₂.valuation_ring :=
{ map_add' := λ x y, subtype.val_injective $
    (valfield_equiv_valfield_of_eq_supp h.supp_eq).map_add x y,
  map_mul' := λ x y, subtype.val_injective $
    (valfield_equiv_valfield_of_eq_supp h.supp_eq).map_mul x y,
  .. val_ring_equiv_of_is_equiv_aux h, }

-- we omit the proof that the diagram {r | v₁ r ≤ 1} → v₁.valuation_ring → v₂.valuation_ring
-- commutes.

lemma valfield_le_of_le_of_equiv (h : v₁.is_equiv v₂) (a b : valuation_field v₁) :
  (a ≤ b) ↔ valfield_of_valfield_of_eq_supp (h.supp_eq) a ≤
    valfield_of_valfield_of_eq_supp (h.supp_eq) b :=
calc a ≤ b ↔ v₁.on_valuation_field a ≤ v₁.on_valuation_field b : iff.rfl
       ... ↔ _ : h.on_valuation_field_is_equiv a b

def valfield.preorder_equiv (h : v₁.is_equiv v₂) :
  preorder_equiv (valuation_field v₁) (valuation_field v₂) :=
{ le_map := valfield_le_of_le_of_equiv h,
  ..(valfield_equiv_valfield_of_eq_supp h.supp_eq).to_equiv
}

-- units

/-- The induced map between the unit groups of the valuation fields of
two valuations with the same support.-/
def valfield_units_of_valfield_units_of_eq_supp (h : supp v₁ = supp v₂) :
  units (valuation_field v₁) → units (valuation_field v₂) :=
units.map' $ valfield_of_valfield_of_eq_supp h

/-- The induced map between the unit groups of the valuation fields of
two valuations with the same support is a group homomorphism.-/
instance valfield_units.is_group_hom (h : supp v₁ = supp v₂) :
  is_group_hom (valfield_units_of_valfield_units_of_eq_supp h) :=
by unfold valfield_units_of_valfield_units_of_eq_supp; apply_instance

lemma units_valfield_of_units_valfield_of_eq_supp_mk
  (h : supp v₁ = supp v₂) (r : R) (hr : r ∉ supp v₁) :
  valfield_units_of_valfield_units_of_eq_supp h (units_valfield_mk v₁ r hr)
  = units_valfield_mk v₂ r (h ▸ hr) := units.ext $ valfield_equiv_valfield_mk_eq_mk h r

def valfield_units_equiv_units_of_eq_supp (h : supp v₁ = supp v₂) :
(units (valuation_field v₁)) ≃* (units (valuation_field v₂)) :=
units.map_equiv { .. valfield_equiv_valfield_of_eq_supp h }

end valuation_field -- section

lemma valfield_units_equiv_units_mk_eq_mk (h : supp v₁ = supp v₂) (r : R) (hr : r ∉ supp v₁):
(valfield_units_equiv_units_of_eq_supp h).to_equiv (units_valfield_mk v₁ r hr) =
units_valfield_mk v₂ r (h ▸ hr) := units_valfield_of_units_valfield_of_eq_supp_mk h r hr

def valfield_units_preorder_equiv (h : v₁.is_equiv v₂) :
  preorder_equiv (units (valuation_field v₁)) (units (valuation_field v₂)) :=
{ le_map := λ u v, @le_equiv.le_map _ _ _ _ (valfield.preorder_equiv h) u.val v.val,
  ..valfield_units_equiv_units_of_eq_supp (h.supp_eq) }

lemma val_one_iff_unit_val_one (x : units (valuation_field v)) :
  x ∈ valuation_field_norm_one v ↔ v.on_valuation_field x = 1 :=
calc x ∈ valuation_field_norm_one v ↔
  (units.map (v.on_valuation_field : v.valuation_field →* Γ₀) x = 1) : is_subgroup.mem_trivial
  ... ↔ v.on_valuation_field x = 1 : units.ext_iff

lemma is_equiv.norm_one_eq_norm_one (h : is_equiv v₁ v₂) :
  valfield_units_of_valfield_units_of_eq_supp (is_equiv.supp_eq h) ⁻¹' valuation_field_norm_one v₂
  = valuation_field_norm_one v₁ :=
begin
  ext x,
  rw [set.mem_preimage, val_one_iff_unit_val_one x,
    is_equiv.v_eq_one (is_equiv.on_valuation_field_is_equiv h) x, val_one_iff_unit_val_one],
  refl,
end

/-- Two equivalent valuations have isomorphic canonical value monoids.

This is part of the statement of [Wedhorn, 1.27 (iii) -> (i)]. -/
def is_equiv.value_mul_equiv (h : is_equiv v₁ v₂) :
  (value_monoid v₁) ≃* (value_monoid v₂) :=
{ to_fun := λ x, quotient.lift_on' x ((valuation_field.canonical_valuation v₂).comap (valfield_of_valfield_of_eq_supp h.supp_eq))
    begin
      rintros a b ⟨c, hc, rfl⟩,
      rw valuation.map_mul,
      convert (mul_one _).symm,
      rw val_one_iff_unit_val_one at hc,
      rw h.on_valuation_field_is_equiv.v_eq_one c at hc,
      suffices : v₂.on_valuation_field.is_equiv (valuation_field.canonical_valuation v₂),
      { have tmp := (this.comap (valfield_of_valfield_of_eq_supp _)),
        rwa tmp.v_eq_one at hc, },
      intros a b, exact iff.rfl
    end,
  inv_fun :=  λ x, quotient.lift_on' x ((valuation_field.canonical_valuation v₁).comap (valfield_of_valfield_of_eq_supp h.symm.supp_eq))
    begin
      rintros a b ⟨c, hc, rfl⟩,
      rw valuation.map_mul,
      convert (mul_one _).symm,
      rw val_one_iff_unit_val_one at hc,
      rw h.symm.on_valuation_field_is_equiv.v_eq_one c at hc,
      suffices : v₁.on_valuation_field.is_equiv (valuation_field.canonical_valuation v₁),
      { have tmp := (this.comap (valfield_of_valfield_of_eq_supp _)),
        rwa tmp.v_eq_one at hc, },
      intros a b, exact iff.rfl
    end,
  left_inv := by { rintro ⟨a⟩, apply quotient.sound',
    refine ⟨1, is_submonoid.one_mem _, _⟩,
    rw [units.coe_one, mul_one],
    exact (valfield_equiv_valfield_of_eq_supp h.supp_eq).to_equiv.left_inv a },
  right_inv := by { rintro ⟨a⟩, apply quotient.sound',
    refine ⟨1, is_submonoid.one_mem _, _⟩,
    rw [units.coe_one, mul_one],
    exact (valfield_equiv_valfield_of_eq_supp h.symm.supp_eq).to_equiv.left_inv a },
  map_mul' :=
  begin
    rintro ⟨a⟩ ⟨b⟩, apply quotient.sound',
    refine ⟨1, is_submonoid.one_mem _, _⟩,
    rw [units.coe_one, mul_one],
    exact is_ring_hom.map_mul _,
  end }

-- ordering part of 1.27 (iii) -> (i)
lemma is_equiv.value_monoid_order_equiv_aux (h : is_equiv v₁ v₂) (x y : value_monoid v₁) (h2 : x ≤ y) :
  h.value_mul_equiv x ≤ h.value_mul_equiv y :=
begin
  induction x with x, induction y, swap, refl, swap, refl,
  exact (is_equiv.on_valuation_field_is_equiv h x y).1 h2,
end

/-- The canonical value monoids of two equivalent valuations are order equivalent.-/
def is_equiv.value_monoid_le_equiv (h : is_equiv v₁ v₂) :
  (value_monoid v₁) ≃≤ (value_monoid v₂) :=
{ le_map := λ x y, linear_order_le_iff_of_monotone_injective
  (h.value_mul_equiv.to_equiv.bijective.1)
  (is_equiv.value_monoid_order_equiv_aux h) x y
   ..h.value_mul_equiv}

lemma is_equiv.value_mul_equiv_monotone (h : is_equiv v₁ v₂) :
  monotone (h.value_mul_equiv) := λ x y,
  (@@le_equiv.le_map _ _ (is_equiv.value_monoid_le_equiv h)).1

lemma is_equiv.value_mul_equiv_map_zero (h : is_equiv v₁ v₂) :
  h.value_mul_equiv 0 = 0 :=
begin
  apply quotient.sound',
  refine ⟨1, is_submonoid.one_mem _, _⟩,
  rw [units.coe_one, mul_one],
  exact is_ring_hom.map_zero _,
end

lemma is_equiv.with_zero_value_mul_equiv_mk_eq_mk (h : v₁.is_equiv v₂) :
  (canonical_valuation v₁).map
    h.value_mul_equiv.to_monoid_hom h.value_mul_equiv_map_zero h.value_mul_equiv_monotone =
  canonical_valuation v₂ :=
begin
  ext r, apply quotient.sound',
  refine ⟨1, is_submonoid.one_mem _, _⟩,
  rw [units.coe_one, mul_one],
  apply valfield_of_valfield_of_eq_supp_quotient_mk,
end

end Wedhorn1_27_equivalences -- section

end valuation


namespace HW7

inductive Nat where
  | zero : Nat
  | succ (n : Nat) : Nat

def Nat.add : Nat → Nat → Nat
  | Nat.zero, b   => b
  | Nat.succ a, b => Nat.succ (Nat.add a b)

def addtail (n m : Nat) : Nat :=
  match n, m with
  | Nat.zero, m => m
  | Nat.succ n', m => addtail n' (Nat.succ m)

theorem add_eq : forall n m, Nat.add n m = addtail n m :=
 by intro n
    induction n
    case zero => intro m; simp only [Nat.add, addtail]
    case succ n IH => sorry

end HW7


/-
Copyright (c) 2021 Bhavik Mehta, Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta, Alena Gusakov, Yaël Dillies

! This file was ported from Lean 3 source module data.finset.slice
! leanprover-community/mathlib commit f7fc89d5d5ff1db2d1242c7bb0e9062ce47ef47c
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.BigOperators.Basic
import Mathlib.Data.Nat.Interval
import Mathlib.Order.Antichain

/-!
# `r`-sets and slice

This file defines the `r`-th slice of a set family and provides a way to say that a set family is
made of `r`-sets.

An `r`-set is a finset of cardinality `r` (aka of *size* `r`). The `r`-th slice of a set family is
the set family made of its `r`-sets.

## Main declarations

* `Set.Sized`: `A.Sized r` means that `A` only contains `r`-sets.
* `Finset.slice`: `A.slice r` is the set of `r`-sets in `A`.

## Notation

`A # r` is notation for `A.slice r` in locale `finset_family`.
-/

open Finset Nat

open BigOperators

variable {α : Type _} {ι : Sort _} {κ : ι → Sort _}

namespace Set

variable {A B : Set (Finset α)} {r : ℕ}

/-! ### Families of `r`-sets -/

/-- `Sized r A` means that every Finset in `A` has size `r`. -/
def Sized (r : ℕ) (A : Set (Finset α)) : Prop :=
  ∀ ⦃x⦄, x ∈ A → card x = r
#align set.sized Set.Sized

theorem Sized.mono (h : A ⊆ B) (hB : B.Sized r) : A.Sized r := fun _x hx => hB <| h hx
#align set.sized.mono Set.Sized.mono

theorem sized_union : (A ∪ B).Sized r ↔ A.Sized r ∧ B.Sized r :=
  ⟨fun hA => ⟨hA.mono <| subset_union_left _ _, hA.mono <| subset_union_right _ _⟩, fun hA _x hx =>
    hx.elim (fun h => hA.1 h) fun h => hA.2 h⟩
#align set.sized_union Set.sized_union

alias sized_union ↔ _ sized.union
#align set.sized.union Set.sized.union

--TODO: A `forall_unionᵢ` lemma would be handy here.
@[simp]
theorem sized_unionᵢ {f : ι → Set (Finset α)} : (⋃ i, f i).Sized r ↔ ∀ i, (f i).Sized r := by
  simp_rw [Set.Sized, Set.mem_unionᵢ, forall_exists_index]
  exact forall_swap
#align set.sized_Union Set.sized_unionᵢ

-- @[simp] -- Porting note: left hand side is not simp-normal form.
theorem sized_unionᵢ₂ {f : ∀ i, κ i → Set (Finset α)} :
    (⋃ (i) (j), f i j).Sized r ↔ ∀ i j, (f i j).Sized r :=
 by simp only [Set.sized_unionᵢ]
#align set.sized_Union₂ Set.sized_unionᵢ₂

protected theorem Sized.isAntichain (hA : A.Sized r) : IsAntichain (· ⊆ ·) A :=
  fun _s hs _t ht h hst => h <| Finset.eq_of_subset_of_card_le hst ((hA ht).trans (hA hs).symm).le
#align set.sized.is_antichain Set.Sized.isAntichain

protected theorem Sized.subsingleton (hA : A.Sized 0) : A.Subsingleton :=
  subsingleton_of_forall_eq ∅ fun _s hs => card_eq_zero.1 <| hA hs
#align set.sized.subsingleton Set.Sized.subsingleton

theorem Sized.subsingleton' [Fintype α] (hA : A.Sized (Fintype.card α)) : A.Subsingleton :=
  subsingleton_of_forall_eq Finset.univ fun s hs => s.card_eq_iff_eq_univ.1 <| hA hs
#align set.sized.subsingleton' Set.Sized.subsingleton'

theorem Sized.empty_mem_iff (hA : A.Sized r) : ∅ ∈ A ↔ A = {∅} :=
  hA.isAntichain.bot_mem_iff
#align set.sized.empty_mem_iff Set.Sized.empty_mem_iff

theorem Sized.univ_mem_iff [Fintype α] (hA : A.Sized r) : Finset.univ ∈ A ↔ A = {Finset.univ} :=
  hA.isAntichain.top_mem_iff
#align set.sized.univ_mem_iff Set.Sized.univ_mem_iff

theorem sized_powersetLen (s : Finset α) (r : ℕ) : (powersetLen r s : Set (Finset α)).Sized r :=
  fun _t ht => (mem_powersetLen.1 ht).2
#align set.sized_powerset_len Set.sized_powersetLen

end Set

namespace Finset

section Sized

variable [Fintype α] {𝒜 : Finset (Finset α)} {s : Finset α} {r : ℕ}

theorem subset_powersetLen_univ_iff : 𝒜 ⊆ powersetLen r univ ↔ (𝒜 : Set (Finset α)).Sized r :=
  forall_congr' fun A => by rw [mem_powerset_len_univ_iff, mem_coe]
#align finset.subset_powerset_len_univ_iff Finset.subset_powersetLen_univ_iff

alias subset_powersetLen_univ_iff ↔ _ _root_.Set.Sized.subset_powersetLen_univ
#align set.sized.subset_powerset_len_univ Set.Sized.subset_powersetLen_univ

theorem Set.Sized.card_le (h𝒜 : (𝒜 : Set (Finset α)).Sized r) :
    card 𝒜 ≤ (Fintype.card α).choose r := by
  rw [Fintype.card, ← card_powersetLen]
  exact card_le_of_subset (subset_powersetLen_univ_iff.mpr h𝒜)
#align set.sized.card_le Finset.Set.Sized.card_le

end Sized

/-! ### Slices -/

section Slice

variable {𝒜 : Finset (Finset α)} {A A₁ A₂ : Finset α} {r r₁ r₂ : ℕ}

/-- The `r`-th slice of a set family is the subset of its elements which have cardinality `r`. -/
def slice (𝒜 : Finset (Finset α)) (r : ℕ) : Finset (Finset α) :=
  𝒜.filter fun i => i.card = r
#align finset.slice Finset.slice

-- mathport name: finset.slice
-- Porting note: old code: scoped[FinsetFamily]
@[inherit_doc]
scoped[Finset] infixl:90 " # " => Finset.slice

/-- `A` is in the `r`-th slice of `𝒜` iff it's in `𝒜` and has cardinality `r`. -/
theorem mem_slice : A ∈ 𝒜 # r ↔ A ∈ 𝒜 ∧ A.card = r :=
  mem_filter
#align finset.mem_slice Finset.mem_slice

/-- The `r`-th slice of `𝒜` is a subset of `𝒜`. -/
theorem slice_subset : 𝒜 # r ⊆ 𝒜 :=
  filter_subset _ _
#align finset.slice_subset Finset.slice_subset

/-- Everything in the `r`-th slice of `𝒜` has size `r`. -/
theorem sized_slice : (𝒜 # r : Set (Finset α)).Sized r := fun _ => And.right ∘ mem_slice.mp
#align finset.sized_slice Finset.sized_slice

theorem eq_of_mem_slice (h₁ : A ∈ 𝒜 # r₁) (h₂ : A ∈ 𝒜 # r₂) : r₁ = r₂ :=
  (sized_slice h₁).symm.trans <| sized_slice h₂
#align finset.eq_of_mem_slice Finset.eq_of_mem_slice

/-- Elements in distinct slices must be distinct. -/
theorem ne_of_mem_slice (h₁ : A₁ ∈ 𝒜 # r₁) (h₂ : A₂ ∈ 𝒜 # r₂) : r₁ ≠ r₂ → A₁ ≠ A₂ :=
  mt fun h => (sized_slice h₁).symm.trans ((congr_arg card h).trans (sized_slice h₂))
#align finset.ne_of_mem_slice Finset.ne_of_mem_slice

theorem pairwiseDisjoint_slice : (Set.univ : Set ℕ).PairwiseDisjoint (slice 𝒜) := fun _ _ _ _ hmn =>
  disjoint_filter.2 fun _s _hs hm hn => hmn <| hm.symm.trans hn
#align finset.pairwise_disjoint_slice Finset.pairwiseDisjoint_slice

variable [Fintype α] (𝒜)

@[simp]
theorem bunionᵢ_slice [DecidableEq α] : (Iic <| Fintype.card α).bunionᵢ 𝒜.slice = 𝒜 :=
  Subset.antisymm (bunionᵢ_subset.2 fun _r _ => slice_subset) fun s hs =>
    mem_bunionᵢ.2 ⟨s.card, mem_Iic.2 <| s.card_le_univ, mem_slice.2 <| ⟨hs, rfl⟩⟩
#align finset.bUnion_slice Finset.bunionᵢ_slice

@[simp]
theorem sum_card_slice : (∑ r in Iic (Fintype.card α), (𝒜 # r).card) = 𝒜.card := by
  letI := Classical.decEq α
  rw [← card_bunionᵢ, bunionᵢ_slice]
  exact Finset.pairwiseDisjoint_slice.subset (Set.subset_univ _)
#align finset.sum_card_slice Finset.sum_card_slice

end Slice

end Finset


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Abhimanyu Pallavi Sudhir, Jean Lo, Calle Sönne, Benjamin Davidson
-/
import algebra.quadratic_discriminant
import analysis.complex.polynomial
import field_theory.is_alg_closed.basic
import analysis.special_functions.trigonometric.basic
import analysis.convex.specific_functions

/-!
# Complex trigonometric functions

Basic facts and derivatives for the complex trigonometric functions.

Several facts about the real trigonometric functions have the proofs deferred here, rather than
`analysis.special_functions.trigonometric.basic`,
as they are most easily proved by appealing to the corresponding fact for complex trigonometric
functions, or require additional imports which are not available in that file.
-/

noncomputable theory

namespace complex

open set filter
open_locale real

theorem cos_eq_zero_iff {θ : ℂ} : cos θ = 0 ↔ ∃ k : ℤ, θ = (2 * k + 1) * π / 2 :=
begin
  have h : (exp (θ * I) + exp (-θ * I)) / 2 = 0 ↔ exp (2 * θ * I) = -1,
  { rw [@div_eq_iff _ _ (exp (θ * I) + exp (-θ * I)) 2 0 two_ne_zero', zero_mul,
      add_eq_zero_iff_eq_neg, neg_eq_neg_one_mul, ← div_eq_iff (exp_ne_zero _), ← exp_sub],
    field_simp only, congr' 3, ring },
  rw [cos, h, ← exp_pi_mul_I, exp_eq_exp_iff_exists_int, mul_right_comm],
  refine exists_congr (λ x, _),
  refine (iff_of_eq $ congr_arg _ _).trans (mul_right_inj' $ mul_ne_zero two_ne_zero' I_ne_zero),
  ring,
end

theorem cos_ne_zero_iff {θ : ℂ} : cos θ ≠ 0 ↔ ∀ k : ℤ, θ ≠ (2 * k + 1) * π / 2 :=
by rw [← not_exists, not_iff_not, cos_eq_zero_iff]

theorem sin_eq_zero_iff {θ : ℂ} : sin θ = 0 ↔ ∃ k : ℤ, θ = k * π :=
begin
  rw [← complex.cos_sub_pi_div_two, cos_eq_zero_iff],
  split,
  { rintros ⟨k, hk⟩,
    use k + 1,
    field_simp [eq_add_of_sub_eq hk],
    ring },
  { rintros ⟨k, rfl⟩,
    use k - 1,
    field_simp,
    ring }
end

theorem sin_ne_zero_iff {θ : ℂ} : sin θ ≠ 0 ↔ ∀ k : ℤ, θ ≠ k * π :=
by rw [← not_exists, not_iff_not, sin_eq_zero_iff]

lemma tan_eq_zero_iff {θ : ℂ} : tan θ = 0 ↔ ∃ k : ℤ, θ = k * π / 2 :=
begin
  have h := (sin_two_mul θ).symm,
  rw mul_assoc at h,
  rw [tan, div_eq_zero_iff, ← mul_eq_zero, ← zero_mul ((1/2):ℂ), mul_one_div,
      cancel_factors.cancel_factors_eq_div h two_ne_zero', mul_comm],
  simpa only [zero_div, zero_mul, ne.def, not_false_iff] with field_simps using sin_eq_zero_iff,
end

lemma tan_ne_zero_iff {θ : ℂ} : tan θ ≠ 0 ↔ ∀ k : ℤ, θ ≠ k * π / 2 :=
by rw [← not_exists, not_iff_not, tan_eq_zero_iff]

lemma tan_int_mul_pi_div_two (n : ℤ) : tan (n * π/2) = 0 :=
tan_eq_zero_iff.mpr (by use n)

lemma cos_eq_cos_iff {x y : ℂ} :
  cos x = cos y ↔ ∃ k : ℤ, y = 2 * k * π + x ∨ y = 2 * k * π - x :=
calc cos x = cos y ↔ cos x - cos y = 0 : sub_eq_zero.symm
... ↔ -2 * sin((x + y)/2) * sin((x - y)/2) = 0 : by rw cos_sub_cos
... ↔ sin((x + y)/2) = 0 ∨ sin((x - y)/2) = 0 : by simp [(by norm_num : (2:ℂ) ≠ 0)]
... ↔ sin((x - y)/2) = 0 ∨ sin((x + y)/2) = 0 : or.comm
... ↔ (∃ k : ℤ, y = 2 * k * π + x) ∨ (∃ k :ℤ, y = 2 * k * π - x) :
begin
  apply or_congr;
    field_simp [sin_eq_zero_iff, (by norm_num : -(2:ℂ) ≠ 0), eq_sub_iff_add_eq',
      sub_eq_iff_eq_add, mul_comm (2:ℂ), mul_right_comm _ (2:ℂ)],
  split; { rintros ⟨k, rfl⟩, use -k, simp, },
end
... ↔ ∃ k : ℤ, y = 2 * k * π + x ∨ y = 2 * k * π - x : exists_or_distrib.symm

lemma sin_eq_sin_iff {x y : ℂ} :
  sin x = sin y ↔ ∃ k : ℤ, y = 2 * k * π + x ∨ y = (2 * k + 1) * π - x :=
begin
  simp only [← complex.cos_sub_pi_div_two, cos_eq_cos_iff, sub_eq_iff_eq_add],
  refine exists_congr (λ k, or_congr _ _); refine eq.congr rfl _; field_simp; ring
end

lemma tan_add {x y : ℂ}
  (h : ((∀ k : ℤ, x ≠ (2 * k + 1) * π / 2) ∧ ∀ l : ℤ, y ≠ (2 * l + 1) * π / 2)
     ∨ ((∃ k : ℤ, x = (2 * k + 1) * π / 2) ∧ ∃ l : ℤ, y = (2 * l + 1) * π / 2)) :
  tan (x + y) = (tan x + tan y) / (1 - tan x * tan y) :=
begin
  rcases h with ⟨h1, h2⟩ | ⟨⟨k, rfl⟩, ⟨l, rfl⟩⟩,
  { rw [tan, sin_add, cos_add,
        ← div_div_div_cancel_right (sin x * cos y + cos x * sin y)
            (mul_ne_zero (cos_ne_zero_iff.mpr h1) (cos_ne_zero_iff.mpr h2)),
        add_div, sub_div],
    simp only [←div_mul_div, ←tan, mul_one, one_mul,
              div_self (cos_ne_zero_iff.mpr h1), div_self (cos_ne_zero_iff.mpr h2)] },
  { obtain ⟨t, hx, hy, hxy⟩ := ⟨tan_int_mul_pi_div_two, t (2*k+1), t (2*l+1), t (2*k+1+(2*l+1))⟩,
    simp only [int.cast_add, int.cast_bit0, int.cast_mul, int.cast_one, hx, hy] at hx hy hxy,
    rw [hx, hy, add_zero, zero_div,
        mul_div_assoc, mul_div_assoc, ← add_mul (2*(k:ℂ)+1) (2*l+1) (π/2), ← mul_div_assoc, hxy] },
end

lemma tan_add' {x y : ℂ}
  (h : ((∀ k : ℤ, x ≠ (2 * k + 1) * π / 2) ∧ ∀ l : ℤ, y ≠ (2 * l + 1) * π / 2)) :
  tan (x + y) = (tan x + tan y) / (1 - tan x * tan y) :=
tan_add (or.inl h)

lemma tan_two_mul {z : ℂ} : tan (2 * z) = 2 * tan z / (1 - tan z ^ 2) :=
begin
  by_cases h : ∀ k : ℤ, z ≠ (2 * k + 1) * π / 2,
  { rw [two_mul, two_mul, sq, tan_add (or.inl ⟨h, h⟩)] },
  { rw not_forall_not at h,
    rw [two_mul, two_mul, sq, tan_add (or.inr ⟨h, h⟩)] },
end

lemma tan_add_mul_I {x y : ℂ}
  (h : ((∀ k : ℤ, x ≠ (2 * k + 1) * π / 2) ∧ ∀ l : ℤ, y * I ≠ (2 * l + 1) * π / 2)
     ∨ ((∃ k : ℤ, x = (2 * k + 1) * π / 2) ∧ ∃ l : ℤ, y * I = (2 * l + 1) * π / 2)) :
  tan (x + y*I) = (tan x + tanh y * I) / (1 - tan x * tanh y * I) :=
by rw [tan_add h, tan_mul_I, mul_assoc]

lemma tan_eq {z : ℂ}
  (h : ((∀ k : ℤ, (z.re:ℂ) ≠ (2 * k + 1) * π / 2) ∧ ∀ l : ℤ, (z.im:ℂ) * I ≠ (2 * l + 1) * π / 2)
     ∨ ((∃ k : ℤ, (z.re:ℂ) = (2 * k + 1) * π / 2) ∧ ∃ l : ℤ, (z.im:ℂ) * I = (2 * l + 1) * π / 2)) :
  tan z = (tan z.re + tanh z.im * I) / (1 - tan z.re * tanh z.im * I) :=
by convert tan_add_mul_I h; exact (re_add_im z).symm

open_locale topological_space

lemma continuous_on_tan : continuous_on tan {x | cos x ≠ 0} :=
continuous_on_sin.div continuous_on_cos $ λ x, id

@[continuity]
lemma continuous_tan : continuous (λ x : {x | cos x ≠ 0}, tan x) :=
continuous_on_iff_continuous_restrict.1 continuous_on_tan

lemma cos_eq_iff_quadratic {z w : ℂ} :
  cos z = w ↔ (exp (z * I)) ^ 2 - 2 * w * exp (z * I) + 1 = 0 :=
begin
  rw ← sub_eq_zero,
  field_simp [cos, exp_neg, exp_ne_zero],
  refine eq.congr _ rfl,
  ring
end

lemma cos_surjective : function.surjective cos :=
begin
  intro x,
  obtain ⟨w, w₀, hw⟩ : ∃ w ≠ 0, 1 * w * w + (-2 * x) * w + 1 = 0,
  { rcases exists_quadratic_eq_zero (@one_ne_zero ℂ _ _) (is_alg_closed.exists_eq_mul_self _)
      with ⟨w, hw⟩,
    refine ⟨w, _, hw⟩,
    rintro rfl,
    simpa only [zero_add, one_ne_zero, mul_zero] using hw },
  refine ⟨log w / I, cos_eq_iff_quadratic.2 _⟩,
  rw [div_mul_cancel _ I_ne_zero, exp_log w₀],
  convert hw,
  ring
end

@[simp] lemma range_cos : range cos = set.univ :=
cos_surjective.range_eq

lemma sin_surjective : function.surjective sin :=
begin
  intro x,
  rcases cos_surjective x with ⟨z, rfl⟩,
  exact ⟨z + π / 2, sin_add_pi_div_two z⟩
end

@[simp] lemma range_sin : range sin = set.univ :=
sin_surjective.range_eq

end complex

namespace real

open_locale real

theorem cos_eq_zero_iff {θ : ℝ} : cos θ = 0 ↔ ∃ k : ℤ, θ = (2 * k + 1) * π / 2 :=
by exact_mod_cast @complex.cos_eq_zero_iff θ

theorem cos_ne_zero_iff {θ : ℝ} : cos θ ≠ 0 ↔ ∀ k : ℤ, θ ≠ (2 * k + 1) * π / 2 :=
by rw [← not_exists, not_iff_not, cos_eq_zero_iff]

lemma cos_eq_cos_iff {x y : ℝ} :
  cos x = cos y ↔ ∃ k : ℤ, y = 2 * k * π + x ∨ y = 2 * k * π - x :=
by exact_mod_cast @complex.cos_eq_cos_iff x y

lemma sin_eq_sin_iff {x y : ℝ} :
  sin x = sin y ↔ ∃ k : ℤ, y = 2 * k * π + x ∨ y = (2 * k + 1) * π - x :=
by exact_mod_cast @complex.sin_eq_sin_iff x y

lemma lt_sin_mul {x : ℝ} (hx : 0 < x) (hx' : x < 1) : x < sin ((π / 2) * x) :=
by simpa [mul_comm x] using strict_concave_on_sin_Icc.2 ⟨le_rfl, pi_pos.le⟩
  ⟨pi_div_two_pos.le, half_le_self pi_pos.le⟩ pi_div_two_pos.ne (sub_pos.2 hx') hx

lemma le_sin_mul {x : ℝ} (hx : 0 ≤ x) (hx' : x ≤ 1) : x ≤ sin ((π / 2) * x) :=
by simpa [mul_comm x] using strict_concave_on_sin_Icc.concave_on.2 ⟨le_rfl, pi_pos.le⟩
  ⟨pi_div_two_pos.le, half_le_self pi_pos.le⟩ (sub_nonneg.2 hx') hx

lemma mul_lt_sin {x : ℝ} (hx : 0 < x) (hx' : x < π / 2) : (2 / π) * x < sin x :=
begin
  rw [←inv_div],
  simpa [pi_div_two_pos.ne', mul_nonneg, inv_nonneg] using @lt_sin_mul ((π / 2)⁻¹ * x) _ _,
  { exact mul_pos (inv_pos.2 pi_div_two_pos) hx },
  { rwa [←div_eq_inv_mul, div_lt_one pi_div_two_pos] },
end

/-- In the range `[0, π / 2]`, we have a linear lower bound on `sin`. This inequality forms one half
of Jordan's inequality, the other half is `real.sin_lt` -/
lemma mul_le_sin {x : ℝ} (hx : 0 ≤ x) (hx' : x ≤ π / 2) : (2 / π) * x ≤ sin x :=
begin
  rw [←inv_div],
  simpa [pi_div_two_pos.ne', mul_nonneg, inv_nonneg] using @le_sin_mul ((π / 2)⁻¹ * x) _ _,
  { exact mul_nonneg (inv_nonneg.2 pi_div_two_pos.le) hx },
  { rwa [←div_eq_inv_mul, div_le_one pi_div_two_pos] },
end

end real


/-
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 algebra.gcd_monoid.integrally_closed
! leanprover-community/mathlib commit 2032a878972d5672e7c27c957e7a6e297b044973
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.GcdMonoid.Basic
import Mathbin.RingTheory.IntegrallyClosed
import Mathbin.RingTheory.Polynomial.Eisenstein.Basic

/-!

# GCD domains are integrally closed

-/

open BigOperators Polynomial

variable {R A : Type _} [CommRing R] [IsDomain R] [GCDMonoid R] [CommRing A] [Algebra R A]

theorem IsLocalization.surj_of_gcd_domain (M : Submonoid R) [IsLocalization M A] (z : A) :
    ∃ a b : R, IsUnit (gcd a b) ∧ z * algebraMap R A b = algebraMap R A a :=
  by
  obtain ⟨x, ⟨y, hy⟩, rfl⟩ := IsLocalization.mk'_surjective M z
  obtain ⟨x', y', hx', hy', hu⟩ := extract_gcd x y
  use x', y', hu
  rw [mul_comm, IsLocalization.mul_mk'_eq_mk'_of_mul]
  convert IsLocalization.mk'_mul_cancel_left _ _ using 2
  · rw [Subtype.coe_mk, hy', ← mul_comm y', mul_assoc]
    conv_lhs => rw [hx']
  · infer_instance
#align is_localization.surj_of_gcd_domain IsLocalization.surj_of_gcd_domain

instance (priority := 100) GCDMonoid.toIsIntegrallyClosed : IsIntegrallyClosed R :=
  ⟨fun X ⟨p, hp₁, hp₂⟩ =>
    by
    obtain ⟨x, y, hg, he⟩ := IsLocalization.surj_of_gcd_domain (nonZeroDivisors R) X
    have :=
      Polynomial.dvd_pow_natDegree_of_eval₂_eq_zero (IsFractionRing.injective R <| FractionRing R)
        hp₁ y x _ hp₂ (by rw [mul_comm, he])
    have : IsUnit y := by
      rw [isUnit_iff_dvd_one, ← one_pow]
      exact
        (dvd_gcd this <| dvd_refl y).trans
          (gcd_pow_left_dvd_pow_gcd.trans <| pow_dvd_pow_of_dvd (isUnit_iff_dvd_one.1 hg) _)
    use x * (this.unit⁻¹ : _)
    erw [map_mul, ← Units.coe_map_inv, eq_comm, Units.eq_mul_inv_iff_mul_eq]
    exact he⟩
#align gcd_monoid.to_is_integrally_closed GCDMonoid.toIsIntegrallyClosed


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

! This file was ported from Lean 3 source module ring_theory.finite_presentation
! leanprover-community/mathlib commit da420a8c6dd5bdfb85c4ced85c34388f633bc6ff
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.RingTheory.FiniteType
import Mathbin.RingTheory.MvPolynomial.Tower
import Mathbin.RingTheory.Ideal.QuotientOperations

/-!
# Finiteness conditions in commutative algebra

In this file we define several notions of finiteness that are common in commutative algebra.

## Main declarations

- `module.finite`, `algebra.finite`, `ring_hom.finite`, `alg_hom.finite`
  all of these express that some object is finitely generated *as module* over some base ring.
- `algebra.finite_type`, `ring_hom.finite_type`, `alg_hom.finite_type`
  all of these express that some object is finitely generated *as algebra* over some base ring.
- `algebra.finite_presentation`, `ring_hom.finite_presentation`, `alg_hom.finite_presentation`
  all of these express that some object is finitely presented *as algebra* over some base ring.

-/

open Function (Surjective)

open BigOperators Polynomial

section ModuleAndAlgebra

variable (R A B M N : Type _)

/-- An algebra over a commutative semiring is `finite_presentation` if it is the quotient of a
polynomial ring in `n` variables by a finitely generated ideal. -/
def Algebra.FinitePresentation [CommSemiring R] [Semiring A] [Algebra R A] : Prop :=
  ∃ (n : ℕ)(f : MvPolynomial (Fin n) R →ₐ[R] A), Surjective f ∧ f.toRingHom.ker.Fg
#align algebra.finite_presentation Algebra.FinitePresentation

namespace Algebra

variable [CommRing R] [CommRing A] [Algebra R A] [CommRing B] [Algebra R B]

variable [AddCommGroup M] [Module R M]

variable [AddCommGroup N] [Module R N]

namespace FiniteType

variable {R A B}

/-- A finitely presented algebra is of finite type. -/
theorem of_finitePresentation : FinitePresentation R A → FiniteType R A :=
  by
  rintro ⟨n, f, hf⟩
  apply finite_type.iff_quotient_mv_polynomial''.2
  exact ⟨n, f, hf.1⟩
#align algebra.finite_type.of_finite_presentation Algebra.FiniteType.of_finitePresentation

end FiniteType

namespace FinitePresentation

variable {R A B}

/-- An algebra over a Noetherian ring is finitely generated if and only if it is finitely
presented. -/
theorem of_finiteType [IsNoetherianRing R] : FiniteType R A ↔ FinitePresentation R A :=
  by
  refine' ⟨fun h => _, Algebra.FiniteType.of_finitePresentation⟩
  obtain ⟨n, f, hf⟩ := Algebra.FiniteType.iff_quotient_mv_polynomial''.1 h
  refine' ⟨n, f, hf, _⟩
  have hnoet : IsNoetherianRing (MvPolynomial (Fin n) R) := by infer_instance
  replace hnoet := (isNoetherianRing_iff.1 hnoet).noetherian
  exact hnoet f.to_ring_hom.ker
#align algebra.finite_presentation.of_finite_type Algebra.FinitePresentation.of_finiteType

/-- If `e : A ≃ₐ[R] B` and `A` is finitely presented, then so is `B`. -/
theorem equiv (hfp : FinitePresentation R A) (e : A ≃ₐ[R] B) : FinitePresentation R B :=
  by
  obtain ⟨n, f, hf⟩ := hfp
  use n, AlgHom.comp (↑e) f
  constructor
  · exact Function.Surjective.comp e.surjective hf.1
  suffices hker : (AlgHom.comp (↑e) f).toRingHom.ker = f.to_ring_hom.ker
  · rw [hker]
    exact hf.2
  · have hco : (AlgHom.comp (↑e) f).toRingHom = RingHom.comp (↑e.to_ring_equiv) f.to_ring_hom :=
      by
      have h : (AlgHom.comp (↑e) f).toRingHom = e.to_alg_hom.to_ring_hom.comp f.to_ring_hom := rfl
      have h1 : ↑e.to_ring_equiv = e.to_alg_hom.toRingHom := rfl
      rw [h, h1]
    rw [RingHom.ker_eq_comap_bot, hco, ← Ideal.comap_comap, ← RingHom.ker_eq_comap_bot,
      RingHom.ker_coe_equiv (AlgEquiv.toRingEquiv e), RingHom.ker_eq_comap_bot]
#align algebra.finite_presentation.equiv Algebra.FinitePresentation.equiv

variable (R)

/-- The ring of polynomials in finitely many variables is finitely presented. -/
protected theorem mvPolynomial (ι : Type u_2) [Finite ι] :
    FinitePresentation R (MvPolynomial ι R) := by
  cases nonempty_fintype ι <;>
    exact
      let eqv := (MvPolynomial.renameEquiv R <| Fintype.equivFin ι).symm
      ⟨Fintype.card ι, eqv, eqv.Surjective,
        ((RingHom.injective_iff_ker_eq_bot _).1 eqv.Injective).symm ▸ Submodule.fg_bot⟩
#align algebra.finite_presentation.mv_polynomial Algebra.FinitePresentation.mvPolynomial

/-- `R` is finitely presented as `R`-algebra. -/
theorem self : FinitePresentation R R :=
  equiv (FinitePresentation.mvPolynomial R PEmpty) (MvPolynomial.isEmptyAlgEquiv R PEmpty)
#align algebra.finite_presentation.self Algebra.FinitePresentation.self

/-- `R[X]` is finitely presented as `R`-algebra. -/
theorem polynomial : FinitePresentation R R[X] :=
  equiv (FinitePresentation.mvPolynomial R PUnit) (MvPolynomial.pUnitAlgEquiv R)
#align algebra.finite_presentation.polynomial Algebra.FinitePresentation.polynomial

variable {R}

/-- The quotient of a finitely presented algebra by a finitely generated ideal is finitely
presented. -/
protected theorem quotient {I : Ideal A} (h : I.Fg) (hfp : FinitePresentation R A) :
    FinitePresentation R (A ⧸ I) := by
  obtain ⟨n, f, hf⟩ := hfp
  refine' ⟨n, (Ideal.Quotient.mkₐ R I).comp f, _, _⟩
  · exact (Ideal.Quotient.mkₐ_surjective R I).comp hf.1
  · refine' Ideal.fg_ker_comp _ _ hf.2 _ hf.1
    simp [h]
#align algebra.finite_presentation.quotient Algebra.FinitePresentation.quotient

/-- If `f : A →ₐ[R] B` is surjective with finitely generated kernel and `A` is finitely presented,
then so is `B`. -/
theorem of_surjective {f : A →ₐ[R] B} (hf : Function.Surjective f) (hker : f.toRingHom.ker.Fg)
    (hfp : FinitePresentation R A) : FinitePresentation R B :=
  equiv (hfp.Quotient hker) (Ideal.quotientKerAlgEquivOfSurjective hf)
#align algebra.finite_presentation.of_surjective Algebra.FinitePresentation.of_surjective

theorem iff :
    FinitePresentation R A ↔
      ∃ (n : _)(I : Ideal (MvPolynomial (Fin n) R))(e : (_ ⧸ I) ≃ₐ[R] A), I.Fg :=
  by
  constructor
  · rintro ⟨n, f, hf⟩
    exact ⟨n, f.to_ring_hom.ker, Ideal.quotientKerAlgEquivOfSurjective hf.1, hf.2⟩
  · rintro ⟨n, I, e, hfg⟩
    exact Equiv ((finite_presentation.mv_polynomial R _).Quotient hfg) e
#align algebra.finite_presentation.iff Algebra.FinitePresentation.iff

/-- An algebra is finitely presented if and only if it is a quotient of a polynomial ring whose
variables are indexed by a fintype by a finitely generated ideal. -/
theorem iff_quotient_mv_polynomial' :
    FinitePresentation R A ↔
      ∃ (ι : Type u_2)(_ : Fintype ι)(f : MvPolynomial ι R →ₐ[R] A),
        Surjective f ∧ f.toRingHom.ker.Fg :=
  by
  constructor
  · rintro ⟨n, f, hfs, hfk⟩
    set ulift_var := MvPolynomial.renameEquiv R Equiv.ulift
    refine'
      ⟨ULift (Fin n), inferInstance, f.comp ulift_var.to_alg_hom, hfs.comp ulift_var.surjective,
        Ideal.fg_ker_comp _ _ _ hfk ulift_var.surjective⟩
    convert Submodule.fg_bot
    exact RingHom.ker_coe_equiv ulift_var.to_ring_equiv
  · rintro ⟨ι, hfintype, f, hf⟩
    skip
    have equiv := MvPolynomial.renameEquiv R (Fintype.equivFin ι)
    refine'
      ⟨Fintype.card ι, f.comp Equiv.symm, hf.1.comp (AlgEquiv.symm Equiv).Surjective,
        Ideal.fg_ker_comp _ f _ hf.2 equiv.symm.surjective⟩
    convert Submodule.fg_bot
    exact RingHom.ker_coe_equiv equiv.symm.to_ring_equiv
#align algebra.finite_presentation.iff_quotient_mv_polynomial' Algebra.FinitePresentation.iff_quotient_mv_polynomial'

/-- If `A` is a finitely presented `R`-algebra, then `mv_polynomial (fin n) A` is finitely presented
as `R`-algebra. -/
theorem mvPolynomial_of_finitePresentation (hfp : FinitePresentation R A) (ι : Type _) [Finite ι] :
    FinitePresentation R (MvPolynomial ι A) :=
  by
  rw [iff_quotient_mv_polynomial'] at hfp⊢
  classical
    obtain ⟨ι', _, f, hf_surj, hf_ker⟩ := hfp
    skip
    let g := (MvPolynomial.mapAlgHom f).comp (MvPolynomial.sumAlgEquiv R ι ι').toAlgHom
    cases nonempty_fintype (Sum ι ι')
    refine'
      ⟨Sum ι ι', by infer_instance, g,
        (MvPolynomial.map_surjective f.to_ring_hom hf_surj).comp (AlgEquiv.surjective _),
        Ideal.fg_ker_comp _ _ _ _ (AlgEquiv.surjective _)⟩
    · convert Submodule.fg_bot
      exact RingHom.ker_coe_equiv (MvPolynomial.sumAlgEquiv R ι ι').toRingEquiv
    · rw [AlgHom.toRingHom_eq_coe, MvPolynomial.mapAlgHom_coe_ringHom, MvPolynomial.ker_map]
      exact hf_ker.map MvPolynomial.C
#align algebra.finite_presentation.mv_polynomial_of_finite_presentation Algebra.FinitePresentation.mvPolynomial_of_finitePresentation

/-- If `A` is an `R`-algebra and `S` is an `A`-algebra, both finitely presented, then `S` is
  finitely presented as `R`-algebra. -/
theorem trans [Algebra A B] [IsScalarTower R A B] (hfpA : FinitePresentation R A)
    (hfpB : FinitePresentation A B) : FinitePresentation R B :=
  by
  obtain ⟨n, I, e, hfg⟩ := Iff.1 hfpB
  exact Equiv ((mv_polynomial_of_finite_presentation hfpA _).Quotient hfg) (e.restrict_scalars R)
#align algebra.finite_presentation.trans Algebra.FinitePresentation.trans

open MvPolynomial

-- We follow the proof of https://stacks.math.columbia.edu/tag/0561
-- TODO: extract out helper lemmas and tidy proof.
theorem of_restrict_scalars_finitePresentation [Algebra A B] [IsScalarTower R A B]
    (hRB : FinitePresentation R B) [hRA : FiniteType R A] : FinitePresentation A B := by
  classical
    obtain ⟨n, f, hf, s, hs⟩ := hRB
    let RX := MvPolynomial (Fin n) R
    let AX := MvPolynomial (Fin n) A
    refine' ⟨n, MvPolynomial.aeval (f ∘ X), _, _⟩
    · rw [← Algebra.range_top_iff_surjective, ← Algebra.adjoin_range_eq_range_aeval, Set.range_comp,
        _root_.eq_top_iff, ← @adjoin_adjoin_of_tower R A B, adjoin_image, adjoin_range_X,
        Algebra.map_top, (Algebra.range_top_iff_surjective _).mpr hf]
      exact subset_adjoin
    · obtain ⟨t, ht⟩ := hRA.out
      have := fun i : t => hf (algebraMap A B i)
      choose t' ht'
      have ht'' : Algebra.adjoin R (algebraMap A AX '' t ∪ Set.range (X : _ → AX)) = ⊤ :=
        by
        rw [adjoin_union_eq_adjoin_adjoin, ← Subalgebra.restrictScalars_top R]
        congr 1
        swap
        · exact Subalgebra.isScalarTower_mid _
        rw [adjoin_algebra_map, ht]
        apply Subalgebra.restrictScalars_injective R
        rw [← adjoin_restrict_scalars, adjoin_range_X, Subalgebra.restrictScalars_top,
          Subalgebra.restrictScalars_top]
      let g : t → AX := fun x => C (x : A) - map (algebraMap R A) (t' x)
      refine' ⟨s.image (map (algebraMap R A)) ∪ t.attach.image g, _⟩
      rw [Finset.coe_union, Finset.coe_image, Finset.coe_image, Finset.attach_eq_univ,
        Finset.coe_univ, Set.image_univ]
      let s₀ := _
      let I := _
      change Ideal.span s₀ = I
      have leI : Ideal.span s₀ ≤ I := by
        rw [Ideal.span_le]
        rintro _ (⟨x, hx, rfl⟩ | ⟨⟨x, hx⟩, rfl⟩)
        all_goals dsimp [g]; rw [RingHom.mem_ker, AlgHom.toRingHom_eq_coe, AlgHom.coe_toRingHom]
        · rw [MvPolynomial.aeval_map_algebraMap, ← aeval_unique]
          have := Ideal.subset_span hx
          rwa [hs] at this
        ·
          rw [map_sub, MvPolynomial.aeval_map_algebraMap, ← aeval_unique, aeval_C, ht',
            Subtype.coe_mk, sub_self]
      apply leI.antisymm
      intro x hx
      rw [RingHom.mem_ker, AlgHom.toRingHom_eq_coe, AlgHom.coe_toRingHom] at hx
      let s₀ := _
      change x ∈ Ideal.span s₀
      have :
        x ∈
          (map (algebraMap R A) : _ →+* AX).srange.toAddSubmonoid ⊔
            (Ideal.span s₀).toAddSubmonoid :=
        by
        have : x ∈ (⊤ : Subalgebra R AX) := trivial
        rw [← ht''] at this
        apply adjoin_induction this
        · rintro _ (⟨x, hx, rfl⟩ | ⟨i, rfl⟩)
          · rw [algebra_map_eq, ← sub_add_cancel (C x) (map (algebraMap R A) (t' ⟨x, hx⟩)),
              add_comm]
            apply AddSubmonoid.add_mem_sup
            · exact Set.mem_range_self _
            · apply Ideal.subset_span
              apply Set.mem_union_right
              exact Set.mem_range_self ⟨x, hx⟩
          · apply AddSubmonoid.mem_sup_left
            exact ⟨X i, map_X _ _⟩
        · intro r
          apply AddSubmonoid.mem_sup_left
          exact ⟨C r, map_C _ _⟩
        · intro _ _ h₁ h₂
          exact add_mem h₁ h₂
        · intro x₁ x₂ h₁ h₂
          obtain ⟨_, ⟨p₁, rfl⟩, q₁, hq₁, rfl⟩ := add_submonoid.mem_sup.mp h₁
          obtain ⟨_, ⟨p₂, rfl⟩, q₂, hq₂, rfl⟩ := add_submonoid.mem_sup.mp h₂
          rw [add_mul, mul_add, add_assoc, ← map_mul]
          apply AddSubmonoid.add_mem_sup
          · exact Set.mem_range_self _
          · refine' add_mem (Ideal.mul_mem_left _ _ hq₂) (Ideal.mul_mem_right _ _ hq₁)
      obtain ⟨_, ⟨p, rfl⟩, q, hq, rfl⟩ := add_submonoid.mem_sup.mp this
      rw [map_add, aeval_map_algebra_map, ← aeval_unique, show aeval (f ∘ X) q = 0 from leI hq,
        add_zero] at hx
      suffices Ideal.span (s : Set RX) ≤ (Ideal.span s₀).comap (map <| algebraMap R A)
        by
        refine' add_mem _ hq
        rw [hs] at this
        exact this hx
      rw [Ideal.span_le]
      intro x hx
      apply Ideal.subset_span
      apply Set.mem_union_left
      exact Set.mem_image_of_mem _ hx
#align algebra.finite_presentation.of_restrict_scalars_finite_presentation Algebra.FinitePresentation.of_restrict_scalars_finitePresentation

-- TODO: extract out helper lemmas and tidy proof.
/-- This is used to prove the strictly stronger `ker_fg_of_surjective`. Use it instead. -/
theorem ker_fg_of_mvPolynomial {n : ℕ} (f : MvPolynomial (Fin n) R →ₐ[R] A)
    (hf : Function.Surjective f) (hfp : FinitePresentation R A) : f.toRingHom.ker.Fg := by
  classical
    obtain ⟨m, f', hf', s, hs⟩ := hfp
    let RXn := MvPolynomial (Fin n) R
    let RXm := MvPolynomial (Fin m) R
    have := fun i : Fin n => hf' (f <| X i)
    choose g hg
    have := fun i : Fin m => hf (f' <| X i)
    choose h hh
    let aeval_h : RXm →ₐ[R] RXn := aeval h
    let g' : Fin n → RXn := fun i => X i - aeval_h (g i)
    refine' ⟨finset.univ.image g' ∪ s.image aeval_h, _⟩
    simp only [Finset.coe_image, Finset.coe_union, Finset.coe_univ, Set.image_univ]
    have hh' : ∀ x, f (aeval_h x) = f' x := by
      intro x
      rw [← f.coe_to_ring_hom, map_aeval]
      simp_rw [AlgHom.coe_toRingHom, hh]
      rw [AlgHom.comp_algebraMap, ← aeval_eq_eval₂_hom, ← aeval_unique]
    let s' := Set.range g' ∪ aeval_h '' s
    have leI : Ideal.span s' ≤ f.to_ring_hom.ker :=
      by
      rw [Ideal.span_le]
      rintro _ (⟨i, rfl⟩ | ⟨x, hx, rfl⟩)
      · change f (g' i) = 0
        rw [map_sub, ← hg, hh', sub_self]
      · change f (aeval_h x) = 0
        rw [hh']
        change x ∈ f'.to_ring_hom.ker
        rw [← hs]
        exact Ideal.subset_span hx
    apply leI.antisymm
    intro x hx
    have : x ∈ aeval_h.range.to_add_submonoid ⊔ (Ideal.span s').toAddSubmonoid :=
      by
      have : x ∈ adjoin R (Set.range X : Set RXn) :=
        by
        rw [adjoin_range_X]
        trivial
      apply adjoin_induction this
      · rintro _ ⟨i, rfl⟩
        rw [← sub_add_cancel (X i) (aeval h (g i)), add_comm]
        apply AddSubmonoid.add_mem_sup
        · exact Set.mem_range_self _
        · apply Submodule.subset_span
          apply Set.mem_union_left
          exact Set.mem_range_self _
      · intro r
        apply AddSubmonoid.mem_sup_left
        exact ⟨C r, aeval_C _ _⟩
      · intro _ _ h₁ h₂
        exact add_mem h₁ h₂
      · intro p₁ p₂ h₁ h₂
        obtain ⟨_, ⟨x₁, rfl⟩, y₁, hy₁, rfl⟩ := add_submonoid.mem_sup.mp h₁
        obtain ⟨_, ⟨x₂, rfl⟩, y₂, hy₂, rfl⟩ := add_submonoid.mem_sup.mp h₂
        rw [mul_add, add_mul, add_assoc, ← map_mul]
        apply AddSubmonoid.add_mem_sup
        · exact Set.mem_range_self _
        · exact add_mem (Ideal.mul_mem_right _ _ hy₁) (Ideal.mul_mem_left _ _ hy₂)
    obtain ⟨_, ⟨x, rfl⟩, y, hy, rfl⟩ := add_submonoid.mem_sup.mp this
    refine' add_mem _ hy
    simp only [RingHom.mem_ker, AlgHom.toRingHom_eq_coe, AlgHom.coe_toRingHom, map_add,
      show f y = 0 from leI hy, add_zero, hh'] at hx
    suffices Ideal.span (s : Set RXm) ≤ (Ideal.span s').comap aeval_h
      by
      apply this
      rwa [hs]
    rw [Ideal.span_le]
    intro x hx
    apply Submodule.subset_span
    apply Set.mem_union_right
    exact Set.mem_image_of_mem _ hx
#align algebra.finite_presentation.ker_fg_of_mv_polynomial Algebra.FinitePresentation.ker_fg_of_mvPolynomial

/-- If `f : A →ₐ[R] B` is a sujection between finitely-presented `R`-algebras, then the kernel of
`f` is finitely generated. -/
theorem ker_fg_of_surjective (f : A →ₐ[R] B) (hf : Function.Surjective f)
    (hRA : FinitePresentation R A) (hRB : FinitePresentation R B) : f.toRingHom.ker.Fg :=
  by
  obtain ⟨n, g, hg, hg'⟩ := hRA
  convert(ker_fg_of_mv_polynomial (f.comp g) (hf.comp hg) hRB).map g.to_ring_hom
  simp_rw [RingHom.ker_eq_comap_bot, AlgHom.toRingHom_eq_coe, AlgHom.comp_toRingHom]
  rw [← Ideal.comap_comap, Ideal.map_comap_of_surjective (g : MvPolynomial (Fin n) R →+* A) hg]
#align algebra.finite_presentation.ker_fg_of_surjective Algebra.FinitePresentation.ker_fg_of_surjective

end FinitePresentation

end Algebra

end ModuleAndAlgebra

namespace RingHom

variable {A B C : Type _} [CommRing A] [CommRing B] [CommRing C]

/-- A ring morphism `A →+* B` is of `finite_presentation` if `B` is finitely presented as
`A`-algebra. -/
def FinitePresentation (f : A →+* B) : Prop :=
  @Algebra.FinitePresentation A B _ _ f.toAlgebra
#align ring_hom.finite_presentation RingHom.FinitePresentation

namespace FiniteType

theorem of_finitePresentation {f : A →+* B} (hf : f.FinitePresentation) : f.FiniteType :=
  @Algebra.FiniteType.of_finitePresentation A B _ _ f.toAlgebra hf
#align ring_hom.finite_type.of_finite_presentation RingHom.FiniteType.of_finitePresentation

end FiniteType

namespace FinitePresentation

variable (A)

theorem id : FinitePresentation (RingHom.id A) :=
  Algebra.FinitePresentation.self A
#align ring_hom.finite_presentation.id RingHom.FinitePresentation.id

variable {A}

theorem comp_surjective {f : A →+* B} {g : B →+* C} (hf : f.FinitePresentation) (hg : Surjective g)
    (hker : g.ker.Fg) : (g.comp f).FinitePresentation :=
  @Algebra.FinitePresentation.of_surjective A B C _ _ f.toAlgebra _ (g.comp f).toAlgebra
    { g with
      toFun := g
      commutes' := fun a => rfl }
    hg hker hf
#align ring_hom.finite_presentation.comp_surjective RingHom.FinitePresentation.comp_surjective

theorem of_surjective (f : A →+* B) (hf : Surjective f) (hker : f.ker.Fg) : f.FinitePresentation :=
  by
  rw [← f.comp_id]
  exact (id A).comp_surjective hf hker
#align ring_hom.finite_presentation.of_surjective RingHom.FinitePresentation.of_surjective

theorem of_finiteType [IsNoetherianRing A] {f : A →+* B} : f.FiniteType ↔ f.FinitePresentation :=
  @Algebra.FinitePresentation.of_finiteType A B _ _ f.toAlgebra _
#align ring_hom.finite_presentation.of_finite_type RingHom.FinitePresentation.of_finiteType

theorem comp {g : B →+* C} {f : A →+* B} (hg : g.FinitePresentation) (hf : f.FinitePresentation) :
    (g.comp f).FinitePresentation :=
  @Algebra.FinitePresentation.trans A B C _ _ f.toAlgebra _ (g.comp f).toAlgebra g.toAlgebra
    {
      smul_assoc := fun a b c =>
        by
        simp only [Algebra.smul_def, RingHom.map_mul, mul_assoc]
        rfl }
    hf hg
#align ring_hom.finite_presentation.comp RingHom.FinitePresentation.comp

theorem of_comp_finiteType (f : A →+* B) {g : B →+* C} (hg : (g.comp f).FinitePresentation)
    (hf : f.FiniteType) : g.FinitePresentation :=
  @Algebra.FinitePresentation.of_restrict_scalars_finitePresentation _ _ f.toAlgebra _
    (g.comp f).toAlgebra g.toAlgebra
    (@IsScalarTower.of_algebraMap_eq' _ _ _ f.toAlgebra g.toAlgebra (g.comp f).toAlgebra rfl) hg hf
#align ring_hom.finite_presentation.of_comp_finite_type RingHom.FinitePresentation.of_comp_finiteType

end FinitePresentation

end RingHom

namespace AlgHom

variable {R A B C : Type _} [CommRing R]

variable [CommRing A] [CommRing B] [CommRing C]

variable [Algebra R A] [Algebra R B] [Algebra R C]

/-- An algebra morphism `A →ₐ[R] B` is of `finite_presentation` if it is of finite presentation as
ring morphism. In other words, if `B` is finitely presented as `A`-algebra. -/
def FinitePresentation (f : A →ₐ[R] B) : Prop :=
  f.toRingHom.FinitePresentation
#align alg_hom.finite_presentation AlgHom.FinitePresentation

namespace FiniteType

variable {R A}

theorem of_finitePresentation {f : A →ₐ[R] B} (hf : f.FinitePresentation) : f.FiniteType :=
  RingHom.FiniteType.of_finitePresentation hf
#align alg_hom.finite_type.of_finite_presentation AlgHom.FiniteType.of_finitePresentation

end FiniteType

namespace FinitePresentation

variable (R A)

theorem id : FinitePresentation (AlgHom.id R A) :=
  RingHom.FinitePresentation.id A
#align alg_hom.finite_presentation.id AlgHom.FinitePresentation.id

variable {R A}

theorem comp {g : B →ₐ[R] C} {f : A →ₐ[R] B} (hg : g.FinitePresentation)
    (hf : f.FinitePresentation) : (g.comp f).FinitePresentation :=
  RingHom.FinitePresentation.comp hg hf
#align alg_hom.finite_presentation.comp AlgHom.FinitePresentation.comp

theorem comp_surjective {f : A →ₐ[R] B} {g : B →ₐ[R] C} (hf : f.FinitePresentation)
    (hg : Surjective g) (hker : g.toRingHom.ker.Fg) : (g.comp f).FinitePresentation :=
  RingHom.FinitePresentation.comp_surjective hf hg hker
#align alg_hom.finite_presentation.comp_surjective AlgHom.FinitePresentation.comp_surjective

theorem of_surjective (f : A →ₐ[R] B) (hf : Surjective f) (hker : f.toRingHom.ker.Fg) :
    f.FinitePresentation :=
  RingHom.FinitePresentation.of_surjective f hf hker
#align alg_hom.finite_presentation.of_surjective AlgHom.FinitePresentation.of_surjective

theorem of_finiteType [IsNoetherianRing A] {f : A →ₐ[R] B} : f.FiniteType ↔ f.FinitePresentation :=
  RingHom.FinitePresentation.of_finiteType
#align alg_hom.finite_presentation.of_finite_type AlgHom.FinitePresentation.of_finiteType

theorem of_comp_finiteType (f : A →ₐ[R] B) {g : B →ₐ[R] C} (h : (g.comp f).FinitePresentation)
    (h' : f.FiniteType) : g.FinitePresentation :=
  h.of_comp_finiteType _ h'
#align alg_hom.finite_presentation.of_comp_finite_type AlgHom.FinitePresentation.of_comp_finiteType

end FinitePresentation

end AlgHom


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

Operations on set-valued functions, aka partial multifunctions, aka relations.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.set.lattice
import Mathlib.PostPort

universes u_1 u_2 u_3 u_4

namespace Mathlib

/-- A relation on `α` and `β`, aka a set-valued function, aka a partial multifunction --/
def rel (α : Type u_1) (β : Type u_2) := α → β → Prop

namespace rel

/-- The inverse relation : `r.inv x y ↔ r y x`. Note that this is *not* a groupoid inverse. -/
def inv {α : Type u_1} {β : Type u_2} (r : rel α β) : rel β α := flip r

theorem inv_def {α : Type u_1} {β : Type u_2} (r : rel α β) (x : α) (y : β) : inv r y x ↔ r x y :=
  iff.rfl

theorem inv_inv {α : Type u_1} {β : Type u_2} (r : rel α β) : inv (inv r) = r :=
  funext fun (x : α) => funext fun (y : β) => propext (iff.refl (inv (inv r) x y))

/-- Domain of a relation -/
def dom {α : Type u_1} {β : Type u_2} (r : rel α β) : set α :=
  set_of fun (x : α) => ∃ (y : β), r x y

/-- Codomain aka range of a relation-/
def codom {α : Type u_1} {β : Type u_2} (r : rel α β) : set β :=
  set_of fun (y : β) => ∃ (x : α), r x y

theorem codom_inv {α : Type u_1} {β : Type u_2} (r : rel α β) : codom (inv r) = dom r :=
  set.ext fun (x : α) => iff.refl (x ∈ codom (inv r))

theorem dom_inv {α : Type u_1} {β : Type u_2} (r : rel α β) : dom (inv r) = codom r :=
  set.ext fun (x : β) => iff.refl (x ∈ dom (inv r))

/-- Composition of relation; note that it follows the `category_theory/` order of arguments. -/
def comp {α : Type u_1} {β : Type u_2} {γ : Type u_3} (r : rel α β) (s : rel β γ) : rel α γ :=
  fun (x : α) (z : γ) => ∃ (y : β), r x y ∧ s y z

theorem comp_assoc {α : Type u_1} {β : Type u_2} {γ : Type u_3} {δ : Type u_4} (r : rel α β)
    (s : rel β γ) (t : rel γ δ) : comp (comp r s) t = comp r (comp s t) :=
  sorry

@[simp] theorem comp_right_id {α : Type u_1} {β : Type u_2} (r : rel α β) : comp r Eq = r := sorry

@[simp] theorem comp_left_id {α : Type u_1} {β : Type u_2} (r : rel α β) : comp Eq r = r := sorry

theorem inv_id {α : Type u_1} : inv Eq = Eq :=
  funext fun (x : α) => funext fun (y : α) => propext { mp := Eq.symm, mpr := Eq.symm }

theorem inv_comp {α : Type u_1} {β : Type u_2} {γ : Type u_3} (r : rel α β) (s : rel β γ) :
    inv (comp r s) = comp (inv s) (inv r) :=
  sorry

/-- Image of a set under a relation -/
def image {α : Type u_1} {β : Type u_2} (r : rel α β) (s : set α) : set β :=
  set_of fun (y : β) => ∃ (x : α), ∃ (H : x ∈ s), r x y

theorem mem_image {α : Type u_1} {β : Type u_2} (r : rel α β) (y : β) (s : set α) :
    y ∈ image r s ↔ ∃ (x : α), ∃ (H : x ∈ s), r x y :=
  iff.rfl

theorem image_subset {α : Type u_1} {β : Type u_2} (r : rel α β) :
    relator.lift_fun has_subset.subset has_subset.subset (image r) (image r) :=
  sorry

theorem image_mono {α : Type u_1} {β : Type u_2} (r : rel α β) : monotone (image r) :=
  image_subset r

theorem image_inter {α : Type u_1} {β : Type u_2} (r : rel α β) (s : set α) (t : set α) :
    image r (s ∩ t) ⊆ image r s ∩ image r t :=
  monotone.map_inf_le (image_mono r) s t

theorem image_union {α : Type u_1} {β : Type u_2} (r : rel α β) (s : set α) (t : set α) :
    image r (s ∪ t) = image r s ∪ image r t :=
  sorry

@[simp] theorem image_id {α : Type u_1} (s : set α) : image Eq s = s := sorry

theorem image_comp {α : Type u_1} {β : Type u_2} {γ : Type u_3} (r : rel α β) (s : rel β γ)
    (t : set α) : image (comp r s) t = image s (image r t) :=
  sorry

theorem image_univ {α : Type u_1} {β : Type u_2} (r : rel α β) : image r set.univ = codom r := sorry

/-- Preimage of a set under a relation `r`. Same as the image of `s` under `r.inv` -/
def preimage {α : Type u_1} {β : Type u_2} (r : rel α β) (s : set β) : set α := image (inv r) s

theorem mem_preimage {α : Type u_1} {β : Type u_2} (r : rel α β) (x : α) (s : set β) :
    x ∈ preimage r s ↔ ∃ (y : β), ∃ (H : y ∈ s), r x y :=
  iff.rfl

theorem preimage_def {α : Type u_1} {β : Type u_2} (r : rel α β) (s : set β) :
    preimage r s = set_of fun (x : α) => ∃ (y : β), ∃ (H : y ∈ s), r x y :=
  set.ext fun (x : α) => mem_preimage r x s

theorem preimage_mono {α : Type u_1} {β : Type u_2} (r : rel α β) {s : set β} {t : set β}
    (h : s ⊆ t) : preimage r s ⊆ preimage r t :=
  image_mono (inv r) h

theorem preimage_inter {α : Type u_1} {β : Type u_2} (r : rel α β) (s : set β) (t : set β) :
    preimage r (s ∩ t) ⊆ preimage r s ∩ preimage r t :=
  image_inter (inv r) s t

theorem preimage_union {α : Type u_1} {β : Type u_2} (r : rel α β) (s : set β) (t : set β) :
    preimage r (s ∪ t) = preimage r s ∪ preimage r t :=
  image_union (inv r) s t

theorem preimage_id {α : Type u_1} (s : set α) : preimage Eq s = s := sorry

theorem preimage_comp {α : Type u_1} {β : Type u_2} {γ : Type u_3} (r : rel α β) (s : rel β γ)
    (t : set γ) : preimage (comp r s) t = preimage r (preimage s t) :=
  sorry

theorem preimage_univ {α : Type u_1} {β : Type u_2} (r : rel α β) : preimage r set.univ = dom r :=
  eq.mpr
    (id (Eq._oldrec (Eq.refl (preimage r set.univ = dom r)) (preimage.equations._eqn_1 r set.univ)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (image (inv r) set.univ = dom r)) (image_univ (inv r))))
      (eq.mpr (id (Eq._oldrec (Eq.refl (codom (inv r) = dom r)) (codom_inv r))) (Eq.refl (dom r))))

/-- Core of a set `s : set β` w.r.t `r : rel α β` is the set of `x : α` that are related *only*
to elements of `s`. -/
def core {α : Type u_1} {β : Type u_2} (r : rel α β) (s : set β) : set α :=
  set_of fun (x : α) => ∀ (y : β), r x y → y ∈ s

theorem mem_core {α : Type u_1} {β : Type u_2} (r : rel α β) (x : α) (s : set β) :
    x ∈ core r s ↔ ∀ (y : β), r x y → y ∈ s :=
  iff.rfl

theorem core_subset {α : Type u_1} {β : Type u_2} (r : rel α β) :
    relator.lift_fun has_subset.subset has_subset.subset (core r) (core r) :=
  fun (s t : set β) (h : s ⊆ t) (x : α) (h' : x ∈ core r s) (y : β) (rxy : r x y) => h (h' y rxy)

theorem core_mono {α : Type u_1} {β : Type u_2} (r : rel α β) : monotone (core r) := core_subset r

theorem core_inter {α : Type u_1} {β : Type u_2} (r : rel α β) (s : set β) (t : set β) :
    core r (s ∩ t) = core r s ∩ core r t :=
  sorry

theorem core_union {α : Type u_1} {β : Type u_2} (r : rel α β) (s : set β) (t : set β) :
    core r s ∪ core r t ⊆ core r (s ∪ t) :=
  monotone.le_map_sup (core_mono r) s t

@[simp] theorem core_univ {α : Type u_1} {β : Type u_2} (r : rel α β) :
    core r set.univ = set.univ :=
  sorry

theorem core_id {α : Type u_1} (s : set α) : core Eq s = s := sorry

theorem core_comp {α : Type u_1} {β : Type u_2} {γ : Type u_3} (r : rel α β) (s : rel β γ)
    (t : set γ) : core (comp r s) t = core r (core s t) :=
  sorry

/-- Restrict the domain of a relation to a subtype. -/
def restrict_domain {α : Type u_1} {β : Type u_2} (r : rel α β) (s : set α) :
    rel (Subtype fun (x : α) => x ∈ s) β :=
  fun (x : Subtype fun (x : α) => x ∈ s) (y : β) => r (subtype.val x) y

theorem image_subset_iff {α : Type u_1} {β : Type u_2} (r : rel α β) (s : set α) (t : set β) :
    image r s ⊆ t ↔ s ⊆ core r t :=
  sorry

theorem core_preimage_gc {α : Type u_1} {β : Type u_2} (r : rel α β) :
    galois_connection (image r) (core r) :=
  image_subset_iff r

end rel

namespace function

/-- The graph of a function as a relation. -/
def graph {α : Type u_1} {β : Type u_2} (f : α → β) : rel α β := fun (x : α) (y : β) => f x = y

end function

namespace set

-- TODO: if image were defined with bounded quantification in corelib, the next two would

-- be definitional

theorem image_eq {α : Type u_1} {β : Type u_2} (f : α → β) (s : set α) :
    f '' s = rel.image (function.graph f) s :=
  sorry

theorem preimage_eq {α : Type u_1} {β : Type u_2} (f : α → β) (s : set β) :
    f ⁻¹' s = rel.preimage (function.graph f) s :=
  sorry

theorem preimage_eq_core {α : Type u_1} {β : Type u_2} (f : α → β) (s : set β) :
    f ⁻¹' s = rel.core (function.graph f) s :=
  sorry

end Mathlib


/-
Copyright (c) 2021 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import data.vector.basic
import data.list.zip

/-!
# The `zip_with` operation on vectors.
-/

namespace vector

section zip_with

variables {α β γ : Type*} {n : ℕ} (f : α → β → γ)

/-- Apply the function `f : α → β → γ` to each corresponding pair of elements from two vectors. -/
def zip_with : vector α n → vector β n → vector γ n :=
λ x y, ⟨list.zip_with f x.1 y.1, by simp⟩

@[simp]
lemma zip_with_to_list (x : vector α n) (y : vector β n) :
  (vector.zip_with f x y).to_list = list.zip_with f x.to_list y.to_list :=
rfl

@[simp]
lemma zip_with_nth (x : vector α n) (y : vector β n) (i) :
  (vector.zip_with f x y).nth i = f (x.nth i) (y.nth i) :=
begin
  dsimp only [vector.zip_with, vector.nth],
  cases x, cases y,
  simp only [list.nth_le_zip_with, subtype.coe_mk],
  congr,
end

@[simp]

@[to_additive]
lemma prod_mul_prod_eq_prod_zip_with [comm_monoid α] (x y : vector α n) :
  x.to_list.prod * y.to_list.prod = (vector.zip_with (*) x y).to_list.prod :=
list.prod_mul_prod_eq_prod_zip_with_of_length_eq x.to_list y.to_list
  ((to_list_length x).trans (to_list_length y).symm)

end zip_with

end vector


/-
Copyright (c) 2019 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 algebra.order.archimedean
import order.filter.at_top_bot

/-!
# `at_top` filter and archimedean (semi)rings/fields

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

In this file we prove that for a linear ordered archimedean semiring `R` and a function `f : α → ℕ`,
the function `coe ∘ f : α → R` tends to `at_top` along a filter `l` if and only if so does `f`.
We also prove that `coe : ℕ → R` tends to `at_top` along `at_top`, as well as version of these
two results for `ℤ` (and a ring `R`) and `ℚ` (and a field `R`).
-/

variables {α R : Type*}

open filter set

@[simp] lemma nat.comap_coe_at_top [strict_ordered_semiring R] [archimedean R] :
  comap (coe : ℕ → R) at_top = at_top :=
comap_embedding_at_top (λ _ _, nat.cast_le) exists_nat_ge

lemma tendsto_coe_nat_at_top_iff [strict_ordered_semiring R] [archimedean R]
  {f : α → ℕ} {l : filter α} :
  tendsto (λ n, (f n : R)) l at_top ↔ tendsto f l at_top :=
tendsto_at_top_embedding (assume a₁ a₂, nat.cast_le) exists_nat_ge

lemma tendsto_coe_nat_at_top_at_top [strict_ordered_semiring R] [archimedean R] :
  tendsto (coe : ℕ → R) at_top at_top :=
nat.mono_cast.tendsto_at_top_at_top exists_nat_ge

@[simp] lemma int.comap_coe_at_top [strict_ordered_ring R] [archimedean R] :
  comap (coe : ℤ → R) at_top = at_top :=
comap_embedding_at_top (λ _ _, int.cast_le) $ λ r,
  let ⟨n, hn⟩ := exists_nat_ge r in ⟨n, by exact_mod_cast hn⟩

@[simp] lemma int.comap_coe_at_bot [strict_ordered_ring R] [archimedean R] :
  comap (coe : ℤ → R) at_bot = at_bot :=
comap_embedding_at_bot (λ _ _, int.cast_le) $ λ r,
  let ⟨n, hn⟩ := exists_nat_ge (-r) in ⟨-n, by simpa [neg_le] using hn⟩

lemma tendsto_coe_int_at_top_iff [strict_ordered_ring R] [archimedean R]
  {f : α → ℤ} {l : filter α} :
  tendsto (λ n, (f n : R)) l at_top ↔ tendsto f l at_top :=
by rw [← tendsto_comap_iff, int.comap_coe_at_top]

lemma tendsto_coe_int_at_bot_iff [strict_ordered_ring R] [archimedean R]
  {f : α → ℤ} {l : filter α} :
  tendsto (λ n, (f n : R)) l at_bot ↔ tendsto f l at_bot :=
by rw [← tendsto_comap_iff, int.comap_coe_at_bot]

lemma tendsto_coe_int_at_top_at_top [strict_ordered_ring R] [archimedean R] :
  tendsto (coe : ℤ → R) at_top at_top :=
int.cast_mono.tendsto_at_top_at_top $ λ b,
  let ⟨n, hn⟩ := exists_nat_ge b in ⟨n, by exact_mod_cast hn⟩

@[simp] lemma rat.comap_coe_at_top [linear_ordered_field R] [archimedean R] :
  comap (coe : ℚ → R) at_top = at_top :=
comap_embedding_at_top (λ _ _, rat.cast_le) $ λ r, let ⟨n, hn⟩ := exists_nat_ge r in ⟨n, by simpa⟩

@[simp] lemma rat.comap_coe_at_bot [linear_ordered_field R] [archimedean R] :
  comap (coe : ℚ → R) at_bot = at_bot :=
comap_embedding_at_bot (λ _ _, rat.cast_le) $ λ r, let ⟨n, hn⟩ := exists_nat_ge (-r)
  in ⟨-n, by simpa [neg_le]⟩

lemma tendsto_coe_rat_at_top_iff [linear_ordered_field R] [archimedean R]
  {f : α → ℚ} {l : filter α} :
  tendsto (λ n, (f n : R)) l at_top ↔ tendsto f l at_top :=
by rw [← tendsto_comap_iff, rat.comap_coe_at_top]

lemma tendsto_coe_rat_at_bot_iff [linear_ordered_field R] [archimedean R]
  {f : α → ℚ} {l : filter α} :
  tendsto (λ n, (f n : R)) l at_bot ↔ tendsto f l at_bot :=
by rw [← tendsto_comap_iff, rat.comap_coe_at_bot]

lemma at_top_countable_basis_of_archimedean [linear_ordered_semiring R] [archimedean R] :
  (at_top : filter R).has_countable_basis (λ n : ℕ, true) (λ n, Ici n) :=
{ countable := to_countable _,
  to_has_basis := at_top_basis.to_has_basis
    (λ x hx, let ⟨n, hn⟩ := exists_nat_ge x in ⟨n, trivial, Ici_subset_Ici.2 hn⟩)
    (λ n hn, ⟨n, trivial, subset.rfl⟩) }

lemma at_bot_countable_basis_of_archimedean [linear_ordered_ring R] [archimedean R] :
  (at_bot : filter R).has_countable_basis (λ m : ℤ, true) (λ m, Iic m) :=
{ countable := to_countable _,
  to_has_basis := at_bot_basis.to_has_basis
    (λ x hx, let ⟨m, hm⟩ := exists_int_lt x in ⟨m, trivial, Iic_subset_Iic.2 hm.le⟩)
    (λ m hm, ⟨m, trivial, subset.rfl⟩) }

@[priority 100]
instance at_top_countably_generated_of_archimedean [linear_ordered_semiring R] [archimedean R] :
  (at_top : filter R).is_countably_generated :=
at_top_countable_basis_of_archimedean.is_countably_generated

@[priority 100]
instance at_bot_countably_generated_of_archimedean [linear_ordered_ring R] [archimedean R] :
  (at_bot : filter R).is_countably_generated :=
at_bot_countable_basis_of_archimedean.is_countably_generated

namespace filter

variables {l : filter α} {f : α → R} {r : R}

section linear_ordered_semiring

variables [linear_ordered_semiring R] [archimedean R]

/-- If a function tends to infinity along a filter, then this function multiplied by a positive
constant (on the left) also tends to infinity. The archimedean assumption is convenient to get a
statement that works on `ℕ`, `ℤ` and `ℝ`, although not necessary (a version in ordered fields is
given in `filter.tendsto.const_mul_at_top`). -/
lemma tendsto.const_mul_at_top' (hr : 0 < r) (hf : tendsto f l at_top) :
  tendsto (λx, r * f x) l at_top :=
begin
  apply tendsto_at_top.2 (λb, _),
  obtain ⟨n : ℕ, hn : 1 ≤ n • r⟩ := archimedean.arch 1 hr,
  rw nsmul_eq_mul' at hn,
  filter_upwards [tendsto_at_top.1 hf (n * max b 0)] with x hx,
  calc b ≤ 1 * max b 0 : by { rw [one_mul], exact le_max_left _ _ }
  ... ≤ (r * n) * max b 0 : mul_le_mul_of_nonneg_right hn (le_max_right _ _)
  ... = r * (n * max b 0) : by rw [mul_assoc]
  ... ≤ r * f x : mul_le_mul_of_nonneg_left hx (le_of_lt hr)
end

/-- If a function tends to infinity along a filter, then this function multiplied by a positive
constant (on the right) also tends to infinity. The archimedean assumption is convenient to get a
statement that works on `ℕ`, `ℤ` and `ℝ`, although not necessary (a version in ordered fields is
given in `filter.tendsto.at_top_mul_const`). -/
lemma tendsto.at_top_mul_const' (hr : 0 < r) (hf : tendsto f l at_top) :
  tendsto (λx, f x * r) l at_top :=
begin
  apply tendsto_at_top.2 (λb, _),
  obtain ⟨n : ℕ, hn : 1 ≤ n • r⟩ := archimedean.arch 1 hr,
  have hn' : 1 ≤ (n : R) * r, by rwa nsmul_eq_mul at hn,
  filter_upwards [tendsto_at_top.1 hf (max b 0 * n)] with x hx,
  calc b ≤ max b 0 * 1 : by { rw [mul_one], exact le_max_left _ _ }
  ... ≤ max b 0 * (n * r) : mul_le_mul_of_nonneg_left hn' (le_max_right _ _)
  ... = (max b 0 * n) * r : by rw [mul_assoc]
  ... ≤ f x * r : mul_le_mul_of_nonneg_right hx (le_of_lt hr)
end

end linear_ordered_semiring

section linear_ordered_ring

variables [linear_ordered_ring R] [archimedean R]

/-- See also `filter.tendsto.at_top_mul_neg_const` for a version of this lemma for
`linear_ordered_field`s which does not require the `archimedean` assumption. -/
lemma tendsto.at_top_mul_neg_const' (hr : r < 0) (hf : tendsto f l at_top) :
  tendsto (λx, f x * r) l at_bot :=
by simpa only [tendsto_neg_at_top_iff, mul_neg] using hf.at_top_mul_const' (neg_pos.mpr hr)

/-- See also `filter.tendsto.at_bot_mul_const` for a version of this lemma for
`linear_ordered_field`s which does not require the `archimedean` assumption. -/
lemma tendsto.at_bot_mul_const' (hr : 0 < r) (hf : tendsto f l at_bot) :
  tendsto (λx, f x * r) l at_bot :=
begin
  simp only [← tendsto_neg_at_top_iff, ← neg_mul] at hf ⊢,
  exact hf.at_top_mul_const' hr
end

/-- See also `filter.tendsto.at_bot_mul_neg_const` for a version of this lemma for
`linear_ordered_field`s which does not require the `archimedean` assumption. -/
lemma tendsto.at_bot_mul_neg_const' (hr : r < 0) (hf : tendsto f l at_bot) :
  tendsto (λx, f x * r) l at_top :=
by simpa only [mul_neg, tendsto_neg_at_bot_iff] using hf.at_bot_mul_const' (neg_pos.2 hr)

end linear_ordered_ring

section linear_ordered_cancel_add_comm_monoid

variables [linear_ordered_cancel_add_comm_monoid R] [archimedean R]

lemma tendsto.at_top_nsmul_const {f : α → ℕ} (hr : 0 < r) (hf : tendsto f l at_top) :
  tendsto (λ x, f x • r) l at_top :=
begin
  refine tendsto_at_top.mpr (λ s, _),
  obtain ⟨n : ℕ, hn : s ≤ n • r⟩ := archimedean.arch s hr,
  exact (tendsto_at_top.mp hf n).mono (λ a ha, hn.trans (nsmul_le_nsmul hr.le ha)),
end

end linear_ordered_cancel_add_comm_monoid

section linear_ordered_add_comm_group

variables [linear_ordered_add_comm_group R] [archimedean R]

lemma tendsto.at_top_nsmul_neg_const {f : α → ℕ} (hr : r < 0) (hf : tendsto f l at_top) :
  tendsto (λ x, f x • r) l at_bot :=
by simpa using hf.at_top_nsmul_const (neg_pos.2 hr)

lemma tendsto.at_top_zsmul_const {f : α → ℤ} (hr : 0 < r) (hf : tendsto f l at_top) :
  tendsto (λ x, f x • r) l at_top :=
begin
  refine tendsto_at_top.mpr (λ s, _),
  obtain ⟨n : ℕ, hn : s ≤ n • r⟩ := archimedean.arch s hr,
  replace hn : s ≤ (n : ℤ) • r, { simpa, },
  exact (tendsto_at_top.mp hf n).mono (λ a ha, hn.trans (zsmul_le_zsmul hr.le ha)),
end

lemma tendsto.at_top_zsmul_neg_const {f : α → ℤ} (hr : r < 0) (hf : tendsto f l at_top) :
  tendsto (λ x, f x • r) l at_bot :=
by simpa using hf.at_top_zsmul_const (neg_pos.2 hr)

lemma tendsto.at_bot_zsmul_const {f : α → ℤ} (hr : 0 < r) (hf : tendsto f l at_bot) :
  tendsto (λ x, f x • r) l at_bot :=
begin
  simp only [← tendsto_neg_at_top_iff, ← neg_zsmul] at hf ⊢,
  exact hf.at_top_zsmul_const hr
end

lemma tendsto.at_bot_zsmul_neg_const {f : α → ℤ} (hr : r < 0) (hf : tendsto f l at_bot) :
  tendsto (λ x, f x • r) l at_top :=
by simpa using hf.at_bot_zsmul_const (neg_pos.2 hr)

end linear_ordered_add_comm_group

end filter