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

import topology.algebra.valuation
import topology.algebra.with_zero_topology
import topology.algebra.uniform_field

/-!
# Valued fields and their completions

In this file we study the topology of a field `K` endowed with a valuation (in our application
to adic spaces, `K` will be the valuation field associated to some valuation on a ring, defined in
valuation.basic).

We already know from valuation.topology that one can build a topology on `K` which
makes it a topological ring.

The first goal is to show `K` is a topological *field*, ie inversion is continuous
at every non-zero element.

The next goal is to prove `K` is a *completable* topological field. This gives us
a completion `hat K` which is a topological field. We also prove that `K` is automatically
separated, so the map from `K` to `hat K` is injective.

Then we extend the valuation given on `K` to a valuation on `hat K`.
-/

open filter set
open_locale topological_space

section division_ring

variables {K : Type*} [division_ring K] {Γ₀ : Type*} [linear_ordered_comm_group_with_zero Γ₀]

section valuation_topological_division_ring

section inversion_estimate
variables (v : valuation K Γ₀)

-- The following is the main technical lemma ensuring that inversion is continuous
-- in the topology induced by a valuation on a division ring (ie the next instance)
-- and the fact that a valued field is completable
-- [BouAC, VI.5.1 Lemme 1]
lemma valuation.inversion_estimate {x y : K} {γ : Γ₀ˣ} (y_ne : y ≠ 0)
  (h : v (x - y) < min (γ * ((v y) * (v y))) (v y)) :
  v (x⁻¹ - y⁻¹) < γ :=
begin
  have hyp1 : v (x - y) < γ * ((v y) * (v y)),
    from lt_of_lt_of_le h (min_le_left _ _),
  have hyp1' : v (x - y) * ((v y) * (v y))⁻¹ < γ,
    from mul_inv_lt_of_lt_mul₀ hyp1,
  have hyp2 : v (x - y) < v y,
    from lt_of_lt_of_le h (min_le_right _ _),
  have key : v x = v y, from valuation.map_eq_of_sub_lt v hyp2,
  have x_ne : x ≠ 0,
  { intro h,
    apply y_ne,
    rw [h, v.map_zero] at key,
    exact v.zero_iff.1 key.symm },
  have decomp : x⁻¹ - y⁻¹ = x⁻¹ * (y - x) * y⁻¹,
  by rw [mul_sub_left_distrib, sub_mul, mul_assoc,
        show y * y⁻¹ = 1, from mul_inv_cancel y_ne,
        show x⁻¹ * x = 1, from inv_mul_cancel x_ne, mul_one, one_mul],
  calc
    v (x⁻¹ - y⁻¹) = v (x⁻¹ * (y - x) * y⁻¹) : by rw decomp
    ... = (v x⁻¹) * (v $ y - x) * (v y⁻¹) : by repeat { rw valuation.map_mul }
    ... = (v x)⁻¹ * (v $ y - x) * (v y)⁻¹ : by rw [v.map_inv, v.map_inv]
    ... = (v $ y - x) * ((v y) * (v y))⁻¹ : by
      { rw [mul_assoc, mul_comm, key, mul_assoc, mul_inv_rev] }
    ... = (v $ y - x) * ((v y) * (v y))⁻¹ : rfl
    ... = (v $ x - y) * ((v y) * (v y))⁻¹ : by rw valuation.map_sub_swap
    ... < γ : hyp1',
end
end inversion_estimate

open valued

/-- The topology coming from a valuation on a division ring makes it a topological division ring
    [BouAC, VI.5.1 middle of Proposition 1] -/
@[priority 100]
instance valued.topological_division_ring [valued K Γ₀] : topological_division_ring K :=
{ continuous_at_inv₀ :=
    begin
      intros x x_ne s s_in,
      cases valued.mem_nhds.mp s_in with γ hs, clear s_in,
      rw [mem_map, valued.mem_nhds],
      change ∃ (γ : Γ₀ˣ), {y : K | (v (y - x) : Γ₀) < γ} ⊆ {x : K | x⁻¹ ∈ s},
      have vx_ne := (valuation.ne_zero_iff $ v).mpr x_ne,
      let γ' := units.mk0 _ vx_ne,
      use min (γ * (γ'*γ')) γ',
      intros y y_in,
      apply hs,
      simp only [mem_set_of_eq] at y_in,
      rw [units.min_coe, units.coe_mul, units.coe_mul] at y_in,
      exact valuation.inversion_estimate _ x_ne y_in
    end,
  ..(by apply_instance : topological_ring K) }

/-- A valued division ring is separated. -/
@[priority 100]
instance valued_ring.separated [valued K Γ₀] : separated_space K :=
begin
  rw separated_iff_t2,
  apply topological_add_group.t2_space_of_zero_sep,
  intros x x_ne,
  refine ⟨{k | v k < v x}, _, λ h, lt_irrefl _ h⟩,
  rw valued.mem_nhds,
  have vx_ne := (valuation.ne_zero_iff $ v).mpr x_ne,
  let γ' := units.mk0 _ vx_ne,
  exact ⟨γ', λ y hy, by simpa using hy⟩,
end

section
local attribute [instance] linear_ordered_comm_group_with_zero.topological_space

open valued

lemma valued.continuous_valuation [valued K Γ₀] : continuous (v : K → Γ₀) :=
begin
  rw continuous_iff_continuous_at,
  intro x,
  classical,
  by_cases h : x = 0,
  { rw h,
    change tendsto _ _ (𝓝 (v (0 : K))),
    erw valuation.map_zero,
    rw linear_ordered_comm_group_with_zero.tendsto_zero,
    intro γ,
    rw valued.mem_nhds_zero,
    use [γ, set.subset.refl _] },
  { change tendsto _ _ _,
    have v_ne : (v x : Γ₀) ≠ 0, from (valuation.ne_zero_iff _).mpr h,
    rw linear_ordered_comm_group_with_zero.tendsto_of_ne_zero v_ne,
    apply valued.loc_const v_ne },
end
end

end valuation_topological_division_ring

end division_ring

namespace valued
open uniform_space

variables {K : Type*} [field K] {Γ₀ : Type*} [linear_ordered_comm_group_with_zero Γ₀]
  [hv: valued K Γ₀]

include hv

local notation `hat ` := completion

