import Mathlib.Data.Nat.Basic
import Mathlib.Init.Algebra.Order
import Mathlib.Init.Data.Nat.Basic
import Mathlib.Init.Data.Nat.Lemmas
import Mathlib.Init.Data.Int.Basic
import Mathlib.Data.String.Defs
import Mathlib.Data.String.Lemmas
import Mathlib.Data.Equiv.Basic
import Timelib.Util
import Timelib.Date.ScalarDate
import Timelib.Date.Convert
import Timelib.NanoPrecision.Duration.SignedDuration
import Timelib.NanoPrecision.Duration.UnsignedDuration
import Timelib.NanoPrecision.ClockTime.NaiveClockTime

/--
If nonnegative, the number of nanoseconds since the epoch (midnight of 0001/Jan/01)
If negative, the number of nanoseconds until the epoch (midnight of 0001/Jan/01)
-/
structure TaiDateTime where
  nanos : Int
deriving DecidableEq, Ord, Repr

instance : Inhabited TaiDateTime where
  default := ⟨0⟩

/-
Using `Int.fdiv`, because we have a positive denominator, and we want to round
down if `dt.nanos` is negative, up if it's nonnegative.
-/
def TaiDateTime.toScalarDate (dt : TaiDateTime) : ScalarDate := ⟨(dt.nanos.fdiv oneDayNanos) + 1⟩

def TaiDateTime.dayOfWeek (dt : TaiDateTime) : Int := dt.toScalarDate.dayOfWeek

/--
The `DateTime` as of midnight (00:00:00 uninterpreted) on the ymd.
We subtract one to account for the fact that `Date` is one day ahead of the zero-based `TaiDateTime`.
-/
def TaiDateTime.fromYmd
  (y : Year)
  (m : Month)
  (d : Nat)
  (hd : 1 <= d ∧ d <= m.numDays y := by decide) : TaiDateTime :=
    ⟨oneDayNanos * ((Ymd.mk y m d hd.left hd.right).toScalarDate.day - 1)⟩

def TaiDateTime.fromYmdsn
  (y : Year)
  (m : Month)
  (d : Nat)
  (s : Nat)
  (n : Nat)
  (hd : 1 <= d ∧ d <= m.numDays y := by decide) : TaiDateTime :=
    ⟨(TaiDateTime.fromYmd y m d hd).nanos + (oneSecondNanos * s) + n⟩

instance : Equiv Int TaiDateTime where
  toFun := TaiDateTime.mk
  invFun := TaiDateTime.nanos
  left_inv := by simp [Function.LeftInverse]
  right_inv := by simp [Function.LeftInverse, Function.RightInverse]

theorem TaiDateTime.eq_of_val_eq : ∀ {d1 d2 : TaiDateTime} (h : d1.nanos = d2.nanos), d1 = d2
| ⟨_⟩, _, rfl => rfl

theorem TaiDateTime.val_ne_of_ne : ∀ {d1 d2 : TaiDateTime} (h : d1 ≠ d2), d1.nanos ≠ d2.nanos
| ⟨x⟩, ⟨y⟩, h => by intro hh; apply h; exact congrArg TaiDateTime.mk hh

instance : LT TaiDateTime where
  lt := InvImage Int.lt TaiDateTime.nanos

instance : LE TaiDateTime where
  le := InvImage Int.le TaiDateTime.nanos

@[simp] theorem TaiDateTime.le_def (d₁ d₂ : TaiDateTime) : (d₁ <= d₂) = (d₁.nanos <= d₂.nanos) := rfl
@[simp] theorem TaiDateTime.lt_def (d₁ d₂ : TaiDateTime) : (d₁ < d₂) = (d₁.nanos < d₂.nanos) := rfl

instance instDecidableLETaiDateTime (d₁ d₂ : TaiDateTime) : Decidable (d₁ <= d₂) := inferInstanceAs (Decidable <| d₁.nanos <= d₂.nanos)
instance instDecidableLTTaiDateTime (d₁ d₂ : TaiDateTime) : Decidable (d₁ < d₂) := inferInstanceAs (Decidable <| d₁.nanos < d₂.nanos)

instance : LinearOrder TaiDateTime where
  le_refl (a) := le_refl a.nanos
  le_trans (a b c) := Int.le_trans
  lt_iff_le_not_le (a b) := Int.lt_iff_le_not_le
  le_antisymm (a b h1 h2) := by
    apply TaiDateTime.eq_of_val_eq
    exact le_antisymm h1 h2
  le_total := by simp [TaiDateTime.le_def, le_total]
  decidable_le := inferInstance

def TaiDateTime.seconds (d : TaiDateTime) : Int := d.nanos / oneSecondNanos

def TaiDateTime.fromNanos : Int → TaiDateTime := TaiDateTime.mk

def TaiDateTime.toYmd (d : TaiDateTime) : Ymd := d.toScalarDate.toYmd

def TaiDateTime.year (d : TaiDateTime) : Year := d.toScalarDate.year

instance : ToString TaiDateTime where
  toString dt :=
    let ⟨y, m, d, _, _⟩ := dt.toYmd
    let t : String := ToString.toString <| NaiveClockTime.mk (Fin.ofInt'' (dt.nanos % (↑oneDayNanos)))
    s!"{y}/{m.toNat}/{d}; {t}"

@[reducible]
def TaiDateTime.dateEq : TaiDateTime → TaiDateTime → Prop
| n₁, n₂ => n₁.toScalarDate = n₂.toScalarDate

def TaiDateTime.dateEq.Equivalence : Equivalence TaiDateTime.dateEq := {
  refl := fun _ => rfl
  symm := fun h => h.symm
  trans := fun h h' => Eq.trans h h'
}

instance instTaiDateTimeSetoid : Setoid TaiDateTime :=
  ⟨TaiDateTime.dateEq, TaiDateTime.dateEq.Equivalence⟩

instance (d₁ d₂ : TaiDateTime) : Decidable <| d₁.dateEq d₂ := inferInstance

instance {n : Nat} : OfNat TaiDateTime n where
  ofNat := ⟨n⟩

instance : HAdd TaiDateTime SignedDuration TaiDateTime where
  hAdd da du := ⟨da.nanos + du.val⟩

instance : HAdd SignedDuration TaiDateTime TaiDateTime where
  hAdd du da := da + du

theorem TaiDateTime.hAdd_signed_def (d : TaiDateTime) (dur : SignedDuration) : d + dur = ⟨d.nanos + dur.val⟩ := rfl
theorem TaiDateTime.hAdd_signed_def_rev (d : TaiDateTime) (dur : SignedDuration) : dur + d = ⟨d.nanos + dur.val⟩ := rfl

instance : HSub TaiDateTime SignedDuration TaiDateTime where
  hSub t dur := t + -dur

theorem TaiDateTime.hSub_signed_def (d : TaiDateTime) (dur : SignedDuration) : d - dur = d + -dur := rfl

theorem TaiDateTime.hAdd_signed_sub_cancel (t : TaiDateTime) (d : SignedDuration) : t + d - d = t := by
  apply TaiDateTime.eq_of_val_eq
  simp [TaiDateTime.hSub_signed_def, TaiDateTime.hAdd_signed_def]
  apply Int.add_neg_cancel_right

theorem TaiDateTime.hAdd_signed_sub_add_cancel (t : TaiDateTime) (d : SignedDuration) : t - d + d = t := by
  simp [TaiDateTime.hSub_signed_def, TaiDateTime.hAdd_signed_def]
  exact TaiDateTime.eq_of_val_eq (Int.sub_add_cancel t.nanos d.val)

theorem TaiDateTime.hAdd_signed_comm (t : TaiDateTime) (d : SignedDuration) : t + d = d + t := by
  simp [TaiDateTime.hAdd_signed_def, TaiDateTime.hAdd_signed_def_rev]

instance : HAdd TaiDateTime UnsignedDuration TaiDateTime where
  hAdd da du := ⟨da.nanos + du.val⟩

instance : HAdd UnsignedDuration TaiDateTime TaiDateTime where
  hAdd du da := da + du

theorem TaiDateTime.hAdd_unsigned_def (d : TaiDateTime) (dur : UnsignedDuration) : d + dur = ⟨d.nanos + dur.val⟩ := rfl

instance : HSub TaiDateTime UnsignedDuration TaiDateTime where
  hSub da du := ⟨da.nanos - du.val⟩

theorem TaiDateTime.hSub_unsigned_def (d : TaiDateTime) (dur : UnsignedDuration) : d - dur = ⟨d.nanos - dur.val⟩ := rfl

theorem TaiDateTime.hAdd_unsigned_sub_cancel (t : TaiDateTime) (d : UnsignedDuration) : t + d - d = t := TaiDateTime.hAdd_signed_sub_cancel t d

theorem TaiDateTime.hAdd_unsigned_sub_add_cancel (t : TaiDateTime) (d : UnsignedDuration) : t - d + d = t := TaiDateTime.hAdd_signed_sub_add_cancel t d

theorem TaiDateTime.hAdd_unsigned_comm (t : TaiDateTime) (d : UnsignedDuration) : t + d = d + t := TaiDateTime.hAdd_signed_comm t d

/--
Set the clock time of the current day to `tgt`.
-/
@[reducible]
def TaiDateTime.setClockTime (t : TaiDateTime) (clockTime : NaiveClockTime) : TaiDateTime :=
  let days := (t.nanos.fdiv oneDayNanos) * oneDayNanos
  ⟨days + clockTime.nanos.val⟩


import algebraic_geometry.points

open opposite topological_space category_theory category_theory.limits

noncomputable theory

namespace algebraic_geometry

namespace pullback

universe u

variables {X Y Z : Scheme.{u}} (f : X ⟶ Z) (g : Y ⟶ Z)

structure triplet :=
(x : X.carrier)
(y : Y.carrier)
(z : Z.carrier)
(hx : f.1.base x = z)
(hy : g.1.base y = z)
.
variables {f g} (T : triplet f g)

def triplet.residue_field_tensor : CommRing :=
pushout (Z.residue_field_of_eq T.hx ≫ f.map_residue_field T.x)
        (Z.residue_field_of_eq T.hy ≫ g.map_residue_field T.y)
.
def triplet.Spec_residue_field_tensor_to :
  Scheme.Spec.obj (op T.residue_field_tensor) ⟶ pullback f g :=
pullback.lift (Scheme.Spec.map pushout.inl.op ≫ X.from_Spec_residue_field T.x)
              (Scheme.Spec.map pushout.inr.op ≫ Y.from_Spec_residue_field T.y)
begin
  have := @pushout.condition _ _ _ _ _ (Z.residue_field_of_eq T.hx ≫ f.map_residue_field T.x)
    (Z.residue_field_of_eq T.hy ≫ g.map_residue_field T.y) _,
  replace this := congr_arg (λ f, Z.residue_field_of_eq T.hx.symm ≫ f) this,
  simp only [category.assoc, Scheme.residue_field_of_eq_trans_assoc,
    Scheme.residue_field_of_eq_refl, category.id_comp] at this,
  simp only [category.assoc, ← Scheme.hom.map_residue_field_from_Spec_residue_field,
    ← Scheme.Spec.map_comp_assoc, ← op_comp, this],
  rw [op_comp, functor.map_comp_assoc],
  congr' 1,
  generalize_proofs h,
  revert h,
  rw [T.hx, T.hy],
  simp only [Scheme.residue_field_of_eq_refl, category.id_comp, op_id,
    category_theory.functor.map_id, category.id_comp, eq_self_iff_true, forall_true_left]
end

@[simps]
def triplet_of_pullback (t : (pullback f g).carrier) : triplet f g :=
{ x := (pullback.fst : pullback f g ⟶ X).1.base t,
  y := (pullback.snd : pullback f g ⟶ Y).1.base t,
  z := (limit.π _ walking_cospan.one : pullback f g ⟶ Z).1.base t,
  hx := by { rw [limit.π, pullback_cone.condition_one (limit.cone (cospan f g))], refl },
  hy := by { rw [limit.π, pullback_cone.condition_one (limit.cone (cospan f g)),
    pullback_cone.condition], refl } }

.
def residue_field_tensor_of_pullback_to (t : (pullback f g).carrier) :
  (triplet_of_pullback t).residue_field_tensor ⟶ Scheme.residue_field _ t :=
pushout.desc
  ((pullback.fst : pullback f g ⟶ _).map_residue_field t)
  ((pullback.snd : pullback f g ⟶ _).map_residue_field t)
begin
  dsimp only [triplet_of_pullback_x, triplet_of_pullback_y],
  rw [category.assoc, category.assoc, ← Scheme.hom.map_residue_field_comp,
    ← Scheme.hom.map_residue_field_comp, Scheme.hom.map_residue_field_congr pullback.condition,
    Scheme.residue_field_of_eq_trans_assoc],
  refl
end

def residue_field_tensor_prime_ideal (t : (pullback f g).carrier) :
  prime_spectrum (triplet_of_pullback t).residue_field_tensor :=
prime_spectrum.comap (residue_field_tensor_of_pullback_to t) ⊥

lemma Spec_residue_field_tensor_of_pullback_to_comp (t : (pullback f g).carrier) :
  Scheme.Spec.map (residue_field_tensor_of_pullback_to t).op ≫
    (triplet_of_pullback t).Spec_residue_field_tensor_to =
    Scheme.from_Spec_residue_field _ t :=
begin
  apply pullback.hom_ext,
  { rw [category.assoc, triplet.Spec_residue_field_tensor_to, pullback.lift_fst,
      ← functor.map_comp_assoc, ← op_comp, residue_field_tensor_of_pullback_to,
      pushout.inl_desc, ← Scheme.hom.map_residue_field_from_Spec_residue_field], refl },
  { rw [category.assoc, triplet.Spec_residue_field_tensor_to, pullback.lift_snd,
      ← functor.map_comp_assoc, ← op_comp, residue_field_tensor_of_pullback_to,
      pushout.inr_desc, ← Scheme.hom.map_residue_field_from_Spec_residue_field], refl }
end

lemma residue_field_tensor_to_prime_ideal (t : (pullback f g).carrier) :
  (triplet_of_pullback t).Spec_residue_field_tensor_to.val.base
    (residue_field_tensor_prime_ideal t) = t :=
begin
  change (Scheme.Spec.map (residue_field_tensor_of_pullback_to t).op ≫
    (triplet_of_pullback t).Spec_residue_field_tensor_to).1.base _ = t,
  rw [Spec_residue_field_tensor_of_pullback_to_comp, Scheme.from_Spec_residue_field_base],
