/-
Copyright (c) 2021 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import logic.small.basic
import category_theory.category.ulift
import category_theory.skeletal

/-!
# Essentially small categories.

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

A category given by `(C : Type u) [category.{v} C]` is `w`-essentially small
if there exists a `small_model C : Type w` equipped with `[small_category (small_model C)]`.

A category is `w`-locally small if every hom type is `w`-small.

The main theorem here is that a category is `w`-essentially small iff
the type `skeleton C` is `w`-small, and `C` is `w`-locally small.
-/

universes w v v' u u'

open category_theory

variables (C : Type u) [category.{v} C]

namespace category_theory

/-- A category is `essentially_small.{w}` if there exists
an equivalence to some `S : Type w` with `[small_category S]`. -/
class essentially_small (C : Type u) [category.{v} C] : Prop :=
(equiv_small_category : ∃ (S : Type w) (_ : small_category S), by exactI nonempty (C ≌ S))

/-- Constructor for `essentially_small C` from an explicit small category witness. -/

/--
An arbitrarily chosen small model for an essentially small category.
-/
@[nolint has_nonempty_instance]
def small_model (C : Type u) [category.{v} C] [essentially_small.{w} C] : Type w :=
classical.some (@essentially_small.equiv_small_category C _ _)

noncomputable
instance small_category_small_model
  (C : Type u) [category.{v} C] [essentially_small.{w} C] : small_category (small_model C) :=
classical.some (classical.some_spec (@essentially_small.equiv_small_category C _ _))

/--
The (noncomputable) categorical equivalence between
an essentially small category and its small model.
-/
noncomputable
def equiv_small_model (C : Type u) [category.{v} C] [essentially_small.{w} C] : C ≌ small_model C :=
nonempty.some (classical.some_spec (classical.some_spec
  (@essentially_small.equiv_small_category C _ _)))

lemma essentially_small_congr {C : Type u} [category.{v} C] {D : Type u'} [category.{v'} D]
  (e : C ≌ D) : essentially_small.{w} C ↔ essentially_small.{w} D :=
begin
  fsplit,
  { rintro ⟨S, 𝒮, ⟨f⟩⟩,
    resetI,
    exact essentially_small.mk' (e.symm.trans f), },
  { rintro ⟨S, 𝒮, ⟨f⟩⟩,
    resetI,
    exact essentially_small.mk' (e.trans f), },
end

lemma discrete.essentially_small_of_small {α : Type u} [small.{w} α] :
  essentially_small.{w} (discrete α) :=
⟨⟨discrete (shrink α), ⟨infer_instance, ⟨discrete.equivalence (equiv_shrink _)⟩⟩⟩⟩

lemma essentially_small_self : essentially_small.{max w v u} C :=
essentially_small.mk' (as_small.equiv : C ≌ as_small.{w} C)

/--
A category is `w`-locally small if every hom set is `w`-small.

See `shrink_homs C` for a category instance where every hom set has been replaced by a small model.
-/
class locally_small (C : Type u) [category.{v} C] : Prop :=
(hom_small : ∀ X Y : C, small.{w} (X ⟶ Y) . tactic.apply_instance)

instance (C : Type u) [category.{v} C] [locally_small.{w} C] (X Y : C) :
  small (X ⟶ Y) :=
locally_small.hom_small X Y

lemma locally_small_congr {C : Type u} [category.{v} C] {D : Type u'} [category.{v'} D]
  (e : C ≌ D) : locally_small.{w} C ↔ locally_small.{w} D :=
begin
  fsplit,
  { rintro ⟨L⟩,
    fsplit,
    intros X Y,
    specialize L (e.inverse.obj X) (e.inverse.obj Y),
    refine (small_congr _).mpr L,
    exact equiv_of_fully_faithful e.inverse, },
  { rintro ⟨L⟩,
    fsplit,
    intros X Y,
    specialize L (e.functor.obj X) (e.functor.obj Y),
    refine (small_congr _).mpr L,
    exact equiv_of_fully_faithful e.functor, },
end

@[priority 100]
instance locally_small_self (C : Type u) [category.{v} C] : locally_small.{v} C := {}

@[priority 100]
instance locally_small_of_essentially_small
  (C : Type u) [category.{v} C] [essentially_small.{w} C] : locally_small.{w} C :=
(locally_small_congr (equiv_small_model C)).mpr (category_theory.locally_small_self _)

/--
We define a type alias `shrink_homs C` for `C`. When we have `locally_small.{w} C`,
we'll put a `category.{w}` instance on `shrink_homs C`.
-/
@[nolint has_nonempty_instance]
def shrink_homs (C : Type u) := C

namespace shrink_homs

section
variables {C' : Type*} -- a fresh variable with no category instance attached

/-- Help the typechecker by explicitly translating from `C` to `shrink_homs C`. -/
def to_shrink_homs {C' : Type*} (X : C') : shrink_homs C' := X
/-- Help the typechecker by explicitly translating from `shrink_homs C` to `C`. -/
def from_shrink_homs {C' : Type*} (X : shrink_homs C') : C' := X

@[simp] lemma to_from (X : C') : from_shrink_homs (to_shrink_homs X) = X := rfl
@[simp] lemma from_to (X : shrink_homs C') : to_shrink_homs (from_shrink_homs X) = X := rfl

end

variables (C) [locally_small.{w} C]

@[simps]
noncomputable
instance : category.{w} (shrink_homs C) :=
{ hom := λ X Y, shrink (from_shrink_homs X ⟶ from_shrink_homs Y),
  id := λ X, equiv_shrink _ (𝟙 (from_shrink_homs X)),
  comp := λ X Y Z f g,
    equiv_shrink _ (((equiv_shrink _).symm f) ≫ ((equiv_shrink _).symm g)), }.

/-- Implementation of `shrink_homs.equivalence`. -/
@[simps]
noncomputable
def functor : C ⥤ shrink_homs C :=
{ obj := λ X, to_shrink_homs X,
  map := λ X Y f, equiv_shrink (X ⟶ Y) f, }

/-- Implementation of `shrink_homs.equivalence`. -/
@[simps]
noncomputable
def inverse : shrink_homs C ⥤ C :=
{ obj := λ X, from_shrink_homs X,
  map := λ X Y f, (equiv_shrink (from_shrink_homs X ⟶ from_shrink_homs Y)).symm f, }

/--
The categorical equivalence between `C` and `shrink_homs C`, when `C` is locally small.
-/
@[simps]
noncomputable
def equivalence : C ≌ shrink_homs C :=
equivalence.mk (functor C) (inverse C)
  (nat_iso.of_components (λ X, iso.refl X) (by tidy))
  (nat_iso.of_components (λ X, iso.refl X) (by tidy))

end shrink_homs

/--
A category is essentially small if and only if
the underlying type of its skeleton (i.e. the "set" of isomorphism classes) is small,
and it is locally small.
-/
theorem essentially_small_iff (C : Type u) [category.{v} C] :
  essentially_small.{w} C ↔ small.{w} (skeleton C) ∧ locally_small.{w} C :=
begin
  -- This theorem is the only bit of real work in this file.
  fsplit,
  { intro h,
    fsplit,
    { rcases h with ⟨S, 𝒮, ⟨e⟩⟩,
      resetI,
      refine ⟨⟨skeleton S, ⟨_⟩⟩⟩,
      exact e.skeleton_equiv, },
    { resetI, apply_instance, }, },
  { rintro ⟨⟨S, ⟨e⟩⟩, L⟩,
    resetI,
    let e' := (shrink_homs.equivalence C).skeleton_equiv.symm,
    refine ⟨⟨S, _, ⟨_⟩⟩⟩,
    apply induced_category.category (e'.trans e).symm,
    refine (shrink_homs.equivalence C).trans
      ((skeleton_equivalence _).symm.trans
      ((induced_functor (e'.trans e).symm).as_equivalence.symm)), },
end

/--
Any thin category is locally small.
-/
@[priority 100]
instance locally_small_of_thin {C : Type u} [category.{v} C] [quiver.is_thin C] :
  locally_small.{w} C := {}

/--
A thin category is essentially small if and only if the underlying type of its skeleton is small.
-/
theorem essentially_small_iff_of_thin
  {C : Type u} [category.{v} C] [quiver.is_thin C] :
  essentially_small.{w} C ↔ small.{w} (skeleton C) :=
by simp [essentially_small_iff, category_theory.locally_small_of_thin]

end category_theory


import analysis.inner_product_space.pi_L2

variables {ι : Type*} [fintype ι]
variables {𝕜 : Type*} [is_R_or_C 𝕜] {E : Type*} [inner_product_space 𝕜 E]
variables {E' : Type*} [inner_product_space 𝕜 E']

variables {m n : ℕ}

local notation `⟪`x`, `y`⟫` := @inner 𝕜 (euclidean_space 𝕜 (fin m)) _ x y

open_locale matrix

lemma inner_matrix_row_row (A : matrix (fin n) (fin m) 𝕜) (i j : (fin n)) :
  ⟪A i, A j⟫ = (A ⬝ Aᴴ) j i := by {simp only [inner, matrix.mul_apply, star_ring_end_apply,
    matrix.conj_transpose_apply,mul_comm]}


/-
Copyright (c) 2018 Mario Carneiro, Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Kevin Buzzard

! This file was ported from Lean 3 source module ring_theory.ideal.idempotent_fg
! leanprover-community/mathlib commit 290a7ba01fbcab1b64757bdaa270d28f4dcede35
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Ring.Idempotents
import Mathbin.RingTheory.Finiteness

/-!
## Lemmas on idempotent finitely generated ideals

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

namespace Ideal

/- warning: ideal.is_idempotent_elem_iff_of_fg -> Ideal.isIdempotentElem_iff_of_fg is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : CommRing.{u1} R] (I : Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))), (Ideal.Fg.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) I) -> (Iff (IsIdempotentElem.{u1} (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Ideal.hasMul.{u1} R (CommRing.toCommSemiring.{u1} R _inst_1)) I) (Exists.{succ u1} R (fun (e : R) => And (IsIdempotentElem.{u1} R (Distrib.toHasMul.{u1} R (Ring.toDistrib.{u1} R (CommRing.toRing.{u1} R _inst_1))) e) (Eq.{succ u1} (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) I (Submodule.span.{u1, u1} R R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))))) (Semiring.toModule.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Singleton.singleton.{u1, u1} R (Set.{u1} R) (Set.hasSingleton.{u1} R) e))))))
but is expected to have type
  forall {R : Type.{u1}} [_inst_1 : CommRing.{u1} R] (I : Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))), (Ideal.Fg.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) I) -> (Iff (IsIdempotentElem.{u1} (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Ideal.instMulIdealToSemiring.{u1} R (CommRing.toCommSemiring.{u1} R _inst_1)) I) (Exists.{succ u1} R (fun (e : R) => And (IsIdempotentElem.{u1} R (NonUnitalNonAssocRing.toMul.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R _inst_1)))) e) (Eq.{succ u1} (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) I (Submodule.span.{u1, u1} R R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R _inst_1))))) (_private.Mathlib.RingTheory.Ideal.Operations.0.Ideal.instModuleToSemiringToAddCommMonoidToNonUnitalNonAssocSemiringToNonUnitalNonAssocRingToNonUnitalRingToNonUnitalCommRing.{u1, u1} R R (CommRing.toCommSemiring.{u1} R _inst_1) _inst_1 (Algebra.id.{u1} R (CommRing.toCommSemiring.{u1} R _inst_1))) (Singleton.singleton.{u1, u1} R (Set.{u1} R) (Set.instSingletonSet.{u1} R) e))))))
Case conversion may be inaccurate. Consider using '#align ideal.is_idempotent_elem_iff_of_fg Ideal.isIdempotentElem_iff_of_fgₓ'. -/
/-- A finitely generated idempotent ideal is generated by an idempotent element -/
theorem isIdempotentElem_iff_of_fg {R : Type _} [CommRing R] (I : Ideal R) (h : I.Fg) :
    IsIdempotentElem I ↔ ∃ e : R, IsIdempotentElem e ∧ I = R ∙ e :=
  by
  constructor
  · intro e
    obtain ⟨r, hr, hr'⟩ :=
      Submodule.exists_mem_and_smul_eq_self_of_fg_of_le_smul I I h
        (by
          rw [smul_eq_mul]
          exact e.ge)
    simp_rw [smul_eq_mul] at hr'
    refine' ⟨r, hr' r hr, antisymm _ ((Submodule.span_singleton_le_iff_mem _ _).mpr hr)⟩
    intro x hx
    rw [← hr' x hx]
    exact ideal.mem_span_singleton'.mpr ⟨_, mul_comm _ _⟩
  · rintro ⟨e, he, rfl⟩
    simp [IsIdempotentElem, Ideal.span_singleton_mul_span_singleton, he.eq]
#align ideal.is_idempotent_elem_iff_of_fg Ideal.isIdempotentElem_iff_of_fg

/- warning: ideal.is_idempotent_elem_iff_eq_bot_or_top -> Ideal.isIdempotentElem_iff_eq_bot_or_top is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : CommRing.{u1} R] [_inst_2 : IsDomain.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))] (I : Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))), (Ideal.Fg.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) I) -> (Iff (IsIdempotentElem.{u1} (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Ideal.hasMul.{u1} R (CommRing.toCommSemiring.{u1} R _inst_1)) I) (Or (Eq.{succ u1} (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) I (Bot.bot.{u1} (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Submodule.hasBot.{u1, u1} R R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))))) (Semiring.toModule.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)))))) (Eq.{succ u1} (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) I (Top.top.{u1} (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Submodule.hasTop.{u1, u1} R R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))))) (Semiring.toModule.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))))))))
but is expected to have type
  forall {R : Type.{u1}} [_inst_1 : CommRing.{u1} R] [_inst_2 : IsDomain.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))] (I : Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))), (Ideal.Fg.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) I) -> (Iff (IsIdempotentElem.{u1} (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Ideal.instMulIdealToSemiring.{u1} R (CommRing.toCommSemiring.{u1} R _inst_1)) I) (Or (Eq.{succ u1} (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) I (Bot.bot.{u1} (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Submodule.instBotSubmodule.{u1, u1} R R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))))) (Semiring.toModule.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)))))) (Eq.{succ u1} (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) I (Top.top.{u1} (Ideal.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Submodule.instTopSubmodule.{u1, u1} R R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))))) (Semiring.toModule.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))))))))