/-- A valued field is completable. -/
@[priority 100]
instance completable : completable_top_field K :=
{ nice := begin
    rintros F hF h0,
    have : ∃ (γ₀ : Γ₀ˣ) (M ∈ F), ∀ x ∈ M, (γ₀ : Γ₀) ≤ v x,
    { rcases filter.inf_eq_bot_iff.mp h0 with ⟨U, U_in, M, M_in, H⟩,
      rcases valued.mem_nhds_zero.mp U_in with ⟨γ₀, hU⟩,
      existsi [γ₀, M, M_in],
      intros x xM,
      apply le_of_not_lt _,
      intro hyp,
      have : x ∈ U ∩ M := ⟨hU hyp, xM⟩,
      rwa H at this },
    rcases this with ⟨γ₀, M₀, M₀_in, H₀⟩,
    rw valued.cauchy_iff at hF ⊢,
    refine ⟨hF.1.map _, _⟩,
    replace hF := hF.2,
    intros γ,
    rcases hF (min (γ * γ₀ * γ₀) γ₀) with ⟨M₁, M₁_in, H₁⟩, clear hF,
    use (λ x : K, x⁻¹) '' (M₀ ∩ M₁),
    split,
    { rw mem_map,
      apply mem_of_superset (filter.inter_mem M₀_in M₁_in),
      exact subset_preimage_image _ _ },
    { rintros _ ⟨x, ⟨x_in₀, x_in₁⟩, rfl⟩ _ ⟨y, ⟨y_in₀, y_in₁⟩, rfl⟩,
      simp only [mem_set_of_eq],
      specialize H₁ x x_in₁ y y_in₁,
      replace x_in₀ := H₀ x x_in₀,
      replace y_in₀ := H₀ y y_in₀, clear H₀,
      apply valuation.inversion_estimate,
      { have : (v x : Γ₀) ≠ 0,
        { intro h, rw h at x_in₀, simpa using x_in₀, },
        exact (valuation.ne_zero_iff _).mp this },
      { refine lt_of_lt_of_le H₁ _,
        rw units.min_coe,
        apply min_le_min _ x_in₀,
        rw mul_assoc,
        have : ((γ₀ * γ₀ : Γ₀ˣ) : Γ₀) ≤ v x * v x,
          from calc ↑γ₀ * ↑γ₀ ≤ ↑γ₀ * v x : mul_le_mul_left' x_in₀ ↑γ₀
                          ... ≤ _ : mul_le_mul_right' x_in₀ (v x),
        rw units.coe_mul,
        exact mul_le_mul_left' this γ } }
  end,
  ..valued_ring.separated }

local attribute [instance] linear_ordered_comm_group_with_zero.topological_space

/-- The extension of the valuation of a valued field to the completion of the field. -/
noncomputable def extension : hat K → Γ₀ :=
completion.dense_inducing_coe.extend (v : K → Γ₀)

lemma continuous_extension : continuous (valued.extension : hat K → Γ₀) :=
 begin
  refine completion.dense_inducing_coe.continuous_extend _,
  intro x₀,
  by_cases h : x₀ = coe 0,
  { refine ⟨0, _⟩,
    erw [h, ← completion.dense_inducing_coe.to_inducing.nhds_eq_comap]; try { apply_instance },
    rw linear_ordered_comm_group_with_zero.tendsto_zero,
    intro γ₀,
    rw valued.mem_nhds,
    exact ⟨γ₀, by simp⟩ },
  { have preimage_one : v ⁻¹' {(1 : Γ₀)} ∈ 𝓝 (1 : K),
    { have : (v (1 : K) : Γ₀) ≠ 0, { rw valuation.map_one, exact zero_ne_one.symm },
      convert valued.loc_const this,
      ext x,
      rw [valuation.map_one, mem_preimage, mem_singleton_iff, mem_set_of_eq] },
    obtain ⟨V, V_in, hV⟩ : ∃ V ∈ 𝓝 (1 : hat K), ∀ x : K, (x : hat K) ∈ V → (v x : Γ₀) = 1,
    { rwa [completion.dense_inducing_coe.nhds_eq_comap, mem_comap] at preimage_one },

    have : ∃ V' ∈ (𝓝 (1 : hat K)), (0 : hat K) ∉ V' ∧ ∀ x y ∈ V', x*y⁻¹ ∈ V,
    { have : tendsto (λ p : hat K × hat K, p.1*p.2⁻¹) ((𝓝 1).prod (𝓝 1)) (𝓝 1),
      { rw ← nhds_prod_eq,
        conv {congr, skip, skip, rw ← (one_mul (1 : hat K))},
        refine tendsto.mul continuous_fst.continuous_at
                           (tendsto.comp _ continuous_snd.continuous_at),
        convert continuous_at_inv₀ (zero_ne_one.symm : 1 ≠ (0 : hat K)),
        exact inv_one.symm },
      rcases tendsto_prod_self_iff.mp this V V_in with ⟨U, U_in, hU⟩,
      let hatKstar := ({0}ᶜ : set $ hat K),
      have : hatKstar ∈ 𝓝 (1 : hat K),
      from compl_singleton_mem_nhds zero_ne_one.symm,
      use  [U ∩ hatKstar, filter.inter_mem U_in this],
      split,
      { rintro ⟨h, h'⟩,
        rw mem_compl_singleton_iff at h',
        exact h' rfl },
      { rintros x ⟨hx, _⟩ y ⟨hy, _⟩,
        apply hU ; assumption } },
    rcases this with ⟨V', V'_in, zeroV', hV'⟩,
    have nhds_right : (λ x, x*x₀) '' V' ∈ 𝓝 x₀,
    { have l : function.left_inverse (λ x : hat K, x * x₀⁻¹) (λ x : hat K, x * x₀),
      { intro x,
        simp only [mul_assoc, mul_inv_cancel h, mul_one] },
      have r: function.right_inverse (λ x : hat K, x * x₀⁻¹) (λ x : hat K, x * x₀),
      { intro x,
        simp only [mul_assoc, inv_mul_cancel h, mul_one] },
      have c : continuous  (λ x : hat K, x * x₀⁻¹),
        from continuous_id.mul continuous_const,
      rw image_eq_preimage_of_inverse l r,
      rw ← mul_inv_cancel h at V'_in,
      exact c.continuous_at V'_in },
    have : ∃ (z₀ : K) (y₀ ∈ V'), coe z₀ = y₀*x₀ ∧ z₀ ≠ 0,
    { rcases completion.dense_range_coe.mem_nhds nhds_right with ⟨z₀, y₀, y₀_in, H : y₀ * x₀ = z₀⟩,
      refine ⟨z₀, y₀, y₀_in, ⟨H.symm, _⟩⟩,
      rintro rfl,
      exact mul_ne_zero (ne_of_mem_of_not_mem y₀_in zeroV') h H },
    rcases this with ⟨z₀, y₀, y₀_in, hz₀, z₀_ne⟩,
    have vz₀_ne: (v z₀ : Γ₀) ≠ 0 := by rwa valuation.ne_zero_iff,
    refine ⟨v z₀, _⟩,
    rw [linear_ordered_comm_group_with_zero.tendsto_of_ne_zero vz₀_ne, mem_comap],
    use [(λ x, x*x₀) '' V', nhds_right],
    intros x x_in,
    rcases mem_preimage.1 x_in with ⟨y, y_in, hy⟩, clear x_in,
    change y*x₀ = coe x at hy,
    have : (v (x*z₀⁻¹) : Γ₀) = 1,
    { apply hV,
      have : ((z₀⁻¹ : K) : hat K) = z₀⁻¹,
      from ring_hom.map_inv (completion.coe_ring_hom : K →+* hat K) z₀,
      rw [completion.coe_mul, this, ← hy, hz₀, mul_inv, mul_comm y₀⁻¹, ← mul_assoc, mul_assoc y,
          mul_inv_cancel h, mul_one],
      solve_by_elim },
    calc v x = v (x*z₀⁻¹*z₀) : by rw [mul_assoc, inv_mul_cancel z₀_ne, mul_one]
         ... = v (x*z₀⁻¹)*v z₀ : valuation.map_mul _ _ _
         ... = v z₀ : by rw [this, one_mul]  },
end

@[simp, norm_cast]
lemma extension_extends (x : K) : extension (x : hat K) = v x :=
begin
  haveI : t2_space Γ₀ := regular_space.t2_space _,
  refine completion.dense_inducing_coe.extend_eq_of_tendsto _,
  rw ← completion.dense_inducing_coe.nhds_eq_comap,
  exact valued.continuous_valuation.continuous_at,
end

/-- the extension of a valuation on a division ring to its completion. -/
noncomputable def extension_valuation :
  valuation (hat K) Γ₀ :=
{ to_fun := valued.extension,
  map_zero' := by { rw [← v.map_zero, ← valued.extension_extends (0 : K)], refl, },
  map_one' := by { rw [← completion.coe_one, valued.extension_extends (1 : K)],
                   exact valuation.map_one _ },
  map_mul' := λ x y, begin
    apply completion.induction_on₂ x y,
    { have c1 : continuous (λ (x : hat K × hat K), valued.extension (x.1 * x.2)),
        from valued.continuous_extension.comp (continuous_fst.mul continuous_snd),

      have c2 : continuous (λ (x : hat K × hat K), valued.extension x.1 * valued.extension x.2),
        from (valued.continuous_extension.comp continuous_fst).mul
              (valued.continuous_extension.comp continuous_snd),
      exact is_closed_eq c1 c2 },
    { intros x y,
      norm_cast,
      exact valuation.map_mul _ _ _ },
  end,
  map_add_le_max' := λ x y, begin
    rw le_max_iff,
    apply completion.induction_on₂ x y,
    { have cont : continuous (valued.extension : hat K → Γ₀) := valued.continuous_extension,
      exact  (is_closed_le (cont.comp continuous_add) $ cont.comp continuous_fst).union
        (is_closed_le (cont.comp continuous_add) $ cont.comp continuous_snd) },
    { intros x y,
      dsimp,
      norm_cast,
      rw ← le_max_iff,
      exact v.map_add x y, },
  end }

-- Bourbaki CA VI §5 no.3 Proposition 5 (d)
lemma closure_coe_completion_v_lt {γ : Γ₀ˣ} :
  closure (coe '' { x : K | v x < (γ : Γ₀) }) = { x : hat K | extension_valuation x < (γ : Γ₀) } :=
begin
  ext x,
  let γ₀ := extension_valuation x,
  suffices : γ₀ ≠ 0 → (x ∈ closure (coe '' { x : K | v x < (γ : Γ₀) }) ↔ γ₀ < (γ : Γ₀)),
  { cases eq_or_ne γ₀ 0,
    { simp only [h, (valuation.zero_iff _).mp h, mem_set_of_eq, valuation.map_zero, units.zero_lt,
        iff_true],
      apply subset_closure,
      exact ⟨0, by simpa only [mem_set_of_eq, valuation.map_zero, units.zero_lt, true_and]⟩, },
    { exact this h, }, },
  intros h,
  have hγ₀ : extension ⁻¹' {γ₀} ∈ 𝓝 x := continuous_extension.continuous_at.preimage_mem_nhds
    (linear_ordered_comm_group_with_zero.singleton_mem_nhds_of_ne_zero h),
  rw mem_closure_iff_nhds',
  refine ⟨λ hx, _, λ hx s hs, _⟩,
  { obtain ⟨⟨-, y, hy₁ : v y < (γ : Γ₀), rfl⟩, hy₂⟩ := hx _ hγ₀,
    replace hy₂ : v y = γ₀, { simpa using hy₂, },
    rwa ← hy₂, },
  { obtain ⟨y, hy₁, hy₂ : ↑y ∈ s⟩ := completion.dense_range_coe.mem_nhds (inter_mem hγ₀ hs),
    replace hy₁ : v y = γ₀, { simpa using hy₁, },
    rw ← hy₁ at hx,
    exact ⟨⟨y, ⟨y, hx, rfl⟩⟩, hy₂⟩, },
end

noncomputable instance valued_completion : valued (hat K) Γ₀ :=
{ v := extension_valuation,
  is_topological_valuation := λ s,
  begin
    suffices : has_basis (𝓝 (0 : hat K)) (λ _, true) (λ γ : Γ₀ˣ, { x | extension_valuation x < γ }),
    { rw this.mem_iff,
      exact exists_congr (λ γ, by simp), },
    simp_rw ← closure_coe_completion_v_lt,
    exact (has_basis_nhds_zero K Γ₀).has_basis_of_dense_inducing completion.dense_inducing_coe,
  end }

end valued


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Chris Hughes, Mario Carneiro, Yury Kudryashov
-/
import data.int.cast.prod
import algebra.group.prod
import algebra.ring.equiv
import algebra.order.monoid.prod

/-!
# Semiring, ring etc structures on `R × S`

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

In this file we define two-binop (`semiring`, `ring` etc) structures on `R × S`. We also prove
trivial `simp` lemmas, and define the following operations on `ring_hom`s and similarly for
`non_unital_ring_hom`s:

* `fst R S : R × S →+* R`, `snd R S : R × S →+* S`: projections `prod.fst` and `prod.snd`
  as `ring_hom`s;
* `f.prod g : `R →+* S × T`: sends `x` to `(f x, g x)`;
* `f.prod_map g : `R × S → R' × S'`: `prod.map f g` as a `ring_hom`,
  sends `(x, y)` to `(f x, g y)`.
-/

variables {α β R R' S S' T T' : Type*}

namespace prod

/-- Product of two distributive types is distributive. -/
instance [distrib R] [distrib S] : distrib (R × S) :=
{ left_distrib := λ a b c, mk.inj_iff.mpr ⟨left_distrib _ _ _, left_distrib _ _ _⟩,
  right_distrib := λ a b c, mk.inj_iff.mpr ⟨right_distrib _ _ _, right_distrib _ _ _⟩,
  .. prod.has_add, .. prod.has_mul }

/-- Product of two `non_unital_non_assoc_semiring`s is a `non_unital_non_assoc_semiring`. -/
instance [non_unital_non_assoc_semiring R] [non_unital_non_assoc_semiring S] :
  non_unital_non_assoc_semiring (R × S) :=
{ .. prod.add_comm_monoid, .. prod.mul_zero_class, .. prod.distrib }

/-- Product of two `non_unital_semiring`s is a `non_unital_semiring`. -/
instance [non_unital_semiring R] [non_unital_semiring S] :
  non_unital_semiring (R × S) :=
{ .. prod.non_unital_non_assoc_semiring, .. prod.semigroup }

/-- Product of two `non_assoc_semiring`s is a `non_assoc_semiring`. -/
instance [non_assoc_semiring R] [non_assoc_semiring S] :
  non_assoc_semiring (R × S) :=
{ .. prod.non_unital_non_assoc_semiring, .. prod.mul_one_class, .. prod.add_monoid_with_one }

/-- Product of two semirings is a semiring. -/
instance [semiring R] [semiring S] : semiring (R × S) :=
{ .. prod.add_comm_monoid, .. prod.monoid_with_zero, .. prod.distrib, .. prod.add_monoid_with_one }

/-- Product of two `non_unital_comm_semiring`s is a `non_unital_comm_semiring`. -/
instance [non_unital_comm_semiring R] [non_unital_comm_semiring S] :
  non_unital_comm_semiring (R × S) :=
{ .. prod.non_unital_semiring, .. prod.comm_semigroup }

/-- Product of two commutative semirings is a commutative semiring. -/
instance [comm_semiring R] [comm_semiring S] : comm_semiring (R × S) :=
{ .. prod.semiring, .. prod.comm_monoid }

instance [non_unital_non_assoc_ring R] [non_unital_non_assoc_ring S] :
  non_unital_non_assoc_ring (R × S) :=
{ .. prod.add_comm_group, .. prod.non_unital_non_assoc_semiring }

instance [non_unital_ring R] [non_unital_ring S] :
  non_unital_ring (R × S) :=
{ .. prod.add_comm_group, .. prod.non_unital_semiring }

instance [non_assoc_ring R] [non_assoc_ring S] :
  non_assoc_ring (R × S) :=
{ .. prod.add_comm_group, .. prod.non_assoc_semiring, .. prod.add_group_with_one }

/-- Product of two rings is a ring. -/
instance [ring R] [ring S] : ring (R × S) :=
{ .. prod.add_comm_group, .. prod.add_group_with_one, .. prod.semiring }

/-- Product of two `non_unital_comm_ring`s is a `non_unital_comm_ring`. -/
instance [non_unital_comm_ring R] [non_unital_comm_ring S] : non_unital_comm_ring (R × S) :=
{ .. prod.non_unital_ring, .. prod.comm_semigroup }

/-- Product of two commutative rings is a commutative ring. -/
instance [comm_ring R] [comm_ring S] : comm_ring (R × S) :=
{ .. prod.ring, .. prod.comm_monoid }

end prod

namespace non_unital_ring_hom

variables (R S) [non_unital_non_assoc_semiring R] [non_unital_non_assoc_semiring S]

/-- Given non-unital semirings `R`, `S`, the natural projection homomorphism from `R × S` to `R`.-/
def fst : R × S →ₙ+* R := { to_fun := prod.fst, .. mul_hom.fst R S, .. add_monoid_hom.fst R S }

/-- Given non-unital semirings `R`, `S`, the natural projection homomorphism from `R × S` to `S`.-/
def snd : R × S →ₙ+* S := { to_fun := prod.snd, .. mul_hom.snd R S, .. add_monoid_hom.snd R S }

variables {R S}

@[simp]

section prod

variables [non_unital_non_assoc_semiring T] (f : R →ₙ+* S) (g : R →ₙ+* T)

/-- Combine two non-unital ring homomorphisms `f : R →ₙ+* S`, `g : R →ₙ+* T` into
`f.prod g : R →ₙ+* S × T` given by `(f.prod g) x = (f x, g x)` -/
protected def prod (f : R →ₙ+* S) (g : R →ₙ+* T) : R →ₙ+* S × T :=
{ to_fun := λ x, (f x, g x),
  .. mul_hom.prod (f : mul_hom R S) (g : mul_hom R T),
  .. add_monoid_hom.prod (f : R →+ S) (g : R →+ T) }

@[simp] lemma prod_apply (x) : f.prod g x = (f x, g x) := rfl

@[simp] lemma fst_comp_prod : (fst S T).comp (f.prod g) = f :=
ext $ λ x, rfl

@[simp] lemma snd_comp_prod : (snd S T).comp (f.prod g) = g :=
ext $ λ x, rfl

lemma prod_unique (f : R →ₙ+* S × T) :
  ((fst S T).comp f).prod ((snd S T).comp f) = f :=
ext $ λ x, by simp only [prod_apply, coe_fst, coe_snd, comp_apply, prod.mk.eta]

end prod

section prod_map

variables [non_unital_non_assoc_semiring R'] [non_unital_non_assoc_semiring S']
  [non_unital_non_assoc_semiring T]
variables (f : R →ₙ+* R') (g : S →ₙ+* S')

/-- `prod.map` as a `non_unital_ring_hom`. -/
def prod_map : R × S →ₙ+* R' × S' := (f.comp (fst R S)).prod (g.comp (snd R S))

lemma prod_map_def : prod_map f g = (f.comp (fst R S)).prod (g.comp (snd R S)) := rfl

@[simp]
lemma coe_prod_map : ⇑(prod_map f g) = prod.map f g := rfl

lemma prod_comp_prod_map (f : T →ₙ+* R) (g : T →ₙ+* S) (f' : R →ₙ+* R') (g' : S →ₙ+* S') :
  (f'.prod_map g').comp (f.prod g) = (f'.comp f).prod (g'.comp g) :=
rfl

end prod_map

end non_unital_ring_hom

namespace ring_hom

variables (R S) [non_assoc_semiring R] [non_assoc_semiring S]

/-- Given semirings `R`, `S`, the natural projection homomorphism from `R × S` to `R`.-/
def fst : R × S →+* R := { to_fun := prod.fst, .. monoid_hom.fst R S, .. add_monoid_hom.fst R S }

/-- Given semirings `R`, `S`, the natural projection homomorphism from `R × S` to `S`.-/
def snd : R × S →+* S := { to_fun := prod.snd, .. monoid_hom.snd R S, .. add_monoid_hom.snd R S }

variables {R S}

@[simp] lemma coe_fst : ⇑(fst R S) = prod.fst := rfl
@[simp] lemma coe_snd : ⇑(snd R S) = prod.snd := rfl

section prod

variables [non_assoc_semiring T] (f : R →+* S) (g : R →+* T)

/-- Combine two ring homomorphisms `f : R →+* S`, `g : R →+* T` into `f.prod g : R →+* S × T`
given by `(f.prod g) x = (f x, g x)` -/
protected def prod (f : R →+* S) (g : R →+* T) : R →+* S × T :=
{ to_fun := λ x, (f x, g x),
  .. monoid_hom.prod (f : R →* S) (g : R →* T), .. add_monoid_hom.prod (f : R →+ S) (g : R →+ T) }

@[simp] lemma prod_apply (x) : f.prod g x = (f x, g x) := rfl

@[simp] lemma fst_comp_prod : (fst S T).comp (f.prod g) = f :=
ext $ λ x, rfl

@[simp] lemma snd_comp_prod : (snd S T).comp (f.prod g) = g :=
ext $ λ x, rfl

lemma prod_unique (f : R →+* S × T) :
  ((fst S T).comp f).prod ((snd S T).comp f) = f :=
ext $ λ x, by simp only [prod_apply, coe_fst, coe_snd, comp_apply, prod.mk.eta]

end prod

section prod_map

variables [non_assoc_semiring R'] [non_assoc_semiring S'] [non_assoc_semiring T]
variables (f : R →+* R') (g : S →+* S')

/-- `prod.map` as a `ring_hom`. -/
def prod_map : R × S →+* R' × S' := (f.comp (fst R S)).prod (g.comp (snd R S))

lemma prod_map_def : prod_map f g = (f.comp (fst R S)).prod (g.comp (snd R S)) := rfl

@[simp]
lemma coe_prod_map : ⇑(prod_map f g) = prod.map f g := rfl

lemma prod_comp_prod_map (f : T →+* R) (g : T →+* S) (f' : R →+* R') (g' : S →+* S') :
  (f'.prod_map g').comp (f.prod g) = (f'.comp f).prod (g'.comp g) :=
rfl

end prod_map

end ring_hom

namespace ring_equiv
variables {R S} [non_assoc_semiring R] [non_assoc_semiring S]

/-- Swapping components as an equivalence of (semi)rings. -/
def prod_comm : R × S ≃+* S × R :=
{ ..add_equiv.prod_comm, ..mul_equiv.prod_comm }

@[simp] lemma coe_prod_comm : ⇑(prod_comm : R × S ≃+* S × R) = prod.swap := rfl
@[simp] lemma coe_prod_comm_symm : ⇑((prod_comm : R × S ≃+* S × R).symm) = prod.swap := rfl

@[simp] lemma fst_comp_coe_prod_comm :
  (ring_hom.fst S R).comp ↑(prod_comm : R × S ≃+* S × R) = ring_hom.snd R S :=
ring_hom.ext $ λ _, rfl

@[simp] lemma snd_comp_coe_prod_comm :
  (ring_hom.snd S R).comp ↑(prod_comm : R × S ≃+* S × R) = ring_hom.fst R S :=
ring_hom.ext $ λ _, rfl

variables (R S) [subsingleton S]

/-- A ring `R` is isomorphic to `R × S` when `S` is the zero ring -/
@[simps] def prod_zero_ring : R ≃+* R × S :=
{ to_fun := λ x, (x, 0),
  inv_fun := prod.fst,
  map_add' := by simp,
  map_mul' := by simp,
  left_inv := λ x, rfl,
  right_inv := λ x, by cases x; simp }

/-- A ring `R` is isomorphic to `S × R` when `S` is the zero ring -/
@[simps] def zero_ring_prod : R ≃+* S × R :=
{ to_fun := λ x, (0, x),
  inv_fun := prod.snd,
  map_add' := by simp,
  map_mul' := by simp,
  left_inv := λ x, rfl,
  right_inv := λ x, by cases x; simp }

end ring_equiv

/-- The product of two nontrivial rings is not a domain -/
lemma false_of_nontrivial_of_product_domain (R S : Type*) [ring R] [ring S]
  [is_domain (R × S)] [nontrivial R] [nontrivial S] : false :=
begin
  have := no_zero_divisors.eq_zero_or_eq_zero_of_mul_eq_zero
    (show ((0 : R), (1 : S)) * (1, 0) = 0, by simp),
  rw [prod.mk_eq_zero,prod.mk_eq_zero] at this,
  rcases this with (⟨_,h⟩|⟨h,_⟩),
  { exact zero_ne_one h.symm },
  { exact zero_ne_one h.symm }
end

/-! ### Order -/

instance [ordered_semiring α] [ordered_semiring β] : ordered_semiring (α × β) :=
{ add_le_add_left := λ _ _, add_le_add_left,
  zero_le_one := ⟨zero_le_one, zero_le_one⟩,
  mul_le_mul_of_nonneg_left := λ a b c hab hc,
    ⟨mul_le_mul_of_nonneg_left hab.1 hc.1, mul_le_mul_of_nonneg_left hab.2 hc.2⟩,
  mul_le_mul_of_nonneg_right := λ a b c hab hc,
    ⟨mul_le_mul_of_nonneg_right hab.1 hc.1, mul_le_mul_of_nonneg_right hab.2 hc.2⟩,
  ..prod.semiring, ..prod.partial_order _ _ }

instance [ordered_comm_semiring α] [ordered_comm_semiring β] : ordered_comm_semiring (α × β) :=
{ ..prod.comm_semiring, ..prod.ordered_semiring }

instance [ordered_ring α] [ordered_ring β] : ordered_ring (α × β) :=
{ mul_nonneg := λ a b ha hb, ⟨mul_nonneg ha.1 hb.1, mul_nonneg ha.2 hb.2⟩,
  ..prod.ring, ..prod.ordered_semiring }

instance [ordered_comm_ring α] [ordered_comm_ring β] : ordered_comm_ring (α × β) :=
{ ..prod.comm_ring, ..prod.ordered_ring }


/-
Copyright (c) 2019 Neil Strickland. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Neil Strickland, Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.group.semiconj
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Commuting pairs of elements in monoids

We define the predicate `commute a b := a * b = b * a` and provide some operations on terms `(h :
commute a b)`. E.g., if `a`, `b`, and c are elements of a semiring, and that `hb : commute a b` and
`hc : commute a c`.  Then `hb.pow_left 5` proves `commute (a ^ 5) b` and `(hb.pow_right 2).add_right
(hb.mul_right hc)` proves `commute a (b ^ 2 + b * c)`.

Lean does not immediately recognise these terms as equations, so for rewriting we need syntax like
`rw [(hb.pow_left 5).eq]` rather than just `rw [hb.pow_left 5]`.

This file defines only a few operations (`mul_left`, `inv_right`, etc).  Other operations
(`pow_right`, field inverse etc) are in the files that define corresponding notions.

## Implementation details

Most of the proofs come from the properties of `semiconj_by`.
-/

/-- Two elements commute if `a * b = b * a`. -/
def commute {S : Type u_1} [Mul S] (a : S) (b : S) := semiconj_by a b b

namespace commute

/-- Equality behind `commute a b`; useful for rewriting. -/
protected theorem Mathlib.add_commute.eq {S : Type u_1} [Add S] {a : S} {b : S}
    (h : add_commute a b) : a + b = b + a :=
  h

/-- Any element commutes with itself. -/
@[simp] protected theorem refl {S : Type u_1} [Mul S] (a : S) : commute a a := Eq.refl (a * a)

/-- If `a` commutes with `b`, then `b` commutes with `a`. -/
protected theorem Mathlib.add_commute.symm {S : Type u_1} [Add S] {a : S} {b : S}
    (h : add_commute a b) : add_commute b a :=
  Eq.symm h

protected theorem Mathlib.add_commute.symm_iff {S : Type u_1} [Add S] {a : S} {b : S} :
    add_commute a b ↔ add_commute b a :=
  { mp := add_commute.symm, mpr := add_commute.symm }

/-- If `a` commutes with both `b` and `c`, then it commutes with their product. -/
@[simp] theorem mul_right {S : Type u_1} [semigroup S] {a : S} {b : S} {c : S} (hab : commute a b)
    (hac : commute a c) : commute a (b * c) :=
  semiconj_by.mul_right hab hac

/-- If both `a` and `b` commute with `c`, then their product commutes with `c`. -/
@[simp] theorem Mathlib.add_commute.add_left {S : Type u_1} [add_semigroup S] {a : S} {b : S}
    {c : S} (hac : add_commute a c) (hbc : add_commute b c) : add_commute (a + b) c :=
  add_semiconj_by.add_left hac hbc

protected theorem Mathlib.add_commute.right_comm {S : Type u_1} [add_semigroup S] {b : S} {c : S}
    (h : add_commute b c) (a : S) : a + b + c = a + c + b :=
  sorry

protected theorem left_comm {S : Type u_1} [semigroup S] {a : S} {b : S} (h : commute a b) (c : S) :
    a * (b * c) = b * (a * c) :=
  sorry

protected theorem Mathlib.add_commute.all {S : Type u_1} [add_comm_semigroup S] (a : S) (b : S) :
    add_commute a b :=
  add_comm a b

@[simp] theorem one_right {M : Type u_1} [monoid M] (a : M) : commute a 1 := semiconj_by.one_right a

@[simp] theorem Mathlib.add_commute.zero_left {M : Type u_1} [add_monoid M] (a : M) :
    add_commute 0 a :=
  add_semiconj_by.zero_left a

theorem Mathlib.add_commute.units_neg_right {M : Type u_1} [add_monoid M] {a : M}
    {u : add_units M} : add_commute a ↑u → add_commute a ↑(-u) :=
  add_semiconj_by.units_neg_right

@[simp] theorem Mathlib.add_commute.units_neg_right_iff {M : Type u_1} [add_monoid M] {a : M}
    {u : add_units M} : add_commute a ↑(-u) ↔ add_commute a ↑u :=
  add_semiconj_by.units_neg_right_iff

theorem Mathlib.add_commute.units_neg_left {M : Type u_1} [add_monoid M] {u : add_units M} {a : M} :
    add_commute (↑u) a → add_commute (↑(-u)) a :=
  add_semiconj_by.units_neg_symm_left

@[simp] theorem Mathlib.add_commute.units_neg_left_iff {M : Type u_1} [add_monoid M]
    {u : add_units M} {a : M} : add_commute (↑(-u)) a ↔ add_commute (↑u) a :=
  add_semiconj_by.units_neg_symm_left_iff

theorem Mathlib.add_commute.units_coe {M : Type u_1} [add_monoid M] {u₁ : add_units M}
    {u₂ : add_units M} : add_commute u₁ u₂ → add_commute ↑u₁ ↑u₂ :=
  add_semiconj_by.units_coe

theorem Mathlib.add_commute.units_of_coe {M : Type u_1} [add_monoid M] {u₁ : add_units M}
    {u₂ : add_units M} : add_commute ↑u₁ ↑u₂ → add_commute u₁ u₂ :=
  add_semiconj_by.units_of_coe

@[simp] theorem units_coe_iff {M : Type u_1} [monoid M] {u₁ : units M} {u₂ : units M} :
    commute ↑u₁ ↑u₂ ↔ commute u₁ u₂ :=
  semiconj_by.units_coe_iff

theorem Mathlib.add_commute.neg_right {G : Type u_1} [add_group G] {a : G} {b : G} :
    add_commute a b → add_commute a (-b) :=
  add_semiconj_by.neg_right

@[simp] theorem Mathlib.add_commute.neg_right_iff {G : Type u_1} [add_group G] {a : G} {b : G} :
    add_commute a (-b) ↔ add_commute a b :=
  add_semiconj_by.neg_right_iff

theorem inv_left {G : Type u_1} [group G] {a : G} {b : G} : commute a b → commute (a⁻¹) b :=
  semiconj_by.inv_symm_left

@[simp] theorem inv_left_iff {G : Type u_1} [group G] {a : G} {b : G} :
    commute (a⁻¹) b ↔ commute a b :=
  semiconj_by.inv_symm_left_iff

theorem Mathlib.add_commute.neg_neg {G : Type u_1} [add_group G] {a : G} {b : G} :
    add_commute a b → add_commute (-a) (-b) :=
  add_semiconj_by.neg_neg_symm

@[simp] theorem inv_inv_iff {G : Type u_1} [group G] {a : G} {b : G} :
    commute (a⁻¹) (b⁻¹) ↔ commute a b :=
  semiconj_by.inv_inv_symm_iff

protected theorem Mathlib.add_commute.neg_add_cancel {G : Type u_1} [add_group G] {a : G} {b : G}
    (h : add_commute a b) : -a + b + a = b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (-a + b + a = b)) (add_commute.eq (add_commute.neg_left h))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (b + -a + a = b)) (neg_add_cancel_right b a))) (Eq.refl b))

theorem inv_mul_cancel_assoc {G : Type u_1} [group G] {a : G} {b : G} (h : commute a b) :
    a⁻¹ * (b * a) = b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a⁻¹ * (b * a) = b)) (Eq.symm (mul_assoc (a⁻¹) b a))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a⁻¹ * b * a = b)) (commute.inv_mul_cancel h))) (Eq.refl b))

