/-
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

! This file was ported from Lean 3 source module data.pi.interval
! leanprover-community/mathlib commit d101e93197bb5f6ea89bd7ba386b7f7dff1f3903
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Finset.LocallyFinite
import Mathlib.Data.Fintype.BigOperators

/-!
# Intervals in a pi type

This file shows that (dependent) functions to locally finite orders equipped with the pointwise
order are locally finite and calculates the cardinality of their intervals.
-/

open Finset Fintype

open BigOperators

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

namespace Pi

section LocallyFinite

variable [DecidableEq ι] [Fintype ι] [∀ i, DecidableEq (α i)] [∀ i, PartialOrder (α i)]
  [∀ i, LocallyFiniteOrder (α i)]

instance : LocallyFiniteOrder (∀ i, α i) :=
  LocallyFiniteOrder.ofIcc _ (fun a b => piFinset fun i => Icc (a i) (b i)) fun a b x => by
    simp_rw [mem_piFinset, mem_Icc, le_def, forall_and]

variable (a b : ∀ i, α i)

theorem Icc_eq : Icc a b = piFinset fun i => Icc (a i) (b i) :=
  rfl
#align pi.Icc_eq Pi.Icc_eq

theorem card_Icc : (Icc a b).card = ∏ i, (Icc (a i) (b i)).card :=
  card_piFinset _
#align pi.card_Icc Pi.card_Icc

theorem card_Ico : (Ico a b).card = (∏ i, (Icc (a i) (b i)).card) - 1 := by
  rw [card_Ico_eq_card_Icc_sub_one, card_Icc]
#align pi.card_Ico Pi.card_Ico

theorem card_Ioc : (Ioc a b).card = (∏ i, (Icc (a i) (b i)).card) - 1 := by
  rw [card_Ioc_eq_card_Icc_sub_one, card_Icc]
#align pi.card_Ioc Pi.card_Ioc

theorem card_Ioo : (Ioo a b).card = (∏ i, (Icc (a i) (b i)).card) - 2 := by
  rw [card_Ioo_eq_card_Icc_sub_two, card_Icc]
#align pi.card_Ioo Pi.card_Ioo

end LocallyFinite

section Bounded

variable [DecidableEq ι] [Fintype ι] [∀ i, DecidableEq (α i)] [∀ i, PartialOrder (α i)]

section Bot

variable [∀ i, LocallyFiniteOrderBot (α i)] (b : ∀ i, α i)

instance : LocallyFiniteOrderBot (∀ i, α i) :=
  LocallyFiniteOrderTop.ofIic _ (fun b => piFinset fun i => Iic (b i)) fun b x => by
    simp_rw [mem_piFinset, mem_Iic, le_def]

theorem card_Iic : (Iic b).card = ∏ i, (Iic (b i)).card :=
  card_piFinset _
#align pi.card_Iic Pi.card_Iic

theorem card_Iio : (Iio b).card = (∏ i, (Iic (b i)).card) - 1 := by
  rw [card_Iio_eq_card_Iic_sub_one, card_Iic]
#align pi.card_Iio Pi.card_Iio

end Bot

section Top

variable [∀ i, LocallyFiniteOrderTop (α i)] (a : ∀ i, α i)

instance : LocallyFiniteOrderTop (∀ i, α i) :=
  LocallyFiniteOrderTop.ofIci _ (fun a => piFinset fun i => Ici (a i)) fun a x => by
    simp_rw [mem_piFinset, mem_Ici, le_def]

theorem card_Ici : (Ici a).card = ∏ i, (Ici (a i)).card :=
  card_piFinset _
#align pi.card_Ici Pi.card_Ici

theorem card_Ioi : (Ioi a).card = (∏ i, (Ici (a i)).card) - 1 := by
  rw [card_Ioi_eq_card_Ici_sub_one, card_Ici]
#align pi.card_Ioi Pi.card_Ioi

end Top

end Bounded

end Pi


/-
Copyright (c) 2020 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn
-/
import measure_theory.content
import measure_theory.prod_group

/-!
# Haar measure

In this file we prove the existence of Haar measure for a locally compact Hausdorff topological
group.

For the construction, we follow the write-up by Jonathan Gleason,
*Existence and Uniqueness of Haar Measure*.
This is essentially the same argument as in
https://en.wikipedia.org/wiki/Haar_measure#A_construction_using_compact_subsets.

We construct the Haar measure first on compact sets. For this we define `(K : U)` as the (smallest)
number of left-translates of `U` are needed to cover `K` (`index` in the formalization).
Then we define a function `h` on compact sets as `lim_U (K : U) / (K₀ : U)`,
where `U` becomes a smaller and smaller open neighborhood of `1`, and `K₀` is a fixed compact set
with nonempty interior. This function is `chaar` in the formalization, and we define the limit
formally using Tychonoff's theorem.

This function `h` forms a content, which we can extend to an outer measure `μ`
(`haar_outer_measure`), and obtain the Haar measure from that (`haar_measure`).
We normalize the Haar measure so that the measure of `K₀` is `1`.
We show that for second countable spaces any left invariant Borel measure is a scalar multiple of
the Haar measure.

Note that `μ` need not coincide with `h` on compact sets, according to
[halmos1950measure, ch. X, §53 p.233]. However, we know that `h(K)` lies between `μ(Kᵒ)` and `μ(K)`,
where `ᵒ` denotes the interior.

## Main Declarations

* `haar_measure`: the Haar measure on a locally compact Hausdorff group. This is a left invariant
  regular measure. It takes as argument a compact set of the group (with non-empty interior),
  and is normalized so that the measure of the given set is 1.
* `haar_measure_self`: the Haar measure is normalized.
* `is_left_invariant_haar_measure`: the Haar measure is left invariant.
* `regular_haar_measure`: the Haar measure is a regular measure.

## References
* Paul Halmos (1950), Measure Theory, §53
* Jonathan Gleason, Existence and Uniqueness of Haar Measure
  - Note: step 9, page 8 contains a mistake: the last defined `μ` does not extend the `μ` on compact
    sets, see Halmos (1950) p. 233, bottom of the page. This makes some other steps (like step 11)
    invalid.
* https://en.wikipedia.org/wiki/Haar_measure
-/
noncomputable theory

open set has_inv function topological_space measurable_space
open_locale nnreal classical ennreal

variables {G : Type*} [group G]

namespace measure_theory
namespace measure

/-! We put the internal functions in the construction of the Haar measure in a namespace,
  so that the chosen names don't clash with other declarations.
  We first define a couple of the functions before proving the properties (that require that `G`
  is a topological group). -/
namespace haar

/-- The index or Haar covering number or ratio of `K` w.r.t. `V`, denoted `(K : V)`:
  it is the smallest number of (left) translates of `V` that is necessary to cover `K`.
  It is defined to be 0 if no finite number of translates cover `K`. -/