Case conversion may be inaccurate. Consider using '#align ideal.is_idempotent_elem_iff_eq_bot_or_top Ideal.isIdempotentElem_iff_eq_bot_or_topₓ'. -/
theorem isIdempotentElem_iff_eq_bot_or_top {R : Type _} [CommRing R] [IsDomain R] (I : Ideal R)
    (h : I.Fg) : IsIdempotentElem I ↔ I = ⊥ ∨ I = ⊤ :=
  by
  constructor
  · intro H
    obtain ⟨e, he, rfl⟩ := (I.is_idempotent_elem_iff_of_fg h).mp H
    simp only [Ideal.submodule_span_eq, Ideal.span_singleton_eq_bot]
    apply or_of_or_of_imp_of_imp (is_idempotent_elem.iff_eq_zero_or_one.mp he) id
    rintro rfl
    simp
  · rintro (rfl | rfl) <;> simp [IsIdempotentElem]
#align ideal.is_idempotent_elem_iff_eq_bot_or_top Ideal.isIdempotentElem_iff_eq_bot_or_top

end Ideal


import category_theory.limits.shapes.pullbacks
import category_theory.limits.limits
import category_theory.types
import category_theory.limits.types
import category_theory.monad.algebra
import category_theory.category.Cat
import tactic.equiv_rw
import category.pullbacks
import data.sigma

namespace category_theory

open category_theory category_theory.category category_theory.limits

universes v u
noncomputable theory
section
variables (A : Type u) [category.{v} A]

structure internal_category_struct :=
(C₀ C₁ C₂ : A) -- object of objects, object of morphisms, object of composable pairs (i.e (f,g) where f ∘ g makes sense)
(trg src : C₁ ⟶ C₀) -- get codomain and domain of morphisms
(ident : C₀ ⟶ C₁) -- get identity morphism on object
(first_hom comp second_hom : C₂ ⟶ C₁) -- decompose composite
(comp_comm : first_hom ≫ src = second_hom ≫ trg)
(comp_pb : is_limit (pullback_cone.mk _ _ comp_comm))
(ident_trg : ident ≫ trg = 𝟙 C₀)
(ident_src : ident ≫ src = 𝟙 C₀)
(comp_trg : comp ≫ trg = first_hom ≫ trg)
(comp_src : comp ≫ src = second_hom ≫ src)
end

open internal_category_struct

attribute [simp, reassoc] internal_category_struct.ident_src internal_category_struct.ident_trg
attribute [simp, reassoc] internal_category_struct.comp_comm internal_category_struct.comp_trg internal_category_struct.comp_src

section
variables {C : Type u} [category.{v} C] {X Y Z : C} (f : X ⟶ Z) (g : Y ⟶ Z)
@[simp] lemma mk_fst {W : C} (fst : W ⟶ X) (snd : W ⟶ Y) (eq : fst ≫ f = snd ≫ g) :
  (pullback_cone.mk fst snd eq).fst = fst := rfl
@[simp] lemma mk_snd {W : C} (fst : W ⟶ X) (snd : W ⟶ Y) (eq : fst ≫ f = snd ≫ g) :
  (pullback_cone.mk fst snd eq).snd = snd := rfl
end

section
variables {A : Type u} [category.{v} A] (c : internal_category_struct A)
-- given f,g with the source of f = target of g (ie f ∘ g or g ≫ f makes sense), form the composable pair (f,g)

def make_pair {Q : A} (f g : Q ⟶ c.C₁)
  (composable : f ≫ c.src = g ≫ c.trg) :