protected theorem mul_inv_cancel {G : Type u_1} [group G] {a : G} {b : G} (h : commute a b) :
    a * b * (a⁻¹) = b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a * b * (a⁻¹) = b)) (commute.eq h)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (b * a * (a⁻¹) = b)) (mul_inv_cancel_right b a))) (Eq.refl b))

theorem mul_inv_cancel_assoc {G : Type u_1} [group G] {a : G} {b : G} (h : commute a b) :
    a * (b * (a⁻¹)) = b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a * (b * (a⁻¹)) = b)) (Eq.symm (mul_assoc a b (a⁻¹)))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * b * (a⁻¹) = b)) (commute.mul_inv_cancel h))) (Eq.refl b))

end commute

@[simp] theorem mul_inv_cancel_comm {G : Type u_1} [comm_group G] (a : G) (b : G) :
    a * b * (a⁻¹) = b :=
  commute.mul_inv_cancel (commute.all a b)

@[simp] theorem add_neg_cancel_comm_assoc {G : Type u_1} [add_comm_group G] (a : G) (b : G) :
    a + (b + -a) = b :=
  add_commute.add_neg_cancel_assoc (add_commute.all a b)

@[simp] theorem inv_mul_cancel_comm {G : Type u_1} [comm_group G] (a : G) (b : G) :
    a⁻¹ * b * a = b :=
  commute.inv_mul_cancel (commute.all a b)

@[simp] theorem inv_mul_cancel_comm_assoc {G : Type u_1} [comm_group G] (a : G) (b : G) :
    a⁻¹ * (b * a) = b :=
  commute.inv_mul_cancel_assoc (commute.all a b)

end Mathlib


import .finite

inductive {u} set.acc {α : Type u} (r : α → α → Prop) (S : set α)
  : α → Prop
| intro (x : α) (h : ∀ y ∈ S, r y x → set.acc y) : set.acc x