end

@[ext]
lemma triplet_ext {T₁ T₂ : triplet f g}
  (hx : T₁.x = T₂.x) (hy : T₁.y = T₂.y) : T₁ = T₂ :=
begin
  cases T₁, cases T₂, dsimp only at hx hy, substs hx hy T₁_hx T₂_hx
end

lemma triplet_ext_iff {T₁ T₂ : triplet f g} :
  T₁ = T₂ ↔ T₁.x = T₂.x ∧ T₁.y = T₂.y :=
begin
  split, { rintro rfl, exact ⟨rfl, rfl⟩ }, { intro h, exact triplet_ext h.1 h.2 }
end

def triplet.residue_field_tensor_of_eq {T₁ T₂ : triplet f g} (e : T₁ = T₂) :
  T₁.residue_field_tensor ⟶ T₂.residue_field_tensor :=
pushout.map _ _ _ _
  (X.residue_field_of_eq $ by subst e)
  (Y.residue_field_of_eq $ by subst e)
  (Z.residue_field_of_eq $ by subst e)
  (by { subst e, simp })
  (by { subst e, simp })
.
lemma triplet.residue_field_tensor_of_eq_eq_eq_to_hom
  {T₁ T₂ : triplet f g} (e : T₁ = T₂) :
  triplet.residue_field_tensor_of_eq e = eq_to_hom (by subst e) :=
by { subst e, apply pushout.hom_ext; simpa [triplet.residue_field_tensor_of_eq, -category.comp_id]
  using (category.comp_id _).symm }