Q ⟶ c.C₂ :=
(pullback_cone.is_limit.lift' c.comp_pb _ _ composable).1

@[simp, reassoc]
lemma compose_l {Q : A} (f g : Q ⟶ c.C₁)
  (cmp : f ≫ c.src = g ≫ c.trg) :
make_pair c f g cmp ≫ c.first_hom = f :=
(pullback_cone.is_limit.lift' c.comp_pb _ _ cmp).2.1

@[simp, reassoc]
lemma compose_r {Q : A} (f g : Q ⟶ c.C₁)
  (cmp : f ≫ c.src = g ≫ c.trg) :
make_pair c f g cmp ≫ c.second_hom = g :=
(pullback_cone.is_limit.lift' c.comp_pb _ _ cmp).2.2

@[reassoc] lemma compose_natural {Q R : A} (f g : R ⟶ c.C₁) (h : Q ⟶ R) (composable : f ≫ c.src = g ≫ c.trg) :
  h ≫ make_pair c f g composable = make_pair c (h ≫ f) (h ≫ g) (by simp [*]) :=
begin
  apply pullback_cone.is_limit.hom_ext c.comp_pb;
  simp,
end
end

section
variables {A : Type u} [category.{v} A] [has_finite_limits A] (c : internal_category_struct A)
/--
object of composable triples (f,g,h) where f ∘ (g ∘ h) makes sense
(as should (f ∘ g) ∘ h)
constructed as the pullback of (f,g₁) and (g₂,h) where g₁ = g₂
-/
def internal_category_struct.C₃ : A :=
pullback c.second_hom c.first_hom

open limits.pullback

/-- The first pair `(f, g₁)` of the triple `(f, g₁ = g₂, h)` -/
abbreviation internal_category_struct.left_pair : c.C₃ ⟶ c.C₂ := fst
/-- The second pair `(g₂, h)` of the triple `(f, g₁ = g₂, h)` -/
abbreviation internal_category_struct.right_pair : c.C₃ ⟶ c.C₂ := snd

/-- The first homomorphism `f` of the triple `(f, g, h)` -/
abbreviation internal_category_struct.trip_first_hom : c.C₃ ⟶ c.C₁ := c.left_pair ≫ c.first_hom
/-- The first homomorphism `h` of the triple `(f, g, h)` -/
abbreviation internal_category_struct.trip_third_hom : c.C₃ ⟶ c.C₁ := c.right_pair ≫ c.second_hom

/-- Prove `g₁ = g₂` in the triple `(f, g₁ = g₂, h)` -/
@[reassoc] lemma trip_snd_eq : c.left_pair ≫ c.second_hom = c.right_pair ≫ c.first_hom := condition

/-- Map `(f, g, h)` to `(f ∘ g, h)` -/
abbreviation internal_category_struct.comp_left_pair : c.C₃ ⟶ c.C₂ :=
make_pair c (c.left_pair ≫ c.comp) c.trip_third_hom $
by rw [assoc, c.comp_src, trip_snd_eq_assoc, assoc, c.comp_comm]

/-- Map `(f, g, h)` to `(f, g ∘ h)` -/
abbreviation internal_category_struct.comp_right_pair : c.C₃ ⟶ c.C₂ :=
make_pair c c.trip_first_hom (c.right_pair ≫ c.comp) $
by rw [assoc, assoc, c.comp_trg, c.comp_comm, trip_snd_eq_assoc]

end
-- def element {X : Type u} : (⊤_ (Type u) ⟶ X) ≃ X :=
-- { to_fun := λ f, f _,

-- }
-- -- { to_fun := λ f, f ⟨λ t, t.elim, λ t, t.elim⟩,
-- --   inv_fun := λ x _, x,
-- --   left_inv := λ f,
-- --   begin
-- --     ext1 ⟨_, _⟩,
-- --     dsimp,
-- --     congr,
-- --     ext ⟨⟩,
-- --   end,
-- --   right_inv := λ x, rfl }

-- @[simp] lemma element_natural {X Y : Type u} (f : ⊤_ _ ⟶ X) (g : X ⟶ Y) : element (f ≫ g) = g (element f) :=
-- rfl

-- @[simp] lemma element_unelement {X : Type u} (x : X) : element (element.symm x) = x :=
-- rfl

-- def category_struct_of_internal_category_struct_type (c : internal_category_struct.{u} (Type u)) :
--   category_struct c.C₀ :=
-- { hom := λ X Y, {h : c.C₁ // c.src h = Y ∧ c.trg h = X},
--   id := λ X, ⟨c.ident X, congr_fun c.ident_src X, congr_fun c.ident_trg X⟩,
--   comp := λ X Y Z f g,
--   begin
--     refine ⟨_, _, _⟩,
--     { refine element (make_pair c (element.symm ↑f) (element.symm ↑g) _ ≫ c.comp),
--       rw ← element.apply_eq_iff_eq,
--       dsimp, rw [f.prop.1, g.prop.2] },
--     { change (make_pair _ _ _ _ ≫ c.comp ≫ c.src) _ = Z,
--       rw [c.comp_src, compose_r_assoc],
--       exact g.prop.1 },
--     { change (make_pair _ _ _ _ ≫ c.comp ≫ c.trg) _ = X,
--       rw [c.comp_trg, compose_l_assoc],
--       exact f.prop.2 },
--   end }

-- structure internal_category (A : Type u) [category.{v} A] [has_finite_limits.{v} A] extends internal_category_struct.{v} A :=
-- (assoc : internal_category_struct.comp_left_pair _ ≫ comp = internal_category_struct.comp_right_pair _ ≫ comp)
-- (id_comp : make_pair _ (𝟙 _) (src ≫ ident) (by simp) ≫ comp = 𝟙 C₁)
-- (comp_id : make_pair _ (trg ≫ ident) (𝟙 _) (by simp) ≫ comp = 𝟙 C₁)

-- @[simps]
-- def internal_category_struct_type_of_category_struct (C : Type u) [category_struct.{u} C] : internal_category_struct.{u} (Type u) :=
-- { C₀ := C,
--   C₁ := Σ (X Y : C), X ⟶ Y,
--   C₂ := Σ (X Y Z : C), (X ⟶ Y) × (Y ⟶ Z),
--   src := λ f, f.1,
--   trg := λ f, f.2.1,
--   ident := λ x, ⟨x, x, 𝟙 _⟩,
--   first_hom := λ x, ⟨x.2.1, x.2.2.1, x.2.2.2.2⟩,
--   comp := λ x, ⟨x.1, x.2.2.1, x.2.2.2.1 ≫ x.2.2.2.2⟩,
--   second_hom := λ x, ⟨x.1, x.2.1, x.2.2.2.1⟩,
--   comp_comm := rfl,
--   comp_pb :=
--   begin
--     refine construct_type_pb _ _,
--     rintros ⟨Y, X, f⟩ ⟨Z, Y, g⟩ _,
--     dsimp at a, subst a,
--     refine ⟨⟨Z, Y, X, g, f⟩, rfl, rfl, _⟩,
--     rintro ⟨Z', Y', X', g', f'⟩ h₁ h₂,
--     dsimp at h₁ h₂,
--     cases h₁,
--     cases h₂,
--     refl,
--   end,
--   ident_trg := rfl,
--   ident_src := rfl,
--   comp_trg := rfl,
--   comp_src := rfl }

-- section

-- def tag (α : Type*) (n : ℕ) (t : α) := t

-- def alt_pb (C : Type u) [category_struct.{u} C] := Σ (W X Y Z : C), (W ⟶ X) × (X ⟶ Y) × (Y ⟶ Z)
-- def alt_π₁ (C : Type u) [category_struct.{u} C] :
--   alt_pb C ⟶ (internal_category_struct_type_of_category_struct C).C₂ :=
-- begin
--   intro x,
--   refine ⟨x.2.1, x.2.2.1, x.2.2.2.1, x.2.2.2.2.2.1, x.2.2.2.2.2.2⟩,
-- end
-- def alt_π₂ (C : Type u) [category_struct.{u} C] :
--   alt_pb C ⟶ (internal_category_struct_type_of_category_struct C).C₂ :=
-- begin
--   intro x,
--   refine ⟨x.1, x.2.1, x.2.2.1, x.2.2.2.2.1, x.2.2.2.2.2.1⟩,
-- end

-- lemma alt_comm (C : Type u) [category_struct.{u} C] :
--   alt_π₁ C ≫ (internal_category_struct_type_of_category_struct C).second_hom = alt_π₂ C ≫ (internal_category_struct_type_of_category_struct C).first_hom :=
-- rfl

-- def is_pb (C : Type u) [category_struct.{u} C] :
--   is_limit (pullback_cone.mk _ _ (alt_comm C)) :=
-- begin
--   apply construct_type_pb _,
--   rintros ⟨X, Y, Z, f, g⟩ ⟨W, X, Y, h, f⟩ _,
--   dsimp [internal_category_struct_type_of_category_struct] at a,
--   injection a with a₁ a₂,
--   subst a₁,
--   rw heq_iff_eq at a₂,
--   injection a₂ with a₃ a₄,
--   subst a₃,
--   rw heq_iff_eq at a₄,
--   subst a₄,
--   refine ⟨⟨_, _, _, _, h, f, g⟩, _, _, _⟩,
--   refl,
--   refl,
--   rintro ⟨_, _, _, _, _, _, _⟩ k l,
--   cases k,
--   cases l,
--   refl,
-- end

-- end

-- local attribute [instance] has_finite_limits_of_has_limits

-- def to_C₃ (C : Type u) [category_struct.{u} C] : alt_pb C ≅ (internal_category_struct_type_of_category_struct C).C₃ :=
-- limits.is_limit.cone_point_unique_up_to_iso (is_pb C) (limit.is_limit _)

-- @[simps]
-- def internal_category_type_of_category (C : Type u) [category.{u} C] : internal_category.{u} (Type u) :=
-- { id_comp :=
--   begin
--     ext1 ⟨X, Y, f⟩,
--     change (⟨_, _, _⟩ : Σ (X Y : C), X ⟶ Y) = _,
--     congr' 2,
--     apply id_comp,
--   end,
--   comp_id :=
--   begin
--     ext1 ⟨X, Y, f⟩,
--     change (⟨X, Y, f ≫ 𝟙 _⟩ : Σ (X Y : C), X ⟶ Y) = (⟨X, Y, f⟩ : Σ (X Y : C), X ⟶ Y),
--     congr' 2,
--     apply comp_id,
--   end,
--   assoc :=
--   begin
--     haveI := is_iso.of_iso (to_C₃ C),
--     rw [← cancel_epi (to_C₃ C).hom, compose_natural_assoc, compose_natural_assoc],
--     change make_pair _ (pullback.lift _ _ _ ≫ pullback.fst ≫ _) (pullback.lift _ _ _ ≫ pullback.snd ≫ _) _ ≫ _ =
--            make_pair _ (pullback.lift _ _ _ ≫ pullback.fst ≫ _) (pullback.lift _ _ _ ≫ pullback.snd ≫ _) _ ≫ _,
--     simp_rw [pullback.lift_fst_assoc, pullback.lift_snd_assoc],
--     ext1 ⟨W, X, Y, Z, f, g, h⟩,
--     change (⟨W, Z, f ≫ g ≫ h⟩ : Σ (X Y : C), X ⟶ Y) = (⟨W, Z, (f ≫ g) ≫ h⟩ : Σ (X Y : C), X ⟶ Y),
--     simp,
--   end,
--   ..internal_category_struct_type_of_category_struct C }

-- instance category_of_internal_category_type (c : internal_category.{u} (Type u)) :
--   small_category c.C₀ :=
-- { comp_id' :=
--   begin
--     rintros X Y ⟨f, rfl, rfl⟩,
--     ext1,
--     change element (make_pair _ (element.symm f) _ _ ≫ c.comp) = f,
--     equiv_rw (@element c.C₁).symm at f,
--     rw equiv.apply_eq_iff_eq,
--     change make_pair c.to_internal_category_struct f (element.symm (element ((f ≫ c.src) ≫ c.ident))) _ ≫ c.comp = _,
--     simp_rw [equiv.symm_apply_apply, assoc],
--     have := f ≫= c.id_comp,
--     simp_rw [compose_natural_assoc, comp_id] at this,
--     exact this,
--   end,
--   id_comp' :=
--   begin
--     rintros X Y ⟨f, rfl, rfl⟩,
--     ext1,
--     change element (make_pair _ _ (element.symm f) _ ≫ c.comp) = f,
--     equiv_rw (@element c.C₁).symm at f,
--     rw equiv.apply_eq_iff_eq,
--     change make_pair c.to_internal_category_struct (element.symm (element ((f ≫ c.trg) ≫ c.ident))) f _ ≫ c.comp = _,
--     simp_rw [equiv.symm_apply_apply, assoc],
--     have := f ≫= c.comp_id,
--     simp_rw [compose_natural_assoc, comp_id] at this,
--     exact this,
--   end,
--   assoc' :=
--   begin
--     rintros W X Y Z ⟨f, rfl, rfl⟩ ⟨g, rfl, fg⟩ ⟨h, rfl, gh⟩,
--     ext1,
--     equiv_rw (@element c.C₁).symm at f,
--     equiv_rw (@element c.C₁).symm at g,
--     equiv_rw (@element c.C₁).symm at h,
--     change element (make_pair _ _ _ _ ≫ c.comp) = element (make_pair _ _ _ _ ≫ c.comp),
--     rw equiv.apply_eq_iff_eq,
--     change make_pair _ (element.symm (element (make_pair _ (element.symm (element f)) (element.symm (element g)) _ ≫ c.comp))) (element.symm (element h)) _ ≫ c.comp =
--            make_pair _ (element.symm (element f)) (element.symm (element (make_pair _ (element.symm (element g)) (element.symm (element h)) _ ≫ c.comp))) _ ≫ c.comp,
--     simp_rw [equiv.symm_apply_apply],
--     change make_pair _ (make_pair _ f g _ ≫ c.comp) h _ ≫ c.comp = make_pair _ f (make_pair _ g h _ ≫ c.comp) _ ≫ c.comp,
--     have := pullback.lift (make_pair _ f g _) (make_pair _ g h _) _ ≫= c.assoc,
--       rotate,
--       { rw [equiv.symm_symm, ← element_natural _ c.trg, ← element_natural _ c.src, equiv.apply_eq_iff_eq] at fg,
--         rw fg },
--       { rw [equiv.symm_symm, ← element_natural _ c.trg, ← element_natural _ c.src, equiv.apply_eq_iff_eq] at gh,
--         rw gh },
--       { rw [compose_l, compose_r] },
--     rw [← assoc, ← assoc] at this,
--     convert this;
--     apply pullback_cone.is_limit.hom_ext c.comp_pb;
--     simp,
--   end,
--   ..category_struct_of_internal_category_struct_type c.to_internal_category_struct}

-- structure internal_functor {A : Type u} [category.{v} A] [has_finite_limits A] (c d : internal_category A) :=
-- (obj : c.C₀ ⟶ d.C₀)
-- (map : c.C₁ ⟶ d.C₁)
-- (map_src : map ≫ d.src = c.src ≫ obj)
-- (map_trg : map ≫ d.trg = c.trg ≫ obj)
-- (ident_map : c.ident ≫ map = obj ≫ d.ident)
-- (comp_map : make_pair _ (first_hom _ ≫ map) (second_hom _ ≫ map) (by simp [map_src, map_trg]) ≫ d.comp = c.comp ≫ map)

-- attribute [simp, reassoc] internal_functor.map_src internal_functor.map_trg internal_functor.ident_map internal_functor.comp_map
-- variables {A : Type u} [category.{v} A] [has_finite_limits A]

-- def internal_id (c : internal_category A) : internal_functor c c :=
-- { obj := 𝟙 _,
--   map := 𝟙 _,
--   map_src := by simp,
--   map_trg := by simp,
--   ident_map := by simp,
--   comp_map :=
--   begin
--     simp only [comp_id],
--     convert id_comp _,
--     apply pullback_cone.is_limit.hom_ext c.comp_pb;
--     simp,
--   end }

-- def internal_comp {c d e : internal_category A} (F : internal_functor c d) (G : internal_functor d e) :
--   internal_functor c e :=
-- { obj := F.obj ≫ G.obj,
--   map := F.map ≫ G.map,
--   map_src := by simp,
--   map_trg := by simp,
--   ident_map := by simp,
--   comp_map :=
--   begin
--     rw [← F.comp_map_assoc, ← G.comp_map, compose_natural_assoc],
--     simp,
--   end }

-- @[ext] def internal_functor_ext {c d : internal_category A} (F G : internal_functor c d) (h₁ : F.obj = G.obj) (h₂ : F.map = G.map) : F = G :=
-- begin
--   cases F, cases G,
--   congr; assumption
-- end
-- @[simps]
-- def make_functor (c d : internal_category.{u} (Type u)) (F : internal_functor c d) :
--   c.C₀ ⥤ d.C₀ :=
-- { obj := F.obj,
--   map := λ X Y f,
--   begin
--     refine ⟨F.map f.1, _, _⟩,
--     { change (F.map ≫ d.src) _ = _,
--       rw F.map_src,
--       dsimp,
--       rw f.prop.1 },
--     { change (F.map ≫ d.trg) _ = _,
--       rw F.map_trg,
--       dsimp,
--       rw f.prop.2 },
--   end,
--   map_id' := λ X,
--   begin
--     ext1,
--     change (c.ident ≫ F.map) X = (F.obj ≫ d.ident) X,
--     rw F.ident_map,
--   end,
--   map_comp' :=
--   begin
--     rintros _ _ Z ⟨f, rfl, rfl⟩ ⟨g, rfl, fg⟩,
--     ext1,
--     change F.map (element (make_pair _ (element.symm f) (element.symm g) _ ≫ c.comp)) = element (make_pair _ (element.symm (F.map f)) (element.symm (F.map g)) _ ≫ d.comp),
--     equiv_rw (@element c.C₁).symm at f,
--     equiv_rw (@element c.C₁).symm at g,
--     have : g ≫ c.trg = f ≫ c.src,
--       rw ← element.apply_eq_iff_eq,
--       simpa using fg,
--     simp_rw [← element_natural _ F.map, equiv.symm_apply_apply],
--     rw [element.apply_eq_iff_eq, assoc, ← F.comp_map, compose_natural_assoc],
--     simp,
--   end }

-- def internalise_functor (C D : Type u) [small_category C] [small_category D] (F : C ⥤ D) :
--   internal_functor (internal_category_type_of_category C) (internal_category_type_of_category D) :=
-- { obj := F.obj,
--   map := λ XYf, ⟨F.obj XYf.1, F.obj XYf.2.1, F.map XYf.2.2⟩,
--   map_src := rfl,
--   map_trg := rfl,
--   ident_map :=
--   begin
--     ext1 X,
--     dsimp,
--     simp only [functor.map_id],
--     refl,
--   end,
--   comp_map :=
--   begin
--     ext1 ⟨X, Y, Z, f, g⟩,
--     dsimp [internal_category_struct_type_of_category_struct],
--     change (⟨F.obj X, ⟨F.obj Z, F.map f ≫ F.map g⟩⟩ : Σ (X Y : D), X ⟶ Y) = (⟨F.obj X, ⟨F.obj Z, F.map (f ≫ g)⟩⟩ : Σ (X Y : D), X ⟶ Y),
--     simp,
--   end }

-- instance cat_of_int_cat : category (internal_category.{v} A) :=
-- { hom := internal_functor,
--   id := internal_id,
--   comp := λ X Y Z, internal_comp,
--   id_comp' := λ X Y f,
--   begin
--     apply internal_functor_ext;
--     apply id_comp,
--   end,
--   comp_id' := λ X Y f,
--   begin
--     apply internal_functor_ext;
--     apply comp_id,
--   end,
--   assoc' := λ c₁ c₂ c₃ c₄ f g h,
--   begin
--     apply internal_functor_ext;
--     apply assoc,
--   end }

-- @[simps]
-- def internal_equiv : internal_category (Type u) ⥤ Cat :=
-- { obj := λ c, Cat.of c.C₀,
--   map := make_functor,
--   map_id' := λ c,
--   begin
--     refine functor.ext (λ X, rfl) _,
--     intros,
--     apply subtype.ext,
--     dsimp [make_functor],
--     simpa only [id_comp, comp_id],
--   end,
--   map_comp' := λ c d e f g,
--   begin
--     refine functor.ext (λ X, rfl) _,
--     intros,
--     apply subtype.ext,
--     dsimp,
--     simpa,
--   end }

-- @[simps]
-- def internal_inv : Cat.{u} ⥤ internal_category (Type u) :=
-- { obj := λ c, internal_category_type_of_category c.α,
--   map := λ c d f, internalise_functor _ _ f }

-- -- -- set_option pp.all true
-- -- def internal_equivalence : internal_category.{u} (Type u) ≌ Cat.{u u} :=
-- -- { functor :=
-- --   { obj := λ c, Cat.of c.C₀,
-- --     map := make_functor,
-- --     map_id' := λ c,
-- --     begin
-- --       refine functor.ext (λ X, rfl) _,
-- --       intros,
-- --       apply subtype.ext,
-- --       dsimp [make_functor],
-- --       simpa only [id_comp, comp_id],
-- --     end,
-- --     map_comp' := λ c d e f g,
-- --     begin
-- --       refine functor.ext (λ X, rfl) _,
-- --       intros,
-- --       apply subtype.ext,
-- --       dsimp,
-- --       simpa,
-- --     end },
-- --   inverse :=
-- --   { obj := λ c, internal_category_type_of_category c.α,
-- --     map := λ c d f, internalise_functor _ _ f },
-- --   unit_iso :=
-- --   begin
-- --     -- apply nat_iso.of_components _ _,
-- --     -- intro X,
-- --     -- dsimp,
-- --     -- change X ≅ _,
-- --     -- dsimp [Cat.of, bundled.of, Cat.str, category_theory.category_of_internal_category_type, internal_category_type_of_category],
-- --     -- refine ⟨_, _, _, _⟩,
-- --     -- refine ⟨𝟙 _, λ x, ⟨X.src x, X.trg x, sorry⟩, rfl, rfl, _, _⟩,
-- --     -- ext1,
-- --     -- dsimp [internal_category_struct_type_of_category_struct],
-- --     -- change (⟨(X.ident ≫ X.src) x, (X.ident ≫ X.trg) x, _⟩ : Σ (X₁ Y₁ : X.to_internal_category_struct.C₀), X₁ ⟶ Y₁) = _,
-- --     sorry,
-- --   end,
-- --   counit_iso :=
-- --   begin
-- --     apply nat_iso.of_components _ _,
-- --     intro X,
-- --     apply eq_to_iso,
-- --     cases X,
-- --     dsimp [Cat.of, bundled.of],
-- --     congr,

-- --   end
-- -- }

end category_theory


import .form ..list

namespace nat

def update (m n) (v : nat → nat) : nat → nat
| x := if x = m then n else v x

lemma update_eq (m n v) : update m n v m = n :=
begin simp only [update, if_pos rfl] end

lemma update_eq_of_ne {m n v k} :
  m ≠ k → update m n v k = v k :=
begin
  intro h1, simp only [update],
  rw if_neg h1.symm
end

namespace preterm

def sub_terms : preterm → option (preterm × preterm)
| (& i)      := none
| (i ** n)   := none
| (t +* s) := t.sub_terms <|> s.sub_terms
| (t -* s) := t.sub_terms <|> s.sub_terms <|> some (t,s)

def sub_subst (t s : preterm) (k : nat) : preterm → preterm
| t@(& m)    := t
| t@(m ** n) := t
| (x +* y) := x.sub_subst +* y.sub_subst
| (x -* y) :=
  if x = t ∧ y = s then (1 ** k)
  else x.sub_subst -* y.sub_subst

lemma val_sub_subst {k x y v} :
  ∀ {t : preterm}, t.fresh_idx ≤ k →
  (sub_subst x y k t).val
  (update k (x.val v - y.val v) v) = t.val v
| (& m)    h1 := rfl
| (m ** n) h1 :=
  begin
    simp_omega [sub_subst], apply congr_arg,
    apply update_eq_of_ne (ne_of_gt _),
    apply lt_iff_add_one_le.elim_right h1,
 end
| (t +* s) h1 :=
  begin
    simp_omega [sub_subst], apply fun_mono_2;
    apply val_sub_subst (le_trans _ h1),
    apply le_max_left, apply le_max_right
  end
| (t -* s) h1 :=
  begin
    simp_omega [sub_subst],
    by_cases h2 : t = x ∧ s = y,
    { rw if_pos h2, simp_omega,
      rw [update_eq, h2.left, h2.right, one_mul] },
    { rw if_neg h2, simp_omega [sub_subst],
      apply fun_mono_2;
      apply val_sub_subst (le_trans _ h1),
      apply le_max_left, apply le_max_right, }
  end

end preterm

namespace form

def sub_terms : form → option (preterm × preterm)
| (t =* s) := t.sub_terms <|> s.sub_terms
| (t ≤* s) := t.sub_terms <|> s.sub_terms
| (¬* p)   := p.sub_terms
| (p ∨* q) := p.sub_terms <|> q.sub_terms
| (p ∧* q) := p.sub_terms <|> q.sub_terms

@[omega] def sub_subst (x y : preterm) (k : nat) : form → form
| (t =* s) := preterm.sub_subst x y k t =* preterm.sub_subst x y k s
| (t ≤* s) := preterm.sub_subst x y k t ≤* preterm.sub_subst x y k s
| (¬* p)   := ¬* p.sub_subst
| (p ∨* q) := p.sub_subst ∨* q.sub_subst
| (p ∧* q) := p.sub_subst ∧* q.sub_subst

end form

def is_diff (t s k) : form :=
((t =* (s +* (1 ** k))) ∨* (t ≤* s ∧* ((1 ** k) =* &0)))

lemma holds_is_diff {t s : preterm} {k} {v : nat → nat} :
  v k = t.val v - s.val v → (is_diff t s k).holds v :=
begin
  intro h1, simp_omega [is_diff, if_pos (eq.refl 1)],
  by_cases h2 : t.val v ≤ s.val v,
  { right, refine ⟨h2,_⟩,
    rw [h1, one_mul, nat.sub_eq_zero_iff_le], exact h2 },
  { left, rw [h1, one_mul, add_comm, nat.sub_add_cancel _],
    rw not_le at h2, apply le_of_lt h2 }
end

def sub_elim_core (t s k) (p : form) : form :=
(form.sub_subst t s k p) ∧* (is_diff t s k)

def sub_fresh_idx (t s : preterm) (p : form) : nat :=
max p.fresh_idx (max t.fresh_idx s.fresh_idx)

def sub_elim (t s) (p : form) : form :=
-- sub_elim_core t s p.fresh_idx p
sub_elim_core t s (sub_fresh_idx t s p) p

lemma sub_subst_equiv {k} {x y : preterm} {v} :
  ∀ p : form, p.fresh_idx ≤ k → ((form.sub_subst x y k p).holds
    (update k (x.val v - y.val v) v) ↔ (p.holds v))
| (t =* s) h1 :=
  begin
    simp_omega, apply pred_mono_2;
    apply preterm.val_sub_subst (le_trans _ h1),
    apply le_max_left, apply le_max_right
  end
| (t ≤* s) h1 :=
  begin
    simp_omega, apply pred_mono_2;
    apply preterm.val_sub_subst (le_trans _ h1),
    apply le_max_left, apply le_max_right
  end
| (¬* p) h1 :=
  by { apply not_iff_not_of_iff, apply sub_subst_equiv p h1 }
| (p ∨* q) h1 :=
  begin
    simp_omega, apply pred_mono_2; apply propext;
    apply sub_subst_equiv _ (le_trans _ h1),
    apply le_max_left, apply le_max_right
  end
| (p ∧* q) h1 :=
  begin
    simp_omega, apply pred_mono_2; apply propext;
    apply sub_subst_equiv _ (le_trans _ h1),
    apply le_max_left, apply le_max_right
  end

lemma sat_sub_elim {t s} {p : form} :
  p.sat → (sub_elim t s p).sat :=
begin
  intro h1, simp only [sub_elim, sub_elim_core],
  cases h1 with v h1,
  refine ⟨update (sub_fresh_idx t s p) (t.val v - s.val v) v, _⟩,
  constructor,
  { apply (sub_subst_equiv p _).elim_right h1,
    apply le_max_left },
  { apply holds_is_diff, rw update_eq,
    apply sub_eq_sub_of_eq_of_eq;
    apply preterm.val_constant; intros x h2;
    rw update_eq_of_ne; apply ne_of_gt;
    apply lt_of_lt_of_le h2;
    apply le_trans _ (le_max_right _ _),
    apply le_max_left, apply le_max_right }
end

lemma unsat_of_unsat_sub_elim (t s p) :
  (sub_elim t s p).unsat → p.unsat :=
not_of_imp_of_not sat_sub_elim

end nat


/-
Copyright (c) 2021 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen, Paul Lezeau

! This file was ported from Lean 3 source module number_theory.kummer_dedekind
! leanprover-community/mathlib commit f7fc89d5d5ff1db2d1242c7bb0e9062ce47ef47c
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.RingTheory.AlgebraTower
import Mathbin.RingTheory.DedekindDomain.Ideal
import Mathbin.RingTheory.IsAdjoinRoot

/-!
# Kummer-Dedekind theorem

This file proves the monogenic version of the Kummer-Dedekind theorem on the splitting of prime
ideals in an extension of the ring of integers. This states that if `I` is a prime ideal of
Dedekind domain `R` and `S = R[α]` for some `α` that is integral over `R` with minimal polynomial
`f`, then the prime factorisations of `I * S` and `f mod I` have the same shape, i.e. they have the
same number of prime factors, and each prime factors of `I * S` can be paired with a prime factor
of `f mod I` in a way that ensures multiplicities match (in fact, this pairing can be made explicit
with a formula).

## Main definitions

 * `normalized_factors_map_equiv_normalized_factors_min_poly_mk` : The bijection in the
    Kummer-Dedekind theorem. This is the pairing between the prime factors of `I * S` and the prime
    factors of `f mod I`.

## Main results

 * `normalized_factors_ideal_map_eq_normalized_factors_min_poly_mk_map` : The Kummer-Dedekind
    theorem.
 * `ideal.irreducible_map_of_irreducible_minpoly` : `I.map (algebra_map R S)` is irreducible if
    `(map I^.quotient.mk (minpoly R pb.gen))` is irreducible, where `pb` is a power basis of `S`
    over `R`.

## TODO

 * Prove the Kummer-Dedekind theorem in full generality.

 * Prove the converse of `ideal.irreducible_map_of_irreducible_minpoly`.

 * Prove that `normalized_factors_map_equiv_normalized_factors_min_poly_mk` can be expressed as
    `normalized_factors_map_equiv_normalized_factors_min_poly_mk g = ⟨I, G(α)⟩` for `g` a prime
    factor of `f mod I` and `G` a lift of `g` to `R[X]`.

## References

 * [J. Neukirch, *Algebraic Number Theory*][Neukirch1992]

## Tags

kummer, dedekind, kummer dedekind, dedekind-kummer, dedekind kummer
-/

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

open Ideal Polynomial DoubleQuot UniqueFactorizationMonoid Algebra RingHom

-- mathport name: «expr < >»
local notation:max R "<" x ">" => adjoin R ({x} : Set S)

/-- Let `S / R` be a ring extension and `x : S`, then the conductor of `R<x>` is the
    biggest ideal of `S` contained in `R<x>`. -/
def conductor (x : S) : Ideal S
    where
  carrier := { a | ∀ b : S, a * b ∈ R<x> }
  zero_mem' b := by simpa only [MulZeroClass.zero_mul] using Subalgebra.zero_mem _
  add_mem' a b ha hb c := by simpa only [add_mul] using Subalgebra.add_mem _ (ha c) (hb c)
  smul_mem' c a ha b := by simpa only [smul_eq_mul, mul_left_comm, mul_assoc] using ha (c * b)
#align conductor conductor

variable {R} {x : S}

theorem conductor_eq_of_eq {y : S} (h : (R<x> : Set S) = R<y>) : conductor R x = conductor R y :=
  Ideal.ext fun a => forall_congr' fun b => Set.ext_iff.mp h _
#align conductor_eq_of_eq conductor_eq_of_eq

theorem conductor_subset_adjoin : (conductor R x : Set S) ⊆ R<x> := fun y hy => by
  simpa only [mul_one] using hy 1
#align conductor_subset_adjoin conductor_subset_adjoin

theorem mem_conductor_iff {y : S} : y ∈ conductor R x ↔ ∀ b : S, y * b ∈ R<x> :=
  ⟨fun h => h, fun h => h⟩
#align mem_conductor_iff mem_conductor_iff

theorem conductor_eq_top_of_adjoin_eq_top (h : R<x> = ⊤) : conductor R x = ⊤ := by
  simp only [Ideal.eq_top_iff_one, mem_conductor_iff, h, mem_top, forall_const]
#align conductor_eq_top_of_adjoin_eq_top conductor_eq_top_of_adjoin_eq_top

theorem conductor_eq_top_of_powerBasis (pb : PowerBasis R S) : conductor R pb.gen = ⊤ :=
  conductor_eq_top_of_adjoin_eq_top pb.adjoin_gen_eq_top
#align conductor_eq_top_of_power_basis conductor_eq_top_of_powerBasis

variable {I : Ideal R}

/-- This technical lemma tell us that if `C` is the conductor of `R<x>` and `I` is an ideal of `R`
  then `p * (I * S) ⊆ I * R<x>` for any `p` in `C ∩ R` -/
theorem prod_mem_ideal_map_of_mem_conductor {p : R} {z : S}
    (hp : p ∈ Ideal.comap (algebraMap R S) (conductor R x)) (hz' : z ∈ I.map (algebraMap R S)) :
    algebraMap R S p * z ∈ algebraMap R<x> S '' ↑(I.map (algebraMap R R<x>)) :=
  by
  rw [Ideal.map, Ideal.span, Finsupp.mem_span_image_iff_total] at hz'
  obtain ⟨l, H, H'⟩ := hz'
  rw [Finsupp.total_apply] at H'
  rw [← H', mul_comm, Finsupp.sum_mul]
  have lem :
    ∀ {a : R},
      a ∈ I →
        l a • algebraMap R S a * algebraMap R S p ∈
          algebraMap R<x> S '' I.map (algebraMap R R<x>) :=
    by
    intro a ha
    rw [Algebra.id.smul_eq_mul, mul_assoc, mul_comm, mul_assoc, Set.mem_image]
    refine'
      Exists.intro
        (algebraMap R R<x> a * ⟨l a * algebraMap R S p, show l a * algebraMap R S p ∈ R<x> from _⟩)
        _
    · rw [mul_comm]
      exact mem_conductor_iff.mp (ideal.mem_comap.mp hp) _
    refine' ⟨_, by simpa only [RingHom.map_mul, mul_comm (algebraMap R S p) (l a)] ⟩
    rw [mul_comm]
    apply Ideal.mul_mem_left (I.map (algebraMap R R<x>)) _ (Ideal.mem_map_of_mem _ ha)
  refine'
    Finset.sum_induction _ (fun u => u ∈ algebraMap R<x> S '' I.map (algebraMap R R<x>))
      (fun a b => _) _ _
  rintro ⟨z, hz, rfl⟩ ⟨y, hy, rfl⟩
  rw [← RingHom.map_add]
  exact ⟨z + y, Ideal.add_mem _ (set_like.mem_coe.mp hz) hy, rfl⟩
  · refine' ⟨0, set_like.mem_coe.mpr <| Ideal.zero_mem _, RingHom.map_zero _⟩
  · intro y hy
    exact lem ((Finsupp.mem_supported _ l).mp H hy)
#align prod_mem_ideal_map_of_mem_conductor prod_mem_ideal_map_of_mem_conductor

/-- A technical result telling us that `(I * S) ∩ R<x> = I * R<x>` for any ideal `I` of `R`. -/
theorem comap_map_eq_map_adjoin_of_coprime_conductor
    (hx : (conductor R x).comap (algebraMap R S) ⊔ I = ⊤)
    (h_alg : Function.Injective (algebraMap R<x> S)) :
    (I.map (algebraMap R S)).comap (algebraMap R<x> S) = I.map (algebraMap R R<x>) :=
  by
  apply le_antisymm
  · -- This is adapted from [Neukirch1992]. Let `C = (conductor R x)`. The idea of the proof
    -- is that since `I` and `C ∩ R` are coprime, we have
    -- `(I * S) ∩ R<x> ⊆ (I + C) * ((I * S) ∩ R<x>) ⊆ I * R<x> + I * C * S ⊆ I * R<x>`.
    intro y hy
    obtain ⟨z, hz⟩ := y
    obtain ⟨p, hp, q, hq, hpq⟩ := submodule.mem_sup.mp ((Ideal.eq_top_iff_one _).mp hx)
    have temp : algebraMap R S p * z + algebraMap R S q * z = z := by
      simp only [← add_mul, ← RingHom.map_add (algebraMap R S), hpq, map_one, one_mul]
    suffices
      z ∈ algebraMap R<x> S '' I.map (algebraMap R R<x>) ↔
        (⟨z, hz⟩ : R<x>) ∈ I.map (algebraMap R R<x>)
      by
      rw [← this, ← temp]
      obtain ⟨a, ha⟩ :=
        (Set.mem_image _ _ _).mp
          (prod_mem_ideal_map_of_mem_conductor hp
            (show z ∈ I.map (algebraMap R S) by rwa [Ideal.mem_comap] at hy))
      use a + algebraMap R R<x> q * ⟨z, hz⟩
      refine'
        ⟨Ideal.add_mem (I.map (algebraMap R R<x>)) ha.left _, by
          simpa only [ha.right, map_add, AlgHom.map_mul, add_right_inj] ⟩
      rw [mul_comm]
      exact Ideal.mul_mem_left (I.map (algebraMap R R<x>)) _ (Ideal.mem_map_of_mem _ hq)
    refine'
      ⟨fun h => _, fun h => (Set.mem_image _ _ _).mpr (Exists.intro ⟨z, hz⟩ ⟨by simp [h], rfl⟩)⟩
    · obtain ⟨x₁, hx₁, hx₂⟩ := (Set.mem_image _ _ _).mp h
      have : x₁ = ⟨z, hz⟩ := by
        apply h_alg
        simpa [hx₂]
      rwa [← this]
  · -- The converse inclusion is trivial
    have : algebraMap R S = (algebraMap _ S).comp (algebraMap R R<x>) :=
      by
      ext
      rfl
    rw [this, ← Ideal.map_map]
    apply Ideal.le_comap_map
#align comap_map_eq_map_adjoin_of_coprime_conductor comap_map_eq_map_adjoin_of_coprime_conductor

/-- The canonical morphism of rings from `R<x> ⧸ (I*R<x>)` to `S ⧸ (I*S)` is an isomorphism
    when `I` and `(conductor R x) ∩ R` are coprime. -/
noncomputable def quotAdjoinEquivQuotMap (hx : (conductor R x).comap (algebraMap R S) ⊔ I = ⊤)
    (h_alg : Function.Injective (algebraMap R<x> S)) :
    R<x> ⧸ I.map (algebraMap R R<x>) ≃+* S ⧸ I.map (algebraMap R S) :=
  RingEquiv.ofBijective
    (Ideal.Quotient.lift (I.map (algebraMap R R<x>))
      ((I.map (algebraMap R S)).Quotient.mk.comp (algebraMap R<x> S)) fun r hr =>
      by
      have : algebraMap R S = (algebraMap R<x> S).comp (algebraMap R R<x>) :=
        by
        ext
        rfl
      rw [RingHom.comp_apply, Ideal.Quotient.eq_zero_iff_mem, this, ← Ideal.map_map]
      exact Ideal.mem_map_of_mem _ hr)
    (by
      constructor
      · --the kernel of the map is clearly `(I * S) ∩ R<x>`. To get injectivity, we need to show that
        --this is contained in `I * R<x>`, which is the content of the previous lemma.
        refine' RingHom.lift_injective_of_ker_le_ideal _ _ fun u hu => _
        rwa [RingHom.mem_ker, RingHom.comp_apply, Ideal.Quotient.eq_zero_iff_mem, ← Ideal.mem_comap,
          comap_map_eq_map_adjoin_of_coprime_conductor hx h_alg] at hu
      · -- Surjectivity follows from the surjectivity of the canonical map `R<x> → S ⧸ (I * S)`,
        -- which in turn follows from the fact that `I * S + (conductor R x) = S`.
        refine' Ideal.Quotient.lift_surjective_of_surjective _ _ fun y => _
        obtain ⟨z, hz⟩ := Ideal.Quotient.mk_surjective y
        have : z ∈ conductor R x ⊔ I.map (algebraMap R S) :=
          by
          suffices conductor R x ⊔ I.map (algebraMap R S) = ⊤ by simp only [this]
          rw [Ideal.eq_top_iff_one] at hx⊢
          replace hx := Ideal.mem_map_of_mem (algebraMap R S) hx
          rw [Ideal.map_sup, RingHom.map_one] at hx
          exact
            (sup_le_sup
                (show ((conductor R x).comap (algebraMap R S)).map (algebraMap R S) ≤ conductor R x
                  from Ideal.map_comap_le)
                (le_refl (I.map (algebraMap R S))))
              hx
        rw [← Ideal.mem_quotient_iff_mem_sup, hz, Ideal.mem_map_iff_of_surjective] at this
        obtain ⟨u, hu, hu'⟩ := this
        use ⟨u, conductor_subset_adjoin hu⟩
        simpa only [← hu']
        · exact Ideal.Quotient.mk_surjective)
#align quot_adjoin_equiv_quot_map quotAdjoinEquivQuotMap

@[simp]
theorem quotAdjoinEquivQuotMap_apply_mk (hx : (conductor R x).comap (algebraMap R S) ⊔ I = ⊤)
    (h_alg : Function.Injective (algebraMap R<x> S)) (a : R<x>) :
    quotAdjoinEquivQuotMap hx h_alg ((I.map (algebraMap R R<x>)).Quotient.mk a) =
      (I.map (algebraMap R S)).Quotient.mk ↑a :=
  rfl
#align quot_adjoin_equiv_quot_map_apply_mk quotAdjoinEquivQuotMap_apply_mk

namespace KummerDedekind

open BigOperators Polynomial Classical

variable [IsDomain R] [IsIntegrallyClosed R]

variable [IsDomain S] [IsDedekindDomain S]

variable [NoZeroSMulDivisors R S]

attribute [local instance] Ideal.Quotient.field

/-- The first half of the **Kummer-Dedekind Theorem** in the monogenic case, stating that the prime
    factors of `I*S` are in bijection with those of the minimal polynomial of the generator of `S`
    over `R`, taken `mod I`.-/
noncomputable def normalizedFactorsMapEquivNormalizedFactorsMinPolyMk (hI : IsMaximal I)
    (hI' : I ≠ ⊥) (hx : (conductor R x).comap (algebraMap R S) ⊔ I = ⊤) (hx' : IsIntegral R x) :
    { J : Ideal S | J ∈ normalizedFactors (I.map (algebraMap R S)) } ≃
      { d : (R ⧸ I)[X] | d ∈ normalizedFactors (map I.Quotient.mk (minpoly R x)) } :=
  (normalizedFactorsEquivOfQuotEquiv
        ((quotAdjoinEquivQuotMap hx
                (by
                  apply NoZeroSMulDivisors.algebraMap_injective (Algebra.adjoin R {x}) S
                  exact Subalgebra.noZeroSMulDivisors_top (Algebra.adjoin R {x}))).symm.trans
          (((Algebra.adjoin.powerBasis' hx').quotientEquivQuotientMinpolyMap I).toRingEquiv.trans
            (quotEquivOfEq
              (show
                Ideal.span {(minpoly R (Algebra.adjoin.powerBasis' hx').gen).map I.Quotient.mk} =
                  Ideal.span {(minpoly R x).map I.Quotient.mk}
                by rw [Algebra.adjoin.powerBasis'_minpoly_gen hx']))))
        (--show that `I * S` ≠ ⊥
        show I.map (algebraMap R S) ≠ ⊥ by
          rwa [Ne.def, map_eq_bot_iff_of_injective (NoZeroSMulDivisors.algebraMap_injective R S), ←
            Ne.def])
        (--show that the ideal spanned by `(minpoly R pb.gen) mod I` is non-zero
        by
          by_contra
          exact
            (show map I.Quotient.mk (minpoly R x) ≠ 0 from
                Polynomial.map_monic_ne_zero (minpoly.monic hx'))
              (span_singleton_eq_bot.mp h))).trans
    (normalizedFactorsEquivSpanNormalizedFactors
        (show map I.Quotient.mk (minpoly R x) ≠ 0 from
          Polynomial.map_monic_ne_zero (minpoly.monic hx'))).symm
#align kummer_dedekind.normalized_factors_map_equiv_normalized_factors_min_poly_mk KummerDedekind.normalizedFactorsMapEquivNormalizedFactorsMinPolyMk

/-- The second half of the **Kummer-Dedekind Theorem** in the monogenic case, stating that the
    bijection `factors_equiv'` defined in the first half preserves multiplicities. -/
theorem multiplicity_factors_map_eq_multiplicity (hI : IsMaximal I) (hI' : I ≠ ⊥)
    (hx : (conductor R x).comap (algebraMap R S) ⊔ I = ⊤) (hx' : IsIntegral R x) {J : Ideal S}
    (hJ : J ∈ normalizedFactors (I.map (algebraMap R S))) :
    multiplicity J (I.map (algebraMap R S)) =
      multiplicity (↑(normalizedFactorsMapEquivNormalizedFactorsMinPolyMk hI hI' hx hx' ⟨J, hJ⟩))
        (map I.Quotient.mk (minpoly R x)) :=
  by
  rw [normalized_factors_map_equiv_normalized_factors_min_poly_mk, Equiv.coe_trans,
    Function.comp_apply,
    multiplicity_normalizedFactorsEquivSpanNormalizedFactors_symm_eq_multiplicity,
    normalizedFactorsEquivOfQuotEquiv_multiplicity_eq_multiplicity]
#align kummer_dedekind.multiplicity_factors_map_eq_multiplicity KummerDedekind.multiplicity_factors_map_eq_multiplicity

/-- The **Kummer-Dedekind Theorem**. -/
theorem normalizedFactors_ideal_map_eq_normalizedFactors_min_poly_mk_map (hI : IsMaximal I)
    (hI' : I ≠ ⊥) (hx : (conductor R x).comap (algebraMap R S) ⊔ I = ⊤) (hx' : IsIntegral R x) :
    normalizedFactors (I.map (algebraMap R S)) =
      Multiset.map
        (fun f =>
          ((normalizedFactorsMapEquivNormalizedFactorsMinPolyMk hI hI' hx hx').symm f : Ideal S))
        (normalizedFactors (Polynomial.map I.Quotient.mk (minpoly R x))).attach :=
  by
  ext J
  -- WLOG, assume J is a normalized factor
  by_cases hJ : J ∈ normalized_factors (I.map (algebraMap R S))
  swap
  · rw [multiset.count_eq_zero.mpr hJ, eq_comm, Multiset.count_eq_zero, Multiset.mem_map]
    simp only [Multiset.mem_attach, true_and_iff, not_exists]
    rintro J' rfl
    exact
      hJ ((normalized_factors_map_equiv_normalized_factors_min_poly_mk hI hI' hx hx').symm J').Prop
  -- Then we just have to compare the multiplicities, which we already proved are equal.
  have := multiplicity_factors_map_eq_multiplicity hI hI' hx hx' hJ
  rw [multiplicity_eq_count_normalized_factors, multiplicity_eq_count_normalized_factors,
    UniqueFactorizationMonoid.normalize_normalized_factor _ hJ,
    UniqueFactorizationMonoid.normalize_normalized_factor, PartENat.natCast_inj] at this
  refine' this.trans _
  -- Get rid of the `map` by applying the equiv to both sides.
  generalize hJ' :
    (normalized_factors_map_equiv_normalized_factors_min_poly_mk hI hI' hx hx') ⟨J, hJ⟩ = J'
  have :
    ((normalized_factors_map_equiv_normalized_factors_min_poly_mk hI hI' hx hx').symm J' :
        Ideal S) =
      J :=
    by rw [← hJ', Equiv.symm_apply_apply _ _, Subtype.coe_mk]
  subst this
  -- Get rid of the `attach` by applying the subtype `coe` to both sides.
  rw [Multiset.count_map_eq_count' fun f =>
      ((normalized_factors_map_equiv_normalized_factors_min_poly_mk hI hI' hx hx').symm f :
        Ideal S),
    Multiset.attach_count_eq_count_coe]
  · exact subtype.coe_injective.comp (Equiv.injective _)
  · exact (normalized_factors_map_equiv_normalized_factors_min_poly_mk hI hI' hx hx' _).Prop
  ·
    exact
      irreducible_of_normalized_factor _
        (normalized_factors_map_equiv_normalized_factors_min_poly_mk hI hI' hx hx' _).Prop
  · exact Polynomial.map_monic_ne_zero (minpoly.monic hx')
  · exact irreducible_of_normalized_factor _ hJ
  ·
    rwa [← bot_eq_zero, Ne.def,
      map_eq_bot_iff_of_injective (NoZeroSMulDivisors.algebraMap_injective R S)]
#align kummer_dedekind.normalized_factors_ideal_map_eq_normalized_factors_min_poly_mk_map KummerDedekind.normalizedFactors_ideal_map_eq_normalizedFactors_min_poly_mk_map

theorem Ideal.irreducible_map_of_irreducible_minpoly (hI : IsMaximal I) (hI' : I ≠ ⊥)
    (hx : (conductor R x).comap (algebraMap R S) ⊔ I = ⊤) (hx' : IsIntegral R x)
    (hf : Irreducible (map I.Quotient.mk (minpoly R x))) : Irreducible (I.map (algebraMap R S)) :=
  by
  have mem_norm_factors :
    normalize (map I.Quotient.mk (minpoly R x)) ∈
      normalized_factors (map I.Quotient.mk (minpoly R x)) :=
    by simp [normalized_factors_irreducible hf]
  suffices ∃ y, normalized_factors (I.map (algebraMap R S)) = {y}
    by
    obtain ⟨y, hy⟩ := this
    have h :=
      normalized_factors_prod
        (show I.map (algebraMap R S) ≠ 0 by
          rwa [← bot_eq_zero, Ne.def,
            map_eq_bot_iff_of_injective (NoZeroSMulDivisors.algebraMap_injective R S)])
    rw [associated_iff_eq, hy, Multiset.prod_singleton] at h
    rw [← h]
    exact
      irreducible_of_normalized_factor y
        (show y ∈ normalized_factors (I.map (algebraMap R S)) by simp [hy])
  rw [normalized_factors_ideal_map_eq_normalized_factors_min_poly_mk_map hI hI' hx hx']
  use
    ((normalized_factors_map_equiv_normalized_factors_min_poly_mk hI hI' hx hx').symm
        ⟨normalize (map I.Quotient.mk (minpoly R x)), mem_norm_factors⟩ :
      Ideal S)
  rw [Multiset.map_eq_singleton]
  use ⟨normalize (map I.Quotient.mk (minpoly R x)), mem_norm_factors⟩
  refine' ⟨_, rfl⟩
  apply Multiset.map_injective Subtype.coe_injective
  rw [Multiset.attach_map_val, Multiset.map_singleton, Subtype.coe_mk]
  exact normalized_factors_irreducible hf
#align kummer_dedekind.ideal.irreducible_map_of_irreducible_minpoly KummerDedekind.Ideal.irreducible_map_of_irreducible_minpoly

end KummerDedekind


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl

! This file was ported from Lean 3 source module order.zorn
! leanprover-community/mathlib commit c3291da49cfa65f0d43b094750541c0731edc932
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Order.Chain

/-!
# Zorn's lemmas

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

This file proves several formulations of Zorn's Lemma.

## Variants

The primary statement of Zorn's lemma is `exists_maximal_of_chains_bounded`. Then it is specialized
to particular relations:
* `(≤)` with `zorn_partial_order`
* `(⊆)` with `zorn_subset`
* `(⊇)` with `zorn_superset`

Lemma names carry modifiers:
* `₀`: Quantifies over a set, as opposed to over a type.
* `_nonempty`: Doesn't ask to prove that the empty chain is bounded and lets you give an element
  that will be smaller than the maximal element found (the maximal element is no smaller than any
  other element, but it can also be incomparable to some).

## How-to

This file comes across as confusing to those who haven't yet used it, so here is a detailed
walkthrough:
1. Know what relation on which type/set you're looking for. See Variants above. You can discharge
  some conditions to Zorn's lemma directly using a `_nonempty` variant.
2. Write down the definition of your type/set, put a `suffices : ∃ m, ∀ a, m ≺ a → a ≺ m, { ... },`
  (or whatever you actually need) followed by a `apply some_version_of_zorn`.
3. Fill in the details. This is where you start talking about chains.

A typical proof using Zorn could look like this
```lean
lemma zorny_lemma : zorny_statement :=
begin
  let s : set α := {x | whatever x},
  suffices : ∃ x ∈ s, ∀ y ∈ s, y ⊆ x → y = x, -- or with another operator
  { exact proof_post_zorn },
  apply zorn_subset, -- or another variant
  rintro c hcs hc,
  obtain rfl | hcnemp := c.eq_empty_or_nonempty, -- you might need to disjunct on c empty or not
  { exact ⟨edge_case_construction,
      proof_that_edge_case_construction_respects_whatever,
      proof_that_edge_case_construction_contains_all_stuff_in_c⟩ },
  exact ⟨construction,
    proof_that_construction_respects_whatever,
    proof_that_construction_contains_all_stuff_in_c⟩,
end
```

## Notes

Originally ported from Isabelle/HOL. The
[original file](https://isabelle.in.tum.de/dist/library/HOL/HOL/Zorn.html) was written by Jacques D.
Fleuriot, Tobias Nipkow, Christian Sternagel.
-/

open Classical Set

variable {α β : Type _} {r : α → α → Prop} {c : Set α}

-- mathport name: «expr ≺ »
local infixl:50 " ≺ " => r

#print exists_maximal_of_chains_bounded /-
/-- **Zorn's lemma**

If every chain has an upper bound, then there exists a maximal element. -/
theorem exists_maximal_of_chains_bounded (h : ∀ c, IsChain r c → ∃ ub, ∀ a ∈ c, a ≺ ub)
    (trans : ∀ {a b c}, a ≺ b → b ≺ c → a ≺ c) : ∃ m, ∀ a, m ≺ a → a ≺ m :=
  have : ∃ ub, ∀ a ∈ maxChain r, a ≺ ub := h _ <| maxChain_spec.left
  let ⟨ub, (hub : ∀ a ∈ maxChain r, a ≺ ub)⟩ := this
  ⟨ub, fun a ha =>
    have : IsChain r (insert a <| maxChain r) :=
      maxChain_spec.1.insert fun b hb _ => Or.inr <| trans (hub b hb) ha
    hub a <| by
      rw [max_chain_spec.right this (subset_insert _ _)]
      exact mem_insert _ _⟩
#align exists_maximal_of_chains_bounded exists_maximal_of_chains_bounded
-/

#print exists_maximal_of_nonempty_chains_bounded /-
/-- A variant of Zorn's lemma. If every nonempty chain of a nonempty type has an upper bound, then
there is a maximal element.
-/
theorem exists_maximal_of_nonempty_chains_bounded [Nonempty α]
    (h : ∀ c, IsChain r c → c.Nonempty → ∃ ub, ∀ a ∈ c, a ≺ ub)
    (trans : ∀ {a b c}, a ≺ b → b ≺ c → a ≺ c) : ∃ m, ∀ a, m ≺ a → a ≺ m :=
  exists_maximal_of_chains_bounded
    (fun c hc =>
      (eq_empty_or_nonempty c).elim
        (fun h => ⟨Classical.arbitrary α, fun x hx => (h ▸ hx : x ∈ (∅ : Set α)).elim⟩) (h c hc))
    fun a b c => trans
#align exists_maximal_of_nonempty_chains_bounded exists_maximal_of_nonempty_chains_bounded
-/

section Preorder

variable [Preorder α]

#print zorn_preorder /-
theorem zorn_preorder (h : ∀ c : Set α, IsChain (· ≤ ·) c → BddAbove c) :
    ∃ m : α, ∀ a, m ≤ a → a ≤ m :=
  exists_maximal_of_chains_bounded h fun a b c => le_trans
#align zorn_preorder zorn_preorder
-/

#print zorn_nonempty_preorder /-
theorem zorn_nonempty_preorder [Nonempty α]
    (h : ∀ c : Set α, IsChain (· ≤ ·) c → c.Nonempty → BddAbove c) : ∃ m : α, ∀ a, m ≤ a → a ≤ m :=
  exists_maximal_of_nonempty_chains_bounded h fun a b c => le_trans
#align zorn_nonempty_preorder zorn_nonempty_preorder
-/

/- warning: zorn_preorder₀ -> zorn_preorder₀ is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : Preorder.{u1} α] (s : Set.{u1} α), (forall (c : Set.{u1} α), (HasSubset.Subset.{u1} (Set.{u1} α) (Set.hasSubset.{u1} α) c s) -> (IsChain.{u1} α (LE.le.{u1} α (Preorder.toLE.{u1} α _inst_1)) c) -> (Exists.{succ u1} α (fun (ub : α) => Exists.{0} (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) ub s) (fun (H : Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) ub s) => forall (z : α), (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) z c) -> (LE.le.{u1} α (Preorder.toLE.{u1} α _inst_1) z ub))))) -> (Exists.{succ u1} α (fun (m : α) => Exists.{0} (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) m s) (fun (H : Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) m s) => forall (z : α), (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) z s) -> (LE.le.{u1} α (Preorder.toLE.{u1} α _inst_1) m z) -> (LE.le.{u1} α (Preorder.toLE.{u1} α _inst_1) z m))))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : Preorder.{u1} α] (s : Set.{u1} α), (forall (c : Set.{u1} α), (HasSubset.Subset.{u1} (Set.{u1} α) (Set.instHasSubsetSet.{u1} α) c s) -> (IsChain.{u1} α (fun (x._@.Mathlib.Order.Zorn._hyg.862 : α) (x._@.Mathlib.Order.Zorn._hyg.864 : α) => LE.le.{u1} α (Preorder.toLE.{u1} α _inst_1) x._@.Mathlib.Order.Zorn._hyg.862 x._@.Mathlib.Order.Zorn._hyg.864) c) -> (Exists.{succ u1} α (fun (ub : α) => And (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) ub s) (forall (z : α), (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) z c) -> (LE.le.{u1} α (Preorder.toLE.{u1} α _inst_1) z ub))))) -> (Exists.{succ u1} α (fun (m : α) => And (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) m s) (forall (z : α), (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) z s) -> (LE.le.{u1} α (Preorder.toLE.{u1} α _inst_1) m z) -> (LE.le.{u1} α (Preorder.toLE.{u1} α _inst_1) z m))))
Case conversion may be inaccurate. Consider using '#align zorn_preorder₀ zorn_preorder₀ₓ'. -/
/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (c «expr ⊆ » s) -/
theorem zorn_preorder₀ (s : Set α)
    (ih : ∀ (c) (_ : c ⊆ s), IsChain (· ≤ ·) c → ∃ ub ∈ s, ∀ z ∈ c, z ≤ ub) :
    ∃ m ∈ s, ∀ z ∈ s, m ≤ z → z ≤ m :=
  let ⟨⟨m, hms⟩, h⟩ :=
    @zorn_preorder s _ fun c hc =>
      let ⟨ub, hubs, hub⟩ :=
        ih (Subtype.val '' c) (fun _ ⟨⟨x, hx⟩, _, h⟩ => h ▸ hx)
          (by
            rintro _ ⟨p, hpc, rfl⟩ _ ⟨q, hqc, rfl⟩ hpq <;>
              refine' hc hpc hqc fun t => hpq (Subtype.ext_iff.1 t))
      ⟨⟨ub, hubs⟩, fun ⟨y, hy⟩ hc => hub _ ⟨_, hc, rfl⟩⟩
  ⟨m, hms, fun z hzs hmz => h ⟨z, hzs⟩ hmz⟩
#align zorn_preorder₀ zorn_preorder₀

/- warning: zorn_nonempty_preorder₀ -> zorn_nonempty_preorder₀ is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : Preorder.{u1} α] (s : Set.{u1} α), (forall (c : Set.{u1} α), (HasSubset.Subset.{u1} (Set.{u1} α) (Set.hasSubset.{u1} α) c s) -> (IsChain.{u1} α (LE.le.{u1} α (Preorder.toLE.{u1} α _inst_1)) c) -> (forall (y : α), (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) y c) -> (Exists.{succ u1} α (fun (ub : α) => Exists.{0} (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) ub s) (fun (H : Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) ub s) => forall (z : α), (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) z c) -> (LE.le.{u1} α (Preorder.toLE.{u1} α _inst_1) z ub)))))) -> (forall (x : α), (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x s) -> (Exists.{succ u1} α (fun (m : α) => Exists.{0} (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) m s) (fun (H : Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) m s) => And (LE.le.{u1} α (Preorder.toLE.{u1} α _inst_1) x m) (forall (z : α), (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) z s) -> (LE.le.{u1} α (Preorder.toLE.{u1} α _inst_1) m z) -> (LE.le.{u1} α (Preorder.toLE.{u1} α _inst_1) z m))))))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : Preorder.{u1} α] (s : Set.{u1} α), (forall (c : Set.{u1} α), (HasSubset.Subset.{u1} (Set.{u1} α) (Set.instHasSubsetSet.{u1} α) c s) -> (IsChain.{u1} α (fun (x._@.Mathlib.Order.Zorn._hyg.1178 : α) (x._@.Mathlib.Order.Zorn._hyg.1180 : α) => LE.le.{u1} α (Preorder.toLE.{u1} α _inst_1) x._@.Mathlib.Order.Zorn._hyg.1178 x._@.Mathlib.Order.Zorn._hyg.1180) c) -> (forall (y : α), (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) y c) -> (Exists.{succ u1} α (fun (ub : α) => And (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) ub s) (forall (z : α), (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) z c) -> (LE.le.{u1} α (Preorder.toLE.{u1} α _inst_1) z ub)))))) -> (forall (x : α), (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) x s) -> (Exists.{succ u1} α (fun (m : α) => And (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) m s) (And (LE.le.{u1} α (Preorder.toLE.{u1} α _inst_1) x m) (forall (z : α), (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) z s) -> (LE.le.{u1} α (Preorder.toLE.{u1} α _inst_1) m z) -> (LE.le.{u1} α (Preorder.toLE.{u1} α _inst_1) z m))))))
Case conversion may be inaccurate. Consider using '#align zorn_nonempty_preorder₀ zorn_nonempty_preorder₀ₓ'. -/
/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (c «expr ⊆ » s) -/
theorem zorn_nonempty_preorder₀ (s : Set α)
    (ih : ∀ (c) (_ : c ⊆ s), IsChain (· ≤ ·) c → ∀ y ∈ c, ∃ ub ∈ s, ∀ z ∈ c, z ≤ ub) (x : α)
    (hxs : x ∈ s) : ∃ m ∈ s, x ≤ m ∧ ∀ z ∈ s, m ≤ z → z ≤ m :=
  by
  rcases zorn_preorder₀ ({ y ∈ s | x ≤ y }) fun c hcs hc => _ with ⟨m, ⟨hms, hxm⟩, hm⟩
  · exact ⟨m, hms, hxm, fun z hzs hmz => hm _ ⟨hzs, hxm.trans hmz⟩ hmz⟩
  · rcases c.eq_empty_or_nonempty with (rfl | ⟨y, hy⟩)
    · exact ⟨x, ⟨hxs, le_rfl⟩, fun z => False.elim⟩
    · rcases ih c (fun z hz => (hcs hz).1) hc y hy with ⟨z, hzs, hz⟩
      exact ⟨z, ⟨hzs, (hcs hy).2.trans <| hz _ hy⟩, hz⟩