def index (K V : set G) : ℕ :=
Inf $ finset.card '' {t : finset G | K ⊆ ⋃ g ∈ t, (λ h, g * h) ⁻¹' V }

lemma index_empty {V : set G} : index ∅ V = 0 :=
begin
  simp only [index, nat.Inf_eq_zero], left, use ∅,
  simp only [finset.card_empty, empty_subset, mem_set_of_eq, eq_self_iff_true, and_self],
end

variables [topological_space G]

/-- `prehaar K₀ U K` is a weighted version of the index, defined as `(K : U)/(K₀ : U)`.
  In the applications `K₀` is compact with non-empty interior, `U` is open containing `1`,
  and `K` is any compact set.
  The argument `K` is a (bundled) compact set, so that we can consider `prehaar K₀ U` as an
  element of `haar_product` (below). -/
def prehaar (K₀ U : set G) (K : compacts G) : ℝ := (index K.1 U : ℝ) / index K₀ U

lemma prehaar_empty (K₀ : positive_compacts G) {U : set G} : prehaar K₀.1 U ⊥ = 0 :=
by { simp only [prehaar, compacts.bot_val, index_empty, nat.cast_zero, zero_div] }

lemma prehaar_nonneg (K₀ : positive_compacts G) {U : set G} (K : compacts G) :
  0 ≤ prehaar K₀.1 U K :=
by apply div_nonneg; norm_cast; apply zero_le

/-- `haar_product K₀` is the product of intervals `[0, (K : K₀)]`, for all compact sets `K`.
  For all `U`, we can show that `prehaar K₀ U ∈ haar_product K₀`. -/
def haar_product (K₀ : set G) : set (compacts G → ℝ) :=
pi univ (λ K, Icc 0 $ index K.1 K₀)

@[simp] lemma mem_prehaar_empty {K₀ : set G} {f : compacts G → ℝ} :
  f ∈ haar_product K₀ ↔ ∀ K : compacts G, f K ∈ Icc (0 : ℝ) (index K.1 K₀) :=
by simp only [haar_product, pi, forall_prop_of_true, mem_univ, mem_set_of_eq]

/-- The closure of the collection of elements of the form `prehaar K₀ U`,
  for `U` open neighbourhoods of `1`, contained in `V`. The closure is taken in the space
  `compacts G → ℝ`, with the topology of pointwise convergence.
  We show that the intersection of all these sets is nonempty, and the Haar measure
  on compact sets is defined to be an element in the closure of this intersection. -/
def cl_prehaar (K₀ : set G) (V : open_nhds_of (1 : G)) : set (compacts G → ℝ) :=
closure $ prehaar K₀ '' { U : set G | U ⊆ V.1 ∧ is_open U ∧ (1 : G) ∈ U }

variables [topological_group G]

/-!
### Lemmas about `index`
-/

/-- If `K` is compact and `V` has nonempty interior, then the index `(K : V)` is well-defined,
  there is a finite set `t` satisfying the desired properties. -/
lemma index_defined {K V : set G} (hK : is_compact K) (hV : (interior V).nonempty) :
  ∃ n : ℕ, n ∈ finset.card '' {t : finset G | K ⊆ ⋃ g ∈ t, (λ h, g * h) ⁻¹' V } :=
by { rcases compact_covered_by_mul_left_translates hK hV with ⟨t, ht⟩, exact ⟨t.card, t, ht, rfl⟩ }

lemma index_elim {K V : set G} (hK : is_compact K) (hV : (interior V).nonempty) :
  ∃ (t : finset G), K ⊆ (⋃ g ∈ t, (λ h, g * h) ⁻¹' V) ∧ finset.card t = index K V :=
by { have := nat.Inf_mem (index_defined hK hV), rwa [mem_image] at this }

lemma le_index_mul (K₀ : positive_compacts G) (K : compacts G) {V : set G}
  (hV : (interior V).nonempty) : index K.1 V ≤ index K.1 K₀.1 * index K₀.1 V :=
begin
  rcases index_elim K.2 K₀.2.2 with ⟨s, h1s, h2s⟩,
  rcases index_elim K₀.2.1 hV with ⟨t, h1t, h2t⟩,
  rw [← h2s, ← h2t, mul_comm],
  refine le_trans _ finset.mul_card_le,
  apply nat.Inf_le, refine ⟨_, _, rfl⟩, rw [mem_set_of_eq], refine subset.trans h1s _,
  apply bUnion_subset, intros g₁ hg₁, rw preimage_subset_iff, intros g₂ hg₂,
  have := h1t hg₂,
  rcases this with ⟨_, ⟨g₃, rfl⟩, A, ⟨hg₃, rfl⟩, h2V⟩, rw [mem_preimage, ← mul_assoc] at h2V,
  exact mem_bUnion (finset.mul_mem_mul hg₃ hg₁) h2V
end

lemma index_pos (K : positive_compacts G) {V : set G} (hV : (interior V).nonempty) :
  0 < index K.1 V :=
begin
  unfold index, rw [nat.Inf_def, nat.find_pos, mem_image],
  { rintro ⟨t, h1t, h2t⟩, rw [finset.card_eq_zero] at h2t, subst h2t,
    cases K.2.2 with g hg,
    show g ∈ (∅ : set G), convert h1t (interior_subset hg), symmetry, apply bUnion_empty },
  { exact index_defined K.2.1 hV }
end

lemma index_mono {K K' V : set G} (hK' : is_compact K') (h : K ⊆ K')
  (hV : (interior V).nonempty) : index K V ≤ index K' V :=
begin
  rcases index_elim hK' hV with ⟨s, h1s, h2s⟩,
  apply nat.Inf_le, rw [mem_image], refine ⟨s, subset.trans h h1s, h2s⟩
end

lemma index_union_le (K₁ K₂ : compacts G) {V : set G} (hV : (interior V).nonempty) :
  index (K₁.1 ∪ K₂.1) V ≤ index K₁.1 V + index K₂.1 V :=
begin
  rcases index_elim K₁.2 hV with ⟨s, h1s, h2s⟩,
  rcases index_elim K₂.2 hV with ⟨t, h1t, h2t⟩,
  rw [← h2s, ← h2t],
  refine le_trans _ (finset.card_union_le _ _),
  apply nat.Inf_le, refine ⟨_, _, rfl⟩, rw [mem_set_of_eq],
  apply union_subset; refine subset.trans (by assumption) _; apply bUnion_subset_bUnion_left;
    intros g hg; simp only [mem_def] at hg;
    simp only [mem_def, multiset.mem_union, finset.union_val, hg, or_true, true_or]
end

lemma index_union_eq (K₁ K₂ : compacts G) {V : set G} (hV : (interior V).nonempty)
  (h : disjoint (K₁.1 * V⁻¹) (K₂.1 * V⁻¹)) :
  index (K₁.1 ∪ K₂.1) V = index K₁.1 V + index K₂.1 V :=
begin
  apply le_antisymm (index_union_le K₁ K₂ hV),
  rcases index_elim (K₁.2.union K₂.2) hV with ⟨s, h1s, h2s⟩, rw [← h2s],
  have : ∀ (K : set G) , K ⊆ (⋃ g ∈ s, (λ h, g * h) ⁻¹' V) →
    index K V ≤ (s.filter (λ g, ((λ (h : G), g * h) ⁻¹' V ∩ K).nonempty)).card,
  { intros K hK, apply nat.Inf_le, refine ⟨_, _, rfl⟩, rw [mem_set_of_eq],
    intros g hg, rcases hK hg with ⟨_, ⟨g₀, rfl⟩, _, ⟨h1g₀, rfl⟩, h2g₀⟩,
    simp only [mem_preimage] at h2g₀,
    simp only [mem_Union], use g₀, split,
    { simp only [finset.mem_filter, h1g₀, true_and], use g,
      simp only [hg, h2g₀, mem_inter_eq, mem_preimage, and_self] },
    exact h2g₀ },
  refine le_trans (add_le_add (this K₁.1 $ subset.trans (subset_union_left _ _) h1s)
    (this K₂.1 $ subset.trans (subset_union_right _ _) h1s)) _,
  rw [← finset.card_union_eq, finset.filter_union_right],
  exact s.card_filter_le _,
  apply finset.disjoint_filter.mpr,
  rintro g₁ h1g₁ ⟨g₂, h1g₂, h2g₂⟩ ⟨g₃, h1g₃, h2g₃⟩,
  simp only [mem_preimage] at h1g₃ h1g₂,
  apply @h g₁⁻¹,
  split; simp only [set.mem_inv, set.mem_mul, exists_exists_and_eq_and, exists_and_distrib_left],
  { refine ⟨_, h2g₂, (g₁ * g₂)⁻¹, _, _⟩, simp only [inv_inv, h1g₂],
    simp only [mul_inv_rev, mul_inv_cancel_left] },
  { refine ⟨_, h2g₃, (g₁ * g₃)⁻¹, _, _⟩, simp only [inv_inv, h1g₃],
    simp only [mul_inv_rev, mul_inv_cancel_left] }
end

lemma mul_left_index_le {K : set G} (hK : is_compact K) {V : set G} (hV : (interior V).nonempty)
  (g : G) : index ((λ h, g * h) '' K) V ≤ index K V :=
begin
  rcases index_elim hK hV with ⟨s, h1s, h2s⟩, rw [← h2s],
  apply nat.Inf_le, rw [mem_image],
  refine ⟨s.map (equiv.mul_right g⁻¹).to_embedding, _, finset.card_map _⟩,
  { simp only [mem_set_of_eq], refine subset.trans (image_subset _ h1s) _,
    rintro _ ⟨g₁, ⟨_, ⟨g₂, rfl⟩, ⟨_, ⟨hg₂, rfl⟩, hg₁⟩⟩, rfl⟩,
    simp only [mem_preimage] at hg₁, simp only [exists_prop, mem_Union, finset.mem_map,
      equiv.coe_mul_right, exists_exists_and_eq_and, mem_preimage, equiv.to_embedding_apply],
    refine ⟨_, hg₂, _⟩, simp only [mul_assoc, hg₁, inv_mul_cancel_left] }
end

lemma is_left_invariant_index {K : set G} (hK : is_compact K) (g : G) {V : set G}
  (hV : (interior V).nonempty) : index ((λ h, g * h) '' K) V = index K V :=
begin
  refine le_antisymm (mul_left_index_le hK hV g) _,
  convert mul_left_index_le (hK.image $ continuous_mul_left g) hV g⁻¹,
  rw [image_image], symmetry, convert image_id' _, ext h, apply inv_mul_cancel_left
end

/-!
### Lemmas about `prehaar`
-/

lemma prehaar_le_index (K₀ : positive_compacts G) {U : set G} (K : compacts G)
  (hU : (interior U).nonempty) : prehaar K₀.1 U K ≤ index K.1 K₀.1 :=
begin
  unfold prehaar, rw [div_le_iff]; norm_cast,
  { apply le_index_mul K₀ K hU },
  { exact index_pos K₀ hU }
end

lemma prehaar_pos (K₀ : positive_compacts G) {U : set G} (hU : (interior U).nonempty)
  {K : set G} (h1K : is_compact K) (h2K : (interior K).nonempty) : 0 < prehaar K₀.1 U ⟨K, h1K⟩ :=
by { apply div_pos; norm_cast, apply index_pos ⟨K, h1K, h2K⟩ hU, exact index_pos K₀ hU }

lemma prehaar_mono {K₀ : positive_compacts G} {U : set G} (hU : (interior U).nonempty)
  {K₁ K₂ : compacts G} (h : K₁.1 ⊆ K₂.1) : prehaar K₀.1 U K₁ ≤ prehaar K₀.1 U K₂ :=
begin
  simp only [prehaar], rw [div_le_div_right], exact_mod_cast index_mono K₂.2 h hU,
  exact_mod_cast index_pos K₀ hU
end

lemma prehaar_self {K₀ : positive_compacts G} {U : set G} (hU : (interior U).nonempty) :
  prehaar K₀.1 U ⟨K₀.1, K₀.2.1⟩ = 1 :=
by { simp only [prehaar], rw [div_self], apply ne_of_gt, exact_mod_cast index_pos K₀ hU }

lemma prehaar_sup_le {K₀ : positive_compacts G} {U : set G} (K₁ K₂ : compacts G)
  (hU : (interior U).nonempty) : prehaar K₀.1 U (K₁ ⊔ K₂) ≤ prehaar K₀.1 U K₁ + prehaar K₀.1 U K₂ :=
begin
  simp only [prehaar], rw [div_add_div_same, div_le_div_right],
  exact_mod_cast index_union_le K₁ K₂ hU, exact_mod_cast index_pos K₀ hU
end

lemma prehaar_sup_eq {K₀ : positive_compacts G} {U : set G} {K₁ K₂ : compacts G}
  (hU : (interior U).nonempty) (h : disjoint (K₁.1 * U⁻¹) (K₂.1 * U⁻¹)) :
  prehaar K₀.1 U (K₁ ⊔ K₂) = prehaar K₀.1 U K₁ + prehaar K₀.1 U K₂ :=
by { simp only [prehaar], rw [div_add_div_same], congr', exact_mod_cast index_union_eq K₁ K₂ hU h }

lemma is_left_invariant_prehaar {K₀ : positive_compacts G} {U : set G} (hU : (interior U).nonempty)
  (g : G) (K : compacts G) : prehaar K₀.1 U (K.map _ $ continuous_mul_left g) = prehaar K₀.1 U K :=
by simp only [prehaar, compacts.map_val, is_left_invariant_index K.2 _ hU]

/-!
### Lemmas about `haar_product`
-/

lemma prehaar_mem_haar_product (K₀ : positive_compacts G) {U : set G}
  (hU : (interior U).nonempty) : prehaar K₀.1 U ∈ haar_product K₀.1 :=
by { rintro ⟨K, hK⟩ h2K, rw [mem_Icc], exact ⟨prehaar_nonneg K₀ _, prehaar_le_index K₀ _ hU⟩ }

lemma nonempty_Inter_cl_prehaar (K₀ : positive_compacts G) :
  (haar_product K₀.1 ∩ ⋂ (V : open_nhds_of (1 : G)), cl_prehaar K₀.1 V).nonempty :=
begin
  have : is_compact (haar_product K₀.1), { apply compact_univ_pi, intro K, apply compact_Icc },
  refine this.inter_Inter_nonempty (cl_prehaar K₀.1) (λ s, is_closed_closure) (λ t, _),
  let V₀ := ⋂ (V ∈ t), (V : open_nhds_of 1).1,
  have h1V₀ : is_open V₀,
  { apply is_open_bInter, apply finite_mem_finset, rintro ⟨V, hV⟩ h2V, exact hV.1 },
  have h2V₀ : (1 : G) ∈ V₀, { simp only [mem_Inter], rintro ⟨V, hV⟩ h2V, exact hV.2 },
  refine ⟨prehaar K₀.1 V₀, _⟩,
  split,
  { apply prehaar_mem_haar_product K₀, use 1, rwa h1V₀.interior_eq },
  { simp only [mem_Inter], rintro ⟨V, hV⟩ h2V, apply subset_closure,
    apply mem_image_of_mem, rw [mem_set_of_eq],
    exact ⟨subset.trans (Inter_subset _ ⟨V, hV⟩) (Inter_subset _ h2V), h1V₀, h2V₀⟩ },
end

/-!
### Lemmas about `chaar`
-/

/-- This is the "limit" of `prehaar K₀.1 U K` as `U` becomes a smaller and smaller open
  neighborhood of `(1 : G)`. More precisely, it is defined to be an arbitrary element
  in the intersection of all the sets `cl_prehaar K₀ V` in `haar_product K₀`.
  This is roughly equal to the Haar measure on compact sets,
  but it can differ slightly. We do know that
  `haar_measure K₀ (interior K.1) ≤ chaar K₀ K ≤ haar_measure K₀ K.1`.
  These inequalities are given by `measure_theory.measure.haar_outer_measure_le_echaar` and
  `measure_theory.measure.echaar_le_haar_outer_measure`. -/
def chaar (K₀ : positive_compacts G) (K : compacts G) : ℝ :=
classical.some (nonempty_Inter_cl_prehaar K₀) K

lemma chaar_mem_haar_product (K₀ : positive_compacts G) : chaar K₀ ∈ haar_product K₀.1 :=
(classical.some_spec (nonempty_Inter_cl_prehaar K₀)).1

lemma chaar_mem_cl_prehaar (K₀ : positive_compacts G) (V : open_nhds_of (1 : G)) :
  chaar K₀ ∈ cl_prehaar K₀.1 V :=
by { have := (classical.some_spec (nonempty_Inter_cl_prehaar K₀)).2, rw [mem_Inter] at this,
     exact this V }

lemma chaar_nonneg (K₀ : positive_compacts G) (K : compacts G) : 0 ≤ chaar K₀ K :=
by { have := chaar_mem_haar_product K₀ K (mem_univ _), rw mem_Icc at this, exact this.1 }

lemma chaar_empty (K₀ : positive_compacts G) : chaar K₀ ⊥ = 0 :=
begin
  let eval : (compacts G → ℝ) → ℝ := λ f, f ⊥,
  have : continuous eval := continuous_apply ⊥,
  show chaar K₀ ∈ eval ⁻¹' {(0 : ℝ)},
  apply mem_of_subset_of_mem _ (chaar_mem_cl_prehaar K₀ ⟨set.univ, is_open_univ, mem_univ _⟩),
  unfold cl_prehaar, rw is_closed.closure_subset_iff,
  { rintro _ ⟨U, ⟨h1U, h2U, h3U⟩, rfl⟩, apply prehaar_empty },
  { apply continuous_iff_is_closed.mp this, exact is_closed_singleton },
end

lemma chaar_self (K₀ : positive_compacts G) : chaar K₀ ⟨K₀.1, K₀.2.1⟩ = 1 :=
begin
  let eval : (compacts G → ℝ) → ℝ := λ f, f ⟨K₀.1, K₀.2.1⟩,
  have : continuous eval := continuous_apply _,
  show chaar K₀ ∈ eval ⁻¹' {(1 : ℝ)},
  apply mem_of_subset_of_mem _ (chaar_mem_cl_prehaar K₀ ⟨set.univ, is_open_univ, mem_univ _⟩),
  unfold cl_prehaar, rw is_closed.closure_subset_iff,
  { rintro _ ⟨U, ⟨h1U, h2U, h3U⟩, rfl⟩, apply prehaar_self,
    rw h2U.interior_eq, exact ⟨1, h3U⟩ },
  { apply continuous_iff_is_closed.mp this, exact is_closed_singleton }
end

lemma chaar_mono {K₀ : positive_compacts G} {K₁ K₂ : compacts G} (h : K₁.1 ⊆ K₂.1) :
  chaar K₀ K₁ ≤ chaar K₀ K₂ :=
begin
  let eval : (compacts G → ℝ) → ℝ := λ f, f K₂ - f K₁,
  have : continuous eval := (continuous_apply K₂).sub (continuous_apply K₁),
  rw [← sub_nonneg], show chaar K₀ ∈ eval ⁻¹' (Ici (0 : ℝ)),
  apply mem_of_subset_of_mem _ (chaar_mem_cl_prehaar K₀ ⟨set.univ, is_open_univ, mem_univ _⟩),
  unfold cl_prehaar, rw is_closed.closure_subset_iff,
  { rintro _ ⟨U, ⟨h1U, h2U, h3U⟩, rfl⟩, simp only [mem_preimage, mem_Ici, eval, sub_nonneg],
    apply prehaar_mono _ h, rw h2U.interior_eq, exact ⟨1, h3U⟩ },
  { apply continuous_iff_is_closed.mp this, exact is_closed_Ici },
end

lemma chaar_sup_le {K₀ : positive_compacts G} (K₁ K₂ : compacts G) :
  chaar K₀ (K₁ ⊔ K₂) ≤ chaar K₀ K₁ + chaar K₀ K₂ :=
begin
  let eval : (compacts G → ℝ) → ℝ := λ f, f K₁ + f K₂ - f (K₁ ⊔ K₂),
  have : continuous eval :=
    ((@continuous_add ℝ _ _ _).comp ((continuous_apply K₁).prod_mk (continuous_apply K₂))).sub
      (continuous_apply (K₁ ⊔ K₂)),
  rw [← sub_nonneg], show chaar K₀ ∈ eval ⁻¹' (Ici (0 : ℝ)),
  apply mem_of_subset_of_mem _ (chaar_mem_cl_prehaar K₀ ⟨set.univ, is_open_univ, mem_univ _⟩),
  unfold cl_prehaar, rw is_closed.closure_subset_iff,
  { rintro _ ⟨U, ⟨h1U, h2U, h3U⟩, rfl⟩, simp only [mem_preimage, mem_Ici, eval, sub_nonneg],
    apply prehaar_sup_le, rw h2U.interior_eq, exact ⟨1, h3U⟩ },
  { apply continuous_iff_is_closed.mp this, exact is_closed_Ici },
end

lemma chaar_sup_eq [t2_space G] {K₀ : positive_compacts G} {K₁ K₂ : compacts G}
  (h : disjoint K₁.1 K₂.1) : chaar K₀ (K₁ ⊔ K₂) = chaar K₀ K₁ + chaar K₀ K₂ :=
begin
  rcases compact_compact_separated K₁.2 K₂.2 (disjoint_iff.mp h) with
    ⟨U₁, U₂, h1U₁, h1U₂, h2U₁, h2U₂, hU⟩,
  rw [← disjoint_iff_inter_eq_empty] at hU,
  rcases compact_open_separated_mul K₁.2 h1U₁ h2U₁ with ⟨V₁, h1V₁, h2V₁, h3V₁⟩,
  rcases compact_open_separated_mul K₂.2 h1U₂ h2U₂ with ⟨V₂, h1V₂, h2V₂, h3V₂⟩,
  let eval : (compacts G → ℝ) → ℝ := λ f, f K₁ + f K₂ - f (K₁ ⊔ K₂),
  have : continuous eval :=
    ((@continuous_add ℝ _ _ _).comp ((continuous_apply K₁).prod_mk (continuous_apply K₂))).sub
      (continuous_apply (K₁ ⊔ K₂)),
  rw [eq_comm, ← sub_eq_zero], show chaar K₀ ∈ eval ⁻¹' {(0 : ℝ)},
  let V := V₁ ∩ V₂,
  apply mem_of_subset_of_mem _ (chaar_mem_cl_prehaar K₀
    ⟨V⁻¹, (is_open_inter h1V₁ h1V₂).preimage continuous_inv,
    by simp only [mem_inv, one_inv, h2V₁, h2V₂, V, mem_inter_eq, true_and]⟩),
  unfold cl_prehaar, rw is_closed.closure_subset_iff,
  { rintro _ ⟨U, ⟨h1U, h2U, h3U⟩, rfl⟩,
    simp only [mem_preimage, eval, sub_eq_zero, mem_singleton_iff], rw [eq_comm],
    apply prehaar_sup_eq,
    { rw h2U.interior_eq, exact ⟨1, h3U⟩ },
    { refine disjoint_of_subset _ _ hU,
      { refine subset.trans (mul_subset_mul subset.rfl _) h3V₁,
        exact subset.trans (inv_subset.mpr h1U) (inter_subset_left _ _) },
      { refine subset.trans (mul_subset_mul subset.rfl _) h3V₂,
        exact subset.trans (inv_subset.mpr h1U) (inter_subset_right _ _) }}},
  { apply continuous_iff_is_closed.mp this, exact is_closed_singleton },
end

lemma is_left_invariant_chaar {K₀ : positive_compacts G} (g : G) (K : compacts G) :
  chaar K₀ (K.map _ $ continuous_mul_left g) = chaar K₀ K :=
begin
  let eval : (compacts G → ℝ) → ℝ := λ f, f (K.map _ $ continuous_mul_left g) - f K,
  have : continuous eval := (continuous_apply (K.map _ _)).sub (continuous_apply K),
  rw [← sub_eq_zero], show chaar K₀ ∈ eval ⁻¹' {(0 : ℝ)},
  apply mem_of_subset_of_mem _ (chaar_mem_cl_prehaar K₀ ⟨set.univ, is_open_univ, mem_univ _⟩),
  unfold cl_prehaar, rw is_closed.closure_subset_iff,
  { rintro _ ⟨U, ⟨h1U, h2U, h3U⟩, rfl⟩,
    simp only [mem_singleton_iff, mem_preimage, eval, sub_eq_zero],
    apply is_left_invariant_prehaar, rw h2U.interior_eq, exact ⟨1, h3U⟩ },
  { apply continuous_iff_is_closed.mp this, exact is_closed_singleton },
end

/-- The function `chaar` interpreted in `ℝ≥0∞` -/
@[reducible] def echaar (K₀ : positive_compacts G) (K : compacts G) : ℝ≥0∞ :=
show nnreal, from ⟨chaar K₀ K, chaar_nonneg _ _⟩

/-! We only prove the properties for `echaar` that we use at least twice below. -/

/-- The variant of `chaar_sup_le` for `echaar` -/
lemma echaar_sup_le {K₀ : positive_compacts G} (K₁ K₂ : compacts G) :
  echaar K₀ (K₁ ⊔ K₂) ≤ echaar K₀ K₁ + echaar K₀ K₂ :=
by { norm_cast, simp only [←nnreal.coe_le_coe, nnreal.coe_add, subtype.coe_mk, chaar_sup_le]}

/-- The variant of `chaar_mono` for `echaar` -/
lemma echaar_mono {K₀ : positive_compacts G} ⦃K₁ K₂ : compacts G⦄ (h : K₁.1 ⊆ K₂.1) :
  echaar K₀ K₁ ≤ echaar K₀ K₂ :=
by { norm_cast, simp only [←nnreal.coe_le_coe, subtype.coe_mk, chaar_mono, h] }

/-- The variant of `chaar_self` for `echaar` -/
lemma echaar_self {K₀ : positive_compacts G} : echaar K₀ ⟨K₀.1, K₀.2.1⟩ = 1 :=
by { simp_rw [← ennreal.coe_one, echaar, ennreal.coe_eq_coe, chaar_self], refl }

/-- The variant of `is_left_invariant_chaar` for `echaar` -/
lemma is_left_invariant_echaar {K₀ : positive_compacts G} (g : G) (K : compacts G) :
  echaar K₀ (K.map _ $ continuous_mul_left g) = echaar K₀ K :=
by simpa only [ennreal.coe_eq_coe, ←nnreal.coe_eq] using is_left_invariant_chaar g K

end haar
open haar

/-!
### The Haar outer measure
-/

variables [topological_space G] [t2_space G] [topological_group G]

/-- The Haar outer measure on `G`. It is not normalized, and is mainly used to construct
  `haar_measure`, which is a normalized measure. -/
def haar_outer_measure (K₀ : positive_compacts G) : outer_measure G :=
outer_measure.of_content (echaar K₀) $
  by { rw echaar, norm_cast, rw [←nnreal.coe_eq, nnreal.coe_zero, subtype.coe_mk, chaar_empty] }

lemma haar_outer_measure_eq_infi (K₀ : positive_compacts G) (A : set G) :
  haar_outer_measure K₀ A = ⨅ (U : set G) (hU : is_open U) (h : A ⊆ U),
    inner_content (echaar K₀) ⟨U, hU⟩ :=
outer_measure.of_content_eq_infi echaar_sup_le A

lemma echaar_le_haar_outer_measure {K₀ : positive_compacts G} (K : compacts G) :
  echaar K₀ K ≤ haar_outer_measure K₀ K.1 :=
outer_measure.le_of_content_compacts echaar_sup_le K

lemma haar_outer_measure_of_is_open {K₀ : positive_compacts G} (U : set G) (hU : is_open U) :
  haar_outer_measure K₀ U = inner_content (echaar K₀) ⟨U, hU⟩ :=
outer_measure.of_content_opens echaar_sup_le ⟨U, hU⟩

lemma haar_outer_measure_le_echaar {K₀ : positive_compacts G} {U : set G} (hU : is_open U)
  (K : compacts G) (h : U ⊆ K.1) : haar_outer_measure K₀ U ≤ echaar K₀ K :=
(outer_measure.of_content_le echaar_sup_le echaar_mono ⟨U, hU⟩ K h : _)

lemma haar_outer_measure_exists_open {K₀ : positive_compacts G} {A : set G}
  (hA : haar_outer_measure K₀ A < ∞) {ε : ℝ≥0} (hε : 0 < ε) :
  ∃ U : opens G, A ⊆ U ∧ haar_outer_measure K₀ U ≤ haar_outer_measure K₀ A + ε :=
outer_measure.of_content_exists_open echaar_sup_le hA hε

lemma haar_outer_measure_exists_compact {K₀ : positive_compacts G} {U : opens G}
  (hU : haar_outer_measure K₀ U < ∞) {ε : ℝ≥0} (hε : 0 < ε) :
  ∃ K : compacts G, K.1 ⊆ U ∧ haar_outer_measure K₀ U ≤ haar_outer_measure K₀ K.1 + ε :=
outer_measure.of_content_exists_compact echaar_sup_le hU hε

lemma haar_outer_measure_caratheodory {K₀ : positive_compacts G} (A : set G) :
  (haar_outer_measure K₀).caratheodory.measurable_set' A ↔ ∀ (U : opens G),
  haar_outer_measure K₀ (U ∩ A) + haar_outer_measure K₀ (U \ A) ≤ haar_outer_measure K₀ U :=
outer_measure.of_content_caratheodory echaar_sup_le A

lemma one_le_haar_outer_measure_self {K₀ : positive_compacts G} : 1 ≤ haar_outer_measure K₀ K₀.1 :=
begin
  rw [haar_outer_measure_eq_infi],
  refine le_binfi _, intros U hU, refine le_infi _, intros h2U,
  refine le_trans _ (le_bsupr ⟨K₀.1, K₀.2.1⟩ h2U), simp_rw [echaar_self, le_rfl]
end

lemma haar_outer_measure_pos_of_is_open {K₀ : positive_compacts G}
  {U : set G} (hU : is_open U) (h2U : U.nonempty) : 0 < haar_outer_measure K₀ U :=
outer_measure.of_content_pos_of_is_mul_left_invariant echaar_sup_le is_left_invariant_echaar
  ⟨K₀.1, K₀.2.1⟩ (by simp only [echaar_self, ennreal.zero_lt_one]) hU h2U

lemma haar_outer_measure_self_pos {K₀ : positive_compacts G} :
  0 < haar_outer_measure K₀ K₀.1 :=
(haar_outer_measure_pos_of_is_open is_open_interior K₀.2.2).trans_le
  ((haar_outer_measure K₀).mono interior_subset)

lemma haar_outer_measure_lt_top_of_is_compact [locally_compact_space G] {K₀ : positive_compacts G}
  {K : set G} (hK : is_compact K) : haar_outer_measure K₀ K < ∞ :=
begin
  rcases exists_compact_superset hK with ⟨F, h1F, h2F⟩,
  refine ((haar_outer_measure K₀).mono h2F).trans_lt _,
  refine (haar_outer_measure_le_echaar is_open_interior ⟨F, h1F⟩ interior_subset).trans_lt
    ennreal.coe_lt_top
end

variables [S : measurable_space G] [borel_space G]
include S

lemma haar_caratheodory_measurable (K₀ : positive_compacts G) :
  S ≤ (haar_outer_measure K₀).caratheodory :=
begin
  rw [@borel_space.measurable_eq G _ _], refine generate_from_le _,
  intros U hU, rw haar_outer_measure_caratheodory, intro U',
  rw haar_outer_measure_of_is_open ((U' : set G) ∩ U) (is_open_inter U'.prop hU),
  simp only [inner_content, supr_subtype'], rw [opens.coe_mk],
  haveI : nonempty {L : compacts G // L.1 ⊆ U' ∩ U} := ⟨⟨⊥, empty_subset _⟩⟩,
  rw [ennreal.supr_add],
  refine supr_le _, rintro ⟨L, hL⟩, simp only [subset_inter_iff] at hL,
  have : ↑U' \ U ⊆ U' \ L.1 := diff_subset_diff_right hL.2,
  refine le_trans (add_le_add_left ((haar_outer_measure K₀).mono' this) _) _,
  rw haar_outer_measure_of_is_open (↑U' \ L.1) (is_open_diff U'.2 L.2.is_closed),
  simp only [inner_content, supr_subtype'], rw [opens.coe_mk],
  haveI : nonempty {M : compacts G // M.1 ⊆ ↑U' \ L.1} := ⟨⟨⊥, empty_subset _⟩⟩,
  rw [ennreal.add_supr], refine supr_le _, rintro ⟨M, hM⟩, simp only [subset_diff] at hM,
  have : (L ⊔ M).1 ⊆ U',
  { simp only [union_subset_iff, compacts.sup_val, hM, hL, and_self] },
  rw haar_outer_measure_of_is_open ↑U' U'.2,
  refine le_trans (ge_of_eq _) (le_inner_content _ _ this), norm_cast,
  simp only [←nnreal.coe_eq, nnreal.coe_add, subtype.coe_mk], exact chaar_sup_eq hM.2.symm
end

/-!
### The Haar measure
-/

/-- the Haar measure on `G`, scaled so that `haar_measure K₀ K₀ = 1`. -/
def haar_measure (K₀ : positive_compacts G) : measure G :=
(haar_outer_measure K₀ K₀.1)⁻¹ •
  (haar_outer_measure K₀).to_measure (haar_caratheodory_measurable K₀)

lemma haar_measure_apply {K₀ : positive_compacts G} {s : set G} (hs : measurable_set s) :
  haar_measure K₀ s = haar_outer_measure K₀ s / haar_outer_measure K₀ K₀.1 :=
by { simp only [haar_measure, hs, div_eq_mul_inv, mul_comm, to_measure_apply,
      algebra.id.smul_eq_mul, pi.smul_apply, measure.coe_smul] }

lemma is_mul_left_invariant_haar_measure (K₀ : positive_compacts G) :
  is_mul_left_invariant (haar_measure K₀) :=
begin
  intros g A hA,
  rw [haar_measure_apply hA, haar_measure_apply (measurable_const_mul g hA)],
  congr' 1,
  exact outer_measure.is_mul_left_invariant_of_content echaar_sup_le is_left_invariant_echaar g A
end

lemma haar_measure_self [locally_compact_space G] {K₀ : positive_compacts G} :
  haar_measure K₀ K₀.1 = 1 :=
begin
  rw [haar_measure_apply K₀.2.1.measurable_set, ennreal.div_self],
  { rw [← pos_iff_ne_zero], exact haar_outer_measure_self_pos },
  { exact ne_of_lt (haar_outer_measure_lt_top_of_is_compact K₀.2.1) }
end

lemma haar_measure_pos_of_is_open [locally_compact_space G] {K₀ : positive_compacts G}
  {U : set G} (hU : is_open U) (h2U : U.nonempty) : 0 < haar_measure K₀ U :=
begin
  rw [haar_measure_apply hU.measurable_set, ennreal.div_pos_iff],
  refine ⟨_, ne_of_lt $ haar_outer_measure_lt_top_of_is_compact K₀.2.1⟩,
  rw [← pos_iff_ne_zero], apply haar_outer_measure_pos_of_is_open hU h2U
end

lemma regular_haar_measure [locally_compact_space G] {K₀ : positive_compacts G} :
  (haar_measure K₀).regular :=
begin
  apply measure.regular.smul, split,
  { intros K hK, rw [to_measure_apply _ _ hK.measurable_set],
    apply haar_outer_measure_lt_top_of_is_compact hK },
  { intros A hA, rw [to_measure_apply _ _ hA, haar_outer_measure_eq_infi],
    refine binfi_le_binfi _, intros U hU, refine infi_le_infi _, intro h2U,
    rw [to_measure_apply _ _ hU.measurable_set, haar_outer_measure_of_is_open U hU], refl' },
  { intros U hU, rw [to_measure_apply _ _ hU.measurable_set, haar_outer_measure_of_is_open U hU],
    dsimp only [inner_content], refine bsupr_le (λ K hK, _),
    refine le_supr_of_le K.1 _, refine le_supr_of_le K.2 _, refine le_supr_of_le hK _,
    rw [to_measure_apply _ _ K.2.measurable_set], apply echaar_le_haar_outer_measure },
  { rw ennreal.inv_lt_top, apply haar_outer_measure_self_pos }
end

instance [locally_compact_space G] [separable_space G] (K₀ : positive_compacts G) :
  sigma_finite (haar_measure K₀) :=
regular_haar_measure.sigma_finite

section unique

variables [locally_compact_space G] [second_countable_topology G] {μ : measure G} [sigma_finite μ]

/-- The Haar measure is unique up to scaling. More precisely: every σ-finite left invariant measure
  is a scalar multiple of the Haar measure. -/
theorem haar_measure_unique (hμ : is_mul_left_invariant μ)
  (K₀ : positive_compacts G) : μ = μ K₀.1 • haar_measure K₀ :=
begin
  ext1 s hs,
  have := measure_mul_measure_eq hμ (is_mul_left_invariant_haar_measure K₀)
    regular_haar_measure K₀.2.1 hs,
  rw [haar_measure_self, one_mul] at this,
  rw [← this (by norm_num), smul_apply],
end

theorem regular_of_left_invariant (hμ : is_mul_left_invariant μ) {K} (hK : is_compact K)
  (h2K : (interior K).nonempty) (hμK : μ K < ∞) : regular μ :=
begin
  rw [haar_measure_unique hμ ⟨K, hK, h2K⟩],
  exact regular.smul regular_haar_measure hμK
end

end unique

end measure
end measure_theory


import M4R.Algebra.Ring.Matsumura

namespace M4R

  namespace Ideal
    def chain (α : Type _) [Ring α] := Nat → Ideal α

    namespace chain
      variable [Ring α] (c : chain α)

      protected theorem ext {c₁ c₂ : chain α} : c₁ = c₂ ↔ ∀ n, c₁ n = c₂ n :=
        ⟨fun h _ => h ▸ rfl, funext⟩

      def ascending : Prop :=  ∀ n, c n ⊆ c n.succ

      def descending : Prop :=  ∀ n, c n.succ ⊆ c n

      def is_prime : Prop := ∀ n, (c n).is_prime

      def base (I : Ideal α) : Prop := c 0 = I

      theorem base_self : c.base (c 0) := rfl

      def is_stable : Prop := ∃ N, ∀ n, N ≤ n → c n = c N

      def strict_infinite : Prop := ∀ n, c n ≠ c n.succ

      def strict_stable : Prop := ∃ N, (∀ n, n < N → c n ≠ c n.succ) ∧ (∀ n, N ≤ n → c n = c N)

      noncomputable def stable_length (hc : c.strict_stable) : Nat := Classical.choose hc

      theorem stable_length_spec (hc : c.strict_stable) : (∀ n, n < c.stable_length hc → c n ≠ c n.succ) ∧
        ∀ n, c.stable_length hc ≤ n → c n = c (c.stable_length hc) := Classical.choose_spec hc

      def shift (n : Nat) : chain α := fun k => c (n + k)

      variable {c}

      theorem stable_length_eq (N : Nat) (hN₁ : ∀ n, n < N → c n ≠ c n.succ) (hN₂ : ∀ n, N ≤ n → c n = c N) :
        c.stable_length ⟨N, hN₁, hN₂⟩ = N :=
          let hc : c.strict_stable := ⟨N, hN₁, hN₂⟩
          Nat.le_antisymm (Nat.not_lt.mp (mt ((c.stable_length_spec hc).left N) (iff_not_not.mpr ((hN₂ N.succ (Nat.le_succ N)).symm))))
            (Nat.not_lt.mp (mt (hN₁ (c.stable_length hc)) (iff_not_not.mpr (((c.stable_length_spec hc).right _ (Nat.le_succ _)).symm))))

      theorem shift_ascending (n : Nat) (hc : c.ascending) : (c.shift n).ascending :=
        fun m => (Nat.add_succ n m ▸ hc (n + m) : c (n + m) ⊆ c (n + m.succ))
      theorem shift_descending (n : Nat) (hc : c.descending) : (c.shift n).descending :=
        fun m => (Nat.add_succ n m ▸ hc (n + m) : c (n + m.succ) ⊆ c (n + m))
      theorem shift_prime (n : Nat) (hc : c.is_prime) : (c.shift n).is_prime :=
        fun m => hc (n + m)
      theorem shift_base (c : chain α) (n : Nat) : (c.shift n).base (c n) := rfl
      theorem shift_is_stable (n : Nat) (hc : c.is_stable) : (c.shift n).is_stable := by
        let ⟨N, hN⟩ := hc
        byCases h : n < N
        { exact ⟨N - n, fun m hm => (hN (n + m) (Nat.add_comm m n ▸ Nat.sub_le_iff_right.mp hm)).trans
          (congrArg c (Nat.add_sub_of_le (Nat.le_of_lt h))).symm⟩ }
        { exact ⟨0, fun m hm => have h := Nat.not_lt.mp h
            (hN (n + m) (Nat.le_trans h (Nat.le_add_right n m))).trans (hN n h).symm⟩ }
      theorem shift_strict_infinite (n : Nat) (hc : c.strict_infinite) : (c.shift n).strict_infinite :=
        fun m => hc (n + m)
      theorem shift_strict_stable (n : Nat) (hc : c.strict_stable) : (c.shift n).strict_stable := by
        let ⟨N, hN₁, hN₂⟩ := hc
        byCases h : n < N
        { exact ⟨N - n, fun m hm => hN₁ (n + m) (Nat.add_comm m n ▸ (Nat.lt_sub_iff_right (Nat.le_of_lt h)).mp hm),
            fun m hm => (hN₂ (n + m) (Nat.add_comm n m ▸ Nat.sub_le_iff_right.mp hm)).trans (congrArg c
              (Nat.add_sub_of_le (Nat.le_of_lt h))).symm⟩ }
        { exact ⟨0, fun m hm => absurd hm (Nat.not_lt_zero m), fun m hm =>
            have h := Nat.not_lt.mp h
            (hN₂ (n + m) (Nat.le_trans h (Nat.le_add_right n m))).trans (hN₂ n h).symm⟩ }
      theorem shift_stable_length (n : Nat) (hc : c.strict_stable) : (c.shift n).stable_length (shift_strict_stable n hc) =
        c.stable_length hc - n := by
          byCases h : n < c.stable_length hc
          { exact stable_length_eq _ (fun m hm => (c.stable_length_spec hc).left (n + m) (Nat.add_comm m n ▸
              (Nat.lt_sub_iff_right (Nat.le_of_lt h)).mp hm)) fun m hm => by
                have := (c.stable_length_spec hc).right _ (Nat.sub_le_iff_right.mp hm)
                rw [Nat.add_comm, ←Nat.sub_add_cancel (Nat.le_of_lt h), Nat.add_comm _ n] at this
                exact this }
          { exact Nat.sub_eq_zero_of_le (Nat.not_lt.mp h) ▸ stable_length_eq _ (fun m hm => absurd hm (Nat.not_lt_zero m))
              fun m hm => have h := Nat.not_lt.mp h; ((c.stable_length_spec hc).right (n + m) (Nat.le_trans h
                (Nat.le_add_right n m))).trans ((c.stable_length_spec hc).right n h).symm }

      theorem subset_ascending (hc : c.ascending) {m n : Nat} (h : m ≤ n) : c m ⊆ c n :=
        have : ∀ n, c m ⊆ c (m + n) := fun n => by
          induction n with
          | zero      => exact Subset.refl _
          | succ n ih => exact Nat.add_succ m n ▸ Subset.trans ih (hc (m + n))
        let ⟨k, hk⟩ := Nat.le.dest h
        hk ▸ this k
      theorem subset_descending (hc : c.descending) {m n : Nat} (h : m ≤ n) : c n ⊆ c m :=
        have : ∀ n, c (m + n) ⊆ c m := fun n => by
          induction n with
          | zero      => exact Subset.refl _
          | succ n ih => exact Nat.add_succ m n ▸ Subset.trans (hc (m + n)) ih
        let ⟨k, hk⟩ := Nat.le.dest h
        hk ▸ this k

      theorem subset_base {I : Ideal α} (hc₁ : c.base I) (hc₂ : c.descending) (n : Nat) : c n ⊆ I :=
        hc₁ ▸ subset_descending hc₂ (Nat.zero_le n)
      theorem base_subset {I : Ideal α} (hc₁ : c.base I) (hc₂ : c.ascending) (n : Nat) : I ⊆ c n :=
        hc₁ ▸ subset_ascending hc₂ (Nat.zero_le n)
      theorem base_prime {I : Ideal α} (hc₁ : c.base I) (hc₂ : c.is_prime) : I.is_prime :=
        hc₁ ▸ hc₂ 0

      theorem subsetneq_succ_of_strict_infinite_ascending (hc₁ : c.strict_infinite) (hc₂ : c.ascending) (n : Nat) :
        c n ⊊ c n.succ := Ideal.subsetneq.mpr ⟨hc₂ n, hc₁ n⟩
      theorem subsetneq_lt_of_strict_infinite_ascending (hc₁ : c.strict_infinite) (hc₂ : c.ascending) {m n : Nat} (h : m < n) :
        c m ⊊ c n := ProperSubset.trans_left (subsetneq_succ_of_strict_infinite_ascending hc₁ hc₂ m) (subset_ascending hc₂ h)

      theorem subsetneq_succ_of_strict_infinite_descending (hc₁ : c.strict_infinite) (hc₂ : c.descending) (n : Nat) :
        c n.succ ⊊ c n := Ideal.subsetneq.mpr ⟨hc₂ n, (hc₁ n).symm⟩
      theorem subsetneq_lt_of_strict_infinite_descending (hc₁ : c.strict_infinite) (hc₂ : c.descending) {m n : Nat} (h : m < n) :
        c n ⊊ c m := ProperSubset.trans_right (subset_descending hc₂ h) (subsetneq_succ_of_strict_infinite_descending hc₁ hc₂ m)

      theorem is_stable_of_strict_stable : c.strict_stable → c.is_stable :=
        fun ⟨N, hN⟩ => ⟨N, hN.right⟩

      theorem length_zero_of_strict_stable_0_eq_1 (hc : c.strict_stable) (h01 : c 0 = c 1) : c.stable_length hc = 0 :=
        Nat.le_zero.mp (Nat.not_lt.mp (mt ((c.stable_length_spec hc).left 0) (iff_not_not.mpr h01)))

      def length_infinite (S : Set (chain α)) : Prop := (∃ c ∈ S, c.strict_infinite) ∨
          ∀ n, ∃ (c : chain α) (hc : c.strict_stable), c ∈ S ∧ n ≤ c.stable_length hc

      def length_finite (S : Set (chain α)) : Prop :=
        (∀ c ∈ S, ¬c.strict_infinite) ∧ ∃ (c : chain α) (hc : c.strict_stable), c ∈ S ∧
          ∀ (d : chain α) (hd : d.strict_stable), d ∈ S → d.stable_length hd  ≤ c.stable_length hc

      theorem length_finite_iff_not_infinite {S : Set (chain α)} (hS : ∃ c ∈ S, c.strict_stable) :
        length_finite S ↔ ¬length_infinite S := by
          simp only [chain.length_finite, chain.length_infinite, not_or_iff_and_not, not_exists, not_forall, not_and, Nat.not_le]
          exact Iff.and (forall_congr' fun _ => Iff.rfl)
            ⟨fun ⟨c, hstab, _, hmax⟩ => ⟨(c.stable_length hstab).succ, fun d hd₁ hd₂ => Nat.lt_succ_of_le (hmax d hd₁ hd₂)⟩,
            fun ⟨N, hN⟩ =>
              let ⟨⟨c, hc⟩, hcS, hmax⟩ := maximal.max_exists {c : Subtype chain.strict_stable | c.val ∈ S}
                (let ⟨c, hcS, hstab⟩ := hS; ⟨⟨c, hstab⟩, hcS⟩) (fun ⟨c, hc⟩ => c.stable_length hc)
                ⟨N, fun ⟨c, hc⟩ hcS => Nat.le_of_lt (hN c hc hcS)⟩
              ⟨c, hc, hcS, fun d hd => hmax ⟨d, hd⟩⟩⟩

      open NCSemiring

      theorem NonTrivial_of_length_infinite {S : Set (chain α)} (h : length_infinite S) : Ring.is_NonTrivial α :=
      fun h10 =>
        have : ∀ I J : Ideal α, I = J := fun I J =>
          Ideal.ext.mp (Set.ext.mp fun _ => by simp only [all_trivial h10, I.has_zero, J.has_zero])
        h.elim (fun ⟨c, hcS, hc⟩ => absurd (this _ _) (hc 0)) fun hc =>
          let ⟨c, hc, hcS, hc'⟩ := hc 1; absurd (this _ _) ((c.stable_length_spec hc).left 0 hc')

      theorem field_not_strict_infinite_of_descending (h : Ring.is_Field α) {c : chain α}
        (hdesc : c.descending) : ¬c.strict_infinite := fun hc => by
          have : ∀ n, c n = 1 := fun n => (Ring.ideal_0_or_1 h (c n)).resolve_left
            fun h => hc n (in_zero_ideal (h ▸ hdesc n : c n.succ ⊆ 0) ▸ h)
          apply hc 0; rw [this 0, this 1]

      theorem field_strict_stable_length_le_1_of_descending (h : Ring.is_Field α) {c : chain α}
        (hdesc : c.descending) (hc : c.strict_stable) : c.stable_length hc ≤ 1 :=
          Nat.not_lt.mp (mt ((c.stable_length_spec hc).left 1) (iff_not_not.mpr ((Ring.ideal_0_or_1 h (c 0)).elim
            (fun h₀₀ => have : ∀ n, c n = 0 := fun n => in_zero_ideal (h₀₀ ▸ c.subset_base c.base_self hdesc n)
              (this 1).trans (this 2).symm)
            fun h₀₁ => (Ring.ideal_0_or_1 h (c 1)).elim
              (fun h₁₀ => h₁₀.trans (in_zero_ideal (h₁₀ ▸ hdesc 1)).symm)
              fun h₁₁ => have := length_zero_of_strict_stable_0_eq_1 hc (h₀₁.trans h₁₁.symm)
                h₁₁.trans (h₀₁.symm.trans (this ▸ ((c.stable_length_spec hc).right 2 (this ▸ Nat.zero_le 2)).symm)))))

      theorem field_length_finite_of_descending (h : Ring.is_Field α) {S : Set (chain α)} (hS₁ : ∃ c ∈ S, c.strict_stable)
        (hS₂ : S ⊆ {c | c.descending}) : length_finite S :=
          (length_finite_iff_not_infinite hS₁).mpr fun hinf => hinf.elim
            (fun ⟨c, hcS, hc⟩ => absurd hc (field_not_strict_infinite_of_descending h (hS₂ hcS)))
            fun h' => by
              let ⟨c, hc, hcS, hc2⟩ := h' 2
              have := Nat.le_trans hc2 (field_strict_stable_length_le_1_of_descending h (hS₂ hcS) hc)
              contradiction

      open Classical

      noncomputable def length_of_finite {S : Set (chain α)} (h : length_finite S) : Nat :=
        (choose h.right).stable_length (choose (choose_spec h.right))

      theorem length_spec_of_finite {S : Set (chain α)} (h : length_finite S) :
        (∃ (c : chain α) (hc : c.strict_stable), c ∈ S ∧ c.stable_length hc = length_of_finite h) ∧
        ∀ (d : chain α) (hd : d.strict_stable), d ∈ S → d.stable_length hd  ≤ length_of_finite h :=
          have ⟨hc, hcS, h'⟩ := choose_spec h.right
          ⟨⟨choose h.right, hc, hcS, rfl⟩, h'⟩

      theorem length_eq_of_finite {S : Set (chain α)} (h₁ : ∀ c ∈ S, ¬c.strict_infinite) {c : chain α} (hc : c.strict_stable) (hcS : c ∈ S)
        (h₂ : ∀ (d : chain α) (hd : d.strict_stable), d ∈ S → d.stable_length hd  ≤ c.stable_length hc) :
          length_of_finite ⟨h₁, c, hc, hcS, h₂⟩ = c.stable_length hc :=
            have h := choose_spec (choose_spec (⟨h₁, c, hc, hcS, h₂⟩ : length_finite S).right)
            Nat.le_antisymm (h₂ _ _ h.left) (h.right c hc hcS)

      def const_chain (I : Ideal α) : chain α := fun _ => I

      theorem const_chain.ascending (I : Ideal α) : (const_chain I).ascending :=
        fun _ => Subset.refl I
      theorem const_chain.descending (I : Ideal α) : (const_chain I).descending :=
        fun _ => Subset.refl I
      theorem const_chain.is_prime {I : Ideal α} (hI : I.is_prime) : (const_chain I).is_prime :=
        fun _ => hI
      theorem const_chain.base (I : Ideal α) : (const_chain I).base I := rfl
      theorem const_chain.strict_stable (I : Ideal α) : (const_chain I).strict_stable :=
        ⟨0, fun _ => (absurd · (Nat.not_lt_zero _)), fun _ _ => rfl⟩
      theorem const_chain.is_stable (I : Ideal α) : (const_chain I).is_stable :=
        is_stable_of_strict_stable (const_chain.strict_stable I)
      theorem const_chain.length (I : Ideal α) : (const_chain I).stable_length (const_chain.strict_stable I) = 0 :=
        byContradiction fun h => ((const_chain I).stable_length_spec
          (const_chain.strict_stable I)).left 0 (Nat.zero_lt_iff_neq_zero.mpr h) rfl

      theorem const_chain.of_length_zero {hc₁ : c.strict_stable} (hc₂ : c.stable_length hc₁ = 0) : c = const_chain (c 0) :=
        chain.ext.mpr fun n => hc₂ ▸ (c.stable_length_spec hc₁).right n (hc₂ ▸ Nat.zero_le n)
      theorem const_chain.of_0_eq_1 (hc : c.strict_stable) (h01 : c 0 = c 1) : c = const_chain (c 0) :=
        of_length_zero (length_zero_of_strict_stable_0_eq_1 hc h01)

      section contract_chain
        variable [Ring α] [Ring β] {f : α →₊ β} (hf : Ideal.preserve_mul_right f)

        def contract_chain (c : chain β) : chain α := fun n => contraction hf (c n)

        theorem contract_chain.ascending {c : chain β} (hc : c.ascending) : (contract_chain hf c).ascending :=
          fun n => contraction.subset hf (hc n)
        theorem contract_chain.descending {c : chain β} (hc : c.descending) : (contract_chain hf c).descending :=
          fun n => contraction.subset hf (hc n)
        theorem contract_chain.is_prime {f : α →ᵣ₁ β} {c : chain β} (hc : c.is_prime) :
          (contract_chain f.preserve_mul_right c).is_prime := fun n => contraction_prime f (hc n)
        theorem contract_chain.is_stable {c : chain β} : c.is_stable → (contract_chain hf c).is_stable :=
          fun ⟨N, hN⟩ => ⟨N, fun n hn => congrArg (contraction hf) (hN n hn)⟩
        theorem contract_chain.base {c : chain β} {I : Ideal β} (hc : c.base I) :
          (contract_chain hf c).base (contraction hf I) := congrArg (contraction hf) hc

        variable (hfs : Function.surjective f.hom)

        theorem contract_chain.is_stable_of_surjective {c : chain β} : (contract_chain hf c).is_stable → c.is_stable :=
          fun ⟨N, hN⟩ => ⟨N, fun n hn => contraction_injective_of_surjective hf hfs (hN n hn)⟩
        theorem contract_chain.strict_infinite_of_surjective {c : chain β} (hc : c.strict_infinite) :
          (contract_chain hf c).strict_infinite :=
            fun n h => hc n (contraction_injective_of_surjective hf hfs h)
        theorem contract_chain.strict_stable_of_surjective {c : chain β} (hc : c.strict_stable) :
          (contract_chain hf c).strict_stable :=
            let ⟨N, hN₁, hN₂⟩ := hc
            ⟨N, fun n hn h => hN₁ n hn (contraction_injective_of_surjective hf hfs h),
              fun n hn => congrArg (contraction hf) (hN₂ n hn)⟩

        theorem contract_chain.stable_length_eq_of_surjective {c : chain β} (hc : c.strict_stable) :
          c.stable_length hc = (contract_chain hf c).stable_length (contract_chain.strict_stable_of_surjective hf hfs hc) :=
            have hc' := contract_chain.strict_stable_of_surjective hf hfs hc
            Nat.le_antisymm (Nat.not_lt.mp (mt ((c.stable_length_spec hc).left ((contract_chain hf c).stable_length hc'))
              (iff_not_not.mpr (contraction_injective_of_surjective hf hfs (((contract_chain hf c).stable_length_spec hc').right
              _ (Nat.le_succ _)).symm))))
            (Nat.not_lt.mp (mt (((contract_chain hf c).stable_length_spec hc').left (c.stable_length hc)) (iff_not_not.mpr
              (congrArg (contraction hf) ((c.stable_length_spec hc).right _ (Nat.le_succ _)).symm))))

        theorem contract_chain.length_infinite {S : Set (chain β)}
          (hS : length_infinite S) : length_infinite (Function.image' (contract_chain hf) S) :=
            Or.imp (fun ⟨c, hcS, hc⟩ => ⟨contract_chain hf c, ⟨c, hcS, rfl⟩,
              contract_chain.strict_infinite_of_surjective hf hfs hc⟩)
              (fun h n => let ⟨c, hc, hcS, hcn⟩ := h n
                ⟨contract_chain hf c, contract_chain.strict_stable_of_surjective hf hfs hc,
                ⟨c, hcS, rfl⟩, contract_chain.stable_length_eq_of_surjective hf hfs hc ▸ hcn⟩) hS
      end contract_chain
      section extend_chain
        variable [Ring α] [Ring β] (f : α → β)

        noncomputable def extend_chain (c : chain α) : chain β := fun n => extension f (c n)

        theorem extend_chain.ascending {c : chain α} (hc : c.ascending) : (extend_chain f c).ascending :=
          fun n => extension.subset f (hc n)
        theorem extend_chain.descending {c : chain α} (hc : c.descending) : (extend_chain f c).descending :=
          fun n => extension.subset f (hc n)
        theorem extend_chain.base {c : chain α} {I : Ideal α} (hc : c.base I) :
          (extend_chain f c).base (extension f I) := congrArg (extension f) hc

        theorem extension_contraction_of_isomorphism (c : chain α) (f : α ≅ᵣ β) :
          contract_chain f.preserve_mul_right (extend_chain f.hom c) = c :=
            chain.ext.mpr fun n => extension_contraction_eq_of_isomorphism f (c n)
      end extend_chain

      noncomputable def strict_increasing_index (h : ∀ N, ∃ (n : Nat) (hn : N ≤ n), c n ≠ c N) : Nat → Nat
      | 0   => 0
      | n+1 => choose (h (strict_increasing_index h n))
      theorem strict_increasing_index.idx_strict (h : ∀ N, ∃ (n : Nat) (hn : N ≤ n), c n ≠ c N) (n : Nat) :
        strict_increasing_index h n < strict_increasing_index h n.succ :=
          Nat.lt_of_le_and_ne (choose (choose_spec (h (strict_increasing_index h n))))
            fun h' => choose_spec (choose_spec (h (strict_increasing_index h n))) (congrArg _ h'.symm)
      theorem strict_increasing_index.strict (h : ∀ N, ∃ (n : Nat) (hn : N ≤ n), c n ≠ c N) (n : Nat) :
        c (strict_increasing_index h n) ≠ c (strict_increasing_index h n.succ) :=
          (choose_spec (choose_spec (h (strict_increasing_index h n)))).symm

      noncomputable def strictified (h : ∀ N, ∃ (n : Nat) (hn : N ≤ n), c n ≠ c N) : chain α :=
        fun n => match n with
        | 0   => 1
        | n+1 => c (strict_increasing_index h (if c 0 = 1 then n.succ else n))
      theorem strictified.base (h : ∀ N, ∃ (n : Nat) (hn : N ≤ n), c n ≠ c N) : (strictified h).base 1 := rfl
      theorem strictified.base1 (h : ∀ N, ∃ (n : Nat) (hn : N ≤ n), c n ≠ c N) (h0 : c 0 = 1) :
        ∀ n, strictified h n = c (strict_increasing_index h n)
      | 0   => base h ▸ h0.symm
      | n+1 => by simp only [strictified, h0, ite_true]; rfl
      theorem strictified.not_base1 (h : ∀ N, ∃ (n : Nat) (hn : N ≤ n), c n ≠ c N) (h0 : c 0 ≠ 1) (n : Nat) :
        strictified h n.succ = c (strict_increasing_index h n) := by simp only [strictified, h0, ite_false]
      theorem strictified.descending (h : ∀ N, ∃ (n : Nat) (hn : N ≤ n), c n ≠ c N) (hc : c.descending) : (strictified h).descending :=
        fun n => by
          byCases h0 : c 0 = 1
          { simp only [base1 h h0]; exact chain.subset_descending hc (Nat.le_of_lt (strict_increasing_index.idx_strict h n)) }
          { match n with
            | 0   => exact in_unit_ideal _
            | n+1 => simp only [not_base1 h h0]; exact chain.subset_descending hc (Nat.le_of_lt
              (strict_increasing_index.idx_strict h n)) }
      theorem strictified.strict_infinite (h : ∀ N, ∃ (n : Nat) (hn : N ≤ n), c n ≠ c N) : (strictified h).strict_infinite :=
        fun n => by
          byCases h0 : c 0 = 1
          { simp only [base1 h h0]; exact strict_increasing_index.strict h n }
          { simp only [not_base1 h h0]
            match n with
            | 0   => exact Ne.symm h0
            | n+1 => simp only [not_base1 h h0]; exact strict_increasing_index.strict h n }

      section strict_index
        -- i.e. `k` greater than previous index `n`, representing different ideal from `c n`,
        -- less than `m` (to avoid jumping past `m`) and different ideal from `c m` (to make sure we go to `m`, rather than an
        -- earlier ideal in the same block (we assume you never have the same ideal appear twice with any distinct ideals in between)
        abbrev next_term (c : chain α) (m n : Nat) : Prop := Nonempty ({k | n < k ∧ c n ≠ c k ∧ k < m ∧ ∀ l, l ≤ k → c l ≠ c m} : Set Nat)

        theorem next_term_ext {m n N : Nat} (h : n < N ∧ c n ≠ c N ∧ N < m ∧ ∀ l, l ≤ N → c l ≠ c m) (hmin : ∀ k, n < k ∧ c n ≠ c k ∧
          k < m ∧ (∀ l, l ≤ k → c l ≠ c m) → N ≤ k) : choose (minimal.min_exists _ (⟨N, h⟩ : next_term c m n) id) = N :=
            let m := minimal.min_exists _ (⟨N, h⟩ : next_term c m n) id
            Nat.le_antisymm ((choose_spec m).right N h) (hmin (choose m) (choose_spec m).left)
        theorem not_next_term_m (c : chain α) (m : Nat) : ¬ next_term c m m := fun ⟨_, h₁, _, h₂, _⟩ => Nat.lt_not_symm ⟨h₁, h₂⟩

        -- index of `n`ᵗʰ unique ideal in chain `c` (stabilised such that `c (m+k) = c m` for all `k`)
        noncomputable def strict_index (c : chain α) (m : Nat) : Nat → Nat
        | 0   => if c 0 = c m then m else 0
        | n+1 => if h : next_term c m (strict_index c m n) then choose (minimal.min_exists _ h id) else m

        theorem strict_index.def_zero_m {m : Nat} (h : c 0 = c m) : strict_index c m 0 = m := by
          simp only [strict_index, h, ite_true]
        theorem strict_index.def_zero_0 {m : Nat} (h : c 0 ≠ c m) : strict_index c m 0 = 0 := by
          simp only [strict_index, h, ite_false]
        theorem strict_index.zero_or_m (c : chain α) (m : Nat) : strict_index c m 0 = 0 ∨ strict_index c m 0 = m := by
          byCases h : c 0 = c m
          { exact Or.inr (def_zero_m h) }
          { exact Or.inl (def_zero_0 h) }
        theorem strict_index.c_zero (c : chain α) (m : Nat) : c (strict_index c m 0) = c 0 := by
          byCases h : c 0 = c m
          { exact (congrArg (c ·) (def_zero_m h)).trans h.symm }
          { exact (congrArg (c ·) (def_zero_0 h)) }
        theorem strict_index.def_exists {m n : Nat} (h : next_term c m (strict_index c m n)) :
          strict_index c m n.succ = choose (minimal.min_exists _ h id) := by simp only [strict_index, h, dite_true]
        theorem strict_index.neq_m_of_exists {m n : Nat} (h : next_term c m (strict_index c m n)) :
          strict_index c m n.succ ≠ m :=
            def_exists h ▸ Nat.ne_of_lt (choose_spec (minimal.min_exists _ h id)).left.right.right.left
        theorem strict_index.def_not_exists {m n : Nat} (h : ¬next_term c m (strict_index c m n)) :
          strict_index c m n.succ = m := by simp only [strict_index, h, dite_false]

        theorem strict_index.spec (c : chain α) (m n : Nat) : strict_index c m n.succ = m ∨
          (strict_index c m n < strict_index c m n.succ ∧ c (strict_index c m n) ≠ c (strict_index c m n.succ) ∧
          strict_index c m n.succ < m ∧ (∀ l, l ≤ strict_index c m n.succ → c l ≠ c m) ∧
          ∀ k, strict_index c m n ≤ k → k < strict_index c m n.succ → c k = c (strict_index c m n)) := by
            byCases h : next_term c m (strict_index c m n)
            { apply Or.inr
              have hmin := minimal.min_exists _ h id
              have ⟨⟨h₁, h₂, h₃, h₄⟩, h₅⟩ := choose_spec hmin;
              rw [def_exists h]
              exact ⟨h₁, h₂, h₃, h₄, fun k hk₁ hk₂ => (Nat.lt_or_eq_of_le hk₁).elim
                (fun hk₁ => byContradiction fun h => have hkm := Nat.lt_trans hk₂ h₃; absurd (h₅ k ⟨hk₁, Ne.symm h, hkm, fun l hl =>
                  h₄ l (Nat.le_trans hl (Nat.le_of_lt hk₂))⟩) (Nat.not_le.mpr hk₂))
                fun h => by rw [h]⟩ }
            { exact Or.inl (strict_index.def_not_exists h) }
        theorem strict_index.const_after_m {m n : Nat} (h : strict_index c m n = m) : ∀ k, n ≤ k → strict_index c m k = m := fun k hk =>
            have : ∀ k, strict_index c m (n + k) = m := fun k => by
              induction k with
              | zero      => exact h
              | succ k ih => exact def_not_exists fun ⟨_, h₁, _, h₂, _⟩ => absurd ih (Nat.ne_of_lt (Nat.lt_trans h₁ h₂))
            let ⟨k, hk⟩ := Nat.le.dest hk
            hk ▸ this k
        theorem strict_index.le_m (c : chain α) (m : Nat) : (n : Nat) → strict_index c m n ≤ m
        | 0   => (zero_or_m c m).elim (Eq.symm · ▸ Nat.zero_le m) (Eq.symm · ▸ Nat.le_refl m)
        | n+1 => (spec c m n).elim Nat.le_of_eq (fun h => Nat.le_of_lt h.right.right.left)
        theorem strict_index.increasing (c : chain α) (m n : Nat) : strict_index c m n ≤ strict_index c m n.succ :=
          (spec c m n).elim (Eq.symm · ▸ le_m c m n) fun h => Nat.le_of_lt h.left
        theorem strict_index.m_of_stable {m n : Nat} (h : strict_index c m n = strict_index c m n.succ) :
          strict_index c m n = m := h ▸ (spec c m n).resolve_right fun h' => absurd h (Nat.ne_of_lt h'.left)
        theorem strict_index.stable_of_m {m n : Nat} (h : strict_index c m n = m) : strict_index c m n = strict_index c m n.succ :=
          h.trans (const_after_m h n.succ (Nat.le_succ _)).symm
        theorem strict_index.stable_after {m n : Nat} (h : strict_index c m n = strict_index c m n.succ) :
          ∀ k, n ≤ k → strict_index c m k = m := const_after_m (m_of_stable h)
        theorem strict_index.strict_before {m n : Nat} (h : strict_index c m n ≠ strict_index c m n.succ) :
          ∀ k, k ≤ n → strict_index c m k ≠ strict_index c m k.succ :=
            fun k hk h' => absurd (stable_of_m (stable_after h' n hk)) h
        theorem strict_index.strict_increasing {m n : Nat} (h : strict_index c m n ≠ strict_index c m n.succ) :
          ∀ k, k ≤ n.succ → k ≤ strict_index c m k := fun k hk => by
            induction k with
            | zero      => exact Nat.zero_le _
            | succ k ih => exact Nat.succ_le_of_lt (Nat.lt_of_le_of_lt (ih (Nat.le_trans (Nat.le_succ k) hk))
              (Nat.lt_of_le_and_ne (increasing c m k) (strict_before h k (Nat.le_of_succ_le_succ hk))))
        theorem strict_index.m_eq_m (c : chain α) (m : Nat) : strict_index c m m = m := by
          byCases h : strict_index c m m = strict_index c m m.succ
          { exact m_of_stable h }
          { exact Nat.le_antisymm (le_m c m m) (strict_increasing h m (Nat.le_succ m)) }
        theorem strict_index.strict_stable (c : chain α) (m : Nat) : ∃ N, (∀ n, n < N → strict_index c m n ≠ strict_index c m n.succ)
          ∧ ∀ n, N ≤ n → strict_index c m n = m :=
            let ⟨N, hN, hNmax⟩ := minimal.min_exists {k | strict_index c m k = m} ⟨m, m_eq_m c m⟩ id
            ⟨N, fun n hn => match N with
              | 0   => absurd hn (Nat.not_lt_zero n)
              | N+1 => by
                have : strict_index c m N ≠ strict_index c m N.succ := fun h =>
                  absurd (hNmax N (m_of_stable h)) (Nat.not_le.mpr (Nat.lt.base N))
                exact strict_before this n (Nat.le_of_lt_succ hn), (const_after_m hN ·)⟩
        noncomputable abbrev strict_index.length (c : chain α) (m : Nat) : Nat := choose (strict_stable c m)
        theorem strict_index.length_spec (c : chain α) (m : Nat) : (∀ n, n < length c m → strict_index c m n ≠ strict_index c m n.succ)
          ∧ ∀ n, length c m ≤ n → strict_index c m n = m := choose_spec (strict_stable c m)
        theorem strict_index.stable_length_le (c : chain α) (m : Nat) : length c m ≤ m :=
          Nat.not_lt.mp (mt ((choose_spec (strict_stable c m)).left m) (iff_not_not.mpr (stable_of_m (m_eq_m c m))))
        theorem strict_index.neq_m_lt_length {m n : Nat} (hn : n < length c m) : strict_index c m n ≠ m :=
          fun h => absurd (stable_of_m h) ((length_spec c m).left n hn)
        theorem strict_index.eq_m_ge_length {m n : Nat} (hn : length c m ≤ n) : strict_index c m n = m :=
          (length_spec c m).right n hn
        theorem strict_index.length_zero {m : Nat} : length c m = 0 ↔ c m = c 0 :=
          ⟨fun h => c_zero c m ▸ (congrArg (c ·) (eq_m_ge_length (h ▸ Nat.le_refl 0)).symm),
          fun h => Nat.le_zero.mp (Nat.le_of_succ_le_succ (Nat.not_le.mp (mt neq_m_lt_length (iff_not_not.mpr (def_zero_m h.symm)))))⟩

        abbrev monotone_chain (c : chain α) : Prop := ∀ i k, i ≤ k → c i = c k → ∀ j, i ≤ j → j ≤ k → c j = c i
        theorem monotone_of_ascending (hc : c.ascending) : monotone_chain c :=
          fun i k hik hcik j hij hjk => Ideal.antisymm (hcik ▸ subset_ascending hc hjk) (subset_ascending hc hij)
        theorem monotone_of_descending (hc : c.descending) : monotone_chain c :=
          fun i k hik hcik j hij hjk => Ideal.antisymm (subset_descending hc hij) (hcik ▸ subset_descending hc hjk)

        theorem strict_index.next_term_m_succ {m n : Nat} (hmonotone : monotone_chain c) (h : strict_index c m n = strict_index c m.succ n)
          (nt : next_term c m (strict_index c m n)) : ∃ nt' : next_term c m.succ (strict_index c m.succ n), choose (minimal.min_exists _ nt id) = choose (minimal.min_exists _ nt' id) :=
            let h' := minimal.min_exists _ nt id
            have : strict_index c m.succ n < choose h' ∧ c (strict_index c m.succ n) ≠ c (choose h') ∧ choose h' < m.succ ∧ ∀ l, l ≤ choose h' → c l ≠ c m.succ :=
              ⟨h ▸ (choose_spec h').left.left, h ▸ (choose_spec h').left.right.left, Nat.lt_trans (choose_spec h').left.right.right.left (Nat.lt.base m),
                fun l hl h'' => absurd (hmonotone l m.succ (Nat.le_trans hl (Nat.le_of_lt (Nat.lt.step (choose_spec h').left.right.right.left))) h'' m
                  (Nat.le_trans hl (Nat.le_of_lt (choose_spec h').left.right.right.left)) (Nat.le_succ m)) ((choose_spec h').left.right.right.right l hl).symm⟩
            ⟨⟨choose h', this⟩, (next_term_ext this fun k hk => by
              byCases hk' : k = m
              { exact hk'.symm ▸ Nat.le_of_lt (choose_spec h').left.right.right.left }
              { byCases hk'' : ∃ l, l ≤ k ∧ c l = c m;
                { let ⟨l, hl, h⟩ := hk''; exact Nat.le_trans (Nat.le_of_lt (Nat.not_le.mp (imp_not_comm.mp
                  ((choose_spec h').left.right.right.right l) h))) hl }
                { simp only [not_exists, not_and] at hk''
                  exact (choose_spec h').right k ⟨h ▸ hk.left, h ▸ hk.right.left, Nat.lt_of_le_and_ne
                    (Nat.le_of_succ_le_succ hk.right.right.left) hk', hk''⟩} } ).symm⟩

        theorem strict_index.lt_length_m_succ {m n : Nat} (hmonotone : monotone_chain c)
          (hn : n < length c m) : strict_index c m n = strict_index c m.succ n := by
            induction n with
            | zero      =>
              have h0 := mt def_zero_m (neq_m_lt_length hn)
              have h0' := def_zero_0 fun h' => absurd (hmonotone 0 m.succ (Nat.zero_le _) h' m (Nat.zero_le m) (Nat.le_succ m)).symm h0
              exact (def_zero_0 h0).trans h0'.symm
            | succ n ih =>
              have : next_term c m (strict_index c m n) := of_not_not (mt def_not_exists (neq_m_lt_length hn))
              let ⟨k, hk⟩ := next_term_m_succ hmonotone (ih (Nat.lt_trans (Nat.lt.base n) hn)) this
              exact (def_exists this).trans (hk.trans (def_exists k).symm)

        theorem strict_index.ge_length_of_m_eq_m_succ {m n : Nat} (hmonotone : monotone_chain c)
          (hm : c m = c m.succ) (hn : length c m ≤ n) : strict_index c m.succ n = m.succ := by
            induction n with
            | zero => exact def_zero_m ((length_zero.mp (Nat.le_zero.mp hn)).symm.trans hm)
            | succ n ih =>
              exact (Nat.lt_or_eq_of_le hn).elim (fun hn => stable_after (stable_of_m (ih (Nat.le_of_succ_le_succ hn))) n.succ (Nat.le_succ n))
                fun hn =>
                  have he := lt_length_m_succ hmonotone (hn ▸ Nat.lt.base n : n < length c m)
                  have : ¬next_term c m (strict_index c m n) := fun h => absurd (eq_m_ge_length (Nat.le_of_eq hn)) (neq_m_of_exists h)
                  have : ¬next_term c m.succ (strict_index c m.succ n) := fun ⟨k, h₁, h₂, h₃, h₄⟩ =>
                    absurd ⟨k, he ▸ h₁, he ▸ h₂, Nat.lt_of_le_and_ne (Nat.le_of_succ_le_succ h₃) fun h =>
                      absurd hm (h ▸ h₄ k (Nat.le_refl k)), fun l hl => hm ▸ h₄ l hl⟩ this
                  def_not_exists this

        theorem strict_index.neq_succ_injective {m n : Nat} (h : strict_index c m n ≠ strict_index c m n.succ) : c (strict_index c m n) ≠ c (strict_index c m n.succ) := by
          byCases h' : strict_index c m n.succ = m
          { match n with
            | 0   =>
              rw [h'] at h ⊢; have := mt def_zero_m h
              rw [def_zero_0 this]; exact this
            | n+1 => rw [h']; exact ((spec c m n).resolve_left (fun h' => h (stable_of_m h'))).right.right.right.left _ (Nat.le_refl _) }
          { exact ((spec c m n).resolve_left h').right.left }
        theorem strict_index.eq_succ_injective {m n : Nat} (h : c (strict_index c m n) = c (strict_index c m n.succ)) : strict_index c m n = strict_index c m n.succ :=
          of_not_not (mt neq_succ_injective (iff_not_not.mpr h))
        theorem strict_index.m_injective {m n : Nat} (h : c (strict_index c m n) = c m) : strict_index c m n = m :=
          match n with
          | 0   => def_zero_m (c_zero c m ▸ h)
          | n+1 => by
            byCases h' : next_term c m (strict_index c m n)
            { have h'' := minimal.min_exists _ h' id;
              exact absurd (def_exists h' ▸ h) ((choose_spec h'').left.right.right.right
                (choose h'') (Nat.le_refl _)); }
            { exact def_not_exists h' }

        theorem strict_index.eq_length_of_m_neq_m_succ {m : Nat} (hmonotone : monotone_chain c)
          (hm : c m ≠ c m.succ) : c (strict_index c m.succ (length c m)) = c m := by
            byCases hl : length c m = 0
            { exact hl ▸ c_zero c m.succ ▸ (length_zero.mp hl).symm }
            { let ⟨k, hk⟩ := Nat.ne_zero_dest hl;
              rw [hk]
              have hk' : k < length c m := hk ▸ Nat.lt.base k
              have he := lt_length_m_succ hmonotone hk'
              let ⟨n, hn, hnmin⟩ := minimal.min_exists {n | c n = c m} ⟨m, rfl⟩ id
              have hm' := hnmin m rfl
              have hn' : strict_index c m.succ k < n ∧ c (strict_index c m.succ k) ≠ c n ∧ n < m.succ ∧
                ∀ l, l ≤ n → c l ≠ c m.succ := ⟨he ▸ byContradiction fun h => absurd (m_injective (hn ▸
                  hmonotone n m hm' hn (strict_index c m k) (Nat.not_lt.mp h) (le_m c m k)))
                  (neq_m_lt_length hk'), fun h => absurd (m_injective (hn ▸ he ▸ h)) (neq_m_lt_length hk'),
                  Nat.succ_le_succ hm', fun l hl hl' => absurd ((hmonotone l m.succ (Nat.le_trans hl
                  (Nat.le_step hm')) hl' m (Nat.le_trans hl hm') (Nat.le_succ m)).trans hl') hm⟩;
              rw [def_exists ⟨n, hn'⟩, next_term_ext hn' fun x ⟨h₁, h₂, h₃, h₄⟩ => byContradiction fun h =>
                have h := Nat.not_le.mp h
                have : next_term c m (strict_index c m k) := ⟨x, he ▸ h₁, he ▸ h₂,
                  Nat.lt_of_le_and_ne (Nat.le_of_succ_le_succ h₃) (fun h' => absurd hm' (Nat.not_le.mpr (h' ▸ h))),
                  fun l hl h' => absurd (Nat.lt_of_le_of_lt hl (Nat.lt_of_lt_of_le h (hnmin l h'))) (Nat.lt_irrefl l)⟩
                absurd (eq_m_ge_length (Nat.le_refl (length c m))) (hk ▸ neq_m_of_exists this)]; exact hn }
        theorem strict_index.length_succ_of_m_neq_m_succ {m : Nat} (hmonotone : monotone_chain c)
          (hm : c m ≠ c m.succ) : strict_index c m.succ (length c m).succ = m.succ :=
            have : ¬ next_term c m.succ (strict_index c m.succ (length c m)) := fun ⟨x, h₁, h₂, h₃, h₄⟩ => absurd (hmonotone (strict_index c m.succ
              (length c m)) m (Nat.le_trans (Nat.le_of_lt h₁) (Nat.le_of_succ_le_succ h₃)) (eq_length_of_m_neq_m_succ hmonotone hm) x (Nat.le_of_lt h₁)
              (Nat.le_of_succ_le_succ h₃)).symm h₂
            def_not_exists this

        theorem strict_index.succ_length_le (hmonotone : monotone_chain c) (m : Nat) : length c m ≤ length c m.succ :=
          Nat.not_lt.mp fun h => by
            have := le_m c m (length c m.succ)
            rw [lt_length_m_succ hmonotone h, eq_m_ge_length (Nat.le_refl _)] at this
            exact absurd this (Nat.not_le.mpr (Nat.lt.base m))
        theorem strict_index.succ_length_succ {m : Nat} (hc : c m ≠ c m.succ) (hmonotone : monotone_chain c) :
          length c m.succ = (length c m).succ :=
            Nat.le_antisymm
            (Nat.not_lt.mp (mt ((length_spec c m.succ).left (length c m).succ) (iff_not_not.mpr
              (stable_of_m (length_succ_of_m_neq_m_succ hmonotone hc)))))
            (Nat.succ_le_of_lt (Nat.not_le.mp (mt ((length_spec c m.succ).right (length c m)) fun h =>
              absurd ((eq_length_of_m_neq_m_succ hmonotone hc).symm.trans (congrArg (c ·) h)) hc)))
        theorem strict_index.succ_length_eq {m : Nat} (hc : c m = c m.succ) (hmonotone : monotone_chain c) :
          length c m.succ = length c m :=
            Nat.le_antisymm
            (Nat.not_lt.mp (mt ((length_spec c m.succ).left (length c m)) (iff_not_not.mpr ((ge_length_of_m_eq_m_succ
              hmonotone hc (Nat.le_refl _)).trans (ge_length_of_m_eq_m_succ hmonotone hc (Nat.le_succ _)).symm))))
            (succ_length_le hmonotone m)
      end strict_index

      noncomputable def strict_stabilised (c : chain α) (m : Nat) : chain α := fun n => c (strict_index c m n)

      theorem strict_stabilised.base (c : chain α) (m : Nat) : (strict_stabilised c m).base (c 0) := strict_index.c_zero c m
      theorem strict_stabilised.descending (hc : c.descending) (m : Nat) : (strict_stabilised c m).descending :=
        fun n => subset_descending hc (strict_index.increasing c m n)

      theorem strict_stabilised.strict_stable (c : chain α) (m : Nat) : (strict_stabilised c m).strict_stable :=
        let ⟨N, hN₁, hN₂⟩ := strict_index.strict_stable c m
        ⟨N, fun n hn => strict_index.neq_succ_injective (hN₁ n hn),
        fun n hn => congrArg (c ·) ((hN₂ n hn).trans (hN₂ N (Nat.le_refl _)).symm)⟩
      noncomputable abbrev strict_stabilised.length (c : chain α) (m : Nat) : Nat :=
        (strict_stabilised c m).stable_length (strict_stable c m)
      theorem strict_stabilised.length_eq_length (c : chain α) (m : Nat) : length c m = strict_index.length c m :=
        Nat.le_antisymm (Nat.not_lt.mp (mt (((strict_stabilised c m).stable_length_spec (strict_stable c m)).left (strict_index.length c m))
          (iff_not_not.mpr (congrArg (c ·) (((strict_index.length_spec c m).right (strict_index.length c m) (Nat.le_refl _)).trans
            ((strict_index.length_spec c m).right (strict_index.length c m).succ (Nat.le_succ _)).symm)))))
          (Nat.not_lt.mp (mt ((strict_index.length_spec c m).left (length c m)) (iff_not_not.mpr (strict_index.eq_succ_injective
            (((strict_stabilised c m).stable_length_spec (strict_stable c m)).right (length c m).succ (Nat.le_succ _)).symm))))
      theorem strict_stabilised.length_le (c : chain α) (m : Nat) : length c m ≤ m :=
        length_eq_length c m ▸ strict_index.stable_length_le c m

      theorem strict_stabilised.succ_length_le (hmonotone : monotone_chain c) (m : Nat) :
        length c m ≤ length c m.succ := length_eq_length c m ▸ length_eq_length c m.succ ▸ strict_index.succ_length_le hmonotone m
      theorem strict_stabilised.succ_length_succ {m : Nat} (hmonotone : monotone_chain c) (hc : c m ≠ c m.succ) :
        length c m.succ = (length c m).succ := length_eq_length c m ▸ length_eq_length c m.succ ▸ strict_index.succ_length_succ hc hmonotone
      theorem strict_stabilised.succ_length_eq {m : Nat} (hmonotone : monotone_chain c) (hc : c m = c m.succ) :
        length c m.succ = length c m := length_eq_length c m ▸ length_eq_length c m.succ ▸ strict_index.succ_length_eq hc hmonotone

      def prefix_chain (I : Ideal α) (c : chain α) : chain α := fun n => match n with | 0 => I | n+1 => c n

      namespace prefix_chain

        theorem ascending {I : Ideal α} (hI : I ⊆ c 0) (hc : c.ascending) : (prefix_chain I c).ascending :=
          fun n => match n with | 0 => hI | n+1 => hc n
        theorem descending {I : Ideal α} (hI : c 0 ⊆ I) (hc : c.descending) : (prefix_chain I c).descending :=
          fun n => match n with | 0 => hI | n+1 => hc n
        theorem is_prime {I : Ideal α} (hI : I.is_prime) (hc : c.is_prime) : (prefix_chain I c).is_prime :=
          fun n => match n with | 0 => hI | n+1 => hc n

        theorem strict_stable {I : Ideal α} (hc : c.strict_stable) (hI : I ≠ c 0) : (prefix_chain I c).strict_stable :=
          ⟨(c.stable_length hc).succ, fun k hk => match k with | 0 => hI | k+1 => (c.stable_length_spec hc).left k (Nat.lt_of_succ_lt_succ hk),
            fun k hk => match k with | k+1 => (c.stable_length_spec hc).right k (Nat.le_of_succ_le_succ hk)⟩
        theorem stable_length {I : Ideal α} (hc : c.strict_stable) (hI : I ≠ c 0) :
          (prefix_chain I c).stable_length (strict_stable hc hI) = (c.stable_length hc).succ :=
            stable_length_eq _ (fun k hk => match k with | 0 => by exact hI | k+1 => (c.stable_length_spec hc).left k (Nat.lt_of_succ_lt_succ hk))
              fun k hk => match k with | k+1 => (c.stable_length_spec hc).right k (Nat.le_of_succ_le_succ hk)

        theorem strict_infinite {I : Ideal α} (hc : c.strict_infinite) (hI : I ≠ c 0) : (prefix_chain I c).strict_infinite :=
          fun n => match n with | 0 => hI | n+1 => hc n

      end prefix_chain
    end chain
  end Ideal
end M4R


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Chris Hughes, Tim Baanen
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.matrix.pequiv
import Mathlib.data.fintype.card
import Mathlib.group_theory.perm.sign
import Mathlib.algebra.algebra.basic
import Mathlib.tactic.ring
import Mathlib.linear_algebra.alternating
import Mathlib.PostPort

universes u v w z u_1

namespace Mathlib

namespace matrix

/-- The determinant of a matrix given by the Leibniz formula. -/
def det {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] (M : matrix n n R) :
    R :=
  finset.sum finset.univ
    fun (σ : equiv.perm n) =>
      ↑↑(coe_fn equiv.perm.sign σ) * finset.prod finset.univ fun (i : n) => M (coe_fn σ i) i

@[simp] theorem det_diagonal {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R]
    {d : n → R} : det (diagonal d) = finset.prod finset.univ fun (i : n) => d i :=
  sorry

@[simp] theorem det_zero {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R]
    (h : Nonempty n) : det 0 = 0 :=
  sorry

@[simp] theorem det_one {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] :
    det 1 = 1 :=
  sorry

theorem det_eq_one_of_card_eq_zero {n : Type u} [DecidableEq n] [fintype n] {R : Type v}
    [comm_ring R] {A : matrix n n R} (h : fintype.card n = 0) : det A = 1 :=
  sorry

theorem det_mul_aux {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R]
    {M : matrix n n R} {N : matrix n n R} {p : n → n} (H : ¬function.bijective p) :
    (finset.sum finset.univ
          fun (σ : equiv.perm n) =>
            ↑↑(coe_fn equiv.perm.sign σ) *
              finset.prod finset.univ fun (x : n) => M (coe_fn σ x) (p x) * N (p x) x) =
        0 :=
  sorry

@[simp] theorem det_mul {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R]
    (M : matrix n n R) (N : matrix n n R) : det (matrix.mul M N) = det M * det N :=
  sorry

protected instance det.is_monoid_hom {n : Type u} [DecidableEq n] [fintype n] {R : Type v}
    [comm_ring R] : is_monoid_hom det :=
  is_monoid_hom.mk det_one

/-- Transposing a matrix preserves the determinant. -/
@[simp] theorem det_transpose {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R]
    (M : matrix n n R) : det (transpose M) = det M :=
  sorry

/-- The determinant of a permutation matrix equals its sign. -/
@[simp] theorem det_permutation {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R]
    (σ : equiv.perm n) : det (pequiv.to_matrix (equiv.to_pequiv σ)) = ↑(coe_fn equiv.perm.sign σ) :=
  sorry

/-- Permuting the columns changes the sign of the determinant. -/
theorem det_permute {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R]
    (σ : equiv.perm n) (M : matrix n n R) :
    (det fun (i : n) => M (coe_fn σ i)) = ↑(coe_fn equiv.perm.sign σ) * det M :=
  sorry

@[simp] theorem det_smul {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R]
    {A : matrix n n R} {c : R} : det (c • A) = c ^ fintype.card n * det A :=
  sorry

theorem ring_hom.map_det {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R]
    {S : Type w} [comm_ring S] {M : matrix n n R} {f : R →+* S} :
    coe_fn f (det M) = det (coe_fn (ring_hom.map_matrix f) M) :=
  sorry

theorem alg_hom.map_det {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R]
    {S : Type w} [comm_ring S] [algebra R S] {T : Type z} [comm_ring T] [algebra R T]
    {M : matrix n n S} {f : alg_hom R S T} :
    coe_fn f (det M) = det (coe_fn (ring_hom.map_matrix ↑f) M) :=
  sorry

/-!
### `det_zero` section

Prove that a matrix with a repeated column has determinant equal to zero.
-/

theorem det_eq_zero_of_row_eq_zero {n : Type u} [DecidableEq n] [fintype n] {R : Type v}
    [comm_ring R] {A : matrix n n R} (i : n) (h : ∀ (j : n), A i j = 0) : det A = 0 :=
  sorry

theorem det_eq_zero_of_column_eq_zero {n : Type u} [DecidableEq n] [fintype n] {R : Type v}
    [comm_ring R] {A : matrix n n R} (j : n) (h : ∀ (i : n), A i j = 0) : det A = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (det A = 0)) (Eq.symm (det_transpose A))))
    (det_eq_zero_of_row_eq_zero j h)

/-- If a matrix has a repeated row, the determinant will be zero. -/
theorem det_zero_of_row_eq {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R]
    {M : matrix n n R} {i : n} {j : n} (i_ne_j : i ≠ j) (hij : M i = M j) : det M = 0 :=
  sorry

theorem det_update_column_add {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R]
    (M : matrix n n R) (j : n) (u : n → R) (v : n → R) :
    det (update_column M j (u + v)) = det (update_column M j u) + det (update_column M j v) :=
  sorry

theorem det_update_row_add {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R]
    (M : matrix n n R) (j : n) (u : n → R) (v : n → R) :
    det (update_row M j (u + v)) = det (update_row M j u) + det (update_row M j v) :=
  sorry

theorem det_update_column_smul {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R]
    (M : matrix n n R) (j : n) (s : R) (u : n → R) :
    det (update_column M j (s • u)) = s * det (update_column M j u) :=
  sorry

theorem det_update_row_smul {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R]
    (M : matrix n n R) (j : n) (s : R) (u : n → R) :
    det (update_row M j (s • u)) = s * det (update_row M j u) :=
  sorry

/-- `det` is an alternating multilinear map over the rows of the matrix.

See also `is_basis.det`. -/
def det_row_multilinear {n : Type u} [DecidableEq n] [fintype n] {R : Type v} [comm_ring R] :
    alternating_map R (n → R) R n :=
  alternating_map.mk det sorry sorry sorry

@[simp] theorem det_block_diagonal {n : Type u} [DecidableEq n] [fintype n] {R : Type v}
    [comm_ring R] {o : Type u_1} [fintype o] [DecidableEq o] (M : o → matrix n n R) :
    det (block_diagonal M) = finset.prod finset.univ fun (k : o) => det (M k) :=
  sorry

end Mathlib


theorem succ_inj' {a b : ℕ} (hs : nat.succ(a) = nat.succ(b)) :  a = b :=
begin
    apply nat.succ.inj hs,
end

theorem succ_inj' {a b : ℕ} (hs : nat.succ(a) = nat.succ(b)) :  a = b :=
begin
    exact nat.succ.inj hs,
end


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Floris van Doorn, Violeta Hernández Palacios
-/
import set_theory.ordinal.arithmetic

/-! # Ordinal exponential

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

In this file we define the power function and the logarithm function on ordinals. The two are
related by the lemma `ordinal.opow_le_iff_le_log : (b^c) ≤ x ↔ c ≤ log b x` for nontrivial inputs
`b`, `c`.
-/

noncomputable theory

open function cardinal set equiv order
open_locale classical cardinal ordinal

universes u v w

namespace ordinal

/-- The ordinal exponential, defined by transfinite recursion. -/
instance : has_pow ordinal ordinal :=
⟨λ a b, if a = 0 then 1 - b else limit_rec_on b 1 (λ _ IH, IH * a) (λ b _, bsup.{u u} b)⟩

local infixr (name := ordinal.pow) ^ := @pow ordinal ordinal ordinal.has_pow

theorem opow_def (a b : ordinal) :
  a ^ b = if a = 0 then 1 - b else limit_rec_on b 1 (λ _ IH, IH * a) (λ b _, bsup.{u u} b) :=
rfl

theorem zero_opow' (a : ordinal) : 0 ^ a = 1 - a :=
by simp only [opow_def, if_pos rfl]

@[simp] theorem zero_opow {a : ordinal} (a0 : a ≠ 0) : 0 ^ a = 0 :=
by rwa [zero_opow', ordinal.sub_eq_zero_iff_le, one_le_iff_ne_zero]

@[simp] theorem opow_zero (a : ordinal) : a ^ 0 = 1 :=
by by_cases a = 0; [simp only [opow_def, if_pos h, sub_zero],
simp only [opow_def, if_neg h, limit_rec_on_zero]]

@[simp] theorem opow_succ (a b : ordinal) : a ^ succ b = a ^ b * a :=
if h : a = 0 then by subst a; simp only [zero_opow (succ_ne_zero _), mul_zero]
else by simp only [opow_def, limit_rec_on_succ, if_neg h]

theorem opow_limit {a b : ordinal} (a0 : a ≠ 0) (h : is_limit b) :
  a ^ b = bsup.{u u} b (λ c _, a ^ c) :=
by simp only [opow_def, if_neg a0]; rw limit_rec_on_limit _ _ _ _ h; refl

theorem opow_le_of_limit {a b c : ordinal} (a0 : a ≠ 0) (h : is_limit b) :
  a ^ b ≤ c ↔ ∀ b' < b, a ^ b' ≤ c :=
by rw [opow_limit a0 h, bsup_le_iff]

theorem lt_opow_of_limit {a b c : ordinal} (b0 : b ≠ 0) (h : is_limit c) :
  a < b ^ c ↔ ∃ c' < c, a < b ^ c' :=
by rw [← not_iff_not, not_exists]; simp only [not_lt, opow_le_of_limit b0 h, exists_prop, not_and]

@[simp] theorem opow_one (a : ordinal) : a ^ 1 = a :=
by rw [← succ_zero, opow_succ]; simp only [opow_zero, one_mul]

@[simp] theorem one_opow (a : ordinal) : 1 ^ a = 1 :=
begin
  apply limit_rec_on a,
  { simp only [opow_zero] },
  { intros _ ih, simp only [opow_succ, ih, mul_one] },
  refine λ b l IH, eq_of_forall_ge_iff (λ c, _),
  rw [opow_le_of_limit ordinal.one_ne_zero l],
  exact ⟨λ H, by simpa only [opow_zero] using H 0 l.pos,
         λ H b' h, by rwa IH _ h⟩,
end

theorem opow_pos {a : ordinal} (b)
  (a0 : 0 < a) : 0 < a ^ b :=
begin
  have h0 : 0 < a ^ 0, {simp only [opow_zero, zero_lt_one]},
  apply limit_rec_on b,
  { exact h0 },
  { intros b IH, rw [opow_succ],
    exact mul_pos IH a0 },
  { exact λ b l _, (lt_opow_of_limit (ordinal.pos_iff_ne_zero.1 a0) l).2
      ⟨0, l.pos, h0⟩ },
end

theorem opow_ne_zero {a : ordinal} (b)
  (a0 : a ≠ 0) : a ^ b ≠ 0 :=
ordinal.pos_iff_ne_zero.1 $ opow_pos b $ ordinal.pos_iff_ne_zero.2 a0

theorem opow_is_normal {a : ordinal} (h : 1 < a) : is_normal ((^) a) :=
have a0 : 0 < a, from zero_lt_one.trans h,
⟨λ b, by simpa only [mul_one, opow_succ] using
  (mul_lt_mul_iff_left (opow_pos b a0)).2 h,
 λ b l c, opow_le_of_limit (ne_of_gt a0) l⟩

theorem opow_lt_opow_iff_right {a b c : ordinal}
  (a1 : 1 < a) : a ^ b < a ^ c ↔ b < c :=
(opow_is_normal a1).lt_iff

theorem opow_le_opow_iff_right {a b c : ordinal}
  (a1 : 1 < a) : a ^ b ≤ a ^ c ↔ b ≤ c :=
(opow_is_normal a1).le_iff

theorem opow_right_inj {a b c : ordinal}
  (a1 : 1 < a) : a ^ b = a ^ c ↔ b = c :=
(opow_is_normal a1).inj

theorem opow_is_limit {a b : ordinal}
  (a1 : 1 < a) : is_limit b → is_limit (a ^ b) :=
(opow_is_normal a1).is_limit

theorem opow_is_limit_left {a b : ordinal}
  (l : is_limit a) (hb : b ≠ 0) : is_limit (a ^ b) :=
begin
  rcases zero_or_succ_or_limit b with e|⟨b,rfl⟩|l',
  { exact absurd e hb },
  { rw opow_succ,
    exact mul_is_limit (opow_pos _ l.pos) l },
  { exact opow_is_limit l.one_lt l' }
end

theorem opow_le_opow_right {a b c : ordinal}
  (h₁ : 0 < a) (h₂ : b ≤ c) : a ^ b ≤ a ^ c :=
begin
  cases lt_or_eq_of_le (one_le_iff_pos.2 h₁) with h₁ h₁,
  { exact (opow_le_opow_iff_right h₁).2 h₂ },
  { subst a, simp only [one_opow] }
end

theorem opow_le_opow_left {a b : ordinal} (c)
  (ab : a ≤ b) : a ^ c ≤ b ^ c :=
begin
  by_cases a0 : a = 0,
  { subst a, by_cases c0 : c = 0,
    { subst c, simp only [opow_zero] },
    { simp only [zero_opow c0, ordinal.zero_le] } },
  { apply limit_rec_on c,
    { simp only [opow_zero] },
    { intros c IH, simpa only [opow_succ] using mul_le_mul' IH ab },
    { exact λ c l IH, (opow_le_of_limit a0 l).2
        (λ b' h, (IH _ h).trans (opow_le_opow_right
          ((ordinal.pos_iff_ne_zero.2 a0).trans_le ab) h.le)) } }
end

theorem left_le_opow (a : ordinal) {b : ordinal} (b1 : 0 < b) : a ≤ a ^ b :=
begin
  nth_rewrite 0 ←opow_one a,
  cases le_or_gt a 1 with a1 a1,
  { cases lt_or_eq_of_le a1 with a0 a1,
    { rw lt_one_iff_zero at a0,
      rw [a0, zero_opow ordinal.one_ne_zero],
      exact ordinal.zero_le _ },
    rw [a1, one_opow, one_opow] },
  rwa [opow_le_opow_iff_right a1, one_le_iff_pos]
end

theorem right_le_opow {a : ordinal} (b) (a1 : 1 < a) : b ≤ a ^ b :=
(opow_is_normal a1).self_le _

theorem opow_lt_opow_left_of_succ {a b c : ordinal}
  (ab : a < b) : a ^ succ c < b ^ succ c :=
by { rw [opow_succ, opow_succ], exact
  (mul_le_mul_right' (opow_le_opow_left c ab.le) a).trans_lt
  (mul_lt_mul_of_pos_left ab (opow_pos c ((ordinal.zero_le a).trans_lt ab))) }

theorem opow_add (a b c : ordinal) : a ^ (b + c) = a ^ b * a ^ c :=
begin
  rcases eq_or_ne a 0 with rfl | a0,
  { rcases eq_or_ne c 0 with rfl | c0, { simp },
    have : b + c ≠ 0 := ((ordinal.pos_iff_ne_zero.2 c0).trans_le (le_add_left _ _)).ne',
    simp only [zero_opow c0, zero_opow this, mul_zero] },
  rcases eq_or_lt_of_le (one_le_iff_ne_zero.2 a0) with rfl | a1,
  { simp only [one_opow, mul_one] },
  apply limit_rec_on c,
  { simp },
  { intros c IH,
    rw [add_succ, opow_succ, IH, opow_succ, mul_assoc] },
  { intros c l IH,
    refine eq_of_forall_ge_iff (λ d, (((opow_is_normal a1).trans
      (add_is_normal b)).limit_le l).trans _),
    dsimp only [function.comp],
    simp only [IH] {contextual := tt},
    exact (((mul_is_normal $ opow_pos b (ordinal.pos_iff_ne_zero.2 a0)).trans
      (opow_is_normal a1)).limit_le l).symm }
end

theorem opow_one_add (a b : ordinal) : a ^ (1 + b) = a * a ^ b :=
by rw [opow_add, opow_one]

theorem opow_dvd_opow (a) {b c : ordinal} (h : b ≤ c) : a ^ b ∣ a ^ c :=
⟨a ^ (c - b), by rw [←opow_add, ordinal.add_sub_cancel_of_le h] ⟩

theorem opow_dvd_opow_iff {a b c : ordinal} (a1 : 1 < a) : a ^ b ∣ a ^ c ↔ b ≤ c :=
⟨λ h, le_of_not_lt $ λ hn,
  not_le_of_lt ((opow_lt_opow_iff_right a1).2 hn) $
    le_of_dvd (opow_ne_zero _ $ one_le_iff_ne_zero.1 $ a1.le) h,
opow_dvd_opow _⟩

theorem opow_mul (a b c : ordinal) : a ^ (b * c) = (a ^ b) ^ c :=
begin
  by_cases b0 : b = 0, {simp only [b0, zero_mul, opow_zero, one_opow]},
  by_cases a0 : a = 0,
  { subst a,
    by_cases c0 : c = 0, {simp only [c0, mul_zero, opow_zero]},
    simp only [zero_opow b0, zero_opow c0, zero_opow (mul_ne_zero b0 c0)] },
  cases eq_or_lt_of_le (one_le_iff_ne_zero.2 a0) with a1 a1,
  { subst a1, simp only [one_opow] },
  apply limit_rec_on c,
  { simp only [mul_zero, opow_zero] },
  { intros c IH,
    rw [mul_succ, opow_add, IH, opow_succ] },
  { intros c l IH,
    refine eq_of_forall_ge_iff (λ d, (((opow_is_normal a1).trans
      (mul_is_normal (ordinal.pos_iff_ne_zero.2 b0))).limit_le l).trans _),
    dsimp only [function.comp],
    simp only [IH] {contextual := tt},
    exact (opow_le_of_limit (opow_ne_zero _ a0) l).symm }
end

/-! ### Ordinal logarithm -/

/-- The ordinal logarithm is the solution `u` to the equation `x = b ^ u * v + w` where `v < b` and
    `w < b ^ u`. -/
@[pp_nodot] def log (b : ordinal) (x : ordinal) : ordinal :=
if h : 1 < b then pred (Inf {o | x < b ^ o}) else 0

/-- The set in the definition of `log` is nonempty. -/
theorem log_nonempty {b x : ordinal} (h : 1 < b) : {o | x < b ^ o}.nonempty :=
⟨_, succ_le_iff.1 (right_le_opow _ h)⟩

theorem log_def {b : ordinal} (h : 1 < b) (x : ordinal) : log b x = pred (Inf {o | x < b ^ o}) :=
by simp only [log, dif_pos h]

theorem log_of_not_one_lt_left {b : ordinal} (h : ¬ 1 < b) (x : ordinal) : log b x = 0 :=
by simp only [log, dif_neg h]

theorem log_of_left_le_one {b : ordinal} (h : b ≤ 1) : ∀ x, log b x = 0 :=
log_of_not_one_lt_left h.not_lt

@[simp] lemma log_zero_left : ∀ b, log 0 b = 0 :=
log_of_left_le_one zero_le_one

@[simp] theorem log_zero_right (b : ordinal) : log b 0 = 0 :=
if b1 : 1 < b then begin
  rw [log_def b1, ← ordinal.le_zero, pred_le],
  apply cInf_le',
  dsimp,
  rw [succ_zero, opow_one],
  exact zero_lt_one.trans b1
end
else by simp only [log_of_not_one_lt_left b1]

@[simp] theorem log_one_left : ∀ b, log 1 b = 0 :=
log_of_left_le_one le_rfl

theorem lt_opow_succ_log_self {b : ordinal} (hb : 1 < b) (x : ordinal) : x < b ^ succ (log b x) :=
begin
  rcases eq_or_ne x 0 with rfl | hx,
  { apply opow_pos _ (zero_lt_one.trans hb) },
  { rw succ_log_def hb hx,
    exact Inf_mem (log_nonempty hb) }
end

theorem opow_log_le_self (b) {x : ordinal} (hx : x ≠ 0) : b ^ log b x ≤ x :=
begin
  rcases eq_or_ne b 0 with rfl | b0,
  { rw zero_opow',
    refine (sub_le_self _ _).trans (one_le_iff_ne_zero.2 hx) },
  rcases lt_or_eq_of_le (one_le_iff_ne_zero.2 b0) with hb | rfl,
  { refine le_of_not_lt (λ h, (lt_succ (log b x)).not_le _),
    have := @cInf_le' _ _ {o | x < b ^ o} _ h,
    rwa ←succ_log_def hb hx at this },
  { rwa [one_opow, one_le_iff_ne_zero] }
end

/-- `opow b` and `log b` (almost) form a Galois connection. -/
theorem opow_le_iff_le_log {b x c : ordinal} (hb : 1 < b) (hx : x ≠ 0) : b ^ c ≤ x ↔ c ≤ log b x :=
⟨λ h, le_of_not_lt $ λ hn,
   (lt_opow_succ_log_self hb x).not_le $
   ((opow_le_opow_iff_right hb).2 (succ_le_of_lt hn)).trans h,
λ h, ((opow_le_opow_iff_right hb).2 h).trans (opow_log_le_self b hx)⟩

theorem lt_opow_iff_log_lt {b x c : ordinal} (hb : 1 < b) (hx : x ≠ 0) : x < b ^ c ↔ log b x < c :=
lt_iff_lt_of_le_iff_le (opow_le_iff_le_log hb hx)

theorem log_pos {b o : ordinal} (hb : 1 < b) (ho : o ≠ 0) (hbo : b ≤ o) : 0 < log b o :=
by rwa [←succ_le_iff, succ_zero, ←opow_le_iff_le_log hb ho, opow_one]

theorem log_eq_zero {b o : ordinal} (hbo : o < b) : log b o = 0 :=
begin
  rcases eq_or_ne o 0 with rfl | ho,
  { exact log_zero_right b },
  cases le_or_lt b 1 with hb hb,
  { rcases le_one_iff.1 hb with rfl | rfl,
    { exact log_zero_left o },
    { exact log_one_left o } },
  { rwa [←ordinal.le_zero, ←lt_succ_iff, succ_zero, ←lt_opow_iff_log_lt hb ho, opow_one] }
end

@[mono] theorem log_mono_right (b) {x y : ordinal} (xy : x ≤ y) : log b x ≤ log b y :=
if hx : x = 0 then by simp only [hx, log_zero_right, ordinal.zero_le] else
if hb : 1 < b then
  (opow_le_iff_le_log hb (lt_of_lt_of_le (ordinal.pos_iff_ne_zero.2 hx) xy).ne').1 $
    (opow_log_le_self _ hx).trans xy
else by simp only [log_of_not_one_lt_left hb, ordinal.zero_le]

theorem log_le_self (b x : ordinal) : log b x ≤ x :=
if hx : x = 0 then by simp only [hx, log_zero_right, ordinal.zero_le] else
if hb : 1 < b then (right_le_opow _ hb).trans (opow_log_le_self b hx)
else by simp only [log_of_not_one_lt_left hb, ordinal.zero_le]

@[simp] theorem log_one_right (b : ordinal) : log b 1 = 0 :=
if hb : 1 < b then log_eq_zero hb else log_of_not_one_lt_left hb 1

theorem mod_opow_log_lt_self (b : ordinal) {o : ordinal} (ho : o ≠ 0) : o % b ^ log b o < o :=
begin
  rcases eq_or_ne b 0 with rfl | hb,
  { simpa using ordinal.pos_iff_ne_zero.2 ho },
  { exact (mod_lt _ $ opow_ne_zero _ hb).trans_le (opow_log_le_self _ ho) }
end

theorem log_mod_opow_log_lt_log_self {b o : ordinal} (hb : 1 < b) (ho : o ≠ 0) (hbo : b ≤ o) :
  log b (o % b ^ log b o) < log b o :=
begin
  cases eq_or_ne (o % b ^ log b o) 0,
  { rw [h, log_zero_right],
    apply log_pos hb ho hbo },
  { rw [←succ_le_iff, succ_log_def hb h],
    apply cInf_le',
    apply mod_lt,
    rw ←ordinal.pos_iff_ne_zero,
    exact opow_pos _ (zero_lt_one.trans hb) }
end

lemma opow_mul_add_pos {b v : ordinal} (hb : b ≠ 0) (u) (hv : v ≠ 0) (w) : 0 < b ^ u * v + w :=
(opow_pos u $ ordinal.pos_iff_ne_zero.2 hb).trans_le $
  (le_mul_left _ $ ordinal.pos_iff_ne_zero.2 hv).trans $ le_add_right _ _

lemma opow_mul_add_lt_opow_mul_succ {b u w : ordinal} (v : ordinal) (hw : w < b ^ u) :
  b ^ u * v + w < b ^ u * (succ v) :=
by rwa [mul_succ, add_lt_add_iff_left]

lemma opow_mul_add_lt_opow_succ {b u v w : ordinal} (hvb : v < b) (hw : w < b ^ u) :
  b ^ u * v + w < b ^ (succ u) :=
begin
  convert (opow_mul_add_lt_opow_mul_succ v hw).trans_le (mul_le_mul_left' (succ_le_of_lt hvb) _),
  exact opow_succ b u
end

theorem log_opow_mul_add {b u v w : ordinal} (hb : 1 < b) (hv : v ≠ 0) (hvb : v < b)
  (hw : w < b ^ u) : log b (b ^ u * v + w) = u :=
begin
  have hne' := (opow_mul_add_pos (zero_lt_one.trans hb).ne' u hv w).ne',
  by_contra' hne,
  cases lt_or_gt_of_ne hne with h h,
  { rw ←lt_opow_iff_log_lt hb hne' at h,
    exact h.not_le ((le_mul_left _ (ordinal.pos_iff_ne_zero.2 hv)).trans (le_add_right _ _)) },
  { change _ < _ at h,
    rw [←succ_le_iff, ←opow_le_iff_le_log hb hne'] at h,
    exact (not_lt_of_le h) (opow_mul_add_lt_opow_succ hvb hw) }
end

theorem log_opow {b : ordinal} (hb : 1 < b) (x : ordinal) : log b (b ^ x) = x :=
begin
  convert log_opow_mul_add hb zero_ne_one.symm hb (opow_pos x (zero_lt_one.trans hb)),
  rw [add_zero, mul_one]
end

theorem div_opow_log_pos (b : ordinal) {o : ordinal} (ho : o ≠ 0) : 0 < o / b ^ log b o :=
begin
  rcases eq_zero_or_pos b with (rfl | hb),
  { simpa using ordinal.pos_iff_ne_zero.2 ho },
  { rw div_pos (opow_ne_zero _ hb.ne'),
    exact opow_log_le_self b ho }
end

theorem div_opow_log_lt {b : ordinal} (o : ordinal) (hb : 1 < b) : o / b ^ log b o < b :=
begin
  rw [div_lt (opow_pos _ (zero_lt_one.trans hb)).ne', ←opow_succ],
  exact lt_opow_succ_log_self hb o
end

theorem add_log_le_log_mul {x y : ordinal} (b : ordinal) (hx : x ≠ 0) (hy : y ≠ 0) :
  log b x + log b y ≤ log b (x * y) :=
begin
  by_cases hb : 1 < b,
  { rw [←opow_le_iff_le_log hb (mul_ne_zero hx hy), opow_add],
    exact mul_le_mul' (opow_log_le_self b hx) (opow_log_le_self b hy) },
  simp only [log_of_not_one_lt_left hb, zero_add]
end

/-! ### Interaction with `nat.cast` -/

@[simp, norm_cast] theorem nat_cast_opow (m : ℕ) : ∀ n : ℕ, ((pow m n : ℕ) : ordinal) = m ^ n
| 0     := by simp
| (n+1) := by rw [pow_succ', nat_cast_mul, nat_cast_opow, nat.cast_succ, add_one_eq_succ, opow_succ]

local infixr (name := ordinal.pow) ^ := @pow ordinal ordinal ordinal.has_pow
theorem sup_opow_nat {o : ordinal} (ho : 0 < o) : sup (λ n : ℕ, o ^ n) = o ^ ω :=
begin
  rcases lt_or_eq_of_le (one_le_iff_pos.2 ho) with ho₁ | rfl,
  { exact (opow_is_normal ho₁).apply_omega },
  { rw one_opow,
    refine le_antisymm (sup_le (λ n, by rw one_opow)) _,
    convert le_sup _ 0,
    rw [nat.cast_zero, opow_zero] }
end

end ordinal

namespace tactic
open ordinal positivity

/-- Extension for the `positivity` tactic: `ordinal.opow` takes positive values on positive inputs.
-/
@[positivity]
meta def positivity_opow : expr → tactic strictness
| `(@has_pow.pow _ _ %%inst %%a %%b) := do
  strictness_a ← core a,
  match strictness_a with
  | positive p := positive <$> mk_app ``opow_pos [b, p]
  | _ := failed -- We already know that `0 ≤ x` for all `x : ordinal`
  end
| _ := failed

end tactic