lemma {u} set_acc_of_set_acc_minus {α : Type u} (r : α → α → Prop) (S S' : set α)
  (r_trans : ∀ x y z, r x y → r y z → r x z)
  : ∀ y ∈ S, (∀ y' ∈ S', ¬ r y' y) → (S ∖ S').acc r y → S.acc r y :=
begin
  intros y hy h hacc,
  induction hacc with y h ih, constructor,
  intros y' hy' hr,
  have : y' ∉ S' := λ h', h y' h' hr,
  apply ih, constructor; assumption,
  assumption, assumption,
  intros y'' h'' h''', apply h y'' h'',
  apply r_trans; assumption,
end

lemma partial_order.finite_well_founded
  {X : Type _} [partial_order X] (is_fin : finite X)
  : well_founded (@partial_order.lt X _) :=
begin
  constructor,
  suffices : ∀ x : X, x ∈ @set.univ X → set.acc partial_order.lt (@set.univ X) x,
  { intro x, apply @set.acc.rec_on X (<) set.univ (acc (<)),
    { apply this, constructor },
    { clear x, intros, constructor,
       intros y hy, exact ih y true.intro hy } },
  have : set.finite (@set.univ X),
  { cases is_fin with size h, existsi size,
    cases h with f h, cases h with f_i f_s,
    existsi f, constructor, assumption,
    funext, apply propext, transitivity true,
    refl, rw true_iff, exact f_s a },
  cases this with size h,
  generalize q : set.univ = S, rw q at h, clear q,
  revert S h, induction size with n ih;
  intros; cases h with f h; cases h with f_i f_s,
  { rw f_s at a, exfalso, cases a, exact a_w.elim0 },
  constructor, intros,
  have : y ∈ { y ∈ S | y ≠ x } := ⟨H, ne_of_lt a_1⟩,
  cases ih { y ∈ S | y ≠ x } _ y this,
  { apply set_acc_of_set_acc_minus (<) S {x} (@lt_trans X _) _ H;
    rw elem_singleton,
    { intros y' h', rw (_ : y' = x),
      apply lt_asymm, assumption, assumption },
    { constructor, intros y' h' hlt, apply h; assumption } },
  { rw f_s at a, cases a,
    existsi fin.fun_omit a_w.val f, constructor,
    apply omit_inj_if_fun_inj _ _ f_i,
    rw [im_omit _ _ _ f_i, elem_singleton, f_s],
    rw a_h, refl }
end

theorem partial_order.induction {X : Type _} [partial_order X]
  (P : X → Prop) (is_fin : finite X)
  (ih : ∀ x , (∀ y, y < x → P y) → P x)
  : ∀ x, P x :=
  λ x, well_founded.induction (partial_order.finite_well_founded is_fin) x ih

def minimal {X : Type _} [partial_order X] (P : X → Prop)
  := λ x : X, P x ∧ ∀ y, y < x → ¬ P y

theorem partial_order.ex_min {X : Type _} [partial_order X]
  (is_fin : finite X) (P : X → Prop)
  : ∀ x, P x → ∃ y, minimal P y ∧ y ≤ x :=
begin
  apply partial_order.induction (λ x, P x → ∃ y, minimal P y ∧ y ≤ x) is_fin,
  intros x ih hp,
  cases classical.em (minimal P x),
  { existsi x, constructor, assumption, refl },
  { dsimp [minimal] at h,
    rw @decidable.not_and_iff_or_not _ _
      (classical.prop_decidable _) (classical.prop_decidable _) at h,
    have h := or.resolve_left h,
    rw ← classical.dne (P x) at h, specialize h hp,
    cases classical.exists_of_not_forall h with y hy,
    simp at hy,
    rw classical.implies_iff_or at hy,
    rw not_or_iff_and_not at hy,
    rw ← classical.dne (y < x) at hy,
    rw ← classical.dne (P y) at hy,
    cases ih y hy.left hy.right,
    cases h_1, existsi w, constructor,
    assumption, transitivity, assumption,
    apply le_of_lt, exact hy.left }
end


import dimension_theory.artinian
import dimension_theory.height

variables {R : Type*} [comm_ring R] (I : ideal R)

lemma ideal.is_maximal_iff_forall_is_prime {I : ideal R} :
 I.is_maximal ↔ I ≠ ⊤ ∧ ∀ J, ideal.is_prime J → I ≤ J → I = J :=
begin
  refine ⟨λ H, ⟨H.ne_top,λ J hJ e, H.eq_of_le hJ.ne_top e⟩, λ H, _⟩,
  obtain ⟨m, hm, hm'⟩ := ideal.exists_le_maximal _ H.1,
  rwa H.2 m hm.is_prime hm',
end

lemma set.chain_height_le_one_iff {α : Type*} [preorder α] {s : set α} :
  s.chain_height ≤ 1 ↔ is_antichain (<) s :=
begin
  split,
  { intros H x hx y hy e₁ e₂,
    suffices : ↑2 ≤ s.chain_height,
    { exact one_lt_two.not_le (with_top.coe_le_coe.mp $ this.trans H) },
    refine set.le_chain_height_iff.mpr ⟨[x, y], ⟨_, _⟩, rfl⟩; simp [hx, hy, e₂] },
  { intro H,
    rw [set.chain_height, supr₂_le_iff],
    rintros (_|⟨x, _|⟨y, l⟩⟩) ⟨_|⟨h₁, h₂⟩, h₃⟩; simp only [list.length, enat.coe_zero, zero_le,
      implies_true_iff, list.length_singleton, enat.coe_one, le_refl],
    refine (H (h₃ x _) (h₃ y _) h₁.ne h₁).elim; simp }
end

lemma set.chain_height_eq_one_iff {α : Type*} [preorder α] {s : set α} :
  s.chain_height = 1 ↔ s.nonempty ∧ is_antichain (<) s :=
by rw [le_antisymm_iff, set.chain_height_le_one_iff, set.one_le_chain_height_iff, and_comm]

lemma krull_dimension_eq_zero_iff [nontrivial R] :
  krull_dimension R = 0 ↔ (∀ (I : ideal R), I.is_prime → I.is_maximal) :=
begin
  rw [← nonpos_iff_eq_zero, ← with_top.add_le_add_iff_right (@with_top.one_ne_top ℕ _),
    zero_add, krull_dimension_succ, set.chain_height_le_one_iff],
  refine forall₂_congr (λ I hI, (ideal.is_maximal_iff_forall_is_prime.trans
    ((and_iff_right hI.ne_top).trans $ forall₂_congr $ λ J hJ, ⟨_, _⟩)).symm),
  { exact λ H e e', e (H e'.le) },
  { exact λ H e, not_not.mp (λ e', H e' (e.lt_of_ne e')) }
end

lemma is_artinian_ring_iff_krull_dimension_eq_zero [is_noetherian_ring R] [nontrivial R] :
  is_artinian_ring R ↔ krull_dimension R = 0 :=
begin
  rw [is_artinian_ring_iff_is_noetherian_ring, and_iff_right ‹is_noetherian_ring R›,
    krull_dimension_eq_zero_iff],
end

lemma is_localization.is_noetherian_ring (I : ideal R) [I.is_prime] (A : Type*) [comm_ring A]
  [algebra R A] [is_localization.at_prime A I] [hR : is_noetherian_ring R] :
  is_noetherian_ring A :=
begin
  rw [is_noetherian_ring_iff, is_noetherian_iff_well_founded] at hR ⊢,
  exact order_embedding.well_founded (is_localization.order_embedding I.prime_compl A).dual hR
end

instance (I : ideal R) [I.is_prime] [is_noetherian_ring R] :
  is_noetherian_ring (localization.at_prime I) :=
is_localization.is_noetherian_ring I _

lemma is_artinian_ring.eq_maximal_ideal_of_is_prime [is_artinian_ring R] [local_ring R]
  (I : ideal R) [I.is_prime] : I = local_ring.maximal_ideal R :=
local_ring.eq_maximal_ideal (((is_artinian_ring_iff_is_noetherian_ring R).mp ‹_›).2 _ ‹_›)

lemma is_artinian_ring.radical_eq_maximal_ideal [is_artinian_ring R] [local_ring R]
  (I : ideal R) (hI : I ≠ ⊤) : I.radical = local_ring.maximal_ideal R :=
begin
  rw ideal.radical_eq_Inf,
  refine (Inf_le _).antisymm (le_Inf _),
  { exact ⟨local_ring.le_maximal_ideal hI, infer_instance⟩ },
  { rintros J ⟨h₁, h₂⟩, exactI (is_artinian_ring.eq_maximal_ideal_of_is_prime J).ge }
end

lemma ideal.is_prime.pow_le_iff {J : ideal R} (hJ : J.is_prime) {n : ℕ} (hn : n ≠ 0) :
  I ^ n ≤ J ↔ I ≤ J :=
⟨λ H x hx, hJ.mem_of_pow_mem n (H (ideal.pow_mem_pow hx n)), (ideal.pow_le_self hn).trans⟩

lemma is_artinian_ring_iff_is_nilpotent_maximal_ideal [is_noetherian_ring R] [local_ring R] :
  is_artinian_ring R ↔ is_nilpotent (local_ring.maximal_ideal R) :=
begin
  split,
  { introI h,
    rw ← is_artinian_ring.radical_eq_maximal_ideal (⊥ : ideal R) bot_ne_top,
    exact is_artinian_ring.is_nilpotent_nilradical R },
  { rintro ⟨n, hn⟩,
    rcases eq_or_ne n 0 with (rfl|hn'),
    { rw pow_zero at hn, exact (one_ne_zero hn).elim },
    rw is_artinian_ring_iff_is_noetherian_ring,
    refine ⟨‹_›, λ I hI, _⟩,
    suffices : local_ring.maximal_ideal R ≤ I,
    { rw ← (local_ring.maximal_ideal.is_maximal R).eq_of_le hI.ne_top this, apply_instance },
    rw [← hI.pow_le_iff (local_ring.maximal_ideal R) hn', hn],
    exact bot_le }
end

lemma ideal.exists_pow_le_of_fg {R : Type*} [comm_semiring R] (I J : ideal R) (h : I.fg)
  (h' : I ≤ J.radical) :
  ∃ n : ℕ, I ^ n ≤ J :=
begin
  revert h',
  refine submodule.fg_induction _ _ (λ I, I ≤ J.radical → ∃ n : ℕ, I ^ n ≤ J) _ _ _ h,
  { intros x hx, obtain ⟨n, hn⟩ := hx (ideal.subset_span (set.mem_singleton x)),
    exact ⟨n, by rwa [← ideal.span, ideal.span_singleton_pow, ideal.span_le, set.singleton_subset_iff]⟩ },
  { intros J K hJ hK hJK,
    obtain ⟨n, hn⟩ := hJ (λ x hx, hJK $ ideal.mem_sup_left hx),
    obtain ⟨m, hm⟩ := hK (λ x hx, hJK $ ideal.mem_sup_right hx),
    use n + m,
    rw [← ideal.add_eq_sup, add_pow, ideal.sum_eq_sup, finset.sup_le_iff],
    refine λ i hi, ideal.mul_le_right.trans _,
    obtain h | h := le_or_lt n i,
    { exact ideal.mul_le_right.trans ((ideal.pow_le_pow h).trans hn) },
    { refine ideal.mul_le_left.trans ((ideal.pow_le_pow _).trans hm),
      rw [add_comm, nat.add_sub_assoc h.le], apply nat.le_add_right } },
end

lemma ideal.is_nilpotent_iff_le_nilradical {I : ideal R} (hI : I.fg) :
  is_nilpotent I ↔ I ≤ nilradical R :=
⟨λ ⟨n, hn⟩ x hx, ⟨n, hn ▸ ideal.pow_mem_pow hx n⟩,
  λ h, ⟨_, le_bot_iff.mp (ideal.exists_pow_le_of_fg _ _ hI h).some_spec⟩⟩

namespace submodule

open ideal

variables {M : Type*} [add_comm_group M] [module R M]

/-- *Nakayama's Lemma** - A slightly more general version of (4) in
[Stacks 00DV](https://stacks.math.columbia.edu/tag/00DV).
See also `smul_sup_eq_of_le_smul_of_le_jacobson_bot` for the special case when `J = ⊥`.  -/
lemma smul_sup_eq_smul_sup_of_le_smul_of_le_jacobson' {I J : ideal R}
  {N N' : submodule R M} (hN' : N'.fg) (hIJ : I ≤ jacobson J)
  (hNN : N' ≤ N ⊔ I • N') : N ⊔ N' = N ⊔ J • N' :=
begin
  replace hNN : N ⊔ N' ≤ N ⊔ I • N' := sup_le le_sup_left hNN,
  have hNN' : N ⊔ N' = N ⊔ I • N',
    from le_antisymm hNN
      (sup_le_sup_left (submodule.smul_le.2 (λ _ _ _, submodule.smul_mem _ _)) _),
  have h_comap := submodule.comap_injective_of_surjective (linear_map.range_eq_top.1 (N.range_mkq)),
  have : (I • N').map N.mkq = N'.map N.mkq,
  { rw ←h_comap.eq_iff,
    simpa [comap_map_eq, sup_comm, eq_comm] using hNN' },
  have := @submodule.eq_smul_of_le_smul_of_le_jacobson _ _ _ _ _ I J
    (N'.map N.mkq) (hN'.map _)
    (by rw [← map_smul'', this]; exact le_rfl)
    hIJ,
  rw [← map_smul'', ←h_comap.eq_iff, comap_map_eq, comap_map_eq, submodule.ker_mkq,
    sup_comm] at this,
  rw [this, sup_comm]
end

/-- *Nakayama's Lemma** - Statement (4) in
[Stacks 00DV](https://stacks.math.columbia.edu/tag/00DV).
See also `smul_sup_eq_smul_sup_of_le_smul_of_le_jacobson` for a generalisation
to the `jacobson` of any ideal -/
lemma smul_sup_le_of_le_smul_of_le_jacobson_bot' {I : ideal R}
  {N N' : submodule R M} (hN' : N'.fg) (hIJ : I ≤ jacobson ⊥)
  (hNN : N' ≤ N ⊔ I • N') : N' ≤ N :=
by rw [← sup_eq_left, smul_sup_eq_smul_sup_of_le_smul_of_le_jacobson' hN' hIJ hNN,
  bot_smul, sup_bot_eq]

end submodule

lemma with_top.lt_coe_iff_add_one_le {n : ℕ} {m : ℕ∞} :
  m < n ↔ m + 1 ≤ n :=
begin
  cases m; simp only [with_top.none_eq_top, with_top.some_eq_coe, ← with_top.coe_one,
    with_top.top_add, ← with_top.coe_add, with_top.coe_le_coe, with_top.coe_lt_coe,
    with_top.nat_ne_top, not_top_lt, top_le_iff, nat.lt_iff_add_one_le],
end

lemma ideal.height_le_iff {p : ideal R} {n : ℕ} [p.is_prime] :
  p.height ≤ n ↔ ∀ q : ideal R, q.is_prime → q < p → q.height < n :=
begin
  rw ideal.height_eq_prime_height,
  delta ideal.prime_height,
  rw [set.chain_height_eq_supr_Iic, supr₂_le_iff],
  simp only [set.mem_inter_iff, set.mem_set_of_eq, set.mem_Iio, and_imp],
  apply forall₃_congr,
  introsI q hq h,
  rw [with_top.lt_coe_iff_add_one_le, ideal.height_eq_prime_height, ideal.prime_height_succ,
    set.inter_assoc, set.inter_eq_right_iff_subset.mpr (set.Iic_subset_Iio.mpr h)]
end

lemma ideal.height_le_one_of_is_principal_of_mem_minimal_primes_of_local_ring [is_noetherian_ring R]
  [local_ring R] (I : ideal R) (hI : I.is_principal)
    (hp : (local_ring.maximal_ideal R) ∈ I.minimal_primes) :
    (local_ring.maximal_ideal R).height ≤ 1 :=
begin
  rw [← with_top.coe_one, ideal.height_le_iff],
  introsI q h₁ h₂,
  suffices : q.prime_height = 0, { rw [ideal.height_eq_prime_height, this], exact zero_lt_one },
  rw [← ideal.height_eq_prime_height,
    ← is_localization.at_prime.krull_dimension_eq_height q (localization.at_prime q),
    ← is_artinian_ring_iff_krull_dimension_eq_zero,
    is_artinian_ring_iff_is_nilpotent_maximal_ideal,
    ← localization.at_prime.map_eq_maximal_ideal],
  have hI : I ≠ ⊤ := (hp.1.2.trans_lt
    (lt_top_iff_ne_top.mpr (local_ring.maximal_ideal.is_maximal _).ne_top)).ne,
  haveI := ideal.quotient.nontrivial hI,
  haveI := local_ring.of_surjective' I^.quotient.mk ideal.quotient.mk_surjective,
  have : is_artinian_ring (R ⧸ I),
  { rw [is_artinian_ring_iff_is_nilpotent_maximal_ideal,
      ideal.is_nilpotent_iff_le_nilradical
      (is_noetherian.noetherian _)],
    refine (ideal.comap_le_comap_iff_of_surjective
      I^.quotient.mk ideal.quotient.mk_surjective _ _).mp _,
    rw [nilradical, ideal.comap_radical, ideal.zero_eq_bot, ← ring_hom.ker_eq_comap_bot,
      ideal.mk_ker, local_ring.eq_maximal_ideal (ideal.comap_is_maximal_of_surjective
      I^.quotient.mk ideal.quotient.mk_surjective), ideal.radical_eq_Inf, le_Inf_iff],
    any_goals { apply_instance },
    exact λ J ⟨hJ₁, hJ₂⟩, hp.2 ⟨hJ₂, hJ₁⟩ (local_ring.le_maximal_ideal hJ₂.ne_top) },
  let f := algebra_map R (localization.at_prime q),
  let qs : ℕ →o (ideal (R ⧸ I))ᵒᵈ :=
  { to_fun := λ n, ((q.map f ^ n).comap f).map I^.quotient.mk,
    monotone' := λ i j e, ideal.map_mono (ideal.comap_mono (ideal.pow_le_pow e)) },
  obtain ⟨n, hn⟩ := (@well_founded.monotone_chain_condition (order_dual _) _).mp this.1 qs,
  refine ⟨n, (_ : q.map f ^ n = 0)⟩,
  apply submodule.eq_bot_of_le_smul_of_le_jacobson_bot (q.map f) _ (is_noetherian.noetherian _),
  rotate,
  { rw [local_ring.jacobson_eq_maximal_ideal, localization.at_prime.map_eq_maximal_ideal],
    exacts [le_rfl, bot_ne_top] },
  { apply_instance },
  rw [smul_eq_mul, ← pow_succ,
    ← is_localization.map_comap q.prime_compl (localization.at_prime q) (q.map f ^ n),
    ← is_localization.map_comap q.prime_compl (localization.at_prime q) (q.map f ^ (n + 1))],
  apply ideal.map_mono,
  refine submodule.smul_sup_le_of_le_smul_of_le_jacobson_bot' (is_noetherian.noetherian _)
    (_ : I ≤ _) _,
  { rw local_ring.jacobson_eq_maximal_ideal, exacts [hp.1.2, bot_ne_top] },
  specialize hn _ n.le_succ,
  apply_fun ideal.comap I^.quotient.mk at hn,
  simp only [qs, order_hom.coe_fun_mk, ← ring_hom.ker_eq_comap_bot, ideal.mk_ker,
    ideal.comap_map_of_surjective I^.quotient.mk ideal.quotient.mk_surjective] at hn,
  intros x hx,
  obtain ⟨y, hy, z, hz, rfl⟩ := submodule.mem_sup.mp ((hn.le : _) (ideal.mem_sup_left hx)),
  refine submodule.add_mem_sup hy _,
  obtain ⟨z, rfl⟩ := I^.is_principal.mem_iff_eq_smul_generator^.mp hz,
  rw [smul_eq_mul, smul_eq_mul, mul_comm],
  refine ideal.mul_mem_mul (submodule.is_principal.generator_mem _) _,
  rwa [ideal.mem_comap, f.map_add, smul_eq_mul, map_mul, ideal.add_mem_iff_right _
    (ideal.pow_le_pow n.le_succ hy), mul_comm, ideal.unit_mul_mem_iff_mem] at hx,
  refine is_localization.map_units _ ⟨_, show I^.is_principal.generator ∈ q.prime_compl, from _⟩,
  change I^.is_principal.generator ∉ (↑q : set R),
  rw [← set.singleton_subset_iff, ← ideal.span_le, ideal.span_singleton_generator],
  exact λ e, h₂.not_le (hp.2 ⟨h₁, e⟩ h₂.le),
end

lemma ideal.height_le_one_of_is_principal_of_mem_minimal_primes [is_noetherian_ring R]
    (I : ideal R) (hI : I.is_principal)
    (p : ideal R) (hp : p ∈ I.minimal_primes) :
    p.height ≤ 1 :=
begin
  haveI := hp.1.1,
  casesI subsingleton_or_nontrivial R,
  { exact (‹p.is_prime›.ne_top (subsingleton.elim _ _)).elim },
  let f := algebra_map R (localization.at_prime p),
  have := ideal.height_le_one_of_is_principal_of_mem_minimal_primes_of_local_ring
    (I.map f) ⟨⟨f I^.is_principal.generator, _⟩⟩ _,
  { rwa [is_localization.height p.prime_compl, localization.at_prime.comap_maximal_ideal] at this },
  { rw [← set.image_singleton, ← ideal.span, ← ideal.map_span, ideal.span_singleton_generator I] },
  { rwa [is_localization.minimal_primes_map p.prime_compl (localization.at_prime p) I,
      set.mem_preimage, localization.at_prime.comap_maximal_ideal] }
end

lemma exists_covby_of_lt {α : Type*} [partial_order α] [hα : well_founded_gt α]
  {x y : α} (e : x < y) : ∃ z, x ≤ z ∧ z ⋖ y :=
begin
  rw [well_founded_gt, is_well_founded_iff, well_founded.well_founded_iff_has_max'] at hα,
  obtain ⟨z, ⟨hxz, hzy⟩, hz⟩ := hα (set.Ico x y) ⟨x, le_rfl, e⟩,
  exact ⟨z, hxz, hzy, λ c hzc hcy, hzc.ne (hz _ ⟨hxz.trans hzc.le, hcy⟩ hzc.le).symm⟩
end

lemma ideal.height_le_iff_covby {p : ideal R} {n : ℕ} [p.is_prime] [is_noetherian_ring R] :
  p.height ≤ n ↔ ∀ q : ideal R, q.is_prime → q < p →
    (∀ q' : ideal R, q'.is_prime → q < q' → ¬ q' < p) → q.height < n :=
begin
  rw ideal.height_le_iff,
  split,
  { exact λ H q hq e _, H q hq e },
  { intros H q hq e,
    have := (order_embedding.subtype (λ I : ideal R, I.is_prime)).dual.well_founded
      (well_founded_submodule_gt R R),
    obtain ⟨⟨x, hx⟩, hqx, hxp⟩ :=
      @exists_covby_of_lt { I : ideal R // I.is_prime } _ ⟨this⟩ ⟨q, hq⟩ ⟨p, ‹_›⟩ e,
    exact (ideal.height_mono hqx).trans_lt
      (H _ hx hxp.1 (λ I hI e, hxp.2 (show subtype.mk x hx < ⟨I, hI⟩, from e))) }
end

lemma with_top.lt_one_iff_eq_zero {n : ℕ∞} :
  n < 1 ↔ n = 0 :=
begin
  cases n; simp [with_top.some_eq_coe, with_top.none_eq_top],
end

variables {S : Type*} [comm_ring S]

lemma ideal.minimal_primes_map_of_surjective {f : R →+* S} (hf : function.surjective f)
  (I : ideal R) :
  (I.map f).minimal_primes = ideal.map f '' (I ⊔ f.ker).minimal_primes :=
begin
  apply set.image_injective.mpr (ideal.comap_injective_of_surjective f hf),
  rw [← ideal.comap_minimal_primes_eq_of_surjective hf, ← set.image_comp,
    ideal.comap_map_of_surjective f hf],
  ext, split,
  { intro hx, refine ⟨x, hx, _⟩, refine (ideal.comap_map_of_surjective f hf _).trans _,
    rw [sup_eq_left, ← ring_hom.ker_eq_comap_bot], exact le_sup_right.trans hx.1.2 },
  { rintro ⟨x, hx, rfl⟩, convert hx, refine (ideal.comap_map_of_surjective f hf _).trans _,
    rw [sup_eq_left, ← ring_hom.ker_eq_comap_bot], exact le_sup_right.trans hx.1.2 },
end

lemma ideal.height_le_spanrank_of_mem_minimal_primes [is_noetherian_ring R]
    (I : ideal R) (p : ideal R) (hp : p ∈ I.minimal_primes) :
    p.height ≤ I.spanrank :=
begin
  classical,
  delta submodule.spanrank,
  rw le_infi_iff,
  rintro ⟨s, hs, hs'⟩,
  unfreezingI
  { induction hn : hs.to_finset.card using nat.strong_induction_on with n H generalizing R },
  haveI := hp.1.1,
  subst hs',
  cases n,
  { rw [finset.card_eq_zero, ← finset.coe_inj, hs.coe_to_finset, finset.coe_empty] at hn,
    rw [hn, submodule.span_empty, ← minimal_primes,
      ← ideal.prime_height_eq_zero_iff, ← ideal.height_eq_prime_height] at hp, exact hp.le },
  rw [← @localization.at_prime.comap_maximal_ideal _ _ p, ← is_localization.height p.prime_compl],
  rw [← @localization.at_prime.comap_maximal_ideal _ _ p, ← set.mem_preimage,
    ← is_localization.minimal_primes_map p.prime_compl, ← ideal.span, ideal.map_span] at hp,
  let A' := localization p.prime_compl,
  let p' := local_ring.maximal_ideal A',
  let t := algebra_map R A' '' s,
  have ht : t.finite := hs.image _,
  replace hn : ht.to_finset.card ≤ n + 1,
  { rw (show ht.to_finset = hs.to_finset.image (algebra_map R A'), by { ext, simp }),
    exact finset.card_image_le.trans_eq hn },
  change p' ∈ (ideal.span t).minimal_primes at hp,
  show p'.height ≤ _,
  clear_value t, clear hs s,
  simp_rw [ideal.height_le_iff_covby, nat.succ_eq_add_one, with_top.lt_coe_iff_add_one_le,
    with_top.coe_add, with_top.coe_one, with_top.add_le_add_iff_right with_top.one_ne_top],
  introsI q hq hpq hq',
  obtain ⟨x, s, hxs, rfl, hxq⟩ : ∃ x s, x ∉ s ∧ t = insert x s ∧ x ∉ q,
  { have : ¬ t ⊆ q,
    { rw ← ideal.span_le, exact λ e, lt_irrefl _ ((hp.2 ⟨hq, e⟩ hpq.le).trans_lt hpq) },
    obtain ⟨x, hxt, hxq⟩ := set.not_subset.mp this,
    refine ⟨x, t \ {x}, λ e, e.2 rfl, _, hxq⟩,
    rw [set.insert_diff_singleton, set.insert_eq_of_mem hxt] },
  have : p' ≤ (q ⊔ ideal.span {x}).radical,
  { rw [ideal.radical_eq_Inf, le_Inf_iff],
    rintro J ⟨hJ, hJ'⟩, by_contra h, refine hq' J hJ' (lt_of_le_of_ne (le_sup_left.trans hJ) _)
      (lt_of_le_not_le (local_ring.le_maximal_ideal hJ'.ne_top) h),
    rintro rfl, apply hxq, apply hJ, apply ideal.mem_sup_right,
    exact submodule.mem_span_singleton_self _ },
  have h : ∀ z ∈ s, z ∈ (q ⊔ ideal.span {x}).radical,
  { have := hp.1.2.trans this, rw [ideal.span_le, set.insert_subset] at this, exact this.2 },
  replace h : ∀ z : s, ∃ (m : ℕ) (y ∈ q) (a : A'), y + a * x = z ^ m,
  { rintros ⟨z, hzs⟩,
    dsimp [ideal.radical] at h,
    simp only [submodule.mem_sup, ideal.mem_span_singleton'] at h,
    obtain ⟨m, y, hyq, _, ⟨a, rfl⟩, hy⟩ := h z hzs, exact ⟨m, y, hyq, a, hy⟩ },
  choose m y hyq a hy using h,
  let I' := ideal.span (set.range y),
  let f := I'^.quotient.mk,
  have hf : function.surjective f := ideal.quotient.mk_surjective,
  have hf' : ∀ z, f (y z) = 0,
  { intro z, rw [← ring_hom.mem_ker, ideal.mk_ker], exact ideal.subset_span ⟨z, rfl⟩ },
  have hI'q : I' ≤ q, { rw ideal.span_le, rintro _ ⟨z, rfl⟩, apply hyq },
  have hI'p' : I' ≤ p' := hI'q.trans hpq.le,
  have h := @@ideal.height_le_one_of_is_principal_of_mem_minimal_primes _ _ ((ideal.span {x}).map f)
    ⟨⟨algebra_map _ _ x, by { rw [ideal.map_span, set.image_singleton], refl }⟩⟩ (p'.map f) _,
  swap,
  { haveI : (p'.map f).is_prime := ideal.map_is_prime_of_surjective hf _,
    obtain ⟨p'', h₁, h₂⟩ := ideal.exists_minimal_primes_le
      (show (ideal.span {x}).map f ≤ p'.map f, from _),
    have hxp'' : f x ∈ p'',
    { rw [← ideal.span_singleton_le_iff_mem, ← set.image_singleton, ← ideal.map_span],
      exact h₁.1.2 },
    convert h₁,
    refine (ideal.map_le_iff_le_comap.mpr
      (hp.2 ⟨@@ideal.is_prime.comap _ _ _ f h₁.1.1, _⟩ _)).antisymm h₂,
    { rw [ideal.span_le, set.insert_subset],
      refine ⟨hxp'', _⟩,
      { intros z hz,
        show f z ∈ p'',
        apply h₁.1.1.mem_of_pow_mem (m ⟨z, hz⟩),
        specialize hy ⟨z, hz⟩, rw subtype.coe_mk at hy,
        rw [← map_pow, ← hy, map_add, hf', zero_add, map_mul],
        exact ideal.mul_mem_left _ _ hxp'' } },
    { conv_rhs { rw [← sup_eq_left.mpr hI'p', ← @ideal.mk_ker _ _ I', ring_hom.ker_eq_comap_bot,
        ← ideal.comap_map_of_surjective f hf p'] },
      exact ideal.comap_mono h₂ },
    { apply ideal.map_mono, rw [ideal.span_singleton_le_iff_mem],
      exact hp.1.2 (ideal.subset_span (set.mem_insert x s)) },
    { rwa [ideal.mk_ker] } },
  have : q.map f < p'.map f,
  { refine lt_of_le_not_le (ideal.map_mono hpq.le) (λ e, _),
    have := @ideal.comap_mono _ _ _ _ _ _ f _ _ e,
    simp_rw [ideal.comap_map_of_surjective f hf, ← ring_hom.ker_eq_comap_bot, ideal.mk_ker,
      sup_eq_left.mpr hI'q, sup_eq_left.mpr (hI'q.trans hpq.le)] at this,
    exact lt_irrefl _(this.trans_lt hpq) },
  haveI : (p'.map f).is_prime := ideal.map_is_prime_of_surjective hf (by rwa ideal.mk_ker),
  haveI : (q.map f).is_prime := ideal.map_is_prime_of_surjective hf (by rwa ideal.mk_ker),
  haveI : (p'.map f).finite_height,
  { rw [ideal.finite_height_iff, ← lt_top_iff_ne_top],
    exact or.inr (h.trans_lt (with_top.coe_lt_top 1)) },
  rw ideal.height_eq_prime_height at h,
  have := (ideal.prime_height_strict_mono this).trans_le h,
  rw [with_top.lt_one_iff_eq_zero, ideal.prime_height_eq_zero_iff, minimal_primes,
    ← @ideal.map_bot A' (A' ⧸ I') _ _ _ _ f, ideal.minimal_primes_map_of_surjective hf,
    bot_sup_eq, ideal.mk_ker] at this,
  obtain ⟨q', hq₁, hq₂⟩ := this,
  obtain rfl : q = q',
  { apply_fun ideal.comap f at hq₂,
    simp_rw [ideal.comap_map_of_surjective f hf, ← ring_hom.ker_eq_comap_bot, ideal.mk_ker] at hq₂,
    rwa [sup_eq_left.mpr hI'q, sup_eq_left.mpr hq₁.1.2, eq_comm] at hq₂ },
  have : s.finite := ht.subset (set.subset_insert _ _), haveI := this.fintype,
  have H' : (@@set.finite_range y this.to_subtype).to_finset.card ≤ n,
  { transitivity this.to_finset.card,
    { convert @finset.card_image_le s _ finset.univ y _ using 1,
      { congr' 1, ext, simp },
      { rw [(finset.card_eq_iff_eq_univ finset.univ).mpr rfl, fintype.card_of_finset'], simp } },
    { rw [← nat.lt_add_one_iff],
      refine lt_of_lt_of_le _ hn,
      rw [set.finite.to_finset_insert, finset.card_insert_of_not_mem, nat.lt_add_one_iff],
      simpa using hxs } },
  refine (H _ _ _ _ hq₁ _ (@@set.finite_range _ this.to_subtype) rfl rfl).trans
    (with_top.coe_le_coe.mpr H'),
  rwa [nat.succ_eq_add_one, nat.lt_add_one_iff]
end
.

lemma ideal.nonempty_minimal_primes {I : ideal R} :
  I.minimal_primes.nonempty ↔ I ≠ ⊤ :=
by rw [← set.ne_empty_iff_nonempty, ne.def, ideal.minimal_primes_eq_empty_iff]

lemma ideal.height_le_spanrank [is_noetherian_ring R] (hI : I ≠ ⊤) :
  I.height ≤ I.spanrank :=
begin
  obtain ⟨J, hJ⟩ := ideal.nonempty_minimal_primes.mpr hI,
  refine (infi₂_le J hJ).trans _,
  rw ← ideal.height_eq_prime_height,
  exact ideal.height_le_spanrank_of_mem_minimal_primes _ _ hJ,
end

instance ideal.finite_height_of_is_noetherian_ring [is_noetherian_ring R] : I.finite_height :=
begin
  rw [ideal.finite_height_iff_lt, or_iff_not_imp_left],
  intro e,
  refine (ideal.height_le_spanrank I e).trans_lt _,
  rw [lt_top_iff_ne_top, submodule.spanrank_ne_top_iff],
  exact is_noetherian.noetherian I
end

lemma exists_spanrank_eq_and_height_eq [is_noetherian_ring R] (I : ideal R) (hI : I ≠ ⊤) :
  ∃ J ≤ I, J.spanrank = I.height ∧ J.height = I.height :=
begin
  obtain ⟨J, hJ, e₁, e₂⟩ := exists_spanrank_le_and_le_height_of_le_height I _
    (enat.coe_to_nat_le_self I.height),
  rw [enat.coe_to_nat_eq_self.mpr (ideal.height_ne_top hI)] at e₁ e₂,
  refine ⟨J, hJ, e₁.antisymm (e₂.trans $ ideal.height_le_spanrank _ _),
    (ideal.height_mono hJ).antisymm e₂⟩,
  rintro rfl, exact hI (top_le_iff.mp hJ),
end

lemma ideal.height_le_iff_exists_minimal_primes [is_noetherian_ring R]
    (p : ideal R) [p.is_prime] (n : ℕ∞) :
    p.height ≤ n ↔ ∃ I : ideal R, p ∈ I.minimal_primes ∧ I.spanrank ≤ n :=
begin
  split,
  { intro h,
    obtain ⟨I, hI, e₁, e₂⟩ := exists_spanrank_eq_and_height_eq p ‹p.is_prime›.ne_top,
    refine ⟨I, _, e₁.symm ▸ h⟩,
    exact ideal.mem_minimal_primes_of_height_eq hI e₂.ge },
  { rintros ⟨I, h₁, h₂⟩, exact (ideal.height_le_spanrank_of_mem_minimal_primes _ _ h₁).trans h₂ }
end


/-
Copyright (c) 2021 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import data.int.order.basic
import data.nat.succ_pred

/-!
# Successors and predecessors of integers

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

In this file, we show that `ℤ` is both an archimedean `succ_order` and an archimedean `pred_order`.
-/

open function order

namespace int

@[reducible] -- so that Lean reads `int.succ` through `succ_order.succ`
instance : succ_order ℤ :=
{ succ := succ,
  ..succ_order.of_succ_le_iff succ (λ a b, iff.rfl) }

@[reducible] -- so that Lean reads `int.pred` through `pred_order.pred`
instance : pred_order ℤ :=
{ pred := pred,
  pred_le := λ a, (sub_one_lt_of_le le_rfl).le,
  min_of_le_pred := λ a ha, ((sub_one_lt_of_le le_rfl).not_le ha).elim,
  le_pred_of_lt := λ a b, le_sub_one_of_lt,
  le_of_pred_lt := λ a b, le_of_sub_one_lt }

@[simp] lemma succ_eq_succ : order.succ = succ := rfl
@[simp] lemma pred_eq_pred : order.pred = pred := rfl

lemma pos_iff_one_le {a : ℤ} : 0 < a ↔ 1 ≤ a := order.succ_le_iff.symm

lemma succ_iterate (a : ℤ) : ∀ n, succ^[n] a = a + n
| 0       := (add_zero a).symm
| (n + 1) := by { rw [function.iterate_succ', int.coe_nat_succ, ←add_assoc],
    exact congr_arg _ (succ_iterate n) }

lemma pred_iterate (a : ℤ) : ∀ n, pred^[n] a = a - n
| 0       := (sub_zero a).symm
| (n + 1) := by { rw [function.iterate_succ', int.coe_nat_succ, ←sub_sub],
    exact congr_arg _ (pred_iterate n) }

instance : is_succ_archimedean ℤ :=
⟨λ a b h, ⟨(b - a).to_nat,
  by rw [succ_eq_succ, succ_iterate, to_nat_sub_of_le h, ←add_sub_assoc, add_sub_cancel']⟩⟩

instance : is_pred_archimedean ℤ :=
⟨λ a b h, ⟨(b - a).to_nat, by rw [pred_eq_pred, pred_iterate, to_nat_sub_of_le h, sub_sub_cancel]⟩⟩

/-! ### Covering relation -/

protected lemma covby_iff_succ_eq {m n : ℤ} : m ⋖ n ↔ m + 1 = n := succ_eq_iff_covby.symm

@[simp] lemma sub_one_covby (z : ℤ) : z - 1 ⋖ z :=
by rw [int.covby_iff_succ_eq, sub_add_cancel]

@[simp] lemma covby_add_one (z : ℤ) : z ⋖ z + 1 :=
int.covby_iff_succ_eq.mpr rfl

end int

@[simp, norm_cast] lemma nat.cast_int_covby_iff {a b : ℕ} : (a : ℤ) ⋖ b ↔ a ⋖ b :=
by { rw [nat.covby_iff_succ_eq, int.covby_iff_succ_eq], exact int.coe_nat_inj' }

alias nat.cast_int_covby_iff ↔ _ covby.cast_int


import Mathlib.Data.Nat.Basic

import Util.Meta.Tactics

/-! Properties of `Int.natAbs` or otherwise useful for working with it. -/

-- TODO question namespace choices

/- `linarith` is powerful, but generates huge proof terms with all
kinds of stuff in them.

In another construction this caused a mysterious error, so I'm
avoiding `linarith` for simple proofs where it's unnecessary and not
especially convenient. -/

section Identities
namespace Int
variable (a b c : ℤ)

protected lemma sub_eq_neg_add : a - b = -b + a :=
  Int.add_comm .. ▸ Int.sub_eq_add_neg ..

protected lemma add_sub_cancel_right
    : a + (b - a) = b := by
  /- rewrite [Int.sub_eq_add_neg, Int.add_comm b (-a)]
  apply Int.add_neg_cancel_left -/
  rewrite [Int.add_comm]; apply Int.sub_add_cancel

end Int
end Identities

/- These should probably be proved for any OrderedSemigroup or something. -/
section NatIneqs
variable {a₁ b₁ a₂ b₂ a₃ b₃ a₄ b₄ : ℕ}

lemma Nat.add_le_add₃ (h₁ : a₁ ≤ b₁) (h₂ : a₂ ≤ b₂) (h₃ : a₃ ≤ b₃)
    : a₁ + a₂ + a₃ ≤ b₁ + b₂ + b₃ :=
  /- `by linarith` works, but I'm avoiding it. -/
  Nat.add_le_add (Nat.add_le_add h₁ h₂) h₃

lemma Nat.add_le_add₄ (h₁ : a₁ ≤ b₁) (h₂ : a₂ ≤ b₂)
                      (h₃ : a₃ ≤ b₃) (h₄ : a₄ ≤ b₄)
    : a₁ + a₂ + a₃ + a₄ ≤ b₁ + b₂ + b₃ + b₄ :=
  /- `by linarith` works, but I'm avoiding it. -/
  Nat.add_le_add (Nat.add_le_add₃ h₁ h₂ h₃) h₄

section variable {a b₁ b₂ c₁ c₂ c₃ c₄ : ℕ} (h : a ≤ b₁ + b₂)

lemma Nat.le_trans_le_sum_left (h' : b₁ ≤ c₁ + c₂)
    : a ≤ c₁ + c₂ + b₂ :=
  calc a ≤ b₁ + b₂ := h
       _ ≤ c₁ + c₂ + b₂ := Nat.add_le_add_right h' b₂

lemma Nat.le_trans_le_sum_right (h' : b₂ ≤ c₁ + c₂)
    : a ≤ b₁ + c₁ + c₂ :=
  calc a ≤ b₁ + b₂ := h
       _ ≤ b₁ + c₁ + c₂ := Nat.add_assoc .. ▸ Nat.add_le_add_left h' b₁

lemma Nat.le_trans_le_sum (h₁' : b₁ ≤ c₁ + c₂) (h₂' : b₂ ≤ c₃ + c₄)
    : a ≤ c₁ + c₂ + c₃ + c₄ :=
  calc a ≤ b₁ + b₂           := h
       _ ≤ c₁ + c₂ + c₃ + c₄ := Nat.add_assoc .. ▸ Nat.add_le_add h₁' h₂'

end

end NatIneqs

/-! # Absolute value notation for convenience -/
namespace Int.natAbs            -- scoped to this namespace

/- This conflicts with match-case notation. -/
-- 	local notation (priority := high) "|" x "|" => Int.natAbs x
/- This is copied with modifications from Mathlib.Algebra.Abs. -/
/- Splitting into `syntax` and `macro_rules` seems to be necessary to use `local`. -/
scoped syntax:arg (name := __notation) (priority := default+1)
  atomic("|" noWs) term:min noWs "|" : term
scoped macro_rules (kind := __notation)
  | `(|$x:term|) => `(Int.natAbs $x)

/- This should make the pretty printer use this notation.
Copied with modifications from https://github.com/leanprover/lean4/issues/2045#issuecomment-1396168913. -/
@[scoped app_unexpander Int.natAbs]
private def __unexpander : Lean.PrettyPrinter.Unexpander
| `($(_) $n:term) => `(|$n|)
| _ => throw ()

end Int.natAbs

abbrev Int.diff : ℤ → ℤ → ℕ := (· - · |>.natAbs)

-- Lemmas about Int.natAbs and Int.diff
namespace Int
variable (a b c d : ℤ)

open scoped Int.natAbs

lemma natAbs_add_le₃ : |a + b + c| ≤ |a| + |b| + |c| :=
  /- `by linarith [Int.natAbs_add_le (a + b) c, Int.natAbs_add_le a b]`
  works, but I'm avoiding it. -/
  Nat.le_trans_le_sum_left (Int.natAbs_add_le (a + b) c)
                           (Int.natAbs_add_le a b)

lemma natAbs_add_le₄
    : |a + b + c + d| ≤ |a| + |b| + |c| + |d| :=
  /- `by linarith [Int.natAbs_add_le (a + b + c) d, Int.natAbs_add_le₃ a b c]`
  works, but I'm avoiding it. -/
  Nat.le_trans_le_sum_left (Int.natAbs_add_le (a + b + c) d)
                           (Int.natAbs_add_le₃ a b c)

@[simp] lemma diff_eq : a.diff b = |a - b| := rfl

lemma diff_self_eq_zero : a.diff a = 0 := by
  unfold diff natAbs; rw [Int.sub_self a]

lemma diff_comm : a.diff b = b.diff a := by
  unfold diff; rw [←Int.natAbs_neg, Int.neg_sub]

lemma triangle_ineq : a.diff c ≤ a.diff b + b.diff c := by
  unfold diff; rewrite [show a - c = (a - b) + (b - c)
                        by rw [←Int.add_sub_assoc, Int.sub_add_cancel]]
  apply Int.natAbs_add_le

lemma triangle_ineq' : b.diff c ≤ a.diff b + a.diff c :=
  diff_comm b a ▸ triangle_ineq b a c

lemma triangle_ineq₃ : a.diff d ≤ a.diff b + b.diff c + c.diff d :=
  Nat.le_trans_le_sum_left (triangle_ineq a c d) (triangle_ineq a b c)

end Int


/-
Copyright (c) 2014 Floris van Doorn (c) 2016 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn, Leonardo de Moura, Jeremy Avigad, Mario Carneiro
-/
import order.basic
import algebra.group_with_zero.basic
import algebra.ring.defs

/-!
# Basic operations on the natural numbers

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

This file contains:
- instances on the natural numbers
- some basic lemmas about natural numbers
- extra recursors:
  * `le_rec_on`, `le_induction`: recursion and induction principles starting at non-zero numbers
  * `decreasing_induction`: recursion growing downwards
  * `le_rec_on'`, `decreasing_induction'`: versions with slightly weaker assumptions
  * `strong_rec'`: recursion based on strong inequalities
- decidability instances on predicates about the natural numbers

Many theorems that used to live in this file have been moved to `data.nat.order`,
so that this file requires fewer imports.
For each section here there is a corresponding section in that file with additional results.
It may be possible to move some of these results here, by tweaking their proofs.

-/

universes u v

/-! ### instances -/

instance : nontrivial ℕ :=
⟨⟨0, 1, nat.zero_ne_one⟩⟩

instance : comm_semiring ℕ :=
{ add            := nat.add,
  add_assoc      := nat.add_assoc,
  zero           := nat.zero,
  zero_add       := nat.zero_add,
  add_zero       := nat.add_zero,
  add_comm       := nat.add_comm,
  mul            := nat.mul,
  mul_assoc      := nat.mul_assoc,
  one            := nat.succ nat.zero,
  one_mul        := nat.one_mul,
  mul_one        := nat.mul_one,
  left_distrib   := nat.left_distrib,
  right_distrib  := nat.right_distrib,
  zero_mul       := nat.zero_mul,
  mul_zero       := nat.mul_zero,
  mul_comm       := nat.mul_comm,
  nat_cast       := λ n, n,
  nat_cast_zero  := rfl,
  nat_cast_succ  := λ n, rfl,
  nsmul          := λ m n, m * n,
  nsmul_zero'    := nat.zero_mul,
  nsmul_succ'    := λ n x,
    by rw [nat.succ_eq_add_one, nat.add_comm, nat.right_distrib, nat.one_mul] }

/-! Extra instances to short-circuit type class resolution and ensure computability -/

instance : add_comm_monoid ℕ              := infer_instance
instance : add_monoid ℕ                   := infer_instance
instance : monoid ℕ                       := infer_instance
instance : comm_monoid ℕ                  := infer_instance
instance : comm_semigroup ℕ               := infer_instance
instance : semigroup ℕ                    := infer_instance
instance : add_comm_semigroup ℕ           := infer_instance
instance : add_semigroup ℕ                := infer_instance
instance : distrib ℕ                      := infer_instance
instance : semiring ℕ                     := infer_instance

protected lemma nat.nsmul_eq_mul (m n : ℕ) : m • n = m * n := rfl

instance nat.cancel_comm_monoid_with_zero : cancel_comm_monoid_with_zero ℕ :=
{ mul_left_cancel_of_ne_zero :=
    λ _ _ _ h1 h2, nat.eq_of_mul_eq_mul_left (nat.pos_of_ne_zero h1) h2,
  .. nat.comm_semiring }

attribute [simp] nat.not_lt_zero nat.succ_ne_zero nat.succ_ne_self
  nat.zero_ne_one nat.one_ne_zero
  nat.zero_ne_bit1 nat.bit1_ne_zero
  nat.bit0_ne_one nat.one_ne_bit0
  nat.bit0_ne_bit1 nat.bit1_ne_bit0

variables {m n k : ℕ}
namespace nat

/-!
### Recursion and `forall`/`exists`
-/

@[simp] lemma and_forall_succ {p : ℕ → Prop} : (p 0 ∧ ∀ n, p (n + 1)) ↔ ∀ n, p n :=
⟨λ h n, nat.cases_on n h.1 h.2, λ h, ⟨h _, λ n, h _⟩⟩

@[simp] lemma or_exists_succ {p : ℕ → Prop} : (p 0 ∨ ∃ n, p (n + 1)) ↔ ∃ n, p n :=
⟨λ h, h.elim (λ h0, ⟨0, h0⟩) (λ ⟨n, hn⟩, ⟨n + 1, hn⟩),
  by { rintro ⟨(_|n), hn⟩, exacts [or.inl hn, or.inr ⟨n, hn⟩]}⟩

/-! ### `succ` -/

lemma _root_.has_lt.lt.nat_succ_le {n m : ℕ} (h : n < m) : succ n ≤ m := succ_le_of_lt h

lemma succ_eq_one_add (n : ℕ) : n.succ = 1 + n :=
by rw [nat.succ_eq_add_one, nat.add_comm]

theorem eq_of_lt_succ_of_not_lt {a b : ℕ} (h1 : a < b + 1) (h2 : ¬ a < b) : a = b :=
have h3 : a ≤ b, from le_of_lt_succ h1,
or.elim (eq_or_lt_of_not_lt h2) (λ h, h) (λ h, absurd h (not_lt_of_ge h3))

lemma eq_of_le_of_lt_succ {n m : ℕ} (h₁ : n ≤ m) (h₂ : m < n + 1) : m = n :=
nat.le_antisymm (le_of_succ_le_succ h₂) h₁

theorem one_add (n : ℕ) : 1 + n = succ n := by simp [add_comm]

@[simp] lemma succ_pos' {n : ℕ} : 0 < succ n := succ_pos n

theorem succ_inj' {n m : ℕ} : succ n = succ m ↔ n = m :=
⟨succ.inj, congr_arg _⟩

theorem succ_injective : function.injective nat.succ := λ x y, succ.inj

lemma succ_ne_succ {n m : ℕ} : succ n ≠ succ m ↔ n ≠ m :=
succ_injective.ne_iff

@[simp] lemma succ_succ_ne_one (n : ℕ) : n.succ.succ ≠ 1 :=
succ_ne_succ.mpr n.succ_ne_zero

@[simp] lemma one_lt_succ_succ (n : ℕ) : 1 < n.succ.succ :=
succ_lt_succ $ succ_pos n

theorem succ_le_succ_iff {m n : ℕ} : succ m ≤ succ n ↔ m ≤ n :=
⟨le_of_succ_le_succ, succ_le_succ⟩

theorem max_succ_succ {m n : ℕ} :
  max (succ m) (succ n) = succ (max m n) :=
begin
  by_cases h1 : m ≤ n,
  rw [max_eq_right h1, max_eq_right (succ_le_succ h1)],
  { rw not_le at h1, have h2 := le_of_lt h1,
    rw [max_eq_left h2, max_eq_left (succ_le_succ h2)] }
end

lemma not_succ_lt_self {n : ℕ} : ¬succ n < n :=
not_lt_of_ge (nat.le_succ _)

theorem lt_succ_iff {m n : ℕ} : m < succ n ↔ m ≤ n :=
⟨le_of_lt_succ, lt_succ_of_le⟩

lemma succ_le_iff {m n : ℕ} : succ m ≤ n ↔ m < n :=
⟨lt_of_succ_le, succ_le_of_lt⟩

lemma lt_iff_add_one_le {m n : ℕ} : m < n ↔ m + 1 ≤ n :=
by rw succ_le_iff

-- Just a restatement of `nat.lt_succ_iff` using `+1`.
lemma lt_add_one_iff {a b : ℕ} : a < b + 1 ↔ a ≤ b :=
lt_succ_iff

-- A flipped version of `lt_add_one_iff`.
lemma lt_one_add_iff {a b : ℕ} : a < 1 + b ↔ a ≤ b :=
by simp only [add_comm, lt_succ_iff]

-- This is true reflexively, by the definition of `≤` on ℕ,
-- but it's still useful to have, to convince Lean to change the syntactic type.
lemma add_one_le_iff {a b : ℕ} : a + 1 ≤ b ↔ a < b :=
iff.refl _

lemma one_add_le_iff {a b : ℕ} : 1 + a ≤ b ↔ a < b :=
by simp only [add_comm, add_one_le_iff]

theorem of_le_succ {n m : ℕ} (H : n ≤ m.succ) : n ≤ m ∨ n = m.succ :=
H.lt_or_eq_dec.imp le_of_lt_succ id

lemma succ_lt_succ_iff {m n : ℕ} : succ m < succ n ↔ m < n :=
⟨lt_of_succ_lt_succ, succ_lt_succ⟩

lemma div_le_iff_le_mul_add_pred {m n k : ℕ} (n0 : 0 < n) : m / n ≤ k ↔ m ≤ n * k + (n - 1) :=
begin
  rw [← lt_succ_iff, div_lt_iff_lt_mul n0, succ_mul, mul_comm],
  cases n, {cases n0},
  exact lt_succ_iff,
end

lemma two_lt_of_ne : ∀ {n}, n ≠ 0 → n ≠ 1 → n ≠ 2 → 2 < n
| 0 h _ _ := (h rfl).elim
| 1 _ h _ := (h rfl).elim
| 2 _ _ h := (h rfl).elim
| (n+3) _ _ _ := dec_trivial

theorem forall_lt_succ {P : ℕ → Prop} {n : ℕ} : (∀ m < n + 1, P m) ↔ (∀ m < n, P m) ∧ P n :=
by simp only [lt_succ_iff, decidable.le_iff_eq_or_lt, forall_eq_or_imp, and.comm]

theorem exists_lt_succ {P : ℕ → Prop} {n : ℕ} : (∃ m < n + 1, P m) ↔ (∃ m < n, P m) ∨ P n :=
by { rw ←not_iff_not, push_neg, exact forall_lt_succ }

/-! ### `add` -/

-- Sometimes a bare `nat.add` or similar appears as a consequence of unfolding
-- during pattern matching. These lemmas package them back up as typeclass
-- mediated operations.
@[simp] theorem add_def {a b : ℕ} : nat.add a b = a + b := rfl
@[simp] theorem mul_def {a b : ℕ} : nat.mul a b = a * b := rfl

lemma exists_eq_add_of_le (h : m ≤ n) : ∃ k : ℕ, n = m + k :=
⟨n - m, (nat.add_sub_of_le h).symm⟩

lemma exists_eq_add_of_le' (h : m ≤ n) : ∃ k : ℕ, n = k + m :=
⟨n - m, (nat.sub_add_cancel h).symm⟩

lemma exists_eq_add_of_lt (h : m < n) : ∃ k : ℕ, n = m + k + 1 :=
⟨n - (m + 1), by rw [add_right_comm, nat.add_sub_of_le h]⟩

/-! ### `pred` -/

@[simp]
lemma add_succ_sub_one (n m : ℕ) : (n + succ m) - 1 = n + m :=
by rw [add_succ, succ_sub_one]

@[simp]
lemma succ_add_sub_one (n m : ℕ) : (succ n + m) - 1 = n + m :=
by rw [succ_add, succ_sub_one]

lemma pred_eq_sub_one (n : ℕ) : pred n = n - 1 := rfl

theorem pred_eq_of_eq_succ {m n : ℕ} (H : m = n.succ) : m.pred = n := by simp [H]

@[simp] lemma pred_eq_succ_iff {n m : ℕ} : pred n = succ m ↔ n = m + 2 :=
by cases n; split; rintro ⟨⟩; refl

theorem pred_sub (n m : ℕ) : pred n - m = pred (n - m) :=
by rw [← nat.sub_one, nat.sub_sub, one_add, sub_succ]

lemma le_pred_of_lt {n m : ℕ} (h : m < n) : m ≤ n - 1 :=
nat.sub_le_sub_right h 1

lemma le_of_pred_lt {m n : ℕ} : pred m < n → m ≤ n :=
match m with
| 0 := le_of_lt
| m+1 := id
end

/-- This ensures that `simp` succeeds on `pred (n + 1) = n`. -/
@[simp] lemma pred_one_add (n : ℕ) : pred (1 + n) = n :=
by rw [add_comm, add_one, pred_succ]

/-! ### `mul` -/

theorem two_mul_ne_two_mul_add_one {n m} : 2 * n ≠ 2 * m + 1 :=
mt (congr_arg (%2)) (by { rw [add_comm, add_mul_mod_self_left, mul_mod_right, mod_eq_of_lt]; simp })

lemma mul_ne_mul_left {a b c : ℕ} (ha : 0 < a) : b * a ≠ c * a ↔ b ≠ c :=
(mul_left_injective₀ ha.ne').ne_iff

lemma mul_ne_mul_right {a b c : ℕ} (ha : 0 < a) : a * b ≠ a * c ↔ b ≠ c :=
(mul_right_injective₀ ha.ne').ne_iff

lemma mul_right_eq_self_iff {a b : ℕ} (ha : 0 < a) : a * b = a ↔ b = 1 :=
suffices a * b = a * 1 ↔ b = 1, by rwa mul_one at this,
mul_right_inj' ha.ne'

lemma mul_left_eq_self_iff {a b : ℕ} (hb : 0 < b) : a * b = b ↔ a = 1 :=
by rw [mul_comm, nat.mul_right_eq_self_iff hb]

lemma lt_succ_iff_lt_or_eq {n i : ℕ} : n < i.succ ↔ (n < i ∨ n = i) :=
lt_succ_iff.trans decidable.le_iff_lt_or_eq

/-!
### Recursion and induction principles

This section is here due to dependencies -- the lemmas here require some of the lemmas
proved above, and some of the results in later sections depend on the definitions in this section.
-/

@[simp] lemma rec_zero {C : ℕ → Sort u} (h0 : C 0) (h : ∀ n, C n → C (n + 1)) :
  (nat.rec h0 h : Π n, C n) 0 = h0 :=
rfl

@[simp] lemma rec_add_one {C : ℕ → Sort u} (h0 : C 0) (h : ∀ n, C n → C (n + 1)) (n : ℕ) :
  (nat.rec h0 h : Π n, C n) (n + 1) = h n ((nat.rec h0 h : Π n, C n) n) :=
rfl

/-- Recursion starting at a non-zero number: given a map `C k → C (k+1)` for each `k`,
there is a map from `C n` to each `C m`, `n ≤ m`. For a version where the assumption is only made
when `k ≥ n`, see `le_rec_on'`. -/
@[elab_as_eliminator]
def le_rec_on {C : ℕ → Sort u} {n : ℕ} : Π {m : ℕ}, n ≤ m → (Π {k}, C k → C (k+1)) → C n → C m
| 0     H next x := eq.rec_on (nat.eq_zero_of_le_zero H) x
| (m+1) H next x := or.by_cases (of_le_succ H) (λ h : n ≤ m, next $ le_rec_on h @next x)
  (λ h : n = m + 1, eq.rec_on h x)

theorem le_rec_on_self {C : ℕ → Sort u} {n} {h : n ≤ n} {next} (x : C n) :
  (le_rec_on h next x : C n) = x :=
by cases n; unfold le_rec_on or.by_cases; rw [dif_neg n.not_succ_le_self]

theorem le_rec_on_succ {C : ℕ → Sort u} {n m} (h1 : n ≤ m) {h2 : n ≤ m+1} {next} (x : C n) :
  (le_rec_on h2 @next x : C (m+1)) = next (le_rec_on h1 @next x : C m) :=
by conv { to_lhs, rw [le_rec_on, or.by_cases, dif_pos h1] }

theorem le_rec_on_succ' {C : ℕ → Sort u} {n} {h : n ≤ n+1} {next} (x : C n) :
  (le_rec_on h next x : C (n+1)) = next x :=
by rw [le_rec_on_succ (le_refl n), le_rec_on_self]

theorem le_rec_on_trans {C : ℕ → Sort u} {n m k} (hnm : n ≤ m) (hmk : m ≤ k) {next} (x : C n) :
  (le_rec_on (le_trans hnm hmk) @next x : C k) = le_rec_on hmk @next (le_rec_on hnm @next x) :=
begin
  induction hmk with k hmk ih, { rw le_rec_on_self },
  rw [le_rec_on_succ (le_trans hnm hmk), ih, le_rec_on_succ]
end

theorem le_rec_on_succ_left {C : ℕ → Sort u} {n m} (h1 : n ≤ m) (h2 : n+1 ≤ m)
  {next : Π{{k}}, C k → C (k+1)} (x : C n) :
  (le_rec_on h2 next (next x) : C m) = (le_rec_on h1 next x : C m) :=
begin
  rw [subsingleton.elim h1 (le_trans (le_succ n) h2),
      le_rec_on_trans (le_succ n) h2, le_rec_on_succ']
end

theorem le_rec_on_injective {C : ℕ → Sort u} {n m} (hnm : n ≤ m)
  (next : Π n, C n → C (n+1)) (Hnext : ∀ n, function.injective (next n)) :
  function.injective (le_rec_on hnm next) :=
begin
  induction hnm with m hnm ih, { intros x y H, rwa [le_rec_on_self, le_rec_on_self] at H },
  intros x y H, rw [le_rec_on_succ hnm, le_rec_on_succ hnm] at H, exact ih (Hnext _ H)
end

theorem le_rec_on_surjective {C : ℕ → Sort u} {n m} (hnm : n ≤ m)
  (next : Π n, C n → C (n+1)) (Hnext : ∀ n, function.surjective (next n)) :
  function.surjective (le_rec_on hnm next) :=
begin
  induction hnm with m hnm ih, { intros x, use x, rw le_rec_on_self },
  intros x, rcases Hnext _ x with ⟨w, rfl⟩, rcases ih w with ⟨x, rfl⟩, use x, rw le_rec_on_succ
end

/-- Recursion principle based on `<`. -/
@[elab_as_eliminator]
protected def strong_rec' {p : ℕ → Sort u} (H : ∀ n, (∀ m, m < n → p m) → p n) : ∀ (n : ℕ), p n
| n := H n (λ m hm, strong_rec' m)

/-- Recursion principle based on `<` applied to some natural number. -/
@[elab_as_eliminator]
def strong_rec_on' {P : ℕ → Sort*} (n : ℕ) (h : ∀ n, (∀ m, m < n → P m) → P n) : P n :=
nat.strong_rec' h n

theorem strong_rec_on_beta' {P : ℕ → Sort*} {h} {n : ℕ} :
  (strong_rec_on' n h : P n) = h n (λ m hmn, (strong_rec_on' m h : P m)) :=
by { simp only [strong_rec_on'], rw nat.strong_rec' }

/-- Induction principle starting at a non-zero number. For maps to a `Sort*` see `le_rec_on`. -/
@[elab_as_eliminator] lemma le_induction {P : nat → Prop} {m}
  (h0 : P m) (h1 : ∀ n, m ≤ n → P n → P (n + 1)) :
  ∀ n, m ≤ n → P n :=
by apply nat.less_than_or_equal.rec h0; exact h1

/-- Decreasing induction: if `P (k+1)` implies `P k`, then `P n` implies `P m` for all `m ≤ n`.
Also works for functions to `Sort*`. For a version assuming only the assumption for `k < n`, see
`decreasing_induction'`. -/
@[elab_as_eliminator]
def decreasing_induction {P : ℕ → Sort*} (h : ∀n, P (n+1) → P n) {m n : ℕ} (mn : m ≤ n)
  (hP : P n) : P m :=
le_rec_on mn (λ k ih hsk, ih $ h k hsk) (λ h, h) hP

@[simp] lemma decreasing_induction_self {P : ℕ → Sort*} (h : ∀n, P (n+1) → P n) {n : ℕ}
  (nn : n ≤ n) (hP : P n) : (decreasing_induction h nn hP : P n) = hP :=
by { dunfold decreasing_induction, rw [le_rec_on_self] }

lemma decreasing_induction_succ {P : ℕ → Sort*} (h : ∀n, P (n+1) → P n) {m n : ℕ} (mn : m ≤ n)
  (msn : m ≤ n + 1) (hP : P (n+1)) :
  (decreasing_induction h msn hP : P m) = decreasing_induction h mn (h n hP) :=
by { dunfold decreasing_induction, rw [le_rec_on_succ] }

@[simp] lemma decreasing_induction_succ' {P : ℕ → Sort*} (h : ∀n, P (n+1) → P n) {m : ℕ}
  (msm : m ≤ m + 1) (hP : P (m+1)) : (decreasing_induction h msm hP : P m) = h m hP :=
by { dunfold decreasing_induction, rw [le_rec_on_succ'] }

lemma decreasing_induction_trans {P : ℕ → Sort*} (h : ∀n, P (n+1) → P n) {m n k : ℕ}
  (mn : m ≤ n) (nk : n ≤ k) (hP : P k) :
  (decreasing_induction h (le_trans mn nk) hP : P m) =
  decreasing_induction h mn (decreasing_induction h nk hP) :=
by { induction nk with k nk ih, rw [decreasing_induction_self],
     rw [decreasing_induction_succ h (le_trans mn nk), ih, decreasing_induction_succ] }

lemma decreasing_induction_succ_left {P : ℕ → Sort*} (h : ∀n, P (n+1) → P n) {m n : ℕ}
  (smn : m + 1 ≤ n) (mn : m ≤ n) (hP : P n) :
  (decreasing_induction h mn hP : P m) = h m (decreasing_induction h smn hP) :=
by { rw [subsingleton.elim mn (le_trans (le_succ m) smn), decreasing_induction_trans,
         decreasing_induction_succ'] }

/-- Given `P : ℕ → ℕ → Sort*`, if for all `a b : ℕ` we can extend `P` from the rectangle
strictly below `(a,b)` to `P a b`, then we have `P n m` for all `n m : ℕ`.
Note that for non-`Prop` output it is preferable to use the equation compiler directly if possible,
since this produces equation lemmas. -/
@[elab_as_eliminator]
def strong_sub_recursion {P : ℕ → ℕ → Sort*}
  (H : ∀ a b, (∀ x y, x < a → y < b → P x y) → P a b) : Π (n m : ℕ), P n m
| n m := H n m (λ x y hx hy, strong_sub_recursion x y)

/-- Given `P : ℕ → ℕ → Sort*`, if we have `P i 0` and `P 0 i` for all `i : ℕ`,
and for any `x y : ℕ` we can extend `P` from `(x,y+1)` and `(x+1,y)` to `(x+1,y+1)`
then we have `P n m` for all `n m : ℕ`.
Note that for non-`Prop` output it is preferable to use the equation compiler directly if possible,
since this produces equation lemmas. -/
@[elab_as_eliminator]
def pincer_recursion {P : ℕ → ℕ → Sort*} (Ha0 : ∀ a : ℕ, P a 0) (H0b : ∀ b : ℕ, P 0 b)
  (H : ∀ x y : ℕ, P x y.succ → P x.succ y → P x.succ y.succ) : ∀ (n m : ℕ), P n m
| a 0 := Ha0 a
| 0 b := H0b b
| (nat.succ a) (nat.succ b) := H _ _ (pincer_recursion _ _) (pincer_recursion _ _)

/-- Recursion starting at a non-zero number: given a map `C k → C (k+1)` for each `k ≥ n`,
there is a map from `C n` to each `C m`, `n ≤ m`. -/
@[elab_as_eliminator]
def le_rec_on' {C : ℕ → Sort*} {n : ℕ} :
  Π {m : ℕ}, n ≤ m → (Π ⦃k⦄, n ≤ k → C k → C (k+1)) → C n → C m
| 0     H next x := eq.rec_on (nat.eq_zero_of_le_zero H) x
| (m+1) H next x := or.by_cases (of_le_succ H) (λ h : n ≤ m, next h $ le_rec_on' h next x)
  (λ h : n = m + 1, eq.rec_on h x)

/-- Decreasing induction: if `P (k+1)` implies `P k` for all `m ≤ k < n`, then `P n` implies `P m`.
Also works for functions to `Sort*`. Weakens the assumptions of `decreasing_induction`. -/
@[elab_as_eliminator]
def decreasing_induction' {P : ℕ → Sort*} {m n : ℕ} (h : ∀ k < n, m ≤ k → P (k+1) → P k)
  (mn : m ≤ n) (hP : P n) : P m :=
begin
  -- induction mn using nat.le_rec_on' generalizing h hP -- this doesn't work unfortunately
  refine le_rec_on' mn _ _ h hP; clear h hP mn n,
  { intros n mn ih h hP,
    apply ih,
    { exact λ k hk, h k hk.step },
    { exact h n (lt_succ_self n) mn hP } },
  { intros h hP, exact hP }
end

/-! ### `div` -/

attribute [simp] nat.div_self

/-- A version of `nat.div_lt_self` using successors, rather than additional hypotheses. -/
lemma div_lt_self' (n b : ℕ) : (n+1)/(b+2) < n+1 :=
nat.div_lt_self (nat.succ_pos n) (nat.succ_lt_succ (nat.succ_pos _))

theorem le_div_iff_mul_le' {x y : ℕ} {k : ℕ} (k0 : 0 < k) : x ≤ y / k ↔ x * k ≤ y :=
le_div_iff_mul_le k0

theorem div_lt_iff_lt_mul' {x y : ℕ} {k : ℕ} (k0 : 0 < k) : x / k < y ↔ x < y * k :=
lt_iff_lt_of_le_iff_le $ le_div_iff_mul_le' k0

lemma one_le_div_iff {a b : ℕ} (hb : 0 < b) : 1 ≤ a / b ↔ b ≤ a :=
by rw [le_div_iff_mul_le hb, one_mul]

lemma div_lt_one_iff {a b : ℕ} (hb : 0 < b) : a / b < 1 ↔ a < b :=
lt_iff_lt_of_le_iff_le $ one_le_div_iff hb

protected theorem div_le_div_right {n m : ℕ} (h : n ≤ m) {k : ℕ} : n / k ≤ m / k :=
(nat.eq_zero_or_pos k).elim (λ k0, by simp [k0]) $ λ hk,
(le_div_iff_mul_le' hk).2 $ le_trans (nat.div_mul_le_self _ _) h

lemma lt_of_div_lt_div {m n k : ℕ} : m / k < n / k → m < n :=
lt_imp_lt_of_le_imp_le $ λ h, nat.div_le_div_right h

protected lemma div_pos {a b : ℕ} (hba : b ≤ a) (hb : 0 < b) : 0 < a / b :=
nat.pos_of_ne_zero (λ h, lt_irrefl a
  (calc a = a % b : by simpa [h] using (mod_add_div a b).symm
      ... < b : nat.mod_lt a hb
      ... ≤ a : hba))

lemma lt_mul_of_div_lt {a b c : ℕ} (h : a / c < b) (w : 0 < c) : a < b * c :=
lt_of_not_ge $ not_le_of_gt h ∘ (nat.le_div_iff_mul_le w).2

lemma mul_div_le_mul_div_assoc (a b c : ℕ) : a * (b / c) ≤ (a * b) / c :=
if hc0 : c = 0 then by simp [hc0]
else (nat.le_div_iff_mul_le (nat.pos_of_ne_zero hc0)).2
  (by rw [mul_assoc]; exact nat.mul_le_mul_left _ (nat.div_mul_le_self _ _))

protected theorem eq_mul_of_div_eq_right {a b c : ℕ} (H1 : b ∣ a) (H2 : a / b = c) :
  a = b * c :=
by rw [← H2, nat.mul_div_cancel' H1]

protected theorem div_eq_iff_eq_mul_right {a b c : ℕ} (H : 0 < b) (H' : b ∣ a) :
  a / b = c ↔ a = b * c :=
⟨nat.eq_mul_of_div_eq_right H', nat.div_eq_of_eq_mul_right H⟩

protected theorem div_eq_iff_eq_mul_left {a b c : ℕ} (H : 0 < b) (H' : b ∣ a) :
  a / b = c ↔ a = c * b :=
by rw mul_comm; exact nat.div_eq_iff_eq_mul_right H H'

protected theorem eq_mul_of_div_eq_left {a b c : ℕ} (H1 : b ∣ a) (H2 : a / b = c) :
  a = c * b :=
by rw [mul_comm, nat.eq_mul_of_div_eq_right H1 H2]

protected theorem mul_div_cancel_left' {a b : ℕ} (Hd :  a ∣ b) : a * (b / a) = b :=
by rw [mul_comm,nat.div_mul_cancel Hd]

/-- Alias of `nat.mul_div_mul` -/ --TODO: Update `nat.mul_div_mul` in the core?
protected lemma mul_div_mul_left (a b : ℕ) {c : ℕ} (hc : 0 < c) : c * a / (c * b) = a / b :=
nat.mul_div_mul a b hc
protected lemma mul_div_mul_right (a b : ℕ) {c : ℕ} (hc : 0 < c) : a * c / (b * c) = a / b :=
by rw [mul_comm, mul_comm b, a.mul_div_mul_left b hc]

lemma lt_div_mul_add {a b : ℕ} (hb : 0 < b) : a < a/b*b + b :=
begin
  rw [←nat.succ_mul, ←nat.div_lt_iff_lt_mul hb],
  exact nat.lt_succ_self _,
end

@[simp]
protected lemma div_left_inj {a b d : ℕ} (hda : d ∣ a) (hdb : d ∣ b) : a / d = b / d ↔ a = b :=
begin
  refine ⟨λ h, _, congr_arg _⟩,
  rw [←nat.mul_div_cancel' hda, ←nat.mul_div_cancel' hdb, h],
end

/-! ### `mod`, `dvd` -/

lemma mod_eq_iff_lt {a b : ℕ} (h : b ≠ 0) : a % b = a ↔ a < b :=
begin
  cases b, contradiction,
  exact ⟨λ h, h.ge.trans_lt (mod_lt _ (succ_pos _)), mod_eq_of_lt⟩,
end

@[simp] lemma mod_succ_eq_iff_lt {a b : ℕ} : a % b.succ = a ↔ a < b.succ :=
mod_eq_iff_lt (succ_ne_zero _)

lemma div_add_mod (m k : ℕ) : k * (m / k) + m % k = m :=
(nat.add_comm _ _).trans (mod_add_div _ _)

lemma mod_add_div' (m k : ℕ) : m % k + (m / k) * k = m :=
by { rw mul_comm, exact mod_add_div _ _ }

lemma div_add_mod' (m k : ℕ) : (m / k) * k + m % k = m :=
by { rw mul_comm, exact div_add_mod _ _ }

/-- See also `nat.div_mod_equiv` for a similar statement as an `equiv`. -/
protected theorem div_mod_unique {n k m d : ℕ} (h : 0 < k) :
  n / k = d ∧ n % k = m ↔ m + k * d = n ∧ m < k :=
⟨λ ⟨e₁, e₂⟩, e₁ ▸ e₂ ▸ ⟨mod_add_div _ _, mod_lt _ h⟩,
 λ ⟨h₁, h₂⟩, h₁ ▸ by rw [add_mul_div_left _ _ h, add_mul_mod_self_left];
   simp [div_eq_of_lt, mod_eq_of_lt, h₂]⟩

protected theorem dvd_add_left {k m n : ℕ} (h : k ∣ n) : k ∣ m + n ↔ k ∣ m :=
(nat.dvd_add_iff_left h).symm

protected theorem dvd_add_right {k m n : ℕ} (h : k ∣ m) : k ∣ m + n ↔ k ∣ n :=
(nat.dvd_add_iff_right h).symm

protected theorem mul_dvd_mul_iff_left {a b c : ℕ} (ha : 0 < a) : a * b ∣ a * c ↔ b ∣ c :=
exists_congr $ λ d, by rw [mul_assoc, mul_right_inj' ha.ne']

protected theorem mul_dvd_mul_iff_right {a b c : ℕ} (hc : 0 < c) : a * c ∣ b * c ↔ a ∣ b :=
exists_congr $ λ d, by rw [mul_right_comm, mul_left_inj' hc.ne']

@[simp] theorem mod_mod_of_dvd (n : nat) {m k : nat} (h : m ∣ k) : n % k % m = n % m :=
begin
  conv { to_rhs, rw ←mod_add_div n k },
  rcases h with ⟨t, rfl⟩, rw [mul_assoc, add_mul_mod_self_left]
end

@[simp] theorem mod_mod (a n : ℕ) : (a % n) % n = a % n :=
(nat.eq_zero_or_pos n).elim
  (λ n0, by simp [n0])
  (λ npos, mod_eq_of_lt (mod_lt _ npos))

@[simp] theorem mod_add_mod (m n k : ℕ) : (m % n + k) % n = (m + k) % n :=
by have := (add_mul_mod_self_left (m % n + k) n (m / n)).symm;
   rwa [add_right_comm, mod_add_div] at this

@[simp] theorem add_mod_mod (m n k : ℕ) : (m + n % k) % k = (m + n) % k :=
by rw [add_comm, mod_add_mod, add_comm]

lemma add_mod (a b n : ℕ) : (a + b) % n = ((a % n) + (b % n)) % n :=
by rw [add_mod_mod, mod_add_mod]

theorem add_mod_eq_add_mod_right {m n k : ℕ} (i : ℕ) (H : m % n = k % n) :
  (m + i) % n = (k + i) % n :=
by rw [← mod_add_mod, ← mod_add_mod k, H]

theorem add_mod_eq_add_mod_left {m n k : ℕ} (i : ℕ) (H : m % n = k % n) :
  (i + m) % n = (i + k) % n :=
by rw [add_comm, add_mod_eq_add_mod_right _ H, add_comm]

lemma mul_mod (a b n : ℕ) : (a * b) % n = ((a % n) * (b % n)) % n :=
begin
  conv_lhs
  { rw [←mod_add_div a n, ←mod_add_div' b n, right_distrib, left_distrib, left_distrib,
        mul_assoc, mul_assoc, ←left_distrib n _ _, add_mul_mod_self_left, ← mul_assoc,
        add_mul_mod_self_right] }
end

lemma mul_dvd_of_dvd_div {a b c : ℕ} (hab : c ∣ b) (h : a ∣ b / c) : c * a ∣ b :=
have h1 : ∃ d, b / c = a * d, from h,
have h2 : ∃ e, b = c * e, from hab,
let ⟨d, hd⟩ := h1, ⟨e, he⟩ := h2 in
have h3 : b = a * d * c, from
  nat.eq_mul_of_div_eq_left hab hd,
show ∃ d, b = c * a * d, from ⟨d, by cc⟩

lemma eq_of_dvd_of_div_eq_one {a b : ℕ} (w : a ∣ b) (h : b / a = 1) : a = b :=
by rw [←nat.div_mul_cancel w, h, one_mul]

lemma eq_zero_of_dvd_of_div_eq_zero {a b : ℕ} (w : a ∣ b) (h : b / a = 0) : b = 0 :=
by rw [←nat.div_mul_cancel w, h, zero_mul]

lemma div_le_div_left {a b c : ℕ} (h₁ : c ≤ b) (h₂ : 0 < c) : a / b ≤ a / c :=
(nat.le_div_iff_mul_le h₂).2 $
  le_trans (nat.mul_le_mul_left _ h₁) (div_mul_le_self _ _)

lemma lt_iff_le_pred : ∀ {m n : ℕ}, 0 < n → (m < n ↔ m ≤ n - 1)
| m (n+1) _ := lt_succ_iff

lemma mul_div_le (m n : ℕ) : n * (m / n) ≤ m :=
begin
  cases nat.eq_zero_or_pos n with n0 h,
  { rw [n0, zero_mul], exact m.zero_le },
  { rw [mul_comm, ← nat.le_div_iff_mul_le' h] },
end

lemma lt_mul_div_succ (m : ℕ) {n : ℕ} (n0 : 0 < n) : m < n * ((m / n) + 1) :=
begin
  rw [mul_comm, ← nat.div_lt_iff_lt_mul' n0],
  exact lt_succ_self _
end

lemma mul_add_mod (a b c : ℕ) : (a * b + c) % b = c % b :=
by simp [nat.add_mod]

lemma mul_add_mod_of_lt {a b c : ℕ} (h : c < b) : (a * b + c) % b = c :=
by rw [nat.mul_add_mod, nat.mod_eq_of_lt h]

lemma pred_eq_self_iff {n : ℕ} : n.pred = n ↔ n = 0 :=
by { cases n; simp [(nat.succ_ne_self _).symm] }

/-! ### `find` -/
section find

variables {p q : ℕ → Prop} [decidable_pred p] [decidable_pred q]

lemma find_eq_iff (h : ∃ n : ℕ, p n) : nat.find h = m ↔ p m ∧ ∀ n < m, ¬ p n :=
begin
  split,
  { rintro rfl, exact ⟨nat.find_spec h, λ _, nat.find_min h⟩ },
  { rintro ⟨hm, hlt⟩,
    exact le_antisymm (nat.find_min' h hm) (not_lt.1 $ imp_not_comm.1 (hlt _) $ nat.find_spec h) }
end

@[simp] lemma find_lt_iff (h : ∃ n : ℕ, p n) (n : ℕ) : nat.find h < n ↔ ∃ m < n, p m :=
⟨λ h2, ⟨nat.find h, h2, nat.find_spec h⟩, λ ⟨m, hmn, hm⟩, (nat.find_min' h hm).trans_lt hmn⟩

@[simp]

@[simp] lemma le_find_iff (h : ∃ (n : ℕ), p n) (n : ℕ) : n ≤ nat.find h ↔ ∀ m < n, ¬ p m :=
by simp_rw [← not_lt, find_lt_iff, not_exists]

@[simp] lemma lt_find_iff (h : ∃ n : ℕ, p n) (n : ℕ) : n < nat.find h ↔ ∀ m ≤ n, ¬ p m :=
by simp only [← succ_le_iff, le_find_iff, succ_le_succ_iff]

@[simp] lemma find_eq_zero (h : ∃ n : ℕ, p n) : nat.find h = 0 ↔ p 0 :=
by simp [find_eq_iff]

theorem find_mono (h : ∀ n, q n → p n) {hp : ∃ n, p n} {hq : ∃ n, q n} :
  nat.find hp ≤ nat.find hq :=
nat.find_min' _ (h _ (nat.find_spec hq))

lemma find_le {h : ∃ n, p n} (hn : p n) : nat.find h ≤ n :=
(nat.find_le_iff _ _).2 ⟨n, le_rfl, hn⟩

lemma find_comp_succ (h₁ : ∃ n, p n) (h₂ : ∃ n, p (n + 1)) (h0 : ¬ p 0) :
  nat.find h₁ = nat.find h₂ + 1 :=
begin
  refine (find_eq_iff _).2 ⟨nat.find_spec h₂, λ n hn, _⟩,
  cases n with n,
  exacts [h0, @nat.find_min (λ n, p (n + 1)) _ h₂ _ (succ_lt_succ_iff.1 hn)]
end

end find

/-! ### `find_greatest` -/
section find_greatest

/-- `find_greatest P b` is the largest `i ≤ bound` such that `P i` holds, or `0` if no such `i`
exists -/
protected def find_greatest (P : ℕ → Prop) [decidable_pred P] : ℕ → ℕ
| 0       := 0
| (n + 1) := if P (n + 1) then n + 1 else find_greatest n

variables {P Q : ℕ → Prop} [decidable_pred P] {b : ℕ}

@[simp] lemma find_greatest_zero : nat.find_greatest P 0 = 0 := rfl

lemma find_greatest_succ (n : ℕ) :
  nat.find_greatest P (n + 1) = if P (n + 1) then n + 1 else nat.find_greatest P n := rfl

@[simp] lemma find_greatest_eq : ∀ {b}, P b → nat.find_greatest P b = b
| 0       h := rfl
| (n + 1) h := by simp [nat.find_greatest, h]

@[simp] lemma find_greatest_of_not (h : ¬ P (b + 1)) :
  nat.find_greatest P (b + 1) = nat.find_greatest P b :=
by simp [nat.find_greatest, h]

end find_greatest

/-! ### decidability of predicates -/

instance decidable_ball_lt (n : nat) (P : Π k < n, Prop) :
  ∀ [H : ∀ n h, decidable (P n h)], decidable (∀ n h, P n h) :=
begin
  induction n with n IH; intro; resetI,
  { exact is_true (λ n, dec_trivial) },
  cases IH (λ k h, P k (lt_succ_of_lt h)) with h,
  { refine is_false (mt _ h), intros hn k h, apply hn },
  by_cases p : P n (lt_succ_self n),
  { exact is_true (λ k h',
     (le_of_lt_succ h').lt_or_eq_dec.elim (h _)
       (λ e, match k, e, h' with _, rfl, h := p end)) },
  { exact is_false (mt (λ hn, hn _ _) p) }
end

instance decidable_forall_fin {n : ℕ} (P : fin n → Prop)
  [H : decidable_pred P] : decidable (∀ i, P i) :=
decidable_of_iff (∀ k h, P ⟨k, h⟩) ⟨λ a ⟨k, h⟩, a k h, λ a k h, a ⟨k, h⟩⟩

instance decidable_ball_le (n : ℕ) (P : Π k ≤ n, Prop)
  [H : ∀ n h, decidable (P n h)] : decidable (∀ n h, P n h) :=
decidable_of_iff (∀ k (h : k < succ n), P k (le_of_lt_succ h))
⟨λ a k h, a k (lt_succ_of_le h), λ a k h, a k _⟩

instance decidable_exists_lt {P : ℕ → Prop} [h : decidable_pred P] :
  decidable_pred (λ n, ∃ (m : ℕ), m < n ∧ P m)
| 0 := is_false (by simp)
| (n + 1) := decidable_of_decidable_of_iff (@or.decidable _ _ (decidable_exists_lt n) (h n))
  (by simp only [lt_succ_iff_lt_or_eq, or_and_distrib_right, exists_or_distrib, exists_eq_left])

instance decidable_exists_le {P : ℕ → Prop} [h : decidable_pred P] :
  decidable_pred (λ n, ∃ (m : ℕ), m ≤ n ∧ P m) :=
λ n, decidable_of_iff (∃ m, m < n + 1 ∧ P m) (exists_congr (λ x, and_congr_left' lt_succ_iff))

end nat