#align zorn_nonempty_preorder₀ zorn_nonempty_preorder₀

/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (c «expr ⊆ » Ici[set.Ici] a) -/
#print zorn_nonempty_Ici₀ /-
theorem zorn_nonempty_Ici₀ (a : α)
    (ih : ∀ (c) (_ : c ⊆ Ici a), IsChain (· ≤ ·) c → ∀ y ∈ c, ∃ ub, a ≤ ub ∧ ∀ z ∈ c, z ≤ ub)
    (x : α) (hax : a ≤ x) : ∃ m, x ≤ m ∧ ∀ z, m ≤ z → z ≤ m :=
  let ⟨m, hma, hxm, hm⟩ := zorn_nonempty_preorder₀ (Ici a) (by simpa using ih) x hax
  ⟨m, hxm, fun z hmz => hm _ (hax.trans <| hxm.trans hmz) hmz⟩
#align zorn_nonempty_Ici₀ zorn_nonempty_Ici₀
-/

end Preorder

section PartialOrder

variable [PartialOrder α]

#print zorn_partialOrder /-
theorem zorn_partialOrder (h : ∀ c : Set α, IsChain (· ≤ ·) c → BddAbove c) :
    ∃ m : α, ∀ a, m ≤ a → a = m :=
  let ⟨m, hm⟩ := zorn_preorder h
  ⟨m, fun a ha => le_antisymm (hm a ha) ha⟩
