/-
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.cardinal.ordinal
import set_theory.ordinal.fixed_point

/-!
# Cofinality

This file contains the definition of cofinality of an ordinal number and regular cardinals

## Main Definitions

* `ordinal.cof o` is the cofinality of the ordinal `o`.
  If `o` is the order type of the relation `<` on `α`, then `o.cof` is the smallest cardinality of a
  subset `s` of α that is *cofinal* in `α`, i.e. `∀ x : α, ∃ y ∈ s, ¬ y < x`.
* `cardinal.is_limit c` means that `c` is a (weak) limit cardinal: `c ≠ 0 ∧ ∀ x < c, succ x < c`.
* `cardinal.is_strong_limit c` means that `c` is a strong limit cardinal:
  `c ≠ 0 ∧ ∀ x < c, 2 ^ x < c`.
* `cardinal.is_regular c` means that `c` is a regular cardinal: `ℵ₀ ≤ c ∧ c.ord.cof = c`.
* `cardinal.is_inaccessible c` means that `c` is strongly inaccessible:
  `ℵ₀ < c ∧ is_regular c ∧ is_strong_limit c`.

## Main Statements

* `ordinal.infinite_pigeonhole_card`: the infinite pigeonhole principle
* `cardinal.lt_power_cof`: A consequence of König's theorem stating that `c < c ^ c.ord.cof` for
  `c ≥ ℵ₀`
* `cardinal.univ_inaccessible`: The type of ordinals in `Type u` form an inaccessible cardinal
  (in `Type v` with `v > u`). This shows (externally) that in `Type u` there are at least `u`
  inaccessible cardinals.

## Implementation Notes

* The cofinality is defined for ordinals.
  If `c` is a cardinal number, its cofinality is `c.ord.cof`.

## Tags

cofinality, regular cardinals, limits cardinals, inaccessible cardinals,
infinite pigeonhole principle
-/

noncomputable theory

open function cardinal set order
open_locale classical cardinal ordinal

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

/-! ### Cofinality of orders -/

namespace order

/-- Cofinality of a reflexive order `≼`. This is the smallest cardinality
  of a subset `S : set α` such that `∀ a, ∃ b ∈ S, a ≼ b`. -/