.
@[simp, reassoc]
lemma triplet.residue_field_tensor_of_eq_trans
  {T₁ T₂ T₃ : triplet f g} (e : T₁ = T₂) (e' : T₂ = T₃) :
  triplet.residue_field_tensor_of_eq e ≫ triplet.residue_field_tensor_of_eq e' =
    triplet.residue_field_tensor_of_eq (e.trans e') :=
by simp only [triplet.residue_field_tensor_of_eq_eq_eq_to_hom, eq_to_hom_trans]

@[simp]
lemma triplet.residue_field_tensor_of_eq_id {T : triplet f g} :
  triplet.residue_field_tensor_of_eq (refl T) = 𝟙 _ :=
by simp only [triplet.residue_field_tensor_of_eq_eq_eq_to_hom, eq_to_hom_refl]

lemma triplet.of_pullback_tensor_to
  (T : triplet f g) (p : prime_spectrum T.residue_field_tensor) :
  triplet_of_pullback (T.Spec_residue_field_tensor_to.1.base p) = T :=
begin
  ext; dsimp,
  { rw [← Scheme.comp_val_base_apply, triplet.Spec_residue_field_tensor_to,
      pullback.lift_fst, Scheme.comp_val_base_apply, Scheme.from_Spec_residue_field_base] },
  { rw [← Scheme.comp_val_base_apply, triplet.Spec_residue_field_tensor_to,
      pullback.lift_snd, Scheme.comp_val_base_apply, Scheme.from_Spec_residue_field_base] },
end

lemma triplet.eq_from_Spec_residue_field_aux (x : X.carrier) (p) :
  Scheme.Spec.map (X.residue_field_of_eq (Scheme.from_Spec_residue_field_base x p) ≫
    (X.from_Spec_residue_field x).map_residue_field p).op =
  (Scheme.Spec.obj (op (X.residue_field x))).from_Spec_residue_field p :=
begin
  rw ← cancel_mono (X.from_Spec_residue_field x),
  rw [op_comp, functor.map_comp_assoc, Scheme.residue_field_of_eq_from_Spec,
    Scheme.hom.map_residue_field_from_Spec_residue_field],
end

lemma triplet.eq_from_Spec_residue_field (T : triplet f g)
  (p : prime_spectrum T.residue_field_tensor) :
  Scheme.Spec.map (triplet.residue_field_tensor_of_eq (T.of_pullback_tensor_to p).symm ≫
    residue_field_tensor_of_pullback_to _ ≫
    T.Spec_residue_field_tensor_to.map_residue_field p).op =
  Scheme.from_Spec_residue_field _ p :=
begin
  refine eq.trans _ (Scheme.Spec.image_preimage _),
  congr' 1,
  apply quiver.hom.unop_inj,
  apply pushout.hom_ext,
  { have : T.Spec_residue_field_tensor_to ≫ pullback.fst = _ := pullback.lift_fst _ _ _,
    simp only [residue_field_tensor_of_pullback_to,
      triplet.residue_field_tensor_of_eq, quiver.hom.unop_op,
      pushout.inl_desc_assoc, op_comp, category.assoc, unop_comp],
    apply quiver.hom.op_inj,
    apply Scheme.Spec.map_injective,
    rw [← Scheme.hom.map_residue_field_comp, Scheme.hom.map_residue_field_congr this,
      Scheme.residue_field_of_eq_trans_assoc],
    conv_rhs { rw [op_comp, functor.map_comp] },
    rw [quiver.hom.op_unop, functor.image_preimage],
    refine eq.trans _ (Scheme.hom.map_residue_field_from_Spec_residue_field _ _),
    rw [Scheme.hom.map_residue_field_comp, ← category.assoc, op_comp, functor.map_comp,
      ← triplet.eq_from_Spec_residue_field_aux],
    refl },
  { have : T.Spec_residue_field_tensor_to ≫ pullback.snd = _ := pullback.lift_snd _ _ _,
    simp only [residue_field_tensor_of_pullback_to,
      triplet.residue_field_tensor_of_eq, quiver.hom.unop_op,
      pushout.inr_desc_assoc, op_comp, category.assoc, unop_comp],
    apply quiver.hom.op_inj,
    apply Scheme.Spec.map_injective,
    rw [← Scheme.hom.map_residue_field_comp, Scheme.hom.map_residue_field_congr this,
      Scheme.residue_field_of_eq_trans_assoc],
    conv_rhs { rw [op_comp, functor.map_comp] },
    rw [quiver.hom.op_unop, functor.image_preimage],
    refine eq.trans _ (Scheme.hom.map_residue_field_from_Spec_residue_field _ _),
    rw [Scheme.hom.map_residue_field_comp, ← category.assoc, op_comp, functor.map_comp,
      ← triplet.eq_from_Spec_residue_field_aux],
    refl },
end
.
lemma carrier_equiv_eq
  {T₁ T₂ : Σ T : triplet f g, prime_spectrum T.residue_field_tensor} :
  T₁ = T₂ ↔ ∃ e : T₁.1 = T₂.1, prime_spectrum.comap
    (triplet.residue_field_tensor_of_eq e.symm) T₁.2 = T₂.2 :=
begin
  split,
  { rintro rfl, refine ⟨rfl, _⟩, rw triplet.residue_field_tensor_of_eq_id, ext, refl },
  { cases T₁, cases T₂, dsimp, rintro ⟨rfl, rfl⟩, congr' 1,
    rw triplet.residue_field_tensor_of_eq_id, ext, refl }
end

variables (f g)

def carrier_equiv :
  (pullback f g).carrier ≃ Σ T : triplet f g, prime_spectrum T.residue_field_tensor :=
{ to_fun := λ t, ⟨_, residue_field_tensor_prime_ideal t⟩,
  inv_fun := λ T, T.1.Spec_residue_field_tensor_to.1.base T.2,
  left_inv := residue_field_tensor_to_prime_ideal,
  right_inv :=
  begin
    rintro ⟨T, p⟩,
    apply carrier_equiv_eq.mpr ⟨_, _⟩; dsimp,
    { ext; dsimp only [triplet_of_pullback_x, triplet_of_pullback_y],
      { rw [← Scheme.comp_val_base_apply, triplet.Spec_residue_field_tensor_to,
          pullback.lift_fst, Scheme.comp_val_base_apply, Scheme.from_Spec_residue_field_base] },
      { rw [← Scheme.comp_val_base_apply, triplet.Spec_residue_field_tensor_to,
          pullback.lift_snd, Scheme.comp_val_base_apply, Scheme.from_Spec_residue_field_base] } },
    { delta residue_field_tensor_prime_ideal,
      have : prime_spectrum.comap (T.Spec_residue_field_tensor_to.map_residue_field p) ⊥ = ⊥ :=
        subsingleton.elim _ _,
      rw [← this, ← prime_spectrum.comap_comp_apply, ← prime_spectrum.comap_comp_apply],
      convert_to
        (Scheme.Spec.map (triplet.residue_field_tensor_of_eq _ ≫
          residue_field_tensor_of_pullback_to _ ≫
          T.Spec_residue_field_tensor_to.map_residue_field p).op).1.base _ = p,
      rw [triplet.eq_from_Spec_residue_field, Scheme.from_Spec_residue_field_base] }
  end }
.
instance {K M N : Type*} [field K] [add_comm_group M] [add_comm_group N] [module K M] [module K N]
  [nontrivial M] [nontrivial N] : nontrivial (tensor_product K M N) :=
begin
  obtain ⟨v, ⟨hv⟩⟩ := basis.exists_basis K M,
  obtain ⟨w, ⟨hw⟩⟩ := basis.exists_basis K N,
  haveI := hv.index_nonempty,
  haveI := hw.index_nonempty,
  exact ⟨⟨_, _, (hv.tensor_product hw).ne_zero (classical.arbitrary _)⟩⟩
end

lemma CommRing.pushout_nontrivial {A B C : CommRing.{u}} (hA : is_field A) (f : A ⟶ B) (g : A ⟶ C)
  [nontrivial B] [nontrivial C] : nontrivial.{u} (pushout f g : _) :=
begin
  delta pushout,
  apply_with (@@equiv.nontrivial (colimit.iso_colimit_cocone ⟨_, CommRing.pushout_cocone_is_colimit
    f g⟩).CommRing_iso_to_ring_equiv.to_equiv) { instances := ff },
  dsimp,
  letI := hA.to_field, letI := f.to_algebra, letI := g.to_algebra,
  apply_instance,
end

instance {R : Type*} [comm_ring R] [nontrivial R] : nonempty (prime_spectrum R) :=
⟨⟨_, (ideal.exists_maximal R).some_spec.is_prime⟩⟩

variables {f g}

lemma triplet.exists_preimage (T : triplet f g) :
  ∃ t : (pullback f g).carrier,
    (pullback.fst : _ ⟶ X).1.base t = T.x ∧ (pullback.snd : _ ⟶ Y).1.base t = T.y :=
begin
  haveI : nontrivial T.residue_field_tensor,
  { delta triplet.residue_field_tensor,
    exact CommRing.pushout_nontrivial (field.to_is_field (Z.residue_field T.z)) _ _ },
  obtain ⟨t, ht⟩ := (carrier_equiv f g).surjective ⟨T, classical.arbitrary _⟩,
  rw (show T = ((carrier_equiv f g) t).1, by rw ht),
  exact ⟨t, rfl, rfl⟩,
end

lemma range_fst :
  set.range (pullback.fst : pullback f g ⟶ X).1.base = f.1.base ⁻¹' set.range g.1.base :=
begin
  apply le_antisymm,
  { rintro _ ⟨y, rfl⟩,
    refine ⟨(pullback.snd : pullback f g ⟶ Y).1.base y, _⟩,
    rw [← Scheme.comp_val_base_apply, ← Scheme.comp_val_base_apply, pullback.condition] },
  { rintro x ⟨y, hxy⟩,
    obtain ⟨t, rfl : _ = x, -⟩ := triplet.exists_preimage ⟨x, y, _, hxy.symm, rfl⟩,
    exact ⟨_, rfl⟩ }
end

lemma range_snd :
  set.range (pullback.snd : pullback f g ⟶ Y).1.base = g.1.base ⁻¹' set.range f.1.base :=
begin
  apply le_antisymm,
  { rintro _ ⟨y, rfl⟩,
    refine ⟨(pullback.fst : pullback f g ⟶ X).1.base y, _⟩,
    rw [← Scheme.comp_val_base_apply, ← Scheme.comp_val_base_apply, pullback.condition] },
  { rintro x ⟨y, hxy⟩,
    obtain ⟨t, -, rfl : _ = x⟩ := triplet.exists_preimage ⟨y, x, _, hxy, rfl⟩,
    exact ⟨_, rfl⟩ }
end

lemma range_to_base :
    set.range (pullback.fst ≫ f : pullback f g ⟶ Z).1.base =
      set.range f.1.base ∩ set.range g.1.base :=
begin
  apply le_antisymm,
  { rintro _ ⟨x, rfl⟩,
    refine ⟨⟨_, rfl⟩, _⟩,
    rw pullback.condition,
    exact ⟨_, rfl⟩ },
  { rintro z ⟨⟨x, hx⟩, ⟨y, hy⟩⟩,
    obtain ⟨t, ht : _ = x, -⟩ := triplet.exists_preimage ⟨x, y, z, hx, hy⟩,
    substs hx ht,
    exact ⟨_, rfl⟩ }
end

lemma range_map {X Y S X' Y' S' : Scheme} (f : X ⟶ S) (g : Y ⟶ S) (f' : X' ⟶ S')
  (g' : Y' ⟶ S') (i₁ : X ⟶ X') (i₂ : Y ⟶ Y') (i₃ : S ⟶ S') (e₁ : f ≫ i₃ = i₁ ≫ f')
  (e₂ : g ≫ i₃ = i₂ ≫ g') [mono i₃] :
  set.range (pullback.map f g f' g' i₁ i₂ i₃ e₁ e₂).1.base =
  (pullback.fst : pullback f' g' ⟶ X').val.base ⁻¹' set.range i₁.val.base ∩
  (pullback.snd : pullback f' g' ⟶ Y').val.base ⁻¹' set.range i₂.val.base :=
begin
  simp only [pullback_map_eq_pullback_fst_fst_iso_inv, Scheme.comp_val_base, coe_comp],
  rw [set.range_comp, set.range_iff_surjective.mpr _, set.image_comp, set.image_univ,
    range_snd, set.image_preimage_eq_inter_range, range_fst, range_fst],
  exact (as_iso $ (Scheme.forget_to_Top ⋙ forget Top).map
    (pullback_fst_fst_iso f g f' g' i₁ i₂ i₃ e₁ e₂).inv).to_equiv.surjective,
end

end pullback

end algebraic_geometry


import combinatorics.simple_graph.coloring

--OUTPUT 1
theorem bipartite_graph_two_colorable {G : Type*} [graph G] :
  (∃ (V1 V2 : set G), ∀ (v1 v2 : G), (v1,v2) ∈ G → (v1 ∈ V1 ∧ v2 ∈ V2) ∨ (v1 ∈ V2 ∧ v2 ∈ V1)) ↔
  (∃ (V1 V2 : set G), ∀ (v1 v2 : G), (v1,v2) ∈ G → (v1 ∈ V1 ∧ v2 ∈ V2) ∨ (v1 ∈ V2 ∧ v2 ∈ V1)) :=
begin
  split,
  assume h1 : ∃ (V1 V2 : set G), ∀ (v1 v2 : G), (v1,v2) ∈ G → (v1 ∈ V1 ∧ v2 ∈ V2) ∨ (v1 ∈ V2 ∧ v2 ∈ V1),
  exact h1,
  assume h2 : ∃ (V1 V2 : set G), ∀ (v1 v2 : G), (v1,v2) ∈ G → (v1 ∈ V1 ∧ v2 ∈ V2) ∨ (v1 ∈ V2 ∧ v2 ∈ V1),
  exact h2,
end

--OUTPUT 2
theorem bipartite_iff_two_colorable {G : Type*} [graph G] : bipartite G ↔ two_colorable G :=
begin
  -- Let $G$ be a 2-colorable graph, which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color.
  have h1 : two_colorable G → bipartite G, from assume h2 : two_colorable G,
    -- Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue.
    have h3 : ∃ A B : set G.vertex, ∀ v : G.vertex, v ∈ A ∨ v ∈ B ∧ ∀ u v : G.vertex, u ∈ A ∧ v ∈ A → ¬ G.adj u v ∧ ∀ u v : G.vertex, u ∈ B ∧ v ∈ B → ¬ G.adj u v ∧ ∀ u v : G.vertex, u ∈ A ∧ v ∈ B → G.adj u v, from
      -- Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$.
      have h4 : ∃ A B : set G.vertex, ∀ v : G.vertex, v ∈ A ∨ v ∈ B ∧ ∀ u v : G.vertex, u ∈ A ∧ v ∈ A → ¬ G.adj u v ∧ ∀ u v : G.vertex, u ∈ B ∧ v ∈ B → ¬ G.adj u v, from
        -- This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.
        have h5 : ∃ A B : set G.vertex, ∀ v : G.vertex, v ∈ A ∨ v ∈ B ∧ ∀ u v : G.vertex, u ∈ A ∧ v ∈ A → ¬ G.adj u v ∧ ∀ u v : G.vertex, u ∈ B ∧ v ∈ B → ¬ G.adj u v ∧ ∀ u v : G.vertex, G.adj u v → u ∈ A ∧ v ∈ B ∨ u ∈ B ∧ v ∈ A, from
          -- Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue.
          have h6 : ∃ A B : set G.vertex, ∀ v : G.vertex, v ∈ A ∨ v ∈ B ∧ ∀ u v : G.vertex, u ∈ A ∧ v ∈ A → ¬ G.adj u v ∧ ∀ u v : G.vertex, u ∈ B ∧ v ∈ B → ¬ G.adj u v, from
            -- Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$.
            have h7 : ∃ A B : set G.vertex, ∀ v : G.vertex, v ∈ A ∨ v ∈ B ∧ ∀ u v : G.vertex, u ∈ A ∧ v ∈ A → ¬ G.adj u v ∧ ∀ u v : G.vertex, u ∈ B ∧ v ∈ B → ¬ G.adj u v ∧ ∀ u v : G.vertex, G.adj u v → u ∈ A ∧ v ∈ B ∨ u ∈ B ∧ v ∈ A, from
              -- Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue.
              have h8 : ∃ A B : set G.vertex, ∀ v : G.vertex, v ∈ A ∨ v ∈ B ∧ ∀ u v : G.vertex, u ∈ A ∧ v ∈ A → ¬ G.adj u v ∧ ∀ u v : G.vertex, u ∈ B ∧ v ∈ B → ¬ G.adj u v, from
                -- Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$.
                have h9 : ∃ A B : set G.vertex, ∀ v : G.vertex, v ∈ A ∨ v ∈ B ∧ ∀ u v : G.vertex, u ∈ A ∧ v ∈ A → ¬ G.adj u v ∧ ∀ u v : G.vertex, u ∈ B ∧ v ∈ B → ¬ G.adj u v ∧ ∀ u v : G.vertex, G.adj u v → u ∈ A ∧ v ∈ B ∨ u ∈ B ∧ v ∈ A, from
                  -- Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue.
                  have h10 : ∃ A B : set G.vertex, ∀ v : G.vertex, v ∈ A ∨ v ∈ B ∧ ∀ u v : G.vertex, u ∈ A ∧ v ∈ A → ¬ G.adj u v ∧ ∀ u v : G.vertex, u ∈ B ∧ v ∈ B → ¬ G.adj u v, from
                    -- Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$.
                    have h11 : ∃ A B : set G.vertex, ∀ v : G.vertex, v ∈ A ∨ v ∈ B ∧ ∀ u v : G.vertex, u ∈ A ∧ v ∈ A → ¬ G.adj u v ∧ ∀ u v : G.vertex, u ∈ B ∧ v ∈ B → ¬ G.adj u v ∧ ∀ u v : G.vertex, G.adj u v → u ∈ A ∧ v ∈ B ∨ u ∈ B ∧ v ∈ A, from
                      -- Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue.
                      have h12 : ∃ A B : set G.vertex, ∀ v : G.vertex, v ∈ A ∨ v ∈ B ∧ ∀ u v : G.vertex, u ∈ A ∧ v ∈ A → ¬ G.adj u v ∧ ∀ u v : G.vertex, u ∈ B ∧ v ∈ B → ¬ G.adj u v, from
                        -- Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$.
                        have h13 : ∃ A B : set G.vertex, ∀ v : G.vertex, v ∈ A ∨ v ∈ B ∧ ∀ u v : G.vertex, u ∈ A ∧ v ∈ A → ¬ G.adj u v ∧ ∀ u v : G.vertex, u ∈ B ∧ v ∈ B → ¬ G.adj u v ∧ ∀ u v : G.vertex, G.adj u v → u ∈ A ∧ v ∈ B ∨ u ∈ B ∧ v ∈ A, from
                          -- Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue.
                          have h14 : ∃ A B : set G.vertex, ∀ v : G.vertex, v ∈ A ∨ v ∈ B ∧ ∀ u v : G.vertex, u ∈ A ∧ v ∈ A → ¬ G.adj u v ∧ ∀ u v : G.vertex, u ∈ B ∧ v ∈ B → ¬ G.adj u v, from
                            -- Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$.
                            have h15 : ∃ A B : set G.vertex, ∀ v : G.vertex, v ∈ A ∨ v ∈ B ∧ ∀ u v : G.vertex, u ∈ A ∧ v ∈ A → ¬ G.adj u v ∧ ∀ u v : G.vertex, u ∈ B ∧ v ∈ B → ¬ G.adj u v ∧ ∀ u v : G.vertex, G
end --Needs more than 2000 tokens!

--OUTPUT 3
theorem bipartite_graph_two_colorable {G : Type*} [graph G] : two_colorable G ↔ bipartite G :=
begin
  -- Let $G$ be a 2-colorable graph, which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color.
  have h1 : two_colorable G → ∀ (red : set G) (blue : set G), (∀ a : G, a ∈ red ∨ a ∈ blue) ∧ (∀ a b : G, a ∈ red ∧ b ∈ red → ¬ (a,b) ∈ G.edges) ∧ (∀ a b : G, a ∈ blue ∧ b ∈ blue → ¬ (a,b) ∈ G.edges) → bipartite G, from by {
    assume h2colorable : two_colorable G,
    assume (red : set G) (blue : set G),
    assume hredblue : (∀ a : G, a ∈ red ∨ a ∈ blue) ∧ (∀ a b : G, a ∈ red ∧ b ∈ red → ¬ (a,b) ∈ G.edges) ∧ (∀ a b : G, a ∈ blue ∧ b ∈ blue → ¬ (a,b) ∈ G.edges),
    -- Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue.
    have hred : ∀ a : G, a ∈ red → a ∈ G.vertices, from by {
      assume a : G,
      assume hreda : a ∈ red,
      show a ∈ G.vertices, from by {
        have hredbluea : a ∈ red ∨ a ∈ blue, from by {apply hredblue.left,exact a},
        cases hredbluea,
        exact hreda,
        exact hredbluea,
      },
    },
    have hblue : ∀ a : G, a ∈ blue → a ∈ G.vertices, from by {
      assume a : G,
      assume hbluea : a ∈ blue,
      show a ∈ G.vertices, from by {
        have hredbluea : a ∈ red ∨ a ∈ blue, from by {apply hredblue.left,exact a},
        cases hredbluea,
        exact hredbluea,
        exact hbluea,
      },
    },
    -- Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$.
    have hredred : ∀ a b : G, a ∈ red ∧ b ∈ red → ¬ (a,b) ∈ G.edges, from by {
      assume a b : G,
      assume hredred : a ∈ red ∧ b ∈ red,
      show ¬ (a,b) ∈ G.edges, from by {
        apply hredblue.right.left,
        exact hredred,
      },
    },
    have hblueblue : ∀ a b : G, a ∈ blue ∧ b ∈ blue → ¬ (a,b) ∈ G.edges, from by {
      assume a b : G,
      assume hblueblue : a ∈ blue ∧ b ∈ blue,
      show ¬ (a,b) ∈ G.edges, from by {
        apply hredblue.right.right,
        exact hblueblue,
      },
    },
    -- This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.
    have hredblueedges : ∀ a b : G, (a,b) ∈ G.edges → a ∈ red ∧ b ∈ blue ∨ a ∈ blue ∧ b ∈ red, from by {
      assume a b : G,
      assume hredblueedges : (a,b) ∈ G.edges,
      show a ∈ red ∧ b ∈ blue ∨ a ∈ blue ∧ b ∈ red, from by {
        have hredbluea : a ∈ red ∨ a ∈ blue, from by {apply hredblue.left,exact a},
        have hredblueb : b ∈ red ∨ b ∈ blue, from by {apply hredblue.left,exact b},
        cases hredbluea,
        cases hredblueb,
        have hredred : a ∈ red ∧ b ∈ red, from by {split,exact hredbluea,exact hredblueb},
        have hredrededges : ¬ (a,b) ∈ G.edges, from by {apply hredred,exact hredred},
        contradiction,
        right,
        split,
        exact hredbluea,
        exact hredblueb,
        cases hredblueb,
        left,
        split,
        exact hredbluea,
        exact hredblueb,
        have hblueblue : a ∈ blue ∧ b ∈ blue, from by {split,exact hredbluea,exact hredblueb},
        have hblueblueedges : ¬ (a,b) ∈ G.edges, from by {apply hblueblue,exact hblueblue},
        contradiction,
      },
    },
    show bipartite G, from by {
      use red,
      use blue,
      split,
      exact hred,
      split,
      exact hblue,
      exact hredblueedges,
    },
  },

  -- Conversely, suppose $G$ is bipartite, that is, we can partition the vertices into two subsets $V_{1}, V_{2}$ every edge has one endpoint in $V_{1}$ and the other in $V_{2}$.
  have h2 : bipartite G → two_colorable G, from by {
    assume hbipartite : bipartite G,
    -- Then coloring every vertex of $V_{1}$ red and every vertex of $V_{2}$ blue yields a valid coloring, so $G$ is 2-colorable.
    have hredblue : ∀ a : G, a ∈ hbipartite.left ∨ a ∈ hbipartite.right, from by {
      assume a : G,
      show a ∈ hbipartite.left ∨ a ∈ hbipartite.right, from by {
        have hredblueedges : ∀ a b : G, (a,b) ∈ G.edges → a ∈ hbipartite.left ∧ b ∈ hbipartite.right ∨ a ∈ hbipartite.right ∧ b ∈ hbipartite.left, from by {
          assume a b : G,
          assume hredblueedges : (a,b) ∈ G.edges,
          show a ∈ hbipartite.left ∧ b ∈ hbipartite.right ∨ a ∈ hbipartite.right ∧ b ∈ hbipartite.left, from by {
            apply hbipartite.right.right,
            exact hredblueedges,
          },
        },
        have hredbluea : a ∈ hbipartite.left ∨ a ∈ hbipartite.right, from by {
          cases a,
          have hredblueedges : (a,a) ∈ G.edges, from by {apply G.self_loop,exact a},
          have hredbluea : a ∈ hbipartite.left ∧ a ∈ hbipartite.right ∨ a ∈ hbipartite.right ∧ a ∈ hbipartite.left, from by {apply hredblueedges,exact hredblueedges},
          cases hredbluea,
          left,
          exact hredbluea.left,
          right,
          exact hredbluea.right,
        },
        exact hredbluea,
      },
    },
    have hredred : ∀ a b : G, a ∈ hbipartite.left ∧ b ∈ hbipartite.left → ¬ (a,b) ∈ G.edges, from by
end --Needs more than 2000 tokens!

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  -- $A$ and $B$ are sets. $A$ and $B$ belong to power set of $S$
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  -- Then $A ⊆ S$ and $B ⊆ S$, by power set definition
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by {split,apply set.subset_of_mem_powerset,exact hA,apply set.subset_of_mem_powerset,exact hB},
  -- Then $(A ∩ B) ⊆ A$, by intersection of set is a subset
  have h2 : (A ∩ B) ⊆ A, from by apply set.inter_subset_left,
  -- Then $(A ∩ B) ⊆ S$, by subset relation is transitive
  have h3 : (A ∩ B) ⊆ S, from by {apply set.subset.trans h2 h1.left},
  -- Hence $(A ∩ B) ∈  𝒫 S$, by power set definition
  show (A ∩ B) ∈  𝒫 S, from by {apply set.mem_powerset h3},
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  -- expand the power
  calc (x + y)^2 = (x+y)*(x+y) : by rw sq
  -- distributive property of multiplication over addition gives:
  ... = x*(x+y) + y*(x+y) : by rw add_mul
  -- applying the above property further gives:
  ... = x*x + x*y + y*x + y*y : by {rw [mul_comm x (x+y),mul_comm y (x+y)], rw [add_mul,add_mul], ring}
  -- rearranging the terms using commutativity and adding gives:
  ... = x^2 + 2*x*y + y^2 : by {repeat {rw ← sq}, rw mul_comm y x, ring}
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  -- Group has Latin Square Property
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from by {
    assume a b : G, use a⁻¹ * b, obviously, },
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by {
    assume a b : G, use b * a⁻¹, obviously, },

  -- Setting $b = a$, this becomes:
  have h3 : ∀ a : G, ∃! x : G, a * x = a, from
    assume a : G, h1 a a,
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from
    assume a : G, h2 a a,

  -- These $x$ and $y$ are both $(1 : G)$, by definition of identity element
  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from assume a :G,
    exists_unique.unique (h3 a) (classical.some_spec (exists_unique.exists (h3 a)))
    (mul_one a),
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from assume a : G,
    exists_unique.unique (h4 a) (classical.some_spec (exists_unique.exists (h4 a))) (one_mul a),

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by {
    use (1 : G),
    have h7 : ∀ e : G, (∀ a : G, e * a = a ∧ a * e = a) → e = 1, from by {
      assume (e : G) (hident : ∀ a : G, e * a = a ∧ a * e = a),
      have h8 : ∀ a : G, e = classical.some (h3 a).exists, from assume (a : G),
        exists_unique.unique (h3 a) (hident a).right
        (classical.some_spec (exists_unique.exists (h3 a))),
      have h9 : ∀ a : G, e = classical.some (h4 a).exists, from assume (a : G),
        exists_unique.unique (h4 a) (hident a).left
        (classical.some_spec (exists_unique.exists (h4 a))),
      show e = (1 : G), from eq.trans (h9 e) (h6 _),
    },
    exact ⟨by obviously, h7⟩,
  }
end

/--`theorem`
Bipartite Graph is two colorable
Let $G$ be a graph. Then $G$ is 2-colorable if and only if $G$ is bipartite.
`proof`
Let $G$ be a 2-colorable graph, which means we can color every vertex either red or blue, and no edge will have both endpoints colored the same color. Let $A$ denote the subset of vertices colored red, and let $B$ denote the subset of vertices colored blue. Since all vertices of $A$ are red, there are no edges within $A$, and similarly for $B$. This implies that every edge has one endpoint in $A$ and the other in $B$, which means $G$ is bipartite.

Conversely, suppose $G$ is bipartite, that is, we can partition the vertices into two subsets $V_{1}, V_{2}$ every edge has one endpoint in $V_{1}$ and the other in $V_{2}$. Then coloring every vertex of $V_{1}$ red and every vertex of $V_{2}$ blue yields a valid coloring, so $G$ is 2-colorable.

QED

-/
theorem
FEW SHOT PROMPTS TO CODEX(END)-/


-- La_funcion_relacionP_es_inversa_por_la_derecha_de_la_funcion_cociente.lean
-- La función relacionP es inversa por la derecha de la función cociente
-- José A. Alonso Jiménez
-- Sevilla, 14 de octubre de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Demostrar que relacionP es inversa por la derecha de cociente.
-- ---------------------------------------------------------------------

import tactic

@[ext] structure particion (A : Type) :=
(Bloques    : set (set A))
(Hno_vacios : ∀ X ∈ Bloques, (X : set A).nonempty)
(Hrecubren  : ∀ a, ∃ X ∈ Bloques, a ∈ X)
(Hdisjuntos : ∀ X Y ∈ Bloques, (X ∩ Y : set A).nonempty → X = Y)

namespace particion

variable  {A : Type}
variables {X Y : set A}
variable  {P : particion A}
variable  (R : A → A → Prop)

def clase (a : A) :=
  {b : A | R b a}

def clases : (A → A → Prop) → set (set A) :=
  λ R, {B : set A | ∃ x : A, B = clase R x}

lemma pertenece_clase_syss
  {a b : A}
  : b ∈ clase R a ↔ R b a :=
by refl

lemma clases_no_vacias
  (hR: equivalence R)
  : ∀ (X : set A), X ∈ clases R → X.nonempty :=
begin
  rintros _ ⟨a, rfl⟩,
  use a,
  rw pertenece_clase_syss,
  apply hR.1,
end

lemma clases_recubren
  (hR: equivalence R)
  : ∀ a, ∃ X ∈ clases R, a ∈ X :=
begin
  intro a,
  use clase R a,
  split,
  { use a, },
  { exact hR.1 a, },
end

lemma subclase_si_pertenece
  {R : A → A → Prop}
  (hR: equivalence R)
  {a b : A}
  : a ∈ clase R b → clase R a ⊆ clase R b :=
λ hab z hza, hR.2.2 hza hab

lemma clases_iguales_si_pertenece
  {R : A → A → Prop}
  (hR: equivalence R)
  {a b : A}
  : a ∈ clase R b → clase R a = clase R b :=
λ hab, set.subset.antisymm
        (subclase_si_pertenece hR hab)
        (subclase_si_pertenece hR (hR.2.1 hab))

lemma clases_disjuntas
  (hR: equivalence R)
  : ∀ X Y ∈ clases R, (X ∩ Y : set A).nonempty → X = Y :=
begin
  rintros X ⟨a, rfl⟩ Y ⟨b, rfl⟩ ⟨c, hca, hcb⟩,
  exact clases_iguales_si_pertenece hR (hR.2.2 (hR.2.1 hca) hcb),
end

def cociente : {R : A → A → Prop // equivalence R} → particion A :=
  λ R, { Bloques    := {B : set A | ∃ x : A, B = clase R.1 x},
         Hno_vacios := clases_no_vacias R.1 R.2,
         Hrecubren  := clases_recubren R.1 R.2,
         Hdisjuntos := clases_disjuntas R.1 R.2, }

def relacion : (particion A) → (A → A → Prop) :=
  λ P a b, ∀ X ∈ Bloques P, a ∈ X → b ∈ X

lemma reflexiva
  (P : particion A)
  : reflexive (relacion P) :=
λ a X hXC haX, haX

lemma iguales_si_comun
  (hX : X ∈ Bloques P)
  (hY : Y ∈ Bloques P)
  {a : A}
  (haX : a ∈ X)
  (haY : a ∈ Y)
  : X = Y :=
Hdisjuntos P X hX Y hY ⟨a, haX, haY⟩

lemma pertenece_si_pertenece
  (hX : X ∈ Bloques P)
  (hY : Y ∈ Bloques P)
  {a b : A}
  (haX : a ∈ X)
  (haY : a ∈ Y)
  (hbX : b ∈ X)
  : b ∈ Y :=
begin
  convert hbX,
  exact iguales_si_comun hY hX haY haX,
end

lemma simetrica
  (P : particion A)
  : symmetric (relacion P) :=
begin
  intros a b h X hX hbX,
  obtain ⟨Y, hY, haY⟩ := Hrecubren P a,
  specialize h Y hY haY,
  exact pertenece_si_pertenece hY hX h hbX haY,
end

lemma transitiva
  (P : particion A)
  : transitive (relacion P) :=
λ a b c hab hbc X hX haX, hbc X hX (hab X hX haX)

def relacionP : particion A → {R : A → A → Prop // equivalence R} :=
  λ P, ⟨λ a b, ∀ X ∈ Bloques P, a ∈ X → b ∈ X,
        ⟨reflexiva P, simetrica P, transitiva P⟩⟩

-- 1ª demostración
example :
  function.right_inverse relacionP (@cociente A) :=
begin
  unfold function.right_inverse,
  unfold function.left_inverse,
  intro P,
  ext X,
  simp [cociente],
  split,
  { intro h,
    cases h with a ha,
    rw ha,
    rcases Hrecubren P a with ⟨X, hX, haX⟩,
    convert hX,
    ext b,
    rw pertenece_clase_syss,
    split,
    { intro hba,
      rcases Hrecubren P b with ⟨Y, hY, hbY⟩,
      specialize hba Y hY hbY,
      convert hbY,
      exact iguales_si_comun hX hY haX hba, },
    { intros hbX Y hY hbY,
      apply pertenece_si_pertenece hX hY hbX hbY haX, }},
  { intro hX,
    rcases Hno_vacios P X hX with ⟨a, ha⟩,
    use a,
    ext b,
    split,
    { intro hbX,
      rw pertenece_clase_syss,
      intros Y hY hbY,
      exact pertenece_si_pertenece hX hY hbX hbY ha, },
    { rw pertenece_clase_syss,
      intro hba,
      rcases Hrecubren P b with ⟨Y, hY, hbY⟩,
      specialize hba Y hY hbY,
      exact pertenece_si_pertenece hY hX hba ha hbY, }}
end

-- 2ª demostración
lemma inversa_dcha :
  function.right_inverse relacionP (@cociente A) :=
begin
  intro P,
  ext X,
  show (∃ (a : A), X = clase _ a) ↔ X ∈ Bloques P,
  split,
  { rintro ⟨a, rfl⟩,
    obtain ⟨X, hX, haX⟩ := Hrecubren P a,
    convert hX,
    ext b,
    rw pertenece_clase_syss,
    split,
    { intro hba,
      obtain ⟨Y, hY, hbY⟩ := Hrecubren P b,
      specialize hba Y hY hbY,
      convert hbY,
      exact iguales_si_comun hX hY haX hba, },
    { intros hbX Y hY hbY,
      apply pertenece_si_pertenece hX hY hbX hbY haX, }},
  { intro hX,
    rcases Hno_vacios P X hX with ⟨a, ha⟩,
    use a,
    ext b,
    split,
    { intro hbX,
      rw pertenece_clase_syss,
      intros Y hY hbY,
      exact pertenece_si_pertenece hX hY hbX hbY ha, },
    { rw pertenece_clase_syss,
      intro hba,
      obtain ⟨Y, hY, hbY⟩ := Hrecubren P b,
      specialize hba Y hY hbY,
      exact pertenece_si_pertenece hY hX hba ha hbY, }}
end

end particion


import .lovelib

/-! # LoVe Demo 6: Monads

We take a look at an important functional programming abstraction: monads.
Monads generalize computation with side effects. Haskell has shown that monads
can be used very successful to write imperative programs. For us, they are
interesting in three ways:

* They are a useful concept in their own right.

* They provide a nice example of axiomatic reasoning.

* They are useful for programming Lean itself (metaprogramming). -/

set_option pp.beta true

namespace LoVe

/-! ## Introductory Example

Consider the following programming task:

    Implement a function `sum_2_5_7 ns` that sums up the second, fifth, and
    seventh items of a list `ns` of natural numbers. Use `option ℕ` for the
    result so that if the list has fewer than seven elements, you can return
    `option.none`.

A straightforward solution follows: -/

def sum_2_5_7 (ns : list ℕ) : option ℕ :=
match list.nth ns 1 with
| option.none    := option.none
| option.some n2 :=
  match list.nth ns 4 with
  | option.none    := option.none
  | option.some n5 :=
    match list.nth ns 6 with
    | option.none    := option.none
    | option.some n7 := option.some (n2 + n5 + n7)
    end
  end
end

/-! The code is ugly, because of all the pattern matching on options.

We can put all the ugliness in one function, which we call `bind_opt`: -/

def bind_opt {α : Type} {β : Type} :
  option α → (α → option β) → option β
| option.none     _ := option.none
| (option.some a) f := f a

def sum_2_5_7₂ (ns : list ℕ) : option ℕ :=
bind_opt (list.nth ns 1)
  (λn2, bind_opt (list.nth ns 4)
     (λn5, bind_opt (list.nth ns 6)
        (λn7, option.some (n2 + n5 + n7))))

/-! Instead of defining `bind_opt` ourselves, we can use Lean's predefined
general `bind` operation. We can also use `pure` instead of `option.some`: -/

#check @bind

def sum_2_5_7₃ (ns : list ℕ) : option ℕ :=
bind (list.nth ns 1)
  (λn2, bind (list.nth ns 4)
     (λn5, bind (list.nth ns 6)
        (λn7, pure (n2 + n5 + n7))))

/-! Syntactic sugar:

    `ma >>= f` := `bind ma f` -/

#check (>>=)

def sum_2_5_7₄ (ns : list ℕ) : option ℕ :=
list.nth ns 1 >>=
  λn2, list.nth ns 4 >>=
    λn5, list.nth ns 6 >>=
      λn7, pure (n2 + n5 + n7)

/-! Syntactic sugar:

    `do a ← ma, t` := `ma >>= (λa, t)`
    `do ma, t`     := `ma >>= (λ_, t)` -/

def sum_2_5_7₅ (ns : list ℕ) : option ℕ :=
do n2 ← list.nth ns 1,
  do n5 ← list.nth ns 4,
    do n7 ← list.nth ns 6,
      pure (n2 + n5 + n7)

/-! The `do`s can be combined: -/

def sum_2_5_7₆ (ns : list ℕ) : option ℕ :=
do
  n2 ← list.nth ns 1,
  n5 ← list.nth ns 4,
  n7 ← list.nth ns 6,
  pure (n2 + n5 + n7)

/-! Although the notation has an imperative flavor, the function is a pure
functional program.

## Two Operations and Three Laws

The `option` type constructor is an example of a monad.

In general, a __monad__ is a type constructor `m` that depends on some type
parameter `α` (i.e., `m α`) equipped with two distinguished operations:

    `pure {α : Type} : α → m α`
    `bind {α β : Type} : m α → (α → m β) → m β`

For `option`:

    `pure` := `option.some`
    `bind` := `bind_opt`

Intuitively, we can think of a monad as a "box":

* `pure` puts the data into the box.

* `bind` allows us to access the data in the box and modify it (possibly even
  changing its type, since the result is an `m β` monad, not a `m α` monad).

There is no general way to extract the data from the monad, i.e., to obtain an
`α` from an `m α`.

To summarize, `pure a` provides no side effect and simply provides a box
containing the the value `a`, whereas `bind ma f` (also written `ma >>= f`)
executes `ma`, then executes `f` with the boxed result `a` of `ma`.

The option monad is only one instance among many.

Type         | Effect
------------ | --------------------------------------------------------------
`id α`       | no effect
`option α`   | simple exceptions
`σ → α × σ`  | threading through a state of type `σ`
`set α`      | nondeterministic computation returning `α` values
`t → α`      | reading elements of type `t` (e.g., a configuration)
`ℕ × α`      | adjoining running time (e.g., to model algorithmic complexity)
`string × α` | adjoining text output (e.g., for logging)
`prob α`     | probability (e.g., using random number generators)
`io α`       | interaction with the operating system
`tactic α`   | interaction with the proof assistant

All of the above are type constructors `m` are parameterized by a type `α`.

Some effects can be combined (e.g., `option (t → α)`).

Some effects are not executable (e.g., `set α`, `prob α`). They are nonetheless
useful for modeling programs abstractly in the logic.

Specific monads may provide a way to extract the boxed value stored in the monad
without `bind`'s requirement of putting it back in a monad.

Monads have several benefits, including:

* They provide the convenient and highly readable `do` notation.

* They support generic operations, such as
  `mmap {α β : Type} : (α → m β) → list α → m (list β)`, which work uniformly
  across all monads.

The `bind` and `pure` operations are normally required to obey three laws,
called the monad laws. Pure data as the first program can be simplified away:

    do
      a' ← pure a,
      f a'
  =
    f a

Pure data as the second program can be simplified away:

    do
      a ← x,
      pure a
  =
    x

Nested programs `x`, `f`, `g` can be linearized using this associativity rule:

    do
      b ← do {
        a ← x,
        f a },
      g b
  =
    do
      a ← x,
      b ← f a,
      g b

## A Type Class of Monads

Monads are a mathematical structure, so we use class to add them as a type class
(lecture 12). We can think of a type class as a structure that is parameterized
by a type—or here, by a type constructor `m : Type → Type`. -/

@[class] structure lawful_monad (m : Type → Type)
  extends has_bind m, has_pure m : Type 1 :=
(pure_bind {α β : Type} (a : α) (f : α → m β) :
   (pure a >>= f) = f a)
(bind_pure {α : Type} (ma : m α) :
   (ma >>= pure) = ma)
(bind_assoc {α β γ : Type} (f : α → m β) (g : β → m γ)
     (ma : m α) :
   ((ma >>= f) >>= g) = (ma >>= (λa, f a >>= g)))

#print monad
#print is_lawful_monad

/-! Step by step:

* We are creating a structure parameterized by a unary type constructor `m`.

* The structure inherits the fields, and any syntactic sugar, from structures
  called `has_bind` and `has_pure`, which provide the `bind` and `pure`
  operations on `m` and some syntactic sugar.

* `Type 1` is necessary for reasons that will become clear in lecture 11.

* The definition adds three fields to those already provided by `has_bind` and
  `has_pure`, to store the proofs of the monad laws.

To instantiate this definition with a concrete monad, we must supply the type
constructor `m` (e.g., `option`), `bind` and `pure` operators, and
proofs of the monad laws.

(Lean's actual definition of monads is more complicated.)

## Identity -/

#check id

def id.pure {α : Type} : α → id α :=
id

def id.bind {α β : Type} : id α → (α → id β) → id β
| a f := f a

@[instance] def id.lawful_monad : lawful_monad (@id Type) :=
{ pure       := @id.pure,
  bind       := @id.bind,
  pure_bind  :=
    begin
      intros α β a f,
      refl
    end,
  bind_pure  :=
    begin
      intros α m,
      refl
    end,
  bind_assoc :=
    begin
      intros α β γ f g m,
      refl
    end
}

/-! ## Exceptions -/

def option.pure {α : Type} : α → option α :=
option.some

def option.bind {α β : Type} :
  option α → (α → option β) → option β
| option.none     f := option.none
| (option.some a) f := f a

@[instance] def option.lawful_monad : lawful_monad option :=
{ pure       := @option.pure,
  bind       := @option.bind,
  pure_bind  :=
    begin
      intros α β a f,
      refl
    end,
  bind_pure  :=
    begin
      intros α m,
      cases m,
      { refl },
      { refl }
    end,
  bind_assoc :=
    begin
      intros α β γ f g m,
      cases m,
      { refl },
      { refl }
    end }

def option.throw {α : Type} : option α :=
option.none

def option.catch {α : Type} :
  option α → option α → option α
| option.none     ma' := ma'
| (option.some a) _   := option.some a

@[instance] def option.has_orelse : has_orelse option :=
{ orelse := @option.catch }

/-! ## Mutable State -/

def action (σ α : Type) :=
σ → α × σ

def action.read {σ : Type} : action σ σ
| s := (s, s)

def action.write {σ : Type} (s : σ) : action σ unit
| _ := ((), s)

def action.pure {σ α : Type} (a : α) : action σ α
| s := (a, s)

def action.bind {σ : Type} {α β : Type} (ma : action σ α)
    (f : α → action σ β) :
  action σ β
| s :=
  match ma s with
  | (a, s') := f a s'
  end

@[instance] def action.lawful_monad {σ : Type} :
  lawful_monad (action σ) :=
{ pure       := @action.pure σ,
  bind       := @action.bind σ,
  pure_bind  :=
    begin
      intros α β a f,
      apply funext,
      intro s,
      refl
    end,
  bind_pure  :=
    begin
      intros α m,
      apply funext,
      intro s,
      simp [action.bind],
      cases m s,
      refl
    end,
  bind_assoc :=
    begin
      intros α β γ f g m,
      apply funext,
      intro s,
      simp [action.bind],
      cases m s,
      refl
    end }

def diff_list : list ℕ → action ℕ (list ℕ)
| []        := pure []
| (n :: ns) :=
  do
    prev ← action.read,
    if n < prev then
      diff_list ns
    else
      do
        action.write n,
        ns' ← diff_list ns,
        pure (n :: ns')

#eval diff_list [1, 2, 3, 2] 0
#eval diff_list [1, 2, 3, 2, 4, 5, 2] 0

/-! ## Nondeterminism -/

#check set

def set.pure {α : Type} : α → set α
| a := {a}

def set.bind {α β : Type} : set α → (α → set β) → set β
| A f := {b | ∃a, a ∈ A ∧ b ∈ f a}

@[instance] def set.lawful_monad : lawful_monad set :=
{ pure       := @set.pure,
  bind       := @set.bind,
  pure_bind  :=
    begin
      intros α β a f,
      simp [set.pure, set.bind]
    end,
  bind_pure  :=
    begin
      intros α m,
      simp [set.pure, set.bind]
    end,
  bind_assoc :=
    begin
      intros α β γ f g m,
      simp [set.pure, set.bind],
      apply set.ext,
      simp,
      tautology
    end }

/-! `tautology` performs elimination of the logical symbols `∧`, `∨`, `↔`, and
`∃` in hypotheses and introduction of `∧`, `↔`, and `∃` in the conclusion, until
all the emerging subgoals can be trivially proved (e.g., by `refl`).

## A Generic Algorithm: Iteration over a List -/

def mmap {m : Type → Type} [lawful_monad m] {α β : Type}
    (f : α → m β) :
  list α → m (list β)
| []        := pure []
| (a :: as) :=
  do
    b ← f a,
    bs ← mmap as,
    pure (b :: bs)

lemma mmap_append {m : Type → Type} [lawful_monad m]
    {α β : Type} (f : α → m β) :
  ∀as as' : list α, mmap f (as ++ as') =
    do
      bs ← mmap f as,
      bs' ← mmap f as',
      pure (bs ++ bs')
| []        _   :=
  by simp [mmap, lawful_monad.bind_pure, lawful_monad.pure_bind]
| (a :: as) as' :=
  by simp [mmap, mmap_append as as', lawful_monad.pure_bind,
    lawful_monad.bind_assoc]

def nths {α : Type} (xss : list (list α)) (n : ℕ) :
  option (list α) :=
mmap (λxs, list.nth xs n) xss

#eval nths
  [[11, 12, 13, 14],
   [21, 22, 23],
   [31, 32, 33]] 2

end LoVe


/-
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, Yaël Dillies
-/
import order.partial_sups

/-!
# Consecutive differences of sets

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

This file defines the way to make a sequence of elements into a sequence of disjoint elements with
the same partial sups.

For a sequence `f : ℕ → α`, this new sequence will be `f 0`, `f 1 \ f 0`, `f 2 \ (f 0 ⊔ f 1)`.
It is actually unique, as `disjointed_unique` shows.

## Main declarations

* `disjointed f`: The sequence `f 0`, `f 1 \ f 0`, `f 2 \ (f 0 ⊔ f 1)`, ....
* `partial_sups_disjointed`: `disjointed f` has the same partial sups as `f`.
* `disjoint_disjointed`: The elements of `disjointed f` are pairwise disjoint.
* `disjointed_unique`: `disjointed f` is the only pairwise disjoint sequence having the same partial
  sups as `f`.
* `supr_disjointed`: `disjointed f` has the same supremum as `f`. Limiting case of
  `partial_sups_disjointed`.

We also provide set notation variants of some lemmas.

## TODO

Find a useful statement of `disjointed_rec_succ`.

One could generalize `disjointed` to any locally finite bot preorder domain, in place of `ℕ`.
Related to the TODO in the module docstring of `order.partial_sups`.
-/

variables {α β : Type*}

section generalized_boolean_algebra
variables [generalized_boolean_algebra α]

/-- If `f : ℕ → α` is a sequence of elements, then `disjointed f` is the sequence formed by
subtracting each element from the nexts. This is the unique disjoint sequence whose partial sups
are the same as the original sequence. -/
def disjointed (f : ℕ → α) : ℕ → α
| 0       := f 0
| (n + 1) := f (n + 1) \ (partial_sups f n)

@[simp] lemma disjointed_zero (f : ℕ → α) : disjointed f 0 = f 0 := rfl

lemma disjointed_succ (f : ℕ → α) (n : ℕ) :
  disjointed f (n + 1) = f (n + 1) \ (partial_sups f n) :=
rfl

lemma disjointed_le_id : disjointed ≤ (id : (ℕ → α) → ℕ → α) :=
begin
  rintro f n,
  cases n,
  { refl },
  { exact sdiff_le }
end

lemma disjointed_le (f : ℕ → α) : disjointed f ≤ f := disjointed_le_id f

lemma disjoint_disjointed (f : ℕ → α) : pairwise (disjoint on disjointed f) :=
begin
  refine (symmetric.pairwise_on disjoint.symm _).2 (λ m n h, _),
  cases n,
  { exact (nat.not_lt_zero _ h).elim },
  exact disjoint_sdiff_self_right.mono_left ((disjointed_le f m).trans
    (le_partial_sups_of_le f (nat.lt_add_one_iff.1 h))),
end

/-- An induction principle for `disjointed`. To define/prove something on `disjointed f n`, it's
enough to define/prove it for `f n` and being able to extend through diffs. -/
def disjointed_rec {f : ℕ → α} {p : α → Sort*} (hdiff : ∀ ⦃t i⦄, p t → p (t \ f i)) :
  ∀ ⦃n⦄, p (f n) → p (disjointed f n)
| 0       := id
| (n + 1) := λ h,
  begin
    suffices H : ∀ k, p (f (n + 1) \ partial_sups f k),
    { exact H n },
    rintro k,
    induction k with k ih,
    { exact hdiff h },
    rw [partial_sups_succ, ←sdiff_sdiff_left],
    exact hdiff ih,
  end

@[simp] lemma disjointed_rec_zero {f : ℕ → α} {p : α → Sort*} (hdiff : ∀ ⦃t i⦄, p t → p (t \ f i))
  (h₀ : p (f 0)) :
  disjointed_rec hdiff h₀ = h₀ := rfl

-- TODO: Find a useful statement of `disjointed_rec_succ`.

lemma monotone.disjointed_eq {f : ℕ → α} (hf : monotone f) (n : ℕ) :
  disjointed f (n + 1) = f (n + 1) \ f n :=
by rw [disjointed_succ, hf.partial_sups_eq]

@[simp] lemma partial_sups_disjointed (f : ℕ → α) :
  partial_sups (disjointed f) = partial_sups f :=
begin
  ext n,
  induction n with k ih,
  { rw [partial_sups_zero, partial_sups_zero, disjointed_zero] },
  { rw [partial_sups_succ, partial_sups_succ, disjointed_succ, ih, sup_sdiff_self_right] }
end

/-- `disjointed f` is the unique sequence that is pairwise disjoint and has the same partial sups
as `f`. -/
lemma disjointed_unique {f d : ℕ → α} (hdisj : pairwise (disjoint on d))
  (hsups : partial_sups d = partial_sups f) : d = disjointed f :=
begin
  ext n,
  cases n,
  { rw [←partial_sups_zero d, hsups, partial_sups_zero, disjointed_zero] },
  suffices h : d n.succ = partial_sups d n.succ \ partial_sups d n,
  { rw [h, hsups, partial_sups_succ, disjointed_succ, sup_sdiff, sdiff_self, bot_sup_eq] },
  rw [partial_sups_succ, sup_sdiff, sdiff_self, bot_sup_eq, eq_comm, sdiff_eq_self_iff_disjoint],
  suffices h : ∀ m ≤ n, disjoint (partial_sups d m) (d n.succ),
  { exact h n le_rfl },
  rintro m hm,
  induction m with m ih,
  { exact hdisj (nat.succ_ne_zero _).symm },
  rw [partial_sups_succ, disjoint_iff, inf_sup_right, sup_eq_bot_iff, ←disjoint_iff, ←disjoint_iff],
  exact ⟨ih (nat.le_of_succ_le hm), hdisj (nat.lt_succ_of_le hm).ne⟩,
end

end generalized_boolean_algebra

section complete_boolean_algebra
variables [complete_boolean_algebra α]

lemma supr_disjointed (f : ℕ → α) : (⨆ n, disjointed f n) = (⨆ n, f n) :=
supr_eq_supr_of_partial_sups_eq_partial_sups (partial_sups_disjointed f)

lemma disjointed_eq_inf_compl (f : ℕ → α) (n : ℕ) :
  disjointed f n = f n ⊓ (⨅ i < n, (f i)ᶜ) :=
begin
  cases n,
  { rw [disjointed_zero, eq_comm, inf_eq_left],
    simp_rw le_infi_iff,
    exact λ i hi, (i.not_lt_zero hi).elim },
  simp_rw [disjointed_succ, partial_sups_eq_bsupr, sdiff_eq, compl_supr],
  congr,
  ext i,
  rw nat.lt_succ_iff,
end

end complete_boolean_algebra

/-! ### Set notation variants of lemmas -/

lemma disjointed_subset (f : ℕ → set α) (n : ℕ) : disjointed f n ⊆ f n :=
disjointed_le f n

lemma Union_disjointed {f : ℕ → set α} : (⋃ n, disjointed f n) = (⋃ n, f n) :=
supr_disjointed f

lemma disjointed_eq_inter_compl (f : ℕ → set α) (n : ℕ) :
  disjointed f n = f n ∩ (⋂ i < n, (f i)ᶜ) :=
disjointed_eq_inf_compl f n

lemma preimage_find_eq_disjointed (s : ℕ → set α) (H : ∀ x, ∃ n, x ∈ s n)
  [∀ x n, decidable (x ∈ s n)] (n : ℕ) :
  (λ x, nat.find (H x)) ⁻¹' {n} = disjointed s n :=
by { ext x, simp [nat.find_eq_iff, disjointed_eq_inter_compl] }


/-
Copyright (c) 2020 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.field_theory.subfield
import Mathlib.field_theory.tower
import Mathlib.ring_theory.algebraic
import Mathlib.PostPort

universes u_1 u_2 l u_3

namespace Mathlib

/-!
# Intermediate fields

Let `L / K` be a field extension, given as an instance `algebra K L`.
This file defines the type of fields in between `K` and `L`, `intermediate_field K L`.
An `intermediate_field K L` is a subfield of `L` which contains (the image of) `K`,
i.e. it is a `subfield L` and a `subalgebra K L`.

## Main definitions

 * `intermediate_field K L` : the type of intermediate fields between `K` and `L`.

 * `subalgebra.to_intermediate_field`: turns a subalgebra closed under `⁻¹`
   into an intermediate field

 * `subfield.to_intermediate_field`: turns a subfield containing the image of `K`
   into an intermediate field

* `intermediate_field.map`: map an intermediate field along an `alg_hom`

## Implementation notes

Intermediate fields are defined with a structure extending `subfield` and `subalgebra`.
A `subalgebra` is closed under all operations except `⁻¹`,

## Tags
intermediate field, field extension
-/

/-- `S : intermediate_field K L` is a subset of `L` such that there is a field
tower `L / S / K`. -/
structure intermediate_field (K : Type u_1) (L : Type u_2) [field K] [field L] [algebra K L]
extends subalgebra K L, subfield L
where

/-- Reinterpret an `intermediate_field` as a `subalgebra`. -/
/-- Reinterpret an `intermediate_field` as a `subfield`. -/
namespace intermediate_field

protected instance set.has_coe {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] : has_coe (intermediate_field K L) (set L) :=
  has_coe.mk carrier

@[simp] theorem coe_to_subalgebra {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (S : intermediate_field K L) : ↑(to_subalgebra S) = ↑S :=
  rfl

@[simp] theorem coe_to_subfield {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (S : intermediate_field K L) : ↑(to_subfield S) = ↑S :=
  rfl

protected instance has_coe_to_sort {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] : has_coe_to_sort (intermediate_field K L) :=
  has_coe_to_sort.mk (Type u_2) fun (S : intermediate_field K L) => ↥(carrier S)

protected instance has_mem {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] : has_mem L (intermediate_field K L) :=
  has_mem.mk fun (m : L) (S : intermediate_field K L) => m ∈ ↑S

@[simp] theorem mem_mk {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (s : set L) (hK : ∀ (x : K), coe_fn (algebra_map K L) x ∈ s) (ho : 1 ∈ s) (hm : ∀ {a b : L}, a ∈ s → b ∈ s → a * b ∈ s) (hz : 0 ∈ s) (ha : ∀ {a b : L}, a ∈ s → b ∈ s → a + b ∈ s) (hn : ∀ {x : L}, x ∈ s → -x ∈ s) (hi : ∀ (x : L), x ∈ s → x⁻¹ ∈ s) (x : L) : x ∈ mk s ho hm hz ha hK hn hi ↔ x ∈ s :=
  iff.rfl

@[simp] theorem mem_coe {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (S : intermediate_field K L) (x : L) : x ∈ ↑S ↔ x ∈ S :=
  iff.rfl

@[simp] theorem mem_to_subalgebra {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (s : intermediate_field K L) (x : L) : x ∈ to_subalgebra s ↔ x ∈ s :=
  iff.rfl

@[simp] theorem mem_to_subfield {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (s : intermediate_field K L) (x : L) : x ∈ to_subfield s ↔ x ∈ s :=
  iff.rfl

/-- Two intermediate fields are equal if the underlying subsets are equal. -/
theorem ext' {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] {s : intermediate_field K L} {t : intermediate_field K L} (h : ↑s = ↑t) : s = t := sorry

/-- Two intermediate fields are equal if and only if the underlying subsets are equal. -/
protected theorem ext'_iff {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] {s : intermediate_field K L} {t : intermediate_field K L} : s = t ↔ ↑s = ↑t :=
  { mp := fun (h : s = t) => h ▸ rfl, mpr := fun (h : ↑s = ↑t) => ext' h }

/-- Two intermediate fields are equal if they have the same elements. -/
theorem ext {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] {S : intermediate_field K L} {T : intermediate_field K L} (h : ∀ (x : L), x ∈ S ↔ x ∈ T) : S = T :=
  ext' (set.ext h)

/-- An intermediate field contains the image of the smaller field. -/
theorem algebra_map_mem {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (S : intermediate_field K L) (x : K) : coe_fn (algebra_map K L) x ∈ S :=
  algebra_map_mem' S x

/-- An intermediate field contains the ring's 1. -/
theorem one_mem {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (S : intermediate_field K L) : 1 ∈ S :=
  one_mem' S

/-- An intermediate field contains the ring's 0. -/
theorem zero_mem {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (S : intermediate_field K L) : 0 ∈ S :=
  zero_mem' S

/-- An intermediate field is closed under multiplication. -/
theorem mul_mem {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (S : intermediate_field K L) {x : L} {y : L} : x ∈ S → y ∈ S → x * y ∈ S :=
  mul_mem' S

/-- An intermediate field is closed under scalar multiplication. -/
theorem smul_mem {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (S : intermediate_field K L) {y : L} : y ∈ S → ∀ {x : K}, x • y ∈ S :=
  subalgebra.smul_mem (to_subalgebra S)

/-- An intermediate field is closed under addition. -/
theorem add_mem {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (S : intermediate_field K L) {x : L} {y : L} : x ∈ S → y ∈ S → x + y ∈ S :=
  add_mem' S

/-- An intermediate field is closed under subtraction -/
theorem sub_mem {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (S : intermediate_field K L) {x : L} {y : L} (hx : x ∈ S) (hy : y ∈ S) : x - y ∈ S :=
  subfield.sub_mem (to_subfield S) hx hy

/-- An intermediate field is closed under negation. -/
theorem neg_mem {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (S : intermediate_field K L) {x : L} : x ∈ S → -x ∈ S :=
  neg_mem' S

/-- An intermediate field is closed under inverses. -/
theorem inv_mem {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (S : intermediate_field K L) {x : L} : x ∈ S → x⁻¹ ∈ S :=
  inv_mem' S

/-- An intermediate field is closed under division. -/
theorem div_mem {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (S : intermediate_field K L) {x : L} {y : L} (hx : x ∈ S) (hy : y ∈ S) : x / y ∈ S :=
  subfield.div_mem (to_subfield S) hx hy

/-- Product of a list of elements in an intermediate_field is in the intermediate_field. -/
theorem list_prod_mem {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (S : intermediate_field K L) {l : List L} : (∀ (x : L), x ∈ l → x ∈ S) → list.prod l ∈ S :=
  subfield.list_prod_mem (to_subfield S)

/-- Sum of a list of elements in an intermediate field is in the intermediate_field. -/
theorem list_sum_mem {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (S : intermediate_field K L) {l : List L} : (∀ (x : L), x ∈ l → x ∈ S) → list.sum l ∈ S :=
  subfield.list_sum_mem (to_subfield S)

/-- Product of a multiset of elements in an intermediate field is in the intermediate_field. -/
theorem multiset_prod_mem {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (S : intermediate_field K L) (m : multiset L) : (∀ (a : L), a ∈ m → a ∈ S) → multiset.prod m ∈ S :=
  subfield.multiset_prod_mem (to_subfield S) m

/-- Sum of a multiset of elements in a `intermediate_field` is in the `intermediate_field`. -/
theorem multiset_sum_mem {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (S : intermediate_field K L) (m : multiset L) : (∀ (a : L), a ∈ m → a ∈ S) → multiset.sum m ∈ S :=
  subfield.multiset_sum_mem (to_subfield S) m

/-- Product of elements of an intermediate field indexed by a `finset` is in the intermediate_field. -/
theorem prod_mem {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (S : intermediate_field K L) {ι : Type u_3} {t : finset ι} {f : ι → L} (h : ∀ (c : ι), c ∈ t → f c ∈ S) : (finset.prod t fun (i : ι) => f i) ∈ S :=
  subfield.prod_mem (to_subfield S) h

/-- Sum of elements in a `intermediate_field` indexed by a `finset` is in the `intermediate_field`. -/
theorem sum_mem {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (S : intermediate_field K L) {ι : Type u_3} {t : finset ι} {f : ι → L} (h : ∀ (c : ι), c ∈ t → f c ∈ S) : (finset.sum t fun (i : ι) => f i) ∈ S :=
  subfield.sum_mem (to_subfield S) h

theorem pow_mem {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (S : intermediate_field K L) {x : L} (hx : x ∈ S) (n : ℤ) : x ^ n ∈ S :=
  int.cases_on n (fun (n : ℕ) => is_submonoid.pow_mem hx)
    fun (n : ℕ) => subfield.inv_mem (to_subfield S) (is_submonoid.pow_mem hx)

theorem gsmul_mem {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (S : intermediate_field K L) {x : L} (hx : x ∈ S) (n : ℤ) : n •ℤ x ∈ S :=
  subfield.gsmul_mem (to_subfield S) hx n

theorem coe_int_mem {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (S : intermediate_field K L) (n : ℤ) : ↑n ∈ S := sorry

end intermediate_field

/-- Turn a subalgebra closed under inverses into an intermediate field -/
def subalgebra.to_intermediate_field {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (S : subalgebra K L) (inv_mem : ∀ (x : L), x ∈ S → x⁻¹ ∈ S) : intermediate_field K L :=
  intermediate_field.mk (subalgebra.carrier S) sorry sorry sorry sorry sorry sorry inv_mem

@[simp] theorem to_subalgebra_to_intermediate_field {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (S : subalgebra K L) (inv_mem : ∀ (x : L), x ∈ S → x⁻¹ ∈ S) : intermediate_field.to_subalgebra (subalgebra.to_intermediate_field S inv_mem) = S :=
  subalgebra.ext
    fun (x : L) => iff.refl (x ∈ intermediate_field.to_subalgebra (subalgebra.to_intermediate_field S inv_mem))

@[simp] theorem to_intermediate_field_to_subalgebra {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (S : intermediate_field K L) (inv_mem : ∀ (x : L), x ∈ intermediate_field.to_subalgebra S → x⁻¹ ∈ S) : subalgebra.to_intermediate_field (intermediate_field.to_subalgebra S) inv_mem = S :=
  intermediate_field.ext
    fun (x : L) => iff.refl (x ∈ subalgebra.to_intermediate_field (intermediate_field.to_subalgebra S) inv_mem)

/-- Turn a subfield of `L` containing the image of `K` into an intermediate field -/
def subfield.to_intermediate_field {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (S : subfield L) (algebra_map_mem : ∀ (x : K), coe_fn (algebra_map K L) x ∈ S) : intermediate_field K L :=
  intermediate_field.mk (subfield.carrier S) (subfield.one_mem' S) (subfield.mul_mem' S) (subfield.zero_mem' S)
    (subfield.add_mem' S) algebra_map_mem (subfield.neg_mem' S) (subfield.inv_mem' S)

namespace intermediate_field

/-- An intermediate field inherits a field structure -/
protected instance to_field {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (S : intermediate_field K L) : field ↥S :=
  subfield.to_field (to_subfield S)

@[simp] theorem coe_add {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (S : intermediate_field K L) (x : ↥S) (y : ↥S) : ↑(x + y) = ↑x + ↑y :=
  rfl

@[simp] theorem coe_neg {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (S : intermediate_field K L) (x : ↥S) : ↑(-x) = -↑x :=
  rfl

@[simp] theorem coe_mul {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (S : intermediate_field K L) (x : ↥S) (y : ↥S) : ↑(x * y) = ↑x * ↑y :=
  rfl

@[simp] theorem coe_inv {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (S : intermediate_field K L) (x : ↥S) : ↑(x⁻¹) = (↑x⁻¹) :=
  rfl

@[simp] theorem coe_zero {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (S : intermediate_field K L) : ↑0 = 0 :=
  rfl

@[simp] theorem coe_one {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (S : intermediate_field K L) : ↑1 = 1 :=
  rfl

protected instance algebra {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (S : intermediate_field K L) : algebra K ↥S :=
  subalgebra.algebra (to_subalgebra S)

protected instance to_algebra {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (S : intermediate_field K L) : algebra (↥S) L :=
  subalgebra.to_algebra (to_subalgebra S)

protected instance is_scalar_tower {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (S : intermediate_field K L) : is_scalar_tower K (↥S) L :=
  is_scalar_tower.subalgebra' K L L (to_subalgebra S)

/-- If `f : L →+* L'` fixes `K`, `S.map f` is the intermediate field between `L'` and `K`
such that `x ∈ S ↔ f x ∈ S.map f`. -/
def map {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (S : intermediate_field K L) {L' : Type u_3} [field L'] [algebra K L'] (f : alg_hom K L L') : intermediate_field K L' :=
  mk (subalgebra.carrier (subalgebra.map (to_subalgebra S) f)) sorry sorry sorry sorry sorry sorry sorry

/-- The embedding from an intermediate field of `L / K` to `L`. -/
def val {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (S : intermediate_field K L) : alg_hom K (↥S) L :=
  subalgebra.val (to_subalgebra S)

@[simp] theorem coe_val {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (S : intermediate_field K L) : ⇑(val S) = coe :=
  rfl

@[simp] theorem val_mk {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (S : intermediate_field K L) {x : L} (hx : x ∈ S) : coe_fn (val S) { val := x, property := hx } = x :=
  rfl

theorem to_subalgebra_injective {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] {S : intermediate_field K L} {S' : intermediate_field K L} (h : to_subalgebra S = to_subalgebra S') : S = S' := sorry

protected instance partial_order {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] : partial_order (intermediate_field K L) :=
  partial_order.mk (fun (S T : intermediate_field K L) => ↑S ⊆ ↑T)
    (preorder.lt._default fun (S T : intermediate_field K L) => ↑S ⊆ ↑T) sorry sorry sorry

theorem set_range_subset {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (S : intermediate_field K L) : set.range ⇑(algebra_map K L) ⊆ ↑S :=
  subalgebra.range_subset (to_subalgebra S)

theorem field_range_le {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (S : intermediate_field K L) : ring_hom.field_range (algebra_map K L) ≤ to_subfield S := sorry

@[simp] theorem to_subalgebra_le_to_subalgebra {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] {S : intermediate_field K L} {S' : intermediate_field K L} : to_subalgebra S ≤ to_subalgebra S' ↔ S ≤ S' :=
  iff.rfl

@[simp] theorem to_subalgebra_lt_to_subalgebra {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] {S : intermediate_field K L} {S' : intermediate_field K L} : to_subalgebra S < to_subalgebra S' ↔ S < S' :=
  iff.rfl

/-- Lift an intermediate_field of an intermediate_field -/
def lift1 {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] {F : intermediate_field K L} (E : intermediate_field K ↥F) : intermediate_field K L :=
  map E (val F)

/-- Lift an intermediate_field of an intermediate_field -/
def lift2 {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] {F : intermediate_field K L} (E : intermediate_field (↥F) L) : intermediate_field K L :=
  mk (carrier E) sorry sorry sorry sorry sorry sorry sorry

protected instance has_lift1 {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] {F : intermediate_field K L} : has_lift_t (intermediate_field K ↥F) (intermediate_field K L) :=
  has_lift_t.mk lift1

protected instance has_lift2 {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] {F : intermediate_field K L} : has_lift_t (intermediate_field (↥F) L) (intermediate_field K L) :=
  has_lift_t.mk lift2

@[simp] theorem mem_lift2 {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] {F : intermediate_field K L} {E : intermediate_field (↥F) L} {x : L} : x ∈ ↑E ↔ x ∈ E :=
  iff.rfl

protected instance lift2_alg {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] {F : intermediate_field K L} {E : intermediate_field (↥F) L} : algebra K ↥E :=
  algebra.mk (ring_hom.mk ⇑(ring_hom.comp (algebra_map ↥F ↥E) (algebra_map K ↥F)) sorry sorry sorry sorry) sorry sorry

protected instance lift2_tower {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] {F : intermediate_field K L} {E : intermediate_field (↥F) L} : is_scalar_tower K ↥F ↥E := sorry

/-- `lift2` is isomorphic to the original `intermediate_field`. -/
def lift2_alg_equiv {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] {F : intermediate_field K L} (E : intermediate_field (↥F) L) : alg_equiv K ↥↑E ↥E :=
  alg_equiv.mk (fun (x : ↥↑E) => x) (fun (x : ↥E) => x) sorry sorry sorry sorry sorry

protected instance finite_dimensional_left {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (F : intermediate_field K L) [finite_dimensional K L] : finite_dimensional K ↥F :=
  finite_dimensional.finite_dimensional_submodule (subalgebra.to_submodule (to_subalgebra F))

protected instance finite_dimensional_right {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (F : intermediate_field K L) [finite_dimensional K L] : finite_dimensional (↥F) L :=
  finite_dimensional.right K (↥F) L

@[simp] theorem dim_eq_dim_subalgebra {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (F : intermediate_field K L) : vector_space.dim K ↥(to_subalgebra F) = vector_space.dim K ↥F :=
  rfl

@[simp] theorem findim_eq_findim_subalgebra {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (F : intermediate_field K L) : finite_dimensional.findim K ↥(to_subalgebra F) = finite_dimensional.findim K ↥F :=
  rfl

@[simp] theorem to_subalgebra_eq_iff {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] {F : intermediate_field K L} {E : intermediate_field K L} : to_subalgebra F = to_subalgebra E ↔ F = E := sorry

theorem eq_of_le_of_findim_le {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] {F : intermediate_field K L} {E : intermediate_field K L} [finite_dimensional K L] (h_le : F ≤ E) (h_findim : finite_dimensional.findim K ↥E ≤ finite_dimensional.findim K ↥F) : F = E := sorry

theorem eq_of_le_of_findim_eq {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] {F : intermediate_field K L} {E : intermediate_field K L} [finite_dimensional K L] (h_le : F ≤ E) (h_findim : finite_dimensional.findim K ↥F = finite_dimensional.findim K ↥E) : F = E :=
  eq_of_le_of_findim_le h_le (eq.ge h_findim)

theorem eq_of_le_of_findim_le' {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] {F : intermediate_field K L} {E : intermediate_field K L} [finite_dimensional K L] (h_le : F ≤ E) (h_findim : finite_dimensional.findim (↥F) L ≤ finite_dimensional.findim (↥E) L) : F = E := sorry

theorem eq_of_le_of_findim_eq' {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] {F : intermediate_field K L} {E : intermediate_field K L} [finite_dimensional K L] (h_le : F ≤ E) (h_findim : finite_dimensional.findim (↥F) L = finite_dimensional.findim (↥E) L) : F = E :=
  eq_of_le_of_findim_le' h_le (eq.le h_findim)

end intermediate_field

/-- If `L/K` is algebraic, the `K`-subalgebras of `L` are all fields.  -/
def subalgebra_equiv_intermediate_field {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (alg : algebra.is_algebraic K L) : subalgebra K L ≃o intermediate_field K L :=
  rel_iso.mk
    (equiv.mk (fun (S : subalgebra K L) => subalgebra.to_intermediate_field S sorry)
      (fun (S : intermediate_field K L) => intermediate_field.to_subalgebra S) sorry sorry)
    sorry

@[simp] theorem mem_subalgebra_equiv_intermediate_field {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (alg : algebra.is_algebraic K L) {S : subalgebra K L} {x : L} : x ∈ coe_fn (subalgebra_equiv_intermediate_field alg) S ↔ x ∈ S :=
  iff.rfl

@[simp] theorem mem_subalgebra_equiv_intermediate_field_symm {K : Type u_1} {L : Type u_2} [field K] [field L] [algebra K L] (alg : algebra.is_algebraic K L) {S : intermediate_field K L} {x : L} : x ∈ coe_fn (order_iso.symm (subalgebra_equiv_intermediate_field alg)) S ↔ x ∈ S :=
  iff.rfl


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

! This file was ported from Lean 3 source module logic.equiv.option
! leanprover-community/mathlib commit 448144f7ae193a8990cb7473c9e9a01990f64ac7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Control.EquivFunctor
import Mathbin.Data.Option.Basic
import Mathbin.Data.Subtype
import Mathbin.Logic.Equiv.Defs

/-!
# Equivalences for `option α`

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

We define
* `equiv.option_congr`: the `option α ≃ option β` constructed from `e : α ≃ β` by sending `none` to
  `none`, and applying a `e` elsewhere.
* `equiv.remove_none`: the `α ≃ β` constructed from `option α ≃ option β` by removing `none` from
  both sides.
-/

namespace Equiv

open Option

variable {α β γ : Type _}

section OptionCongr

#print Equiv.optionCongr /-
/-- A universe-polymorphic version of `equiv_functor.map_equiv option e`. -/
@[simps apply]
def optionCongr (e : α ≃ β) : Option α ≃ Option β
    where
  toFun := Option.map e
  invFun := Option.map e.symm
  left_inv x := (Option.map_map _ _ _).trans <| e.symm_comp_self.symm ▸ congr_fun Option.map_id x
  right_inv x := (Option.map_map _ _ _).trans <| e.self_comp_symm.symm ▸ congr_fun Option.map_id x
#align equiv.option_congr Equiv.optionCongr
-/

#print Equiv.optionCongr_refl /-
@[simp]
theorem optionCongr_refl : optionCongr (Equiv.refl α) = Equiv.refl _ :=
  ext <| congr_fun Option.map_id
#align equiv.option_congr_refl Equiv.optionCongr_refl
-/

/- warning: equiv.option_congr_symm -> Equiv.optionCongr_symm is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (e : Equiv.{succ u1, succ u2} α β), Eq.{max 1 (max (succ u2) (succ u1)) (succ u1) (succ u2)} (Equiv.{succ u2, succ u1} (Option.{u2} β) (Option.{u1} α)) (Equiv.symm.{succ u1, succ u2} (Option.{u1} α) (Option.{u2} β) (Equiv.optionCongr.{u1, u2} α β e)) (Equiv.optionCongr.{u2, u1} β α (Equiv.symm.{succ u1, succ u2} α β e))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} (e : Equiv.{succ u2, succ u1} α β), Eq.{max (succ u2) (succ u1)} (Equiv.{succ u1, succ u2} (Option.{u1} β) (Option.{u2} α)) (Equiv.symm.{succ u2, succ u1} (Option.{u2} α) (Option.{u1} β) (Equiv.optionCongr.{u2, u1} α β e)) (Equiv.optionCongr.{u1, u2} β α (Equiv.symm.{succ u2, succ u1} α β e))
Case conversion may be inaccurate. Consider using '#align equiv.option_congr_symm Equiv.optionCongr_symmₓ'. -/
@[simp]
theorem optionCongr_symm (e : α ≃ β) : (optionCongr e).symm = optionCongr e.symm :=
  rfl
#align equiv.option_congr_symm Equiv.optionCongr_symm

/- warning: equiv.option_congr_trans -> Equiv.optionCongr_trans is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {γ : Type.{u3}} (e₁ : Equiv.{succ u1, succ u2} α β) (e₂ : Equiv.{succ u2, succ u3} β γ), Eq.{max 1 (max (succ u1) (succ u3)) (succ u3) (succ u1)} (Equiv.{succ u1, succ u3} (Option.{u1} α) (Option.{u3} γ)) (Equiv.trans.{succ u1, succ u2, succ u3} (Option.{u1} α) (Option.{u2} β) (Option.{u3} γ) (Equiv.optionCongr.{u1, u2} α β e₁) (Equiv.optionCongr.{u2, u3} β γ e₂)) (Equiv.optionCongr.{u1, u3} α γ (Equiv.trans.{succ u1, succ u2, succ u3} α β γ e₁ e₂))
but is expected to have type
  forall {α : Type.{u3}} {β : Type.{u2}} {γ : Type.{u1}} (e₁ : Equiv.{succ u3, succ u2} α β) (e₂ : Equiv.{succ u2, succ u1} β γ), Eq.{max (succ u3) (succ u1)} (Equiv.{succ u3, succ u1} (Option.{u3} α) (Option.{u1} γ)) (Equiv.trans.{succ u3, succ u2, succ u1} (Option.{u3} α) (Option.{u2} β) (Option.{u1} γ) (Equiv.optionCongr.{u3, u2} α β e₁) (Equiv.optionCongr.{u2, u1} β γ e₂)) (Equiv.optionCongr.{u3, u1} α γ (Equiv.trans.{succ u3, succ u2, succ u1} α β γ e₁ e₂))
Case conversion may be inaccurate. Consider using '#align equiv.option_congr_trans Equiv.optionCongr_transₓ'. -/
@[simp]
theorem optionCongr_trans (e₁ : α ≃ β) (e₂ : β ≃ γ) :
    (optionCongr e₁).trans (optionCongr e₂) = optionCongr (e₁.trans e₂) :=
  ext <| Option.map_map _ _
#align equiv.option_congr_trans Equiv.optionCongr_trans

/- warning: equiv.option_congr_eq_equiv_function_map_equiv -> Equiv.optionCongr_eq_equivFunctor_mapEquiv is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u1}} (e : Equiv.{succ u1, succ u1} α β), Eq.{succ u1} (Equiv.{succ u1, succ u1} (Option.{u1} α) (Option.{u1} β)) (Equiv.optionCongr.{u1, u1} α β e) (EquivFunctor.mapEquiv.{u1, u1} Option.{u1} (EquivFunctor.ofLawfulFunctor.{u1, u1} Option.{u1} (Applicative.toFunctor.{u1, u1} Option.{u1} (Monad.toApplicative.{u1, u1} Option.{u1} Option.monad.{u1})) (LawfulApplicative.to_lawfulFunctor.{u1, u1} Option.{u1} (Monad.toApplicative.{u1, u1} Option.{u1} Option.monad.{u1}) (LawfulMonad.to_lawfulApplicative.{u1, u1} Option.{u1} Option.monad.{u1} Option.lawfulMonad.{u1}))) α β e)
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u1}} (e : Equiv.{succ u1, succ u1} α β), Eq.{succ u1} (Equiv.{succ u1, succ u1} (Option.{u1} α) (Option.{u1} β)) (Equiv.optionCongr.{u1, u1} α β e) (EquivFunctor.mapEquiv.{u1, u1} Option.{u1} (EquivFunctor.ofLawfulFunctor.{u1, u1} Option.{u1} instFunctorOption.{u1} instLawfulFunctorOptionInstFunctorOption.{u1}) α β e)
Case conversion may be inaccurate. Consider using '#align equiv.option_congr_eq_equiv_function_map_equiv Equiv.optionCongr_eq_equivFunctor_mapEquivₓ'. -/
/-- When `α` and `β` are in the same universe, this is the same as the result of
`equiv_functor.map_equiv`. -/
theorem optionCongr_eq_equivFunctor_mapEquiv {α β : Type _} (e : α ≃ β) :
    optionCongr e = EquivFunctor.mapEquiv Option e :=
  rfl
#align equiv.option_congr_eq_equiv_function_map_equiv Equiv.optionCongr_eq_equivFunctor_mapEquiv

end OptionCongr

section RemoveNone

variable (e : Option α ≃ Option β)

private def remove_none_aux (x : α) : β :=
  if h : (e (some x)).isSome then Option.get h
  else
    Option.get <|
      show (e none).isSome by
        rw [← Option.ne_none_iff_isSome]
        intro hn
        rw [Option.not_isSome_iff_eq_none, ← hn] at h
        simpa only using e.injective h
#align equiv.remove_none_aux equiv.remove_none_aux

private theorem remove_none_aux_some {x : α} (h : ∃ x', e (some x) = some x') :
    some (removeNoneAux e x) = e (some x) := by
  simp [remove_none_aux, option.is_some_iff_exists.mpr h]
#align equiv.remove_none_aux_some equiv.remove_none_aux_some

private theorem remove_none_aux_none {x : α} (h : e (some x) = none) :
    some (removeNoneAux e x) = e none := by
  simp [remove_none_aux, option.not_is_some_iff_eq_none.mpr h]
#align equiv.remove_none_aux_none equiv.remove_none_aux_none

private theorem remove_none_aux_inv (x : α) : removeNoneAux e.symm (removeNoneAux e x) = x :=
  Option.some_injective _
    (by
      cases h1 : e.symm (some (remove_none_aux e x)) <;> cases h2 : e (some x)
      · rw [remove_none_aux_none _ h1]
        exact (e.eq_symm_apply.mpr h2).symm
      · rw [remove_none_aux_some _ ⟨_, h2⟩] at h1
        simpa using h1
      · rw [remove_none_aux_none _ h2] at h1
        simpa using h1
      · rw [remove_none_aux_some _ ⟨_, h1⟩]
        rw [remove_none_aux_some _ ⟨_, h2⟩]
        simp)
#align equiv.remove_none_aux_inv equiv.remove_none_aux_inv

#print Equiv.removeNone /-
/-- Given an equivalence between two `option` types, eliminate `none` from that equivalence by
mapping `e.symm none` to `e none`. -/
def removeNone : α ≃ β where
  toFun := removeNoneAux e
  invFun := removeNoneAux e.symm
  left_inv := removeNoneAux_inv e
  right_inv := removeNoneAux_inv e.symm
#align equiv.remove_none Equiv.removeNone
-/

/- warning: equiv.remove_none_symm -> Equiv.removeNone_symm is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (e : Equiv.{succ u1, succ u2} (Option.{u1} α) (Option.{u2} β)), Eq.{max 1 (max (succ u2) (succ u1)) (succ u1) (succ u2)} (Equiv.{succ u2, succ u1} β α) (Equiv.symm.{succ u1, succ u2} α β (Equiv.removeNone.{u1, u2} α β e)) (Equiv.removeNone.{u2, u1} β α (Equiv.symm.{succ u1, succ u2} (Option.{u1} α) (Option.{u2} β) e))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} (e : Equiv.{succ u2, succ u1} (Option.{u2} α) (Option.{u1} β)), Eq.{max (succ u2) (succ u1)} (Equiv.{succ u1, succ u2} β α) (Equiv.symm.{succ u2, succ u1} α β (Equiv.removeNone.{u2, u1} α β e)) (Equiv.removeNone.{u1, u2} β α (Equiv.symm.{succ u2, succ u1} (Option.{u2} α) (Option.{u1} β) e))
Case conversion may be inaccurate. Consider using '#align equiv.remove_none_symm Equiv.removeNone_symmₓ'. -/
@[simp]
theorem removeNone_symm : (removeNone e).symm = removeNone e.symm :=
  rfl
#align equiv.remove_none_symm Equiv.removeNone_symm

#print Equiv.removeNone_some /-
theorem removeNone_some {x : α} (h : ∃ x', e (some x) = some x') :
    some (removeNone e x) = e (some x) :=
  removeNoneAux_some e h
#align equiv.remove_none_some Equiv.removeNone_some
-/

#print Equiv.removeNone_none /-
theorem removeNone_none {x : α} (h : e (some x) = none) : some (removeNone e x) = e none :=
  removeNoneAux_none e h
#align equiv.remove_none_none Equiv.removeNone_none
-/

/- warning: equiv.option_symm_apply_none_iff -> Equiv.option_symm_apply_none_iff is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (e : Equiv.{succ u1, succ u2} (Option.{u1} α) (Option.{u2} β)), Iff (Eq.{succ u1} (Option.{u1} α) (coeFn.{max 1 (max (succ u2) (succ u1)) (succ u1) (succ u2), max (succ u2) (succ u1)} (Equiv.{succ u2, succ u1} (Option.{u2} β) (Option.{u1} α)) (fun (_x : Equiv.{succ u2, succ u1} (Option.{u2} β) (Option.{u1} α)) => (Option.{u2} β) -> (Option.{u1} α)) (Equiv.hasCoeToFun.{succ u2, succ u1} (Option.{u2} β) (Option.{u1} α)) (Equiv.symm.{succ u1, succ u2} (Option.{u1} α) (Option.{u2} β) e) (Option.none.{u2} β)) (Option.none.{u1} α)) (Eq.{succ u2} (Option.{u2} β) (coeFn.{max 1 (max (succ u1) (succ u2)) (succ u2) (succ u1), max (succ u1) (succ u2)} (Equiv.{succ u1, succ u2} (Option.{u1} α) (Option.{u2} β)) (fun (_x : Equiv.{succ u1, succ u2} (Option.{u1} α) (Option.{u2} β)) => (Option.{u1} α) -> (Option.{u2} β)) (Equiv.hasCoeToFun.{succ u1, succ u2} (Option.{u1} α) (Option.{u2} β)) e (Option.none.{u1} α)) (Option.none.{u2} β))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} (e : Equiv.{succ u2, succ u1} (Option.{u2} α) (Option.{u1} β)), Iff (Eq.{succ u2} ((fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : Option.{u1} β) => Option.{u2} α) (Option.none.{u1} β)) (FunLike.coe.{max (succ u2) (succ u1), succ u1, succ u2} (Equiv.{succ u1, succ u2} (Option.{u1} β) (Option.{u2} α)) (Option.{u1} β) (fun (_x : Option.{u1} β) => (fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : Option.{u1} β) => Option.{u2} α) _x) (Equiv.instFunLikeEquiv.{succ u1, succ u2} (Option.{u1} β) (Option.{u2} α)) (Equiv.symm.{succ u2, succ u1} (Option.{u2} α) (Option.{u1} β) e) (Option.none.{u1} β)) (Option.none.{u2} α)) (Eq.{succ u1} ((fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : Option.{u2} α) => Option.{u1} β) (Option.none.{u2} α)) (FunLike.coe.{max (succ u2) (succ u1), succ u2, succ u1} (Equiv.{succ u2, succ u1} (Option.{u2} α) (Option.{u1} β)) (Option.{u2} α) (fun (_x : Option.{u2} α) => (fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : Option.{u2} α) => Option.{u1} β) _x) (Equiv.instFunLikeEquiv.{succ u2, succ u1} (Option.{u2} α) (Option.{u1} β)) e (Option.none.{u2} α)) (Option.none.{u1} β))
Case conversion may be inaccurate. Consider using '#align equiv.option_symm_apply_none_iff Equiv.option_symm_apply_none_iffₓ'. -/
@[simp]
theorem option_symm_apply_none_iff : e.symm none = none ↔ e none = none :=
  ⟨fun h => by simpa using (congr_arg e h).symm, fun h => by simpa using (congr_arg e.symm h).symm⟩
#align equiv.option_symm_apply_none_iff Equiv.option_symm_apply_none_iff

#print Equiv.some_removeNone_iff /-
theorem some_removeNone_iff {x : α} : some (removeNone e x) = e none ↔ e.symm none = some x :=
  by
  cases' h : e (some x) with a
  · rw [remove_none_none _ h]
    simpa using (congr_arg e.symm h).symm
  · rw [remove_none_some _ ⟨a, h⟩]
    have := congr_arg e.symm h
    rw [symm_apply_apply] at this
    simp only [false_iff_iff, apply_eq_iff_eq]
    simp [this]
#align equiv.some_remove_none_iff Equiv.some_removeNone_iff
-/

/- warning: equiv.remove_none_option_congr -> Equiv.removeNone_optionCongr is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (e : Equiv.{succ u1, succ u2} α β), Eq.{max 1 (max (succ u1) (succ u2)) (succ u2) (succ u1)} (Equiv.{succ u1, succ u2} α β) (Equiv.removeNone.{u1, u2} α β (Equiv.optionCongr.{u1, u2} α β e)) e
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} (e : Equiv.{succ u2, succ u1} α β), Eq.{max (succ u2) (succ u1)} (Equiv.{succ u2, succ u1} α β) (Equiv.removeNone.{u2, u1} α β (Equiv.optionCongr.{u2, u1} α β e)) e
Case conversion may be inaccurate. Consider using '#align equiv.remove_none_option_congr Equiv.removeNone_optionCongrₓ'. -/
@[simp]
theorem removeNone_optionCongr (e : α ≃ β) : removeNone e.optionCongr = e :=
  Equiv.ext fun x => Option.some_injective _ <| removeNone_some _ ⟨e x, by simp [EquivFunctor.map]⟩
#align equiv.remove_none_option_congr Equiv.removeNone_optionCongr

end RemoveNone

/- warning: equiv.option_congr_injective -> Equiv.optionCongr_injective is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}}, Function.Injective.{max 1 (max (succ u1) (succ u2)) (succ u2) (succ u1), max 1 (max (succ u1) (succ u2)) (succ u2) (succ u1)} (Equiv.{succ u1, succ u2} α β) (Equiv.{succ u1, succ u2} (Option.{u1} α) (Option.{u2} β)) (Equiv.optionCongr.{u1, u2} α β)
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}}, Function.Injective.{max (succ u2) (succ u1), max (succ u2) (succ u1)} (Equiv.{succ u2, succ u1} α β) (Equiv.{succ u2, succ u1} (Option.{u2} α) (Option.{u1} β)) (Equiv.optionCongr.{u2, u1} α β)
Case conversion may be inaccurate. Consider using '#align equiv.option_congr_injective Equiv.optionCongr_injectiveₓ'. -/
theorem optionCongr_injective : Function.Injective (optionCongr : α ≃ β → Option α ≃ Option β) :=
  Function.LeftInverse.injective removeNone_optionCongr
#align equiv.option_congr_injective Equiv.optionCongr_injective

#print Equiv.optionSubtype /-
/-- Equivalences between `option α` and `β` that send `none` to `x` are equivalent to
equivalences between `α` and `{y : β // y ≠ x}`. -/
def optionSubtype [DecidableEq β] (x : β) :
    { e : Option α ≃ β // e none = x } ≃ (α ≃ { y : β // y ≠ x })
    where
  toFun e :=
    { toFun := fun a => ⟨e a, ((EquivLike.injective _).ne_iff' e.property).2 (some_ne_none _)⟩
      invFun := fun b =>
        get
          (ne_none_iff_isSome.1
            (((EquivLike.injective _).ne_iff' ((apply_eq_iff_eq_symm_apply _).1 e.property).symm).2
              b.property))
      left_inv := fun a => by
        rw [← some_inj, some_get, ← coe_def]
        exact symm_apply_apply (e : Option α ≃ β) a
      right_inv := fun b => by
        ext
        simp
        exact apply_symm_apply _ _ }
  invFun e :=
    ⟨{  toFun := fun a => casesOn' a x (coe ∘ e)
        invFun := fun b => if h : b = x then none else e.symm ⟨b, h⟩
        left_inv := fun a => by
          cases a; · simp
          simp only [cases_on'_some, Function.comp_apply, Subtype.coe_eta, symm_apply_apply,
            dite_eq_ite]
          exact if_neg (e a).property
        right_inv := fun b => by by_cases h : b = x <;> simp [h] }, rfl⟩
  left_inv e := by
    ext a
    cases a
    · simpa using e.property.symm
    · simpa
  right_inv e := by
    ext a
    rfl
#align equiv.option_subtype Equiv.optionSubtype
-/

#print Equiv.optionSubtype_apply_apply /-
@[simp]
theorem optionSubtype_apply_apply [DecidableEq β] (x : β) (e : { e : Option α ≃ β // e none = x })
    (a : α) (h) : optionSubtype x e a = ⟨(e : Option α ≃ β) a, h⟩ :=
  rfl
#align equiv.option_subtype_apply_apply Equiv.optionSubtype_apply_apply
-/

#print Equiv.coe_optionSubtype_apply_apply /-
@[simp]
theorem coe_optionSubtype_apply_apply [DecidableEq β] (x : β)
    (e : { e : Option α ≃ β // e none = x }) (a : α) :
    ↑(optionSubtype x e a) = (e : Option α ≃ β) a :=
  rfl
#align equiv.coe_option_subtype_apply_apply Equiv.coe_optionSubtype_apply_apply
-/

#print Equiv.optionSubtype_apply_symm_apply /-
@[simp]
theorem optionSubtype_apply_symm_apply [DecidableEq β] (x : β)
    (e : { e : Option α ≃ β // e none = x }) (b : { y : β // y ≠ x }) :
    ↑((optionSubtype x e).symm b) = (e : Option α ≃ β).symm b :=
  by
  dsimp only [option_subtype]
  simp
#align equiv.option_subtype_apply_symm_apply Equiv.optionSubtype_apply_symm_apply
-/

#print Equiv.optionSubtype_symm_apply_apply_coe /-
@[simp]
theorem optionSubtype_symm_apply_apply_coe [DecidableEq β] (x : β) (e : α ≃ { y : β // y ≠ x })
    (a : α) : (optionSubtype x).symm e a = e a :=
  rfl
#align equiv.option_subtype_symm_apply_apply_coe Equiv.optionSubtype_symm_apply_apply_coe
-/

#print Equiv.optionSubtype_symm_apply_apply_some /-
@[simp]
theorem optionSubtype_symm_apply_apply_some [DecidableEq β] (x : β) (e : α ≃ { y : β // y ≠ x })
    (a : α) : (optionSubtype x).symm e (some a) = e a :=
  rfl
#align equiv.option_subtype_symm_apply_apply_some Equiv.optionSubtype_symm_apply_apply_some
-/

#print Equiv.optionSubtype_symm_apply_apply_none /-
@[simp]
theorem optionSubtype_symm_apply_apply_none [DecidableEq β] (x : β) (e : α ≃ { y : β // y ≠ x }) :
    (optionSubtype x).symm e none = x :=
  rfl
#align equiv.option_subtype_symm_apply_apply_none Equiv.optionSubtype_symm_apply_apply_none
-/

#print Equiv.optionSubtype_symm_apply_symm_apply /-
@[simp]
theorem optionSubtype_symm_apply_symm_apply [DecidableEq β] (x : β) (e : α ≃ { y : β // y ≠ x })
    (b : { y : β // y ≠ x }) : ((optionSubtype x).symm e : Option α ≃ β).symm b = e.symm b :=
  by
  simp only [option_subtype, coe_fn_symm_mk, Subtype.coe_mk, Subtype.coe_eta, dite_eq_ite,
    ite_eq_right_iff]
  exact fun h => False.elim (b.property h)
#align equiv.option_subtype_symm_apply_symm_apply Equiv.optionSubtype_symm_apply_symm_apply
-/

end Equiv