#align zorn_partial_order zorn_partialOrder
-/

#print zorn_nonempty_partialOrder /-
theorem zorn_nonempty_partialOrder [Nonempty α]
    (h : ∀ c : Set α, IsChain (· ≤ ·) c → c.Nonempty → BddAbove c) : ∃ m : α, ∀ a, m ≤ a → a = m :=
  let ⟨m, hm⟩ := zorn_nonempty_preorder h
  ⟨m, fun a ha => le_antisymm (hm a ha) ha⟩
#align zorn_nonempty_partial_order zorn_nonempty_partialOrder
-/

/- warning: zorn_partial_order₀ -> zorn_partialOrder₀ is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : PartialOrder.{u1} α] (s : Set.{u1} α), (forall (c : Set.{u1} α), (HasSubset.Subset.{u1} (Set.{u1} α) (Set.hasSubset.{u1} α) c s) -> (IsChain.{u1} α (LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α _inst_1))) c) -> (Exists.{succ u1} α (fun (ub : α) => Exists.{0} (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) ub s) (fun (H : Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) ub s) => forall (z : α), (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) z c) -> (LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α _inst_1)) z ub))))) -> (Exists.{succ u1} α (fun (m : α) => Exists.{0} (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) m s) (fun (H : Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) m s) => forall (z : α), (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) z s) -> (LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α _inst_1)) m z) -> (Eq.{succ u1} α z m))))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : PartialOrder.{u1} α] (s : Set.{u1} α), (forall (c : Set.{u1} α), (HasSubset.Subset.{u1} (Set.{u1} α) (Set.instHasSubsetSet.{u1} α) c s) -> (IsChain.{u1} α (fun (x._@.Mathlib.Order.Zorn._hyg.1874 : α) (x._@.Mathlib.Order.Zorn._hyg.1876 : α) => LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α _inst_1)) x._@.Mathlib.Order.Zorn._hyg.1874 x._@.Mathlib.Order.Zorn._hyg.1876) c) -> (Exists.{succ u1} α (fun (ub : α) => And (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) ub s) (forall (z : α), (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) z c) -> (LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α _inst_1)) z ub))))) -> (Exists.{succ u1} α (fun (m : α) => And (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) m s) (forall (z : α), (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) z s) -> (LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α _inst_1)) m z) -> (Eq.{succ u1} α z m))))
Case conversion may be inaccurate. Consider using '#align zorn_partial_order₀ zorn_partialOrder₀ₓ'. -/
/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (c «expr ⊆ » s) -/
theorem zorn_partialOrder₀ (s : Set α)
    (ih : ∀ (c) (_ : c ⊆ s), IsChain (· ≤ ·) c → ∃ ub ∈ s, ∀ z ∈ c, z ≤ ub) :
    ∃ m ∈ s, ∀ z ∈ s, m ≤ z → z = m :=
  let ⟨m, hms, hm⟩ := zorn_preorder₀ s ih
  ⟨m, hms, fun z hzs hmz => (hm z hzs hmz).antisymm hmz⟩