def cof (r : α → α → Prop) : cardinal :=
Inf {c | ∃ S : set α, (∀ a, ∃ b ∈ S, r a b) ∧ #S = c}

/-- The set in the definition of `order.cof` is nonempty. -/
theorem cof_nonempty (r : α → α → Prop) [is_refl α r] :
  {c | ∃ S : set α, (∀ a, ∃ b ∈ S, r a b) ∧ #S = c}.nonempty :=
⟨_, set.univ, λ a, ⟨a, ⟨⟩, refl _⟩, rfl⟩

lemma cof_le (r : α → α → Prop) {S : set α} (h : ∀ a, ∃ b ∈ S, r a b) : cof r ≤ #S :=
cInf_le' ⟨S, h, rfl⟩

lemma le_cof {r : α → α → Prop} [is_refl α r] (c : cardinal) :
  c ≤ cof r ↔ ∀ {S : set α}, (∀ a, ∃ b ∈ S, r a b) → c ≤ #S :=
begin
  rw [cof, le_cInf_iff'' (cof_nonempty r)],
  use λ H S h, H _ ⟨S, h, rfl⟩,
  rintro H d ⟨S, h, rfl⟩,
  exact H h
end

end order

theorem rel_iso.cof_le_lift {α : Type u} {β : Type v} {r : α → α → Prop} {s}
  [is_refl β s] (f : r ≃r s) :
  cardinal.lift.{max u v} (order.cof r) ≤ cardinal.lift.{max u v} (order.cof s) :=
begin
  rw [order.cof, order.cof, lift_Inf, lift_Inf,
    le_cInf_iff'' (nonempty_image_iff.2 (order.cof_nonempty s))],
  rintros - ⟨-, ⟨u, H, rfl⟩, rfl⟩,
  apply cInf_le',
  refine ⟨_, ⟨f.symm '' u, λ a, _, rfl⟩,
    lift_mk_eq.{u v (max u v)}.2 ⟨((f.symm).to_equiv.image u).symm⟩⟩,
  rcases H (f a) with ⟨b, hb, hb'⟩,
  refine ⟨f.symm b, mem_image_of_mem _ hb, f.map_rel_iff.1 _⟩,
  rwa rel_iso.apply_symm_apply
end

theorem rel_iso.cof_eq_lift {α : Type u} {β : Type v} {r s}
  [is_refl α r] [is_refl β s] (f : r ≃r s) :
  cardinal.lift.{max u v} (order.cof r) = cardinal.lift.{max u v} (order.cof s) :=
(rel_iso.cof_le_lift f).antisymm (rel_iso.cof_le_lift f.symm)

theorem rel_iso.cof_le {α β : Type u} {r : α → α → Prop} {s} [is_refl β s] (f : r ≃r s) :
  order.cof r ≤ order.cof s :=
lift_le.1 (rel_iso.cof_le_lift f)

theorem rel_iso.cof_eq {α β : Type u} {r s} [is_refl α r] [is_refl β s] (f : r ≃r s) :
  order.cof r = order.cof s :=
lift_inj.1 (rel_iso.cof_eq_lift f)

/-- Cofinality of a strict order `≺`. This is the smallest cardinality of a set `S : set α` such
that `∀ a, ∃ b ∈ S, ¬ b ≺ a`. -/
def strict_order.cof (r : α → α → Prop) : cardinal :=
order.cof (swap r)ᶜ

/-- The set in the definition of `order.strict_order.cof` is nonempty. -/
theorem strict_order.cof_nonempty (r : α → α → Prop) [is_irrefl α r] :
  {c | ∃ S : set α, unbounded r S ∧ #S = c}.nonempty :=
@order.cof_nonempty α _ (is_refl.swap rᶜ)

/-! ### Cofinality of ordinals -/

namespace ordinal

/-- Cofinality of an ordinal. This is the smallest cardinal of a
  subset `S` of the ordinal which is unbounded, in the sense
  `∀ a, ∃ b ∈ S, a ≤ b`. It is defined for all ordinals, but
  `cof 0 = 0` and `cof (succ o) = 1`, so it is only really
  interesting on limit ordinals (when it is an infinite cardinal). -/
def cof (o : ordinal.{u}) : cardinal.{u} :=
o.lift_on (λ a, strict_order.cof a.r)
begin
  rintros ⟨α, r, wo₁⟩ ⟨β, s, wo₂⟩ ⟨⟨f, hf⟩⟩,
  haveI := wo₁, haveI := wo₂,
  apply @rel_iso.cof_eq _ _ _ _ _ _ ,
  { split, exact λ a b, not_iff_not.2 hf },
  { exact ⟨(is_well_order.is_irrefl r).1⟩ },
  { exact ⟨(is_well_order.is_irrefl s).1⟩ }
end

lemma cof_type (r : α → α → Prop) [is_well_order α r] : (type r).cof = strict_order.cof r := rfl

theorem le_cof_type [is_well_order α r] {c} : c ≤ cof (type r) ↔ ∀ S, unbounded r S → c ≤ #S :=
(le_cInf_iff'' (strict_order.cof_nonempty r)).trans ⟨λ H S h, H _ ⟨S, h, rfl⟩,
  by { rintros H d ⟨S, h, rfl⟩, exact H _ h }⟩

theorem cof_type_le [is_well_order α r] {S : set α} (h : unbounded r S) : cof (type r) ≤ #S :=
le_cof_type.1 le_rfl S h

theorem lt_cof_type [is_well_order α r] {S : set α} : #S < cof (type r) → bounded r S :=
by simpa using not_imp_not.2 cof_type_le

theorem cof_eq (r : α → α → Prop) [is_well_order α r] : ∃ S, unbounded r S ∧ #S = cof (type r) :=
Inf_mem (strict_order.cof_nonempty r)

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

/-! ### Cofinality of suprema and least strict upper bounds -/

private theorem card_mem_cof {o} : ∃ {ι} (f : ι → ordinal), lsub.{u u} f = o ∧ #ι = o.card :=
⟨_, _, lsub_typein o, mk_ordinal_out o⟩

/-- The set in the `lsub` characterization of `cof` is nonempty. -/
theorem cof_lsub_def_nonempty (o) :
  {a : cardinal | ∃ {ι} (f : ι → ordinal), lsub.{u u} f = o ∧ #ι = a}.nonempty :=
⟨_, card_mem_cof⟩

theorem cof_eq_Inf_lsub (o : ordinal.{u}) :
  cof o = Inf {a : cardinal | ∃ {ι : Type u} (f : ι → ordinal), lsub.{u u} f = o ∧ #ι = a} :=
begin
  refine le_antisymm (le_cInf (cof_lsub_def_nonempty o) _) (cInf_le' _),
  { rintros a ⟨ι, f, hf, rfl⟩,
    rw ←type_lt o,
    refine (cof_type_le (λ a, _)).trans (@mk_le_of_injective _ _
      (λ s : (typein ((<) : o.out.α → o.out.α → Prop))⁻¹' (set.range f), classical.some s.prop)
      (λ s t hst, let H := congr_arg f hst in by rwa [classical.some_spec s.prop,
        classical.some_spec t.prop, typein_inj, subtype.coe_inj] at H)),
    have := typein_lt_self a,
    simp_rw [←hf, lt_lsub_iff] at this,
    cases this with i hi,
    refine ⟨enum (<) (f i) _, _, _⟩,
    { rw [type_lt, ←hf], apply lt_lsub },
    { rw [mem_preimage, typein_enum], exact mem_range_self i },
    { rwa [←typein_le_typein, typein_enum] } },
  { rcases cof_eq (<) with ⟨S, hS, hS'⟩,
    let f : S → ordinal := λ s, typein (<) s.val,
    refine ⟨S, f, le_antisymm (lsub_le (λ i, typein_lt_self i)) (le_of_forall_lt (λ a ha, _)),
      by rwa type_lt o at hS'⟩,
    rw ←type_lt o at ha,
    rcases hS (enum (<) a ha) with ⟨b, hb, hb'⟩,
    rw [←typein_le_typein, typein_enum] at hb',
    exact hb'.trans_lt (lt_lsub.{u u} f ⟨b, hb⟩) }
end

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

theorem cof_le_card (o) : cof o ≤ card o :=
by { rw cof_eq_Inf_lsub, exact cInf_le' card_mem_cof }

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

theorem ord_cof_le (o : ordinal.{u}) : o.cof.ord ≤ o :=
(ord_le_ord.2 (cof_le_card o)).trans (ord_card_le o)

theorem exists_lsub_cof (o : ordinal) : ∃ {ι} (f : ι → ordinal), lsub.{u u} f = o ∧ #ι = cof o :=
by { rw cof_eq_Inf_lsub, exact Inf_mem (cof_lsub_def_nonempty o) }

theorem cof_lsub_le {ι} (f : ι → ordinal) : cof (lsub.{u u} f) ≤ #ι :=
by { rw cof_eq_Inf_lsub, exact cInf_le' ⟨ι, f, rfl, rfl⟩ }

theorem cof_lsub_le_lift {ι} (f : ι → ordinal) : cof (lsub f) ≤ cardinal.lift.{v u} (#ι) :=
begin
  rw ←mk_ulift,
  convert cof_lsub_le (λ i : ulift ι, f i.down),
  exact lsub_eq_of_range_eq.{u (max u v) max u v}
    (set.ext (λ x, ⟨λ ⟨i, hi⟩, ⟨ulift.up i, hi⟩, λ ⟨i, hi⟩, ⟨_, hi⟩⟩))
end

theorem le_cof_iff_lsub {o : ordinal} {a : cardinal} :
  a ≤ cof o ↔ ∀ {ι} (f : ι → ordinal), lsub.{u u} f = o → a ≤ #ι :=
begin
  rw cof_eq_Inf_lsub,
  exact (le_cInf_iff'' (cof_lsub_def_nonempty o)).trans ⟨λ H ι f hf, H _ ⟨ι, f, hf, rfl⟩,
    λ H b ⟨ι, f, hf, hb⟩, ( by { rw ←hb, exact H _ hf} )⟩
end

theorem lsub_lt_ord_lift {ι} {f : ι → ordinal} {c : ordinal} (hι : cardinal.lift (#ι) < c.cof)
  (hf : ∀ i, f i < c) : lsub.{u v} f < c :=
lt_of_le_of_ne (lsub_le hf) (λ h, by { subst h, exact (cof_lsub_le_lift f).not_lt hι })

theorem lsub_lt_ord {ι} {f : ι → ordinal} {c : ordinal} (hι : #ι < c.cof) :
  (∀ i, f i < c) → lsub.{u u} f < c :=
lsub_lt_ord_lift (by rwa (#ι).lift_id)

theorem cof_sup_le_lift {ι} {f : ι → ordinal} (H : ∀ i, f i < sup f) : cof (sup f) ≤ (#ι).lift :=
by { rw ←sup_eq_lsub_iff_lt_sup at H, rw H, exact cof_lsub_le_lift f }

theorem cof_sup_le {ι} {f : ι → ordinal} (H : ∀ i, f i < sup.{u u} f) : cof (sup.{u u} f) ≤ #ι :=
by { rw ←(#ι).lift_id, exact cof_sup_le_lift H }

theorem sup_lt_ord_lift {ι} {f : ι → ordinal} {c : ordinal} (hι : cardinal.lift (#ι) < c.cof)
  (hf : ∀ i, f i < c) : sup.{u v} f < c :=
(sup_le_lsub.{u v} f).trans_lt (lsub_lt_ord_lift hι hf)

theorem sup_lt_ord {ι} {f : ι → ordinal} {c : ordinal} (hι : #ι < c.cof) :
  (∀ i, f i < c) → sup.{u u} f < c :=
sup_lt_ord_lift (by rwa (#ι).lift_id)

theorem supr_lt_lift {ι} {f : ι → cardinal} {c : cardinal} (hι : cardinal.lift (#ι) < c.ord.cof)
  (hf : ∀ i, f i < c) : supr f < c :=
begin
  rw [←ord_lt_ord, supr_ord (cardinal.bdd_above_range _)],
  refine sup_lt_ord_lift hι (λ i, _),
  rw ord_lt_ord,
  apply hf
end

theorem supr_lt {ι} {f : ι → cardinal} {c : cardinal} (hι : #ι < c.ord.cof) :
  (∀ i, f i < c) → supr f < c :=
supr_lt_lift (by rwa (#ι).lift_id)

theorem nfp_family_lt_ord_lift {ι} {f : ι → ordinal → ordinal} {c} (hc : ℵ₀ < cof c)
  (hc' : (#ι).lift < cof c) (hf : ∀ i (b < c), f i b < c) {a} (ha : a < c) :
  nfp_family.{u v} f a < c :=
begin
  refine sup_lt_ord_lift ((cardinal.lift_le.2 (mk_list_le_max ι)).trans_lt _) (λ l, _),
  { rw lift_max,
    apply max_lt _ hc',
    rwa cardinal.lift_aleph_0 },
  { induction l with i l H,
    { exact ha },
    { exact hf _ _ H } }
end

theorem nfp_family_lt_ord {ι} {f : ι → ordinal → ordinal} {c} (hc : ℵ₀ < cof c)
  (hc' : #ι < cof c) (hf : ∀ i (b < c), f i b < c) {a} : a < c → nfp_family.{u u} f a < c :=
nfp_family_lt_ord_lift hc (by rwa (#ι).lift_id) hf

theorem nfp_bfamily_lt_ord_lift {o : ordinal} {f : Π a < o, ordinal → ordinal} {c} (hc : ℵ₀ < cof c)
  (hc' : o.card.lift < cof c) (hf : ∀ i hi (b < c), f i hi b < c) {a} :
  a < c → nfp_bfamily.{u v} o f a < c :=
nfp_family_lt_ord_lift hc (by rwa mk_ordinal_out) (λ i, hf _ _)

theorem nfp_bfamily_lt_ord {o : ordinal} {f : Π a < o, ordinal → ordinal} {c} (hc : ℵ₀ < cof c)
  (hc' : o.card < cof c) (hf : ∀ i hi (b < c), f i hi b < c) {a} :
  a < c → nfp_bfamily.{u u} o f a < c :=
nfp_bfamily_lt_ord_lift hc (by rwa o.card.lift_id) hf

theorem nfp_lt_ord {f : ordinal → ordinal} {c} (hc : ℵ₀ < cof c) (hf : ∀ i < c, f i < c) {a} :
  a < c → nfp f a < c :=
nfp_family_lt_ord_lift hc (by simpa using cardinal.one_lt_aleph_0.trans hc) (λ _, hf)

theorem exists_blsub_cof (o : ordinal) : ∃ (f : Π a < (cof o).ord, ordinal), blsub.{u u} _ f = o :=
begin
  rcases exists_lsub_cof o with ⟨ι, f, hf, hι⟩,
  rcases cardinal.ord_eq ι with ⟨r, hr, hι'⟩,
  rw ←@blsub_eq_lsub' ι r hr at hf,
  rw [←hι, hι'],
  exact ⟨_, hf⟩
end

theorem cof_blsub_le_lift {o} (f : Π a < o, ordinal) :
  cof (blsub o f) ≤ cardinal.lift.{v u} (o.card) :=
by { convert cof_lsub_le_lift _, exact (mk_ordinal_out o).symm }

theorem cof_blsub_le {o} (f : Π a < o, ordinal) : cof (blsub.{u u} o f) ≤ o.card :=
by { rw ←(o.card).lift_id, exact cof_blsub_le_lift f }

theorem blsub_lt_ord_lift {o : ordinal} {f : Π a < o, ordinal} {c : ordinal}
  (ho : o.card.lift < c.cof) (hf : ∀ i hi, f i hi < c) : blsub.{u v} o f < c :=
lt_of_le_of_ne (blsub_le hf) (λ h, ho.not_le
  (by simpa [←supr_ord, hf, h] using cof_blsub_le_lift.{u} f))

theorem blsub_lt_ord {o : ordinal} {f : Π a < o, ordinal} {c : ordinal} (ho : o.card < c.cof)
  (hf : ∀ i hi, f i hi < c) : blsub.{u u} o f < c :=
blsub_lt_ord_lift (by rwa (o.card).lift_id) hf

theorem cof_bsup_le_lift {o : ordinal} {f : Π a < o, ordinal} (H : ∀ i h, f i h < bsup o f) :
  cof (bsup o f) ≤ o.card.lift :=
by { rw ←bsup_eq_blsub_iff_lt_bsup at H, rw H, exact cof_blsub_le_lift f }

theorem cof_bsup_le {o : ordinal} {f : Π a < o, ordinal} :
  (∀ i h, f i h < bsup.{u u} o f) → cof (bsup.{u u} o f) ≤ o.card :=
by { rw ←(o.card).lift_id, exact cof_bsup_le_lift }

theorem bsup_lt_ord_lift {o : ordinal} {f : Π a < o, ordinal} {c : ordinal}
  (ho : o.card.lift < c.cof) (hf : ∀ i hi, f i hi < c) : bsup.{u v} o f < c :=
(bsup_le_blsub f).trans_lt (blsub_lt_ord_lift ho hf)

theorem bsup_lt_ord {o : ordinal} {f : Π a < o, ordinal} {c : ordinal} (ho : o.card < c.cof) :
  (∀ i hi, f i hi < c) → bsup.{u u} o f < c :=
bsup_lt_ord_lift (by rwa (o.card).lift_id)

/-! ### Basic results -/

@[simp] theorem cof_zero : cof 0 = 0 :=
(cof_le_card 0).antisymm (cardinal.zero_le _)

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

theorem cof_ne_zero {o} : cof o ≠ 0 ↔ o ≠ 0 := cof_eq_zero.not

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

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

/-- A fundamental sequence for `a` is an increasing sequence of length `o = cof a` that converges at
    `a`. We provide `o` explicitly in order to avoid type rewrites. -/
def is_fundamental_sequence (a o : ordinal.{u}) (f : Π b < o, ordinal.{u}) : Prop :=
o ≤ a.cof.ord ∧ (∀ {i j} (hi hj), i < j → f i hi < f j hj) ∧ blsub.{u u} o f = a

namespace is_fundamental_sequence
variables {a o : ordinal.{u}} {f : Π b < o, ordinal.{u}}

protected theorem cof_eq (hf : is_fundamental_sequence a o f) : a.cof.ord = o :=
hf.1.antisymm' $ by { rw ←hf.2.2, exact (ord_le_ord.2 (cof_blsub_le f)).trans (ord_card_le o) }

protected theorem strict_mono (hf : is_fundamental_sequence a o f) :
  ∀ {i j} (hi) (hj), i < j → f i hi < f j hj :=
hf.2.1

theorem blsub_eq (hf : is_fundamental_sequence a o f) : blsub.{u u} o f = a :=
hf.2.2

theorem ord_cof (hf : is_fundamental_sequence a o f) :
  is_fundamental_sequence a a.cof.ord (λ i hi, f i (hi.trans_le (by rw hf.cof_eq))) :=
by { have H := hf.cof_eq, subst H, exact hf }

theorem id_of_le_cof (h : o ≤ o.cof.ord) : is_fundamental_sequence o o (λ a _, a) :=
⟨h, λ _ _ _ _, id, blsub_id o⟩

protected theorem zero {f : Π b < (0 : ordinal), ordinal} :
  is_fundamental_sequence 0 0 f :=
⟨by rw [cof_zero, ord_zero], λ i j hi, (ordinal.not_lt_zero i hi).elim, blsub_zero f⟩

protected theorem succ : is_fundamental_sequence (succ o) 1 (λ _ _, o) :=
begin
  refine ⟨_, λ i j hi hj h, _, blsub_const ordinal.one_ne_zero o⟩,
  { rw [cof_succ, ord_one] },
  { rw lt_one_iff_zero at hi hj,
    rw [hi, hj] at h,
    exact h.false.elim }
end

protected theorem monotone (hf : is_fundamental_sequence a o f) {i j : ordinal} (hi : i < o)
  (hj : j < o) (hij : i ≤ j) : f i hi ≤ f j hj :=
begin
  rcases lt_or_eq_of_le hij with hij | rfl,
  { exact (hf.2.1 hi hj hij).le },
  { refl }
end

theorem trans {a o o' : ordinal.{u}} {f : Π b < o, ordinal.{u}}
  (hf : is_fundamental_sequence a o f) {g : Π b < o', ordinal.{u}}
  (hg : is_fundamental_sequence o o' g) :
  is_fundamental_sequence a o' (λ i hi, f (g i hi) (by { rw ←hg.2.2, apply lt_blsub })) :=
begin
  refine ⟨_, λ i j _ _ h, hf.2.1 _ _ (hg.2.1 _ _ h), _⟩,
  { rw hf.cof_eq,
    exact hg.1.trans (ord_cof_le o) },
  { rw @blsub_comp.{u u u} o _ f (@is_fundamental_sequence.monotone _ _ f hf),
    exact hf.2.2 }
end

end is_fundamental_sequence

/-- Every ordinal has a fundamental sequence. -/
theorem exists_fundamental_sequence (a : ordinal.{u}) :
  ∃ f, is_fundamental_sequence a a.cof.ord f :=
begin
  suffices : ∃ o f, is_fundamental_sequence a o f,
  { rcases this with ⟨o, f, hf⟩,
    exact ⟨_, hf.ord_cof⟩ },
  rcases exists_lsub_cof a with ⟨ι, f, hf, hι⟩,
  rcases ord_eq ι with ⟨r, wo, hr⟩,
  haveI := wo,
  let r' := subrel r {i | ∀ j, r j i → f j < f i},
  let hrr' : r' ↪r r := subrel.rel_embedding _ _,
  haveI := hrr'.is_well_order,
  refine ⟨_, _, (type_le'.2 ⟨hrr'⟩).trans _, λ i j _ h _, (enum r' j h).prop _ _,
    le_antisymm (blsub_le (λ i hi, lsub_le_iff.1 hf.le _)) _⟩,
  { rw [←hι, hr] },
  { change r (hrr'.1 _ ) (hrr'.1 _ ),
    rwa [hrr'.2, @enum_lt_enum _ r'] },
  { rw [←hf, lsub_le_iff],
    intro i,
    suffices : ∃ i' hi', f i ≤ bfamily_of_family' r' (λ i, f i) i' hi',
    { rcases this with ⟨i', hi', hfg⟩,
      exact hfg.trans_lt (lt_blsub _ _ _) },
    by_cases h : ∀ j, r j i → f j < f i,
    { refine ⟨typein r' ⟨i, h⟩, typein_lt_type _ _, _⟩,
      rw bfamily_of_family'_typein,
      refl },
    { push_neg at h,
      cases wo.wf.min_mem _ h with hji hij,
      refine ⟨typein r' ⟨_, λ k hkj, lt_of_lt_of_le _ hij⟩, typein_lt_type _ _, _⟩,
      { by_contra' H,
        exact (wo.wf.not_lt_min _ h ⟨is_trans.trans _ _ _ hkj hji, H⟩) hkj },
      { rwa bfamily_of_family'_typein } } }
end

@[simp] theorem cof_cof (a : ordinal.{u}) : cof (cof a).ord = cof a :=
begin
  cases exists_fundamental_sequence a with f hf,
  cases exists_fundamental_sequence a.cof.ord with g hg,
  exact ord_injective ((hf.trans hg).cof_eq.symm)
end

protected theorem is_normal.is_fundamental_sequence {f : ordinal.{u} → ordinal.{u}}
  (hf : is_normal f) {a o} (ha : is_limit a) {g} (hg : is_fundamental_sequence a o g) :
  is_fundamental_sequence (f a) o (λ b hb, f (g b hb)) :=
begin
  refine ⟨_, λ i j _ _ h, hf.strict_mono (hg.2.1 _ _ h), _⟩,
  { rcases exists_lsub_cof (f a) with ⟨ι, f', hf', hι⟩,
    rw [←hg.cof_eq, ord_le_ord, ←hι],
    suffices : lsub.{u u} (λ i, (Inf {b : ordinal | f' i ≤ f b})) = a,
    { rw ←this,
      apply cof_lsub_le },
    have H : ∀ i, ∃ b < a, f' i ≤ f b := λ i, begin
      have := lt_lsub.{u u} f' i,
      rwa [hf', ←is_normal.blsub_eq.{u u} hf ha, lt_blsub_iff] at this
    end,
    refine (lsub_le (λ i, _)).antisymm (le_of_forall_lt (λ b hb, _)),
    { rcases H i with ⟨b, hb, hb'⟩,
      exact lt_of_le_of_lt (cInf_le' hb') hb },
    { have := hf.strict_mono hb,
      rw [←hf', lt_lsub_iff] at this,
      cases this with i hi,
      rcases H i with ⟨b, _, hb⟩,
      exact ((le_cInf_iff'' ⟨b, hb⟩).2 (λ c hc, hf.strict_mono.le_iff_le.1 (hi.trans hc))).trans_lt
        (lt_lsub _ i) } },
  { rw @blsub_comp.{u u u} a _ (λ b _, f b) (λ i j hi hj h, hf.strict_mono.monotone h) g hg.2.2,
    exact is_normal.blsub_eq.{u u} hf ha }
end

theorem is_normal.cof_eq {f} (hf : is_normal f) {a} (ha : is_limit a) : cof (f a) = cof a :=
let ⟨g, hg⟩ := exists_fundamental_sequence a in
  ord_injective (hf.is_fundamental_sequence ha hg).cof_eq

theorem is_normal.cof_le {f} (hf : is_normal f) (a) : cof a ≤ cof (f a) :=
begin
  rcases zero_or_succ_or_limit a with rfl | ⟨b, rfl⟩ | ha,
  { rw cof_zero,
    exact zero_le _ },
  { rw [cof_succ, cardinal.one_le_iff_ne_zero, cof_ne_zero, ←ordinal.pos_iff_ne_zero],
    exact (ordinal.zero_le (f b)).trans_lt (hf.1 b) },
  { rw hf.cof_eq ha }
end

@[simp] theorem cof_add (a b : ordinal) : b ≠ 0 → cof (a + b) = cof b :=
λ h, begin
  rcases zero_or_succ_or_limit b with rfl | ⟨c, rfl⟩ | hb,
  { contradiction },
  { rw [add_succ, cof_succ, cof_succ] },
  { exact (add_is_normal a).cof_eq hb }
end

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

@[simp] theorem aleph'_cof {o : ordinal} (ho : o.is_limit) : (aleph' o).ord.cof = o.cof :=
aleph'_is_normal.cof_eq ho

@[simp] theorem aleph_cof {o : ordinal} (ho : o.is_limit) : (aleph o).ord.cof = o.cof :=
aleph_is_normal.cof_eq ho

@[simp] theorem cof_omega : cof ω = ℵ₀ :=
(aleph_0_le_cof.2 omega_is_limit).antisymm' $ by { rw ←card_omega, apply cof_le_card }

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

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

/-! ### Infinite pigeonhole principle -/

/-- If the union of s is unbounded and s is smaller than the cofinality,
  then s has an unbounded member -/
theorem unbounded_of_unbounded_sUnion (r : α → α → Prop) [wo : is_well_order α r] {s : set (set α)}
  (h₁ : unbounded r $ ⋃₀ s) (h₂ : #s < strict_order.cof r) : ∃ x ∈ s, unbounded r x :=
begin
  by_contra' h,
  simp_rw not_unbounded_iff at h,
  let f : s → α := λ x : s, wo.wf.sup x (h x.1 x.2),
  refine h₂.not_le (le_trans (cInf_le' ⟨range f, λ x, _, rfl⟩) mk_range_le),
  rcases h₁ x with ⟨y, ⟨c, hc, hy⟩, hxy⟩,
  exact ⟨f ⟨c, hc⟩, mem_range_self _, λ hxz, hxy (trans (wo.wf.lt_sup _ hy) hxz)⟩
end

/-- If the union of s is unbounded and s is smaller than the cofinality,
  then s has an unbounded member -/
theorem unbounded_of_unbounded_Union {α β : Type u} (r : α → α → Prop) [wo : is_well_order α r]
  (s : β → set α)
  (h₁ : unbounded r $ ⋃ x, s x) (h₂ : #β < strict_order.cof r) : ∃ x : β, unbounded r (s x) :=
begin
  rw ←sUnion_range at h₁,
  rcases unbounded_of_unbounded_sUnion r h₁ (mk_range_le.trans_lt h₂) with ⟨_, ⟨x, rfl⟩, u⟩,
  exact ⟨x, u⟩
end

/-- The infinite pigeonhole principle -/
theorem infinite_pigeonhole {β α : Type u} (f : β → α) (h₁ : ℵ₀ ≤ #β)
  (h₂ : #α < (#β).ord.cof) : ∃ a : α, #(f ⁻¹' {a}) = #β :=
begin
  have : ∃ a, #β ≤ #(f ⁻¹' {a}),
  { by_contra' h,
    apply mk_univ.not_lt,
    rw [←preimage_univ, ←Union_of_singleton, preimage_Union],
    exact mk_Union_le_sum_mk.trans_lt ((sum_le_supr _).trans_lt $ mul_lt_of_lt h₁
      (h₂.trans_le $ cof_ord_le _) (supr_lt h₂ h)) },
  cases this with x h,
  refine ⟨x, h.antisymm' _⟩,
  rw le_mk_iff_exists_set,
  exact ⟨_, rfl⟩
end

/-- Pigeonhole principle for a cardinality below the cardinality of the domain -/
theorem infinite_pigeonhole_card {β α : Type u} (f : β → α) (θ : cardinal) (hθ : θ ≤ #β)
  (h₁ : ℵ₀ ≤ θ) (h₂ : #α < θ.ord.cof) : ∃ a : α, θ ≤ #(f ⁻¹' {a}) :=
begin
  rcases le_mk_iff_exists_set.1 hθ with ⟨s, rfl⟩,
  cases infinite_pigeonhole (f ∘ subtype.val : s → α) h₁ h₂ with a ha,
  use a, rw [←ha, @preimage_comp _ _ _ subtype.val f],
  exact mk_preimage_of_injective _ _ subtype.val_injective
end

theorem infinite_pigeonhole_set {β α : Type u} {s : set β} (f : s → α) (θ : cardinal)
  (hθ : θ ≤ #s) (h₁ : ℵ₀ ≤ θ) (h₂ : #α < θ.ord.cof) :
    ∃ (a : α) (t : set β) (h : t ⊆ s), θ ≤ #t ∧ ∀ {{x}} (hx : x ∈ t), f ⟨x, h hx⟩ = a :=
begin
  cases infinite_pigeonhole_card f θ hθ h₁ h₂ with a ha,
  refine ⟨a, {x | ∃ h, f ⟨x, h⟩ = a}, _, _, _⟩,
  { rintro x ⟨hx, hx'⟩, exact hx },
  { refine ha.trans (ge_of_eq $ quotient.sound ⟨equiv.trans _
      (equiv.subtype_subtype_equiv_subtype_exists _ _).symm⟩),
    simp only [coe_eq_subtype, mem_singleton_iff, mem_preimage, mem_set_of_eq] },
  rintro x ⟨hx, hx'⟩, exact hx'
end

end ordinal

/-! ### Regular and inaccessible cardinals -/

namespace cardinal
open ordinal

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

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

theorem is_limit.ne_zero {c} (h : is_limit c) : c ≠ 0 :=
h.1

theorem is_limit.succ_lt {x c} (h : is_limit c) : x < c → succ x < c :=
h.2 x

theorem is_limit.aleph_0_le {c} (h : is_limit c) : ℵ₀ ≤ c :=
begin
  by_contra' h',
  rcases lt_aleph_0.1 h' with ⟨_ | n, rfl⟩,
  { exact h.1.irrefl },
  { simpa using h.2 n }
end

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

theorem is_strong_limit.ne_zero {c} (h : is_strong_limit c) : c ≠ 0 :=
h.1

theorem is_strong_limit.two_power_lt {x c} (h : is_strong_limit c) : x < c → 2 ^ x < c :=
h.2 x

theorem is_strong_limit_aleph_0 : is_strong_limit ℵ₀ :=
⟨aleph_0_ne_zero, λ x hx, begin
  rcases lt_aleph_0.1 hx with ⟨n, rfl⟩,
  exact_mod_cast nat_lt_aleph_0 (pow 2 n)
end⟩

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

theorem is_limit_aleph_0 : is_limit ℵ₀ :=
is_strong_limit_aleph_0.is_limit

theorem mk_bounded_subset {α : Type*} (h : ∀ x < #α, 2 ^ x < #α) {r : α → α → Prop}
  [is_well_order α r] (hr : (#α).ord = type r) : #{s : set α // bounded r s} = #α :=
begin
  rcases eq_or_ne (#α) 0 with ha | ha,
  { rw ha,
    haveI := mk_eq_zero_iff.1 ha,
    rw mk_eq_zero_iff,
    split,
    rintro ⟨s, hs⟩,
    exact (not_unbounded_iff s).2 hs (unbounded_of_is_empty s) },
  have h' : is_strong_limit (#α) := ⟨ha, h⟩,
  have ha := h'.is_limit.aleph_0_le,
  apply le_antisymm,
  { have : {s : set α | bounded r s} = ⋃ i, 𝒫 {j | r j i} := set_of_exists _,
    rw [←coe_set_of, this],
    convert mk_Union_le_sum_mk.trans ((sum_le_supr _).trans (mul_le_max_of_aleph_0_le_left ha)),
    apply (max_eq_left _).symm, apply csupr_le' (λ i, _),
    rw mk_powerset,
    apply (h'.two_power_lt _).le,
    rw [coe_set_of, card_typein, ←lt_ord, hr],
    apply typein_lt_type },
  { refine @mk_le_of_injective α _ (λ x, subtype.mk {x} _) _,
    { apply bounded_singleton,
      rw ←hr,
      apply ord_is_limit ha },
    { intros a b hab,
      simpa only [singleton_eq_singleton_iff] using hab } }
end

theorem mk_subset_mk_lt_cof {α : Type*} (h : ∀ x < #α, 2 ^ x < #α) :
  #{s : set α // #s < cof (#α).ord} = #α :=
begin
  rcases eq_or_ne (#α) 0 with ha | ha,
  { rw ha,
    simp [λ s, (cardinal.zero_le s).not_lt] },
  have h' : is_strong_limit (#α) := ⟨ha, h⟩,
  rcases ord_eq α with ⟨r, wo, hr⟩,
  haveI := wo,
  apply le_antisymm,
  { nth_rewrite_rhs 0 ←mk_bounded_subset h hr,
    apply mk_le_mk_of_subset (λ s hs, _),
    rw hr at hs,
    exact lt_cof_type hs },
  { refine @mk_le_of_injective α _ (λ x, subtype.mk {x} _) _,
    { rw mk_singleton,
      exact one_lt_aleph_0.trans_le (aleph_0_le_cof.2 (ord_is_limit h'.is_limit.aleph_0_le)) },
    { intros a b hab,
      simpa only [singleton_eq_singleton_iff] using hab } }
end

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

lemma is_regular.aleph_0_le {c : cardinal} (H : c.is_regular) : ℵ₀ ≤ c :=
H.1

lemma is_regular.cof_eq {c : cardinal} (H : c.is_regular) : c.ord.cof = c :=
(cof_ord_le c).antisymm H.2

lemma is_regular.pos {c : cardinal} (H : c.is_regular) : 0 < c :=
aleph_0_pos.trans_le H.1

lemma is_regular.ord_pos {c : cardinal} (H : c.is_regular) : 0 < c.ord :=
by { rw cardinal.lt_ord, exact H.pos }

theorem is_regular_cof {o : ordinal} (h : o.is_limit) : is_regular o.cof :=
⟨aleph_0_le_cof.2 h, (cof_cof o).ge⟩

theorem is_regular_aleph_0 : is_regular ℵ₀ :=
⟨le_rfl, by simp⟩

theorem is_regular_succ {c : cardinal.{u}} (h : ℵ₀ ≤ c) : is_regular (succ c) :=
⟨h.trans (le_succ c), succ_le_of_lt begin
  cases quotient.exists_rep (@succ cardinal _ _ c) with α αe, simp at αe,
  rcases ord_eq α with ⟨r, wo, re⟩, resetI,
  have := ord_is_limit (h.trans (le_succ _)),
  rw [← αe, re] at this ⊢,
  rcases cof_eq' r this with ⟨S, H, Se⟩,
  rw [← Se],
  apply lt_imp_lt_of_le_imp_le (λ h, mul_le_mul_right' h c),
  rw [mul_eq_self h, ← succ_le_iff, ← αe, ← sum_const'],
  refine le_trans _ (sum_le_sum (λ x, card (typein r x)) _ (λ i, _)),
  { simp only [← card_typein, ← mk_sigma],
    exact ⟨embedding.of_surjective (λ x, x.2.1)
      (λ a, let ⟨b, h, ab⟩ := H a in ⟨⟨⟨_, h⟩, _, ab⟩, rfl⟩)⟩ },
  { rw [← lt_succ_iff, ← lt_ord, ← αe, re],
    apply typein_lt_type }
end⟩

theorem is_regular_aleph_one : is_regular (aleph 1) :=
by { rw ←succ_aleph_0, exact is_regular_succ le_rfl }

theorem is_regular_aleph'_succ {o : ordinal} (h : ω ≤ o) : is_regular (aleph' (succ o)) :=
by { rw aleph'_succ, exact is_regular_succ (aleph_0_le_aleph'.2 h) }

theorem is_regular_aleph_succ (o : ordinal) : is_regular (aleph (succ o)) :=
by { rw aleph_succ, exact is_regular_succ (aleph_0_le_aleph o) }

/--
A function whose codomain's cardinality is infinite but strictly smaller than its domain's
has a fiber with cardinality strictly great than the codomain.
-/
theorem infinite_pigeonhole_card_lt {β α : Type u} (f : β → α)
  (w : #α < #β) (w' : ℵ₀ ≤ #α) :
  ∃ a : α, #α < #(f ⁻¹' {a}) :=
begin
  simp_rw [← succ_le_iff],
  exact ordinal.infinite_pigeonhole_card f (succ (#α)) (succ_le_of_lt w)
    (w'.trans (lt_succ _).le)
    ((lt_succ _).trans_le (is_regular_succ w').2.ge),
end

/--
A function whose codomain's cardinality is infinite but strictly smaller than its domain's
has an infinite fiber.
-/
theorem exists_infinite_fiber {β α : Type*} (f : β → α)
  (w : #α < #β) (w' : _root_.infinite α) :
  ∃ a : α, _root_.infinite (f ⁻¹' {a}) :=
begin
  simp_rw [cardinal.infinite_iff] at ⊢ w',
  cases infinite_pigeonhole_card_lt f w w' with a ha,
  exact ⟨a, w'.trans ha.le⟩,
end

/--
If an infinite type `β` can be expressed as a union of finite sets,
then the cardinality of the collection of those finite sets
must be at least the cardinality of `β`.
-/
lemma le_range_of_union_finset_eq_top
  {α β : Type*} [infinite β] (f : α → finset β) (w : (⋃ a, (f a : set β)) = ⊤) :
  #β ≤ #(range f) :=
begin
  have k : _root_.infinite (range f),
  { rw infinite_coe_iff,
    apply mt (union_finset_finite_of_range_finite f),
    rw w,
    exact infinite_univ, },
  by_contradiction h,
  simp only [not_le] at h,
  let u : Π b, ∃ a, b ∈ f a := λ b, by simpa using (w.ge : _) (set.mem_univ b),
  let u' : β → range f := λ b, ⟨f (u b).some, by simp⟩,
  have v' : ∀ a, u' ⁻¹' {⟨f a, by simp⟩} ≤ f a, begin rintros a p m,
    simp at m,
    rw ←m,
    apply (λ b, (u b).some_spec),
  end,
  obtain ⟨⟨-, ⟨a, rfl⟩⟩, p⟩ := exists_infinite_fiber u' h k,
  exact (@infinite.of_injective _ _ p (inclusion (v' a)) (inclusion_injective _)).false,
end

theorem lsub_lt_ord_lift_of_is_regular {ι} {f : ι → ordinal} {c} (hc : is_regular c)
  (hι : cardinal.lift (#ι) < c) : (∀ i, f i < c.ord) → ordinal.lsub f < c.ord :=
lsub_lt_ord_lift (by rwa hc.cof_eq)

theorem lsub_lt_ord_of_is_regular {ι} {f : ι → ordinal} {c} (hc : is_regular c) (hι : #ι < c) :
  (∀ i, f i < c.ord) → ordinal.lsub f < c.ord :=
lsub_lt_ord (by rwa hc.cof_eq)

theorem sup_lt_ord_lift_of_is_regular {ι} {f : ι → ordinal} {c} (hc : is_regular c)
  (hι : cardinal.lift (#ι) < c) : (∀ i, f i < c.ord) → ordinal.sup f < c.ord :=
sup_lt_ord_lift (by rwa hc.cof_eq)

theorem sup_lt_ord_of_is_regular {ι} {f : ι → ordinal} {c} (hc : is_regular c) (hι : #ι < c) :
  (∀ i, f i < c.ord) → ordinal.sup f < c.ord :=
sup_lt_ord (by rwa hc.cof_eq)

theorem blsub_lt_ord_lift_of_is_regular {o : ordinal} {f : Π a < o, ordinal} {c} (hc : is_regular c)
  (ho : cardinal.lift o.card < c) : (∀ i hi, f i hi < c.ord) → ordinal.blsub o f < c.ord :=
blsub_lt_ord_lift (by rwa hc.cof_eq)

theorem blsub_lt_ord_of_is_regular {o : ordinal} {f : Π a < o, ordinal} {c} (hc : is_regular c)
  (ho : o.card < c) : (∀ i hi, f i hi < c.ord) → ordinal.blsub o f < c.ord :=
blsub_lt_ord (by rwa hc.cof_eq)

theorem bsup_lt_ord_lift_of_is_regular {o : ordinal} {f : Π a < o, ordinal} {c} (hc : is_regular c)
  (hι : cardinal.lift o.card < c) : (∀ i hi, f i hi < c.ord) → ordinal.bsup o f < c.ord :=
bsup_lt_ord_lift (by rwa hc.cof_eq)

theorem bsup_lt_ord_of_is_regular {o : ordinal} {f : Π a < o, ordinal} {c} (hc : is_regular c)
  (hι : o.card < c) : (∀ i hi, f i hi < c.ord) → ordinal.bsup o f < c.ord :=
bsup_lt_ord (by rwa hc.cof_eq)

theorem supr_lt_lift_of_is_regular {ι} {f : ι → cardinal} {c} (hc : is_regular c)
  (hι : cardinal.lift (#ι) < c) : (∀ i, f i < c) → supr f < c :=
supr_lt_lift (by rwa hc.cof_eq)

theorem supr_lt_of_is_regular {ι} {f : ι → cardinal} {c} (hc : is_regular c) (hι : #ι < c) :
  (∀ i, f i < c) → supr f < c :=
supr_lt (by rwa hc.cof_eq)

theorem sum_lt_lift_of_is_regular {ι : Type u} {f : ι → cardinal} {c : cardinal} (hc : is_regular c)
  (hι : cardinal.lift.{v u} (#ι) < c) (hf : ∀ i, f i < c) : sum f < c :=
(sum_le_supr_lift _).trans_lt $ mul_lt_of_lt hc.1 hι (supr_lt_lift_of_is_regular hc hι hf)

theorem sum_lt_of_is_regular {ι : Type u} {f : ι → cardinal} {c : cardinal} (hc : is_regular c)
  (hι : #ι < c) : (∀ i, f i < c) → sum f < c :=
sum_lt_lift_of_is_regular.{u u} hc (by rwa lift_id)

theorem nfp_family_lt_ord_lift_of_is_regular {ι} {f : ι → ordinal → ordinal} {c} (hc : is_regular c)
  (hι : (#ι).lift < c) (hc' : c ≠ ℵ₀) (hf : ∀ i (b < c.ord), f i b < c.ord) {a} (ha : a < c.ord) :
  nfp_family.{u v} f a < c.ord :=
by { apply nfp_family_lt_ord_lift _ _ hf ha; rwa hc.cof_eq, exact lt_of_le_of_ne hc.1 hc'.symm }

theorem nfp_family_lt_ord_of_is_regular {ι} {f : ι → ordinal → ordinal} {c} (hc : is_regular c)
  (hι : #ι < c) (hc' : c ≠ ℵ₀) {a} (hf : ∀ i (b < c.ord), f i b < c.ord) :
  a < c.ord → nfp_family.{u u} f a < c.ord :=
nfp_family_lt_ord_lift_of_is_regular hc (by rwa lift_id) hc' hf

theorem nfp_bfamily_lt_ord_lift_of_is_regular {o : ordinal} {f : Π a < o, ordinal → ordinal} {c}
  (hc : is_regular c) (ho : o.card.lift < c) (hc' : c ≠ ℵ₀)
  (hf : ∀ i hi (b < c.ord), f i hi b < c.ord) {a} : a < c.ord → nfp_bfamily.{u v} o f a < c.ord :=
nfp_family_lt_ord_lift_of_is_regular hc (by rwa mk_ordinal_out) hc' (λ i, hf _ _)

theorem nfp_bfamily_lt_ord_of_is_regular {o : ordinal} {f : Π a < o, ordinal → ordinal} {c}
  (hc : is_regular c) (ho : o.card < c) (hc' : c ≠ ℵ₀) (hf : ∀ i hi (b < c.ord), f i hi b < c.ord)
  {a} : a < c.ord → nfp_bfamily.{u u} o f a < c.ord :=
nfp_bfamily_lt_ord_lift_of_is_regular hc (by rwa lift_id) hc' hf

theorem nfp_lt_ord_of_is_regular {f : ordinal → ordinal} {c} (hc : is_regular c) (hc' : c ≠ ℵ₀)
  (hf : ∀ i < c.ord, f i < c.ord) {a} : (a < c.ord) → nfp f a < c.ord :=
nfp_lt_ord (by { rw hc.cof_eq, exact lt_of_le_of_ne hc.1 hc'.symm }) hf

theorem deriv_family_lt_ord_lift {ι} {f : ι → ordinal → ordinal} {c} (hc : is_regular c)
  (hι : (#ι).lift < c) (hc' : c ≠ ℵ₀) (hf : ∀ i (b < c.ord), f i b < c.ord) {a} :
  a < c.ord → deriv_family.{u v} f a < c.ord :=
begin
  have hω : ℵ₀ < c.ord.cof,
  { rw hc.cof_eq, exact lt_of_le_of_ne hc.1 hc'.symm },
  apply a.limit_rec_on,
  { rw deriv_family_zero,
    exact nfp_family_lt_ord_lift hω (by rwa hc.cof_eq) hf },
  { intros b hb hb',
    rw deriv_family_succ,
    exact nfp_family_lt_ord_lift hω (by rwa hc.cof_eq) hf
      ((ord_is_limit hc.1).2 _ (hb ((lt_succ b).trans hb'))) },
  { intros b hb H hb',
    rw deriv_family_limit f hb,
    exact bsup_lt_ord_of_is_regular hc (ord_lt_ord.1 ((ord_card_le b).trans_lt hb'))
      (λ o' ho', H o' ho' (ho'.trans hb')) }
end

theorem deriv_family_lt_ord {ι} {f : ι → ordinal → ordinal} {c} (hc : is_regular c)
  (hι : #ι < c) (hc' : c ≠ ℵ₀) (hf : ∀ i (b < c.ord), f i b < c.ord) {a} :
  a < c.ord → deriv_family.{u u} f a < c.ord :=
deriv_family_lt_ord_lift hc (by rwa lift_id) hc' hf

theorem deriv_bfamily_lt_ord_lift {o : ordinal} {f : Π a < o, ordinal → ordinal} {c}
  (hc : is_regular c) (hι : o.card.lift < c) (hc' : c ≠ ℵ₀)
  (hf : ∀ i hi (b < c.ord), f i hi b < c.ord) {a} :
  a < c.ord → deriv_bfamily.{u v} o f a < c.ord :=
deriv_family_lt_ord_lift hc (by rwa mk_ordinal_out) hc' (λ i, hf _ _)

theorem deriv_bfamily_lt_ord {o : ordinal} {f : Π a < o, ordinal → ordinal} {c} (hc : is_regular c)
  (hι : o.card < c) (hc' : c ≠ ℵ₀) (hf : ∀ i hi (b < c.ord), f i hi b < c.ord)
  {a} : a < c.ord → deriv_bfamily.{u u} o f a < c.ord :=
deriv_bfamily_lt_ord_lift hc (by rwa lift_id) hc' hf

theorem deriv_lt_ord {f : ordinal.{u} → ordinal} {c} (hc : is_regular c) (hc' : c ≠ ℵ₀)
  (hf : ∀ i < c.ord, f i < c.ord) {a} : a < c.ord → deriv f a < c.ord :=
deriv_family_lt_ord_lift hc
  (by simpa using cardinal.one_lt_aleph_0.trans (lt_of_le_of_ne hc.1 hc'.symm))
  hc' (λ _, hf)

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

theorem is_inaccessible.mk {c} (h₁ : ℵ₀ < c) (h₂ : c ≤ c.ord.cof) (h₃ : ∀ x < c, 2 ^ x < c) :
  is_inaccessible c :=
⟨h₁, ⟨h₁.le, h₂⟩, (aleph_0_pos.trans h₁).ne', h₃⟩

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

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

theorem lt_cof_power {a b : cardinal} (ha : ℵ₀ ≤ a) (b1 : 1 < b) :
  a < cof (b ^ a).ord :=
begin
  have b0 : b ≠ 0 := (zero_lt_one.trans b1).ne',
  apply lt_imp_lt_of_le_imp_le (power_le_power_left $ power_ne_zero a b0),
  rw [←power_mul, mul_eq_self ha],
  exact lt_power_cof (ha.trans $ (cantor' _ b1).le),
end

end cardinal


/-
Copyright (c) 2022 María Inés de Frutos-Fernández. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: María Inés de Frutos-Fernández
-/
import ring_theory.dedekind_domain.ideal
import ring_theory.valuation.extend_to_localization
import ring_theory.valuation.valuation_subring
import topology.algebra.valued_field

/-!
# Adic valuations on Dedekind domains
Given a Dedekind domain `R` of Krull dimension 1 and a maximal ideal `v` of `R`, we define the
`v`-adic valuation on `R` and its extension to the field of fractions `K` of `R`.
We prove several properties of this valuation, including the existence of uniformizers.

We define the completion of `K` with respect to the `v`-adic valuation, denoted
`v.adic_completion`,and its ring of integers, denoted `v.adic_completion_integers`.

## Main definitions
 - `is_dedekind_domain.height_one_spectrum.int_valuation v` is the `v`-adic valuation on `R`.
 - `is_dedekind_domain.height_one_spectrum.valuation v` is the `v`-adic valuation on `K`.
 - `is_dedekind_domain.height_one_spectrum.adic_completion v` is the completion of `K` with respect
    to its `v`-adic valuation.
 - `is_dedekind_domain.height_one_spectrum.adic_completion_integers v` is the ring of integers of
    `v.adic_completion`.

## Main results
- `is_dedekind_domain.height_one_spectrum.int_valuation_le_one` : The `v`-adic valuation on `R` is
  bounded above by 1.
- `is_dedekind_domain.height_one_spectrum.int_valuation_lt_one_iff_dvd` : The `v`-adic valuation of
  `r ∈ R` is less than 1 if and only if `v` divides the ideal `(r)`.
- `is_dedekind_domain.height_one_spectrum.int_valuation_le_pow_iff_dvd` : The `v`-adic valuation of
  `r ∈ R` is less than or equal to `multiplicative.of_add (-n)` if and only if `vⁿ` divides the
  ideal `(r)`.
- `is_dedekind_domain.height_one_spectrum.int_valuation_exists_uniformizer` : There exists `π ∈ R`
  with `v`-adic valuation `multiplicative.of_add (-1)`.
- `is_dedekind_domain.height_one_spectrum.int_valuation_div_eq_div` : The valuation of `k ∈ K` is
  independent on how we express `k` as a fraction.
- `is_dedekind_domain.height_one_spectrum.valuation_of_mk'` : The `v`-adic valuation of `r/s ∈ K`
  is the valuation of `r` divided by the valuation of `s`.
- `is_dedekind_domain.height_one_spectrum.valuation_of_algebra_map` : The `v`-adic valuation on `K`
  extends the `v`-adic valuation on `R`.
- `is_dedekind_domain.height_one_spectrum.valuation_exists_uniformizer` : There exists `π ∈ K` with
  `v`-adic valuation `multiplicative.of_add (-1)`.

## Implementation notes
We are only interested in Dedekind domains with Krull dimension 1.

## References
* [G. J. Janusz, *Algebraic Number Fields*][janusz1996]
* [J.W.S. Cassels, A. Frölich, *Algebraic Number Theory*][cassels1967algebraic]
* [J. Neukirch, *Algebraic Number Theory*][Neukirch1992]

## Tags
dedekind domain, dedekind ring, adic valuation
-/

noncomputable theory
open_locale classical discrete_valuation

open multiplicative is_dedekind_domain

variables {R : Type*} [comm_ring R] [is_domain R] [is_dedekind_domain R] {K : Type*} [field K]
  [algebra R K] [is_fraction_ring R K] (v : height_one_spectrum R)

namespace is_dedekind_domain.height_one_spectrum
/-! ### Adic valuations on the Dedekind domain R -/

/-- The additive `v`-adic valuation of `r ∈ R` is the exponent of `v` in the factorization of the
ideal `(r)`, if `r` is nonzero, or infinity, if `r = 0`. `int_valuation_def` is the corresponding
multiplicative valuation. -/
def int_valuation_def (r : R) : ℤₘ₀ :=
if r = 0 then 0 else multiplicative.of_add
  (-(associates.mk v.as_ideal).count (associates.mk (ideal.span {r} : ideal R)).factors : ℤ)

lemma int_valuation_def_if_pos {r : R} (hr : r = 0) : v.int_valuation_def r = 0 := if_pos hr

lemma int_valuation_def_if_neg {r : R} (hr : r ≠ 0) : v.int_valuation_def r = (multiplicative.of_add
  (-(associates.mk v.as_ideal).count (associates.mk (ideal.span {r} : ideal R)).factors : ℤ)) :=
if_neg hr

/-- Nonzero elements have nonzero adic valuation. -/
lemma int_valuation_ne_zero (x : R) (hx : x ≠ 0) : v.int_valuation_def x ≠ 0 :=
begin
  rw [int_valuation_def, if_neg hx],
  exact with_zero.coe_ne_zero,
end

/-- Nonzero divisors have nonzero valuation. -/
lemma int_valuation_ne_zero' (x : non_zero_divisors R) : v.int_valuation_def x ≠ 0 :=
v.int_valuation_ne_zero x (non_zero_divisors.coe_ne_zero x)

/-- Nonzero divisors have valuation greater than zero. -/
lemma int_valuation_zero_le (x : non_zero_divisors R) : 0 < v.int_valuation_def x :=
begin
  rw [v.int_valuation_def_if_neg (non_zero_divisors.coe_ne_zero x)],
  exact with_zero.zero_lt_coe _,
end

/-- The `v`-adic valuation on `R` is bounded above by 1. -/
lemma int_valuation_le_one (x : R) : v.int_valuation_def x ≤ 1 :=
begin
  rw int_valuation_def,
  by_cases hx : x = 0,
  { rw if_pos hx, exact with_zero.zero_le 1 },
  { rw [if_neg hx, ← with_zero.coe_one, ← of_add_zero, with_zero.coe_le_coe, of_add_le,
      right.neg_nonpos_iff],
    exact int.coe_nat_nonneg _ }
end

/-- The `v`-adic valuation of `r ∈ R` is less than 1 if and only if `v` divides the ideal `(r)`. -/
lemma int_valuation_lt_one_iff_dvd (r : R) :
  v.int_valuation_def r < 1 ↔ v.as_ideal ∣ ideal.span {r} :=
begin
  rw int_valuation_def,
  split_ifs with hr,
  { simpa [hr] using (with_zero.zero_lt_coe _) },
  { rw [← with_zero.coe_one, ← of_add_zero, with_zero.coe_lt_coe, of_add_lt, neg_lt_zero,
      ← int.coe_nat_zero, int.coe_nat_lt, zero_lt_iff],
    have h : (ideal.span {r} : ideal R) ≠ 0,
    { rw [ne.def, ideal.zero_eq_bot, ideal.span_singleton_eq_bot],
      exact hr },
    apply associates.count_ne_zero_iff_dvd h (by apply v.irreducible) }
end

/-- The `v`-adic valuation of `r ∈ R` is less than `multiplicative.of_add (-n)` if and only if
`vⁿ` divides the ideal `(r)`. -/
lemma int_valuation_le_pow_iff_dvd (r : R) (n : ℕ) :
  v.int_valuation_def r ≤ multiplicative.of_add (-(n : ℤ)) ↔ v.as_ideal^n ∣ ideal.span {r} :=
begin
  rw int_valuation_def,
  split_ifs with hr,
  { simp_rw [hr, ideal.dvd_span_singleton, zero_le', submodule.zero_mem], },
  { rw [with_zero.coe_le_coe, of_add_le, neg_le_neg_iff, int.coe_nat_le, ideal.dvd_span_singleton,
      ← associates.le_singleton_iff, associates.prime_pow_dvd_iff_le (associates.mk_ne_zero'.mpr hr)
      (by apply v.associates_irreducible)] }
end

/-- The `v`-adic valuation of `0 : R` equals 0. -/
lemma int_valuation.map_zero' : v.int_valuation_def 0 = 0 := v.int_valuation_def_if_pos (eq.refl 0)

/-- The `v`-adic valuation of `1 : R` equals 1. -/
lemma int_valuation.map_one' : v.int_valuation_def 1 = 1 :=
by rw [v.int_valuation_def_if_neg (zero_ne_one.symm : (1 : R) ≠ 0), ideal.span_singleton_one,
  ← ideal.one_eq_top, associates.mk_one, associates.factors_one, associates.count_zero
  (by apply v.associates_irreducible), int.coe_nat_zero, neg_zero, of_add_zero, with_zero.coe_one]

/-- The `v`-adic valuation of a product equals the product of the valuations. -/
lemma int_valuation.map_mul' (x y : R) :
  v.int_valuation_def (x * y) = v.int_valuation_def x * v.int_valuation_def y :=
begin
  simp only [int_valuation_def],
  by_cases hx : x = 0,
  { rw [hx, zero_mul, if_pos (eq.refl _), zero_mul] },
  { by_cases hy : y = 0,
    { rw [hy, mul_zero, if_pos (eq.refl _), mul_zero] },
    { rw [if_neg hx, if_neg hy, if_neg (mul_ne_zero hx hy), ← with_zero.coe_mul, with_zero.coe_inj,
        ← of_add_add, ← ideal.span_singleton_mul_span_singleton, ← associates.mk_mul_mk, ← neg_add,
        associates.count_mul (by apply associates.mk_ne_zero'.mpr hx)
        (by apply associates.mk_ne_zero'.mpr hy) (by apply v.associates_irreducible)],
      refl }}
end

lemma int_valuation.le_max_iff_min_le {a b c : ℕ} :  multiplicative.of_add(-c : ℤ) ≤
  max (multiplicative.of_add(-a : ℤ)) (multiplicative.of_add(-b : ℤ)) ↔ min a b ≤ c :=
by rw [le_max_iff, of_add_le, of_add_le, neg_le_neg_iff, neg_le_neg_iff, int.coe_nat_le,
    int.coe_nat_le, ← min_le_iff]

/-- The `v`-adic valuation of a sum is bounded above by the maximum of the valuations. -/
lemma int_valuation.map_add_le_max' (x y : R) : v.int_valuation_def (x + y) ≤
  max (v.int_valuation_def x) (v.int_valuation_def y) :=
begin
  by_cases hx : x = 0,
  { rw [hx, zero_add],
    conv_rhs {rw [int_valuation_def, if_pos (eq.refl _)]},
    rw max_eq_right (with_zero.zero_le (v.int_valuation_def y)),
    exact le_refl _, },
  { by_cases hy : y = 0,
    { rw [hy, add_zero],
      conv_rhs {rw [max_comm, int_valuation_def, if_pos (eq.refl _)]},
      rw max_eq_right (with_zero.zero_le (v.int_valuation_def x)),
      exact le_refl _ },
    { by_cases hxy : x + y = 0,
      { rw [int_valuation_def, if_pos hxy], exact zero_le',},
      { rw [v.int_valuation_def_if_neg hxy, v.int_valuation_def_if_neg hx,
          v.int_valuation_def_if_neg hy, with_zero.le_max_iff, int_valuation.le_max_iff_min_le],
      set nmin := min
        ((associates.mk v.as_ideal).count (associates.mk (ideal.span {x})).factors)
        ((associates.mk v.as_ideal).count (associates.mk (ideal.span {y})).factors),
      have h_dvd_x : x ∈ v.as_ideal ^ (nmin),
      { rw [← associates.le_singleton_iff x nmin _,
          associates.prime_pow_dvd_iff_le (associates.mk_ne_zero'.mpr hx) _],
        exact min_le_left _ _,
        apply v.associates_irreducible },
      have h_dvd_y : y ∈ v.as_ideal ^ nmin,
      { rw [← associates.le_singleton_iff y nmin _,
          associates.prime_pow_dvd_iff_le (associates.mk_ne_zero'.mpr hy) _],
        exact min_le_right _ _,
        apply v.associates_irreducible },
      have h_dvd_xy : associates.mk v.as_ideal^nmin ≤ associates.mk (ideal.span {x + y}),
      { rw associates.le_singleton_iff,
        exact ideal.add_mem (v.as_ideal^nmin) h_dvd_x h_dvd_y, },
      rw (associates.prime_pow_dvd_iff_le (associates.mk_ne_zero'.mpr hxy) _) at h_dvd_xy,
      exact h_dvd_xy,
      apply v.associates_irreducible, }}}
end

/-- The `v`-adic valuation on `R`. -/
def int_valuation : valuation R ℤₘ₀ :=
{ to_fun          := v.int_valuation_def,
  map_zero'       := int_valuation.map_zero' v,
  map_one'        := int_valuation.map_one' v,
  map_mul'        := int_valuation.map_mul' v,
  map_add_le_max' := int_valuation.map_add_le_max' v }

/-- There exists `π ∈ R` with `v`-adic valuation `multiplicative.of_add (-1)`. -/
lemma int_valuation_exists_uniformizer :
  ∃ (π : R), v.int_valuation_def π = multiplicative.of_add (-1 : ℤ) :=
begin
  have hv : _root_.irreducible (associates.mk v.as_ideal) := v.associates_irreducible,
  have hlt : v.as_ideal^2 < v.as_ideal,
  { rw ← ideal.dvd_not_unit_iff_lt,
    exact ⟨v.ne_bot, v.as_ideal,
     (not_congr ideal.is_unit_iff).mpr (ideal.is_prime.ne_top v.is_prime), sq v.as_ideal⟩ } ,
  obtain ⟨π, mem, nmem⟩ := set_like.exists_of_lt hlt,
  have hπ : associates.mk (ideal.span {π}) ≠ 0,
  { rw associates.mk_ne_zero',
    intro h,
    rw h at nmem,
    exact nmem (submodule.zero_mem (v.as_ideal^2)), },
  use π,
  rw [int_valuation_def, if_neg (associates.mk_ne_zero'.mp hπ), with_zero.coe_inj],
  apply congr_arg,
  rw [neg_inj, ← int.coe_nat_one, int.coe_nat_inj'],
  rw [← ideal.dvd_span_singleton, ← associates.mk_le_mk_iff_dvd_iff] at mem nmem,
  rw [← pow_one (associates.mk v.as_ideal), associates.prime_pow_dvd_iff_le hπ hv] at mem,
  rw [associates.mk_pow, associates.prime_pow_dvd_iff_le hπ hv, not_le] at nmem,
  exact nat.eq_of_le_of_lt_succ mem nmem,
end

/-! ### Adic valuations on the field of fractions `K` -/

/-- The `v`-adic valuation of `x ∈ K` is the valuation of `r` divided by the valuation of `s`,
where `r` and `s` are chosen so that `x = r/s`. -/
def valuation (v : height_one_spectrum R) : valuation K ℤₘ₀ :=
v.int_valuation.extend_to_localization (λ r hr, set.mem_compl $ v.int_valuation_ne_zero' ⟨r, hr⟩) K

lemma valuation_def (x : K) : v.valuation x = v.int_valuation.extend_to_localization
  (λ r hr, set.mem_compl (v.int_valuation_ne_zero' ⟨r, hr⟩)) K x :=
rfl

/-- The `v`-adic valuation of `r/s ∈ K` is the valuation of `r` divided by the valuation of `s`. -/
lemma valuation_of_mk' {r : R} {s : non_zero_divisors R} :
  v.valuation (is_localization.mk' K r s) = v.int_valuation r / v.int_valuation s :=
begin
  erw [valuation_def, (is_localization.to_localization_map (non_zero_divisors R) K).lift_mk',
    div_eq_mul_inv, mul_eq_mul_left_iff],
  left,
  rw [units.coe_inv, inv_inj],
  refl,
end

/-- The `v`-adic valuation on `K` extends the `v`-adic valuation on `R`. -/
lemma valuation_of_algebra_map (r : R) :
  v.valuation (algebra_map R K r) = v.int_valuation r :=
by rw [valuation_def, valuation.extend_to_localization_apply_map_apply]

/-- The `v`-adic valuation on `R` is bounded above by 1. -/
lemma valuation_le_one (r : R) : v.valuation (algebra_map R K r) ≤ 1 :=
by { rw valuation_of_algebra_map, exact v.int_valuation_le_one r }

/-- The `v`-adic valuation of `r ∈ R` is less than 1 if and only if `v` divides the ideal `(r)`. -/
lemma valuation_lt_one_iff_dvd (r : R) :
  v.valuation (algebra_map R K r) < 1 ↔ v.as_ideal ∣ ideal.span {r} :=
by { rw valuation_of_algebra_map, exact v.int_valuation_lt_one_iff_dvd r }

variable (K)
/-- There exists `π ∈ K` with `v`-adic valuation `multiplicative.of_add (-1)`. -/
lemma valuation_exists_uniformizer :
  ∃ (π : K), v.valuation π = multiplicative.of_add (-1 : ℤ) :=
begin
  obtain ⟨r, hr⟩ := v.int_valuation_exists_uniformizer,
  use algebra_map R K r,
  rw [valuation_def, valuation.extend_to_localization_apply_map_apply],
  exact hr,
end

/-- Uniformizers are nonzero. -/
lemma valuation_uniformizer_ne_zero :
  (classical.some (v.valuation_exists_uniformizer K)) ≠ 0 :=
begin
  have hu := classical.some_spec (v.valuation_exists_uniformizer K),
  exact (valuation.ne_zero_iff _).mp (ne_of_eq_of_ne hu with_zero.coe_ne_zero),
end

/-! ### Completions with respect to adic valuations

Given a Dedekind domain `R` with field of fractions `K` and a maximal ideal `v` of `R`, we define
the completion of `K` with respect to its `v`-adic valuation, denoted `v.adic_completion`, and its
ring of integers, denoted `v.adic_completion_integers`. -/

variable {K}

/-- `K` as a valued field with the `v`-adic valuation. -/
def adic_valued : valued K ℤₘ₀ := valued.mk' v.valuation

lemma adic_valued_apply {x : K} : (v.adic_valued.v : _) x = v.valuation x := rfl

variables (K)

/-- The completion of `K` with respect to its `v`-adic valuation. -/
def adic_completion := @uniform_space.completion K v.adic_valued.to_uniform_space

instance : field (v.adic_completion K) :=
@uniform_space.completion.field K _ v.adic_valued.to_uniform_space _ _
  v.adic_valued.to_uniform_add_group

instance : inhabited (v.adic_completion K) := ⟨0⟩

instance valued_adic_completion : valued (v.adic_completion K) ℤₘ₀ :=
@valued.valued_completion _ _ _ _ v.adic_valued

lemma valued_adic_completion_def {x : v.adic_completion K} :
  valued.v x = @valued.extension K _ _ _ (adic_valued v) x := rfl

instance adic_completion_complete_space : complete_space (v.adic_completion K) :=
@uniform_space.completion.complete_space K v.adic_valued.to_uniform_space

instance adic_completion.has_lift_t : has_lift_t K (v.adic_completion K) :=
(infer_instance : has_lift_t K (@uniform_space.completion K v.adic_valued.to_uniform_space))

/-- The ring of integers of `adic_completion`. -/
def adic_completion_integers : valuation_subring (v.adic_completion K) := valued.v.valuation_subring

end is_dedekind_domain.height_one_spectrum


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import topology.sheaves.sheaf_condition.equalizer_products
import category_theory.full_subcategory
import category_theory.limits.punit

/-!
# Sheaves

We define sheaves on a topological space, with values in an arbitrary category with products.

The sheaf condition for a `F : presheaf C X` requires that the morphism
`F.obj U ⟶ ∏ F.obj (U i)` (where `U` is some open set which is the union of the `U i`)
is the equalizer of the two morphisms
`∏ F.obj (U i) ⟶ ∏ F.obj (U i ⊓ U j)`.

We provide the instance `category (sheaf C X)` as the full subcategory of presheaves,
and the fully faithful functor `sheaf.forget : sheaf C X ⥤ presheaf C X`.

## Equivalent conditions

While the "official" definition is in terms of an equalizer diagram,
in `src/topology/sheaves/sheaf_condition/pairwise_intersections.lean`
and in `src/topology/sheaves/sheaf_condition/open_le_cover.lean`
we provide two equivalent conditions (and prove they are equivalent).

The first is that `F.obj U` is the limit point of the diagram consisting of all the `F.obj (U i)`
and `F.obj (U i ⊓ U j)`.
(That is, we explode the equalizer of two products out into its component pieces.)

The second is that `F.obj U` is the limit point of the diagram constisting of all the `F.obj V`,
for those `V : opens X` such that `V ≤ U i` for some `i`.
(This condition is particularly easy to state, and perhaps should become the "official" definition.)

-/

universes v u

noncomputable theory

open category_theory
open category_theory.limits
open topological_space
open opposite
open topological_space.opens

namespace Top

variables {C : Type u} [category.{v} C] [has_products C]
variables {X : Top.{v}} (F : presheaf C X) {ι : Type v} (U : ι → opens X)

namespace presheaf

open sheaf_condition_equalizer_products

/--
The sheaf condition for a `F : presheaf C X` requires that the morphism
`F.obj U ⟶ ∏ F.obj (U i)` (where `U` is some open set which is the union of the `U i`)
is the equalizer of the two morphisms
`∏ F.obj (U i) ⟶ ∏ F.obj (U i) ⊓ (U j)`.
-/
def is_sheaf (F : presheaf C X) : Prop :=
∀ ⦃ι : Type v⦄ (U : ι → opens X), nonempty (is_limit (sheaf_condition_equalizer_products.fork F U))

/--
The presheaf valued in `punit` over any topological space is a sheaf.
-/
lemma is_sheaf_punit (F : presheaf (category_theory.discrete punit) X) : F.is_sheaf :=
λ ι U, ⟨punit_cone_is_limit⟩

/--
Transfer the sheaf condition across an isomorphism of presheaves.
-/
lemma is_sheaf_of_iso {F G : presheaf C X} (α : F ≅ G) (h : F.is_sheaf) : G.is_sheaf :=
λ ι U, ⟨is_limit.of_iso_limit
  ((is_limit.postcompose_inv_equiv _ _).symm (h U).some)
  (sheaf_condition_equalizer_products.fork.iso_of_iso U α.symm).symm⟩

lemma is_sheaf_iso_iff {F G : presheaf C X} (α : F ≅ G) : F.is_sheaf ↔ G.is_sheaf :=
⟨(λ h, is_sheaf_of_iso α h), (λ h, is_sheaf_of_iso α.symm h)⟩

end presheaf

variables (C X)

/--
A `sheaf C X` is a presheaf of objects from `C` over a (bundled) topological space `X`,
satisfying the sheaf condition.
-/
@[derive category]
def sheaf : Type (max u v) := { F : presheaf C X // F.is_sheaf }

-- Let's construct a trivial example, to keep the inhabited linter happy.
instance sheaf_inhabited : inhabited (sheaf (category_theory.discrete punit) X) :=
⟨⟨functor.star _, presheaf.is_sheaf_punit _⟩⟩

namespace sheaf

/--
The forgetful functor from sheaves to presheaves.
-/
@[derive [full, faithful]]
def forget : Top.sheaf C X ⥤ Top.presheaf C X :=
full_subcategory_inclusion presheaf.is_sheaf

@[simp]

end sheaf

end Top


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

! This file was ported from Lean 3 source module group_theory.subgroup.mul_opposite
! leanprover-community/mathlib commit a11f9106a169dd302a285019e5165f8ab32ff433
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.GroupTheory.Subgroup.Actions

/-!
# Mul-opposite subgroups

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

## Tags
subgroup, subgroups

-/

variable {G : Type _} [Group G]

namespace Subgroup

#print Subgroup.opposite /-
/-- A subgroup `H` of `G` determines a subgroup `H.opposite` of the opposite group `Gᵐᵒᵖ`. -/
@[to_additive
      "An additive subgroup `H` of `G` determines an additive subgroup `H.opposite` of the\n  opposite additive group `Gᵃᵒᵖ`."]
def opposite : Subgroup G ≃ Subgroup Gᵐᵒᵖ
    where
  toFun H :=
    { carrier := MulOpposite.unop ⁻¹' (H : Set G)
      one_mem' := H.one_mem
      mul_mem' := fun a b ha hb => H.mul_mem hb ha
      inv_mem' := fun a => H.inv_mem }
  invFun H :=
    { carrier := MulOpposite.op ⁻¹' (H : Set Gᵐᵒᵖ)
      one_mem' := H.one_mem
      mul_mem' := fun a b ha hb => H.mul_mem hb ha
      inv_mem' := fun a => H.inv_mem }
  left_inv H := SetLike.coe_injective rfl
  right_inv H := SetLike.coe_injective rfl
#align subgroup.opposite Subgroup.opposite
#align add_subgroup.opposite AddSubgroup.opposite
-/

/- warning: subgroup.opposite_equiv -> Subgroup.oppositeEquiv is a dubious translation:
lean 3 declaration is
  forall {G : Type.{u1}} [_inst_1 : Group.{u1} G] (H : Subgroup.{u1} G _inst_1), Equiv.{succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Subgroup.{u1} G _inst_1) Type.{u1} (SetLike.hasCoeToSort.{u1, u1} (Subgroup.{u1} G _inst_1) G (Subgroup.setLike.{u1} G _inst_1)) H) (coeSort.{succ u1, succ (succ u1)} (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1)) Type.{u1} (SetLike.hasCoeToSort.{u1, u1} (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1)) (MulOpposite.{u1} G) (Subgroup.setLike.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (coeFn.{succ u1, succ u1} (Equiv.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (fun (_x : Equiv.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) => (Subgroup.{u1} G _inst_1) -> (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (Equiv.hasCoeToFun.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (Subgroup.opposite.{u1} G _inst_1) H))
but is expected to have type
  forall {G : Type.{u1}} [_inst_1 : Group.{u1} G] (H : Subgroup.{u1} G _inst_1), Equiv.{succ u1, succ u1} (Subtype.{succ u1} G (fun (x : G) => Membership.mem.{u1, u1} G (Subgroup.{u1} G _inst_1) (SetLike.instMembership.{u1, u1} (Subgroup.{u1} G _inst_1) G (Subgroup.instSetLikeSubgroup.{u1} G _inst_1)) x H)) (Subtype.{succ u1} (MulOpposite.{u1} G) (fun (x : MulOpposite.{u1} G) => Membership.mem.{u1, u1} (MulOpposite.{u1} G) ((fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : Subgroup.{u1} G _inst_1) => Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1)) H) (SetLike.instMembership.{u1, u1} ((fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : Subgroup.{u1} G _inst_1) => Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1)) H) (MulOpposite.{u1} G) (Subgroup.instSetLikeSubgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) x (FunLike.coe.{succ u1, succ u1, succ u1} (Equiv.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (Subgroup.{u1} G _inst_1) (fun (a : Subgroup.{u1} G _inst_1) => (fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : Subgroup.{u1} G _inst_1) => Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1)) a) (Equiv.instFunLikeEquiv.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (Subgroup.opposite.{u1} G _inst_1) H)))
Case conversion may be inaccurate. Consider using '#align subgroup.opposite_equiv Subgroup.oppositeEquivₓ'. -/
/-- Bijection between a subgroup `H` and its opposite. -/
@[to_additive "Bijection between an additive subgroup `H` and its opposite.", simps]
def oppositeEquiv (H : Subgroup G) : H ≃ H.opposite :=
  MulOpposite.opEquiv.subtypeEquiv fun _ => Iff.rfl
#align subgroup.opposite_equiv Subgroup.oppositeEquiv
#align add_subgroup.opposite_equiv AddSubgroup.oppositeEquiv

@[to_additive]
instance (H : Subgroup G) [Encodable H] : Encodable H.opposite :=
  Encodable.ofEquiv H H.oppositeEquiv.symm

@[to_additive]
instance (H : Subgroup G) [Countable H] : Countable H.opposite :=
  Countable.of_equiv H H.oppositeEquiv

/- warning: subgroup.smul_opposite_mul -> Subgroup.smul_opposite_mul is a dubious translation:
lean 3 declaration is
  forall {G : Type.{u1}} [_inst_1 : Group.{u1} G] {H : Subgroup.{u1} G _inst_1} (x : G) (g : G) (h : coeSort.{succ u1, succ (succ u1)} (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1)) Type.{u1} (SetLike.hasCoeToSort.{u1, u1} (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1)) (MulOpposite.{u1} G) (Subgroup.setLike.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (coeFn.{succ u1, succ u1} (Equiv.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (fun (_x : Equiv.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) => (Subgroup.{u1} G _inst_1) -> (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (Equiv.hasCoeToFun.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (Subgroup.opposite.{u1} G _inst_1) H)), Eq.{succ u1} G (SMul.smul.{u1, u1} (coeSort.{succ u1, succ (succ u1)} (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1)) Type.{u1} (SetLike.hasCoeToSort.{u1, u1} (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1)) (MulOpposite.{u1} G) (Subgroup.setLike.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (coeFn.{succ u1, succ u1} (Equiv.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (fun (_x : Equiv.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) => (Subgroup.{u1} G _inst_1) -> (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (Equiv.hasCoeToFun.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (Subgroup.opposite.{u1} G _inst_1) H)) G (MulAction.toHasSmul.{u1, u1} (coeSort.{succ u1, succ (succ u1)} (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1)) Type.{u1} (SetLike.hasCoeToSort.{u1, u1} (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1)) (MulOpposite.{u1} G) (Subgroup.setLike.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (coeFn.{succ u1, succ u1} (Equiv.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (fun (_x : Equiv.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) => (Subgroup.{u1} G _inst_1) -> (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (Equiv.hasCoeToFun.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (Subgroup.opposite.{u1} G _inst_1) H)) G (DivInvMonoid.toMonoid.{u1} (coeSort.{succ u1, succ (succ u1)} (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1)) Type.{u1} (SetLike.hasCoeToSort.{u1, u1} (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1)) (MulOpposite.{u1} G) (Subgroup.setLike.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (coeFn.{succ u1, succ u1} (Equiv.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (fun (_x : Equiv.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) => (Subgroup.{u1} G _inst_1) -> (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (Equiv.hasCoeToFun.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (Subgroup.opposite.{u1} G _inst_1) H)) (Group.toDivInvMonoid.{u1} (coeSort.{succ u1, succ (succ u1)} (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1)) Type.{u1} (SetLike.hasCoeToSort.{u1, u1} (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1)) (MulOpposite.{u1} G) (Subgroup.setLike.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (coeFn.{succ u1, succ u1} (Equiv.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (fun (_x : Equiv.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) => (Subgroup.{u1} G _inst_1) -> (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (Equiv.hasCoeToFun.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (Subgroup.opposite.{u1} G _inst_1) H)) (Subgroup.toGroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1) (coeFn.{succ u1, succ u1} (Equiv.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (fun (_x : Equiv.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) => (Subgroup.{u1} G _inst_1) -> (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (Equiv.hasCoeToFun.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (Subgroup.opposite.{u1} G _inst_1) H)))) (Subgroup.mulAction.{u1, u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1) G (Monoid.toOppositeMulAction.{u1} G (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G _inst_1))) (coeFn.{succ u1, succ u1} (Equiv.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (fun (_x : Equiv.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) => (Subgroup.{u1} G _inst_1) -> (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (Equiv.hasCoeToFun.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (Subgroup.opposite.{u1} G _inst_1) H))) h (HMul.hMul.{u1, u1, u1} G G G (instHMul.{u1} G (MulOneClass.toHasMul.{u1} G (Monoid.toMulOneClass.{u1} G (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G _inst_1))))) g x)) (HMul.hMul.{u1, u1, u1} G G G (instHMul.{u1} G (MulOneClass.toHasMul.{u1} G (Monoid.toMulOneClass.{u1} G (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G _inst_1))))) g (SMul.smul.{u1, u1} (coeSort.{succ u1, succ (succ u1)} (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1)) Type.{u1} (SetLike.hasCoeToSort.{u1, u1} (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1)) (MulOpposite.{u1} G) (Subgroup.setLike.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (coeFn.{succ u1, succ u1} (Equiv.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (fun (_x : Equiv.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) => (Subgroup.{u1} G _inst_1) -> (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (Equiv.hasCoeToFun.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (Subgroup.opposite.{u1} G _inst_1) H)) G (MulAction.toHasSmul.{u1, u1} (coeSort.{succ u1, succ (succ u1)} (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1)) Type.{u1} (SetLike.hasCoeToSort.{u1, u1} (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1)) (MulOpposite.{u1} G) (Subgroup.setLike.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (coeFn.{succ u1, succ u1} (Equiv.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (fun (_x : Equiv.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) => (Subgroup.{u1} G _inst_1) -> (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (Equiv.hasCoeToFun.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (Subgroup.opposite.{u1} G _inst_1) H)) G (DivInvMonoid.toMonoid.{u1} (coeSort.{succ u1, succ (succ u1)} (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1)) Type.{u1} (SetLike.hasCoeToSort.{u1, u1} (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1)) (MulOpposite.{u1} G) (Subgroup.setLike.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (coeFn.{succ u1, succ u1} (Equiv.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (fun (_x : Equiv.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) => (Subgroup.{u1} G _inst_1) -> (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (Equiv.hasCoeToFun.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (Subgroup.opposite.{u1} G _inst_1) H)) (Group.toDivInvMonoid.{u1} (coeSort.{succ u1, succ (succ u1)} (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1)) Type.{u1} (SetLike.hasCoeToSort.{u1, u1} (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1)) (MulOpposite.{u1} G) (Subgroup.setLike.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (coeFn.{succ u1, succ u1} (Equiv.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (fun (_x : Equiv.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) => (Subgroup.{u1} G _inst_1) -> (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (Equiv.hasCoeToFun.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (Subgroup.opposite.{u1} G _inst_1) H)) (Subgroup.toGroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1) (coeFn.{succ u1, succ u1} (Equiv.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (fun (_x : Equiv.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) => (Subgroup.{u1} G _inst_1) -> (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (Equiv.hasCoeToFun.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (Subgroup.opposite.{u1} G _inst_1) H)))) (Subgroup.mulAction.{u1, u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1) G (Monoid.toOppositeMulAction.{u1} G (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G _inst_1))) (coeFn.{succ u1, succ u1} (Equiv.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (fun (_x : Equiv.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) => (Subgroup.{u1} G _inst_1) -> (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (Equiv.hasCoeToFun.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (Subgroup.opposite.{u1} G _inst_1) H))) h x))
but is expected to have type
  forall {G : Type.{u1}} [_inst_1 : Group.{u1} G] {H : Subgroup.{u1} G _inst_1} (x : G) (g : G) (h : Subtype.{succ u1} (MulOpposite.{u1} G) (fun (x : MulOpposite.{u1} G) => Membership.mem.{u1, u1} (MulOpposite.{u1} G) ((fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : Subgroup.{u1} G _inst_1) => Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1)) H) (SetLike.instMembership.{u1, u1} ((fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : Subgroup.{u1} G _inst_1) => Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1)) H) (MulOpposite.{u1} G) (Subgroup.instSetLikeSubgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) x (FunLike.coe.{succ u1, succ u1, succ u1} (Equiv.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (Subgroup.{u1} G _inst_1) (fun (a : Subgroup.{u1} G _inst_1) => (fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : Subgroup.{u1} G _inst_1) => Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1)) a) (Equiv.instFunLikeEquiv.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (Subgroup.opposite.{u1} G _inst_1) H))), Eq.{succ u1} G (HSMul.hSMul.{u1, u1, u1} (Subtype.{succ u1} (MulOpposite.{u1} G) (fun (x : MulOpposite.{u1} G) => Membership.mem.{u1, u1} (MulOpposite.{u1} G) ((fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : Subgroup.{u1} G _inst_1) => Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1)) H) (SetLike.instMembership.{u1, u1} ((fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : Subgroup.{u1} G _inst_1) => Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1)) H) (MulOpposite.{u1} G) (Subgroup.instSetLikeSubgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) x (FunLike.coe.{succ u1, succ u1, succ u1} (Equiv.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (Subgroup.{u1} G _inst_1) (fun (a : Subgroup.{u1} G _inst_1) => (fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : Subgroup.{u1} G _inst_1) => Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1)) a) (Equiv.instFunLikeEquiv.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (Subgroup.opposite.{u1} G _inst_1) H))) G G (instHSMul.{u1, u1} (Subtype.{succ u1} (MulOpposite.{u1} G) (fun (x : MulOpposite.{u1} G) => Membership.mem.{u1, u1} (MulOpposite.{u1} G) ((fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : Subgroup.{u1} G _inst_1) => Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1)) H) (SetLike.instMembership.{u1, u1} ((fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : Subgroup.{u1} G _inst_1) => Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1)) H) (MulOpposite.{u1} G) (Subgroup.instSetLikeSubgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) x (FunLike.coe.{succ u1, succ u1, succ u1} (Equiv.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (Subgroup.{u1} G _inst_1) (fun (a : Subgroup.{u1} G _inst_1) => (fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : Subgroup.{u1} G _inst_1) => Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1)) a) (Equiv.instFunLikeEquiv.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (Subgroup.opposite.{u1} G _inst_1) H))) G (Submonoid.smul.{u1, u1} (MulOpposite.{u1} G) G (Monoid.toMulOneClass.{u1} (MulOpposite.{u1} G) (DivInvMonoid.toMonoid.{u1} (MulOpposite.{u1} G) (Group.toDivInvMonoid.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1)))) (Mul.toHasOppositeSMul.{u1} G (MulOneClass.toMul.{u1} G (Monoid.toMulOneClass.{u1} G (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G _inst_1))))) (Subgroup.toSubmonoid.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1) (FunLike.coe.{succ u1, succ u1, succ u1} (Equiv.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (Subgroup.{u1} G _inst_1) (fun (a : Subgroup.{u1} G _inst_1) => (fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : Subgroup.{u1} G _inst_1) => Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1)) a) (Equiv.instFunLikeEquiv.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (Subgroup.opposite.{u1} G _inst_1) H)))) h (HMul.hMul.{u1, u1, u1} G G G (instHMul.{u1} G (MulOneClass.toMul.{u1} G (Monoid.toMulOneClass.{u1} G (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G _inst_1))))) g x)) (HMul.hMul.{u1, u1, u1} G G G (instHMul.{u1} G (MulOneClass.toMul.{u1} G (Monoid.toMulOneClass.{u1} G (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G _inst_1))))) g (HSMul.hSMul.{u1, u1, u1} (Subtype.{succ u1} (MulOpposite.{u1} G) (fun (x : MulOpposite.{u1} G) => Membership.mem.{u1, u1} (MulOpposite.{u1} G) ((fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : Subgroup.{u1} G _inst_1) => Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1)) H) (SetLike.instMembership.{u1, u1} ((fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : Subgroup.{u1} G _inst_1) => Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1)) H) (MulOpposite.{u1} G) (Subgroup.instSetLikeSubgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) x (FunLike.coe.{succ u1, succ u1, succ u1} (Equiv.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (Subgroup.{u1} G _inst_1) (fun (a : Subgroup.{u1} G _inst_1) => (fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : Subgroup.{u1} G _inst_1) => Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1)) a) (Equiv.instFunLikeEquiv.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (Subgroup.opposite.{u1} G _inst_1) H))) G G (instHSMul.{u1, u1} (Subtype.{succ u1} (MulOpposite.{u1} G) (fun (x : MulOpposite.{u1} G) => Membership.mem.{u1, u1} (MulOpposite.{u1} G) ((fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : Subgroup.{u1} G _inst_1) => Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1)) H) (SetLike.instMembership.{u1, u1} ((fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : Subgroup.{u1} G _inst_1) => Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1)) H) (MulOpposite.{u1} G) (Subgroup.instSetLikeSubgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) x (FunLike.coe.{succ u1, succ u1, succ u1} (Equiv.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (Subgroup.{u1} G _inst_1) (fun (a : Subgroup.{u1} G _inst_1) => (fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : Subgroup.{u1} G _inst_1) => Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1)) a) (Equiv.instFunLikeEquiv.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (Subgroup.opposite.{u1} G _inst_1) H))) G (Submonoid.smul.{u1, u1} (MulOpposite.{u1} G) G (Monoid.toMulOneClass.{u1} (MulOpposite.{u1} G) (DivInvMonoid.toMonoid.{u1} (MulOpposite.{u1} G) (Group.toDivInvMonoid.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1)))) (Mul.toHasOppositeSMul.{u1} G (MulOneClass.toMul.{u1} G (Monoid.toMulOneClass.{u1} G (DivInvMonoid.toMonoid.{u1} G (Group.toDivInvMonoid.{u1} G _inst_1))))) (Subgroup.toSubmonoid.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1) (FunLike.coe.{succ u1, succ u1, succ u1} (Equiv.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (Subgroup.{u1} G _inst_1) (fun (a : Subgroup.{u1} G _inst_1) => (fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : Subgroup.{u1} G _inst_1) => Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1)) a) (Equiv.instFunLikeEquiv.{succ u1, succ u1} (Subgroup.{u1} G _inst_1) (Subgroup.{u1} (MulOpposite.{u1} G) (MulOpposite.group.{u1} G _inst_1))) (Subgroup.opposite.{u1} G _inst_1) H)))) h x))
Case conversion may be inaccurate. Consider using '#align subgroup.smul_opposite_mul Subgroup.smul_opposite_mulₓ'. -/
@[to_additive]
theorem smul_opposite_mul {H : Subgroup G} (x g : G) (h : H.opposite) : h • (g * x) = g * h • x :=
  by
  cases h
  simp [(· • ·), mul_assoc]
#align subgroup.smul_opposite_mul Subgroup.smul_opposite_mul
#align add_subgroup.vadd_opposite_add AddSubgroup.vadd_opposite_add

end Subgroup


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Johannes Hölzl, Scott Morrison, Jens Wagemaker
-/
import data.polynomial.eval
import tactic.interval_cases

/-!
# Theory of degrees of polynomials

Some of the main results include
- `nat_degree_comp_le` : The degree of the composition is at most the product of degrees

-/

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

open finsupp finset

namespace polynomial
universes u v w
variables {R : Type u} {S : Type v} { ι : Type w} {a b : R} {m n : ℕ}

section semiring
variables [semiring R] {p q r : polynomial R}

section degree

lemma nat_degree_comp_le : nat_degree (p.comp q) ≤ nat_degree p * nat_degree q :=
if h0 : p.comp q = 0 then by rw [h0, nat_degree_zero]; exact nat.zero_le _
else with_bot.coe_le_coe.1 $
  calc ↑(nat_degree (p.comp q)) = degree (p.comp q) : (degree_eq_nat_degree h0).symm
  ... = _ : congr_arg degree comp_eq_sum_left
  ... ≤ _ : degree_sum_le _ _
  ... ≤ _ : sup_le (λ n hn,
    calc degree (C (coeff p n) * q ^ n)
        ≤ degree (C (coeff p n)) + degree (q ^ n) : degree_mul_le _ _
    ... ≤ nat_degree (C (coeff p n)) + n • (degree q) :
      add_le_add degree_le_nat_degree (degree_pow_le _ _)
    ... ≤ nat_degree (C (coeff p n)) + n • (nat_degree q) :
      add_le_add_left (nsmul_le_nsmul_of_le_right (@degree_le_nat_degree _ _ q) n) _
    ... = (n * nat_degree q : ℕ) :
     by rw [nat_degree_C, with_bot.coe_zero, zero_add, ← with_bot.coe_nsmul,
       nsmul_eq_mul]; simp
    ... ≤ (nat_degree p * nat_degree q : ℕ) : with_bot.coe_le_coe.2 $
      mul_le_mul_of_nonneg_right
        (le_nat_degree_of_ne_zero (finsupp.mem_support_iff.1 hn))
        (nat.zero_le _))

lemma degree_map_le [semiring S] (f : R →+* S) :
  degree (map f p) ≤ degree p :=
if h : map f p = 0 then by simp [h]
else begin
  rw [degree_eq_nat_degree h],
  refine le_degree_of_ne_zero (mt (congr_arg f) _),
  rw [← coeff_map f, is_semiring_hom.map_zero f],
  exact mt leading_coeff_eq_zero.1 h
end

lemma nat_degree_map_le [semiring S] (f : R →+* S) :
  (map f p).nat_degree ≤ p.nat_degree :=
begin
  by_cases hp : p = 0,
  { simp [hp] },
  { rw [← with_bot.coe_le_coe, ← degree_eq_nat_degree hp],
    by_cases hfp : map f p = 0,
    { simp [hfp, zero_le_degree_iff.mpr hp] },
    { simp [← degree_eq_nat_degree hfp, degree_map_le] } }
end

lemma degree_map_eq_of_leading_coeff_ne_zero [semiring S] (f : R →+* S)
  (hf : f (leading_coeff p) ≠ 0) : degree (p.map f) = degree p :=
le_antisymm (degree_map_le f) $
  have hp0 : p ≠ 0, from λ hp0, by simpa [hp0, is_semiring_hom.map_zero f] using hf,
  begin
    rw [degree_eq_nat_degree hp0],
    refine le_degree_of_ne_zero _,
    rw [coeff_map], exact hf
  end

lemma nat_degree_map_of_leading_coeff_ne_zero [semiring S] (f : R →+* S)
  (hf : f (leading_coeff p) ≠ 0) : nat_degree (p.map f) = nat_degree p :=
nat_degree_eq_of_degree_eq (degree_map_eq_of_leading_coeff_ne_zero f hf)

lemma leading_coeff_map_of_leading_coeff_ne_zero [semiring S] (f : R →+* S)
  (hf : f (leading_coeff p) ≠ 0) : leading_coeff (p.map f) = f (leading_coeff p) :=
begin
  unfold leading_coeff,
  rw [coeff_map, nat_degree_map_of_leading_coeff_ne_zero f hf],
end

lemma degree_pos_of_root {p : polynomial R} (hp : p ≠ 0) (h : is_root p a) : 0 < degree p :=
lt_of_not_ge $ λ hlt, begin
  have := eq_C_of_degree_le_zero hlt,
  rw [is_root, this, eval_C] at h,
  exact hp (finsupp.ext (λ n, show coeff p n = 0, from
    nat.cases_on n h (λ _, coeff_eq_zero_of_degree_lt (lt_of_le_of_lt hlt
      (with_bot.coe_lt_coe.2 (nat.succ_pos _)))))),
end

lemma nat_degree_le_iff_coeff_eq_zero :
  p.nat_degree ≤ n ↔ ∀ N : ℕ, n < N → p.coeff N = 0 :=
by simp_rw [nat_degree_le_iff_degree_le, degree_le_iff_coeff_zero, with_bot.coe_lt_coe]

lemma nat_degree_C_mul_le (a : R) (f : polynomial R) :
  (C a * f).nat_degree ≤ f.nat_degree :=
calc
  (C a * f).nat_degree ≤ (C a).nat_degree + f.nat_degree : nat_degree_mul_le
  ... = 0 + f.nat_degree : by rw nat_degree_C a
  ... = f.nat_degree : zero_add _

lemma nat_degree_mul_C_le (f : polynomial R) (a : R) :
  (f * C a).nat_degree ≤ f.nat_degree :=
calc
  (f * C a).nat_degree ≤ f.nat_degree + (C a).nat_degree : nat_degree_mul_le
  ... = f.nat_degree + 0 : by rw nat_degree_C a
  ... = f.nat_degree : add_zero _

lemma eq_nat_degree_of_le_mem_support (pn : p.nat_degree ≤ n) (ns : n ∈ p.support) :
  p.nat_degree = n :=
le_antisymm pn (le_nat_degree_of_mem_supp _ ns)

lemma nat_degree_C_mul_eq_of_mul_eq_one {ai : R} (au : ai * a = 1) :
  (C a * p).nat_degree = p.nat_degree :=
le_antisymm (nat_degree_C_mul_le a p) (calc
  p.nat_degree = (1 * p).nat_degree : by nth_rewrite 0 [← one_mul p]
  ... = (C ai * (C a * p)).nat_degree : by rw [← C_1, ← au, ring_hom.map_mul, ← mul_assoc]
  ... ≤ (C a * p).nat_degree : nat_degree_C_mul_le ai (C a * p))

lemma nat_degree_mul_C_eq_of_mul_eq_one {ai : R} (au : a * ai = 1) :
  (p * C a).nat_degree = p.nat_degree :=
le_antisymm (nat_degree_mul_C_le p a) (calc
  p.nat_degree = (p * 1).nat_degree : by nth_rewrite 0 [← mul_one p]
  ... = ((p * C a) * C ai).nat_degree : by rw [← C_1, ← au, ring_hom.map_mul, ← mul_assoc]
  ... ≤ (p * C a).nat_degree : nat_degree_mul_C_le (p * C a) ai)

/-- Although not explicitly stated, the assumptions of lemma `nat_degree_mul_C_eq_of_mul_ne_zero`
force the polynomial `p` to be non-zero, via `p.leading_coeff ≠ 0`.
Lemma `nat_degree_mul_C_eq_of_no_zero_divisors` below separates cases, in order to overcome this
hurdle.
-/
lemma nat_degree_mul_C_eq_of_mul_ne_zero (h : p.leading_coeff * a ≠ 0) :
  (p * C a).nat_degree = p.nat_degree :=
begin
  refine eq_nat_degree_of_le_mem_support (nat_degree_mul_C_le p a) _,
  refine mem_support_iff.mpr _,
  rwa coeff_mul_C,
end

/-- Although not explicitly stated, the assumptions of lemma `nat_degree_C_mul_eq_of_mul_ne_zero`
force the polynomial `p` to be non-zero, via `p.leading_coeff ≠ 0`.
Lemma `nat_degree_C_mul_eq_of_no_zero_divisors` below separates cases, in order to overcome this
hurdle.
-/
lemma nat_degree_C_mul_eq_of_mul_ne_zero (h : a * p.leading_coeff ≠ 0) :
  (C a * p).nat_degree = p.nat_degree :=
begin
  refine eq_nat_degree_of_le_mem_support (nat_degree_C_mul_le a p) _,
  refine mem_support_iff.mpr _,
  rwa coeff_C_mul,
end

lemma nat_degree_add_coeff_mul (f g : polynomial R) :
  (f * g).coeff (f.nat_degree + g.nat_degree) = f.coeff f.nat_degree * g.coeff g.nat_degree :=
by simp only [coeff_nat_degree, coeff_mul_degree_add_degree]

lemma nat_degree_lt_coeff_mul (h : p.nat_degree + q.nat_degree < m + n) :
  (p * q).coeff (m + n) = 0 :=
coeff_eq_zero_of_nat_degree_lt (nat_degree_mul_le.trans_lt h)

variables [semiring S]

lemma nat_degree_pos_of_eval₂_root {p : polynomial R} (hp : p ≠ 0) (f : R →+* S)
  {z : S} (hz : eval₂ f z p = 0) (inj : ∀ (x : R), f x = 0 → x = 0) :
  0 < nat_degree p :=
lt_of_not_ge $ λ hlt, begin
  rw [eq_C_of_nat_degree_le_zero hlt, eval₂_C] at hz,
  refine hp (finsupp.ext (λ n, _)),
  cases n,
  { exact inj _ hz },
  { exact coeff_eq_zero_of_nat_degree_lt (lt_of_le_of_lt hlt (nat.succ_pos _)) }
end

lemma degree_pos_of_eval₂_root {p : polynomial R} (hp : p ≠ 0) (f : R →+* S)
  {z : S} (hz : eval₂ f z p = 0) (inj : ∀ (x : R), f x = 0 → x = 0) :
  0 < degree p :=
nat_degree_pos_iff_degree_pos.mp (nat_degree_pos_of_eval₂_root hp f hz inj)

section injective
open function
variables {f : R →+* S} (hf : injective f)
include hf

lemma degree_map_eq_of_injective (p : polynomial R) : degree (p.map f) = degree p :=
if h : p = 0 then by simp [h]
else degree_map_eq_of_leading_coeff_ne_zero _
  (by rw [← is_semiring_hom.map_zero f]; exact mt hf.eq_iff.1
    (mt leading_coeff_eq_zero.1 h))

lemma degree_map' (p : polynomial R) :
  degree (p.map f) = degree p :=
p.degree_map_eq_of_injective hf

lemma nat_degree_map' (p : polynomial R) :
  nat_degree (p.map f) = nat_degree p :=
nat_degree_eq_of_degree_eq (degree_map' hf p)

lemma leading_coeff_map' (p : polynomial R) :
  leading_coeff (p.map f) = f (leading_coeff p) :=
begin
  unfold leading_coeff,
  rw [coeff_map, nat_degree_map' hf p],
end

end injective

section
variable {f : polynomial R}

lemma monomial_nat_degree_leading_coeff_eq_self (h : f.support.card ≤ 1) :
  monomial f.nat_degree f.leading_coeff = f :=
begin
  interval_cases f.support.card with H,
  { have : f = 0 := finsupp.card_support_eq_zero.1 H,
    simp [this] },
  { obtain ⟨n, x, hx, rfl : f = monomial n x⟩ := finsupp.card_support_eq_one'.1 H,
    simp [hx] }
end

lemma C_mul_X_pow_eq_self (h : f.support.card ≤ 1) :
  C f.leading_coeff * X^f.nat_degree = f :=
by rw [C_mul_X_pow_eq_monomial, monomial_nat_degree_leading_coeff_eq_self h]

end

end degree
end semiring

section no_zero_divisors
variables [semiring R] [no_zero_divisors R] {p q : polynomial R}

lemma nat_degree_mul_C_eq_of_no_zero_divisors (a0 : a ≠ 0) :
  (p * C a).nat_degree = p.nat_degree :=
begin
  by_cases p0 : p = 0,
  { rw [p0, zero_mul] },
  { exact nat_degree_mul_C_eq_of_mul_ne_zero (mul_ne_zero (leading_coeff_ne_zero.mpr p0) a0) }
end

lemma nat_degree_C_mul_eq_of_no_zero_divisors (a0 : a ≠ 0) :
  (C a * p).nat_degree = p.nat_degree :=
begin
  by_cases p0 : p = 0,
  { rw [p0, mul_zero] },
  { exact nat_degree_C_mul_eq_of_mul_ne_zero (mul_ne_zero a0 (leading_coeff_ne_zero.mpr p0)) }
end

end no_zero_divisors

end polynomial


-- ---------------------------------------------------------------------
-- Ejercicio. Sean a, b y c números reales. Demostrar que
--    min a b + c = min (a + c) (b + c)
-- ----------------------------------------------------------------------

import data.real.basic

variables a b c : ℝ

-- 1ª demostración
-- ===============

lemma aux1a :
  min a b + c ≤ min (a + c) (b + c) :=
begin
  have h1 : min a b  ≤ a :=
    min_le_left a b,
  have h2 : min a b + c ≤ a + c :=
    add_le_add_right h1 c,
  have h3 : min a b  ≤ b :=
    min_le_right a b,
  have h4 : min a b + c ≤ b + c :=
    add_le_add_right h3 c,
  show min a b + c ≤ min (a + c) (b + c),
    by exact le_min h2 h4,
end

lemma aux2a :
  min (a + c) (b + c) ≤ min a b + c :=
begin
  have h1 : min (a + c) (b + c) + -c ≤ min a b,
  { calc min (a + c) (b + c) + -c
         ≤ min (a + c + -c) (b + c + -c) : aux1a (a + c) (b + c) (-c)
     ... = min a b                       : by ring_nf },
  show min (a + c) (b + c) ≤ min a b + c,
    by exact add_neg_le_iff_le_add.mp h1,
end

example :
  min a b + c = min (a + c) (b + c) :=
begin
  apply le_antisymm,
  { exact aux1a a b c, },
  { exact aux2a a b c, },
end

-- 2ª demostración
-- ===============

lemma aux1b :
  min a b + c ≤ min (a + c) (b + c) :=
begin
  apply le_min,
  { apply add_le_add_right,
    exact min_le_left a b, },
  { apply add_le_add_right,
    exact min_le_right a b, },
end

lemma aux2b :
  min (a + c) (b + c) ≤ min a b + c :=
begin
  have h1 : min (a + c) (b + c) + -c ≤ min a b,
  { calc min (a + c) (b + c) + -c
         ≤ min (a + c + -c) (b + c + -c) : aux1b (a + c) (b + c) (-c)
     ... = min a b                       : by ring_nf },
  exact add_neg_le_iff_le_add.mp h1,
end

example :
  min a b + c = min (a + c) (b + c) :=
begin
  apply le_antisymm,
  { exact aux1b a b c, },
  { exact aux2b a b c, },
end

-- 3ª demostración
-- ===============

lemma aux1c :
  min a b + c ≤ min (a + c) (b + c) :=
le_min (add_le_add_right (min_le_left a b) c)
       (add_le_add_right (min_le_right a b) c)

lemma aux2c :
  min (a + c) (b + c) ≤ min a b + c :=
begin
  have h1 : min (a + c) (b + c) + -c ≤ min a b,
  { calc min (a + c) (b + c) + -c
         ≤ min (a + c + -c) (b + c + -c) : aux1c (a + c) (b + c) (-c)
     ... = min a b                       : by ring_nf },
  exact add_neg_le_iff_le_add.mp h1,
end

example :
  min a b + c = min (a + c) (b + c) :=
le_antisymm (aux1b a b c) (aux2b a b c)

-- 4ª demostración
-- ===============

example : min a b + c = min (a + c) (b + c) :=
begin
  by_cases (a ≤ b),
  { have h1 : a + c ≤ b + c,
      apply add_le_add_right h,
    calc min a b + c = a + c               : by simp [min_eq_left h]
                 ... = min (a + c) (b + c) : by simp [min_eq_left h1]},
  { have h2: b ≤ a,
      linarith,
    have h3 : b + c ≤ a + c,
      { exact add_le_add_right h2 c },
    calc min a b + c = b + c               : by simp [min_eq_right h2]
                 ... = min (a + c) (b + c) : by simp [min_eq_right h3]},
end

-- 5ª demostración
-- ===============

example : min a b + c = min (a + c) (b + c) :=
(min_add_add_right a b c).symm