#align zorn_partial_order₀ zorn_partialOrder₀

/- warning: zorn_nonempty_partial_order₀ -> zorn_nonempty_partialOrder₀ is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : PartialOrder.{u1} α] (s : Set.{u1} α), (forall (c : Set.{u1} α), (HasSubset.Subset.{u1} (Set.{u1} α) (Set.hasSubset.{u1} α) c s) -> (IsChain.{u1} α (LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α _inst_1))) c) -> (forall (y : α), (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) y c) -> (Exists.{succ u1} α (fun (ub : α) => Exists.{0} (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) ub s) (fun (H : Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) ub s) => forall (z : α), (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) z c) -> (LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α _inst_1)) z ub)))))) -> (forall (x : α), (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x s) -> (Exists.{succ u1} α (fun (m : α) => Exists.{0} (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) m s) (fun (H : Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) m s) => And (LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α _inst_1)) x m) (forall (z : α), (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) z s) -> (LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α _inst_1)) m z) -> (Eq.{succ u1} α z m))))))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : PartialOrder.{u1} α] (s : Set.{u1} α), (forall (c : Set.{u1} α), (HasSubset.Subset.{u1} (Set.{u1} α) (Set.instHasSubsetSet.{u1} α) c s) -> (IsChain.{u1} α (fun (x._@.Mathlib.Order.Zorn._hyg.2042 : α) (x._@.Mathlib.Order.Zorn._hyg.2044 : α) => LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α _inst_1)) x._@.Mathlib.Order.Zorn._hyg.2042 x._@.Mathlib.Order.Zorn._hyg.2044) c) -> (forall (y : α), (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) y c) -> (Exists.{succ u1} α (fun (ub : α) => And (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) ub s) (forall (z : α), (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) z c) -> (LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α _inst_1)) z ub)))))) -> (forall (x : α), (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) x s) -> (Exists.{succ u1} α (fun (m : α) => And (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) m s) (And (LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α _inst_1)) x m) (forall (z : α), (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) z s) -> (LE.le.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α _inst_1)) m z) -> (Eq.{succ u1} α z m))))))
Case conversion may be inaccurate. Consider using '#align zorn_nonempty_partial_order₀ zorn_nonempty_partialOrder₀ₓ'. -/
/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (c «expr ⊆ » s) -/
theorem zorn_nonempty_partialOrder₀ (s : Set α)
    (ih : ∀ (c) (_ : c ⊆ s), IsChain (· ≤ ·) c → ∀ y ∈ c, ∃ ub ∈ s, ∀ z ∈ c, z ≤ ub) (x : α)
    (hxs : x ∈ s) : ∃ m ∈ s, x ≤ m ∧ ∀ z ∈ s, m ≤ z → z = m :=
  let ⟨m, hms, hxm, hm⟩ := zorn_nonempty_preorder₀ s ih x hxs
  ⟨m, hms, hxm, fun z hzs hmz => (hm z hzs hmz).antisymm hmz⟩
#align zorn_nonempty_partial_order₀ zorn_nonempty_partialOrder₀

end PartialOrder

/- warning: zorn_subset -> zorn_subset is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} (S : Set.{u1} (Set.{u1} α)), (forall (c : Set.{u1} (Set.{u1} α)), (HasSubset.Subset.{u1} (Set.{u1} (Set.{u1} α)) (Set.hasSubset.{u1} (Set.{u1} α)) c S) -> (IsChain.{u1} (Set.{u1} α) (HasSubset.Subset.{u1} (Set.{u1} α) (Set.hasSubset.{u1} α)) c) -> (Exists.{succ u1} (Set.{u1} α) (fun (ub : Set.{u1} α) => Exists.{0} (Membership.Mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.hasMem.{u1} (Set.{u1} α)) ub S) (fun (H : Membership.Mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.hasMem.{u1} (Set.{u1} α)) ub S) => forall (s : Set.{u1} α), (Membership.Mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.hasMem.{u1} (Set.{u1} α)) s c) -> (HasSubset.Subset.{u1} (Set.{u1} α) (Set.hasSubset.{u1} α) s ub))))) -> (Exists.{succ u1} (Set.{u1} α) (fun (m : Set.{u1} α) => Exists.{0} (Membership.Mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.hasMem.{u1} (Set.{u1} α)) m S) (fun (H : Membership.Mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.hasMem.{u1} (Set.{u1} α)) m S) => forall (a : Set.{u1} α), (Membership.Mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.hasMem.{u1} (Set.{u1} α)) a S) -> (HasSubset.Subset.{u1} (Set.{u1} α) (Set.hasSubset.{u1} α) m a) -> (Eq.{succ u1} (Set.{u1} α) a m))))
but is expected to have type
  forall {α : Type.{u1}} (S : Set.{u1} (Set.{u1} α)), (forall (c : Set.{u1} (Set.{u1} α)), (HasSubset.Subset.{u1} (Set.{u1} (Set.{u1} α)) (Set.instHasSubsetSet.{u1} (Set.{u1} α)) c S) -> (IsChain.{u1} (Set.{u1} α) (fun (x._@.Mathlib.Order.Zorn._hyg.2249 : Set.{u1} α) (x._@.Mathlib.Order.Zorn._hyg.2251 : Set.{u1} α) => HasSubset.Subset.{u1} (Set.{u1} α) (Set.instHasSubsetSet.{u1} α) x._@.Mathlib.Order.Zorn._hyg.2249 x._@.Mathlib.Order.Zorn._hyg.2251) c) -> (Exists.{succ u1} (Set.{u1} α) (fun (ub : Set.{u1} α) => And (Membership.mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.instMembershipSet.{u1} (Set.{u1} α)) ub S) (forall (s : Set.{u1} α), (Membership.mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.instMembershipSet.{u1} (Set.{u1} α)) s c) -> (HasSubset.Subset.{u1} (Set.{u1} α) (Set.instHasSubsetSet.{u1} α) s ub))))) -> (Exists.{succ u1} (Set.{u1} α) (fun (m : Set.{u1} α) => And (Membership.mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.instMembershipSet.{u1} (Set.{u1} α)) m S) (forall (a : Set.{u1} α), (Membership.mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.instMembershipSet.{u1} (Set.{u1} α)) a S) -> (HasSubset.Subset.{u1} (Set.{u1} α) (Set.instHasSubsetSet.{u1} α) m a) -> (Eq.{succ u1} (Set.{u1} α) a m))))
Case conversion may be inaccurate. Consider using '#align zorn_subset zorn_subsetₓ'. -/
/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (c «expr ⊆ » S) -/
theorem zorn_subset (S : Set (Set α))
    (h : ∀ (c) (_ : c ⊆ S), IsChain (· ⊆ ·) c → ∃ ub ∈ S, ∀ s ∈ c, s ⊆ ub) :
    ∃ m ∈ S, ∀ a ∈ S, m ⊆ a → a = m :=
  zorn_partialOrder₀ S h
#align zorn_subset zorn_subset

/- warning: zorn_subset_nonempty -> zorn_subset_nonempty is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} (S : Set.{u1} (Set.{u1} α)), (forall (c : Set.{u1} (Set.{u1} α)), (HasSubset.Subset.{u1} (Set.{u1} (Set.{u1} α)) (Set.hasSubset.{u1} (Set.{u1} α)) c S) -> (IsChain.{u1} (Set.{u1} α) (HasSubset.Subset.{u1} (Set.{u1} α) (Set.hasSubset.{u1} α)) c) -> (Set.Nonempty.{u1} (Set.{u1} α) c) -> (Exists.{succ u1} (Set.{u1} α) (fun (ub : Set.{u1} α) => Exists.{0} (Membership.Mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.hasMem.{u1} (Set.{u1} α)) ub S) (fun (H : Membership.Mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.hasMem.{u1} (Set.{u1} α)) ub S) => forall (s : Set.{u1} α), (Membership.Mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.hasMem.{u1} (Set.{u1} α)) s c) -> (HasSubset.Subset.{u1} (Set.{u1} α) (Set.hasSubset.{u1} α) s ub))))) -> (forall (x : Set.{u1} α), (Membership.Mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.hasMem.{u1} (Set.{u1} α)) x S) -> (Exists.{succ u1} (Set.{u1} α) (fun (m : Set.{u1} α) => Exists.{0} (Membership.Mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.hasMem.{u1} (Set.{u1} α)) m S) (fun (H : Membership.Mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.hasMem.{u1} (Set.{u1} α)) m S) => And (HasSubset.Subset.{u1} (Set.{u1} α) (Set.hasSubset.{u1} α) x m) (forall (a : Set.{u1} α), (Membership.Mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.hasMem.{u1} (Set.{u1} α)) a S) -> (HasSubset.Subset.{u1} (Set.{u1} α) (Set.hasSubset.{u1} α) m a) -> (Eq.{succ u1} (Set.{u1} α) a m))))))
but is expected to have type
  forall {α : Type.{u1}} (S : Set.{u1} (Set.{u1} α)), (forall (c : Set.{u1} (Set.{u1} α)), (HasSubset.Subset.{u1} (Set.{u1} (Set.{u1} α)) (Set.instHasSubsetSet.{u1} (Set.{u1} α)) c S) -> (IsChain.{u1} (Set.{u1} α) (fun (x._@.Mathlib.Order.Zorn._hyg.2373 : Set.{u1} α) (x._@.Mathlib.Order.Zorn._hyg.2375 : Set.{u1} α) => HasSubset.Subset.{u1} (Set.{u1} α) (Set.instHasSubsetSet.{u1} α) x._@.Mathlib.Order.Zorn._hyg.2373 x._@.Mathlib.Order.Zorn._hyg.2375) c) -> (Set.Nonempty.{u1} (Set.{u1} α) c) -> (Exists.{succ u1} (Set.{u1} α) (fun (ub : Set.{u1} α) => And (Membership.mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.instMembershipSet.{u1} (Set.{u1} α)) ub S) (forall (s : Set.{u1} α), (Membership.mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.instMembershipSet.{u1} (Set.{u1} α)) s c) -> (HasSubset.Subset.{u1} (Set.{u1} α) (Set.instHasSubsetSet.{u1} α) s ub))))) -> (forall (x : Set.{u1} α), (Membership.mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.instMembershipSet.{u1} (Set.{u1} α)) x S) -> (Exists.{succ u1} (Set.{u1} α) (fun (m : Set.{u1} α) => And (Membership.mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.instMembershipSet.{u1} (Set.{u1} α)) m S) (And (HasSubset.Subset.{u1} (Set.{u1} α) (Set.instHasSubsetSet.{u1} α) x m) (forall (a : Set.{u1} α), (Membership.mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.instMembershipSet.{u1} (Set.{u1} α)) a S) -> (HasSubset.Subset.{u1} (Set.{u1} α) (Set.instHasSubsetSet.{u1} α) m a) -> (Eq.{succ u1} (Set.{u1} α) a m))))))
Case conversion may be inaccurate. Consider using '#align zorn_subset_nonempty zorn_subset_nonemptyₓ'. -/
/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (c «expr ⊆ » S) -/
theorem zorn_subset_nonempty (S : Set (Set α))
    (H : ∀ (c) (_ : c ⊆ S), IsChain (· ⊆ ·) c → c.Nonempty → ∃ ub ∈ S, ∀ s ∈ c, s ⊆ ub) (x)
    (hx : x ∈ S) : ∃ m ∈ S, x ⊆ m ∧ ∀ a ∈ S, m ⊆ a → a = m :=
  zorn_nonempty_partialOrder₀ _ (fun c cS hc y yc => H _ cS hc ⟨y, yc⟩) _ hx
#align zorn_subset_nonempty zorn_subset_nonempty

/- warning: zorn_superset -> zorn_superset is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} (S : Set.{u1} (Set.{u1} α)), (forall (c : Set.{u1} (Set.{u1} α)), (HasSubset.Subset.{u1} (Set.{u1} (Set.{u1} α)) (Set.hasSubset.{u1} (Set.{u1} α)) c S) -> (IsChain.{u1} (Set.{u1} α) (HasSubset.Subset.{u1} (Set.{u1} α) (Set.hasSubset.{u1} α)) c) -> (Exists.{succ u1} (Set.{u1} α) (fun (lb : Set.{u1} α) => Exists.{0} (Membership.Mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.hasMem.{u1} (Set.{u1} α)) lb S) (fun (H : Membership.Mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.hasMem.{u1} (Set.{u1} α)) lb S) => forall (s : Set.{u1} α), (Membership.Mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.hasMem.{u1} (Set.{u1} α)) s c) -> (HasSubset.Subset.{u1} (Set.{u1} α) (Set.hasSubset.{u1} α) lb s))))) -> (Exists.{succ u1} (Set.{u1} α) (fun (m : Set.{u1} α) => Exists.{0} (Membership.Mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.hasMem.{u1} (Set.{u1} α)) m S) (fun (H : Membership.Mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.hasMem.{u1} (Set.{u1} α)) m S) => forall (a : Set.{u1} α), (Membership.Mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.hasMem.{u1} (Set.{u1} α)) a S) -> (HasSubset.Subset.{u1} (Set.{u1} α) (Set.hasSubset.{u1} α) a m) -> (Eq.{succ u1} (Set.{u1} α) a m))))
but is expected to have type
  forall {α : Type.{u1}} (S : Set.{u1} (Set.{u1} α)), (forall (c : Set.{u1} (Set.{u1} α)), (HasSubset.Subset.{u1} (Set.{u1} (Set.{u1} α)) (Set.instHasSubsetSet.{u1} (Set.{u1} α)) c S) -> (IsChain.{u1} (Set.{u1} α) (fun (x._@.Mathlib.Order.Zorn._hyg.2532 : Set.{u1} α) (x._@.Mathlib.Order.Zorn._hyg.2534 : Set.{u1} α) => HasSubset.Subset.{u1} (Set.{u1} α) (Set.instHasSubsetSet.{u1} α) x._@.Mathlib.Order.Zorn._hyg.2532 x._@.Mathlib.Order.Zorn._hyg.2534) c) -> (Exists.{succ u1} (Set.{u1} α) (fun (lb : Set.{u1} α) => And (Membership.mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.instMembershipSet.{u1} (Set.{u1} α)) lb S) (forall (s : Set.{u1} α), (Membership.mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.instMembershipSet.{u1} (Set.{u1} α)) s c) -> (HasSubset.Subset.{u1} (Set.{u1} α) (Set.instHasSubsetSet.{u1} α) lb s))))) -> (Exists.{succ u1} (Set.{u1} α) (fun (m : Set.{u1} α) => And (Membership.mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.instMembershipSet.{u1} (Set.{u1} α)) m S) (forall (a : Set.{u1} α), (Membership.mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.instMembershipSet.{u1} (Set.{u1} α)) a S) -> (HasSubset.Subset.{u1} (Set.{u1} α) (Set.instHasSubsetSet.{u1} α) a m) -> (Eq.{succ u1} (Set.{u1} α) a m))))
Case conversion may be inaccurate. Consider using '#align zorn_superset zorn_supersetₓ'. -/
/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (c «expr ⊆ » S) -/
theorem zorn_superset (S : Set (Set α))
    (h : ∀ (c) (_ : c ⊆ S), IsChain (· ⊆ ·) c → ∃ lb ∈ S, ∀ s ∈ c, lb ⊆ s) :
    ∃ m ∈ S, ∀ a ∈ S, a ⊆ m → a = m :=
  @zorn_partialOrder₀ (Set α)ᵒᵈ _ S fun c cS hc => h c cS hc.symm
#align zorn_superset zorn_superset

/- warning: zorn_superset_nonempty -> zorn_superset_nonempty is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} (S : Set.{u1} (Set.{u1} α)), (forall (c : Set.{u1} (Set.{u1} α)), (HasSubset.Subset.{u1} (Set.{u1} (Set.{u1} α)) (Set.hasSubset.{u1} (Set.{u1} α)) c S) -> (IsChain.{u1} (Set.{u1} α) (HasSubset.Subset.{u1} (Set.{u1} α) (Set.hasSubset.{u1} α)) c) -> (Set.Nonempty.{u1} (Set.{u1} α) c) -> (Exists.{succ u1} (Set.{u1} α) (fun (lb : Set.{u1} α) => Exists.{0} (Membership.Mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.hasMem.{u1} (Set.{u1} α)) lb S) (fun (H : Membership.Mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.hasMem.{u1} (Set.{u1} α)) lb S) => forall (s : Set.{u1} α), (Membership.Mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.hasMem.{u1} (Set.{u1} α)) s c) -> (HasSubset.Subset.{u1} (Set.{u1} α) (Set.hasSubset.{u1} α) lb s))))) -> (forall (x : Set.{u1} α), (Membership.Mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.hasMem.{u1} (Set.{u1} α)) x S) -> (Exists.{succ u1} (Set.{u1} α) (fun (m : Set.{u1} α) => Exists.{0} (Membership.Mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.hasMem.{u1} (Set.{u1} α)) m S) (fun (H : Membership.Mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.hasMem.{u1} (Set.{u1} α)) m S) => And (HasSubset.Subset.{u1} (Set.{u1} α) (Set.hasSubset.{u1} α) m x) (forall (a : Set.{u1} α), (Membership.Mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.hasMem.{u1} (Set.{u1} α)) a S) -> (HasSubset.Subset.{u1} (Set.{u1} α) (Set.hasSubset.{u1} α) a m) -> (Eq.{succ u1} (Set.{u1} α) a m))))))
but is expected to have type
  forall {α : Type.{u1}} (S : Set.{u1} (Set.{u1} α)), (forall (c : Set.{u1} (Set.{u1} α)), (HasSubset.Subset.{u1} (Set.{u1} (Set.{u1} α)) (Set.instHasSubsetSet.{u1} (Set.{u1} α)) c S) -> (IsChain.{u1} (Set.{u1} α) (fun (x._@.Mathlib.Order.Zorn._hyg.2674 : Set.{u1} α) (x._@.Mathlib.Order.Zorn._hyg.2676 : Set.{u1} α) => HasSubset.Subset.{u1} (Set.{u1} α) (Set.instHasSubsetSet.{u1} α) x._@.Mathlib.Order.Zorn._hyg.2674 x._@.Mathlib.Order.Zorn._hyg.2676) c) -> (Set.Nonempty.{u1} (Set.{u1} α) c) -> (Exists.{succ u1} (Set.{u1} α) (fun (lb : Set.{u1} α) => And (Membership.mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.instMembershipSet.{u1} (Set.{u1} α)) lb S) (forall (s : Set.{u1} α), (Membership.mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.instMembershipSet.{u1} (Set.{u1} α)) s c) -> (HasSubset.Subset.{u1} (Set.{u1} α) (Set.instHasSubsetSet.{u1} α) lb s))))) -> (forall (x : Set.{u1} α), (Membership.mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.instMembershipSet.{u1} (Set.{u1} α)) x S) -> (Exists.{succ u1} (Set.{u1} α) (fun (m : Set.{u1} α) => And (Membership.mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.instMembershipSet.{u1} (Set.{u1} α)) m S) (And (HasSubset.Subset.{u1} (Set.{u1} α) (Set.instHasSubsetSet.{u1} α) m x) (forall (a : Set.{u1} α), (Membership.mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.instMembershipSet.{u1} (Set.{u1} α)) a S) -> (HasSubset.Subset.{u1} (Set.{u1} α) (Set.instHasSubsetSet.{u1} α) a m) -> (Eq.{succ u1} (Set.{u1} α) a m))))))
Case conversion may be inaccurate. Consider using '#align zorn_superset_nonempty zorn_superset_nonemptyₓ'. -/
/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (c «expr ⊆ » S) -/
theorem zorn_superset_nonempty (S : Set (Set α))
    (H : ∀ (c) (_ : c ⊆ S), IsChain (· ⊆ ·) c → c.Nonempty → ∃ lb ∈ S, ∀ s ∈ c, lb ⊆ s) (x)
    (hx : x ∈ S) : ∃ m ∈ S, m ⊆ x ∧ ∀ a ∈ S, a ⊆ m → a = m :=
  @zorn_nonempty_partialOrder₀ (Set α)ᵒᵈ _ S (fun c cS hc y yc => H _ cS hc.symm ⟨y, yc⟩) _ hx
#align zorn_superset_nonempty zorn_superset_nonempty

#print IsChain.exists_maxChain /-
/-- Every chain is contained in a maximal chain. This generalizes Hausdorff's maximality principle.
-/
theorem IsChain.exists_maxChain (hc : IsChain r c) : ∃ M, @IsMaxChain _ r M ∧ c ⊆ M :=
  by
  obtain ⟨M, ⟨_, hM₀⟩, hM₁, hM₂⟩ :=
    zorn_subset_nonempty { s | c ⊆ s ∧ IsChain r s } _ c ⟨subset.rfl, hc⟩
  · exact ⟨M, ⟨hM₀, fun d hd hMd => (hM₂ _ ⟨hM₁.trans hMd, hd⟩ hMd).symm⟩, hM₁⟩
  rintro cs hcs₀ hcs₁ ⟨s, hs⟩
  refine'
    ⟨⋃₀ cs, ⟨fun _ ha => Set.mem_unionₛ_of_mem ((hcs₀ hs).left ha) hs, _⟩, fun _ =>
      Set.subset_unionₛ_of_mem⟩
  rintro y ⟨sy, hsy, hysy⟩ z ⟨sz, hsz, hzsz⟩ hyz
  obtain rfl | hsseq := eq_or_ne sy sz
  · exact (hcs₀ hsy).right hysy hzsz hyz
  cases' hcs₁ hsy hsz hsseq with h h
  · exact (hcs₀ hsz).right (h hysy) hzsz hyz
  · exact (hcs₀ hsy).right hysy (h hzsz) hyz
#align is_chain.exists_max_chain IsChain.exists_maxChain
-/